Fix calculate-min-utxo cli command and add round trip JSON test for

ProtocolParameters

cardano-api/cardano-api.cabal

@@ -192,6 +192,7 @@ test-suite cardano-api-test
                         Test.Cardano.Api.Typed.CBOR
                         Test.Cardano.Api.Typed.Envelope
                         Test.Cardano.Api.Typed.Gen
+                        Test.Cardano.Api.Typed.JSON
                         Test.Cardano.Api.Typed.MultiSig.Allegra
                         Test.Cardano.Api.Typed.MultiSig.Mary
                         Test.Cardano.Api.Typed.MultiSig.Shelley

cardano-api/src/Cardano/Api/ProtocolParameters.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -49,10 +50,12 @@ module Cardano.Api.ProtocolParameters (
 
 import           Prelude
 
-import           Data.Aeson (ToJSON)
+import           Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=))
+import qualified Data.Aeson as Aeson
 import           Data.ByteString (ByteString)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
 import           Data.Time (NominalDiffTime, UTCTime)
 import           GHC.Generics
 import           Numeric.Natural
@@ -211,7 +214,48 @@ data ProtocolParameters =
     }
   deriving (Eq, Generic, Show)
 
-deriving instance ToJSON ProtocolParameters
+instance FromJSON ProtocolParameters where
+  parseJSON = withObject "ProtocolParameters" $ \o -> do
+                v <- o .: "protocolVersion"
+                ProtocolParameters
+                        <$> ((,) <$> v .: "major" <*> v .: "minor")
+                        <*> o .: "decentralization"
+                        <*> o .: "extraPraosEntropy"
+                        <*> o .: "maxBlockHeaderSize"
+                        <*> o .: "maxBlockBodySize"
+                        <*> o .: "maxTxSize"
+                        <*> o .: "txFeeFixed"
+                        <*> o .: "txFeePerByte"
+                        <*> o .: "minUTxOValue"
+                        <*> o .: "stakeAddressDeposit"
+                        <*> o .: "stakePoolDeposit"
+                        <*> o .: "minPoolCost"
+                        <*> o .: "poolRetireMaxEpoch"
+                        <*> o .: "stakePoolTargetNum"
+                        <*> o .: "poolPledgeInfluence"
+                        <*> o .: "monetaryExpansion"
+                        <*> o .: "treasuryCut"
+
+instance ToJSON ProtocolParameters where
+  toJSON pp = object [ "extraPraosEntropy" .= protocolParamExtraPraosEntropy pp
+                     , "stakePoolTargetNum" .= protocolParamStakePoolTargetNum pp
+                     , "poolRetireMaxEpoch" .= protocolParamPoolRetireMaxEpoch pp
+                     , "decentralization" .= protocolParamDecentralization pp
+                     , "stakePoolDeposit" .= protocolParamStakePoolDeposit pp
+                     , "maxBlockHeaderSize" .= protocolParamMaxBlockHeaderSize pp
+                     , "maxBlockBodySize" .= protocolParamMaxBlockBodySize pp
+                     , "maxTxSize" .= protocolParamMaxTxSize pp
+                     , "treasuryCut" .= protocolParamTreasuryCut pp
+                     , "minPoolCost" .= protocolParamMinPoolCost pp
+                     , "monetaryExpansion" .= protocolParamMonetaryExpansion pp
+                     , "stakeAddressDeposit" .= protocolParamStakeAddressDeposit pp
+                     , "poolPledgeInfluence" .= protocolParamPoolPledgeInfluence pp
+                     , "protocolVersion" .= let (major, minor) = protocolParamProtocolVersion pp
+                                            in object ["major" .= major, "minor" .= minor]
+                     , "txFeeFixed" .= protocolParamTxFeeFixed pp
+                     , "txFeePerByte" .= protocolParamTxFeePerByte pp
+                     , "minUTxOValue"  .= protocolParamMinUTxOValue pp
+                     ]
 
 -- ----------------------------------------------------------------------------
 -- Updates to the protocol paramaters
@@ -390,7 +434,15 @@ instance Monoid ProtocolParametersUpdate where
 newtype PraosNonce = PraosNonce (Shelley.Hash StandardCrypto ByteString)
   deriving (Eq, Ord, Show, Generic)
 
-deriving instance ToJSON PraosNonce
+instance ToJSON PraosNonce where
+  toJSON (PraosNonce h) =
+    Aeson.String $ Crypto.hashToTextAsHex h
+
+instance FromJSON PraosNonce where
+  parseJSON = withText "PraosNonce" $ \h ->
+                case Crypto.hashFromTextAsHex h of
+                  Nothing -> fail $ "Failed to decode PraosNonce: " <> Text.unpack h
+                  Just nonce -> return $ PraosNonce nonce
 
 makePraosNonce :: ByteString -> PraosNonce
 makePraosNonce = PraosNonce . Crypto.hashWith id

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

