Add signable representations

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Protocol.hs

@@ -37,7 +37,6 @@ import Control.State.Transition.Extended (PredicateFailure, TRC (..), applySTS)
 import Data.Either (fromRight)
 import Data.Map.Strict (Map)
 import GHC.Generics (Generic)
-import GHC.Natural
 import Shelley.Spec.Ledger.API.Validation
 import Shelley.Spec.Ledger.BaseTypes (Globals, Nonce, Seed)
 import Shelley.Spec.Ledger.BlockChain (BHBody, BHeader, bhbody, bheaderPrev, prevHashToNonce)
@@ -53,7 +52,7 @@ import Shelley.Spec.Ledger.LedgerState
     _dstate,
     _genDelegs,
   )
-import Shelley.Spec.Ledger.OCert (KESPeriod)
+import Shelley.Spec.Ledger.OCert (OCertSignable)
 import Shelley.Spec.Ledger.PParams (PParams)
 import qualified Shelley.Spec.Ledger.STS.Prtcl as STS.Prtcl
 import Shelley.Spec.Ledger.STS.Tick (TICK, TickEnv (..))
@@ -282,10 +281,7 @@ updateChainDepState ::
     MonadError (ChainTransitionError crypto) m,
     Cardano.Crypto.DSIGN.Class.Signable
       (DSIGN crypto)
-      ( Cardano.Crypto.KES.Class.VerKeyKES (KES crypto),
-        Natural,
-        Shelley.Spec.Ledger.OCert.KESPeriod
-      ),
+      (Shelley.Spec.Ledger.OCert.OCertSignable crypto),
     Cardano.Crypto.KES.Class.Signable
       (KES crypto)
       (Shelley.Spec.Ledger.BlockChain.BHBody crypto),

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/BaseTypes.hs

@@ -65,6 +65,7 @@ import Cardano.Binary
     matchSize,
   )
 import Cardano.Crypto.Hash
+import Cardano.Crypto.Util (SignableRepresentation (..))
 import qualified Cardano.Crypto.VRF as VRF
 import Cardano.Prelude (NFData, NoUnexpectedThunks (..), cborError)
 import Cardano.Slotting.EpochInfo
@@ -215,6 +216,9 @@ newtype Seed = Seed (Hash Blake2b_256 Seed)
   deriving (Eq, Ord, Show, Generic)
   deriving newtype (NoUnexpectedThunks, ToCBOR)
 
+instance SignableRepresentation Seed where
+  getSignableRepresentation (Seed x) = hashToBytes x
+
 (==>) :: Bool -> Bool -> Bool
 a ==> b = not a || b
 

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/OCert.hs

