Propagate to tests

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -130,11 +130,12 @@ import           Cardano.Api hiding (txIns)
 import qualified Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
                    WitnessNetworkIdOrByronAddress (..))
-import           Cardano.Api.Governance.Actions.VotingProcedure
+import           Cardano.Api.Eon.AllegraEraOnwards (allegraEraOnwardsToShelleyBasedEra)
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Ledger.Lens as A
 import           Cardano.Api.Script (scriptInEraToRefScript)
 import           Cardano.Api.Shelley
+import qualified Cardano.Api.Shelley as ShelleyApi
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
@@ -181,16 +182,8 @@ genAddressShelley = makeShelleyAddress <$> genNetworkId
                                        <*> genPaymentCredential
                                        <*> genStakeAddressReference
 
-genAddressInEra :: CardanoEra era -> Gen (AddressInEra era)
-genAddressInEra =
-  inEonForEra
-    (byronAddressInEra <$> genAddressByron)
-    (\sbe ->
-      Gen.choice
-        [ byronAddressInEra       <$> genAddressByron
-        , shelleyAddressInEra sbe <$> genAddressShelley
-        ]
-    )
+genAddressInEra :: ShelleyBasedEra era -> Gen (AddressInEra era)
+genAddressInEra sbe = shelleyAddressInEra sbe <$> genAddressShelley
 
 genKESPeriod :: Gen KESPeriod
 genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
@@ -305,12 +298,13 @@ genScriptInAnyLang =
       [ ScriptInAnyLang lang <$> genScript lang
       | AnyScriptLanguage lang <- [minBound..maxBound] ]
 
-genScriptInEra :: CardanoEra era -> Gen (ScriptInEra era)
+genScriptInEra :: ShelleyBasedEra era -> Gen (ScriptInEra era)
 genScriptInEra era =
     Gen.choice
       [ ScriptInEra langInEra <$> genScript lang
       | AnyScriptLanguage lang <- [minBound..maxBound]
-      , Just langInEra <- [scriptLanguageSupportedInEra era lang] ]
+        -- TODO: scriptLanguageSupportedInEra should be parameterized on ShelleyBasedEra
+      , Just langInEra <- [scriptLanguageSupportedInEra (toCardanoEra era) lang] ]
 
 genScriptHash :: Gen ScriptHash
 genScriptHash = do
@@ -463,7 +457,7 @@ genPaymentCredential = do
   vKey <- genVerificationKey AsPaymentKey
   return . PaymentCredentialByKey $ verificationKeyHash vKey
 
-genSigningKey :: Key keyrole => AsType keyrole -> Gen (SigningKey keyrole)
+genSigningKey :: Key keyrole => ShelleyApi.AsType keyrole -> Gen (SigningKey keyrole)
 genSigningKey roletoken = do
     seed <- genSeed (fromIntegral seedSize)
     let sk = deterministicSigningKey roletoken seed
@@ -504,34 +498,34 @@ genTxId = TxId <$> genShelleyHash
 genTxIndex :: Gen TxIx
 genTxIndex = TxIx . fromIntegral <$> Gen.word16 Range.constantBounded
 
-genTxOutValue :: CardanoEra era -> Gen (TxOutValue era)
-genTxOutValue =
-  caseByronOrShelleyBasedEra
-    (const $ TxOutValueByron <$> genPositiveLovelace)
-    (\sbe -> TxOutValueShelleyBased sbe <$> genValueForTxOut sbe)
+genTxOutValue :: ShelleyBasedEra era -> Gen (TxOutValue era)
+genTxOutValue sbe = shelleyBasedEraConstraints sbe $ TxOutValueShelleyBased sbe <$> genValueForTxOut sbe
+
+genByronTxOut :: Gen (TxOut CtxTx era)
+genByronTxOut =
+  TxOut <$> error "TODO" -- genAddressInEra era
+        <*> error "TODO" -- genTxOutValue era
+        <*> pure TxOutDatumNone
+        <*> pure ReferenceScriptNone
 
-genTxOutTxContext :: CardanoEra era -> Gen (TxOut CtxTx era)
+genTxOutTxContext :: ShelleyBasedEra era -> Gen (TxOut CtxTx era)
 genTxOutTxContext era =
   TxOut <$> genAddressInEra era
         <*> genTxOutValue era
         <*> genTxOutDatumHashTxContext era
         <*> genReferenceScript era
 
-genTxOutUTxOContext :: CardanoEra era -> Gen (TxOut CtxUTxO era)
+genTxOutUTxOContext :: ShelleyBasedEra era -> Gen (TxOut CtxUTxO era)
 genTxOutUTxOContext era =
   TxOut <$> genAddressInEra era
         <*> genTxOutValue era
         <*> genTxOutDatumHashUTxOContext era
         <*> genReferenceScript era
 
