Call BHEAD from CHAIN

IntersectMBO · Jun 18, 2019 · 0815411 · 0815411
1 parent 0815014
commit 0815411
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 1 deletion.
diff --git a/shelley/chain-and-ledger/executable-spec/delegation.cabal b/shelley/chain-and-ledger/executable-spec/delegation.cabal
@@ -39,6 +39,7 @@ library
                      STS.Overlay
                      STS.Pool
                      STS.PoolReap
+                     STS.Prtcl
                      STS.Rupd
                      STS.Snap
                      STS.Updn

diff --git a/shelley/chain-and-ledger/executable-spec/src/LedgerState.hs b/shelley/chain-and-ledger/executable-spec/src/LedgerState.hs
@@ -108,6 +108,7 @@ module LedgerState
   , NewEpochState(..)
   , NewEpochEnv(..)
   , overlaySchedule
+  , getGKeys
   ) where
 
 import           Control.Monad           (foldM)
@@ -317,6 +318,12 @@ data NewEpochState =
   , nesOsched :: Map.Map Slot (Maybe VKeyGenesis)
   } deriving (Show, Eq)
 
+getGKeys :: NewEpochState -> Set VKeyGenesis
+getGKeys nes = Map.keysSet dms
+  where NewEpochState _ _ _ _ es _ _ _ = nes
+        EpochState _ _ ls _ = es
+        LedgerState _ (DPState (DState _ _ _ _ (Dms dms)) _) _ _ _ _ = ls
+
 data NewEpochEnv =
   NewEpochEnv {
     neeEta1  :: Seed

diff --git a/shelley/chain-and-ledger/executable-spec/src/STS/Chain.hs b/shelley/chain-and-ledger/executable-spec/src/STS/Chain.hs
@@ -47,7 +47,10 @@ chainTransition :: TransitionRule CHAIN
 chainTransition = do
   TRC (sNow, (nes, etaV, etaC, h, sL), block@(Block bh _)) <- judgmentContext
 
-  let nes'@(NewEpochState _ eta0 _ bCur es _ pd osched) = nes -- TODO: converge BHEAD
+  let gkeys = getGKeys nes
+  nes' <- trans @BHEAD $ TRC((etaC, gkeys), nes, bh)
+
+  let NewEpochState _ eta0 _ bCur es _ pd osched = nes'
   let EpochState _ _ ls pp = es
   let LedgerState _ (DPState (DState _ _ _ _ dms) (PState _ _ _ cs)) _ _ _ _ = ls