[CDEC-623] Add golden tests for Undo

chain/Makefile

@@ -5,9 +5,9 @@ ghcid: ## Run ghcid with the cardano-sl-chain package
 	ghcid \
 	    --command "stack ghci cardano-sl-chain --ghci-options=-fno-code"
 
-ghcid-test: ## Have ghcid run the test suite for the wallet-new-specs on successful recompile
+ghcid-test: ## Have ghcid run the chain-test test suite on successful recompile
 	ghcid \
-	    --command "stack ghci cardano-sl-chain:lib cardano-sl-chain:test:test --ghci-options=-fobject-code" \
+	    --command "stack ghci cardano-sl-chain:lib cardano-sl-chain:test:chain-test --ghci-options=-fobject-code" \
 	    --test "Main.main"
 
 .PHONY: ghcid ghcid-test help

chain/test/Test/Pos/Chain/Block/Bi.hs

@@ -16,8 +16,8 @@ import           Pos.Chain.Block (BlockHeader (..), BlockHeaderAttributes,
                      GenesisConsensusData (..), GenesisProof (..), HeaderHash,
                      MainBlockHeader, MainBody (..), MainConsensusData (..),
                      MainExtraBodyData (..), MainExtraHeaderData (..),
-                     MainProof (..), MainToSign (..), mkGenesisHeader,
-                     mkMainHeaderExplicit)
+                     MainProof (..), MainToSign (..), SlogUndo (..), Undo (..),
+                     mkGenesisHeader, mkMainHeaderExplicit)
 import           Pos.Chain.Delegation (DlgPayload (..))
 import           Pos.Chain.Genesis (GenesisHash (..))
 import           Pos.Core (EpochIndex (..))
