{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}

-- | Operational certificates
module Cardano.Api.OperationalCertificate
  ( OperationalCertificate (..)
  , OperationalCertificateIssueCounter (..)
  , Shelley.KESPeriod (..)
  , OperationalCertIssueError (..)
  , getHotKey
  , getKesPeriod
  , getOpCertCount
  , issueOperationalCertificate

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

import           Cardano.Api.Address
import           Cardano.Api.Certificate
import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Byron
import           Cardano.Api.Keys.Class
import           Cardano.Api.Keys.Praos
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.ProtocolParameters
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.Tx.Sign

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

import           Data.Word

-- ----------------------------------------------------------------------------
-- Operational certificates
--

data OperationalCertificate
  = OperationalCertificate
      !(Shelley.OCert StandardCrypto)
      !(VerificationKey StakePoolKey)
  deriving (OperationalCertificate -> OperationalCertificate -> Bool
(OperationalCertificate -> OperationalCertificate -> Bool)
-> (OperationalCertificate -> OperationalCertificate -> Bool)
-> Eq OperationalCertificate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationalCertificate -> OperationalCertificate -> Bool
== :: OperationalCertificate -> OperationalCertificate -> Bool
$c/= :: OperationalCertificate -> OperationalCertificate -> Bool
/= :: OperationalCertificate -> OperationalCertificate -> Bool
Eq, Int -> OperationalCertificate -> ShowS
[OperationalCertificate] -> ShowS
OperationalCertificate -> String
(Int -> OperationalCertificate -> ShowS)
-> (OperationalCertificate -> String)
-> ([OperationalCertificate] -> ShowS)
-> Show OperationalCertificate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationalCertificate -> ShowS
showsPrec :: Int -> OperationalCertificate -> ShowS
$cshow :: OperationalCertificate -> String
show :: OperationalCertificate -> String
$cshowList :: [OperationalCertificate] -> ShowS
showList :: [OperationalCertificate] -> ShowS
Show)
  deriving anyclass HasTypeProxy OperationalCertificate
HasTypeProxy OperationalCertificate =>
(OperationalCertificate -> ByteString)
-> (AsType OperationalCertificate
    -> ByteString -> Either DecoderError OperationalCertificate)
-> SerialiseAsCBOR OperationalCertificate
AsType OperationalCertificate
-> ByteString -> Either DecoderError OperationalCertificate
OperationalCertificate -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: OperationalCertificate -> ByteString
serialiseToCBOR :: OperationalCertificate -> ByteString
$cdeserialiseFromCBOR :: AsType OperationalCertificate
-> ByteString -> Either DecoderError OperationalCertificate
deserialiseFromCBOR :: AsType OperationalCertificate
-> ByteString -> Either DecoderError OperationalCertificate
SerialiseAsCBOR

data OperationalCertificateIssueCounter
  = OperationalCertificateIssueCounter
  { OperationalCertificateIssueCounter -> Word64
opCertIssueCount :: !Word64
  , OperationalCertificateIssueCounter -> VerificationKey StakePoolKey
opCertIssueColdKey :: !(VerificationKey StakePoolKey) -- For consistency checking
  }
  deriving (OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
(OperationalCertificateIssueCounter
 -> OperationalCertificateIssueCounter -> Bool)
-> (OperationalCertificateIssueCounter
    -> OperationalCertificateIssueCounter -> Bool)
-> Eq OperationalCertificateIssueCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
== :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
$c/= :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
/= :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
Eq, Int -> OperationalCertificateIssueCounter -> ShowS
[OperationalCertificateIssueCounter] -> ShowS
OperationalCertificateIssueCounter -> String
(Int -> OperationalCertificateIssueCounter -> ShowS)
-> (OperationalCertificateIssueCounter -> String)
-> ([OperationalCertificateIssueCounter] -> ShowS)
-> Show OperationalCertificateIssueCounter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationalCertificateIssueCounter -> ShowS
showsPrec :: Int -> OperationalCertificateIssueCounter -> ShowS
$cshow :: OperationalCertificateIssueCounter -> String
show :: OperationalCertificateIssueCounter -> String
$cshowList :: [OperationalCertificateIssueCounter] -> ShowS
showList :: [OperationalCertificateIssueCounter] -> ShowS
Show)
  deriving anyclass HasTypeProxy OperationalCertificateIssueCounter
HasTypeProxy OperationalCertificateIssueCounter =>
(OperationalCertificateIssueCounter -> ByteString)
-> (AsType OperationalCertificateIssueCounter
    -> ByteString
    -> Either DecoderError OperationalCertificateIssueCounter)
-> SerialiseAsCBOR OperationalCertificateIssueCounter
AsType OperationalCertificateIssueCounter
-> ByteString
-> Either DecoderError OperationalCertificateIssueCounter
OperationalCertificateIssueCounter -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: OperationalCertificateIssueCounter -> ByteString
serialiseToCBOR :: OperationalCertificateIssueCounter -> ByteString
$cdeserialiseFromCBOR :: AsType OperationalCertificateIssueCounter
-> ByteString
-> Either DecoderError OperationalCertificateIssueCounter
deserialiseFromCBOR :: AsType OperationalCertificateIssueCounter
-> ByteString
-> Either DecoderError OperationalCertificateIssueCounter
SerialiseAsCBOR

instance ToCBOR OperationalCertificate where
  toCBOR :: OperationalCertificate -> Encoding
toCBOR (OperationalCertificate OCert StandardCrypto
ocert VerificationKey StakePoolKey
vkey) =
    (OCert StandardCrypto, VerificationKey StakePoolKey) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (OCert StandardCrypto
ocert, VerificationKey StakePoolKey
vkey)

instance FromCBOR OperationalCertificate where
  fromCBOR :: forall s. Decoder s OperationalCertificate
fromCBOR = do
    (OCert StandardCrypto
ocert, VerificationKey StakePoolKey
vkey) <- Decoder s (OCert StandardCrypto, VerificationKey StakePoolKey)
forall s.
Decoder s (OCert StandardCrypto, VerificationKey StakePoolKey)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    OperationalCertificate -> Decoder s OperationalCertificate
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (OCert StandardCrypto
-> VerificationKey StakePoolKey -> OperationalCertificate
OperationalCertificate OCert StandardCrypto
ocert VerificationKey StakePoolKey
vkey)

instance ToCBOR OperationalCertificateIssueCounter where
  toCBOR :: OperationalCertificateIssueCounter -> Encoding
toCBOR (OperationalCertificateIssueCounter Word64
counter VerificationKey StakePoolKey
vkey) =
    (Word64, VerificationKey StakePoolKey) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word64
counter, VerificationKey StakePoolKey
vkey)

