{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OCertEnv] -> ShowS
$cshowList :: [OCertEnv] -> ShowS
show :: OCertEnv -> String
$cshow :: OCertEnv -> String
showsPrec :: Int -> OCertEnv -> ShowS
$cshowsPrec :: Int -> OCertEnv -> ShowS
Show, OCertEnv -> OCertEnv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OCertEnv -> OCertEnv -> Bool
$c/= :: OCertEnv -> OCertEnv -> Bool
== :: OCertEnv -> OCertEnv -> Bool
$c== :: OCertEnv -> OCertEnv -> Bool
Eq)
currentIssueNo ::
OCertEnv ->
Map (KeyHash 'BlockIssuer) Word64 ->
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
| forall k a. Ord k => k -> Map k a -> Bool
Map.member KeyHash 'BlockIssuer
hk Map (KeyHash 'BlockIssuer) Word64
cs = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'BlockIssuer
hk Map (KeyHash 'BlockIssuer) Word64
cs
| forall a. Ord a => a -> Set a -> Bool
Set.member (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole KeyHash 'BlockIssuer
hk) Set (KeyHash 'StakePool)
stPools = forall a. a -> Maybe a
Just Word64
0
| forall a. Ord a => a -> Set a -> Bool
Set.member (forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole KeyHash 'BlockIssuer
hk) Set (KeyHash 'GenesisDelegate)
genDelegs = forall a. a -> Maybe a
Just Word64
0
| Bool
otherwise = forall a. Maybe a
Nothing
newtype KESPeriod = KESPeriod {KESPeriod -> Word
unKESPeriod :: Word}
deriving (KESPeriod -> KESPeriod -> Bool
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. 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
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
Ord, Context -> KESPeriod -> IO (Maybe ThunkInfo)
Proxy KESPeriod -> String
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
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 ()
label :: Proxy KESPeriod -> Text
$clabel :: Proxy KESPeriod -> Text
dropCBOR :: forall s. Proxy KESPeriod -> Decoder s ()
$cdropCBOR :: forall s. Proxy KESPeriod -> Decoder s ()
decCBOR :: forall s. Decoder s KESPeriod
$cdecCBOR :: forall s. Decoder s KESPeriod
DecCBOR, Typeable 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
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [KESPeriod] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy KESPeriod -> Size
encCBOR :: KESPeriod -> Encoding
$cencCBOR :: KESPeriod -> Encoding
EncCBOR, Typeable 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
ToCBOR, Typeable 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 :: forall s. Decoder s KESPeriod
$cfromCBOR :: forall s. Decoder s KESPeriod
FromCBOR)
deriving (Int -> KESPeriod -> ShowS
[KESPeriod] -> ShowS
KESPeriod -> String
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 c = OCert
{ forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot :: !(KES.VerKeyKES (KES c))
, forall c. OCert c -> Word64
ocertN :: !Word64
, forall c. OCert c -> KESPeriod
ocertKESPeriod :: !KESPeriod
, forall c. OCert c -> SignedDSIGN DSIGN (OCertSignable c)
ocertSigma :: !(DSIGN.SignedDSIGN DSIGN (OCertSignable c))
}
deriving (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
$cto :: forall c x. Rep (OCert c) x -> OCert c
$cfrom :: forall c x. OCert c -> Rep (OCert c) x
Generic)
deriving (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
encodedListSizeExpr :: (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
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
$cencodedSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy (OCert c) -> Size
encCBOR :: OCert c -> Encoding
$cencCBOR :: forall c. Crypto c => OCert c -> Encoding
EncCBOR) via (CBORGroup (OCert c))
deriving instance Crypto c => Eq (OCert c)
deriving instance Crypto c => Show (OCert c)
instance Crypto c => NoThunks (OCert c)
instance Crypto c => EncCBORGroup (OCert c) where
encCBORGroup :: OCert c -> Encoding
encCBORGroup = Encoding -> Encoding
fromPlainEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size
encodedVerKeyKESSizeExpr (forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (Word64 -> Word
toWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. OCert c -> Word64
ocertN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size ((\(KESPeriod Word
p) -> Word
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. OCert c -> KESPeriod
ocertKESPeriod forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
forall a. Num a => a -> a -> a
+ forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size
encodedSigDSIGNSizeExpr ((\(DSIGN.SignedDSIGN SigDSIGN DSIGN
sig) -> SigDSIGN DSIGN
sig) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. OCert c -> SignedDSIGN DSIGN (OCertSignable c)
ocertSigma forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (OCert c)
proxy)
where
toWord :: Word64 -> Word
toWord :: Word64 -> Word
toWord = 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 = forall s a. Decoder s a -> Decoder s a
fromPlainDecoder 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 (forall a. EncCBORGroup a => a -> Word
listLen OCert c
ocert) forall a. Semigroup a => a -> a -> a
<> 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 =
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
Plain.decodeRecordNamed Text
"OCert" (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBORGroup a => a -> Word
listLen) 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 =
forall v. KESAlgorithm v => VerKeyKES v -> Encoding
KES.encodeVerKeyKES (forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot OCert c
ocert)
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
Plain.toCBOR (forall c. OCert c -> Word64
ocertN OCert c
ocert)
forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
Plain.toCBOR (forall c. OCert c -> KESPeriod
ocertKESPeriod OCert c
ocert)
forall a. Semigroup a => a -> a -> a
<> forall v a. DSIGNAlgorithm v => SignedDSIGN v a -> Encoding
DSIGN.encodeSignedDSIGN (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 =
forall c.
VerKeyKES (KES c)
-> Word64
-> KESPeriod
-> SignedDSIGN DSIGN (OCertSignable c)
-> OCert c
OCert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v s. KESAlgorithm v => Decoder s (VerKeyKES v)
KES.decodeVerKeyKES
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. FromCBOR a => Decoder s a
Plain.fromCBOR
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. FromCBOR a => Decoder s a
Plain.fromCBOR
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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) =
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Word64
slotsPerKESPeriod forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word64
spkp ->
if Word64
spkp forall a. Eq a => a -> a -> Bool
== Word64
0
then forall a. HasCallStack => String -> a
error String
"kesPeriod: slots per KES period was set to zero"
else Word -> KESPeriod
KESPeriod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
s forall a. Integral a => a -> a -> a
`div` Word64
spkp
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
( forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
KES.sizeVerKeyKES (forall {k} (t :: k). Proxy t
Proxy @(KES c))
forall a. Num a => a -> a -> a
+ Word
8
forall a. Num a => a -> a -> a
+ Word
8
)
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
BS.byteStringCopy (forall v. KESAlgorithm v => VerKeyKES v -> ByteString
KES.rawSerialiseVerKeyKES VerKeyKES (KES c)
vk)
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BS.word64BE Word64
counter
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BS.word64BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ KESPeriod -> Word
unKESPeriod KESPeriod
period)
ocertToSignable :: OCert c -> OCertSignable c
ocertToSignable :: forall c. OCert c -> OCertSignable c
ocertToSignable OCert {VerKeyKES (KES c)
ocertVkHot :: VerKeyKES (KES c)
ocertVkHot :: forall c. OCert c -> VerKeyKES (KES c)
ocertVkHot, Word64
ocertN :: Word64
ocertN :: forall c. OCert c -> Word64
ocertN, KESPeriod
ocertKESPeriod :: KESPeriod
ocertKESPeriod :: forall c. OCert c -> KESPeriod
ocertKESPeriod} =
forall c.
VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
OCertSignable VerKeyKES (KES c)
ocertVkHot Word64
ocertN KESPeriod
ocertKESPeriod