-- | Operational certificates
--
-- The certificate types and their decoding accessors now live in the
-- cardano-keys package; re-exported here for compatibility, together with the
-- issuing function this API adds on top of them.
module Cardano.Api.Certificate.Internal.OperationalCertificate
  ( OperationalCertificate (..)
  , OperationalCertificateIssueCounter (..)
  , Shelley.KESPeriod (..)
  , OperationalCertIssueError (..)
  , getHotKey
  , getKesPeriod
  , getOpCertCount
  , issueOperationalCertificate

    -- * Data family instances
  , AsType (..)
  )
where

import Cardano.Api.Error
import Cardano.Api.Key.Internal
import Cardano.Api.Key.Internal.Class
import Cardano.Api.Key.Internal.Praos
import Cardano.Api.Tx.Internal.Sign

import Cardano.Crypto.DSIGN qualified as DSIGN
import Cardano.Keys.OperationalCertificate
import Cardano.Ledger.Keys qualified as Shelley
import Cardano.Protocol.Crypto (StandardCrypto)
import Cardano.Protocol.TPraos.OCert qualified as Shelley

import GHC.Stack (HasCallStack)

data OperationalCertIssueError
  = -- | The stake pool verification key expected for the
    -- 'OperationalCertificateIssueCounter' does not match the signing key
    -- supplied for signing.
    --
    -- Order: pool vkey expected, pool skey supplied
    OperationalCertKeyMismatch
      (VerificationKey StakePoolKey)
      (VerificationKey StakePoolKey)
  deriving Int -> OperationalCertIssueError -> ShowS
[OperationalCertIssueError] -> ShowS
OperationalCertIssueError -> String
(Int -> OperationalCertIssueError -> ShowS)
-> (OperationalCertIssueError -> String)
-> ([OperationalCertIssueError] -> ShowS)
-> Show OperationalCertIssueError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationalCertIssueError -> ShowS
showsPrec :: Int -> OperationalCertIssueError -> ShowS
$cshow :: OperationalCertIssueError -> String
show :: OperationalCertIssueError -> String
$cshowList :: [OperationalCertIssueError] -> ShowS
showList :: [OperationalCertIssueError] -> ShowS
Show

instance Error OperationalCertIssueError where
  prettyError :: forall ann. OperationalCertIssueError -> Doc ann
prettyError (OperationalCertKeyMismatch VerificationKey StakePoolKey
_counterKey VerificationKey StakePoolKey
_signingKey) =
    Doc ann
"Key mismatch: the signing key does not match the one that goes with the counter"

-- TODO: include key ids

issueOperationalCertificate
  :: HasCallStack
  => VerificationKey KesKey
  -> Either
       AnyStakePoolSigningKey
       (SigningKey GenesisDelegateExtendedKey)
  -- TODO: this may be better with a type that
  -- captured the three (four?) choices, stake pool
  -- or genesis delegate, extended or normal.
  -> Shelley.KESPeriod
  -> OperationalCertificateIssueCounter
  -> Either
       OperationalCertIssueError
       ( OperationalCertificate
       , OperationalCertificateIssueCounter
       )
issueOperationalCertificate :: HasCallStack =>
VerificationKey KesKey
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
-> KESPeriod
-> OperationalCertificateIssueCounter
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
issueOperationalCertificate
  (KesVerificationKey VerKeyKES (KES StandardCrypto)
kesVKey)
  Either
  AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
skey
  KESPeriod
kesPeriod
  (OperationalCertificateIssueCounter Word64
counter VerificationKey StakePoolKey
poolVKey)
    | VerificationKey StakePoolKey
