Add update payload to chain traces (#649)

- Lower the coverage threshold for "at least 10% of the update proposals do not
  change the maximum transaction-size"
- Increase the trace length to 300 in the `onlyValidSignalsAreGenerated @CHAIN`
  propoerty
- Fix the update generator. It allowed to produce a maximum transaction size
  that was bigger than the current maximum block size.
- Guard the `newMaxBkSize - 1` against underflows
- Lower 10% the bounds for the "at least 10% of the proposals get enough
  endorsements" coverage check.
- Generate `CHAIN` delegation payload only in 30% of the cases.
- Tweak the coverage metrics to account for the fact that we do not want to
  decrease certain protocol parameter values to prevent the signal production
  (blocks, transactions, etc) from stopping.
- Set a memory limit for the tests in `cs-blockchain`
- Fix the abstract size test where the number of characters in the system tags
  were not being counted.
- Fix arithmetic underflow when checking validity of proposed script version.
- Factor out functions for generating update proposal and votes, and
  endorsements. See `updateProposalAndVotesGen` and
  `protocolVersionEndorsementGen`.
- Ignore `stack` lock file.
- Limit the line width to 80. 100 characters is not suitable for working with
    two vertical panes on a laptop, with a font size that is legible for people
    with less than optimal vision (like @dnadales :) ).

.editorconfig

@@ -7,8 +7,9 @@ end_of_line = lf
 charset = utf-8
 trim_trailing_whitespace = true
 insert_final_newline = true
-max_line_length = 100
+# See: https://github.com/input-output-hk/cardano-wallet/wiki/Coding-Standards
+max_line_length = 80
 
 [*.hs]
 indent_size = 2
-max_line_length = 100
+max_line_length = 80

.gitignore

@@ -31,6 +31,7 @@
 *~
 dist-newstyle/
 cabal.project.local
+stack.yaml.lock
 
 # Editors
 TAGS

byron/chain/executable-spec/cs-blockchain.cabal

@@ -76,5 +76,8 @@ test-suite chain-rules-test
                        -Wincomplete-record-updates
                        -Wincomplete-uni-patterns
                        -Wredundant-constraints
+                       -- See `cs-ledger.cabal` for an explanation of the
+                       -- options below.
+                       "-with-rtsopts=-K4m -M300m"
   if (!flag(development))
     ghc-options:       -Werror

byron/chain/executable-spec/src/Cardano/Spec/Chain/STS/Block.hs

@@ -1,22 +1,22 @@
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedLists   #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Cardano.Spec.Chain.STS.Block where
 
-import Control.Lens ((^.), makeLenses, view)
+import           Control.Lens (makeLenses, view, (^.))
+import           Control.State.Transition.Generator
+import           Data.AbstractSize
 import qualified Data.Hashable as H
-import Data.AbstractSize
 import qualified Data.Map.Strict as Map
-import Data.Sequence ((<|))
-import Data.Typeable (typeOf)
-import Numeric.Natural (Natural)
-import GHC.Generics (Generic)
-import Control.State.Transition.Generator
-import Ledger.Core (Hash(Hash), VKey, Slot, Sig)
-import Ledger.Delegation
-import Ledger.Update (STag, ProtVer, UProp, Vote)
-import Ledger.UTxO (TxWits, TxIn, TxOut, Wit)
+import           Data.Sequence ((<|))
+import           Data.Typeable (typeOf)
+import           GHC.Generics (Generic)
+import           Ledger.Core (Hash (Hash), Sig, Slot, VKey)
+import           Ledger.Delegation
+import           Ledger.Update (ProtVer, STag, UProp, Vote)
+import           Ledger.UTxO (TxIn, TxOut, TxWits, Wit)
+import           Numeric.Natural (Natural)
 
 data BlockHeader
   = MkBlockHeader
@@ -39,7 +39,7 @@ data BlockHeader
     -- TODO: BlockVersion – the protocol (block) version that created the block
 
     -- TODO: SoftwareVersion – the software version that created the block
-  } deriving (Generic, Show)
+  } deriving (Eq, Generic, Show)
 
 makeLenses ''BlockHeader
 

byron/chain/executable-spec/src/Cardano/Spec/Chain/STS/Rule/BHead.hs

@@ -6,6 +6,7 @@ module Cardano.Spec.Chain.STS.Rule.BHead where
 
 import           Control.Lens ((^.), _1)
 import           Data.Bimap (Bimap)