@@ -6,6 +6,8 @@
 module Test.Cardano.Api.Typed.Gen
   ( genAddressByron
   , genAddressShelley
+  , genMaybePraosNonce
+  , genProtocolParameters
   , genValueNestedRep
   , genValueNestedBundle
   , genByronKeyWitness
@@ -30,6 +32,7 @@ module Test.Cardano.Api.Typed.Gen
   , genVerificationKey
   ) where
 
+import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.Typed
 
 import           Cardano.Prelude
@@ -626,3 +629,38 @@ genShelleyWitnessSigningKey =
 
 genSeed :: Int -> Gen Crypto.Seed
 genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)
+
+genNat :: Gen Natural
+genNat = Gen.integral (Range.linear 0 10)
+
+genRational :: Gen Rational
+genRational = Gen.realFrac_ (Range.linearFrac 0 1)
+
+genEpochNo :: Gen EpochNo
+genEpochNo = EpochNo <$> Gen.word64 (Range.linear 0 10)
+
+genMaybePraosNonce :: Gen (Maybe PraosNonce)
+genMaybePraosNonce =
+  Gen.maybe (makePraosNonce <$> Gen.bytes (Range.linear 0 32))
+
+genProtocolParameters :: Gen ProtocolParameters
+genProtocolParameters =
+  ProtocolParameters
+    <$> ((,) <$> genNat <*> genNat)
+    <*> genRational
+    <*> genMaybePraosNonce
+    <*> genNat
+    <*> genNat
+    <*> genNat
+    <*> genNat
+    <*> genNat
+    <*> genLovelace
+    <*> genLovelace
+    <*> genLovelace
+    <*> genLovelace
+    <*> genEpochNo
+    <*> genNat
+    <*> genRational
+    <*> genRational
+    <*> genRational
+

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

@@ -0,0 +1,50 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Test.Cardano.Api.Typed.JSON
+  ( tests
+  ) where
+
+import           Cardano.Api
+import           Cardano.Prelude
+
+import           Data.Aeson
+
+import           Hedgehog (Gen, Property, discover, forAll, tripping)
+import qualified Hedgehog as H
+import qualified Hedgehog.Gen as Gen
+import           Test.Tasty (TestTree)
+import           Test.Tasty.Hedgehog.Group (fromGroup)
+
+import           Test.Cardano.Api.Typed.Gen
+
+
+{- HLINT ignore "Use camelCase" -}
+
+prop_roundtrip_praos_nonce_JSON :: Property
+prop_roundtrip_praos_nonce_JSON = H.property $ do
+  pNonce <- forAll $ Gen.just genMaybePraosNonce
+  tripping pNonce encode eitherDecode
+
+prop_roundtrip_protocol_parameters_JSON :: Property
+prop_roundtrip_protocol_parameters_JSON = H.property $ do
+  pp <- forAll genProtocolParameters
+  tripping pp encode eitherDecode
+
+
+-- -----------------------------------------------------------------------------
+
+roundtrip_CBOR
+  :: (SerialiseAsCBOR a, Eq a, Show a)
+  => AsType a -> Gen a -> Property
+roundtrip_CBOR typeProxy gen =
+  H.property $ do
+    val <- H.forAll gen
+    H.tripping val serialiseToCBOR (deserialiseFromCBOR typeProxy)
+
+
+
+-- -----------------------------------------------------------------------------
+
+tests :: TestTree
+tests = fromGroup $$discover

cardano-api/test/cardano-api-test.hs

@@ -10,6 +10,7 @@ import qualified Test.Cardano.Api.Metadata
 import qualified Test.Cardano.Api.Typed.Bech32
 import qualified Test.Cardano.Api.Typed.CBOR
 import qualified Test.Cardano.Api.Typed.Envelope
+import qualified Test.Cardano.Api.Typed.JSON
 import qualified Test.Cardano.Api.Typed.MultiSig.Allegra
 import qualified Test.Cardano.Api.Typed.MultiSig.Mary
 import qualified Test.Cardano.Api.Typed.RawBytes
@@ -31,6 +32,7 @@ tests =
     , Test.Cardano.Api.Typed.Bech32.tests
     , Test.Cardano.Api.Typed.CBOR.tests
     , Test.Cardano.Api.Typed.Envelope.tests
