add back tests

Author: Cmdv

cardano-chain-gen/cardano-chain-gen.cabal

@@ -130,12 +130,21 @@ test-suite cardano-chain-gen
   other-modules:        Test.Cardano.Db.Mock.Config
                         Test.Cardano.Db.Mock.Examples
                         Test.Cardano.Db.Mock.Property.Property
+                        Test.Cardano.Db.Mock.UnifiedApi
+                        Test.Cardano.Db.Mock.Unit.Alonzo
+                        Test.Cardano.Db.Mock.Unit.Alonzo.Config
+                        Test.Cardano.Db.Mock.Unit.Alonzo.Simple
+                        Test.Cardano.Db.Mock.Unit.Alonzo.Tx
+                        Test.Cardano.Db.Mock.Unit.Babbage
+                        Test.Cardano.Db.Mock.Unit.Babbage.Reward
+                        Test.Cardano.Db.Mock.Unit.Babbage.Simple
+                        Test.Cardano.Db.Mock.Unit.Babbage.Tx
                         Test.Cardano.Db.Mock.Unit.Conway
                         Test.Cardano.Db.Mock.Unit.Conway.CommandLineArg.ConfigFile
                         Test.Cardano.Db.Mock.Unit.Conway.CommandLineArg.EpochDisabled
                         Test.Cardano.Db.Mock.Unit.Conway.Config.JsonbInSchema
-                        Test.Cardano.Db.Mock.Unit.Conway.Config.Parse
                         Test.Cardano.Db.Mock.Unit.Conway.Config.MigrateConsumedPruneTxOut
+                        Test.Cardano.Db.Mock.Unit.Conway.Config.Parse
                         Test.Cardano.Db.Mock.Unit.Conway.Governance
                         Test.Cardano.Db.Mock.Unit.Conway.InlineAndReference
                         Test.Cardano.Db.Mock.Unit.Conway.Other
@@ -145,7 +154,6 @@ test-suite cardano-chain-gen
                         Test.Cardano.Db.Mock.Unit.Conway.Simple
                         Test.Cardano.Db.Mock.Unit.Conway.Stake
                         Test.Cardano.Db.Mock.Unit.Conway.Tx
-                        Test.Cardano.Db.Mock.UnifiedApi
                         Test.Cardano.Db.Mock.Validate
 
   build-depends:        aeson

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Babbage.hs

