Ensure valid ProtocolParameters by doing roundtrip

IntersectMBO · Feb 26, 2024 · 1fecdea · 1fecdea
1 parent 2ea50ed
commit 1fecdea
Showing 1 changed file with 24 additions and 7 deletions.
diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/ProtocolParameters.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/ProtocolParameters.hs
@@ -4,7 +4,7 @@
 module Test.Cardano.Api.ProtocolParameters(tests) where
 
 import Cardano.Api.Ledger (PParams(..))
-import Cardano.Api.ProtocolParameters (ProtocolParameters (..), convertToLedgerProtocolParameters, LedgerProtocolParameters (..))
+import Cardano.Api.ProtocolParameters (ProtocolParameters (..), convertToLedgerProtocolParameters, LedgerProtocolParameters (..), fromLedgerPParams)
 import Hedgehog (Property, property, forAll, (===), Gen, success, footnote)
 import Cardano.Api (CardanoEra (..), inEonForEra, ToJSON, prettyPrintJSON, ProtocolParametersConversionError, FromJSON)
 import Cardano.Api.Eon.ShelleyBasedEra(ShelleyBasedEra(..), ShelleyLedgerEra)
@@ -28,20 +28,29 @@ tests =
                           , testProperty "AlonzoEra" $ protocolParametersAreCompatible AlonzoEra
                           , testProperty "BabbageEra" $ protocolParametersAreCompatible BabbageEra
                           ]
+              , testGroup "PParams roundtrip"
+                          [ testProperty "ShelleyEra" $ ppParamsRoundtrip ShelleyEra
+                          , testProperty "AlonzoEra" $ ppParamsRoundtrip AlonzoEra
+                          , testProperty "BabbageEra" $ ppParamsRoundtrip BabbageEra
+                          ]
               ]
 
 protocolParametersSerializeTheSame :: forall era. ToJSON (PParams (ShelleyLedgerEra era)) => CardanoEra era -> Property
 protocolParametersSerializeTheSame era =
    property $ do protocolParameters <- forAll (genProtocolParameters era :: Gen ProtocolParameters)
-                 let protocolParametersBS = prettyPrintJSON protocolParameters :: ByteString
                  case convertToEraAndSerialize protocolParameters of
                    Left _ -> success -- fail (show err)
-                   Right pParamsBS -> do footnote $ "Decentralization parameter was: " <> show (protocolParamDecentralization protocolParameters)
-                                         pParamsBS === protocolParametersBS
+                   Right (roundTrippedProtocolParams, pParamsBS) ->
+                    do footnote $ "Decentralization parameter was: " <> show (protocolParamDecentralization protocolParameters)
+                       pParamsBS === prettyPrintJSON roundTrippedProtocolParams
    where
-   convertToEraAndSerialize :: ProtocolParameters -> Either ProtocolParametersConversionError ByteString
-   convertToEraAndSerialize pp =
-     prettyPrintJSON . unLedgerProtocolParameters <$> convertToLedgerProtocolParameters (toShelleyBased era) pp
+   convertToEraAndSerialize :: ProtocolParameters -> Either ProtocolParametersConversionError (ProtocolParameters, ByteString)
+   convertToEraAndSerialize pp = do
+     firstConversion <- convertToLedgerProtocolParameters sbe pp :: (Either ProtocolParametersConversionError (LedgerProtocolParameters era))
+     let roundTrippedProtocolParams = fromLedgerPParams sbe $ unLedgerProtocolParameters firstConversion
+     secondConversion <- convertToLedgerProtocolParameters sbe roundTrippedProtocolParams
+     return (roundTrippedProtocolParams, prettyPrintJSON . unLedgerProtocolParameters $ secondConversion)
+     where sbe = toShelleyBased era
 
    toShelleyBased :: CardanoEra era -> ShelleyBasedEra era
    toShelleyBased = inEonForEra (error "Not a Shelley-based era") id
@@ -53,3 +62,11 @@ protocolParametersAreCompatible era =
                  case eitherDecode protocolParametersBS :: Either String (PParams (ShelleyLedgerEra era)) of
                    Left err -> fail err
                    Right _ -> success
+
+ppParamsRoundtrip :: forall era. (FromJSON (PParams (ShelleyLedgerEra era)), ToJSON (PParams (ShelleyLedgerEra era))) => CardanoEra era -> Property
+ppParamsRoundtrip era =
+   property $ do protocolParameters <- forAll (genProtocolParameters era :: Gen ProtocolParameters)
+                 let protocolParametersBS = encode protocolParameters :: LBS.ByteString
+                 case eitherDecode protocolParametersBS :: Either String (PParams (ShelleyLedgerEra era)) of
+                   Left err -> fail err
+                   Right pParams -> do encode pParams === protocolParametersBS