Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

remove annotators from PParams FromCBOR instances #2190

Merged
merged 1 commit into from
Mar 22, 2021
Merged

remove annotators from PParams FromCBOR instances #2190

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
177 changes: 80 additions & 97 deletions alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ module Cardano.Ledger.Alonzo.PParams
where

import Cardano.Binary
( Annotator,
( Encoding,
FromCBOR (..),
ToCBOR (..),
encodePreEncoded,
Expand All @@ -52,7 +52,6 @@ import Cardano.Ledger.SafeHash
HashAnnotated (..),
SafeToHash (..),
)
import Control.Applicative (liftA2)
import Control.DeepSeq (NFData)
import Data.ByteString.Short (fromShort)
import Data.Coders
Expand All @@ -64,10 +63,9 @@ import Data.Coders
decode,
encode,
field,
mapDecodeA,
mapEncode,
(!>),
(<*!),
(<!),
)
import Data.Default (Default (..))
import Data.Functor.Identity (Identity (..))
Expand All @@ -94,6 +92,7 @@ import Shelley.Spec.Ledger.PParams (HKD, ProtVer (..))
import Shelley.Spec.Ledger.Serialization
( FromCBORGroup (..),
ToCBORGroup (..),
mapFromCBOR,
mapToCBOR,
ratioFromCBOR,
ratioToCBOR,
Expand Down Expand Up @@ -220,33 +219,33 @@ instance (Era era) => ToCBOR (PParams era) where

instance
(Era era) =>
FromCBOR (Annotator (PParams era))
FromCBOR (PParams era)
where
fromCBOR =
decode $
Ann (RecD PParams)
<*! Ann From -- _minfeeA :: Integer
<*! Ann From -- _minfeeB :: Natural
<*! Ann From -- _maxBBSize :: Natural
<*! Ann From -- _maxTxSize :: Natural
<*! Ann From -- _maxBHSize :: Natural
<*! Ann From -- _keyDeposit :: Coin
<*! Ann From -- _poolDeposit :: Coin
<*! Ann From -- _eMax :: EpochNo
<*! Ann From -- _nOpt :: Natural
<*! Ann (D ratioFromCBOR) -- _a0 :: Rational
<*! Ann From -- _rho :: UnitInterval
<*! Ann From -- _tau :: UnitInterval
<*! Ann From -- _d :: UnitInterval
<*! Ann From -- _extraEntropy :: Nonce
<*! Ann (D fromCBORGroup) -- _protocolVersion :: ProtVer
<*! Ann From -- _minPoolCost :: Natural
RecD PParams
<! From -- _minfeeA :: Integer
<! From -- _minfeeB :: Natural
<! From -- _maxBBSize :: Natural
<! From -- _maxTxSize :: Natural
<! From -- _maxBHSize :: Natural
<! From -- _keyDeposit :: Coin
<! From -- _poolDeposit :: Coin
<! From -- _eMax :: EpochNo
<! From -- _nOpt :: Natural
<! (D ratioFromCBOR) -- _a0 :: Rational
<! From -- _rho :: UnitInterval
<! From -- _tau :: UnitInterval
<! From -- _d :: UnitInterval
<! From -- _extraEntropy :: Nonce
<! (D fromCBORGroup) -- _protocolVersion :: ProtVer
<! From -- _minPoolCost :: Natural
-- new/updated for alonzo
<*! Ann From -- _adaPerUTxOByte :: Coin
<*! mapDecodeA (Ann From) From -- _costmdls :: (Map Language CostModel)
<*! Ann From -- _prices = prices',
<*! Ann From -- _maxTxExUnits = maxTxExUnits',
<*! Ann From -- _maxBlockExUnits = maxBlockExUnits'
<! From -- _adaPerUTxOByte :: Coin
<! (D mapFromCBOR) -- _costmdls :: (Map Language CostModel)
<! From -- _prices = prices',
<! From -- _maxTxExUnits = maxTxExUnits',
<! From -- _maxBlockExUnits = maxBlockExUnits'

-- | Returns a basic "empty" `PParams` structure with all zero values.
emptyPParams :: PParams era
Expand Down Expand Up @@ -307,29 +306,31 @@ encodePParamsUpdate ::
Encode ('Closed 'Sparse) (PParamsUpdate era)
encodePParamsUpdate ppup =
Keyed PParams
!> omitStrictMaybe 0 (_minfeeA ppup)
!> omitStrictMaybe 1 (_minfeeB ppup)
!> omitStrictMaybe 2 (_maxBBSize ppup)
!> omitStrictMaybe 3 (_maxTxSize ppup)
!> omitStrictMaybe 4 (_maxBHSize ppup)
!> omitStrictMaybe 5 (_keyDeposit ppup)
!> omitStrictMaybe 6 (_poolDeposit ppup)
!> omitStrictMaybe 7 (_eMax ppup)
!> omitStrictMaybe 8 (_nOpt ppup)
!> Omit isSNothing (Key 9 (E (ratioToCBOR . fromSJust) (_a0 ppup)))
!> omitStrictMaybe 10 (_rho ppup)
!> omitStrictMaybe 11 (_tau ppup)
!> omitStrictMaybe 12 (_d ppup)
!> omitStrictMaybe 13 (_extraEntropy ppup)
!> omitStrictMaybe 14 (_protocolVersion ppup)
!> omitStrictMaybe 15 (_minPoolCost ppup)
!> omitStrictMaybe 16 (_adaPerUTxOByte ppup)
!> omitStrictMaybe 17 (_costmdls ppup)
!> omitStrictMaybe 18 (_prices ppup)
!> omitStrictMaybe 19 (_maxTxExUnits ppup)
!> omitStrictMaybe 20 (_maxBlockExUnits ppup)
!> omitStrictMaybe 0 (_minfeeA ppup) toCBOR
!> omitStrictMaybe 1 (_minfeeB ppup) toCBOR
!> omitStrictMaybe 2 (_maxBBSize ppup) toCBOR
!> omitStrictMaybe 3 (_maxTxSize ppup) toCBOR
!> omitStrictMaybe 4 (_maxBHSize ppup) toCBOR
!> omitStrictMaybe 5 (_keyDeposit ppup) toCBOR
!> omitStrictMaybe 6 (_poolDeposit ppup) toCBOR
!> omitStrictMaybe 7 (_eMax ppup) toCBOR
!> omitStrictMaybe 8 (_nOpt ppup) toCBOR
!> omitStrictMaybe 9 (_a0 ppup) ratioToCBOR
!> omitStrictMaybe 10 (_rho ppup) toCBOR
!> omitStrictMaybe 11 (_tau ppup) toCBOR
!> omitStrictMaybe 12 (_d ppup) toCBOR
!> omitStrictMaybe 13 (_extraEntropy ppup) toCBOR
!> omitStrictMaybe 14 (_protocolVersion ppup) toCBOR
!> omitStrictMaybe 15 (_minPoolCost ppup) toCBOR
!> omitStrictMaybe 16 (_adaPerUTxOByte ppup) toCBOR
!> omitStrictMaybe 17 (_costmdls ppup) mapToCBOR
!> omitStrictMaybe 18 (_prices ppup) toCBOR
!> omitStrictMaybe 19 (_maxTxExUnits ppup) toCBOR
!> omitStrictMaybe 20 (_maxBlockExUnits ppup) toCBOR
where
omitStrictMaybe key x = Omit isSNothing (Key key (E (toCBOR . fromSJust) x))
omitStrictMaybe ::
Word -> StrictMaybe a -> (a -> Encoding) -> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe key x enc = Omit isSNothing (Key key (E (enc . fromSJust) x))

instance (Era era) => ToCBOR (PParamsUpdate era) where
toCBOR ppup = encode (encodePParamsUpdate ppup)
Expand Down Expand Up @@ -361,51 +362,34 @@ emptyPParamsUpdate =
_maxBlockExUnits = SNothing
}