+import           Numeric.Natural
 
 import           Control.State.Transition
 import           Ledger.Core
@@ -31,7 +32,7 @@ instance STS BHEAD where
 
   data PredicateFailure BHEAD
     = HashesDontMatch -- TODO: Add fields so that users know the two hashes that don't match
-    | HeaderSizeTooBig -- TODO: Add more information here as well.
+    | HeaderSizeTooBig BlockHeader Natural (Threshold Natural)
     | SlotDidNotIncrease
     -- ^ The block header slot number did not increase w.r.t the last seen slot
     | SlotInTheFuture
@@ -47,7 +48,8 @@ instance STS BHEAD where
         TRC ((_, sLast, k), us, bh) <- judgmentContext
         us' <- trans @EPOCH $ TRC ((sEpoch sLast k, k), us, bh ^. bhSlot)
         let sMax = snd (us' ^. _1) ^. maxHdrSz
-        bHeaderSize bh <= sMax ?! HeaderSizeTooBig
+        bHeaderSize bh <= sMax
+          ?! HeaderSizeTooBig bh (bHeaderSize bh) (Threshold sMax)
         return $! us'
     ]
 

byron/chain/executable-spec/src/Cardano/Spec/Chain/STS/Rule/Chain.hs

@@ -18,6 +18,7 @@ import qualified Data.Map as Map
 import           Data.Sequence (Seq)
 import           Data.Set (Set)
 import qualified Data.Set as Set
+import           Data.Word (Word8)
 import           Hedgehog (Gen)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
@@ -31,12 +32,13 @@ import           Ledger.Core
 import qualified Ledger.Core.Generators as CoreGen
 import           Ledger.Delegation
 import           Ledger.Update hiding (delegationMap)
+import qualified Ledger.Update as Update
 import           Ledger.UTxO (UTxO)
 
 import           Cardano.Spec.Chain.STS.Block
 import           Cardano.Spec.Chain.STS.Rule.BBody
 import           Cardano.Spec.Chain.STS.Rule.BHead
-import           Cardano.Spec.Chain.STS.Rule.Epoch (sEpoch)
+import           Cardano.Spec.Chain.STS.Rule.Epoch (EPOCH, sEpoch)
 import           Cardano.Spec.Chain.STS.Rule.Pbft
 import qualified Cardano.Spec.Chain.STS.Rule.SigCnt as SigCntGen
 
@@ -189,45 +191,110 @@ instance HasTrace CHAIN where
       -- current slot to a sufficiently large value.
       gCurrentSlot = Slot <$> Gen.integral (Range.constant 32768 2147483648)
 
-  sigGen _ = sigGenChain GenDelegation GenUTxO Nothing
+  sigGen _ = sigGenChain GenDelegation GenUTxO GenUpdate Nothing
 
 data ShouldGenDelegation = GenDelegation | NoGenDelegation
 
 data ShouldGenUTxO = GenUTxO | NoGenUTxO
 
+data ShouldGenUpdate = GenUpdate | NoGenUpdate
+
 sigGenChain
   :: ShouldGenDelegation
   -> ShouldGenUTxO
+  -> ShouldGenUpdate
   -> Maybe (PredicateFailure CHAIN)
   -> Environment CHAIN
   -> State CHAIN
   -> Gen (Signal CHAIN)
-sigGenChain shouldGenDelegation shouldGenUTxO _ (_sNow, utxo0, ads, pps, k) (Slot s, sgs, h, utxo, ds, _us)
+sigGenChain
+  shouldGenDelegation
+  shouldGenUTxO
+  shouldGenUpdate
+  _
+  (_sNow, utxo0, ads, _pps, k)
+  (Slot s, sgs, h, utxo, ds, us)
   = do
