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

-- | Operational certificates
--
module Bcc.Api.OperationalCertificate (
    OperationalCertificate(..),
    OperationalCertificateIssueCounter(..),
    Sophie.KESPeriod(..),
    OperationalCertIssueError(..),
    issueOperationalCertificate,

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

import           Prelude

import           Data.Word

import           Bcc.Ledger.Crypto (StandardCrypto)
import qualified Bcc.Ledger.Keys as Sophie
import qualified Bcc.Ledger.Serialization as CBOR (CBORGroup (..))

import           Bcc.Api.Address
import           Bcc.Api.Certificate
import           Bcc.Api.Error
import           Bcc.Api.HasTypeProxy
import           Bcc.Api.Key
import           Bcc.Api.KeysCole
import           Bcc.Api.KeysOptimum
import           Bcc.Api.KeysSophie
import           Bcc.Api.ProtocolParameters
import           Bcc.Api.SerialiseCBOR
import           Bcc.Api.SerialiseTextEnvelope
import           Bcc.Api.Tx

import qualified Bcc.Protocol.TOptimum.OCert as Sophie

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

data OperationalCertificate =
     OperationalCertificate
       !(Sophie.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
       !Word64
       !(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.
                            -> Sophie.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     :: Sophie.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
Sophie.OCert VerKeyKES StandardCrypto
kesVKey Word64
counter KESPeriod
kesPeriod SignedDSIGN StandardCrypto (OCertSignable StandardCrypto)
signature

    signature :: Sophie.SignedDSIGN
                   StandardCrypto
                   (Sophie.OCertSignable StandardCrypto)
    signature :: SignedDSIGN StandardCrypto (OCertSignable StandardCrypto)
signature = OCertSignable StandardCrypto
-> SophieSigningKey
-> SignedDSIGN StandardCrypto (OCertSignable StandardCrypto)
forall tosign.
SignableRepresentation tosign =>
tosign -> SophieSigningKey -> SignedDSIGN StandardCrypto tosign
makeSophieSignature
                  (VerKeyKES StandardCrypto
-> Word64 -> KESPeriod -> OCertSignable StandardCrypto
forall crypto.
VerKeyKES crypto -> Word64 -> KESPeriod -> OCertSignable crypto
Sophie.OCertSignable VerKeyKES StandardCrypto
kesVKey Word64
counter KESPeriod
kesPeriod)
                  SophieSigningKey
skey'
      where
        skey' :: SophieSigningKey
        skey' :: SophieSigningKey
skey' = case Either
  (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
skey of
                  Left (StakePoolSigningKey poolSKey) ->
                    SignKeyDSIGN StandardCrypto -> SophieSigningKey
SophieNormalSigningKey SignKeyDSIGN StandardCrypto
poolSKey
                  Right (GenesisDelegateExtendedSigningKey delegSKey) ->
                    XPrv -> SophieSigningKey
SophieExtendedSigningKey XPrv
delegSKey