instance FromCBOR OperationalCertificateIssueCounter where
  fromCBOR :: forall s. Decoder s OperationalCertificateIssueCounter
fromCBOR = do
    (Word64
counter, VerificationKey StakePoolKey
vkey) <- Decoder s (Word64, VerificationKey StakePoolKey)
forall s. Decoder s (Word64, VerificationKey StakePoolKey)
forall a s. FromCBOR a => Decoder s a
fromCBOR
    OperationalCertificateIssueCounter
-> Decoder s OperationalCertificateIssueCounter
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter Word64
counter VerificationKey StakePoolKey
vkey)

instance HasTypeProxy OperationalCertificate where
  data AsType OperationalCertificate = AsOperationalCertificate
  proxyToAsType :: Proxy OperationalCertificate -> AsType OperationalCertificate
proxyToAsType Proxy OperationalCertificate
_ = AsType OperationalCertificate
AsOperationalCertificate

instance HasTypeProxy OperationalCertificateIssueCounter where
  data AsType OperationalCertificateIssueCounter = AsOperationalCertificateIssueCounter
  proxyToAsType :: Proxy OperationalCertificateIssueCounter
-> AsType OperationalCertificateIssueCounter
proxyToAsType Proxy OperationalCertificateIssueCounter
_ = AsType OperationalCertificateIssueCounter
AsOperationalCertificateIssueCounter

