Merge #2300

2300: Introduce ChainIndepState r=mrBliss a=mrBliss Closes #2058, #2229. * Get rid of the `TPraosForgeState` wrapper around `HotKey` and track more. information about the `HotKey`. * Rename `ConsensusState` to `ChainDepState`. * Introduce `ChainIndepState` and use it to track the `HotKey` for `TPraos`. * Rename `ForgeState` to `ExtraForgeState` (block-specific, unused, but for future use, e.g., hardware devices, online opcert renewal) and define `ForgeState` to be the product of `ChainIndepState` and `ExtraForgeState`. * Pass the `ChainIndepState` to `checkIsLeader` so that `TPraos` can check the validity of the KES key (original goal of this PR). * Remove `Update`. * Make `forgeBlock` pure by removing `MonadRandom` (work towards #2036). * Also remove `MonadRandom` from `ProtocolInfo`. Co-authored-by: Thomas Winant <[email protected]>
IntersectMBO · Jun 22, 2020 · 9a7d0e0 · 9a7d0e0
2 parents 174640d + 52a2a22
commit 9a7d0e0
Show file tree

Hide file tree

Showing 82 changed files with 1,269 additions and 901 deletions.
diff --git a/ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Ledger.hs b/ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Ledger.hs
@@ -25,7 +25,6 @@ module Ouroboros.Consensus.ByronDual.Ledger (
   ) where
 
 import           Codec.Serialise
-import           Crypto.Random (MonadRandom)
 import           Data.ByteString (ByteString)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -208,53 +207,54 @@ bridgeTransactionIds = Spec.Test.transactionIds
 -------------------------------------------------------------------------------}
 
 instance CanForge DualByronBlock where
-  type ForgeState DualByronBlock = ForgeState ByronBlock
+  type ExtraForgeState DualByronBlock = ExtraForgeState ByronBlock
 
   forgeBlock = forgeDualByronBlock
 
 forgeDualByronBlock
-  :: forall m. (MonadRandom m, HasCallStack)
+  :: HasCallStack
   => TopLevelConfig DualByronBlock
   -> ForgeState DualByronBlock
   -> BlockNo                            -- ^ Current block number
   -> TickedLedgerState DualByronBlock   -- ^ Ledger
   -> [GenTx DualByronBlock]             -- ^ Txs to add in the block
   -> PBftIsLeader PBftByronCrypto       -- ^ Leader proof ('IsLeader')
-  -> m DualByronBlock
-forgeDualByronBlock cfg () curBlockNo tickedLedger txs isLeader = do
+  -> DualByronBlock
+forgeDualByronBlock cfg forgeState curBlockNo tickedLedger txs isLeader =
     -- NOTE: We do not /elaborate/ the real Byron block from the spec one, but
     -- instead we /forge/ it. This is important, because we want to test that
     -- codepath. This does mean that we do not get any kind of "bridge" between
     -- the two blocks (which we would have gotten if we would have elaborated
     -- the block instead). Fortunately, this is okay, since the bridge for the
     -- block can be computed from the bridge information of all of the txs.
 