-genReferenceScript :: CardanoEra era -> Gen (ReferenceScript era)
-genReferenceScript era =
-  caseByronToAlonzoOrBabbageEraOnwards
-    (const (return ReferenceScriptNone))
-    (const (scriptInEraToRefScript <$> genScriptInEra era))
-    era
+genReferenceScript :: ShelleyBasedEra era -> Gen (ReferenceScript era)
+genReferenceScript era = scriptInEraToRefScript <$> genScriptInEra era
 
-genUTxO :: CardanoEra era -> Gen (UTxO era)
+genUTxO :: ShelleyBasedEra era -> Gen (UTxO era)
 genUTxO era =
   UTxO <$> Gen.map (Range.constant 0 5) ((,) <$> genTxIn <*> (toCtxUTxOTxOut <$> genTxOutTxContext era))
 
@@ -566,11 +560,12 @@ genTxMetadataInEra =
         ]
     )
 
-genTxAuxScripts :: CardanoEra era -> Gen (TxAuxScripts era)
+genTxAuxScripts :: ShelleyBasedEra era -> Gen (TxAuxScripts era)
 genTxAuxScripts era =
-  forEraInEon era
+  forEraInEon (toCardanoEra era)
     (pure TxAuxScriptsNone)
-    (\w -> TxAuxScripts w <$> Gen.list (Range.linear 0 3) (genScriptInEra era))
+    (\w -> TxAuxScripts w <$> Gen.list (Range.linear 0 3)
+                                       (genScriptInEra (allegraEraOnwardsToShelleyBasedEra w)))
 
 genTxWithdrawals :: CardanoEra era -> Gen (TxWithdrawals BuildTx era)
 genTxWithdrawals =
@@ -636,49 +631,64 @@ genTxMintValue =
     )
 
 genTxBodyContent :: CardanoEra era -> Gen (TxBodyContent BuildTx era)
-genTxBodyContent era = do
-  txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
-  txInsCollateral <- genTxInsCollateral era
-  txInsReference <- genTxInsReference era
-  txOuts <- Gen.list (Range.constant 1 10) (genTxOutTxContext era)
-  txTotalCollateral <- genTxTotalCollateral era
-  txReturnCollateral <- genTxReturnCollateral era
-  txFee <- genTxFee era
-  txValidityLowerBound <- genTxValidityLowerBound era
-  txValidityUpperBound <- genTxValidityUpperBound era
-  txMetadata <- genTxMetadataInEra era
-  txAuxScripts <- genTxAuxScripts era
-  let txExtraKeyWits = TxExtraKeyWitnessesNone --TODO: Alonzo era: Generate witness key hashes
-  txProtocolParams <- BuildTxWith <$> forEraInEon era (pure Nothing) (Gen.maybe . genValidProtocolParameters)
-  txWithdrawals <- genTxWithdrawals era
-  txCertificates <- genTxCertificates era
-  txUpdateProposal <- genTxUpdateProposal era
-  txMintValue <- genTxMintValue era
-  txScriptValidity <- genTxScriptValidity era
-  txProposalProcedures <- genMaybeFeaturedInEra genProposals era
-  txVotingProcedures <- genMaybeFeaturedInEra genVotingProcedures era
-  pure $ TxBodyContent
-    { Api.txIns
-    , Api.txInsCollateral
-    , Api.txInsReference
-    , Api.txOuts
-    , Api.txTotalCollateral
-    , Api.txReturnCollateral
-    , Api.txFee
-    , Api.txValidityLowerBound
-    , Api.txValidityUpperBound
-    , Api.txMetadata
-    , Api.txAuxScripts
-    , Api.txExtraKeyWits
-    , Api.txProtocolParams
-    , Api.txWithdrawals
-    , Api.txCertificates
-    , Api.txUpdateProposal
-    , Api.txMintValue
-    , Api.txScriptValidity
-    , Api.txProposalProcedures
-    , Api.txVotingProcedures
-    }
+genTxBodyContent era =
+  caseByronOrShelleyBasedEra
+  -- Byron Era
+  (const $ do
+      txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
+      txOuts <- Gen.list (Range.constant 1 10) genByronTxOut
+      pure (defaultTxBodyContent era)
+        { Api.txIns
+        , Api.txOuts
+        }
+  )
+  -- Shelley Era
+  (\sbe -> do
+      txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
+      txInsCollateral <- genTxInsCollateral era
+      txInsReference <- genTxInsReference era
+      txOuts <- Gen.list (Range.constant 1 10) (genTxOutTxContext sbe)
+      txTotalCollateral <- genTxTotalCollateral era
+      txReturnCollateral <- genTxReturnCollateral sbe
+      txFee <- genTxFee era
+      txValidityLowerBound <- genTxValidityLowerBound era
+      txValidityUpperBound <- genTxValidityUpperBound era
+      txMetadata <- genTxMetadataInEra era
+      txAuxScripts <- genTxAuxScripts sbe
+      let txExtraKeyWits = TxExtraKeyWitnessesNone --TODO: Alonzo era: Generate witness key hashes
+      txProtocolParams <- BuildTxWith <$> forEraInEon era (pure Nothing) (Gen.maybe . genValidProtocolParameters)
+      txWithdrawals <- genTxWithdrawals era
+      txCertificates <- genTxCertificates era
+      txUpdateProposal <- genTxUpdateProposal era
+      txMintValue <- genTxMintValue era
+      txScriptValidity <- genTxScriptValidity era
+      txProposalProcedures <- genMaybeFeaturedInEra genProposals era
+      txVotingProcedures <- genMaybeFeaturedInEra genVotingProcedures era
+      pure $ TxBodyContent
+        { Api.txIns
+        , Api.txInsCollateral
+        , Api.txInsReference
+        , Api.txOuts
+        , Api.txTotalCollateral
+        , Api.txReturnCollateral
+        , Api.txFee
+        , Api.txValidityLowerBound
+        , Api.txValidityUpperBound
+        , Api.txMetadata
+        , Api.txAuxScripts
+        , Api.txExtraKeyWits
+        , Api.txProtocolParams
+        , Api.txWithdrawals
+        , Api.txCertificates
+        , Api.txUpdateProposal
+        , Api.txMintValue
+        , Api.txScriptValidity
+        , Api.txProposalProcedures
+        , Api.txVotingProcedures
+        }
+  )
+  era
+
 
 genTxInsCollateral :: CardanoEra era -> Gen (TxInsCollateral era)
 genTxInsCollateral =
