Resize QSM checkpoints generator in terms of the number of steps

  The main effect of this change is to make sure that checkpoints
  generated in by the QSM tests have increasing slot numbers, and
  that they also generate address states that are bigger and bigger.

  Before this change, we would see commands such as:

  - putCheckpoint (RndState [addr1, addr2, addr3])
  - putCheckpoint (RndState [])

  Which is basically not possible in practice; addresses don't
  disappear. Another approach could have been to adjust a bit our
  database model to keep track of address state in a sparse way as
  well. Ideally, we should also decrease the "size" factor with
  rollbacks although, to do it well, we need to have a coupling between
  the generator and the transition function advancing the model (to make
  sure to shrink the size by the right factor).

lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs

@@ -150,7 +150,7 @@ import GHC.Generics
 import System.IO.Unsafe
     ( unsafePerformIO )
 import System.Random
-    ( mkStdGen )
+    ( mkStdGen, random, randoms )
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
@@ -165,9 +165,11 @@ import Test.QuickCheck
     , generate
     , genericShrink
     , oneof
+    , resize
     , scale
     , shrinkIntegral
     , shrinkList
+    , sized
     , vector
     , vectorOf
     )
@@ -286,7 +288,7 @@ instance Arbitrary MockChain where
 instance GenState s => Arbitrary (InitialCheckpoint s) where
     shrink (InitialCheckpoint cp) = InitialCheckpoint <$> shrink cp
     arbitrary = do
-        cp <- arbitrary @(Wallet s)
+        cp <- resize 0 $ arbitrary @(Wallet s)
         pure $ InitialCheckpoint $ unsafeInitWallet
             (utxo cp)
             (block0 ^. #header)
@@ -332,13 +334,11 @@ instance Arbitrary PassphraseScheme where
 -------------------------------------------------------------------------------}
 
 instance Arbitrary BlockHeader where
-    arbitrary = do
-        EpochNo ep <- arbitrary
-        SlotInEpoch sl <- arbitrary
-        let h = fromIntegral sl + fromIntegral ep * arbitraryEpochLength
+    arbitrary = sized $ \sl -> do
+        let h = Quantity $ fromIntegral sl
+        let slot = SlotNo $ fromIntegral sl
         blockH <- arbitrary
-        let slot = SlotNo $ fromIntegral h
-        pure $ BlockHeader slot (Quantity h) blockH (coerce blockH)
+        pure $ BlockHeader slot h blockH (coerce blockH)
 
 instance Arbitrary SlotNo where
     arbitrary = do
@@ -535,17 +535,31 @@ arbitraryRewardAccount =
                                  Random State
 -------------------------------------------------------------------------------}
 