@@ -30,21 +30,26 @@ import           Test.Pos.Binary.Helpers.GoldenRoundTrip (goldenTestBi,
 import           Test.Pos.Chain.Block.Gen
 import           Test.Pos.Chain.Delegation.Example (exampleLightDlgIndices,
                      staticHeavyDlgIndexes, staticProxySKHeavys)
+import qualified Test.Pos.Chain.Delegation.Example as Delegation
 import           Test.Pos.Chain.Ssc.Example (exampleSscPayload, exampleSscProof)
-import           Test.Pos.Chain.Txp.Example (exampleTxPayload, exampleTxProof)
+import           Test.Pos.Chain.Txp.Example (exampleTxPayload, exampleTxProof,
+                     exampleTxpUndo)
 import           Test.Pos.Chain.Update.Example (exampleBlockVersion,
                      exampleSoftwareVersion, exampleUpdatePayload,
                      exampleUpdateProof)
+import qualified Test.Pos.Chain.Update.Example as Update
 import           Test.Pos.Core.ExampleHelpers (exampleChainDifficulty,
                      exampleEpochIndex, examplePublicKey, exampleSecretKey,
                      exampleSecretKeys, exampleSlotId, exampleSlotLeaders,
                      feedPM, feedPMEpochSlots)
 import           Test.Pos.Util.Golden (discoverGolden, eachOf)
 import           Test.Pos.Util.Tripping (discoverRoundTrip)
 
+
 --------------------------------------------------------------------------------
 -- BlockBodyAttributes
 --------------------------------------------------------------------------------
+
 golden_BlockBodyAttributes :: Property
 golden_BlockBodyAttributes = goldenTestBi bba "test/golden/BlockBodyAttributes"
   where
@@ -53,9 +58,11 @@ golden_BlockBodyAttributes = goldenTestBi bba "test/golden/BlockBodyAttributes"
 roundTripBlockBodyAttributesBi :: Property
 roundTripBlockBodyAttributesBi = eachOf 1000 genBlockBodyAttributes roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- BlockHeader
 --------------------------------------------------------------------------------
+
 golden_BlockHeader_Genesis :: Property
 golden_BlockHeader_Genesis =
     goldenTestBi exampleBlockHeaderGenesis "test/golden/BlockHeader_Genesis"
@@ -70,19 +77,23 @@ roundTripBlockHeaderBi :: Property
 roundTripBlockHeaderBi =
     eachOf 10 (feedPMEpochSlots genBlockHeader) roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- BlockHeaderAttributes
 --------------------------------------------------------------------------------
+
 golden_BlockHeaderAttributes :: Property
 golden_BlockHeaderAttributes = goldenTestBi (mkAttributes () :: BlockHeaderAttributes)
                                             "test/golden/BlockHeaderAttributes"
 
 roundTripBlockHeaderAttributesBi :: Property
 roundTripBlockHeaderAttributesBi = eachOf 1000 genBlockHeaderAttributes roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- BlockSignature
 --------------------------------------------------------------------------------
+
 golden_BlockSignature :: Property
 golden_BlockSignature = goldenTestBi exampleBlockSignature "test/golden/BlockSignature"
 
@@ -98,9 +109,11 @@ roundTripBlockSignatureBi :: Property
 roundTripBlockSignatureBi =
     eachOf 10 (feedPMEpochSlots genBlockSignature) roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- GenesisBlockHeader
 --------------------------------------------------------------------------------
+
 golden_GenesisBlockHeader :: Property
 golden_GenesisBlockHeader = goldenTestBi exampleGenesisBlockHeader
                                          "test/golden/GenesisBlockHeader"
@@ -109,66 +122,80 @@ roundTripGenesisBlockHeaderBi :: Property
 roundTripGenesisBlockHeaderBi =
     eachOf 20 (feedPMEpochSlots genGenesisBlockHeader) roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- GenesisBody
 --------------------------------------------------------------------------------
+
 golden_GenesisBody :: Property
 golden_GenesisBody = goldenTestBi exampleGenesisBody "test/golden/GenesisBody"
 
 roundTripGenesisBodyBi :: Property
 roundTripGenesisBodyBi = eachOf 1000 genGenesisBody roundTripsBiShow
 
+
 --------------------------------------------------------------------------------
 -- GenesisConsensusData
 --------------------------------------------------------------------------------
+
 golden_GenesisConsensusData :: Property
 golden_GenesisConsensusData = goldenTestBi cd "test/golden/GenesisConsensusData"
   where cd = GenesisConsensusData exampleEpochIndex exampleChainDifficulty
 
 roundTripGenesisConsensusDataBi :: Property
 roundTripGenesisConsensusDataBi = eachOf 1000 genGenesisConsensusData roundTripsBiShow
 
+
 --------------------------------------------------------------------------------
 -- HeaderHash
 --------------------------------------------------------------------------------
+
 golden_HeaderHash :: Property
 golden_HeaderHash = goldenTestBi exampleHeaderHash "test/golden/HeaderHash"
 
 roundTripHeaderHashBi :: Property
 roundTripHeaderHashBi = eachOf 1000 genHeaderHash roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- GenesisProof
 --------------------------------------------------------------------------------
+
 golden_GenesisProof :: Property
 golden_GenesisProof = goldenTestBi gp "test/golden/GenesisProof"
   where gp = GenesisProof (abstractHash exampleSlotLeaders)
 
 roundTripGenesisProofBi :: Property
 roundTripGenesisProofBi = eachOf 1000 genGenesisProof roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- MainBlockHeader
 --------------------------------------------------------------------------------
+
 golden_MainBlockHeader :: Property
 golden_MainBlockHeader = goldenTestBi exampleMainBlockHeader "test/golden/MainBlockHeader"
 
 roundTripMainBlockHeaderBi :: Property
 roundTripMainBlockHeaderBi =
     eachOf 20 (feedPMEpochSlots genMainBlockHeader) roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- MainBody
 --------------------------------------------------------------------------------
+
 golden_MainBody :: Property
 golden_MainBody = goldenTestBi exampleMainBody "test/golden/MainBody"
 
 roundTripMainBodyBi :: Property
 roundTripMainBodyBi = eachOf 20 (feedPM genMainBody) roundTripsBiShow
 
+
 --------------------------------------------------------------------------------
 -- MainConsensusData
 --------------------------------------------------------------------------------
+
 golden_MainConsensusData :: Property
 golden_MainConsensusData = goldenTestBi mcd "test/golden/MainConsensusData"
   where mcd = MainConsensusData exampleSlotId examplePublicKey
@@ -178,18 +205,22 @@ roundTripMainConsensusData :: Property
 roundTripMainConsensusData =
     eachOf 20 (feedPMEpochSlots genMainConsensusData) roundTripsBiShow
 
+
 --------------------------------------------------------------------------------
 -- MainExtraBodyData
 --------------------------------------------------------------------------------
+
 golden_MainExtraBodyData :: Property
 golden_MainExtraBodyData = goldenTestBi mebd "test/golden/MainExtraBodyData"
   where mebd = MainExtraBodyData (mkAttributes ())
 
 roundTripMainExtraBodyDataBi :: Property
 roundTripMainExtraBodyDataBi = eachOf 1000 genMainExtraBodyData roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- MainExtraHeaderData
+
 --------------------------------------------------------------------------------
 golden_MainExtraHeaderData :: Property
 golden_MainExtraHeaderData = goldenTestBi exampleMainExtraHeaderData
@@ -198,25 +229,41 @@ golden_MainExtraHeaderData = goldenTestBi exampleMainExtraHeaderData
 roundTripMainExtraHeaderDataBi :: Property
 roundTripMainExtraHeaderDataBi = eachOf 1000 genMainExtraHeaderData roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- MainProof
 --------------------------------------------------------------------------------
+
 golden_MainProof :: Property
 golden_MainProof = goldenTestBi exampleMainProof "test/golden/MainProof"
 
 roundTripMainProofBi :: Property
 roundTripMainProofBi = eachOf 20 (feedPM genMainProof) roundTripsBiBuildable
 
+
 --------------------------------------------------------------------------------
 -- MainToSign
 --------------------------------------------------------------------------------
+
 golden_MainToSign :: Property
 golden_MainToSign = goldenTestBi exampleMainToSign "test/golden/MainToSign"
 
 roundTripMainToSignBi :: Property
 roundTripMainToSignBi =
     eachOf 20 (feedPMEpochSlots genMainToSign) roundTripsBiShow
 
+
+--------------------------------------------------------------------------------
+-- Undo
+--------------------------------------------------------------------------------
+
+golden_Undo :: Property
+golden_Undo = goldenTestBi exampleUndo "test/golden/Undo"
+
+roundTripUndo :: Property
+roundTripUndo = eachOf 20 (feedPMEpochSlots genUndo) roundTripsBiShow
+
+
 --------------------------------------------------------------------------------
 -- Example golden datatypes
 --------------------------------------------------------------------------------
@@ -308,9 +355,21 @@ exampleMainToSign :: MainToSign
 exampleMainToSign = MainToSign (abstractHash (BlockHeaderGenesis exampleGenesisBlockHeader))
                     exampleMainProof exampleSlotId exampleChainDifficulty exampleMainExtraHeaderData
 
------------------------------------------------------------------------
+exampleSlogUndo :: SlogUndo
+exampleSlogUndo = SlogUndo $ Just 999
+
+exampleUndo :: Undo
+exampleUndo = Undo
+  { undoTx = exampleTxpUndo
+  , undoDlg = Delegation.exampleUndo
+  , undoUS = Update.exampleUndo
+  , undoSlog = exampleSlogUndo
+  }
+
+
+--------------------------------------------------------------------------------
 -- Main test export
------------------------------------------------------------------------
+--------------------------------------------------------------------------------
 
 tests :: IO Bool
 tests = and <$> sequence

chain/test/Test/Pos/Chain/Block/Gen.hs

@@ -15,6 +15,7 @@ module Test.Pos.Chain.Block.Gen
        , genMainExtraHeaderData
        , genMainProof
        , genMainToSign
+       , genUndo
        ) where
 
 import           Universum