-- ===============================================================================
-- To deserialise the Sparse encoding (produced by encodePParamsUpdate) where
-- 1) only the 'x' part of the (SJust x) has been serialized, and
-- 2) some fields only have FormCBOR(Annotated instances),
-- we need special functions for constructing Field decoders that handle both cases.

-- | if we have a normal (FromCBOR field) instance we use fieldNorm
fieldNorm :: (StrictMaybe field -> b -> b) -> Decode w field -> Field (Annotator b)
fieldNorm update dec = Field (liftA2 update) (decode (Ann (Map SJust dec)))

-- | if we only have a (FromCBOR (Annotator field)) instance we use fieldAnn
fieldAnn ::
(StrictMaybe field -> b -> b) ->
Decode w (Annotator field) ->
Field (Annotator b)
fieldAnn update dec = Field (liftA2 update) (do x <- decode dec; pure (SJust <$> x))

updateField :: Word -> Field (Annotator (PParamsUpdate era))
updateField 0 = fieldNorm (\x up -> up {_minfeeA = x}) From
updateField 1 = fieldNorm (\x up -> up {_minfeeB = x}) From
updateField 2 = fieldNorm (\x up -> up {_maxBBSize = x}) From
updateField 3 = fieldNorm (\x up -> up {_maxTxSize = x}) From
updateField 4 = fieldNorm (\x up -> up {_maxBHSize = x}) From
updateField 5 = fieldNorm (\x up -> up {_keyDeposit = x}) From
updateField 6 = fieldNorm (\x up -> up {_poolDeposit = x}) From
updateField 7 = fieldNorm (\x up -> up {_eMax = x}) From
updateField 8 = fieldNorm (\x up -> up {_nOpt = x}) From
updateField 9 = fieldNorm (\x up -> up {_a0 = x}) (D ratioFromCBOR)
updateField 10 = fieldNorm (\x up -> up {_rho = x}) From
updateField 11 = fieldNorm (\x up -> up {_tau = x}) From
updateField 12 = fieldNorm (\x up -> up {_d = x}) From
updateField 13 = fieldNorm (\x up -> up {_extraEntropy = x}) From
updateField 14 = fieldNorm (\x up -> up {_protocolVersion = x}) From
updateField 15 = fieldNorm (\x up -> up {_minPoolCost = x}) From
updateField 16 = fieldNorm (\x up -> up {_adaPerUTxOByte = x}) From
updateField 17 = fieldAnn (\x up -> up {_costmdls = x}) (mapDecodeA (Ann From) From)
updateField 18 = fieldNorm (\x up -> up {_prices = x}) From
updateField 19 = fieldNorm (\x up -> up {_maxTxExUnits = x}) From
updateField 20 = fieldNorm (\x up -> up {_maxBlockExUnits = x}) From
updateField :: Word -> Field (PParamsUpdate era)
updateField 0 = field (\x up -> up {_minfeeA = SJust x}) From
updateField 1 = field (\x up -> up {_minfeeB = SJust x}) From
updateField 2 = field (\x up -> up {_maxBBSize = SJust x}) From
updateField 3 = field (\x up -> up {_maxTxSize = SJust x}) From
updateField 4 = field (\x up -> up {_maxBHSize = SJust x}) From
updateField 5 = field (\x up -> up {_keyDeposit = SJust x}) From
updateField 6 = field (\x up -> up {_poolDeposit = SJust x}) From
updateField 7 = field (\x up -> up {_eMax = SJust x}) From
updateField 8 = field (\x up -> up {_nOpt = SJust x}) From
updateField 9 = field (\x up -> up {_a0 = x}) (D $ SJust <$> ratioFromCBOR)
updateField 10 = field (\x up -> up {_rho = SJust x}) From
updateField 11 = field (\x up -> up {_tau = SJust x}) From
updateField 12 = field (\x up -> up {_d = SJust x}) From
updateField 13 = field (\x up -> up {_extraEntropy = SJust x}) From
updateField 14 = field (\x up -> up {_protocolVersion = SJust x}) From
updateField 15 = field (\x up -> up {_minPoolCost = SJust x}) From
updateField 16 = field (\x up -> up {_adaPerUTxOByte = SJust x}) From
updateField 17 = field (\x up -> up {_costmdls = x}) (D $ SJust <$> mapFromCBOR)
updateField 18 = field (\x up -> up {_prices = SJust x}) From
updateField 19 = field (\x up -> up {_maxTxExUnits = SJust x}) From
updateField 20 = field (\x up -> up {_maxBlockExUnits = SJust x}) From
updateField k = field (\_x up -> up) (Invalid k)

