cabal.project and sources.json: update cardano-ledger-specs dependency

This commit hash matches and the sources.json content matches-or-exceeds that of the first cardano-ledger-specs commit that provides everything we require for our initial Alonzo integration (ie no serialization tests, but a Mary-to-Alonzo HF ThreadNet test). We needed to introduce the `Coherent` QuickCheck modifier because PR IntersectMBO/cardano-ledger#2274 loosened the `Arbitrary` instance for Shelley blocks. We have a few tests that assumed the arbitrary blocks would pass "integrity" checks and that the header's claim for the block body's size was mostly correct. The follow-up IntersectMBO/cardano-ledger#2280 re-introduced the generator for coherent header-body pairs, and the new `Coherent` modifier lets us select that for the requisite properties.
IntersectMBO · May 13, 2021 · f89d0d5 · f89d0d5
1 parent 437d716
commit f89d0d5
Show file tree

Hide file tree

Showing 15 changed files with 161 additions and 99 deletions.
diff --git a/cabal.project b/cabal.project
@@ -24,10 +24,10 @@ packages: ./typed-protocols
           ./cardano-client
 
 constraints:
-  ip < 1.5,
-  hedgehog >= 1.0,
-  bimap >= 0.4.0,
-  ListLike >= 4.7.3
+    ip < 1.5
+  , hedgehog >= 1.0
+  , bimap >= 0.4.0
+  , ListLike >= 4.7.3
 
 package Win32-network
   tests: True
@@ -161,8 +161,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: 47db5b818ca4fa051f2e44cdf5e7c5c18c1fb0bf
-  --sha256: 0fr0r5dwfmsp15j19xh20js8nzsqyhwx4q797rxsvpyjfabb2y11
+  tag: 0f409343c3655c4bacd7fab385d392ec5d5cca98
+  --sha256: 0js76inb7avg8c39c9k2zsr77sycg2vadylgvsswdsba808p6hr9
   subdir:
     binary
     binary/test
@@ -174,8 +174,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: e8f19bcc9c8f405131cb95ca6ada26b2b4eac638
-  --sha256: 1v36d3lyhmadzj0abdfsppjna7n7llzqzp9ikx5yq28l2kda2f1p
+  tag: 22f53f75e80a70243bd0fa41f570a9a2715d76cc
+  --sha256: 033qarxg1cifv1y7km170q08idznhygi3xwi3dral5cchi3gdwgm
   subdir:
     byron/chain/executable-spec
     byron/crypto
@@ -200,6 +200,6 @@ source-repository-package
 
 source-repository-package
   type: git
-  location: https://github.com/input-output-hk/cardano-crypto/
+  location: https://github.com/input-output-hk/cardano-crypto
   tag: f73079303f663e028288f9f4a9e08bcca39a923e
   --sha256: 1n87i15x54s0cjkh3nsxs4r1x016cdw1fypwmr68936n3xxsjn6q
diff --git a/nix/sources.json b/nix/sources.json
@@ -30,10 +30,10 @@
         "homepage": null,
         "owner": "input-output-hk",
         "repo": "iohk-nix",
-        "rev": "4efc38924c64c23a582c84950c8c25f72ff049cc",
-        "sha256": "0nhwyrd0xc72yj5q3jqa2wl4khp4g7n72i45cxy2rgn9nrp8wqh0",
+        "rev": "60fe72cf807a4ec4409a53883d5c3af77f60f721",
+        "sha256": "0hpn4fsmnrrqzpj7j3fcmrjm5d3fb15vvbhjn825ipknjjvz6zwd",
         "type": "tarball",
-        "url": "https://github.com/input-output-hk/iohk-nix/archive/4efc38924c64c23a582c84950c8c25f72ff049cc.tar.gz",
+        "url": "https://github.com/input-output-hk/iohk-nix/archive/60fe72cf807a4ec4409a53883d5c3af77f60f721.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "niv": {

diff --git a/ouroboros-consensus-byron-test/src/Test/Consensus/Byron/Generators.hs b/ouroboros-consensus-byron-test/src/Test/Consensus/Byron/Generators.hs
@@ -59,8 +59,8 @@ import qualified Test.Cardano.Chain.Update.Gen as UG
 import qualified Test.Cardano.Crypto.Gen as CC
 
 import           Test.Util.Orphans.Arbitrary ()
