{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Protocol.TPraos.OCert (
  OCert (..),
  OCertEnv (..),
  OCertSignable (..),
  ocertToSignable,
  currentIssueNo,
  KESPeriod (..),
  slotsPerKESPeriod,
  kesPeriod,
) where

import qualified Cardano.Crypto.DSIGN as DSIGN
import qualified Cardano.Crypto.KES as KES
import Cardano.Crypto.Util (SignableRepresentation (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (
  CBORGroup (..),
  DecCBOR (..),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  FromCBOR (..),
  ToCBOR (..),
  encodedSigDSIGNSizeExpr,
  encodedVerKeyKESSizeExpr,
  fromPlainDecoder,
  fromPlainEncoding,
  runByteBuilder,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Keys (
  DSIGN,
  KeyHash,
  KeyRole (..),
  coerceKeyRole,
 )
import Cardano.Protocol.Crypto (Crypto, KES)
import Control.Monad.Trans.Reader (asks)
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Builder.Extra as BS
import Data.Functor ((<&>))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Quiet

data OCertEnv = OCertEnv
  { OCertEnv -> Set (KeyHash 'StakePool)
ocertEnvStPools :: Set (KeyHash 'StakePool)
  , OCertEnv -> Set (KeyHash 'GenesisDelegate)
ocertEnvGenDelegs :: Set (KeyHash 'GenesisDelegate)
  }
  deriving (Int -> OCertEnv -> ShowS
[OCertEnv] -> ShowS
OCertEnv -> String
(Int -> OCertEnv -> ShowS)
-> (OCertEnv -> String) -> ([OCertEnv] -> ShowS) -> Show OCertEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCertEnv -> ShowS
showsPrec :: Int -> OCertEnv -> ShowS
$cshow :: OCertEnv -> String
show :: OCertEnv -> String
$cshowList :: [OCertEnv] -> ShowS
showList :: [OCertEnv] -> ShowS
Show, OCertEnv -> OCertEnv -> Bool
(OCertEnv -> OCertEnv -> Bool)
-> (OCertEnv -> OCertEnv -> Bool) -> Eq OCertEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCertEnv -> OCertEnv -> Bool
== :: OCertEnv -> OCertEnv -> Bool
$c/= :: OCertEnv -> OCertEnv -> Bool
/= :: OCertEnv -> OCertEnv -> Bool
Eq)

currentIssueNo ::
  OCertEnv ->
  Map (KeyHash 'BlockIssuer) Word64 ->
  -- | Pool hash
  KeyHash 'BlockIssuer ->
  Maybe Word64
currentIssueNo :: OCertEnv
-> Map (KeyHash 'BlockIssuer) Word64
-> KeyHash 'BlockIssuer
-> Maybe Word64
currentIssueNo (OCertEnv Set (KeyHash 'StakePool)
stPools Set (KeyHash 'GenesisDelegate)
genDelegs) Map (KeyHash 'BlockIssuer) Word64
cs KeyHash 'BlockIssuer
hk
  | KeyHash 'BlockIssuer -> Map (KeyHash 'BlockIssuer) Word64 -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member KeyHash 'BlockIssuer
hk Map (KeyHash 'BlockIssuer) Word64
cs = KeyHash 'BlockIssuer
-> Map (KeyHash 'BlockIssuer) Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'BlockIssuer
hk Map (KeyHash 'BlockIssuer) Word64
cs
  | KeyHash 'StakePool -> Set (KeyHash 'StakePool) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (KeyHash 'BlockIssuer -> KeyHash 'StakePool
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole KeyHash 'BlockIssuer
hk) Set (KeyHash 'StakePool)
stPools = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
  | KeyHash 'GenesisDelegate -> Set (KeyHash 'GenesisDelegate) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (KeyHash 'BlockIssuer -> KeyHash 'GenesisDelegate
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole KeyHash 'BlockIssuer
hk) Set (KeyHash 'GenesisDelegate)
genDelegs = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
  | Bool
otherwise = Maybe Word64
forall a. Maybe a
Nothing

newtype KESPeriod = KESPeriod {KESPeriod -> Word
unKESPeriod :: Word}
  deriving (KESPeriod -> KESPeriod -> Bool
(KESPeriod -> KESPeriod -> Bool)
-> (KESPeriod -> KESPeriod -> Bool) -> Eq KESPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KESPeriod -> KESPeriod -> Bool
== :: KESPeriod -> KESPeriod -> Bool
$c/= :: KESPeriod -> KESPeriod -> Bool
/= :: KESPeriod -> KESPeriod -> Bool
Eq, (forall x. KESPeriod -> Rep KESPeriod x)
-> (forall x. Rep KESPeriod x -> KESPeriod) -> Generic KESPeriod
forall x. Rep KESPeriod x -> KESPeriod
forall x. KESPeriod -> Rep KESPeriod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KESPeriod -> Rep KESPeriod x
from :: forall x. KESPeriod -> Rep KESPeriod x
$cto :: forall x. Rep KESPeriod x -> KESPeriod
to :: forall x. Rep KESPeriod x -> KESPeriod
Generic, Eq KESPeriod
Eq KESPeriod =>
(KESPeriod -> KESPeriod -> Ordering)
-> (KESPeriod -> KESPeriod -> Bool)
-> (KESPeriod -> KESPeriod -> Bool)
-> (KESPeriod -> KESPeriod -> Bool)
-> (KESPeriod -> KESPeriod -> Bool)
-> (KESPeriod -> KESPeriod -> KESPeriod)
-> (KESPeriod -> KESPeriod -> KESPeriod)
-> Ord KESPeriod
KESPeriod -> KESPeriod -> Bool
KESPeriod -> KESPeriod -> Ordering
KESPeriod -> KESPeriod -> KESPeriod
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KESPeriod -> KESPeriod -> Ordering
compare :: KESPeriod -> KESPeriod -> Ordering
$c< :: KESPeriod -> KESPeriod -> Bool
< :: KESPeriod -> KESPeriod -> Bool
$c<= :: KESPeriod -> KESPeriod -> Bool
<= :: KESPeriod -> KESPeriod -> Bool
$c> :: KESPeriod -> KESPeriod -> Bool
> :: KESPeriod -> KESPeriod -> Bool
$c>= :: KESPeriod -> KESPeriod -> Bool
>= :: KESPeriod -> KESPeriod -> Bool
$cmax :: KESPeriod -> KESPeriod -> KESPeriod
max :: KESPeriod -> KESPeriod -> KESPeriod
$cmin :: KESPeriod -> KESPeriod -> KESPeriod
min :: KESPeriod -> KESPeriod -> KESPeriod
Ord, Context -> KESPeriod -> IO (Maybe ThunkInfo)
Proxy KESPeriod -> String
(Context -> KESPeriod -> IO (Maybe ThunkInfo))
-> (Context -> KESPeriod -> IO (Maybe ThunkInfo))
-> (Proxy KESPeriod -> String)
-> NoThunks KESPeriod
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
noThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy KESPeriod -> String
showTypeOf :: Proxy KESPeriod -> String
NoThunks, Typeable KESPeriod
Typeable KESPeriod =>
(forall s. Decoder s KESPeriod)
-> (forall s. Proxy KESPeriod -> Decoder s ())
-> (Proxy KESPeriod -> Text)
-> DecCBOR KESPeriod
Proxy KESPeriod -> Text
forall s. Decoder s KESPeriod
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy KESPeriod -> Decoder s ()
$cdecCBOR :: forall s. Decoder s KESPeriod
decCBOR :: forall s. Decoder s KESPeriod
$cdropCBOR :: forall s. Proxy KESPeriod -> Decoder s ()
dropCBOR :: forall s. Proxy KESPeriod -> Decoder s ()
$clabel :: Proxy KESPeriod -> Text
label :: Proxy KESPeriod -> Text
DecCBOR, Typeable KESPeriod
Typeable KESPeriod =>
(KESPeriod -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy KESPeriod -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [KESPeriod] -> Size)
-> EncCBOR KESPeriod
KESPeriod -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: KESPeriod -> Encoding
encCBOR :: KESPeriod -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
EncCBOR, Typeable KESPeriod
Typeable KESPeriod =>
(KESPeriod -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy KESPeriod -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [KESPeriod] -> Size)
-> ToCBOR KESPeriod
KESPeriod -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: KESPeriod -> Encoding
toCBOR :: KESPeriod -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
ToCBOR, Typeable KESPeriod
Typeable KESPeriod =>
(forall s. Decoder s KESPeriod)
-> (Proxy KESPeriod -> Text) -> FromCBOR KESPeriod
Proxy KESPeriod -> Text
forall s. Decoder s KESPeriod
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s KESPeriod
fromCBOR :: forall s. Decoder s KESPeriod
$clabel :: Proxy KESPeriod -> Text
label :: Proxy KESPeriod -> Text
FromCBOR)
  deriving (Int -> KESPeriod -> ShowS
[KESPeriod] -> ShowS
KESPeriod -> String
(Int -> KESPeriod -> ShowS)
-> (KESPeriod -> String)
-> ([KESPeriod] -> ShowS)
-> Show KESPeriod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KESPeriod -> ShowS
showsPrec :: Int -> KESPeriod -> ShowS
$cshow :: KESPeriod -> String
show :: KESPeriod -> String
$cshowList :: [KESPeriod] -> ShowS
showList :: [KESPeriod] -> ShowS
Show) via Quiet KESPeriod

data OCert c = OCert
  { forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot :: !(KES.VerKeyKES (KES c))
  -- ^ The operational hot key
  , forall c. OCert c -> Word64
ocertN :: !Word64
  -- ^ counter
  , forall c. OCert c -> KESPeriod
ocertKESPeriod :: !KESPeriod
  -- ^ Start of key evolving signature period
  , forall c. OCert c -> SignedDSIGN DSIGN (OCertSignable c)
ocertSigma :: !(DSIGN.SignedDSIGN DSIGN (OCertSignable c))
  -- ^ Signature of block operational certificate content
  }
  deriving ((forall x. OCert c -> Rep (OCert c) x)
-> (forall x. Rep (OCert c) x -> OCert c) -> Generic (OCert c)
forall x. Rep (OCert c) x -> OCert c
forall x. OCert c -> Rep (OCert c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (OCert c) x -> OCert c
forall c x. OCert c -> Rep (OCert c) x
$cfrom :: forall c x. OCert c -> Rep (OCert c) x
from :: forall x. OCert c -> Rep (OCert c) x
$cto :: forall c x. Rep (OCert c) x -> OCert c
to :: forall x. Rep (OCert c) x -> OCert c
Generic)
  deriving (Typeable (OCert c)
Typeable (OCert c) =>
(OCert c -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (OCert c) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [OCert c] -> Size)
-> EncCBOR (OCert c)
OCert c -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [OCert c] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall c. Crypto c => Typeable (OCert c)
forall c. Crypto c => OCert c -> Encoding
forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [OCert c] -> Size
forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
$cencCBOR :: forall c. Crypto c => OCert c -> Encoding
encCBOR :: OCert c -> Encoding
$cencodedSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
$cencodedListSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [OCert c] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [OCert c] -> Size
EncCBOR) via (CBORGroup (OCert c))
  deriving (Typeable (OCert c)
Typeable (OCert c) =>
(forall s. Decoder s (OCert c))
-> (forall s. Proxy (OCert c) -> Decoder s ())
-> (Proxy (OCert c) -> Text)
-> DecCBOR (OCert c)
Proxy (OCert c) -> Text
forall s. Decoder s (OCert c)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (OCert c) -> Decoder s ()
forall c. Crypto c => Typeable (OCert c)
forall c. Crypto c => Proxy (OCert c) -> Text
forall c s. Crypto c => Decoder s (OCert c)
forall c s. Crypto c => Proxy (OCert c) -> Decoder s ()
$cdecCBOR :: forall c s. Crypto c => Decoder s (OCert c)
decCBOR :: forall s. Decoder s (OCert c)
$cdropCBOR :: forall c s. Crypto c => Proxy (OCert c) -> Decoder s ()
dropCBOR :: forall s. Proxy (OCert c) -> Decoder s ()
$clabel :: forall c. Crypto c => Proxy (OCert c) -> Text
label :: Proxy (OCert c) -> Text
DecCBOR) via (CBORGroup (OCert c))

deriving instance Crypto c => Eq (OCert c)

deriving instance Crypto c => Show (OCert c)

instance Crypto c => NoThunks (OCert c)

-- Serialization of OCerts cannot be versioned, unless it gets parameterized by era.
-- Therefore we use plain encoding for defining the versioned one, instead of the oppoit
-- approach how it is done for types with versioned serialization

instance Crypto c => EncCBORGroup (OCert c) where
  encCBORGroup :: OCert c -> Encoding
encCBORGroup = Encoding -> Encoding
fromPlainEncoding (Encoding -> Encoding)
-> (OCert c -> Encoding) -> OCert c -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert c -> Encoding
forall c. Crypto c => OCert c -> Encoding
encodeOCertFields
  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy (OCert c)
proxy =
    Proxy (VerKeyKES (KES c)) -> Size
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr (OCert c -> VerKeyKES (KES c)
forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot (OCert c -> VerKeyKES (KES c))
-> Proxy (OCert c) -> Proxy (VerKeyKES (KES c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Word -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size (Word64 -> Word
toWord (Word64 -> Word) -> (OCert c -> Word64) -> OCert c -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert c -> Word64
forall c. OCert c -> Word64
ocertN (OCert c -> Word) -> Proxy (OCert c) -> Proxy Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Word -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR t => Proxy t -> Size
size ((\(KESPeriod Word
p) -> Word
p) (KESPeriod -> Word) -> (OCert c -> KESPeriod) -> OCert c -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert c -> KESPeriod
forall c. OCert c -> KESPeriod
ocertKESPeriod (OCert c -> Word) -> Proxy (OCert c) -> Proxy Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (SigDSIGN DSIGN) -> Size
forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr ((\(DSIGN.SignedDSIGN SigDSIGN DSIGN
sig) -> SigDSIGN DSIGN
sig) (SignedDSIGN DSIGN (OCertSignable c) -> SigDSIGN DSIGN)
-> (OCert c -> SignedDSIGN DSIGN (OCertSignable c))
-> OCert c
-> SigDSIGN DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert c -> SignedDSIGN DSIGN (OCertSignable c)
forall c. OCert c -> SignedDSIGN DSIGN (OCertSignable c)
ocertSigma (OCert c -> SigDSIGN DSIGN)
-> Proxy (OCert c) -> Proxy (SigDSIGN DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
    where
      toWord :: Word64 -> Word
      toWord :: Word64 -> Word
toWord = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral

  listLen :: OCert c -> Word
listLen OCert c
_ = Word
4
  listLenBound :: Proxy (OCert c) -> Word
listLenBound Proxy (OCert c)
_ = Word
4

instance Crypto c => DecCBORGroup (OCert c) where
  decCBORGroup :: forall s. Decoder s (OCert c)
decCBORGroup = Decoder s (OCert c) -> Decoder s (OCert c)
forall s a. Decoder s a -> Decoder s a
fromPlainDecoder Decoder s (OCert c)
forall c s. Crypto c => Decoder s (OCert c)
decodeOCertFields

instance Crypto c => ToCBOR (OCert c) where
  toCBOR :: OCert c -> Encoding
toCBOR OCert c
ocert = Word -> Encoding
Plain.encodeListLen (OCert c -> Word
forall a. EncCBORGroup a => a -> Word
listLen OCert c
ocert) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> OCert c -> Encoding
forall c. Crypto c => OCert c -> Encoding
encodeOCertFields OCert c
ocert

instance Crypto c => FromCBOR (OCert c) where
  fromCBOR :: forall s. Decoder s (OCert c)
fromCBOR =
    Text
-> (OCert c -> Int) -> Decoder s (OCert c) -> Decoder s (OCert c)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
Plain.decodeRecordNamed Text
"OCert" (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> (OCert c -> Word) -> OCert c -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert c -> Word
forall a. EncCBORGroup a => a -> Word
listLen) Decoder s (OCert c)
forall c s. Crypto c => Decoder s (OCert c)
decodeOCertFields

encodeOCertFields :: Crypto c => OCert c -> Plain.Encoding
encodeOCertFields :: forall c. Crypto c => OCert c -> Encoding
encodeOCertFields OCert c
ocert =
  VerKeyKES (KES c) -> Encoding
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
KES.encodeVerKeyKES (OCert c -> VerKeyKES (KES c)
forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot OCert c
ocert)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
Plain.toCBOR (OCert c -> Word64
forall c. OCert c -> Word64
ocertN OCert c
ocert)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KESPeriod -> Encoding
forall a. ToCBOR a => a -> Encoding
Plain.toCBOR (OCert c -> KESPeriod
forall c. OCert c -> KESPeriod
ocertKESPeriod OCert c
ocert)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedDSIGN DSIGN (OCertSignable c) -> Encoding
forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
DSIGN.encodeSignedDSIGN (OCert c -> SignedDSIGN DSIGN (OCertSignable c)
forall c. OCert c -> SignedDSIGN DSIGN (OCertSignable c)
ocertSigma OCert c
ocert)

decodeOCertFields :: Crypto c => Plain.Decoder s (OCert c)
decodeOCertFields :: forall c s. Crypto c => Decoder s (OCert c)
decodeOCertFields =
  VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
forall c.
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
OCert
    (VerKeyKES (KES c)
 -> Word64
 -> KESPeriod
 -> SignedDSIGN DSIGN (OCertSignable c)
 -> OCert c)
-> Decoder s (VerKeyKES (KES c))
-> Decoder
     s
     (Word64
      -> KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VerKeyKES (KES c))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
KES.decodeVerKeyKES
    Decoder
  s
  (Word64
   -> KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Decoder s Word64
-> Decoder
     s (KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall s. Decoder s Word64
forall a s. FromCBOR a => Decoder s a
Plain.fromCBOR
    Decoder
  s (KESPeriod -> SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Decoder s KESPeriod
-> Decoder s (SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s KESPeriod
forall s. Decoder s KESPeriod
forall a s. FromCBOR a => Decoder s a
Plain.fromCBOR
    Decoder s (SignedDSIGN DSIGN (OCertSignable c) -> OCert c)
-> Decoder s (SignedDSIGN DSIGN (OCertSignable c))
-> Decoder s (OCert c)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (SignedDSIGN DSIGN (OCertSignable c))
forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
DSIGN.decodeSignedDSIGN

kesPeriod :: SlotNo -> ShelleyBase KESPeriod
kesPeriod :: SlotNo -> ShelleyBase KESPeriod
kesPeriod (SlotNo Word64
s) =
  (Globals -> Word64) -> ReaderT Globals Identity Word64
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Word64
slotsPerKESPeriod ReaderT Globals Identity Word64
-> (Word64 -> KESPeriod) -> ShelleyBase KESPeriod
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word64
spkp ->
    if Word64
spkp Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
      then String -> KESPeriod
forall a. HasCallStack => String -> a
error String
"kesPeriod: slots per KES period was set to zero"
      else Word -> KESPeriod
KESPeriod (Word -> KESPeriod) -> (Word64 -> Word) -> Word64 -> KESPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> KESPeriod) -> Word64 -> KESPeriod
forall a b. (a -> b) -> a -> b
$ Word64
s Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
spkp

-- | Signable part of an operational certificate
data OCertSignable c
  = OCertSignable !(KES.VerKeyKES (KES c)) !Word64 !KESPeriod

instance Crypto c => SignableRepresentation (OCertSignable c) where
  getSignableRepresentation :: OCertSignable c -> ByteString
getSignableRepresentation (OCertSignable VerKeyKES (KES c)
vk Word64
counter KESPeriod
period) =
    Int -> Builder -> ByteString
runByteBuilder
      ( Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$
          Proxy (KES c) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
KES.sizeVerKeyKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(KES c))
            Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
8
            Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
8
      )
      (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
BS.byteStringCopy (VerKeyKES (KES c) -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
KES.rawSerialiseVerKeyKES VerKeyKES (KES c)
vk)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BS.word64BE Word64
counter
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BS.word64BE (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> Word -> Word64
forall a b. (a -> b) -> a -> b
$ KESPeriod -> Word
unKESPeriod KESPeriod
period)

-- | Extract the signable part of an operational certificate (for verification)
ocertToSignable :: OCert c -> OCertSignable c
ocertToSignable :: forall c. OCert c -> OCertSignable c
ocertToSignable OCert {VerKeyKES (KES c)
ocertVkHot :: forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot :: VerKeyKES (KES c)
ocertVkHot, Word64
ocertN :: forall c. OCert c -> Word64
ocertN :: Word64
ocertN, KESPeriod
ocertKESPeriod :: forall c. OCert c -> KESPeriod
ocertKESPeriod :: KESPeriod
ocertKESPeriod} =
  VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
forall c.
VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
OCertSignable VerKeyKES (KES c)
ocertVkHot Word64
ocertN KESPeriod
ocertKESPeriod