@@ -696,9 +706,9 @@ genTxInsReference =
     (const (pure TxInsReferenceNone))
     (\w -> TxInsReference w <$> Gen.list (Range.linear 0 10) genTxIn)
 
-genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral CtxTx era)
+genTxReturnCollateral :: ShelleyBasedEra era -> Gen (TxReturnCollateral CtxTx era)
 genTxReturnCollateral era =
-  forEraInEon era
+  forEraInEon (toCardanoEra era)
     (pure TxReturnCollateralNone)
     (\w -> TxReturnCollateral w <$>  genTxOutTxContext era)
 
@@ -711,7 +721,7 @@ genTxTotalCollateral =
 genTxFee :: CardanoEra era -> Gen (TxFee era)
 genTxFee =
   caseByronOrShelleyBasedEra
-    (pure . TxFeeImplicit)
+    undefined -- (pure . TxFeeImplicit)
     (\w -> TxFeeExplicit w <$> genLovelace)
 
 genTxBody :: CardanoEra era -> Gen (TxBody era)
@@ -761,7 +771,7 @@ genTx era =
 genWitnesses :: CardanoEra era -> Gen [KeyWitness era]
 genWitnesses =
   caseByronOrShelleyBasedEra
-    (Gen.list (Range.constant 1 10) . genByronKeyWitness)
+    (Gen.list (Range.constant 1 10) . (error "genByronKeyWitness"))
     (\sbe -> do
       bsWits  <- Gen.list (Range.constant 0 10) (genShelleyBootstrapWitness sbe)
       keyWits <- Gen.list (Range.constant 0 10) (genShelleyKeyWitness sbe)
@@ -775,7 +785,7 @@ genVerificationKey :: ()
     => HasTypeProxy keyrole
 #endif
     => Key keyrole
-    => AsType keyrole
+    => ShelleyApi.AsType keyrole
     -> Gen (VerificationKey keyrole)
 genVerificationKey roletoken = getVerificationKey <$> genSigningKey roletoken
 
@@ -786,7 +796,7 @@ genVerificationKeyHash :: ()
     => HasTypeProxy keyrole
 #endif
     => Key keyrole
-    => AsType keyrole
+    => ShelleyApi.AsType keyrole
     -> Gen (Hash keyrole)
 genVerificationKeyHash roletoken =
   verificationKeyHash <$> genVerificationKey roletoken
@@ -843,7 +853,7 @@ genShelleyWitnessSigningKey =
 genCardanoKeyWitness :: ()
   => CardanoEra era
   -> Gen (KeyWitness era)
-genCardanoKeyWitness = caseByronOrShelleyBasedEra genByronKeyWitness genShelleyWitness
+genCardanoKeyWitness = caseByronOrShelleyBasedEra (error "genByronKeyWitness") genShelleyWitness
 
 genSeed :: Int -> Gen Crypto.Seed
 genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)