+    -- We'd expect the slot increment to be close to 1, even for large Gen's
+    -- size numbers.
+    nextSlot <- Slot . (s +) <$> Gen.integral (Range.exponential 1 10)
+
+    -- We need to generate delegation, update proposals, votes, and transactions
+    -- after a potential update in the protocol parameters (which is triggered
+    -- only at epoch boundaries). Otherwise the generators will use a state that
+    -- won't hold when the rules that correspond to these generators are
+    -- applied. For instance, the fees might change, which will render the
+    -- transaction as invalid.
+    --
+    let (us', _) = applySTSIndifferently @EPOCH $ TRC ( (sEpoch (Slot s) k, k)
+                                                      , us
+                                                      , nextSlot
+                                                      )
+
+        pps' = protocolParameters us'
+
+        upienv =
+          ( Slot s
+          , _dIStateDelegationMap ds
+          , k
+          , toNumberOfGenesisKeys $ Set.size ads
+          )
+
+        -- TODO: we might need to make the number of genesis keys a newtype, and
+        -- provide this function in the same module where this newtype is
+        -- defined.
+        toNumberOfGenesisKeys n
+          | fromIntegral (maxBound :: Word8) < n =
+              error $ "sigGenChain: too many genesis keys: " ++ show  n
+          | otherwise = fromIntegral n
+
+    aBlockVersion <-
+      Update.protocolVersionEndorsementGen upienv us'
+
     -- Here we do not want to shrink the issuer, since @Gen.element@ shrinks
     -- towards the first element of the list, which in this case won't provide
     -- us with better shrinks.
