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

import qualified Cardano.Protocol.TPraos.OCert as Shelley

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

data OperationalCertificate =
     OperationalCertificate
       !(Shelley.OCert StandardCrypto)
       !(VerificationKey StakePoolKey)
  deriving (OperationalCertificate -> OperationalCertificate -> Bool
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
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
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
SerialiseAsCBOR

data OperationalCertificateIssueCounter =
     OperationalCertificateIssueCounter
       { OperationalCertificateIssueCounter -> Word64
opCertIssueCount :: !Word64
       , OperationalCertificateIssueCounter -> VerificationKey StakePoolKey
opCertIssueColdKey :: !(VerificationKey StakePoolKey) -- For consistency checking
       }
  deriving (OperationalCertificateIssueCounter
-> OperationalCertificateIssueCounter -> Bool
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
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
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
SerialiseAsCBOR

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

instance FromCBOR OperationalCertificate where
    fromCBOR :: forall s. Decoder s OperationalCertificate
fromCBOR = do
      (CBOR.CBORGroup OCert StandardCrypto
ocert, VerificationKey StakePoolKey
vkey) <- forall a s. FromCBOR a => Decoder s a
fromCBOR
      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) =
      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) <- forall a s. FromCBOR a => Decoder s a
fromCBOR
      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
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 VerKeyKES StandardCrypto
kesVKey)
                            Either
  (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
skey
                            KESPeriod
kesPeriod
                            (OperationalCertificateIssueCounter Word64
counter VerificationKey StakePoolKey
poolVKey)
    | VerificationKey StakePoolKey
poolVKey forall a. Eq a => a -> a -> Bool
/= VerificationKey StakePoolKey
poolVKey'
    = forall a b. a -> Either a b
Left (VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> OperationalCertIssueError
OperationalCertKeyMismatch VerificationKey StakePoolKey
poolVKey VerificationKey StakePoolKey
poolVKey')

    | Bool
otherwise
    = 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 (forall a. Enum a => a -> a
succ Word64
counter) VerificationKey StakePoolKey
poolVKey)
  where
    poolVKey' :: VerificationKey StakePoolKey
    poolVKey' :: VerificationKey StakePoolKey
poolVKey' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey GenesisDelegateKey
                                       -> VerificationKey StakePoolKey)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey GenesisDelegateExtendedKey
                                       -> VerificationKey GenesisDelegateKey)

    ocert     :: Shelley.OCert StandardCrypto
    ocert :: OCert StandardCrypto
ocert     = 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 = forall tosign.
SignableRepresentation tosign =>
tosign -> ShelleySigningKey -> SignedDSIGN StandardCrypto tosign
makeShelleySignature
                  (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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall crypto. OCert crypto -> KESPeriod
Shelley.ocertKESPeriod OCert StandardCrypto
cert

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