+{- HLINT ignore "Use !!" -}
 instance Arbitrary (RndState 'Mainnet) where
     shrink (RndState k ix addrs pending g) =
         [ RndState k ix' addrs' pending' g
         | (ix', addrs', pending') <- shrink (ix, addrs, pending)
         ]
-    arbitrary = RndState
-        (Passphrase "passphrase")
-        minBound
-        <$> arbitrary
-        <*> (pure mempty) -- FIXME: see comment on 'Arbitrary Seq.PendingIxs'
-        <*> pure (mkStdGen 42)
+    -- Addresses are generate based on the size parameter, so that property
+    -- tests can actually expect addresses to not be totally random, but
+    -- instead, be an ever growing map, much more like they are actually
+    -- generated in practice.
+    arbitrary = sized $ \n -> do
+        let stdgen = mkStdGen 42
+        let newAddress (m, g0) = (Map.insert k v m, g2)
+              where
+                (acctIx, g1) = random g0
+                (addrIx, g2) = random g1
+                k = (Index acctIx, Index addrIx)
+                v = Address $ B8.pack $ take 32 $ randoms g2
+        let addrs = fst $ head $ drop n $ iterate newAddress (mempty, stdgen)
+        pure $ RndState
+            (Passphrase "passphrase")
+            minBound
+            addrs
+            mempty -- FIXME: see comment on 'Arbitrary Seq.PendingIxs'
+            stdgen
 
 instance Arbitrary (ByronKey 'RootK XPrv) where
     shrink _ = []

lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs

@@ -188,6 +188,7 @@ import Test.QuickCheck
     , frequency
     , labelledExamplesWith
     , property
+    , resize
     , (===)
     )
 import Test.QuickCheck.Monadic
@@ -514,19 +515,19 @@ type WidRefs r =
     RefEnv WalletId MWid r
 
 data Model s r
-    = Model (Mock s) (WidRefs r)
+    = Model Int (Mock s) (WidRefs r)
     deriving (Generic)
 
 deriving instance (Show1 r, Show s) => Show (Model s r)
 
 initModel :: Model s r
-initModel = Model emptyDatabase []
+initModel = Model 0 emptyDatabase []
 
 toMock :: (Functor (f s), Eq1 r) => Model s r -> f s :@ r -> f s MWid
-toMock (Model _ wids) (At fr) = fmap (wids !) fr
+toMock (Model _ _ wids) (At fr) = fmap (wids !) fr
 
 step :: Eq1 r => Model s r -> Cmd s :@ r -> (Resp s MWid, Mock s)
-step m@(Model mock _) c = runMock (toMock m c) mock
+step m@(Model _ mock _) c = runMock (toMock m c) mock
 
 {-------------------------------------------------------------------------------
   Events
@@ -547,10 +548,10 @@ lockstep
     -> Cmd s  :@ r
     -> Resp s :@ r
     -> Event s   r
-lockstep m@(Model _ ws) c (At resp) = Event
+lockstep m@(Model n _ ws) c (At resp) = Event
     { before = m
     , cmd = c
-    , after = Model mock' (ws <> ws')
+    , after = Model (n + 1) mock' (ws <> ws')
     , mockResp = resp'
     }
   where
@@ -567,7 +568,7 @@ generator
     :: forall s. (Arbitrary (Wallet s), GenState s)
     => Model s Symbolic
     -> Maybe (Gen (Cmd s :@ Symbolic))
-generator (Model _ wids) = Just $ frequency $ fmap (fmap At) <$> concat
+generator (Model n _ wids) = Just $ frequency $ fmap (fmap At) <$> concat
     [ withoutWid
     , if null wids then [] else withWid
     ]
@@ -586,7 +587,7 @@ generator (Model _ wids) = Just $ frequency $ fmap (fmap At) <$> concat
     withWid =
         [ (3, RemoveWallet <$> genId')
         , (5, pure ListWallets)
-        , (5, PutCheckpoint <$> genId' <*> arbitrary)
+        , (5, PutCheckpoint <$> genId' <*> resize n arbitrary)
         , (5, ReadCheckpoint <$> genId')
         , (5, ListCheckpoints <$> genId')
         , (5, PutWalletMeta <$> genId' <*> arbitrary)
@@ -634,7 +635,7 @@ shrinker
     :: (Arbitrary (Wallet s))
     => Model s Symbolic
     -> Cmd s :@ Symbolic -> [Cmd s :@ Symbolic]
-shrinker (Model _ _) (At cmd) = case cmd of
+shrinker Model{} (At cmd) = case cmd of
     PutCheckpoint wid wal ->
         [ At $ PutCheckpoint wid wal'
         | wal' <- shrink wal ]
@@ -668,7 +669,7 @@ transition :: Eq1 r => Model s r -> Cmd s :@ r -> Resp s :@ r -> Model s r
 transition m c = after . lockstep m c
 
 precondition :: Model s Symbolic -> Cmd s :@ Symbolic -> Logic
-precondition (Model _ wids) (At c) =
+precondition (Model _ _ wids) (At c) =
     forall (toList c) (`elem` map fst wids)
 
 postcondition
@@ -942,7 +943,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
   where
     isRollbackSuccess :: Event s Symbolic -> Maybe MWid
     isRollbackSuccess ev = case (cmd ev, mockResp ev, before ev) of
-        (At (RollbackTo wid _), Resp (Right Point{}), Model _ wids ) ->
+        (At (RollbackTo wid _), Resp (Right Point{}), Model _ _ wids ) ->
             Just (wids ! wid)
         _otherwise ->
             Nothing
@@ -958,7 +959,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
                 (Nothing
                     , At (RemoveWallet wid)
                     , Resp (Right _)
-                    , Model _ wids) ->
+                    , Model _ _ wids) ->
                         Map.insert (wids ! wid) 0 created
                 _otherwise ->
                     created
@@ -969,7 +970,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
 
     isReadTxHistory :: Event s Symbolic -> Maybe MWid
     isReadTxHistory ev = case (cmd ev, mockResp ev, before ev) of
-        (At (ReadTxHistory wid _ _ _ _), Resp (Right (TxHistory _)), Model _ wids)
+        (At (ReadTxHistory wid _ _ _ _), Resp (Right (TxHistory _)), Model _ _ wids)
             -> Just (wids ! wid)
         _otherwise
             -> Nothing
@@ -1039,7 +1040,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
     isReadPrivateKeySuccess ev = case (cmd ev, mockResp ev, before ev) of
         (At (ReadPrivateKey wid)
             , Resp (Right (PrivateKey (Just _)))
-            , Model _ wids )
+            , Model _ _ wids )
                 -> Just (wids ! wid)
         _otherwise
             -> Nothing
@@ -1109,7 +1110,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
     isPutCheckpointSuccess ev = case (cmd ev, mockResp ev, before ev) of
         (At (PutCheckpoint wid _wal)
             , Resp (Right (Unit ()))
-            , Model _ wids )
+            , Model _ _ wids )
                 -> Just (wids ! wid)
         _otherwise
             -> Nothing
@@ -1125,7 +1126,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
                 ( Nothing
                   , At (PutDelegationCertificate wid _ _)
                   , Resp (Right _)
-                  , Model _ wids
+                  , Model _ _ wids
                   ) ->
                     Map.insert (wids ! wid) 0 acc
                 _ ->
@@ -1138,7 +1139,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
 
     isReadWalletMetadata :: Event s Symbolic -> Maybe MWid
     isReadWalletMetadata ev = case (cmd ev, mockResp ev, before ev) of
-        (At (ReadWalletMeta wid), Resp Right{}, Model _ wids) ->
+        (At (ReadWalletMeta wid), Resp Right{}, Model _ _ wids) ->
             Just (wids ! wid)
         _ ->
             Nothing