poolVKey VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> Bool
forall a. Eq a => a -> a -> Bool
/= VerificationKey StakePoolKey
poolVKey' =
        OperationalCertIssueError
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
forall a b. a -> Either a b
Left (VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> OperationalCertIssueError
OperationalCertKeyMismatch VerificationKey StakePoolKey
poolVKey VerificationKey StakePoolKey
poolVKey')
    | Bool
otherwise =
        (OperationalCertificate, OperationalCertificateIssueCounter)
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
forall a b. b -> Either a b
Right
          ( OCert StandardCrypto
-> VerificationKey StakePoolKey -> OperationalCertificate
OperationalCertificate OCert StandardCrypto
ocert VerificationKey StakePoolKey
poolVKey
          , Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter (Word64 -> Word64
forall a. Enum a => a -> a
succ Word64
counter) VerificationKey StakePoolKey
poolVKey
          )
   where
    castAnyStakePoolSigningKeyToNormalVerificationKey
      :: AnyStakePoolSigningKey
      -> VerificationKey StakePoolKey
    castAnyStakePoolSigningKeyToNormalVerificationKey :: AnyStakePoolSigningKey -> VerificationKey StakePoolKey
castAnyStakePoolSigningKeyToNormalVerificationKey AnyStakePoolSigningKey
anyStakePoolSKey =
      case AnyStakePoolSigningKey -> AnyStakePoolVerificationKey
anyStakePoolSigningKeyToVerificationKey AnyStakePoolSigningKey
anyStakePoolSKey of
        AnyStakePoolNormalVerificationKey VerificationKey StakePoolKey
normalStakePoolVKey -> VerificationKey StakePoolKey
normalStakePoolVKey
        AnyStakePoolExtendedVerificationKey VerificationKey StakePoolExtendedKey
extendedStakePoolVKey ->
          VerificationKey StakePoolExtendedKey
-> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey StakePoolExtendedKey
extendedStakePoolVKey

    poolVKey' :: VerificationKey StakePoolKey
    poolVKey' :: VerificationKey StakePoolKey
poolVKey' =
      (AnyStakePoolSigningKey -> VerificationKey StakePoolKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> VerificationKey StakePoolKey)
-> Either
     AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
-> VerificationKey StakePoolKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        AnyStakePoolSigningKey -> VerificationKey StakePoolKey
castAnyStakePoolSigningKeyToNormalVerificationKey
        (VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert (VerificationKey GenesisDelegateExtendedKey
 -> VerificationKey StakePoolKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateExtendedKey)
-> SigningKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey)
        Either
  AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
skey
     where
      convert
        :: VerificationKey GenesisDelegateExtendedKey
        -> VerificationKey StakePoolKey
      convert :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert =
        ( VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey
            :: VerificationKey GenesisDelegateKey
            -> VerificationKey StakePoolKey
        )
          (VerificationKey GenesisDelegateKey
 -> VerificationKey StakePoolKey)
-> (VerificationKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateKey)
-> VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey
                :: VerificationKey GenesisDelegateExtendedKey
                -> VerificationKey GenesisDelegateKey
            )

    ocert :: Shelley.OCert StandardCrypto
    ocert :: OCert StandardCrypto
ocert = VerKeyKES (KES StandardCrypto)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable StandardCrypto)
-> OCert StandardCrypto
forall c.
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
Shelley.OCert VerKeyKES (KES StandardCrypto)
kesVKey Word64
counter KESPeriod
kesPeriod SignedDSIGN DSIGN (OCertSignable StandardCrypto)
signature

    signature
      :: DSIGN.SignedDSIGN
           Shelley.DSIGN
           (Shelley.OCertSignable StandardCrypto)
    signature :: SignedDSIGN DSIGN (OCertSignable StandardCrypto)
signature =
      OCertSignable StandardCrypto
-> ShelleySigningKey
-> SignedDSIGN DSIGN (OCertSignable StandardCrypto)
forall tosign.
(HasCallStack, SignableRepresentation tosign) =>
tosign -> ShelleySigningKey -> SignedDSIGN DSIGN tosign
makeShelleySignature
        (VerKeyKES (KES StandardCrypto)
-> Word64 -> KESPeriod -> OCertSignable StandardCrypto
forall c.
VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
Shelley.OCertSignable VerKeyKES (KES StandardCrypto)
kesVKey Word64
counter KESPeriod
kesPeriod)
        ShelleySigningKey
skey'
     where
      skey' :: ShelleySigningKey
      skey' :: ShelleySigningKey
skey' = case Either
  AnyStakePoolSigningKey (SigningKey GenesisDelegateExtendedKey)
skey of
        Left (AnyStakePoolNormalSigningKey (StakePoolSigningKey SignKeyDSIGN DSIGN
poolSKey)) ->
          SignKeyDSIGN DSIGN -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN DSIGN
poolSKey
        Left
          ( AnyStakePoolExtendedSigningKey
              (StakePoolExtendedSigningKey XPrv
poolExtendedSKey)
            ) ->
            XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
poolExtendedSKey
        Right (GenesisDelegateExtendedSigningKey XPrv
delegSKey) ->
          XPrv -> ShelleySigningKey
ShelleyExtendedSigningKey XPrv
delegSKey