instance HasTextEnvelope OperationalCertificate where
  textEnvelopeType :: AsType OperationalCertificate -> TextEnvelopeType
textEnvelopeType AsType OperationalCertificate
_ = TextEnvelopeType
"NodeOperationalCertificate"

instance HasTextEnvelope OperationalCertificateIssueCounter where
  textEnvelopeType :: AsType OperationalCertificateIssueCounter -> TextEnvelopeType
textEnvelopeType AsType OperationalCertificateIssueCounter
_ = TextEnvelopeType
"NodeOperationalCertificateIssueCounter"

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
  :: VerificationKey KesKey
  -> Either
      (SigningKey StakePoolKey)
      (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 :: VerificationKey KesKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
-> KESPeriod
-> OperationalCertificateIssueCounter
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
issueOperationalCertificate
  (KesVerificationKey VerKeyKES StandardCrypto
kesVKey)
  Either
  (SigningKey StakePoolKey) (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
    poolVKey' :: VerificationKey StakePoolKey
    poolVKey' :: VerificationKey StakePoolKey
poolVKey' = (SigningKey StakePoolKey -> VerificationKey StakePoolKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> VerificationKey StakePoolKey)
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
-> VerificationKey StakePoolKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SigningKey StakePoolKey -> VerificationKey StakePoolKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (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
  (SigningKey StakePoolKey) (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 StandardCrypto
-> Word64
-> KESPeriod
-> SignedDSIGN StandardCrypto (OCertSignable StandardCrypto)
-> OCert StandardCrypto
forall c.
VerKeyKES c
-> Word64
-> KESPeriod
-> SignedDSIGN c (OCertSignable c)
-> OCert c
Shelley.OCert VerKeyKES StandardCrypto
kesVKey Word64
counter KESPeriod
kesPeriod SignedDSIGN StandardCrypto (OCertSignable StandardCrypto)
signature

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

getHotKey :: OperationalCertificate -> VerificationKey KesKey
getHotKey :: OperationalCertificate -> VerificationKey KesKey
getHotKey (OperationalCertificate OCert StandardCrypto
cert VerificationKey StakePoolKey
_) = VerKeyKES StandardCrypto -> VerificationKey KesKey
KesVerificationKey (VerKeyKES StandardCrypto -> VerificationKey KesKey)
-> VerKeyKES StandardCrypto -> VerificationKey KesKey
forall a b. (a -> b) -> a -> b
$ OCert StandardCrypto -> VerKeyKES StandardCrypto
forall c. OCert c -> VerKeyKES c
Shelley.ocertVkHot OCert StandardCrypto
cert

getKesPeriod :: OperationalCertificate -> Word
getKesPeriod :: OperationalCertificate -> Word
getKesPeriod (OperationalCertificate OCert StandardCrypto
cert VerificationKey StakePoolKey
_) = KESPeriod -> Word
Shelley.unKESPeriod (KESPeriod -> Word) -> KESPeriod -> Word
forall a b. (a -> b) -> a -> b
$ OCert StandardCrypto -> KESPeriod
forall c. OCert c -> KESPeriod
Shelley.ocertKESPeriod OCert StandardCrypto
cert

getOpCertCount :: OperationalCertificate -> Word64
getOpCertCount :: OperationalCertificate -> Word64
getOpCertCount (OperationalCertificate OCert StandardCrypto
cert VerificationKey StakePoolKey
_) = OCert StandardCrypto -> Word64
forall c. OCert c -> Word64
Shelley.ocertN OCert StandardCrypto
cert