-import           Test.Util.Serialisation.Roundtrip (SomeResult (..),
-                     WithVersion (..))
+import           Test.Util.Serialisation.Roundtrip (Coherent (..),
+                     SomeResult (..), WithVersion (..))
 
 {-------------------------------------------------------------------------------
   Generators
@@ -87,7 +87,10 @@ instance Arbitrary RegularBlock where
     hedgehog (CC.genBlock protocolMagicId epochSlots)
 
 instance Arbitrary ByronBlock where
-  arbitrary = frequency
+  arbitrary = getCoherent <$> arbitrary
+
+instance Arbitrary (Coherent ByronBlock) where
+  arbitrary = Coherent <$> frequency
       [ (3, genBlock)
       , (1, genBoundaryBlock)
       ]

diff --git a/ouroboros-consensus-cardano-test/src/Test/Consensus/Cardano/Generators.hs b/ouroboros-consensus-cardano-test/src/Test/Consensus/Cardano/Generators.hs
@@ -49,7 +49,8 @@ import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints)
 
 import           Test.Util.Orphans.Arbitrary ()
-import           Test.Util.Serialisation.Roundtrip (WithVersion (..))
+import           Test.Util.Serialisation.Roundtrip (Coherent (..),
+                     WithVersion (..))
 
 import           Test.Consensus.Byron.Generators
 
@@ -65,6 +66,11 @@ import           Test.Consensus.Cardano.MockCrypto
 instance Arbitrary (CardanoBlock MockCryptoCompatByron) where
   arbitrary = HardForkBlock . OneEraBlock <$> arbitrary
 
+instance Arbitrary (Coherent (CardanoBlock MockCryptoCompatByron)) where
+  arbitrary =
+        Coherent . HardForkBlock . OneEraBlock . hmap (I . getCoherent)
+    <$> arbitrary
+
 instance Arbitrary (CardanoHeader MockCryptoCompatByron) where
   arbitrary = getHeader <$> arbitrary
 
@@ -192,6 +198,17 @@ instance c ~ MockCryptoCompatByron
                                 (CardanoBlock c)) where
   arbitrary = arbitraryNodeToNode BlockByron BlockShelley BlockAllegra BlockMary
 
+instance c ~ MockCryptoCompatByron
+      => Arbitrary (WithVersion (HardForkNodeToNodeVersion (CardanoEras c))
+                                (Coherent (CardanoBlock c))) where
+  arbitrary =
+        fmap (fmap Coherent)
+      $ arbitraryNodeToNode
+          (BlockByron   . getCoherent)
+          (BlockShelley . getCoherent)
+          (BlockAllegra . getCoherent)
+          (BlockMary    . getCoherent)
+
 instance c ~ MockCryptoCompatByron
       => Arbitrary (WithVersion (HardForkNodeToNodeVersion (CardanoEras c))
                                 (CardanoHeader c)) where

diff --git a/ouroboros-consensus-mock-test/src/Test/Consensus/Ledger/Mock/Generators.hs b/ouroboros-consensus-mock-test/src/Test/Consensus/Ledger/Mock/Generators.hs
@@ -61,11 +61,20 @@ instance Arbitrary (HeaderHash blk) => Arbitrary (Point blk) where
   Generators
 -------------------------------------------------------------------------------}
 
--- These generators blindly create random values, so the block will not be
--- valid, but this does not matter for serialisation tests.
-
 instance (SimpleCrypto c, Arbitrary ext, Serialise ext)
       => Arbitrary (SimpleBlock c ext) where
+  arbitrary = do
+    simpleStdHeader <- arbitrary
+    body            <- arbitrary
+    ext             <- arbitrary
+    let hdr = mkSimpleHeader encode simpleStdHeader ext
+    return $ SimpleBlock hdr body
+
+-- | This blindly creates random values, so the block will not be valid, but
+-- this does not matter for serialisation tests. Except we do touch-up the
+-- 'simpleBodySize'.
+instance (SimpleCrypto c, Arbitrary ext, Serialise ext)
+      => Arbitrary (Coherent (SimpleBlock c ext)) where
   arbitrary = do
     simpleStdHeader <- arbitrary
     body            <- arbitrary
@@ -76,7 +85,7 @@ instance (SimpleCrypto c, Arbitrary ext, Serialise ext)
             simpleBodySize = fromIntegral $ Lazy.length $ serialise body
           }
         hdr = mkSimpleHeader encode simpleStdHeader' ext
-    return $ SimpleBlock hdr body
+    return $ Coherent $ SimpleBlock hdr body
 
 instance (SimpleCrypto c, Arbitrary ext, Serialise ext, Typeable ext)
       => Arbitrary (Header (SimpleBlock c ext)) where