@@ -3,12 +3,15 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 module Shelley.Spec.Ledger.OCert
   ( OCert (..),
     OCertEnv (..),
+    OCertSignable (..),
+    ocertToSignable,
     currentIssueNo,
     KESPeriod (..),
     slotsPerKESPeriod,
@@ -19,16 +22,18 @@ 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.Prelude (NoUnexpectedThunks (..))
 import Control.Monad.Trans.Reader (asks)
+import qualified Data.Binary.Put as Binary
+import qualified Data.ByteString.Lazy as BSL
 import Data.Functor ((<&>))
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Word (Word)
+import Data.Word (Word, Word64)
 import GHC.Generics (Generic)
-import Numeric.Natural (Natural)
 import Quiet
 import Shelley.Spec.Ledger.BaseTypes
 import Shelley.Spec.Ledger.Crypto
@@ -58,10 +63,10 @@ data OCertEnv crypto = OCertEnv
 
 currentIssueNo ::
   OCertEnv crypto ->
-  (Map (KeyHash 'BlockIssuer crypto) Natural) ->
+  (Map (KeyHash 'BlockIssuer crypto) Word64) ->
   -- | Pool hash
   KeyHash 'BlockIssuer crypto ->
-  Maybe Natural
+  Maybe Word64
 currentIssueNo (OCertEnv stPools genDelegs) cs hk
   | Map.member hk cs = Map.lookup hk cs
   | Set.member (coerceKeyRole hk) stPools = Just 0
@@ -76,11 +81,11 @@ data OCert crypto = OCert
   { -- | The operational hot key
     ocertVkHot :: !(VerKeyKES crypto),
     -- | counter
-    ocertN :: !Natural,
+    ocertN :: !Word64,
     -- | Start of key evolving signature period
     ocertKESPeriod :: !KESPeriod,
     -- | Signature of block operational certificate content
-    ocertSigma :: !(SignedDSIGN crypto (VerKeyKES crypto, Natural, KESPeriod))
+    ocertSigma :: !(SignedDSIGN crypto (OCertSignable crypto))
   }
   deriving (Generic)
   deriving (ToCBOR) via (CBORGroup (OCert crypto))
@@ -106,7 +111,7 @@ instance
       + encodedSizeExpr size ((\(KESPeriod p) -> p) . ocertKESPeriod <$> proxy)
       + DSIGN.encodedSigDSIGNSizeExpr (((\(DSIGN.SignedDSIGN sig) -> sig) . ocertSigma) <$> proxy)
     where
-      toWord :: Natural -> Word
+      toWord :: Word64 -> Word
       toWord = fromIntegral
 
   listLen _ = 4
@@ -129,3 +134,19 @@ kesPeriod (SlotNo s) =
     if spkp == 0
       then error "kesPeriod: slots per KES period was set to zero"
       else KESPeriod . fromIntegral $ s `div` spkp
+
+-- | Signable part of an operational certificate
+data OCertSignable crypto
+  = OCertSignable !(VerKeyKES crypto) !Word64 !KESPeriod
+
+instance Crypto crypto => SignableRepresentation (OCertSignable crypto) where
+  getSignableRepresentation (OCertSignable vk counter period) =
+    BSL.toStrict . Binary.runPut $ do
+      Binary.putByteString (KES.rawSerialiseVerKeyKES vk)
+      Binary.putWord64be counter
+      Binary.putWord64be (fromIntegral $ unKESPeriod period)
+
+-- | Extract the signable part of an operational certificate (for verification)
+ocertToSignable :: OCert crypto -> OCertSignable crypto
+ocertToSignable OCert {ocertVkHot, ocertN, ocertKESPeriod} =
+  OCertSignable ocertVkHot ocertN ocertKESPeriod

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Chain.hs

@@ -42,6 +42,7 @@ import Control.State.Transition
   )
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.BaseTypes
@@ -77,7 +78,6 @@ import Shelley.Spec.Ledger.Keys
     KESignable,
     KeyHash,
     KeyRole (..),
-    VerKeyKES,
     coerceKeyRole,
   )
 import Shelley.Spec.Ledger.LedgerState
@@ -97,7 +97,7 @@ import Shelley.Spec.Ledger.LedgerState
     updateNES,
     _genDelegs,
   )
-import Shelley.Spec.Ledger.OCert (KESPeriod)
+import Shelley.Spec.Ledger.OCert (OCertSignable)
 import Shelley.Spec.Ledger.PParams
   ( PParams,
     ProtVer (..),
@@ -124,7 +124,7 @@ data CHAIN crypto
 
 data ChainState crypto = ChainState
   { chainNes :: NewEpochState crypto,
-    chainOCertIssue :: Map.Map (KeyHash 'BlockIssuer crypto) Natural,
+    chainOCertIssue :: Map.Map (KeyHash 'BlockIssuer crypto) Word64,
     chainEpochNonce :: Nonce,
     chainEvolvingNonce :: Nonce,
     chainCandidateNonce :: Nonce,
@@ -183,7 +183,7 @@ initialShelleyState lab e utxo reserves genDelegs os pp initNonce =
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     DSignable crypto (Hash crypto (TxBody crypto)),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
@@ -243,7 +243,7 @@ chainChecks maxpv pp bh = do
 chainTransition ::
   forall crypto.
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     DSignable crypto (Hash crypto (TxBody crypto)),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
@@ -310,7 +310,7 @@ chainTransition =
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     DSignable crypto (Hash crypto (TxBody crypto)),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
@@ -321,7 +321,7 @@ instance
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     DSignable crypto (Hash crypto (TxBody crypto)),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
@@ -332,7 +332,7 @@ instance
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     DSignable crypto (Hash crypto (TxBody crypto)),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
@@ -343,7 +343,7 @@ instance
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     DSignable crypto (Hash crypto (TxBody crypto)),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Ocert.hs

@@ -20,7 +20,6 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Word (Word64)
 import GHC.Generics (Generic)
-import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.BaseTypes
 import Shelley.Spec.Ledger.BlockChain
 import Shelley.Spec.Ledger.Crypto
@@ -31,14 +30,14 @@ data OCERT crypto
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     KESignable crypto (BHBody crypto)
   ) =>
   STS (OCERT crypto)
   where
   type
     State (OCERT crypto) =
-      Map (KeyHash 'BlockIssuer crypto) Natural
+      Map (KeyHash 'BlockIssuer crypto) Word64
   type
     Signal (OCERT crypto) =
       BHeader crypto
@@ -53,10 +52,10 @@ instance
         !KESPeriod -- OCert Start KES Period
         !Word64 -- Max KES Key Evolutions
     | CounterTooSmallOCERT
-        !Natural -- last KES counter used
-        !Natural -- current KES counter
+        !Word64 -- last KES counter used
+        !Word64 -- current KES counter
     | InvalidSignatureOCERT -- TODO use whole OCert
-        !Natural -- OCert counter
+        !Word64 -- OCert counter
         !KESPeriod -- OCert KES period
     | InvalidKesSignatureOCERT
         !Word -- current KES Period
@@ -74,7 +73,7 @@ instance NoUnexpectedThunks (PredicateFailure (OCERT crypto))
 
 ocertTransition ::
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     KESignable crypto (BHBody crypto)
   ) =>
   TransitionRule (OCERT crypto)
@@ -98,7 +97,7 @@ ocertTransition =
     -- above `KESBeforeStartOCERT`
     -- predicate failure in the
     -- transition.
-    verifySignedDSIGN vkey (vk_hot, n, c0) tau ?! InvalidSignatureOCERT n c0
+    verifySignedDSIGN vkey (ocertToSignable $ bheaderOCert bhb) tau ?! InvalidSignatureOCERT n c0
     verifySignedKES () vk_hot t bhb sigma ?!: InvalidKesSignatureOCERT kp_ c0_ t
 
     case currentIssueNo env cs hk of

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Overlay.hs

@@ -30,8 +30,8 @@ import Data.Coerce (coerce)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import Data.Word (Word64)
 import GHC.Generics (Generic)
-import Numeric.Natural (Natural)
 import Shelley.Spec.Ledger.BaseTypes
   ( ActiveSlotCoeff,
     Nonce,
@@ -58,14 +58,13 @@ import Shelley.Spec.Ledger.Keys
     KESignable,
     KeyHash,
     KeyRole (..),
-    VerKeyKES,
     VerKeyVRF,
     coerceKeyRole,
     hashKey,
     hashVerKeyVRF,
   )
 import Shelley.Spec.Ledger.LedgerState (OBftSlot (..))
-import Shelley.Spec.Ledger.OCert (KESPeriod)
+import Shelley.Spec.Ledger.OCert (OCertSignable)
 import Shelley.Spec.Ledger.STS.Ocert (OCERT, OCertEnv (..))
 import Shelley.Spec.Ledger.Slot (SlotNo)
 
@@ -83,15 +82,15 @@ instance NoUnexpectedThunks (OverlayEnv crypto)
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
   ) =>
   STS (OVERLAY crypto)
   where
   type
     State (OVERLAY crypto) =
-      Map (KeyHash 'BlockIssuer crypto) Natural
+      Map (KeyHash 'BlockIssuer crypto) Word64
 
   type
     Signal (OVERLAY crypto) =
@@ -224,7 +223,7 @@ pbftVrfChecks vrfHK eta0 bhb = do
 overlayTransition ::
   forall crypto.
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
   ) =>
@@ -267,7 +266,7 @@ instance (VRF.VRFAlgorithm (VRF crypto)) => NoUnexpectedThunks (PredicateFailure
 
 instance
   ( Crypto crypto,
-    DSignable crypto (VerKeyKES crypto, Natural, KESPeriod),
+    DSignable crypto (OCertSignable crypto),
     KESignable crypto (BHBody crypto),
     VRF.Signable (VRF crypto) Seed
   ) =>