-    main <- forgeByronBlock
-              (dualTopLevelConfigMain cfg)
-              ()
-              curBlockNo
-              (Ticked {
-                   tickedSlotNo      = curSlotNo
-                 , tickedLedgerState = dualLedgerStateMain $
-                                         tickedLedgerState tickedLedger
-                 })
-              (map dualGenTxMain txs)
-              isLeader
-
-    let aux :: ByronSpecBlock
-        aux = forgeByronSpecBlock
-                curSlotNo
-                curBlockNo
-                (dualLedgerStateAux $ tickedLedgerState tickedLedger)
-                (map dualGenTxAux txs)
-                (bridgeToSpecKey
-                   (dualLedgerStateBridge $ tickedLedgerState tickedLedger)
-                   (hashVerKey . deriveVerKeyDSIGN . pbftSignKey $ isLeader))
-
-    return DualBlock {
+    DualBlock {
         dualBlockMain   = main
       , dualBlockAux    = Just aux
       , dualBlockBridge = mconcat $ map dualGenTxBridge txs
       }
   where
     curSlotNo = tickedSlotNo tickedLedger
+
+    main :: ByronBlock
+    main = forgeByronBlock
+             (dualTopLevelConfigMain cfg)
+             (castForgeState forgeState)
+             curBlockNo
+             (Ticked {
+                  tickedSlotNo      = curSlotNo
+                , tickedLedgerState = dualLedgerStateMain $
+                                        tickedLedgerState tickedLedger
+                })
+             (map dualGenTxMain txs)
+             isLeader
+
+    aux :: ByronSpecBlock
+    aux = forgeByronSpecBlock
+            curSlotNo
+            curBlockNo
+            (dualLedgerStateAux $ tickedLedgerState tickedLedger)
+            (map dualGenTxAux txs)
+            (bridgeToSpecKey
+               (dualLedgerStateBridge $ tickedLedgerState tickedLedger)
+               (hashVerKey . deriveVerKeyDSIGN . pbftSignKey $ isLeader))
diff --git a/ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Node.hs b/ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Node.hs
@@ -73,6 +73,7 @@ protocolInfoDualByron abstractGenesis@ByronSpecGenesis{..} params mLeader =
             configConsensus = PBftConfig {
                 pbftParams = params
               }
+          , configIndep  = ()
           , configLedger = DualLedgerConfig {
                 dualLedgerConfigMain = concreteGenesis
               , dualLedgerConfigAux  = abstractConfig

diff --git a/ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Node/Serialisation.hs b/ouroboros-consensus-byron-test/src/Ouroboros/Consensus/ByronDual/Node/Serialisation.hs
@@ -77,12 +77,12 @@ instance EncodeDisk DualByronBlock (LedgerState DualByronBlock) where
 instance DecodeDisk DualByronBlock (LedgerState DualByronBlock) where
   decodeDisk _ = decodeDualLedgerState decodeByronLedgerState
 
--- | @'ConsensusState' ('BlockProtocol' 'DualByronBlock')@
+-- | @'ChainDepState' ('BlockProtocol' 'DualByronBlock')@
 instance EncodeDisk DualByronBlock (PBftState PBftByronCrypto) where
-  encodeDisk _ = encodeByronConsensusState
--- | @'ConsensusState' ('BlockProtocol' 'DualByronBlock')@
+  encodeDisk _ = encodeByronChainDepState
+-- | @'ChainDepState' ('BlockProtocol' 'DualByronBlock')@
 instance DecodeDisk DualByronBlock (PBftState PBftByronCrypto) where
-  decodeDisk ccfg = decodeByronConsensusState k
+  decodeDisk ccfg = decodeByronChainDepState k
     where
       k = getByronSecurityParam $ dualCodecConfigMain ccfg
 

diff --git a/ouroboros-consensus-byron-test/src/Test/Consensus/Byron/Examples.hs b/ouroboros-consensus-byron-test/src/Test/Consensus/Byron/Examples.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeApplications  #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 module Test.Consensus.Byron.Examples (
-    exampleConsensusState
+    exampleChainDepState
   , exampleLedgerState
   , exampleHeaderState
   , exampleExtLedgerState
@@ -48,7 +48,7 @@ import qualified Test.Cardano.Chain.UTxO.Example as CC
 -------------------------------------------------------------------------------}
 
 -- | Note that we must use the same value for the 'SecurityParam' as for the
--- 'S.WindowSize', because 'decodeByronConsensusState' only takes the
+-- 'S.WindowSize', because 'decodeByronChainDepState' only takes the
 -- 'SecurityParam' and uses it as the basis for the 'S.WindowSize'.
 secParam :: SecurityParam
 secParam = SecurityParam 2
@@ -60,8 +60,8 @@ windowSize = S.WindowSize 2
   Examples
 -------------------------------------------------------------------------------}
 
