cbor instances for NewEpochState

cabal.project

@@ -12,19 +12,19 @@ constraints:
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 53d773907edea2fdcf65cebeb81ab5e47eeab805
+  tag: 0fcb3a306e96ce36fca75d62792c55ab1de871ea
   subdir: binary
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 53d773907edea2fdcf65cebeb81ab5e47eeab805
+  tag: 0fcb3a306e96ce36fca75d62792c55ab1de871ea
   subdir: cardano-crypto-class
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 0fc0af253df8be5ca6bf60c92bcd2e514b40a47c
+  tag: 0fcb3a306e96ce36fca75d62792c55ab1de871ea
   subdir: slotting
 
 source-repository-package

shelley/chain-and-ledger/executable-spec/src/Delegation/Certificates.hs

@@ -31,6 +31,7 @@ module Delegation.Certificates
   ) where
 
 import           BaseTypes (FixedPoint, UnitInterval, fpEpsilon, intervalValue)
+import           Cardano.Binary (FromCBOR (..), ToCBOR (..))
 import           Cardano.Ledger.Shelley.Crypto
 import           Coin (Coin (..))
 import           Keys (GenKeyHash, Hash, KeyHash, VRFAlgorithm (VerKeyVRF))
@@ -121,7 +122,7 @@ decayPool pc = (pval, pmin, lambdap)
 
 newtype PoolDistr crypto=
   PoolDistr (Map (KeyHash crypto) (Rational, Hash (HASH crypto) (VerKeyVRF (VRF crypto))))
-  deriving (Show, Eq, NoUnexpectedThunks, Relation)
+  deriving (Show, Eq, ToCBOR, FromCBOR, NoUnexpectedThunks, Relation)
 
 isInstantaneousRewards :: DCert crypto-> Bool
 isInstantaneousRewards (DCertMir _) = True

shelley/chain-and-ledger/executable-spec/src/EpochBoundary.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
@@ -41,6 +42,8 @@ import           Slot (SlotNo, (-*))
 import           TxData (Addr (..), Credential, PoolParams, Ptr, RewardAcnt, TxOut (..), getRwdCred)
 import           UTxO (UTxO (..))
 
+import           Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize)
+import           Cardano.Ledger.Shelley.Crypto
 import           Cardano.Prelude (NoUnexpectedThunks (..))
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -57,12 +60,12 @@ import           Ledger.Core (dom, (▷), (◁))
 -- | Blocks made
 newtype BlocksMade crypto
   = BlocksMade (Map (KeyHash crypto) Natural)
-  deriving (Show, Eq, NoUnexpectedThunks)
+  deriving (Show, Eq, ToCBOR, FromCBOR, NoUnexpectedThunks)
 
 -- | Type of stake as map from hash key to coins associated.
 newtype Stake crypto
   = Stake (Map (Credential crypto) Coin)
-  deriving (Show, Eq, Ord, NoUnexpectedThunks)
+  deriving (Show, Eq, Ord, ToCBOR, FromCBOR, NoUnexpectedThunks)
 
 -- | Add two stake distributions
 (⊎)
@@ -211,6 +214,31 @@ data SnapShots crypto
 
 instance NoUnexpectedThunks (SnapShots crypto)
 
+instance
+  Crypto crypto
+  => ToCBOR (SnapShots crypto)
+  where
+    toCBOR (SnapShots mark set go ps fs) =
+      encodeListLen 5
+      <> toCBOR mark
+      <> toCBOR set
+      <> toCBOR go
+      <> toCBOR ps
+      <> toCBOR fs
+
+instance
+  Crypto crypto
+  => FromCBOR (SnapShots crypto)
+  where
+    fromCBOR = do
+      enforceSize "SnapShots" 5
+      mark <- fromCBOR
+      set <- fromCBOR
+      go <- fromCBOR
+      ps <- fromCBOR
+      f <- fromCBOR
+      pure $ SnapShots mark set go ps f
+
 makeLenses ''SnapShots
 
 emptySnapShots :: SnapShots crypto

shelley/chain-and-ledger/executable-spec/src/Keys.hs

@@ -216,7 +216,7 @@ verifyKES (VKeyES vKeyES) vd (KESig sigKES) n =
 
 newtype GenDelegs crypto =
   GenDelegs (Map (GenKeyHash crypto) (KeyHash crypto))
