Fix test generation of Rational protocol parameter values

They have to fit into a UnitInterval. We also need validation.
IntersectMBO · Jun 8, 2021 · 3cba3b2 · 3cba3b2
1 parent 3915b99
commit 3cba3b2
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 3 deletions.
diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs
@@ -823,6 +823,8 @@ makeShelleyUpdateProposal :: ProtocolParametersUpdate
                           -> UpdateProposal
 makeShelleyUpdateProposal params genesisKeyHashes =
     --TODO decide how to handle parameter validation
+    --     for example we need to validate the Rational values can convert
+    --     into the UnitInterval type ok.
     UpdateProposal (Map.fromList [ (kh, params) | kh <- genesisKeyHashes ])
 
 

diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs
@@ -2097,7 +2097,8 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo
     case txProtocolParams of
       BuildTxWith Nothing | not (Set.null languages)
         -> Left TxBodyMissingProtocolParams
-      _ -> return ()
+      _ -> return () --TODO alonzo: validate protocol params for the Alonzo era.
+                     --             All the necessary params must be provided.
 
     return $
       ShelleyTxBody era

diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs
@@ -55,7 +55,7 @@ import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Crypto.Seed as Crypto
 import qualified Shelley.Spec.Ledger.TxBody as Ledger (EraIndependentTxBody)
-
+import qualified Cardano.Ledger.BaseTypes as Ledger
 
 import           Hedgehog (Gen, Range)
 import qualified Hedgehog.Gen as Gen
@@ -683,7 +683,12 @@ genNat :: Gen Natural
 genNat = Gen.integral (Range.linear 0 10)
 
 genRational :: Gen Rational
-genRational = Gen.realFrac_ (Range.linearFrac 0 1)
+genRational = Ledger.unitIntervalToRational <$> genUnitInterval
+
+genUnitInterval :: Gen Ledger.UnitInterval
+genUnitInterval =
+  Gen.just $
+    Ledger.mkUnitInterval <$> Gen.realFrac_ (Range.linearFrac 0 1)
 
 genEpochNo :: Gen EpochNo
 genEpochNo = EpochNo <$> Gen.word64 (Range.linear 0 10)