-exampleConsensusState :: ConsensusState (BlockProtocol ByronBlock)
-exampleConsensusState = withEBB
+exampleChainDepState :: ChainDepState (BlockProtocol ByronBlock)
+exampleChainDepState = withEBB
   where
     signers = map (`S.PBftSigner` CC.exampleKeyHash) [1..4]
 
@@ -75,7 +75,7 @@ exampleConsensusState = withEBB
     exampleEbbHeaderHashBytes :: HeaderHashBytes
     exampleEbbSlot            = 6
     exampleEbbHeaderHashBytes = mkHeaderHashBytesForTestingOnly
-                                  (Lazy8.pack "test_golden_ConsensusState6")
+                                  (Lazy8.pack "test_golden_ChainDepState6")
 
     withEBB = S.appendEBB secParam windowSize
                 exampleEbbSlot exampleEbbHeaderHashBytes

diff --git a/ouroboros-consensus-byron-test/src/Test/ThreadNet/Infra/Byron/TrackUpdates.hs b/ouroboros-consensus-byron-test/src/Test/ThreadNet/Infra/Byron/TrackUpdates.hs
@@ -59,7 +59,6 @@ import           Test.ThreadNet.Util.NodeTopology
 
 import           Test.ThreadNet.Infra.Byron.ProtocolInfo
 
-import           Test.Util.Random
 import           Test.Util.Slots (NumSlots (..))
 
 -- | The expectation and observation regarding whether the hard-fork proposal
@@ -389,7 +388,7 @@ mkProtocolRealPBftAndHardForkTxs
     ProtocolInfo{pInfoConfig}   = pInfo
     TopLevelConfig{configBlock} = pInfoConfig
 
-    pInfo :: ProtocolInfo (ChaChaT m) ByronBlock
+    pInfo :: ProtocolInfo m ByronBlock
     pInfo = mkProtocolRealPBFT params cid genesisConfig genesisSecrets
 
     proposals :: [Byron.GenTx ByronBlock]

diff --git a/ouroboros-consensus-byron-test/test/Test/Consensus/Byron/Golden.hs b/ouroboros-consensus-byron-test/test/Test/Consensus/Byron/Golden.hs
@@ -32,7 +32,7 @@ tests :: TestTree
 tests = testGroup "Golden tests"
     -- Note that for most Byron types, we simply wrap the en/decoders from
     -- cardano-ledger, which already has golden tests for them.
