generate perchance notgarbage

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

@@ -149,6 +149,7 @@ import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
 
 import           Control.Applicative (Alternative (..), optional)
+import           Control.Monad
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
@@ -160,6 +161,7 @@ import qualified Data.OSet.Strict as OSet
 import           Data.Ratio (Ratio, (%))
 import           Data.String
 import           Data.Word (Word16, Word32, Word64)
+import           GHC.Exts (IsList(..))
 import           Numeric.Natural (Natural)
 
 import           Test.Gen.Cardano.Api.Era
@@ -175,8 +177,6 @@ import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Gen.QuickCheck as Q
 import qualified Hedgehog.Range as Range
 
-{- HLINT ignore "Reduce duplication" -}
-{- HLINT ignore "Use let" -}
 
 genAddressByron :: Gen (Address ByronAddr)
 genAddressByron =
@@ -977,7 +977,7 @@ genProtocolParameters era = do
   protocolParamPoolPledgeInfluence <- genRationalInt64
   protocolParamMonetaryExpansion <- genRational
   protocolParamTreasuryCut <- genRational
-  protocolParamCostModels <- pure mempty
+  let protocolParamCostModels = mempty
   -- TODO: Babbage figure out how to deal with
   -- asymmetric cost model JSON instances
   protocolParamPrices <- Gen.maybe genExecutionUnitPrices
@@ -1125,14 +1125,15 @@ genGovernancePollAnswer =
   genGovernancePollHash =
     GovernancePollHash . mkDummyHash <$> Gen.int (Range.linear 0 10)
 
--- TODO: Left off here. Fix this then get back to incorporating proposal procedure
--- script witnesses in the api and then propagate to the cli !!!
 genProposals :: ConwayEraOnwards era -> Gen (TxProposalProcedures BuildTx era)
-genProposals w =
-  conwayEraOnwardsConstraints w $
-    TxProposalProcedures
-      <$> genTxProposalsOSet w
-      <*> return (BuildTxWith mempty)
+genProposals w = conwayEraOnwardsConstraints w $ do
+  proposals <- Gen.list (Range.constant 0 10) (genProposal w)
+  let sbe = conwayEraOnwardsToShelleyBasedEra w
+  proposalsWithWitnesses <- fmap fromList . forM proposals $ \proposal ->
+    (proposal,) <$> genScriptWitnessForStake sbe
+  TxProposalProcedures
+    <$> genTxProposalsOSet w
+    <*> return (BuildTxWith proposalsWithWitnesses)
 
 genTxProposalsOSet
   :: ConwayEraOnwards era
@@ -1145,11 +1146,13 @@ genProposal :: ConwayEraOnwards era -> Gen (L.ProposalProcedure (ShelleyLedgerEr
 genProposal w =
   conwayEraOnwardsTestConstraints w Q.arbitrary
 
--- TODO: Generate map of script witnesses !!!
 genVotingProcedures :: ConwayEraOnwards era -> Gen (Api.TxVotingProcedures BuildTx era)
-genVotingProcedures w =
-  conwayEraOnwardsConstraints w $
-    Api.TxVotingProcedures <$> Q.arbitrary <*> return (BuildTxWith mempty)
+genVotingProcedures w = conwayEraOnwardsConstraints w $ do
+  voters <- Gen.list (Range.constant 0 10) Q.arbitrary
+  let sbe = conwayEraOnwardsToShelleyBasedEra w
+  votersWithWitnesses <- fmap fromList . forM voters $ \voter ->
+    (voter,) <$> genScriptWitnessForStake sbe
+  Api.TxVotingProcedures <$> Q.arbitrary <*> return (BuildTxWith votersWithWitnesses)
 
 genCurrentTreasuryValue :: ConwayEraOnwards era -> Gen L.Coin
 genCurrentTreasuryValue _era = Q.arbitrary