{-# 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           Prelude

import           Data.Word

import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Keys as Shelley
import qualified Cardano.Ledger.Serialization as CBOR (CBORGroup (..))

import           Cardano.Api.Address
import           Cardano.Api.Certificate
import           Cardano.Api.Error
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Key
import           Cardano.Api.KeysByron
import           Cardano.Api.KeysPraos
import           Cardano.Api.KeysShelley
import           Cardano.Api.ProtocolParameters
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.Tx

import qualified Cardano.Protocol.TPraos.OCert as Shelley

-- ----------------------------------------------------------------------------
-- 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
/= :: OperationalCertificate -> OperationalCertificate -> Bool
$c/= :: OperationalCertificate -> OperationalCertificate -> Bool
== :: OperationalCertificate -> OperationalCertificate -> Bool
$c== :: 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
showList :: [OperationalCertificate] -> ShowS
$cshowList :: [OperationalCertificate] -> ShowS
show :: OperationalCertificate -> String
$cshow :: OperationalCertificate -> String
showsPrec :: Int -> OperationalCertificate -> ShowS
$cshowsPrec :: Int -> 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
deserialiseFromCBOR :: AsType OperationalCertificate
-> ByteString -> Either DecoderError OperationalCertificate
$cdeserialiseFromCBOR :: AsType OperationalCertificate
-> ByteString -> Either DecoderError OperationalCertificate
serialiseToCBOR :: OperationalCertificate -> ByteString
$cserialiseToCBOR :: OperationalCertificate -> ByteString
$cp1SerialiseAsCBOR :: HasTypeProxy 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
/= :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
$c/= :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
== :: OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
$c== :: 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
showList :: [OperationalCertificateIssueCounter] -> ShowS
$cshowList :: [OperationalCertificateIssueCounter] -> ShowS
show :: OperationalCertificateIssueCounter -> String
$cshow :: OperationalCertificateIssueCounter -> String
showsPrec :: Int -> OperationalCertificateIssueCounter -> ShowS
$cshowsPrec :: Int -> 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
deserialiseFromCBOR :: AsType OperationalCertificateIssueCounter
-> ByteString
-> Either DecoderError OperationalCertificateIssueCounter
$cdeserialiseFromCBOR :: AsType OperationalCertificateIssueCounter
-> ByteString
-> Either DecoderError OperationalCertificateIssueCounter
serialiseToCBOR :: OperationalCertificateIssueCounter -> ByteString
$cserialiseToCBOR :: OperationalCertificateIssueCounter -> ByteString
$cp1SerialiseAsCBOR :: HasTypeProxy OperationalCertificateIssueCounter
SerialiseAsCBOR

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

instance FromCBOR OperationalCertificate where
    fromCBOR :: Decoder s OperationalCertificate
fromCBOR = do
      (CBOR.CBORGroup OCert StandardCrypto
ocert, VerificationKey StakePoolKey
vkey) <- Decoder
  s (CBORGroup (OCert StandardCrypto), VerificationKey StakePoolKey)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      OperationalCertificate -> Decoder s OperationalCertificate
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 :: Decoder s OperationalCertificateIssueCounter
fromCBOR = do
      (Word64
counter, VerificationKey StakePoolKey
vkey) <- Decoder s (Word64, VerificationKey StakePoolKey)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      OperationalCertificateIssueCounter
-> Decoder s OperationalCertificateIssueCounter
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
showList :: [OperationalCertIssueError] -> ShowS
$cshowList :: [OperationalCertIssueError] -> ShowS
show :: OperationalCertIssueError -> String
$cshow :: OperationalCertIssueError -> String
showsPrec :: Int -> OperationalCertIssueError -> ShowS
$cshowsPrec :: Int -> OperationalCertIssueError -> ShowS
Show

instance Error OperationalCertIssueError where
    displayError :: OperationalCertIssueError -> String
displayError (OperationalCertKeyMismatch VerificationKey StakePoolKey
_counterKey VerificationKey StakePoolKey
_signingKey) =
      String
"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 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 =>
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 =>
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 crypto.
VerKeyKES crypto
-> Word64
-> KESPeriod
-> SignedDSIGN crypto (OCertSignable crypto)
-> OCert crypto
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 crypto.
VerKeyKES crypto -> Word64 -> KESPeriod -> OCertSignable crypto
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 poolSKey) ->
                    SignKeyDSIGN StandardCrypto -> ShelleySigningKey
ShelleyNormalSigningKey SignKeyDSIGN StandardCrypto
poolSKey
                  Right (GenesisDelegateExtendedSigningKey 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 crypto. OCert crypto -> VerKeyKES crypto
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 crypto. OCert crypto -> KESPeriod
Shelley.ocertKESPeriod OCert StandardCrypto
cert

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