-  deriving (Show, Eq, NoUnexpectedThunks)
+  deriving (Show, Eq, ToCBOR, FromCBOR, NoUnexpectedThunks)
 
 newtype GKeys crypto = GKeys (Set (VKeyGenesis crypto))
   deriving (Show, Eq, NoUnexpectedThunks)

shelley/chain-and-ledger/executable-spec/src/LedgerState.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
@@ -97,6 +98,7 @@ module LedgerState
   ) where
 
 import           Address (mkRwdAcnt)
+import           Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, enforceSize)
 import           Cardano.Ledger.Shelley.Crypto
 import           Cardano.Prelude (NoUnexpectedThunks (..))
 import           Coin (Coin (..))
@@ -180,6 +182,25 @@ data DState crypto = DState
 
 instance NoUnexpectedThunks (DState crypto)
 
+instance Crypto crypto => ToCBOR (DState crypto)
+ where
+  toCBOR (DState sc rw dlg p fgs gs ir) =
+    encodeListLen 7 <> toCBOR sc <> toCBOR rw <> toCBOR dlg <> toCBOR p
+      <> toCBOR fgs <> toCBOR gs <> toCBOR ir
+
+instance Crypto crypto => FromCBOR (DState crypto)
+ where
+  fromCBOR = do
+    enforceSize "DState" 7
+    sc <- fromCBOR
+    rw <- fromCBOR
+    dlg <- fromCBOR
+    p <- fromCBOR
+    fgs <- fromCBOR
+    gs <- fromCBOR
+    ir <- fromCBOR
+    pure $ DState sc rw dlg p fgs gs ir
+
 -- | Current state of staking pools and their certificate counters.
 data PState crypto = PState
     { -- |The active stake pools.
@@ -192,6 +213,20 @@ data PState crypto = PState
 
 instance NoUnexpectedThunks (PState crypto)
 
+instance Crypto crypto => ToCBOR (PState crypto)
+ where
+  toCBOR (PState a b c) =
+    encodeListLen 3 <> toCBOR a <> toCBOR b <> toCBOR c
+
+instance Crypto crypto => FromCBOR (PState crypto)
+ where
+  fromCBOR = do
+    enforceSize "PState" 3
+    a <- fromCBOR
+    b <- fromCBOR
+    c <- fromCBOR
+    pure $ PState a b c
+
 -- | The state associated with the current stake delegation.
 data DPState crypto =
     DPState
@@ -202,6 +237,19 @@ data DPState crypto =
 
 instance NoUnexpectedThunks (DPState crypto)
 
+instance Crypto crypto => ToCBOR (DPState crypto)
+ where
+  toCBOR (DPState ds ps) =
+    encodeListLen 2 <> toCBOR ds <> toCBOR ps
+
+instance Crypto crypto => FromCBOR (DPState crypto)
+ where
+  fromCBOR = do
+    enforceSize "DPState" 2
+    ds <- fromCBOR
+    ps <- fromCBOR
+    pure $ DPState ds ps
+
 data RewardUpdate crypto= RewardUpdate
   { deltaT        :: Coin
   , deltaR        :: Coin
@@ -212,6 +260,27 @@ data RewardUpdate crypto= RewardUpdate
 
 instance NoUnexpectedThunks (RewardUpdate crypto)
 
+instance Crypto crypto => ToCBOR (RewardUpdate crypto)
+ where
+  toCBOR (RewardUpdate dt dr rw df irw) =
+    encodeListLen 5
+      <> toCBOR dt
+      <> toCBOR (-dr) -- TODO change Coin serialization to use integers?
+      <> toCBOR rw
+      <> toCBOR (-df) -- TODO change Coin serialization to use integers?
+      <> toCBOR irw
+
+instance Crypto crypto => FromCBOR (RewardUpdate crypto)
+ where
+  fromCBOR = do
+    enforceSize "RewardUpdate" 5
+    dt <- fromCBOR
+    dr <- fromCBOR -- TODO change Coin serialization to use integers?
+    rw <- fromCBOR
+    df <- fromCBOR -- TODO change Coin serialization to use integers?
+    irw <- fromCBOR
+    pure $ RewardUpdate dt (-dr) rw (-df) irw
+
 emptyRewardUpdate :: RewardUpdate crypto
 emptyRewardUpdate = RewardUpdate (Coin 0) (Coin 0) Map.empty (Coin 0) Map.empty
 
@@ -220,6 +289,19 @@ data AccountState = AccountState
   , _reserves  :: Coin
   } deriving (Show, Eq, Generic)
 
+instance ToCBOR AccountState
+ where
+  toCBOR (AccountState t r) =
+    encodeListLen 2 <> toCBOR t <> toCBOR r
+
+instance FromCBOR AccountState
+ where
+  fromCBOR = do
+    enforceSize "AccountState" 2
+    t <- fromCBOR
+    r <- fromCBOR
+    pure $ AccountState t r
+
 instance NoUnexpectedThunks AccountState
 
 data EpochState crypto
@@ -233,6 +315,21 @@ data EpochState crypto
 
 instance NoUnexpectedThunks (EpochState crypto)
 
+instance Crypto crypto => ToCBOR (EpochState crypto)
+ where
+  toCBOR (EpochState a s l p) =
+    encodeListLen 4 <> toCBOR a <> toCBOR s <> toCBOR l <> toCBOR p
+
+instance Crypto crypto => FromCBOR (EpochState crypto)
+ where
+  fromCBOR = do
+    enforceSize "EpochState" 4
+    a <- fromCBOR
+    s <- fromCBOR
+    l <- fromCBOR
+    p <- fromCBOR
+    pure $ EpochState a s l p
+
 emptyUTxOState :: UTxOState crypto
 emptyUTxOState = UTxOState (UTxO Map.empty) (Coin 0) (Coin 0) emptyUpdateState
 
@@ -279,6 +376,21 @@ data UTxOState crypto=
 
 instance NoUnexpectedThunks (UTxOState crypto)
 
+instance Crypto crypto => ToCBOR (UTxOState crypto)
+ where
+  toCBOR (UTxOState ut dp fs us) =
+    encodeListLen 4 <> toCBOR ut <> toCBOR dp <> toCBOR fs <> toCBOR us
+
+instance Crypto crypto => FromCBOR (UTxOState crypto)
+ where
+  fromCBOR = do
+    enforceSize "UTxOState" 4
+    ut <- fromCBOR
+    dp <- fromCBOR
+    fs <- fromCBOR
+    us <- fromCBOR
+    pure $ UTxOState ut dp fs us
+
 -- | New Epoch state and environment
 data NewEpochState crypto=
   NewEpochState {
@@ -295,6 +407,25 @@ data NewEpochState crypto=
 
 instance NoUnexpectedThunks (NewEpochState crypto)
 
+instance Crypto crypto => ToCBOR (NewEpochState crypto)
+ where
+  toCBOR (NewEpochState e bp bc es ru pd os) =
+    encodeListLen 7 <> toCBOR e <> toCBOR bp <> toCBOR bc <> toCBOR es
+      <> toCBOR ru <> toCBOR pd <> toCBOR os
+
+instance Crypto crypto => FromCBOR (NewEpochState crypto)
+ where
+  fromCBOR = do
+    enforceSize "NewEpochState" 7
+    e <- fromCBOR
+    bp <- fromCBOR
+    bc <- fromCBOR
+    es <- fromCBOR
+    ru <- fromCBOR
+    pd <- fromCBOR
+    os <- fromCBOR
+    pure $ NewEpochState e bp bc es ru pd os
+
 getGKeys
   :: NewEpochState crypto
   -> Set (GenKeyHash crypto)
@@ -322,6 +453,19 @@ data LedgerState crypto=
 
 instance NoUnexpectedThunks (LedgerState crypto)
 
+instance Crypto crypto => ToCBOR (LedgerState crypto)
+ where
+  toCBOR (LedgerState u dp) =
+    encodeListLen 2 <> toCBOR u <> toCBOR dp
+
+instance Crypto crypto => FromCBOR (LedgerState crypto)
+ where
+  fromCBOR = do
+    enforceSize "LedgerState" 2
+    u <- fromCBOR
+    dp <- fromCBOR
+    pure $ LedgerState u dp
+
 makeLenses ''DPState
 makeLenses ''DState
 makeLenses ''PState