@@ -29,20 +30,18 @@ import           Pos.Chain.Block (BlockBodyAttributes, BlockHeader (..),
                      GenesisConsensusData (..), GenesisProof (..), HeaderHash,
                      MainBlockHeader, MainBody (..), MainConsensusData (..),
                      MainExtraBodyData (..), MainExtraHeaderData (..),
-                     MainProof (..), MainToSign (..), mkGenesisHeader,
-                     mkMainHeaderExplicit)
+                     MainProof (..), MainToSign (..), SlogUndo (..), Undo (..),
+                     mkGenesisHeader, mkMainHeaderExplicit)
 import           Pos.Core (SlotCount)
 import           Pos.Core.Attributes (mkAttributes)
 import           Pos.Crypto (ProtocolMagic)
 
-import           Test.Pos.Chain.Delegation.Gen (genDlgPayload, genHeavyDlgIndex,
-                     genLightDlgIndices)
+import qualified Test.Pos.Chain.Delegation.Gen as Delegation
 import           Test.Pos.Chain.Ssc.Gen (genSscPayload, genSscProof)
-import           Test.Pos.Chain.Txp.Gen (genTxPayload, genTxProof)
-import           Test.Pos.Chain.Update.Gen (genBlockVersion, genSoftwareVersion,
-                     genUpdatePayload, genUpdateProof)
+import           Test.Pos.Chain.Txp.Gen (genTxPayload, genTxProof, genTxpUndo)
+import qualified Test.Pos.Chain.Update.Gen as Update
 import           Test.Pos.Core.Gen (genChainDifficulty, genEpochIndex,
-                     genSlotId, genSlotLeaders, genTextHash)
+                     genFlatSlotId, genSlotId, genSlotLeaders, genTextHash)
 import           Test.Pos.Crypto.Gen (genAbstractHash, genProxySignature,
                      genPublicKey, genSecretKey, genSignature)
 