diff --git a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs
@@ -105,8 +105,7 @@ import qualified Test.Shelley.Spec.Ledger.Utils as SL hiding (mkKeyPair,
                      mkKeyPair', mkVRFKeyPair)
 
 import qualified Cardano.Ledger.Mary.Value as MA
-import qualified Cardano.Ledger.Shelley.Constraints as SL (PParamsDelta,
-                     makeTxOut)
+import qualified Cardano.Ledger.Shelley.Constraints as SL (makeTxOut)
 import qualified Cardano.Ledger.ShelleyMA as MA
 import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as MA
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA
@@ -213,7 +212,7 @@ examples ::
      ,   SL.PredicateFailure (Core.EraRule "DELEGS" era)
        ~ SL.DelegsPredicateFailure era
      , Core.PParams era ~ SL.PParams era
-     , SL.PParamsDelta era ~ SL.PParams' StrictMaybe era
+     , Core.PParamsDelta era ~ SL.PParams' StrictMaybe era
      )
   => (Core.Tx era -> SL.TxInBlock era)
   -> Core.Value era
@@ -338,7 +337,7 @@ exampleTxBodyShelley = SL.TxBody
 exampleTxBodyMA ::
      forall era.
      ( ShelleyBasedEra era
-     , SL.PParamsDelta era ~ SL.PParams' StrictMaybe era
+     , Core.PParamsDelta era ~ SL.PParams' StrictMaybe era
      )
   => Core.Value era -> MA.TxBody era
 exampleTxBodyMA value = MA.TxBody
@@ -428,7 +427,7 @@ examplePoolDistr = SL.PoolDistr $ Map.fromList [
     ]
 
 exampleProposedPPUpdates ::
-  ( SL.PParamsDelta era ~ SL.PParams' StrictMaybe era
+  ( Core.PParamsDelta era ~ SL.PParams' StrictMaybe era
   , ShelleyBasedEra era
   ) => SL.ProposedPPUpdates era
 exampleProposedPPUpdates = SL.ProposedPPUpdates $

diff --git a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Generators.hs b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Generators.hs
@@ -32,16 +32,16 @@ import           Generic.Random (genericArbitraryU)
 import           Test.QuickCheck hiding (Result)
 
 import           Test.Util.Orphans.Arbitrary ()
-import           Test.Util.Serialisation.Roundtrip (SomeResult (..),
-                     WithVersion (..))
+import           Test.Util.Serialisation.Roundtrip (Coherent (..),
+                     SomeResult (..), WithVersion (..))
 
-import           Test.Cardano.Ledger.Allegra ()
-import           Test.Cardano.Ledger.Mary ()
+import           Test.Cardano.Ledger.AllegraEraGen ()
+import           Test.Cardano.Ledger.MaryEraGen ()
 import           Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
 import           Test.Consensus.Shelley.MockCrypto (CanMock)
 import           Test.Shelley.Spec.Ledger.ConcreteCryptoTypes as SL
 import           Test.Shelley.Spec.Ledger.Generator.ShelleyEraGen ()
-import           Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators ()
+import           Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators (genCoherentBlock)
 import           Test.Shelley.Spec.Ledger.Serialisation.Generators ()
 
 {-------------------------------------------------------------------------------
@@ -51,9 +51,16 @@ import           Test.Shelley.Spec.Ledger.Serialisation.Generators ()
   necessarily valid
 -------------------------------------------------------------------------------}
 
+-- | The upstream 'Arbitrary' instance for Shelley blocks does not generate
+-- coherent blocks, so neither does this.
 instance CanMock era => Arbitrary (ShelleyBlock era) where
   arbitrary = mkShelleyBlock <$> arbitrary
 
+-- | This uses a different upstream generator to ensure the header and block
+-- body relate as expected.
+instance CanMock era => Arbitrary (Coherent (ShelleyBlock era)) where
+  arbitrary = Coherent . mkShelleyBlock <$> genCoherentBlock
+
 instance CanMock era => Arbitrary (Header (ShelleyBlock era)) where
   arbitrary = getHeader <$> arbitrary
 

diff --git a/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs b/ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs
@@ -20,7 +20,7 @@ import           Cardano.Crypto.KES (MockKES)
 
 import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Crypto (Crypto (..))
-import qualified Cardano.Ledger.Era as CL
+import qualified Cardano.Ledger.Era as Core
 import           Control.State.Transition.Extended (PredicateFailure)
 import qualified Shelley.Spec.Ledger.API as SL
 import qualified Shelley.Spec.Ledger.BlockChain as SL
@@ -66,8 +66,9 @@ type CanMock era =
   , Arbitrary (Core.PParams era)
   , Arbitrary (Core.Script era)
   , Arbitrary (Core.TxBody era)
+  , Arbitrary (Core.TxInBlock era)
   , Arbitrary (Core.TxOut era)
   , Arbitrary (Core.Value era)
   , Arbitrary (PredicateFailure (SL.UTXOW era))
-  , CL.TxSeq era ~ SL.TxSeq era
+  , Core.TxSeq era ~ SL.TxSeq era
   )
