Add functions to convert from Shelley update proposal types

So we now have conversions in both directions.
IntersectMBO · Nov 21, 2020 · dfdb712 · dfdb712
1 parent 3225463
commit dfdb712
Show file tree

Hide file tree

Showing 2 changed files with 73 additions and 4 deletions.
diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs
@@ -31,6 +31,7 @@ import           Prelude
 import           Numeric.Natural
 import           Data.ByteString (ByteString)
 import qualified Data.Map.Strict as Map
+import           Data.Map.Strict (Map)
 
 import           Control.Monad
 
@@ -39,7 +40,8 @@ import qualified Cardano.Crypto.Hash.Class as Crypto
 import           Ouroboros.Consensus.Shelley.Eras (StandardShelley)
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 
-import           Shelley.Spec.Ledger.BaseTypes (maybeToStrictMaybe)
+import           Shelley.Spec.Ledger.BaseTypes
+                   (maybeToStrictMaybe, strictMaybeToMaybe)
 import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 import qualified Shelley.Spec.Ledger.Keys as Shelley
 import qualified Shelley.Spec.Ledger.PParams as Shelley
@@ -287,11 +289,11 @@ toShelleyPParamsUpdate
     , Shelley._eMax        = maybeToStrictMaybe protocolUpdatePoolRetireMaxEpoch
     , Shelley._nOpt        = maybeToStrictMaybe protocolUpdateStakePoolTargetNum
     , Shelley._a0          = maybeToStrictMaybe protocolUpdatePoolPledgeInfluence
-    , Shelley._rho         = Shelley.truncateUnitInterval . fromRational <$>
+    , Shelley._rho         = Shelley.unitIntervalFromRational <$>
                                maybeToStrictMaybe protocolUpdateMonetaryExpansion
-    , Shelley._tau         = Shelley.truncateUnitInterval . fromRational <$>
+    , Shelley._tau         = Shelley.unitIntervalFromRational <$>
                                maybeToStrictMaybe protocolUpdateTreasuryCut
-    , Shelley._d           = Shelley.truncateUnitInterval . fromRational <$>
+    , Shelley._d           = Shelley.unitIntervalFromRational <$>
                                maybeToStrictMaybe protocolUpdateDecentralization
     , Shelley._extraEntropy    = toShelleyNonce <$>
                                    maybeToStrictMaybe protocolUpdateExtraPraosEntropy
@@ -303,6 +305,69 @@ toShelleyPParamsUpdate
                                    maybeToStrictMaybe protocolUpdateMinPoolCost
     }
 
+fromShelleyUpdate :: Shelley.Update StandardShelley -> UpdateProposal
+fromShelleyUpdate = UpdateProposal
+
+
+fromShelleyProposedPPUpdates :: Shelley.ProposedPPUpdates StandardShelley
+                             -> Map (Hash GenesisKey) ProtocolParametersUpdate
+fromShelleyProposedPPUpdates =
+    Map.map fromShelleyPParamsUpdate
+  . Map.mapKeysMonotonic GenesisKeyHash
+  . (\(Shelley.ProposedPPUpdates ppup) -> ppup)
+
+
+fromShelleyPParamsUpdate :: Shelley.PParamsUpdate StandardShelley
+                         -> ProtocolParametersUpdate
+fromShelleyPParamsUpdate
+    Shelley.PParams {
+      Shelley._minfeeA
+    , Shelley._minfeeB
+    , Shelley._maxBBSize
+    , Shelley._maxTxSize
+    , Shelley._maxBHSize
+    , Shelley._keyDeposit
+    , Shelley._poolDeposit
+    , Shelley._eMax
+    , Shelley._nOpt
+    , Shelley._a0
+    , Shelley._rho
+    , Shelley._tau
+    , Shelley._d
+    , Shelley._extraEntropy
+    , Shelley._protocolVersion
+    , Shelley._minUTxOValue
+    , Shelley._minPoolCost
+    } =
+    ProtocolParametersUpdate {
+      protocolUpdateProtocolVersion     = (\(Shelley.ProtVer a b) -> (a,b)) <$>
+                                          strictMaybeToMaybe _protocolVersion
+    , protocolUpdateDecentralization    = Shelley.unitIntervalToRational <$>
+                                            strictMaybeToMaybe _d
+    , protocolUpdateExtraPraosEntropy   = fromPraosNonce <$>
+                                            strictMaybeToMaybe _extraEntropy
+    , protocolUpdateMaxBlockHeaderSize  = strictMaybeToMaybe _maxBHSize
+    , protocolUpdateMaxBlockBodySize    = strictMaybeToMaybe _maxBBSize
+    , protocolUpdateMaxTxSize           = strictMaybeToMaybe _maxTxSize
+    , protocolUpdateTxFeeFixed          = strictMaybeToMaybe _minfeeB
+    , protocolUpdateTxFeePerByte        = strictMaybeToMaybe _minfeeA
+    , protocolUpdateMinUTxOValue        = fromShelleyLovelace <$>
+                                            strictMaybeToMaybe _minUTxOValue
+    , protocolUpdateStakeAddressDeposit = fromShelleyLovelace <$>
+                                            strictMaybeToMaybe _keyDeposit
+    , protocolUpdateStakePoolDeposit    = fromShelleyLovelace <$>
+                                            strictMaybeToMaybe _poolDeposit
+    , protocolUpdateMinPoolCost         = fromShelleyLovelace <$>
+                                            strictMaybeToMaybe _minPoolCost
+    , protocolUpdatePoolRetireMaxEpoch  = strictMaybeToMaybe _eMax
+    , protocolUpdateStakePoolTargetNum  = strictMaybeToMaybe _nOpt
+    , protocolUpdatePoolPledgeInfluence = strictMaybeToMaybe _a0
+    , protocolUpdateMonetaryExpansion   = Shelley.unitIntervalToRational <$>
+                                            strictMaybeToMaybe _rho
+    , protocolUpdateTreasuryCut         = Shelley.unitIntervalToRational <$>
+                                            strictMaybeToMaybe _tau
+    }
+
 
 -- ----------------------------------------------------------------------------
 -- Praos nonce

diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs
@@ -34,6 +34,7 @@ module Cardano.Api.Value
 
     -- * Internal conversion functions
   , toShelleyLovelace
+  , fromShelleyLovelace
   ) where
 
 import           Prelude
@@ -68,6 +69,9 @@ toShelleyLovelace :: Lovelace -> Shelley.Coin
 toShelleyLovelace (Lovelace l) = Shelley.Coin l
 --TODO: validate bounds
 
+fromShelleyLovelace :: Shelley.Coin -> Lovelace
+fromShelleyLovelace (Shelley.Coin l) = Lovelace l
+
 
 -- ----------------------------------------------------------------------------
 -- Multi asset Value