Refactor: Remove Test.Cardano.Api.Typed and Test.Golden.Cardano.Api.T…

…yped modules
IntersectMBO · Sep 13, 2024 · 4923d98 · 4923d98
1 parent eb2108c
commit 4923d98
Show file tree

Hide file tree

Showing 16 changed files with 186 additions and 184 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -340,7 +340,11 @@ test-suite cardano-api-test
     time,
 
   other-modules:
+    Test.Cardano.Api.Address
+    Test.Cardano.Api.Bech32
+    Test.Cardano.Api.CBOR
     Test.Cardano.Api.Crypto
+    Test.Cardano.Api.Envelope
     Test.Cardano.Api.EpochLeadership
     Test.Cardano.Api.Eras
     Test.Cardano.Api.Genesis
@@ -349,17 +353,13 @@ test-suite cardano-api-test
     Test.Cardano.Api.KeysByron
     Test.Cardano.Api.Ledger
     Test.Cardano.Api.Metadata
+    Test.Cardano.Api.Ord
+    Test.Cardano.Api.Orphans
     Test.Cardano.Api.ProtocolParameters
-    Test.Cardano.Api.Typed.Address
-    Test.Cardano.Api.Typed.Bech32
-    Test.Cardano.Api.Typed.CBOR
-    Test.Cardano.Api.Typed.Envelope
-    Test.Cardano.Api.Typed.JSON
-    Test.Cardano.Api.Typed.Ord
-    Test.Cardano.Api.Typed.Orphans
-    Test.Cardano.Api.Typed.RawBytes
-    Test.Cardano.Api.Typed.TxBody
-    Test.Cardano.Api.Typed.Value
+    Test.Cardano.Api.RawBytes
+    Test.Cardano.Api.Transaction.Autobalance
+    Test.Cardano.Api.TxBody
+    Test.Cardano.Api.Value
 
   ghc-options:
     -threaded
@@ -412,6 +412,6 @@ test-suite cardano-api-golden
     Test.Golden.Cardano.Api.Genesis
     Test.Golden.Cardano.Api.Ledger
     Test.Golden.Cardano.Api.ProtocolParameters
-    Test.Golden.Cardano.Api.Typed.Script
+    Test.Golden.Cardano.Api.Script
     Test.Golden.Cardano.Api.Value
     Test.Golden.ErrorsSpec
diff --git a/...n/Test/Golden/Cardano/Api/Typed/Script.hs → ...-golden/Test/Golden/Cardano/Api/Script.hs b/...n/Test/Golden/Cardano/Api/Typed/Script.hs → ...-golden/Test/Golden/Cardano/Api/Script.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE TypeApplications #-}
 
