generate garbage

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

@@ -321,8 +321,7 @@ genScriptInEra era =
   Gen.choice
     [ ScriptInEra langInEra <$> genScript lang
     | AnyScriptLanguage lang <- [minBound .. maxBound]
-    , -- TODO: scriptLanguageSupportedInEra should be parameterized on ShelleyBasedEra
-    Just langInEra <- [scriptLanguageSupportedInEra era lang]
+    , Just langInEra <- [scriptLanguageSupportedInEra era lang]
     ]
 
 genScriptHash :: Gen ScriptHash
@@ -654,7 +653,7 @@ genTxMintValue =
     ( \supported ->
         Gen.choice
           [ pure TxMintNone
-          , TxMintValue supported <$> genValueForMinting supported <*> return (BuildTxWith mempty)
+          , TxMintValue supported <$> genValueForMinting supported <*> return (BuildTxWith mempty) -- FIXME!!!
           ]
     )
 
@@ -1127,7 +1126,7 @@ genGovernancePollAnswer =
     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
+-- script witnesses in the api and then propagate to the cli !!!
 genProposals :: ConwayEraOnwards era -> Gen (TxProposalProcedures BuildTx era)
 genProposals w =
   conwayEraOnwardsConstraints w $
@@ -1146,7 +1145,7 @@ genProposal :: ConwayEraOnwards era -> Gen (L.ProposalProcedure (ShelleyLedgerEr
 genProposal w =
   conwayEraOnwardsTestConstraints w Q.arbitrary
 
--- TODO: Generate map of script witnesses
+-- TODO: Generate map of script witnesses !!!
 genVotingProcedures :: ConwayEraOnwards era -> Gen (Api.TxVotingProcedures BuildTx era)
 genVotingProcedures w =
   conwayEraOnwardsConstraints w $
@@ -1157,3 +1156,22 @@ genCurrentTreasuryValue _era = Q.arbitrary
 
 genTreasuryDonation :: ConwayEraOnwards era -> Gen L.Coin
 genTreasuryDonation _era = Q.arbitrary
+
+genScriptWitness :: ShelleyBasedEra era -> Gen (Api.ScriptWitness witctx era)
+genScriptWitness sbe = Gen.choice [genSimpleWitness, genPlutusWitness]
+  where
+    genSimpleWitness = do
+      script <- genScript Api.SimpleScriptLanguage
+      let scriptLanguageInEra' = fromMaybe (error "scriptLanguageSupportedInEra is not total for SimpleScriptLanguage") $
+            Api.scriptLanguageSupportedInEra sbe Api.SimpleScriptLanguage
+      Api.SimpleScriptWitness scriptLanguageInEra' <$> genSimpleScriptOrReferenceInput
+
+    genPlutusWitness = do
+      ScriptInEra scriptLangInEra (PlutusScript plutusScriptVersion' plutusScript) <- genScriptInEra sbe
+      pure $ PlutusScriptWitness scriptLangInEra plutusScriptVersion' undefined  undefined undefined undefined
+
+genSimpleScriptOrReferenceInput :: Gen (SimpleScriptOrReferenceInput lang)
+genSimpleScriptOrReferenceInput = Gen.choice [SScript <$> genSimpleScript, genReferenceScript']
+  where
+    genReferenceScript' = SReferenceScript <$> genTxIn <*> Gen.maybe genScriptHash
+

cardano-api/internal/Cardano/Api/Tx/Body.hs

@@ -1201,6 +1201,7 @@ data TxVotingProcedures build era where
   TxVotingProceduresNone :: TxVotingProcedures build era
   TxVotingProcedures
     :: L.VotingProcedures (ShelleyLedgerEra era)
+    -- TODO possible bug
     -> BuildTxWith
         build
         (Map (Ledger.Voter (Ledger.EraCrypto (ShelleyLedgerEra era))) (ScriptWitness WitCtxStake era))
@@ -2372,6 +2373,7 @@ convVotingProcedures :: TxVotingProcedures build era -> L.VotingProcedures (Shel
 convVotingProcedures txVotingProcedures =
   case txVotingProcedures of
     TxVotingProceduresNone -> L.VotingProcedures Map.empty
+    -- TODO possible bug
     TxVotingProcedures vps _ -> vps
 
 guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError ()

cardano-api/test/cardano-api-test/Test/Cardano/Api/Typed/TxBody.hs

@@ -36,6 +36,7 @@ prop_roundtrip_txbodycontent_txouts =
     -- Convert ledger body back via 'getTxBodyContent' and 'fromLedgerTxBody'
     let (TxBody content') = body
     matchTxOuts (txOuts content) (txOuts content')
+    H.failure
  where
   matchTxOuts :: MonadTest m => [TxOut CtxTx BabbageEra] -> [TxOut CtxTx BabbageEra] -> m ()
   matchTxOuts as bs =