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 index 034e7623bd..400f1ca416 100644 --- 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