-module Test.Golden.Cardano.Api.Typed.Script
+module Test.Golden.Cardano.Api.Script
   ( test_golden_SimpleScriptV1_All
   , test_golden_SimpleScriptV1_Any
   , test_golden_SimpleScriptV1_MofN

diff --git a/...pi-test/Test/Cardano/Api/Typed/Address.hs → ...dano-api-test/Test/Cardano/Api/Address.hs b/...pi-test/Test/Cardano/Api/Typed/Address.hs → ...dano-api-test/Test/Cardano/Api/Address.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 
-module Test.Cardano.Api.Typed.Address
+module Test.Cardano.Api.Address
   ( tests
   )
 where
@@ -11,7 +11,7 @@ import qualified Data.Aeson as Aeson
 
 import           Test.Gen.Cardano.Api.Typed (genAddressByron, genAddressShelley)
 
-import           Test.Cardano.Api.Typed.Orphans ()
+import           Test.Cardano.Api.Orphans ()
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H

diff --git a/...api-test/Test/Cardano/Api/Typed/Bech32.hs → ...rdano-api-test/Test/Cardano/Api/Bech32.hs b/...api-test/Test/Cardano/Api/Typed/Bech32.hs → ...rdano-api-test/Test/Cardano/Api/Bech32.hs
@@ -1,4 +1,4 @@
-module Test.Cardano.Api.Typed.Bech32
+module Test.Cardano.Api.Bech32
   ( tests
   )
 where

diff --git a/...o-api-test/Test/Cardano/Api/Typed/CBOR.hs → ...cardano-api-test/Test/Cardano/Api/CBOR.hs b/...o-api-test/Test/Cardano/Api/Typed/CBOR.hs → ...cardano-api-test/Test/Cardano/Api/CBOR.hs
@@ -4,7 +4,7 @@
 -- TODO remove when serialiseTxLedgerCddl is removed
 {-# OPTIONS_GHC -Wno-deprecations #-}
 
-module Test.Cardano.Api.Typed.CBOR
+module Test.Cardano.Api.CBOR
   ( tests
   )
 where
@@ -16,7 +16,7 @@ import           Data.Proxy (Proxy (..))
 
 import           Test.Gen.Cardano.Api.Typed
 
-import           Test.Cardano.Api.Typed.Orphans ()
+import           Test.Cardano.Api.Orphans ()
 
 import           Hedgehog (Property, forAll, property, tripping)
 import qualified Hedgehog as H

diff --git a/...i-test/Test/Cardano/Api/Typed/Envelope.hs → ...ano-api-test/Test/Cardano/Api/Envelope.hs b/...i-test/Test/Cardano/Api/Typed/Envelope.hs → ...ano-api-test/Test/Cardano/Api/Envelope.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 
-module Test.Cardano.Api.Typed.Envelope
+module Test.Cardano.Api.Envelope
   ( tests
   )
 where
@@ -10,7 +10,7 @@ import           Cardano.Api
 
 import           Test.Gen.Cardano.Api.Typed
 
-import           Test.Cardano.Api.Typed.Orphans ()
+import           Test.Cardano.Api.Orphans ()
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H

diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs
@@ -6,6 +6,7 @@ module Test.Cardano.Api.Json
   )
 where
 
+import           Cardano.Api
 import           Cardano.Api.Orphans ()
 import           Cardano.Api.Shelley
 
@@ -14,8 +15,11 @@ import           Data.Aeson (eitherDecode, encode)
 import           Test.Gen.Cardano.Api (genAlonzoGenesis)
 import           Test.Gen.Cardano.Api.Typed
 
+import           Test.Cardano.Api.Orphans ()
+
 import           Hedgehog (Property, forAll, tripping)
 import qualified Hedgehog as H
+import qualified Hedgehog.Gen as Gen
 import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.Hedgehog (testProperty)
 
@@ -56,6 +60,17 @@ prop_json_roundtrip_scriptdata_detailed_json = H.property $ do
   sData <- forAll genHashableScriptData
   tripping sData scriptDataToJsonDetailedSchema scriptDataFromJsonDetailedSchema
 
+prop_roundtrip_praos_nonce_JSON :: Property
+prop_roundtrip_praos_nonce_JSON = H.property $ do
+  pNonce <- forAll $ Gen.just genMaybePraosNonce
+  tripping pNonce encode eitherDecode
+
+prop_roundtrip_protocol_parameters_JSON :: Property
+prop_roundtrip_protocol_parameters_JSON = H.property $ do
+  AnyCardanoEra era <- forAll $ Gen.element [minBound .. maxBound]
+  pp <- forAll (genProtocolParameters era)
+  tripping pp encode eitherDecode
+
 tests :: TestTree
 tests =
   testGroup
@@ -67,4 +82,6 @@ tests =
     , testProperty "json roundtrip txout tx context" prop_json_roundtrip_txout_tx_context
     , testProperty "json roundtrip txout utxo context" prop_json_roundtrip_txout_utxo_context
     , testProperty "json roundtrip scriptdata detailed json" prop_json_roundtrip_scriptdata_detailed_json
+    , testProperty "json roundtrip praos nonce" prop_roundtrip_praos_nonce_JSON
+    , testProperty "json roundtrip protocol parameters" prop_roundtrip_protocol_parameters_JSON
     ]
diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/KeysByron.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/KeysByron.hs
@@ -7,7 +7,7 @@ where
 
 import           Cardano.Api (AsType (AsByronKey, AsSigningKey), Key (deterministicSigningKey))
 
-import           Test.Cardano.Api.Typed.Orphans ()
+import           Test.Cardano.Api.Orphans ()
 import qualified Test.Gen.Cardano.Crypto.Seed as Gen
 
 import           Hedgehog (Property)