+    , Test.Cardano.Api.Typed.JSON.tests
     , Test.Cardano.Api.Typed.MultiSig.Allegra.tests
     , Test.Cardano.Api.Typed.MultiSig.Mary.tests
     , Test.Cardano.Api.Typed.RawBytes.tests

cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs

@@ -27,14 +27,14 @@ import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT
 import           Cardano.Api
 import           Cardano.Api.Byron hiding (SomeByronSigningKey (..))
 import qualified Cardano.Api.IPC as NewIPC
+import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.Shelley
 import           Cardano.Api.TxInMode
 import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley)
 
 --TODO: do this nicely via the API too:
 import qualified Cardano.Binary as CBOR
 
-import qualified Shelley.Spec.Ledger.PParams as Shelley
 --TODO: following import needed for orphan Eq Script instance
 import           Cardano.Ledger.ShelleyMA.TxBody ()
 import           Shelley.Spec.Ledger.Scripts ()
@@ -553,8 +553,8 @@ runTxCalculateMinFee (TxBodyFile txbodyFile) nw pParamsFile
     let tx = makeSignedTransaction [] txbody
         Lovelace fee = estimateTransactionFee
                              (fromMaybe Mainnet nw)
-                             (Shelley._minfeeB pparams) --TODO: do this better
-                             (Shelley._minfeeA pparams)
+                             (protocolParamTxFeeFixed pparams)
+                             (protocolParamTxFeePerByte pparams)
                              tx
                              nInputs nOutputs
                              nByronKeyWitnesses nShelleyKeyWitnesses
@@ -569,7 +569,7 @@ runTxCreatePolicyId (ScriptFile sFile) = do
 --TODO: eliminate this and get only the necessary params, and get them in a more
 -- helpful way rather than requiring them as a local file.
 readProtocolParameters :: ProtocolParamsFile
-                       -> ExceptT ShelleyTxCmdError IO (Shelley.PParams StandardShelley)
+                       -> ExceptT ShelleyTxCmdError IO ProtocolParameters
 readProtocolParameters (ProtocolParamsFile fpath) = do
   pparams <- handleIOExceptT (ShelleyTxCmdReadFileError . FileIOError fpath) $ LBS.readFile fpath
   firstExceptT (ShelleyTxCmdAesonDecodeProtocolParamsError fpath . Text.pack) . hoistEither $

cardano-cli/test/Test/Golden/Shelley/Transaction/CalculateMinFee.hs

@@ -32,6 +32,6 @@ golden_shelleyTransactionCalculateMinFee = propertyOnce $ H.moduleWorkspace "tmp
 
   H.writeFile minFeeTxtFile minFeeTxt
 
-  H.assertFileOccurences 1 "2541502" minFeeTxtFile
+  H.assertFileOccurences 1 "5083100" minFeeTxtFile
   H.assertFileLines (== 1) minFeeTxtFile
   H.assertEndsWithSingleNewline minFeeTxtFile

cardano-cli/test/data/golden/shelley/transaction-calculate-min-fee/protocol-params.json

@@ -1,24 +1,34 @@
 {
-    "poolDeposit": 0,
-    "protocolVersion": {
-        "minor": 0,
-        "major": 0
+    "extraPraosEntropy": null,
+    "stakePoolTargetNum": 100,
+    "poolRetireMaxEpoch": 18,
+    "decentralization": {
+        "denominator": 10,
+        "numerator": 7
     },
-    "decentralisationParam": 0.99,
-    "maxTxSize": 2048,
-    "minFeeA": 500,
-    "maxBlockBodySize": 2097152,
-    "minFeeB": 2,
-    "minUTxOValue": 1,
-    "minPoolCost": 100,
-    "eMax": 0,
-    "extraEntropy": {
-        "tag": "NeutralNonce"
+    "stakePoolDeposit": 0,
+    "maxBlockHeaderSize": 1100,
+    "maxBlockBodySize": 65536,
+    "maxTxSize": 16384,
+    "treasuryCut": {
+        "denominator": 1,
+        "numerator": 0
     },
-    "maxBlockHeaderSize": 8192,
-    "keyDeposit": 0,
-    "nOpt": 100,
-    "rho": 0,
-    "tau": 0,
-    "a0": 0
-}
+    "minPoolCost": 0,
+    "monetaryExpansion": {
+        "denominator": 1,
+        "numerator": 0
+    },
+    "stakeAddressDeposit": 0,
+    "poolPledgeInfluence": {
+        "denominator": 1,
+        "numerator": 0
+    },
+    "protocolVersion": [
+        2,
+        0
+    ],
+    "txFeeFixed": 100,
+    "txFeePerByte": 1000,
+    "minUTxOValue": 1234556
+}