diff --git a/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs b/ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs
@@ -69,13 +69,12 @@ import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Slots (NumSlots (..))
 import           Test.Util.Time (dawnOfTime)
 
-import qualified Cardano.Ledger.Core
+import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Crypto (Crypto, DSIGN, HASH, KES, VRF)
-import qualified Cardano.Ledger.Era
+import qualified Cardano.Ledger.Era as Core
 import           Cardano.Ledger.Hashes (EraIndependentTxBody)
 import           Cardano.Ledger.SafeHash (HashAnnotated (..), SafeHash,
                      hashAnnotated)
-import qualified Cardano.Ledger.Shelley.Constraints as SL
 import qualified Cardano.Ledger.ShelleyMA.TxBody as MA
 import qualified Shelley.Spec.Ledger.API as SL
 import qualified Shelley.Spec.Ledger.BaseTypes as SL (truncateUnitInterval,
@@ -549,12 +548,12 @@ networkId = SL.Testnet
 mkAllegraSetDecentralizationParamTxs ::
      forall era.
      ( ShelleyBasedEra era
-     , Cardano.Ledger.Core.TxBody era ~ MA.TxBody era
-     , Cardano.Ledger.Core.Value  era ~ SL.Coin
-     , Cardano.Ledger.Core.PParams era ~ SL.PParams era
-     , SL.PParamsDelta era ~ SL.PParams' SL.StrictMaybe era
+     , Core.TxBody era ~ MA.TxBody era
+     , Core.Value  era ~ SL.Coin
+     , Core.PParams era ~ SL.PParams era
+     , Core.PParamsDelta era ~ SL.PParams' SL.StrictMaybe era
      )
-  => [CoreNode (Cardano.Ledger.Era.Crypto era)]
+  => [CoreNode (Core.Crypto era)]
   -> ProtVer   -- ^ The proposed protocol version
   -> SlotNo   -- ^ The TTL
   -> DecentralizationParam   -- ^ The new value
@@ -578,7 +577,7 @@ mkAllegraSetDecentralizationParamTxs coreNodes pVer ttl dNew =
 
     -- Every node signs the transaction body, since it includes a " vote " from
     -- every node.
-    signatures :: Set (SL.WitVKey 'SL.Witness (Cardano.Ledger.Era.Crypto era))
+    signatures :: Set (SL.WitVKey 'SL.Witness (Core.Crypto era))
     signatures =
         SL.makeWitnessesVKey
           (eraIndTxBodyHash' body)
@@ -620,7 +619,7 @@ mkAllegraSetDecentralizationParamTxs coreNodes pVer ttl dNew =
     -- We use the input of the first node, but we just put it all right back.
     --
     -- ASSUMPTION: This transaction runs in the first slot.
-    touchCoins :: (SL.TxIn (Cardano.Ledger.Era.Crypto era), SL.TxOut era)
+    touchCoins :: (SL.TxIn (Core.Crypto era), SL.TxOut era)
     touchCoins = case coreNodes of
         []   -> error "no nodes!"
         cn:_ ->

diff --git a/ouroboros-consensus-shelley-test/test/Test/Consensus/Shelley/Serialisation.hs b/ouroboros-consensus-shelley-test/test/Test/Consensus/Shelley/Serialisation.hs
@@ -87,20 +87,22 @@ testTPraosSlotsPerKESPeriod :: Word64
 testTPraosSlotsPerKESPeriod = maxBound
 
 -- | Test that the block we generate pass the 'verifyBlockIntegrity' check
-prop_blockIntegrity :: Block ShortHash -> Bool
-prop_blockIntegrity = verifyBlockIntegrity testTPraosSlotsPerKESPeriod
+prop_blockIntegrity :: Coherent (Block ShortHash) -> Bool
+prop_blockIntegrity =
+    verifyBlockIntegrity testTPraosSlotsPerKESPeriod . getCoherent
 
 -- | Test that the block we generate pass the 'verifyHeaderIntegrity' check
 prop_headerIntegrity :: Header (Block ShortHash) -> Bool
 prop_headerIntegrity = verifyHeaderIntegrity testTPraosSlotsPerKESPeriod
 
 -- | Test that we can detect random bitflips in blocks.
-prop_detectCorruption_Block :: Block ShortHash -> Corruption -> Property
-prop_detectCorruption_Block =
+prop_detectCorruption_Block :: Coherent (Block ShortHash) -> Corruption -> Property
+prop_detectCorruption_Block (Coherent blk) =
     detectCorruption
       encodeShelleyBlock
       decodeShelleyBlock
       (verifyBlockIntegrity testTPraosSlotsPerKESPeriod)
+      blk
 
 -- | Test that we can detect random bitflips in blocks.
 prop_detectCorruption_Header :: Header (Block ShortHash) -> Corruption -> Property