{-# 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 Cardano.Binary (FromCBOR (..), ToCBOR (..), toCBOR)
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.Crypto (Crypto, KES)
import Cardano.Ledger.Keys
  ( KeyHash,
    KeyRole (..),
    SignedDSIGN,
    VerKeyKES,
    coerceKeyRole,
    decodeSignedDSIGN,
    decodeVerKeyKES,
    encodeSignedDSIGN,
    encodeVerKeyKES,
  )
import Cardano.Ledger.Serialization
  ( CBORGroup (..),
    FromCBORGroup (..),
    ToCBORGroup (..),
    runByteBuilder,
  )
import Cardano.Ledger.Slot (SlotNo (..))
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 crypto = OCertEnv
  { OCertEnv crypto -> Set (KeyHash 'StakePool crypto)
ocertEnvStPools :: Set (KeyHash 'StakePool crypto),
    OCertEnv crypto -> Set (KeyHash 'GenesisDelegate crypto)
ocertEnvGenDelegs :: Set (KeyHash 'GenesisDelegate crypto)
  }
  deriving (Int -> OCertEnv crypto -> ShowS
[OCertEnv crypto] -> ShowS
OCertEnv crypto -> String
(Int -> OCertEnv crypto -> ShowS)
-> (OCertEnv crypto -> String)
-> ([OCertEnv crypto] -> ShowS)
-> Show (OCertEnv crypto)
forall crypto. Int -> OCertEnv crypto -> ShowS
forall crypto. [OCertEnv crypto] -> ShowS
forall crypto. OCertEnv crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OCertEnv crypto] -> ShowS
$cshowList :: forall crypto. [OCertEnv crypto] -> ShowS
show :: OCertEnv crypto -> String
$cshow :: forall crypto. OCertEnv crypto -> String
showsPrec :: Int -> OCertEnv crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> OCertEnv crypto -> ShowS
Show, OCertEnv crypto -> OCertEnv crypto -> Bool
(OCertEnv crypto -> OCertEnv crypto -> Bool)
-> (OCertEnv crypto -> OCertEnv crypto -> Bool)
-> Eq (OCertEnv crypto)
forall crypto. OCertEnv crypto -> OCertEnv crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OCertEnv crypto -> OCertEnv crypto -> Bool
$c/= :: forall crypto. OCertEnv crypto -> OCertEnv crypto -> Bool
== :: OCertEnv crypto -> OCertEnv crypto -> Bool
$c== :: forall crypto. OCertEnv crypto -> OCertEnv crypto -> Bool
Eq)

currentIssueNo ::
  OCertEnv crypto ->
  Map (KeyHash 'BlockIssuer crypto) Word64 ->
  -- | Pool hash
  KeyHash 'BlockIssuer crypto ->
  Maybe Word64
currentIssueNo :: OCertEnv crypto
-> Map (KeyHash 'BlockIssuer crypto) Word64
-> KeyHash 'BlockIssuer crypto
-> Maybe Word64
currentIssueNo (OCertEnv Set (KeyHash 'StakePool crypto)
stPools Set (KeyHash 'GenesisDelegate crypto)
genDelegs) Map (KeyHash 'BlockIssuer crypto) Word64
cs KeyHash 'BlockIssuer crypto
hk
  | KeyHash 'BlockIssuer crypto
-> Map (KeyHash 'BlockIssuer crypto) Word64 -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member KeyHash 'BlockIssuer crypto
hk Map (KeyHash 'BlockIssuer crypto) Word64
cs = KeyHash 'BlockIssuer crypto
-> Map (KeyHash 'BlockIssuer crypto) Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'BlockIssuer crypto
hk Map (KeyHash 'BlockIssuer crypto) Word64
cs
  | KeyHash 'StakePool crypto
-> Set (KeyHash 'StakePool crypto) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (KeyHash 'BlockIssuer crypto -> KeyHash 'StakePool crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
coerceKeyRole KeyHash 'BlockIssuer crypto
hk) Set (KeyHash 'StakePool crypto)
stPools = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
  | KeyHash 'GenesisDelegate crypto
-> Set (KeyHash 'GenesisDelegate crypto) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (KeyHash 'BlockIssuer crypto -> KeyHash 'GenesisDelegate crypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
coerceKeyRole KeyHash 'BlockIssuer crypto
hk) Set (KeyHash 'GenesisDelegate crypto)
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
/= :: KESPeriod -> KESPeriod -> Bool
$c/= :: KESPeriod -> KESPeriod -> Bool
== :: KESPeriod -> KESPeriod -> Bool
$c== :: 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
$cto :: forall x. Rep KESPeriod x -> KESPeriod
$cfrom :: forall x. KESPeriod -> Rep KESPeriod x
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
min :: KESPeriod -> KESPeriod -> KESPeriod
$cmin :: KESPeriod -> KESPeriod -> KESPeriod
max :: KESPeriod -> KESPeriod -> KESPeriod
$cmax :: KESPeriod -> KESPeriod -> KESPeriod
>= :: KESPeriod -> KESPeriod -> Bool
$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
compare :: KESPeriod -> KESPeriod -> Ordering
$ccompare :: KESPeriod -> KESPeriod -> Ordering
$cp1Ord :: Eq 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
showTypeOf :: Proxy KESPeriod -> String
$cshowTypeOf :: Proxy KESPeriod -> String
wNoThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
noThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> KESPeriod -> IO (Maybe ThunkInfo)
NoThunks, Typeable KESPeriod
Decoder s 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
label :: Proxy KESPeriod -> Text
$clabel :: Proxy KESPeriod -> Text
fromCBOR :: Decoder s KESPeriod
$cfromCBOR :: forall s. Decoder s KESPeriod
$cp1FromCBOR :: Typeable KESPeriod
FromCBOR, 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
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
toCBOR :: KESPeriod -> Encoding
$ctoCBOR :: KESPeriod -> Encoding
$cp1ToCBOR :: Typeable KESPeriod
ToCBOR)
  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
showList :: [KESPeriod] -> ShowS
$cshowList :: [KESPeriod] -> ShowS
show :: KESPeriod -> String
$cshow :: KESPeriod -> String
showsPrec :: Int -> KESPeriod -> ShowS
$cshowsPrec :: Int -> KESPeriod -> ShowS
Show) via Quiet KESPeriod

data OCert crypto = OCert
  { -- | The operational hot key
    OCert crypto -> VerKeyKES crypto
ocertVkHot :: !(VerKeyKES crypto),
    -- | counter
    OCert crypto -> Word64
ocertN :: !Word64,
    -- | Start of key evolving signature period
    OCert crypto -> KESPeriod
ocertKESPeriod :: !KESPeriod,
    -- | Signature of block operational certificate content
    OCert crypto -> SignedDSIGN crypto (OCertSignable crypto)
ocertSigma :: !(SignedDSIGN crypto (OCertSignable crypto))
  }
  deriving ((forall x. OCert crypto -> Rep (OCert crypto) x)
-> (forall x. Rep (OCert crypto) x -> OCert crypto)
-> Generic (OCert crypto)
forall x. Rep (OCert crypto) x -> OCert crypto
forall x. OCert crypto -> Rep (OCert crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (OCert crypto) x -> OCert crypto
forall crypto x. OCert crypto -> Rep (OCert crypto) x
$cto :: forall crypto x. Rep (OCert crypto) x -> OCert crypto
$cfrom :: forall crypto x. OCert crypto -> Rep (OCert crypto) x
Generic)
  deriving (Typeable (OCert crypto)
Typeable (OCert crypto)
-> (OCert crypto -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (OCert crypto) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [OCert crypto] -> Size)
-> ToCBOR (OCert crypto)
OCert crypto -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [OCert crypto] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (OCert crypto) -> 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
forall crypto. Crypto crypto => Typeable (OCert crypto)
forall crypto. Crypto crypto => OCert crypto -> Encoding
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [OCert crypto] -> Size
forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (OCert crypto) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [OCert crypto] -> Size
$cencodedListSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [OCert crypto] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (OCert crypto) -> Size
$cencodedSizeExpr :: forall crypto.
Crypto crypto =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (OCert crypto) -> Size
toCBOR :: OCert crypto -> Encoding
$ctoCBOR :: forall crypto. Crypto crypto => OCert crypto -> Encoding
$cp1ToCBOR :: forall crypto. Crypto crypto => Typeable (OCert crypto)
ToCBOR) via (CBORGroup (OCert crypto))

deriving instance Crypto crypto => Eq (OCert crypto)

deriving instance Crypto crypto => Show (OCert crypto)

instance Crypto crypto => NoThunks (OCert crypto)

instance
  (Crypto crypto) =>
  ToCBORGroup (OCert crypto)
  where
  toCBORGroup :: OCert crypto -> Encoding
toCBORGroup OCert crypto
ocert =
    VerKeyKES (KES crypto) -> Encoding
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
encodeVerKeyKES (OCert crypto -> VerKeyKES (KES crypto)
forall crypto. OCert crypto -> VerKeyKES crypto
ocertVkHot OCert crypto
ocert)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (OCert crypto -> Word64
forall crypto. OCert crypto -> Word64
ocertN OCert crypto
ocert)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KESPeriod -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (OCert crypto -> KESPeriod
forall crypto. OCert crypto -> KESPeriod
ocertKESPeriod OCert crypto
ocert)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignedDSIGN (DSIGN crypto) (OCertSignable crypto) -> Encoding
forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
encodeSignedDSIGN (OCert crypto -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
forall crypto.
OCert crypto -> SignedDSIGN crypto (OCertSignable crypto)
ocertSigma OCert crypto
ocert)
  encodedGroupSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (OCert crypto) -> Size
encodedGroupSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (OCert crypto)
proxy =
    Proxy (VerKeyKES (KES crypto)) -> Size
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
KES.encodedVerKeyKESSizeExpr (OCert crypto -> VerKeyKES (KES crypto)
forall crypto. OCert crypto -> VerKeyKES crypto
ocertVkHot (OCert crypto -> VerKeyKES (KES crypto))
-> Proxy (OCert crypto) -> Proxy (VerKeyKES (KES crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Word64 -> Word
toWord (Word64 -> Word)
-> (OCert crypto -> Word64) -> OCert crypto -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert crypto -> Word64
forall crypto. OCert crypto -> Word64
ocertN (OCert crypto -> Word) -> Proxy (OCert crypto) -> Proxy Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size ((\(KESPeriod Word
p) -> Word
p) (KESPeriod -> Word)
-> (OCert crypto -> KESPeriod) -> OCert crypto -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert crypto -> KESPeriod
forall crypto. OCert crypto -> KESPeriod
ocertKESPeriod (OCert crypto -> Word) -> Proxy (OCert crypto) -> Proxy Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert crypto)
proxy)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (SigDSIGN (DSIGN crypto)) -> Size
forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
DSIGN.encodedSigDSIGNSizeExpr ((\(DSIGN.SignedDSIGN SigDSIGN (DSIGN crypto)
sig) -> SigDSIGN (DSIGN crypto)
sig) (SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
 -> SigDSIGN (DSIGN crypto))
-> (OCert crypto
    -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto))
-> OCert crypto
-> SigDSIGN (DSIGN crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCert crypto -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
forall crypto.
OCert crypto -> SignedDSIGN crypto (OCertSignable crypto)
ocertSigma (OCert crypto -> SigDSIGN (DSIGN crypto))
-> Proxy (OCert crypto) -> Proxy (SigDSIGN (DSIGN crypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert crypto)
proxy)
    where
      toWord :: Word64 -> Word
      toWord :: Word64 -> Word
toWord = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

instance
  (Crypto crypto) =>
  FromCBORGroup (OCert crypto)
  where
  fromCBORGroup :: Decoder s (OCert crypto)
fromCBORGroup =
    VerKeyKES (KES crypto)
-> Word64
-> KESPeriod
-> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
-> OCert crypto
forall crypto.
VerKeyKES crypto
-> Word64
-> KESPeriod
-> SignedDSIGN crypto (OCertSignable crypto)
-> OCert crypto
OCert
      (VerKeyKES (KES crypto)
 -> Word64
 -> KESPeriod
 -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
 -> OCert crypto)
-> Decoder s (VerKeyKES (KES crypto))
-> Decoder
     s
     (Word64
      -> KESPeriod
      -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
      -> OCert crypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VerKeyKES (KES crypto))
forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
decodeVerKeyKES
      Decoder
  s
  (Word64
   -> KESPeriod
   -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
   -> OCert crypto)
-> Decoder s Word64
-> Decoder
     s
     (KESPeriod
      -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
      -> OCert crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (KESPeriod
   -> SignedDSIGN (DSIGN crypto) (OCertSignable crypto)
   -> OCert crypto)
-> Decoder s KESPeriod
-> Decoder
     s
     (SignedDSIGN (DSIGN crypto) (OCertSignable crypto) -> OCert crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s KESPeriod
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (SignedDSIGN (DSIGN crypto) (OCertSignable crypto) -> OCert crypto)
-> Decoder s (SignedDSIGN (DSIGN crypto) (OCertSignable crypto))
-> Decoder s (OCert crypto)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (SignedDSIGN (DSIGN crypto) (OCertSignable crypto))
forall v s a. DSIGNAlgorithm v => Decoder s (SignedDSIGN v a)
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 crypto
  = OCertSignable !(VerKeyKES crypto) !Word64 !KESPeriod

instance
  forall crypto.
  Crypto crypto =>
  SignableRepresentation (OCertSignable crypto)
  where
  getSignableRepresentation :: OCertSignable crypto -> ByteString
getSignableRepresentation (OCertSignable VerKeyKES crypto
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 crypto) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
KES.sizeVerKeyKES (Proxy (KES crypto)
forall k (t :: k). Proxy t
Proxy @(KES crypto))
            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 crypto -> ByteString
forall v. KESAlgorithm v => VerKeyKES v -> ByteString
KES.rawSerialiseVerKeyKES VerKeyKES crypto
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 crypto -> OCertSignable crypto
ocertToSignable :: OCert crypto -> OCertSignable crypto
ocertToSignable OCert {VerKeyKES crypto
ocertVkHot :: VerKeyKES crypto
ocertVkHot :: forall crypto. OCert crypto -> VerKeyKES crypto
ocertVkHot, Word64
ocertN :: Word64
ocertN :: forall crypto. OCert crypto -> Word64
ocertN, KESPeriod
ocertKESPeriod :: KESPeriod
ocertKESPeriod :: forall crypto. OCert crypto -> KESPeriod
ocertKESPeriod} =
  VerKeyKES crypto -> Word64 -> KESPeriod -> OCertSignable crypto
forall crypto.
VerKeyKES crypto -> Word64 -> KESPeriod -> OCertSignable crypto
OCertSignable VerKeyKES crypto
ocertVkHot Word64
ocertN KESPeriod
ocertKESPeriod