instance (Era era) => FromCBOR (Annotator (PParamsUpdate era)) where
instance (Era era) => FromCBOR (PParamsUpdate era) where
fromCBOR =
decode
(SparseKeyed "PParamsUpdate" (pure emptyPParamsUpdate) updateField [])
(SparseKeyed "PParamsUpdate" emptyPParamsUpdate updateField [])

-- =================================================================

Expand All @@ -421,8 +405,8 @@ instance NoThunks (ProposedPPUpdates era)
instance Era era => ToCBOR (ProposedPPUpdates era) where
toCBOR (ProposedPPUpdates m) = mapToCBOR m

instance Era era => FromCBOR (Annotator (ProposedPPUpdates era)) where
fromCBOR = (ProposedPPUpdates <$>) <$> (decode (mapDecodeA (Ann From) From)) -- splitMapFromCBOR fromCBOR fromCBOR
instance Era era => FromCBOR (ProposedPPUpdates era) where
fromCBOR = ProposedPPUpdates <$> mapFromCBOR

emptyPPPUpdates :: ProposedPPUpdates era
emptyPPPUpdates = ProposedPPUpdates Map.empty
Expand Down Expand Up @@ -507,13 +491,12 @@ pattern OtherView n <- LangDepViewConstr (Memo (RawOtherView cm) _)