-    [ testCase "ConsensusState" test_golden_ConsensusState
+    [ testCase "ChainDepState"  test_golden_ChainDepState
     , testCase "LedgerState"    test_golden_LedgerState
     , testCase "GenTxId"        test_golden_GenTxId
     , testCase "UPIState"       test_golden_UPIState
@@ -46,10 +46,10 @@ tests = testGroup "Golden tests"
     , testCase "Result"         test_golden_Result
     ]
 
-test_golden_ConsensusState :: Assertion
-test_golden_ConsensusState = goldenTestCBOR
-    encodeByronConsensusState
-    exampleConsensusState
+test_golden_ChainDepState :: Assertion
+test_golden_ChainDepState = goldenTestCBOR
+    encodeByronChainDepState
+    exampleChainDepState
     [ TkListLen 2
     , TkInt 0
     , TkListLen 3
@@ -73,7 +73,7 @@ test_golden_ConsensusState = goldenTestCBOR
     , TkListLen 4
     , TkInt 0
     , TkInt 6
-    , TkBytes "test_golden_ConsensusState6"
+    , TkBytes "test_golden_ChainDepState6"
     , TkListLen 2
     , TkInt 1
     , TkInt 4

diff --git a/ouroboros-consensus-byron-test/test/Test/ThreadNet/RealPBFT.hs b/ouroboros-consensus-byron-test/test/Test/ThreadNet/RealPBFT.hs
@@ -1282,7 +1282,7 @@ genNodeRekeys params nodeJoinPlan nodeTopology numSlots@(NumSlots t)
 mkRekeyUpd
   :: Genesis.Config
   -> Genesis.GeneratedSecrets
-  -> ProtocolInfo (ChaChaT m) ByronBlock
+  -> ProtocolInfo m ByronBlock
   -> EpochNo
   -> Crypto.SignKeyDSIGN Crypto.ByronDSIGN
   -> Maybe (TestNodeInitialization m ByronBlock)

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Forge.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Forge.hs
@@ -44,18 +44,17 @@ import           Ouroboros.Consensus.Byron.Ledger.PBFT
 import           Ouroboros.Consensus.Byron.Protocol
 
 instance CanForge ByronBlock where
-  type ForgeState ByronBlock = ()
   forgeBlock = forgeByronBlock
 
 forgeByronBlock
-  :: forall m. (Monad m, HasCallStack)
+  :: HasCallStack
   => TopLevelConfig ByronBlock
   -> ForgeState ByronBlock
   -> BlockNo                         -- ^ Current block number
   -> TickedLedgerState ByronBlock    -- ^ Current ledger
   -> [GenTx ByronBlock]              -- ^ Txs to add in the block
   -> PBftIsLeader PBftByronCrypto    -- ^ Leader proof ('IsLeader')
-  -> m ByronBlock
+  -> ByronBlock
 forgeByronBlock = forgeRegularBlock
 
 forgeEBB
@@ -126,21 +125,20 @@ initBlockPayloads = BlockPayloads
   }
 
 forgeRegularBlock
-  :: forall m. (Monad m, HasCallStack)
+  :: HasCallStack
   => TopLevelConfig ByronBlock
   -> ForgeState ByronBlock
   -> BlockNo                           -- ^ Current block number
   -> TickedLedgerState ByronBlock      -- ^ Current ledger
   -> [GenTx ByronBlock]                -- ^ Txs to add in the block
   -> PBftIsLeader PBftByronCrypto      -- ^ Leader proof ('IsLeader')
-  -> m ByronBlock
-forgeRegularBlock cfg () curNo tickedLedger txs isLeader =
-    let ouroborosPayload =
-          forgePBftFields
-            (mkByronContextDSIGN $ configBlock cfg)
-            isLeader
-            (reAnnotate $ Annotated toSign ())
-    in return $ forge ouroborosPayload
+  -> ByronBlock
+forgeRegularBlock cfg _forgeState curNo tickedLedger txs isLeader =
+    forge $
+      forgePBftFields
+        (mkByronContextDSIGN $ configBlock cfg)
+        isLeader
+        (reAnnotate $ Annotated toSign ())
   where
     curSlot :: SlotNo
     curSlot = tickedSlotNo tickedLedger

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Ledger.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/Ledger.hs
@@ -354,12 +354,12 @@ decodeByronAnnTip = decodeAnnTipIsEBB decodeByronHeaderHash
 encodeByronExtLedgerState :: ExtLedgerState ByronBlock -> Encoding
 encodeByronExtLedgerState = encodeExtLedgerState
     encodeByronLedgerState
-    encodeByronConsensusState
+    encodeByronChainDepState
     encodeByronAnnTip
 
 encodeByronHeaderState :: HeaderState ByronBlock -> Encoding
 encodeByronHeaderState = encodeHeaderState
-    encodeByronConsensusState
+    encodeByronChainDepState
     encodeByronAnnTip
 
 encodeByronLedgerState :: LedgerState ByronBlock -> Encoding

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/PBFT.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Ledger/PBFT.hs
@@ -9,8 +9,8 @@
 module Ouroboros.Consensus.Byron.Ledger.PBFT (
     toPBftLedgerView
   , fromPBftLedgerView
-  , encodeByronConsensusState
-  , decodeByronConsensusState
+  , encodeByronChainDepState
+  , decodeByronChainDepState
   , mkByronContextDSIGN
   ) where
 
@@ -84,12 +84,12 @@ toPBftLedgerView = PBftLedgerView . Delegation.unMap
 fromPBftLedgerView :: PBftLedgerView PBftByronCrypto -> Delegation.Map
 fromPBftLedgerView = Delegation.Map . pbftDelegates
 
-encodeByronConsensusState
-  :: ConsensusState (BlockProtocol ByronBlock)
+encodeByronChainDepState
+  :: ChainDepState (BlockProtocol ByronBlock)
   -> Encoding
-encodeByronConsensusState = S.encodePBftState
+encodeByronChainDepState = S.encodePBftState
 
-decodeByronConsensusState
+decodeByronChainDepState
   :: SecurityParam
-  -> Decoder s (ConsensusState (BlockProtocol ByronBlock))
-decodeByronConsensusState k = S.decodePBftState k (pbftWindowSize k)
+  -> Decoder s (ChainDepState (BlockProtocol ByronBlock))
+decodeByronChainDepState k = S.decodePBftState k (pbftWindowSize k)
diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node.hs
@@ -125,6 +125,7 @@ protocolInfoByron genesisConfig mSigThresh pVer sVer mLeader =
             configConsensus = PBftConfig {
                 pbftParams = byronPBftParams genesisConfig mSigThresh
               }
+          , configIndep  = ()
           , configLedger = genesisConfig
           , configBlock  = byronConfig
           }