-    vkI         <- SigCntGen.issuer (pps, ds ^. dmsL, k) sgs
-    nextSlot    <- gNextSlot
-
-    delegationPayload <- case shouldGenDelegation of
-      GenDelegation   ->
-        let dsEnv = DSEnv
-                    { _dSEnvAllowedDelegators = ads
-                    , _dSEnvEpoch = sEpoch nextSlot k
-                    , _dSEnvSlot = nextSlot
-                    , _dSEnvK = k
-                    }
-        in
-        dcertsGen dsEnv ds
-      NoGenDelegation -> pure []
-
-    utxoPayload <- case shouldGenUTxO of
-      GenUTxO   -> sigGen @UTXOWS Nothing utxoEnv utxo
-      NoGenUTxO -> pure []
+    vkI <- SigCntGen.issuer (pps', ds ^. dmsL, k) sgs
+
+    delegationPayload <-
+      case shouldGenDelegation of
+        GenDelegation   ->
+          -- In practice there won't be a delegation payload in every block, so we
+          -- make this payload sparse.
+          --
+          -- NOTE: We arbitrarily chose to generate delegation payload in 30% of
+          -- the cases. We could make this configurable.
+          Gen.frequency
+            [ (7, pure [])
+            , (3,
+               let dsEnv =
+                    DSEnv
+                      { _dSEnvAllowedDelegators = ads
+                      , _dSEnvEpoch = sEpoch nextSlot k
+                      , _dSEnvSlot = nextSlot
+                      , _dSEnvK = k
+                      }
+               in dcertsGen dsEnv ds
+              )
+            ]
+        NoGenDelegation -> pure []
+
+    utxoPayload <-
+      case shouldGenUTxO of
+        GenUTxO   ->
+          let utxoEnv = UTxOEnv utxo0 pps' in
+            sigGen @UTXOWS Nothing utxoEnv utxo
+        NoGenUTxO -> pure []
+
+    (anOptionalUpdateProposal, aListOfVotes) <-
+      case shouldGenUpdate of
+        GenUpdate ->
+          Update.updateProposalAndVotesGen upienv us'
+        NoGenUpdate ->
+          pure (Nothing, [])
 
     let
-      dummySig       = Sig genesisHash (owner vkI)
+      dummySig = Sig genesisHash (owner vkI)
       unsignedHeader = MkBlockHeader
         h
         nextSlot
@@ -244,14 +311,8 @@ sigGenChain shouldGenDelegation shouldGenUTxO _ (_sNow, utxo0, ads, pps, k) (Slo
         BlockBody
           delegationPayload
           utxoPayload
-          Nothing -- Update proposal
-          []      -- Votes on update proposals
-          (ProtVer 0 0 0)
+          anOptionalUpdateProposal
+          aListOfVotes
+          aBlockVersion
 
     pure $ Block signedHeader bb
-   where
-     -- We'd expect the slot increment to be close to 1, even for large
-     -- Gen's size numbers.
-     gNextSlot = Slot . (s +) <$> Gen.integral (Range.exponential 1 10)
-
-     utxoEnv   = UTxOEnv {utxo0, pps}

byron/chain/executable-spec/test/Cardano/AbstractSize/Properties.hs

@@ -17,14 +17,14 @@ import           Data.Typeable (TypeRep, Typeable, typeOf)
 import           Data.Word (Word64)
 import           Numeric.Natural (Natural)
 
-import           Hedgehog (MonadTest, Property, forAll, property, withTests, (===))
+import           Hedgehog (MonadTest, Property, diff, forAll, property, withTests, (===))
 import           Test.Tasty.Hedgehog
 
 import           Control.State.Transition.Generator (trace)
 import           Control.State.Transition.Trace (TraceOrder (OldestFirst), traceSignals)
 import           Ledger.Core hiding ((<|))
 import           Ledger.Delegation (DCert)
-import           Ledger.Update (ProtVer (..), STag, UProp (..), Vote)
+import           Ledger.Update (ProtVer (..), UProp (..), Vote)
 import           Ledger.UTxO
 
 import           Cardano.Spec.Chain.STS.Block (Block (..), BlockBody (..), BlockHeader (..))
@@ -136,10 +136,13 @@ propMultipleOfSizesBlock b =
     abstractSize (mkCost @TxWits) b === length (_bUtxo body_)
     abstractSize (mkCost @Vote)   b === length (_bUpdVotes body_)
     abstractSize (mkCost @UProp)  b === length (maybeToList (_bUpdProp body_))
-    abstractSize (mkCost @STag)   b
-      === case _bUpdProp body_ of
-            Just uprop -> Set.size (_upSTags uprop)
-            Nothing -> 0
+    -- A STag is a string, so we need to make sure that all the characters are
+    -- accounted for in the size computation. We cannot use equality, since
+    -- characters might appear in other parts of the block.
+    diff
+      (maybe 0 (sum . fmap length . Set.toList . _upSTags) (_bUpdProp body_))
+      (<=)
+      (abstractSize (mkCost @Char) b)
 
     -- BlockHeader appears only once
     abstractSize (mkCost @BlockHeader) b === 1

byron/chain/executable-spec/test/Cardano/Spec/Chain/STS/Properties.hs

@@ -23,7 +23,9 @@ import           Ledger.Core (BlockCount (BlockCount))
 slotsIncrease :: Property
 slotsIncrease = property $ do
   let (maxTraceLength, step) = (1000, 100)
-  tr <- forAll $ traceSigGen (Maximum maxTraceLength) (sigGenChain NoGenDelegation NoGenUTxO)
+  tr <- forAll $ traceSigGen
+                   (Maximum maxTraceLength)
+                   (sigGenChain NoGenDelegation NoGenUTxO NoGenUpdate)
   classifyTraceLength tr maxTraceLength step
   slotsIncreaseInTrace tr
 
@@ -36,7 +38,9 @@ blockIssuersAreDelegates :: Property
 blockIssuersAreDelegates =
   withTests 200 $ property $ do
     let (maxTraceLength, step) = (1000, 100)
-    tr <- forAll $ traceSigGen (Maximum maxTraceLength) (sigGenChain GenDelegation NoGenUTxO)
+    tr <- forAll $ traceSigGen
+                     (Maximum maxTraceLength)
+                     (sigGenChain GenDelegation NoGenUTxO GenUpdate)
     classifyTraceLength tr maxTraceLength step
     checkBlockIssuersAreDelegates tr
   where
@@ -55,12 +59,14 @@ blockIssuersAreDelegates =
 
 onlyValidSignalsAreGenerated :: Property
 onlyValidSignalsAreGenerated =
-  withTests 300 $ TransitionGenerator.onlyValidSignalsAreGenerated @CHAIN 100
+  withTests 200 $ TransitionGenerator.onlyValidSignalsAreGenerated @CHAIN 300
 
 signersListIsBoundedByK :: Property
 signersListIsBoundedByK = property $ do
   let maxTraceLength = 1000
-  tr <- forAll $ traceSigGen (Maximum maxTraceLength) (sigGenChain GenDelegation NoGenUTxO)
+  tr <- forAll $ traceSigGen
+                   (Maximum maxTraceLength)
+                   (sigGenChain GenDelegation NoGenUTxO GenUpdate)
   signersListIsBoundedByKInTrace tr
   where
     signersListIsBoundedByKInTrace :: MonadTest m => Trace CHAIN -> m ()

byron/ledger/executable-spec/cs-ledger.cabal

@@ -114,7 +114,7 @@ test-suite ledger-rules-test
                -- We set a bound here so that we're alerted of potential space
                -- leaks in our generators (or test) code.
                --
-               -- The 4 megabytes stack bound and 50 megabytes heap bound were
+               -- The 4 megabytes stack bound and 150 megabytes heap bound were
                -- determined ad-hoc.
                "-with-rtsopts=-K4m -M150m"
   if (!flag(development))