diff --git a/...no-api-test/Test/Cardano/Api/Typed/Ord.hs → .../cardano-api-test/Test/Cardano/Api/Ord.hs b/...no-api-test/Test/Cardano/Api/Typed/Ord.hs → .../cardano-api-test/Test/Cardano/Api/Ord.hs
@@ -1,4 +1,4 @@
-module Test.Cardano.Api.Typed.Ord
+module Test.Cardano.Api.Ord
   ( tests
   )
 where

diff --git a/...pi-test/Test/Cardano/Api/Typed/Orphans.hs → ...dano-api-test/Test/Cardano/Api/Orphans.hs b/...pi-test/Test/Cardano/Api/Typed/Orphans.hs → ...dano-api-test/Test/Cardano/Api/Orphans.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Cardano.Api.Typed.Orphans () where
+module Test.Cardano.Api.Orphans () where
 
 import           Cardano.Api.Shelley
 

diff --git a/...i-test/Test/Cardano/Api/Typed/RawBytes.hs → ...ano-api-test/Test/Cardano/Api/RawBytes.hs b/...i-test/Test/Cardano/Api/Typed/RawBytes.hs → ...ano-api-test/Test/Cardano/Api/RawBytes.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 
-module Test.Cardano.Api.Typed.RawBytes
+module Test.Cardano.Api.RawBytes
   ( tests
   )
 where
@@ -10,7 +10,7 @@ import           Cardano.Api
 
 import           Test.Gen.Cardano.Api.Typed
 
-import           Test.Cardano.Api.Typed.Orphans ()
+import           Test.Cardano.Api.Orphans ()
 
 import           Hedgehog (Property)
 import qualified Hedgehog as H

diff --git a/...api-test/Test/Cardano/Api/Typed/TxBody.hs → ...st/Cardano/Api/Transaction/Autobalance.hs b/...api-test/Test/Cardano/Api/Typed/TxBody.hs → ...st/Cardano/Api/Transaction/Autobalance.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE RankNTypes #-}
@@ -10,15 +9,15 @@
 {- HLINT ignore "Use list comprehension" -}
 {- HLINT ignore "Use camelCase" -}
 
-module Test.Cardano.Api.Typed.TxBody
+module Test.Cardano.Api.Transaction.Autobalance
   ( tests
   )
 where
 
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Script
-import           Cardano.Api.Shelley (Address (..), LedgerProtocolParameters (..), ShelleyLedgerEra)
+import           Cardano.Api.Shelley (Address (..), LedgerProtocolParameters (..))
 
 import qualified Cardano.Ledger.Mary.Value as L
 import qualified Cardano.Ledger.Shelley.Scripts as L
@@ -29,101 +28,18 @@ import qualified Cardano.Slotting.Time as CS
 import qualified Data.ByteString as B
 import           Data.Function
 import qualified Data.Map.Strict as M
-import           Data.Maybe (isJust)
 import qualified Data.Time.Format as DT
-import           Data.Type.Equality (TestEquality (testEquality))
 import           GHC.Exts (IsList (..), IsString (..))
 import           GHC.Stack
 
-import           Test.Gen.Cardano.Api.Typed
-
-import           Test.Cardano.Api.Typed.Orphans ()
+import           Test.Cardano.Api.Orphans ()
 
 import           Hedgehog (MonadTest, Property, (===))
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras as H
 import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.Hedgehog (testProperty)
 