diff --git a/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node/Serialisation.hs b/ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Node/Serialisation.hs
@@ -56,12 +56,12 @@ instance EncodeDisk ByronBlock (LedgerState ByronBlock) where
 instance DecodeDisk ByronBlock (LedgerState ByronBlock) where
   decodeDisk _ = decodeByronLedgerState
 
--- | @'ConsensusState' ('BlockProtocol' 'ByronBlock')@
+-- | @'ChainDepState' ('BlockProtocol' 'ByronBlock')@
 instance EncodeDisk ByronBlock (PBftState PBftByronCrypto) where
-  encodeDisk _ = encodeByronConsensusState
--- | @'ConsensusState' ('BlockProtocol' 'ByronBlock')@
+  encodeDisk _ = encodeByronChainDepState
+-- | @'ChainDepState' ('BlockProtocol' 'ByronBlock')@
 instance DecodeDisk ByronBlock (PBftState PBftByronCrypto) where
-  decodeDisk ccfg = decodeByronConsensusState (getByronSecurityParam ccfg)
+  decodeDisk ccfg = decodeByronChainDepState (getByronSecurityParam ccfg)
 
 instance EncodeDisk ByronBlock (AnnTip ByronBlock) where
   encodeDisk _ = encodeByronAnnTip

diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano.hs
@@ -31,7 +31,6 @@ module Ouroboros.Consensus.Cardano (
   , verifyProtocolClient
   ) where
 
-import           Crypto.Random (MonadRandom)
 import           Data.Type.Equality
 
 import           Cardano.Prelude (Natural)
@@ -51,6 +50,7 @@ import           Ouroboros.Consensus.Protocol.BFT as X
 import           Ouroboros.Consensus.Protocol.LeaderSchedule as X
 import           Ouroboros.Consensus.Protocol.PBFT as X
 import           Ouroboros.Consensus.Util
+import           Ouroboros.Consensus.Util.IOLike
 
 import           Ouroboros.Consensus.HardFork.Combinator
 
@@ -189,7 +189,7 @@ verifyProtocol ProtocolCardano{}        = Refl
 -------------------------------------------------------------------------------}
 
 -- | Data required to run the selected protocol
-protocolInfo :: forall m blk p. MonadRandom m
+protocolInfo :: forall m blk p. IOLike m
              => Protocol m blk p -> ProtocolInfo m blk
 protocolInfo (ProtocolMockBFT nodes nid k paramsEra) =
     protocolInfoBft nodes nid k paramsEra