@@ -974,50 +984,54 @@ genExecutionUnits = ExecutionUnits <$> Gen.integral (Range.constant 0 1000)
 genExecutionUnitPrices :: Gen ExecutionUnitPrices
 genExecutionUnitPrices = ExecutionUnitPrices <$> genRational <*> genRational
 
-genTxOutDatumHashTxContext :: CardanoEra era -> Gen (TxOutDatum CtxTx era)
+genTxOutDatumHashTxContext :: ShelleyBasedEra era -> Gen (TxOutDatum CtxTx era)
 genTxOutDatumHashTxContext era = case era of
-    ByronEra   -> pure TxOutDatumNone
-    ShelleyEra -> pure TxOutDatumNone
-    AllegraEra -> pure TxOutDatumNone
-    MaryEra    -> pure TxOutDatumNone
-    AlonzoEra  -> Gen.choice
-                    [ pure TxOutDatumNone
-                    , TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData
-                    , TxOutDatumInTx AlonzoEraOnwardsAlonzo <$> genHashableScriptData
-                    ]
-    BabbageEra -> Gen.choice
-                    [ pure TxOutDatumNone
-                    , TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData
-                    , TxOutDatumInTx AlonzoEraOnwardsBabbage <$> genHashableScriptData
-                    , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData
-                    ]
-    ConwayEra -> Gen.choice
-                    [ pure TxOutDatumNone
-                    , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
-                    , TxOutDatumInTx AlonzoEraOnwardsConway <$> genHashableScriptData
-                    , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
-                    ]
-
-genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era)
+    ShelleyBasedEraShelley -> pure TxOutDatumNone
+    ShelleyBasedEraAllegra -> pure TxOutDatumNone
+    ShelleyBasedEraMary    -> pure TxOutDatumNone
+    ShelleyBasedEraAlonzo  ->
+      Gen.choice
+        [ pure TxOutDatumNone
+        , TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData
+        , TxOutDatumInTx AlonzoEraOnwardsAlonzo <$> genHashableScriptData
+        ]
+    ShelleyBasedEraBabbage ->
+      Gen.choice
+        [ pure TxOutDatumNone
+        , TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData
+        , TxOutDatumInTx AlonzoEraOnwardsBabbage <$> genHashableScriptData
+        , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData
+        ]
+    ShelleyBasedEraConway ->
+      Gen.choice
+        [ pure TxOutDatumNone
+        , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
+        , TxOutDatumInTx AlonzoEraOnwardsConway <$> genHashableScriptData
+        , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
+        ]
+
+genTxOutDatumHashUTxOContext :: ShelleyBasedEra era -> Gen (TxOutDatum CtxUTxO era)
 genTxOutDatumHashUTxOContext era = case era of
-    ByronEra   -> pure TxOutDatumNone
-    ShelleyEra -> pure TxOutDatumNone
-    AllegraEra -> pure TxOutDatumNone
-    MaryEra    -> pure TxOutDatumNone
-    AlonzoEra  -> Gen.choice
-                    [ pure TxOutDatumNone
-                    , TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData
-                    ]
-    BabbageEra -> Gen.choice
-                    [ pure TxOutDatumNone
-                    , TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData
-                    , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData
-                    ]
-    ConwayEra -> Gen.choice
-                    [ pure TxOutDatumNone
-                    , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
-                    , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
-                    ]
+    ShelleyBasedEraShelley -> pure TxOutDatumNone
+    ShelleyBasedEraAllegra -> pure TxOutDatumNone
+    ShelleyBasedEraMary    -> pure TxOutDatumNone
+    ShelleyBasedEraAlonzo  ->
+      Gen.choice
+        [ pure TxOutDatumNone
+        , TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData
+        ]
+    ShelleyBasedEraBabbage ->
+      Gen.choice
+        [ pure TxOutDatumNone
+        , TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData
+        , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData
+        ]
+    ShelleyBasedEraConway ->
+      Gen.choice
+        [ pure TxOutDatumNone
+        , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData
+        , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData
+        ]
 
 mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a
 mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR
@@ -1051,7 +1065,7 @@ genProposal :: ConwayEraOnwards era -> Gen (Proposal era)
 genProposal w =
   conwayEraOnwardsTestConstraints w $ fmap Proposal Q.arbitrary
 
-genVotingProcedures :: ConwayEraOnwards era -> Gen (VotingProcedures era)
+genVotingProcedures :: ConwayEraOnwards era -> Gen (ShelleyApi.VotingProcedures era)
 genVotingProcedures w =
   conwayEraOnwardsConstraints w
-    $ VotingProcedures <$> Q.arbitrary
+    $ ShelleyApi.VotingProcedures <$> Q.arbitrary