@@ -462,7 +462,7 @@ mkUTxOBabbage :: AlonzoTx StandardBabbage -> [(TxIn StandardCrypto, BabbageTxOut
 mkUTxOBabbage = mkUTxOAlonzo
 
 mkUTxOCollBabbage ::
-  (BabbageEraTxBody era) =>
+  BabbageEraTxBody era =>
   AlonzoTx era ->
   [(TxIn (EraCrypto era), TxOut era)]
 mkUTxOCollBabbage tx = Map.toList $ unUTxO $ collOuts $ getField @"body" tx

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway.hs

@@ -227,17 +227,17 @@ mkPaymentTx' inputIndex outputIndices fees donation state' = do
           NoDatum
           SNothing
 
-  pure $
-    mkSimpleTx True $
-      consPaymentTxBody
-        inputs
-        mempty
-        mempty
-        (StrictSeq.fromList $ outputs <> [change])
-        SNothing
-        (Coin fees)
-        mempty
-        (Coin donation)
+  pure
+    $ mkSimpleTx True
+    $ consPaymentTxBody
+      inputs
+      mempty
+      mempty
+      (StrictSeq.fromList $ outputs <> [change])
+      SNothing
+      (Coin fees)
+      mempty
+      (Coin donation)
   where
     mkOutputs (outIx, val) = do
       addr <- resolveAddress outIx state'
@@ -268,17 +268,17 @@ mkLockByScriptTx inputIndex txOutTypes amount fees state' = do
           NoDatum
           SNothing
 
-  pure $
-    mkSimpleTx True $
-      consPaymentTxBody
-        inputs
-        mempty
-        mempty
-        (StrictSeq.fromList $ outputs <> [change])
-        SNothing
-        (Coin fees)
-        mempty
-        (Coin 0)
+  pure
+    $ mkSimpleTx True
+    $ consPaymentTxBody
+      inputs
+      mempty
+      mempty
+      (StrictSeq.fromList $ outputs <> [change])
+      SNothing
+      (Coin fees)
+      mempty
+      (Coin 0)
 
 mkUnlockScriptTx ::
   [ConwayUTxOIndex] ->
@@ -348,9 +348,9 @@ mkDCertPoolTx consDCert state' = do
 
 mkDCertTxPools :: ConwayLedgerState -> Either ForgingError (AlonzoTx StandardConway)
 mkDCertTxPools state' =
-  Right $
-    mkSimpleTx True $
-      consCertTxBody Nothing (allPoolStakeCert' state') (Withdrawals mempty)
+  Right
+    $ mkSimpleTx True
+    $ consCertTxBody Nothing (allPoolStakeCert' state') (Withdrawals mempty)
 
 mkSimpleTx :: Bool -> ConwayTxBody StandardConway -> AlonzoTx StandardConway
 mkSimpleTx isValid' txBody =
@@ -394,9 +394,9 @@ mkScriptDCertTx consCert isValid' state' = do
     cred <- resolveStakeCreds stakeIndex state'
     pure $ mkDCert cred
 
-  pure $
-    mkScriptTx isValid' (mapMaybe prepareRedeemer . zip [0 ..] $ consCert) $
-      consCertTxBody Nothing dcerts (Withdrawals mempty)
+  pure
+    $ mkScriptTx isValid' (mapMaybe prepareRedeemer . zip [0 ..] $ consCert)
+    $ consCertTxBody Nothing dcerts (Withdrawals mempty)
   where
     prepareRedeemer (n, (StakeIndexScript bl, shouldAddRedeemer, _))
       | not shouldAddRedeemer = Nothing
@@ -428,24 +428,24 @@ mkMultiAssetsScriptTx inputIx colInputIx outputIx refInput minted succeeds fees
       refInputs' = Set.fromList $ map (fst . fst) refs
       colInputs' = Set.singleton $ fst colInput
 
-  pure $
-    mkScriptTx succeeds (mkScriptInps (map fst inputs) ++ mkScriptMint' minted) $
-      consTxBody
-        inputs'
-        colInputs'
-        refInputs'
-        (StrictSeq.fromList outputs)
-        SNothing
-        (Coin fees)
-        mempty
-        mempty -- TODO[sgillespie]: minted?
-        (Withdrawals mempty)
-        (Coin 0)
+  pure
+    $ mkScriptTx succeeds (mkScriptInps (map fst inputs) ++ mkScriptMint' minted)
+    $ consTxBody
+      inputs'
+      colInputs'
+      refInputs'
+      (StrictSeq.fromList outputs)
+      SNothing
+      (Coin fees)
+      mempty
+      mempty -- TODO[sgillespie]: minted?
+      (Withdrawals mempty)
+      (Coin 0)
   where
     mkOuts (outIx, val) = do
       addr <- resolveAddress outIx state'
-      pure $
-        BabbageTxOut
+      pure
+        $ BabbageTxOut
           addr
           val
           (DatumHash $ hashData @StandardConway plutusDataList)
@@ -468,19 +468,19 @@ mkDepositTxPools inputIndex deposit state' = do
           NoDatum
           SNothing
 
-  pure $
-    mkSimpleTx True $
-      consTxBody
-        input
-        mempty
-        mempty
-        (StrictSeq.fromList [change])
-        SNothing
-        (Coin 0)
-        mempty
-        (allPoolStakeCert' state')
-        (Withdrawals mempty)
-        (Coin 0)
+  pure
+    $ mkSimpleTx True
+    $ consTxBody
+      input
+      mempty
+      mempty
+      (StrictSeq.fromList [change])
+      SNothing
+      (Coin 0)
+      mempty
+      (allPoolStakeCert' state')
+      (Withdrawals mempty)
+      (Coin 0)
 
 mkRegisterDRepTx ::
   Credential 'DRepRole StandardCrypto ->
@@ -663,8 +663,8 @@ mkFullTx n m state' = do
   refInputPairs <- fmap fst <$> mapM (`resolveUTxOIndex` state') refInputs
   collateralInput <- Set.singleton . fst . fst <$> resolveUTxOIndex collateralInputs state'
 
-  pure $
-    AlonzoTx
+  pure
+    $ AlonzoTx
       { body =
           txBody
             (mkInputs inputPairs)
@@ -748,8 +748,8 @@ mkFullTx n m state' = do
       , ConwayTxCertPool $ Core.RegPool poolParams1
       , ConwayTxCertPool $ Core.RetirePool (Prelude.head unregisteredPools) (EpochNo 0)
       , ConwayTxCertDeleg $ ConwayUnRegCert (unregisteredStakeCredentials !! 2) SNothing
-      , ConwayTxCertDeleg $
-          ConwayDelegCert
+      , ConwayTxCertDeleg
+          $ ConwayDelegCert
             (unregisteredStakeCredentials !! 1)
             (DelegStake $ unregisteredPools !! 2)
       ]
@@ -766,8 +766,8 @@ mkFullTx n m state' = do
 
     -- Withdrawals
     withdrawals =
-      Withdrawals $
-        Map.fromList
+      Withdrawals
+        $ Map.fromList
           [ (RewardAccount Testnet (unregisteredStakeCredentials !! 1), Coin 100)
           , (RewardAccount Testnet (unregisteredStakeCredentials !! 1), Coin 100)
           ]
@@ -899,17 +899,17 @@ mkUnlockScriptTx' inputIndex colInputIndex outputIndex refInput colOut succeeds
           NoDatum
           SNothing
 
-  pure $
-    mkScriptTx succeeds (mkScriptInps inputPairs) $
-      consPaymentTxBody
-        inputs
-        colInputs
-        refInputs
-        (StrictSeq.singleton output)
-        (maybeToStrictMaybe colOut)
-        (Coin fees)
-        mempty
-        (Coin 0)
+  pure
+    $ mkScriptTx succeeds (mkScriptInps inputPairs)
+    $ consPaymentTxBody
+      inputs
+      colInputs
+      refInputs
+      (StrictSeq.singleton output)
+      (maybeToStrictMaybe colOut)
+      (Coin fees)
+      mempty
+      (Coin 0)
 
 allPoolStakeCert' :: ConwayLedgerState -> [ConwayTxCert StandardConway]
 allPoolStakeCert' st = map (mkRegTxCert SNothing) (getCreds st)

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs

@@ -97,8 +97,8 @@ forgeBlocksChunked interpreter vs f = forM (chunksOf 500 vs) $ \blockCreds -> do
 registerDRepsAndDelegateVotes :: Interpreter -> IO CardanoBlock
 registerDRepsAndDelegateVotes interpreter = do
   blockTxs <-
-    withConwayLedgerState interpreter $
-      registerDRepAndDelegateVotes'
+    withConwayLedgerState interpreter
+      $ registerDRepAndDelegateVotes'
         (Prelude.head unregisteredDRepIds)
         (StakeIndex 4)
 

cardano-chain-gen/src/Cardano/Mock/Query.hs

@@ -98,8 +98,8 @@ queryDRepDistrAmount drepHash epochNo = do
     (distr :& hash) <-
       from
         $ table @Db.DrepDistr
-          `innerJoin` table @Db.DrepHash
-        `on` (\(distr :& hash) -> (hash ^. Db.DrepHashId) ==. (distr ^. Db.DrepDistrHashId))
+        `innerJoin` table @Db.DrepHash
+          `on` (\(distr :& hash) -> (hash ^. Db.DrepHashId) ==. (distr ^. Db.DrepDistrHashId))
 
     where_ $ hash ^. Db.DrepHashRaw ==. just (val drepHash)
     where_ $ distr ^. Db.DrepDistrEpochNo ==. val epochNo
@@ -140,14 +140,14 @@ queryConstitutionAnchor epochNo = do
     (_ :& anchor :& epochState) <-
       from
         $ table @Db.Constitution
-          `innerJoin` table @Db.VotingAnchor
-        `on` ( \(constit :& anchor) ->
-                (constit ^. Db.ConstitutionVotingAnchorId) ==. (anchor ^. Db.VotingAnchorId)
-             )
-          `innerJoin` table @Db.EpochState
-        `on` ( \(constit :& _ :& epoch) ->
-                just (constit ^. Db.ConstitutionId) ==. (epoch ^. Db.EpochStateConstitutionId)
-             )
+        `innerJoin` table @Db.VotingAnchor
+          `on` ( \(constit :& anchor) ->
+                  (constit ^. Db.ConstitutionVotingAnchorId) ==. (anchor ^. Db.VotingAnchorId)
+               )
+        `innerJoin` table @Db.EpochState
+          `on` ( \(constit :& _ :& epoch) ->
+                  just (constit ^. Db.ConstitutionId) ==. (epoch ^. Db.EpochStateConstitutionId)
+               )
 
     where_ (epochState ^. Db.EpochStateEpochNo ==. val epochNo)
 
@@ -193,11 +193,13 @@ queryVoteCounts txHash idx = do
         (vote :& tx) <-
           from
             $ table @Db.VotingProcedure
-              `innerJoin` table @Db.Tx
-            `on` (\(vote :& tx) -> vote ^. Db.VotingProcedureTxId ==. tx ^. Db.TxId)
-        where_ $
-          vote ^. Db.VotingProcedureVote ==. val v
-            &&. tx ^. Db.TxHash ==. val txHash
-            &&. vote ^. Db.VotingProcedureIndex ==. val idx
+            `innerJoin` table @Db.Tx
+              `on` (\(vote :& tx) -> vote ^. Db.VotingProcedureTxId ==. tx ^. Db.TxId)
+        where_
+          $ vote
+          ^. Db.VotingProcedureVote
+          ==. val v
+          &&. tx ^. Db.TxHash ==. val txHash
+          &&. vote ^. Db.VotingProcedureIndex ==. val idx
         pure countRows
       pure (maybe 0 unValue res)

cardano-chain-gen/test/Main.hs

@@ -7,6 +7,8 @@ import System.Directory (getCurrentDirectory)
 import System.Environment (lookupEnv, setEnv)
 import System.FilePath ((</>))
 import qualified Test.Cardano.Db.Mock.Property.Property as Property
+import qualified Test.Cardano.Db.Mock.Unit.Alonzo as Alonzo
+import qualified Test.Cardano.Db.Mock.Unit.Babbage as Babbage
 import qualified Test.Cardano.Db.Mock.Unit.Conway as Conway
 import Test.Tasty
 import Test.Tasty.QuickCheck (testProperty)
@@ -27,7 +29,9 @@ tests iom = do
   pure $
     testGroup
       "cardano-chain-gen"
-      [ Conway.unitTests iom knownMigrationsPlain
+      [ Babbage.unitTests iom knownMigrationsPlain
+      , Alonzo.unitTests iom knownMigrationsPlain
+      , Conway.unitTests iom knownMigrationsPlain
       , testProperty "QSM" $ Property.prop_empty_blocks iom knownMigrationsPlain
       ]
   where

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test.Cardano.Db.Mock.Unit.Alonzo (
+  unitTests,
+) where
+
+import Cardano.Mock.ChainSync.Server (IOManager)
+import Data.Text (Text)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (Assertion, testCase)
+
+import qualified Test.Cardano.Db.Mock.Unit.Alonzo.Config as AlzConfig
+import qualified Test.Cardano.Db.Mock.Unit.Alonzo.Simple as AlzSimple
+import qualified Test.Cardano.Db.Mock.Unit.Alonzo.Tx as AlzTx
+
+{- HLINT ignore "Reduce duplication" -}
+
+unitTests :: IOManager -> [(Text, Text)] -> TestTree
+unitTests iom knownMigrations =
+  testGroup
+    "Alonzo unit tests"
+    [ testGroup
+        "config"
+        [ testCase "default insert config" AlzConfig.defaultInsertConfig
+        , testCase "insert config" AlzConfig.insertConfig
+        ]
+    , testGroup
+        "simple"
+        [ test "simple forge blocks" AlzSimple.forgeBlocks
+        , test "sync one block" AlzSimple.addSimple
+        , test "restart db-sync" AlzSimple.restartDBSync
+        , test "sync small chain" AlzSimple.addSimpleChain
+        ]
+    , testGroup
+        "blocks with txs"
+        [ test "simple tx" AlzTx.addSimpleTx
+        , test "consume utxo same block" AlzTx.consumeSameBlock
+        ]
+    ]
+  where
+    test :: String -> (IOManager -> [(Text, Text)] -> Assertion) -> TestTree
+    test str action = testCase str (action iom knownMigrations)