@@ -64,9 +63,9 @@ genBlockSignature pm epochSlots = do
         [ BlockSignature
               <$> genSignature pm mts
         , BlockPSignatureLight
-              <$> genProxySignature pm mts genLightDlgIndices
+              <$> genProxySignature pm mts Delegation.genLightDlgIndices
         , BlockPSignatureHeavy
-              <$> genProxySignature pm mts genHeavyDlgIndex
+              <$> genProxySignature pm mts Delegation.genHeavyDlgIndex
         ]
   where
     mts = genMainToSign pm epochSlots
@@ -98,8 +97,8 @@ genMainBody pm =
     MainBody
         <$> genTxPayload pm
         <*> genSscPayload pm
-        <*> genDlgPayload pm
-        <*> genUpdatePayload pm
+        <*> Delegation.genDlgPayload pm
+        <*> Update.genUpdatePayload pm
 
 -- We use `Nothing` as the ProxySKBlockInfo to avoid clashing key errors
 -- (since we use example keys which aren't related to each other)
@@ -129,8 +128,8 @@ genMainExtraBodyData = MainExtraBodyData <$> genBlockBodyAttributes
 genMainExtraHeaderData :: Gen MainExtraHeaderData
 genMainExtraHeaderData =
     MainExtraHeaderData
-        <$> genBlockVersion
-        <*> genSoftwareVersion
+        <$> Update.genBlockVersion
+        <*> Update.genSoftwareVersion
         <*> genBlockHeaderAttributes
         <*> genAbstractHash genMainExtraBodyData
 
@@ -139,8 +138,8 @@ genMainProof pm =
     MainProof
         <$> genTxProof pm
         <*> genSscProof pm
-        <*> genAbstractHash (genDlgPayload pm)
-        <*> genUpdateProof pm
+        <*> genAbstractHash (Delegation.genDlgPayload pm)
+        <*> Update.genUpdateProof pm
 
 genMainToSign :: ProtocolMagic -> SlotCount -> Gen MainToSign
 genMainToSign pm epochSlots =
@@ -150,3 +149,13 @@ genMainToSign pm epochSlots =
         <*> genSlotId epochSlots
         <*> genChainDifficulty
         <*> genMainExtraHeaderData
+
+genSlogUndo :: Gen SlogUndo
+genSlogUndo = SlogUndo <$> Gen.maybe genFlatSlotId
+
+genUndo :: ProtocolMagic -> SlotCount -> Gen Undo
+genUndo pm epochSlots = Undo
+    <$> genTxpUndo
+    <*> Delegation.genUndo pm
+    <*> Update.genUndo pm epochSlots
+    <*> genSlogUndo