{-# COMPLETE PlutusView {- OtherView -} #-}

instance (Typeable era) => FromCBOR (Annotator (LangDepView era)) where
instance (Typeable era) => FromCBOR (LangDepView era) where
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is probably never used

fromCBOR = decode $ Summands "LangDepView" decodeTag
where
decodeTag :: Word -> Decode 'Open (Annotator (LangDepView era))
decodeTag 0 = Ann (SumD PlutusView) <*! From
-- Since CostModel has only (FromCBOR (Annotator CostModel) insatnce
-- decodeTag 1 = Ann (SumD OtherView) <*! (Ann From)
decodeTag :: Word -> Decode 'Open (LangDepView era)
decodeTag 0 = SumD PlutusView <! From
-- decodeTag 1 = SumD OtherView <! From
-- Since Int has FromCBOR instance
decodeTag n = Invalid n

Expand Down
11 changes: 3 additions & 8 deletions alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -72,6 +72,7 @@ import Numeric.Natural (Natural)
import qualified Plutus.V1.Ledger.Examples as Plutus (alwaysFailingNAryFunction, alwaysSucceedingNAryFunction)
import qualified Plutus.V1.Ledger.Scripts as Plutus (Script)
import Shelley.Spec.Ledger.Coin (Coin (..))
import Shelley.Spec.Ledger.Serialization (mapFromCBOR)

-- | Marker indicating the part of a transaction for which this script is acting
-- as a validator.
Expand Down Expand Up @@ -181,14 +182,8 @@ instance NFData CostModel

deriving instance ToCBOR CostModel

-- This is needed to derive the FromCBOR (Annotator CostModel) instance
instance FromCBOR (Annotator (Map ByteString Integer)) where
fromCBOR = pure <$> fromCBOR

deriving via
Mem (Map ByteString Integer)
instance
FromCBOR (Annotator CostModel)
instance FromCBOR CostModel where
fromCBOR = CostModel <$> mapFromCBOR

-- CostModel is not parameterized by Crypto or Era so we use the
-- hashWithCrypto function, rather than hashAnnotated
Expand Down
6 changes: 3 additions & 3 deletions alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -333,7 +333,7 @@ instance Era era => FromCBOR (Annotator (WitnessPPDataRaw era)) where
decode
( Ann (RecD WitnessPPDataRaw)
<*! mapDecodeA (Ann From) From
<*! setDecodeA From
<*! setDecodeA (Ann From)
)

newtype WitnessPPData era = WitnessPPDataConstr (MemoBytes (WitnessPPDataRaw era))
Expand Down Expand Up @@ -752,7 +752,7 @@ instance
FromCBOR (Annotator (Core.Script era)),
FromCBOR (Annotator (Core.TxBody era)),
FromCBOR (Annotator (Core.AuxiliaryData era)),
Core.AnnotatedData (PParamsDelta era),
FromCBOR (PParamsDelta era),
ToCBOR (Core.Script era),
Typeable (Core.Script era),
Typeable (Core.AuxiliaryData era),
Expand Down Expand Up @@ -782,7 +782,7 @@ deriving via
FromCBOR (Annotator (Core.Script era)),
FromCBOR (Annotator (Core.TxBody era)),
FromCBOR (Annotator (Core.AuxiliaryData era)),
Core.AnnotatedData (PParamsDelta era),
FromCBOR (PParamsDelta era),
ToCBOR (Core.Script era),
Typeable (Core.Script era),
Typeable (Core.AuxiliaryData era),
Expand Down
Loading