--- | Check the txOuts in a TxBodyContent after a ledger roundtrip.
-prop_roundtrip_txbodycontent_txouts :: forall era. ShelleyBasedEra era -> Property
-prop_roundtrip_txbodycontent_txouts era = H.property $ do
-  (body, content :: TxBodyContent BuildTx era) <-
-    shelleyBasedEraConstraints era $ H.forAll $ genValidTxBody era
-  -- Convert ledger body back via 'getTxBodyContent' and 'fromLedgerTxBody'
-  let (TxBody content') = body
-  matchTxOuts (txOuts content) (txOuts content')
- where
-  matchTxOuts :: MonadTest m => [TxOut CtxTx era] -> [TxOut CtxTx era] -> m ()
-  matchTxOuts as bs =
-    mapM_ matchTxOut $ zip as bs
-
-  matchTxOut :: MonadTest m => (TxOut CtxTx era, TxOut CtxTx era) -> m ()
-  matchTxOut (a, b) = do
-    let TxOut aAddress aValue aDatum aRefScript = a
-    let TxOut bAddress bValue bDatum bRefScript = b
-    aAddress === bAddress
-    aValue === bValue
-    matchDatum (aDatum, bDatum)
-    matchRefScript (aRefScript, bRefScript)
-
-  -- NOTE: We accept TxOutDatumInTx instead of TxOutDatumHash as it may be
-  -- correctly resolved given a datum matching the hash was generated.
-  matchDatum :: MonadTest m => (TxOutDatum CtxTx era, TxOutDatum CtxTx era) -> m ()
-  matchDatum = \case
-    (TxOutDatumHash _ dh, TxOutDatumInTx _ d) ->
-      dh === hashScriptDataBytes d
-    (a, b) ->
-      a === b
-
-  -- NOTE: After Allegra, all eras interpret SimpleScriptV1 as SimpleScriptV2
-  -- because V2 is a superset of V1. So we accept that as a valid conversion.
-  matchRefScript :: MonadTest m => (ReferenceScript era, ReferenceScript era) -> m ()
-  matchRefScript (a, b)
-    | isSimpleScriptV2 a && isSimpleScriptV2 b =
-        shelleyBasedEraConstraints era $
-          refScriptToShelleyScript era a
-            === refScriptToShelleyScript era b
-    | otherwise =
-        a === b
-
-  isSimpleScriptV2 :: ReferenceScript era -> Bool
-  isSimpleScriptV2 = isLang SimpleScriptLanguage
-
-  isLang :: ScriptLanguage a -> ReferenceScript era -> Bool
-  isLang expected = \case
-    (ReferenceScript _ (ScriptInAnyLang actual _)) -> isJust $ testEquality expected actual
-    _ -> False
-
-prop_roundtrip_txbodycontent_conway_fields :: Property
-prop_roundtrip_txbodycontent_conway_fields = H.property $ do
-  let sbe = ShelleyBasedEraConway
-  (body, content) <- H.forAll $ genValidTxBody sbe
-  -- Convert ledger body back via 'getTxBodyContent' and 'fromLedgerTxBody'
-  let (TxBody content') = body
-
-  let proposals = getProposalProcedures . unFeatured <$> txProposalProcedures content
-      proposals' = getProposalProcedures . unFeatured <$> txProposalProcedures content'
-      votes = getVotingProcedures . unFeatured <$> txVotingProcedures content
-      votes' = getVotingProcedures . unFeatured <$> txVotingProcedures content'
-      currTreasury = unFeatured <$> txCurrentTreasuryValue content
-      currTreasury' = unFeatured <$> txCurrentTreasuryValue content'
-      treasuryDonation = unFeatured <$> txTreasuryDonation content
-      treasuryDonation' = unFeatured <$> txTreasuryDonation content'
-
-  proposals === proposals'
-  votes === votes'
-  currTreasury === currTreasury'
-  treasuryDonation === treasuryDonation'
- where
-  getVotingProcedures TxVotingProceduresNone = Nothing
-  getVotingProcedures (TxVotingProcedures vps _) = Just vps
-  getProposalProcedures
-    :: TxProposalProcedures build era
-    -> Maybe [L.ProposalProcedure (ShelleyLedgerEra era)]
-  getProposalProcedures TxProposalProceduresNone = Nothing
-  getProposalProcedures txpp@(TxProposalProcedures _ _) = Just . toList $ convProposalProcedures txpp
-
 -- | Test that the fee is the same when spending minted asset manually or when autobalancing it
 prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset :: Property
 prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.propertyOnce $ do
@@ -296,14 +212,7 @@ tests :: TestTree
 tests =
   testGroup
     "Test.Cardano.Api.Typed.TxBody"
-    [ testProperty "roundtrip txbodycontent txouts Babbage" $
-        prop_roundtrip_txbodycontent_txouts ShelleyBasedEraBabbage
-    , testProperty "roundtrip txbodycontent txouts Conway" $
-        prop_roundtrip_txbodycontent_txouts ShelleyBasedEraConway
-    , testProperty
-        "roundtrip txbodycontent new conway fields"
-        prop_roundtrip_txbodycontent_conway_fields
-    , testProperty
+    [ testProperty
         "makeTransactionBodyAutoBalance test correct fees when mutli-asset tx"
         prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset
     ]