From fc87d88d01e815bcf99e66b739d48acbe0e22f3c Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 15:55:14 +0000 Subject: [PATCH 01/31] Generalise toShelleyStakeAddr to work for any ledger era Will be needed for constructing txs in later ledger eras. --- cardano-api/src/Cardano/Api/Address.hs | 35 +++++++++++++++----------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index b0c3c8178d3..7ce9417791a 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -484,24 +484,12 @@ toShelleyAddr (AddressInEra (ShelleyAddressInEra _) Shelley.Addr nw (coerceShelleyPaymentCredential pc) (coerceShelleyStakeReference scr) - where - -- The era parameter in these types is a phantom type so it is safe to cast. - -- We choose to cast because we need to use an era-independent address - -- representation, but have to produce an era-dependent format used by the - -- Shelley ledger lib. - coerceShelleyPaymentCredential :: Shelley.PaymentCredential eraA - -> Shelley.PaymentCredential eraB - coerceShelleyPaymentCredential = coerce - - coerceShelleyStakeReference :: Shelley.StakeReference eraA - -> Shelley.StakeReference eraB - coerceShelleyStakeReference = coerce - -toShelleyStakeAddr :: StakeAddress -> Shelley.RewardAcnt StandardShelley + +toShelleyStakeAddr :: StakeAddress -> Shelley.RewardAcnt ledgerera toShelleyStakeAddr (StakeAddress nw sc) = Shelley.RewardAcnt { Shelley.getRwdNetwork = nw, - Shelley.getRwdCred = sc + Shelley.getRwdCred = coerceShelleyStakeCredential sc } toShelleyPaymentCredential :: PaymentCredential @@ -526,3 +514,20 @@ toShelleyStakeReference (StakeAddressByPointer ptr) = Shelley.StakeRefPtr ptr toShelleyStakeReference NoStakeAddress = Shelley.StakeRefNull + +-- The era parameter in these types is a phantom type so it is safe to cast. +-- We choose to cast because we need to use an era-independent address +-- representation, but have to produce an era-dependent format used by the +-- Shelley ledger lib. +coerceShelleyPaymentCredential :: Shelley.PaymentCredential eraA + -> Shelley.PaymentCredential eraB +coerceShelleyPaymentCredential = coerce + +coerceShelleyStakeCredential :: Shelley.StakeCredential eraA + -> Shelley.StakeCredential eraB +coerceShelleyStakeCredential = coerce + +coerceShelleyStakeReference :: Shelley.StakeReference eraA + -> Shelley.StakeReference eraB +coerceShelleyStakeReference = coerce + From 12fd23380f42904d98ca9433c313d858026bdb4f Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 15:57:48 +0000 Subject: [PATCH 02/31] Move and generalise toShelley{Metadata,MetadataHash} functions Move them into the TxMetadata module and generalise toShelleyMetadataHash to work over all ledger eras. Will be needed for creating txs in later ledger eras. --- cardano-api/src/Cardano/Api/TxBody.hs | 3 --- cardano-api/src/Cardano/Api/TxMetadata.hs | 12 ++++++++++++ 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 230e989bee0..9e5d38e810f 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -329,9 +329,6 @@ makeShelleyTransaction TxExtraContent { where toShelleyUpdate (UpdateProposal p) = p - toShelleyMetadata (TxMetadataShelley m) = m - toShelleyMetadataHash (TxMetadataShelley m) = Shelley.hashMetaData m - toShelleyWdrl :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl StandardShelley toShelleyWdrl wdrls = Shelley.Wdrl $ diff --git a/cardano-api/src/Cardano/Api/TxMetadata.hs b/cardano-api/src/Cardano/Api/TxMetadata.hs index 004c78e91f0..b4d899c2a23 100644 --- a/cardano-api/src/Cardano/Api/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/TxMetadata.hs @@ -25,6 +25,10 @@ module Cardano.Api.TxMetadata ( TxMetadataJsonError (..), TxMetadataJsonSchemaError (..), + -- * Internal conversion functions + toShelleyMetadata, + toShelleyMetadataHash, + -- * Data family instances AsType(..) ) where @@ -61,6 +65,7 @@ import Control.Monad (guard, when) import qualified Cardano.Binary as CBOR +import qualified Cardano.Ledger.Era as Ledger import qualified Shelley.Spec.Ledger.MetaData as Shelley import Cardano.Api.Eras @@ -151,6 +156,13 @@ fromShelleyMetaData (Shelley.MetaData mdMap) = fromShelleyMetaDatum v) | (k,v) <- xs ] +toShelleyMetadata :: TxMetadata -> Shelley.MetaData +toShelleyMetadata (TxMetadataShelley m) = m + +toShelleyMetadataHash :: Ledger.Era ledgerera + => TxMetadata -> Shelley.MetaDataHash ledgerera +toShelleyMetadataHash (TxMetadataShelley m) = Shelley.hashMetaData m + -- ---------------------------------------------------------------------------- -- Validate tx metaData From b10061d4a0852f0a3cef3ca5b45c301c2635f212 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 15:59:38 +0000 Subject: [PATCH 03/31] Generalise toShelleyWithdrawal over all ledger eras Will be needed for making txs for later ledger eras. --- cardano-api/src/Cardano/Api/TxBody.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 9e5d38e810f..d9ef9ecb6ce 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -320,7 +320,7 @@ makeShelleyTransaction TxExtraContent { (Set.fromList (map toShelleyTxIn ins)) (Seq.fromList (map toShelleyTxOut outs)) (Seq.fromList [ cert | Certificate cert <- txCertificates ]) - (toShelleyWdrl txWithdrawals) + (toShelleyWithdrawal txWithdrawals) (toShelleyLovelace fee) ttl (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) @@ -329,14 +329,12 @@ makeShelleyTransaction TxExtraContent { where toShelleyUpdate (UpdateProposal p) = p - toShelleyWdrl :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl StandardShelley - toShelleyWdrl wdrls = - Shelley.Wdrl $ - Map.fromList - [ (toShelleyStakeAddr stakeAddr, toShelleyLovelace value) - | (stakeAddr, value) <- wdrls ] - - +toShelleyWithdrawal :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl ledgerera +toShelleyWithdrawal withdrawals = + Shelley.Wdrl $ + Map.fromList + [ (toShelleyStakeAddr stakeAddr, toShelleyLovelace value) + | (stakeAddr, value) <- withdrawals ] -- | Compute the 'TxIn' of the initial UTxO pseudo-transaction corresponding From 1d32e2455fd7fd6d4352a8f5de35ac45c42cd07e Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 16:14:57 +0000 Subject: [PATCH 04/31] Move toShelleyUpdate to the ProtocolParameters module Not yet generalised over ledger eras. --- cardano-api/src/Cardano/Api/ProtocolParameters.hs | 6 ++++++ cardano-api/src/Cardano/Api/TxBody.hs | 2 -- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index ffdc72b2957..04439fe73e6 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -15,6 +15,9 @@ module Cardano.Api.ProtocolParameters ( ProtocolParametersUpdate(..), makeShelleyUpdateProposal, + -- * Internal conversion functions + toShelleyUpdate, + -- * Data family instances AsType(..) ) where @@ -239,6 +242,9 @@ makeShelleyUpdateProposal params genesisKeyHashes epochno = [ (kh, ppup) | GenesisKeyHash kh <- genesisKeyHashes ])) epochno +toShelleyUpdate :: UpdateProposal -> Shelley.Update StandardShelley +toShelleyUpdate (UpdateProposal p) = p + toShelleyPParamsUpdate :: ProtocolParametersUpdate -> Shelley.PParamsUpdate StandardShelley toShelleyPParamsUpdate diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index d9ef9ecb6ce..e8c6c81d64d 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -326,8 +326,6 @@ makeShelleyTransaction TxExtraContent { (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata)) (toShelleyMetadata <$> txMetadata) - where - toShelleyUpdate (UpdateProposal p) = p toShelleyWithdrawal :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl ledgerera toShelleyWithdrawal withdrawals = From 3225463eeba9df615a1a873fee7a611017790a16 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 18:42:19 +0000 Subject: [PATCH 05/31] Change type of Praos extra entropy update parameter We would like the ProtocolParametersUpdate type to be able to be converted both to and from the equivalent underlying ledger type. We would like this for a couple reasons: 1. so that we can use this same type later for programs that analyse the blockchain and want to see the content of update proposals; 2. so we can switch UpdateProposal to use the representation of the surface API types, while still using the on-chain format for the binary serialisation. This requires converting in both directions. We want to do 2. now because we want a single era-independent representation for update proposals, and to convert into the era-dependent ledger types on-demand when we make a transaction. --- cardano-api/src/Cardano/API.hs | 2 ++ .../src/Cardano/Api/ProtocolParameters.hs | 36 ++++++++++++++----- cardano-api/src/Cardano/Api/Typed.hs | 2 ++ .../src/Cardano/CLI/Shelley/Parsers.hs | 11 ++++-- 4 files changed, 40 insertions(+), 11 deletions(-) diff --git a/cardano-api/src/Cardano/API.hs b/cardano-api/src/Cardano/API.hs index 115e6086f4e..450f8172412 100644 --- a/cardano-api/src/Cardano/API.hs +++ b/cardano-api/src/Cardano/API.hs @@ -338,6 +338,8 @@ module Cardano.API ( NetworkMagic, makeShelleyUpdateProposal, + PraosNonce, + makePraosNonce, ) where import Cardano.Api.Typed diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 04439fe73e6..28dd6a8de92 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -15,6 +15,10 @@ module Cardano.Api.ProtocolParameters ( ProtocolParametersUpdate(..), makeShelleyUpdateProposal, + -- * PraosNonce + PraosNonce, + makePraosNonce, + -- * Internal conversion functions toShelleyUpdate, @@ -33,8 +37,11 @@ import Control.Monad import Cardano.Slotting.Slot (EpochNo) 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 qualified Shelley.Spec.Ledger.BaseTypes as Shelley +import qualified Shelley.Spec.Ledger.Keys as Shelley import qualified Shelley.Spec.Ledger.PParams as Shelley import Cardano.Api.Address @@ -89,7 +96,7 @@ data ProtocolParametersUpdate = -- federated operators did not subtly bias the initial schedule so that -- they retain undue influence after decentralisation. -- - protocolUpdateExtraPraosEntropy :: Maybe (Maybe ByteString), + protocolUpdateExtraPraosEntropy :: Maybe (Maybe PraosNonce), -- | The maximum permitted size of a block header. -- @@ -286,7 +293,7 @@ toShelleyPParamsUpdate maybeToStrictMaybe protocolUpdateTreasuryCut , Shelley._d = Shelley.truncateUnitInterval . fromRational <$> maybeToStrictMaybe protocolUpdateDecentralization - , Shelley._extraEntropy = mkNonce <$> + , Shelley._extraEntropy = toShelleyNonce <$> maybeToStrictMaybe protocolUpdateExtraPraosEntropy , Shelley._protocolVersion = uncurry Shelley.ProtVer <$> maybeToStrictMaybe protocolUpdateProtocolVersion @@ -295,10 +302,23 @@ toShelleyPParamsUpdate , Shelley._minPoolCost = toShelleyLovelace <$> maybeToStrictMaybe protocolUpdateMinPoolCost } - where - mkNonce Nothing = Shelley.NeutralNonce - mkNonce (Just bs) = Shelley.Nonce - . Crypto.castHash - . Crypto.hashWith id - $ bs + + +-- ---------------------------------------------------------------------------- +-- Praos nonce +-- + +newtype PraosNonce = PraosNonce (Shelley.Hash StandardCrypto ByteString) + deriving (Eq, Ord, Show) + +makePraosNonce :: ByteString -> PraosNonce +makePraosNonce = PraosNonce . Crypto.hashWith id + +toShelleyNonce :: Maybe PraosNonce -> Shelley.Nonce +toShelleyNonce Nothing = Shelley.NeutralNonce +toShelleyNonce (Just (PraosNonce h)) = Shelley.Nonce (Crypto.castHash h) + +fromPraosNonce :: Shelley.Nonce -> Maybe PraosNonce +fromPraosNonce Shelley.NeutralNonce = Nothing +fromPraosNonce (Shelley.Nonce h) = Just (PraosNonce (Crypto.castHash h)) diff --git a/cardano-api/src/Cardano/Api/Typed.hs b/cardano-api/src/Cardano/Api/Typed.hs index 2519147667a..bf49449e4fe 100644 --- a/cardano-api/src/Cardano/Api/Typed.hs +++ b/cardano-api/src/Cardano/Api/Typed.hs @@ -379,6 +379,8 @@ module Cardano.Api.Typed ( EpochNo(..), NetworkMagic(..), makeShelleyUpdateProposal, + PraosNonce, + makePraosNonce, -- ** Conversions --TODO: arrange not to export these diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index c06aa162124..917465c2f20 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -2120,9 +2120,9 @@ pDecentralParam = <> Opt.help "Decentralization parameter." ) -pExtraEntropy :: Parser (Maybe ByteString) +pExtraEntropy :: Parser (Maybe PraosNonce) pExtraEntropy = - Opt.option (Just <$> readerFromAttoParser parseEntropyBytes) + Opt.option (Just <$> readerFromAttoParser parsePraosNonce) ( Opt.long "extra-entropy" <> Opt.metavar "HEX" <> Opt.help "Praos extra entropy, as a hex byte string." @@ -2132,8 +2132,13 @@ pExtraEntropy = <> Opt.help "Reset the Praos extra entropy to none." ) where + parsePraosNonce :: Atto.Parser PraosNonce + parsePraosNonce = makePraosNonce <$> parseEntropyBytes + parseEntropyBytes :: Atto.Parser ByteString - parseEntropyBytes = Atto.takeWhile1 Char.isHexDigit <&> decodeEitherBase16 >>= either fail return + parseEntropyBytes = either fail return + . decodeEitherBase16 + =<< Atto.takeWhile1 Char.isHexDigit pProtocol :: Parser Protocol pProtocol = From dfdb7122410a9c6c59484b3b1c0dc7312cfe1d3b Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 18:53:27 +0000 Subject: [PATCH 06/31] Add functions to convert from Shelley update proposal types So we now have conversions in both directions. --- .../src/Cardano/Api/ProtocolParameters.hs | 73 ++++++++++++++++++- cardano-api/src/Cardano/Api/Value.hs | 4 + 2 files changed, 73 insertions(+), 4 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 28dd6a8de92..27e4dfd4181 100644 --- 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 index 1f9d100e900..a1020181ddf 100644 --- 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 From 73a6ebf8911e6ef3e92344ecb57b8304e9c17745 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 18:55:46 +0000 Subject: [PATCH 07/31] Change representation of UpdateProposal to use the API types Switch the UpdateProposal to use the representation of the surface API types. We stick to the existing on-chain binary serialisation format. We want to do this now to add support for more ledger eras. We want a single era-independent representation for update proposals, and to convert into the era-dependent ledger types on-demand when we make a transaction for a specific era. --- .../src/Cardano/Api/ProtocolParameters.hs | 38 +++++++++++++------ 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 27e4dfd4181..920a122d5b1 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -62,9 +62,11 @@ import Cardano.Api.Value -- Protocol updates embedded in transactions -- -newtype UpdateProposal = UpdateProposal (Shelley.Update StandardShelley) +data UpdateProposal = + UpdateProposal + !(Map (Hash GenesisKey) ProtocolParametersUpdate) + !EpochNo deriving stock (Eq, Show) - deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR instance HasTypeProxy UpdateProposal where @@ -74,6 +76,12 @@ instance HasTypeProxy UpdateProposal where instance HasTextEnvelope UpdateProposal where textEnvelopeType _ = "UpdateProposalShelley" +instance ToCBOR UpdateProposal where + toCBOR = toCBOR . toShelleyUpdate + +instance FromCBOR UpdateProposal where + fromCBOR = fromShelleyUpdate <$> fromCBOR + data ProtocolParametersUpdate = ProtocolParametersUpdate { @@ -243,16 +251,23 @@ makeShelleyUpdateProposal :: ProtocolParametersUpdate -> UpdateProposal makeShelleyUpdateProposal params genesisKeyHashes epochno = --TODO decide how to handle parameter validation - let ppup = toShelleyPParamsUpdate params in - UpdateProposal $ - Shelley.Update - (Shelley.ProposedPPUpdates - (Map.fromList - [ (kh, ppup) | GenesisKeyHash kh <- genesisKeyHashes ])) - epochno + UpdateProposal + (Map.fromList [ (kh, params) | kh <- genesisKeyHashes ]) + epochno + toShelleyUpdate :: UpdateProposal -> Shelley.Update StandardShelley -toShelleyUpdate (UpdateProposal p) = p +toShelleyUpdate (UpdateProposal ppup epochno) = + Shelley.Update (toShelleyProposedPPUpdates ppup) epochno + + +toShelleyProposedPPUpdates :: Map (Hash GenesisKey) ProtocolParametersUpdate + -> Shelley.ProposedPPUpdates StandardShelley +toShelleyProposedPPUpdates = + Shelley.ProposedPPUpdates + . Map.mapKeysMonotonic (\(GenesisKeyHash kh) -> kh) + . Map.map toShelleyPParamsUpdate + toShelleyPParamsUpdate :: ProtocolParametersUpdate -> Shelley.PParamsUpdate StandardShelley @@ -306,7 +321,8 @@ toShelleyPParamsUpdate } fromShelleyUpdate :: Shelley.Update StandardShelley -> UpdateProposal -fromShelleyUpdate = UpdateProposal +fromShelleyUpdate (Shelley.Update ppup epochno) = + UpdateProposal (fromShelleyProposedPPUpdates ppup) epochno fromShelleyProposedPPUpdates :: Shelley.ProposedPPUpdates StandardShelley From 9fff1ad3a1c213164192abe8083bcd248f0f7a46 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 18:59:24 +0000 Subject: [PATCH 08/31] Export UpdateProposal and protocol params from the API The protocol params should always have been exported since it is a API surface type. The UpdateProposal repreentation can now be public since it now uses the API surface types too. --- cardano-api/src/Cardano/API.hs | 6 +++++- cardano-api/src/Cardano/Api/Shelley.hs | 19 ------------------- 2 files changed, 5 insertions(+), 20 deletions(-) diff --git a/cardano-api/src/Cardano/API.hs b/cardano-api/src/Cardano/API.hs index 450f8172412..3494002418b 100644 --- a/cardano-api/src/Cardano/API.hs +++ b/cardano-api/src/Cardano/API.hs @@ -336,10 +336,14 @@ module Cardano.API ( makeMIRCertificate, makeGenesisKeyDelegationCertificate, - NetworkMagic, + -- * Protocol parameter updates + UpdateProposal(..), + ProtocolParametersUpdate(..), makeShelleyUpdateProposal, PraosNonce, makePraosNonce, + + NetworkMagic, ) where import Cardano.Api.Typed diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 9cd9004892c..e9e988024d2 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -67,25 +67,6 @@ module Cardano.Api.Shelley fromShelleyMetaData, -- * Protocol parameter updates - UpdateProposal(UpdateProposal), - ProtocolParametersUpdate(ProtocolParametersUpdate), - protocolUpdateProtocolVersion, - protocolUpdateDecentralization, - protocolUpdateExtraPraosEntropy, - protocolUpdateMaxBlockHeaderSize, - protocolUpdateMaxBlockBodySize, - protocolUpdateMaxTxSize, - protocolUpdateTxFeeFixed, - protocolUpdateTxFeePerByte, - protocolUpdateMinUTxOValue, - protocolUpdateStakeAddressDeposit, - protocolUpdateStakePoolDeposit, - protocolUpdateMinPoolCost, - protocolUpdatePoolRetireMaxEpoch, - protocolUpdateStakePoolTargetNum, - protocolUpdatePoolPledgeInfluence, - protocolUpdateMonetaryExpansion, - protocolUpdateTreasuryCut, EpochNo(..), NetworkMagic(..), From e9b2245f97ec36ec6be4e77ce497910348c37227 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 19:14:34 +0000 Subject: [PATCH 09/31] Generalise to/fromShelleyUpdate over all ledger eras --- .../src/Cardano/Api/ProtocolParameters.hs | 27 ++++++++++++------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 920a122d5b1..5ec291e6ad6 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | Protocol parameters. @@ -37,6 +38,8 @@ import Control.Monad import Cardano.Slotting.Slot (EpochNo) import qualified Cardano.Crypto.Hash.Class as Crypto + +import qualified Cardano.Ledger.Era as Ledger import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) @@ -77,10 +80,12 @@ instance HasTextEnvelope UpdateProposal where textEnvelopeType _ = "UpdateProposalShelley" instance ToCBOR UpdateProposal where - toCBOR = toCBOR . toShelleyUpdate + toCBOR = toCBOR . toShelleyUpdate @StandardShelley + -- We have to pick a monomorphic era type for the serialisation. We use the + -- Shelley era. This makes no difference since era type is phantom. instance FromCBOR UpdateProposal where - fromCBOR = fromShelleyUpdate <$> fromCBOR + fromCBOR = fromShelleyUpdate @StandardShelley <$> fromCBOR data ProtocolParametersUpdate = ProtocolParametersUpdate { @@ -256,13 +261,15 @@ makeShelleyUpdateProposal params genesisKeyHashes epochno = epochno -toShelleyUpdate :: UpdateProposal -> Shelley.Update StandardShelley +toShelleyUpdate :: Ledger.Crypto ledgerera ~ StandardCrypto + => UpdateProposal -> Shelley.Update ledgerera toShelleyUpdate (UpdateProposal ppup epochno) = Shelley.Update (toShelleyProposedPPUpdates ppup) epochno -toShelleyProposedPPUpdates :: Map (Hash GenesisKey) ProtocolParametersUpdate - -> Shelley.ProposedPPUpdates StandardShelley +toShelleyProposedPPUpdates :: Ledger.Crypto ledgerera ~ StandardCrypto + => Map (Hash GenesisKey) ProtocolParametersUpdate + -> Shelley.ProposedPPUpdates ledgerera toShelleyProposedPPUpdates = Shelley.ProposedPPUpdates . Map.mapKeysMonotonic (\(GenesisKeyHash kh) -> kh) @@ -270,7 +277,7 @@ toShelleyProposedPPUpdates = toShelleyPParamsUpdate :: ProtocolParametersUpdate - -> Shelley.PParamsUpdate StandardShelley + -> Shelley.PParamsUpdate ledgerera toShelleyPParamsUpdate ProtocolParametersUpdate { protocolUpdateProtocolVersion @@ -320,12 +327,14 @@ toShelleyPParamsUpdate maybeToStrictMaybe protocolUpdateMinPoolCost } -fromShelleyUpdate :: Shelley.Update StandardShelley -> UpdateProposal +fromShelleyUpdate :: Ledger.Crypto ledgerera ~ StandardCrypto + => Shelley.Update ledgerera -> UpdateProposal fromShelleyUpdate (Shelley.Update ppup epochno) = UpdateProposal (fromShelleyProposedPPUpdates ppup) epochno -fromShelleyProposedPPUpdates :: Shelley.ProposedPPUpdates StandardShelley +fromShelleyProposedPPUpdates :: Ledger.Crypto ledgerera ~ StandardCrypto + => Shelley.ProposedPPUpdates ledgerera -> Map (Hash GenesisKey) ProtocolParametersUpdate fromShelleyProposedPPUpdates = Map.map fromShelleyPParamsUpdate @@ -333,7 +342,7 @@ fromShelleyProposedPPUpdates = . (\(Shelley.ProposedPPUpdates ppup) -> ppup) -fromShelleyPParamsUpdate :: Shelley.PParamsUpdate StandardShelley +fromShelleyPParamsUpdate :: Shelley.PParamsUpdate ledgerera -> ProtocolParametersUpdate fromShelleyPParamsUpdate Shelley.PParams { From e29ce3c58badfdcc3a45a041036448540e20abf7 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 23:23:02 +0000 Subject: [PATCH 10/31] Change the API's stake pool metadata URL type to match ledger type Use Text instead of URI. We will want to allow conversion in both directions which means we cannot be more restrictive than the ledger's validity rules. --- cardano-api/src/Cardano/Api/Certificate.hs | 13 +++++-------- cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs | 17 ++++++----------- 2 files changed, 11 insertions(+), 19 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index ab1a47e4bcf..ea90f85ec20 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -34,7 +34,7 @@ import Prelude import Data.Maybe import Data.ByteString (ByteString) -import qualified Data.Text as Text +import Data.Text (Text) import qualified Data.Text.Encoding as Text import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -42,7 +42,6 @@ import qualified Data.Sequence.Strict as Seq import Data.IP (IPv4, IPv6) import Network.Socket (PortNumber) -import qualified Network.URI as URI import Cardano.Slotting.Slot (EpochNo (..)) import qualified Cardano.Crypto.Hash.Class as Crypto @@ -183,7 +182,7 @@ data StakePoolRelay = data StakePoolMetadataReference = StakePoolMetadataReference { - stakePoolMetadataURL :: URI.URI, + stakePoolMetadataURL :: Text, stakePoolMetadataHash :: Hash StakePoolMetadata } deriving (Eq, Show) @@ -248,11 +247,9 @@ toShelleyPoolParams StakePoolParameters { . Shelley.textToDns . Text.decodeLatin1 - toShelleyUrl :: URI.URI -> Shelley.Url - toShelleyUrl uri = fromMaybe (error "toShelleyUrl: invalid url. TODO: proper validation") - . Shelley.textToUrl - . Text.pack - $ URI.uriToString id uri "" + toShelleyUrl :: Text -> Shelley.Url + toShelleyUrl = fromMaybe (error "toShelleyUrl: invalid url. TODO: proper validation") + . Shelley.textToUrl -- ---------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 917465c2f20..1f92b80be4b 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -30,11 +30,9 @@ import Data.Attoparsec.Combinator (()) import Data.Time.Clock (UTCTime) import Data.Time.Format (defaultTimeLocale, iso8601DateFormat, parseTimeOrError) import Network.Socket (PortNumber) -import Network.URI (URI, parseURI) import Options.Applicative hiding (str) import Ouroboros.Consensus.BlockchainTime (SystemStart (..)) -import qualified Cardano.Crypto.Hash as Crypto (Blake2b_256, Hash (..), hashFromBytesAsHex) import qualified Data.Attoparsec.ByteString.Char8 as Atto import qualified Data.ByteString.Char8 as BSC import qualified Data.Char as Char @@ -1932,7 +1930,7 @@ pStakePoolMetadataReference = <$> pStakePoolMetadataUrl <*> pStakePoolMetadataHash -pStakePoolMetadataUrl :: Parser URI +pStakePoolMetadataUrl :: Parser Text pStakePoolMetadataUrl = Opt.option (readURIOfMaxLength 64) ( Opt.long "metadata-url" @@ -1949,11 +1947,9 @@ pStakePoolMetadataHash = <> Opt.help "Pool metadata hash." ) where - getHashFromHexString :: String -> Maybe (Crypto.Hash Crypto.Blake2b_256 ByteString) - getHashFromHexString = Crypto.hashFromBytesAsHex . BSC.pack - metadataHash :: String -> Maybe (Hash StakePoolMetadata) - metadataHash str = StakePoolMetadataHash <$> getHashFromHexString str + metadataHash = deserialiseFromRawBytesHex (AsHash AsStakePoolMetadata) + . BSC.pack pStakePoolRegistrationCert :: Parser PoolCmd pStakePoolRegistrationCert = @@ -2282,10 +2278,9 @@ readOutputFormat = do <> s <> "\". Accepted output formats are \"hex\" and \"bech32\"." -readURIOfMaxLength :: Int -> Opt.ReadM URI -readURIOfMaxLength maxLen = do - s <- readStringOfMaxLength maxLen - maybe (fail "The provided string must be a valid URI.") pure (parseURI s) +readURIOfMaxLength :: Int -> Opt.ReadM Text +readURIOfMaxLength maxLen = + Text.pack <$> readStringOfMaxLength maxLen readStringOfMaxLength :: Int -> Opt.ReadM String readStringOfMaxLength maxLen = do From 92b815894cecfa4a15458eca186bdecb35b6fa11 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 23:29:59 +0000 Subject: [PATCH 11/31] Add a fromShelleyPoolParams to allow conversion both ways We'll use this next to change the representation of certificates --- cardano-api/src/Cardano/Api/Address.hs | 21 +++++++ cardano-api/src/Cardano/Api/Certificate.hs | 70 +++++++++++++++++++++- 2 files changed, 88 insertions(+), 3 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 7ce9417791a..6dab72799fe 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -47,6 +47,8 @@ module Cardano.Api.Address ( toShelleyAddr, toShelleyStakeAddr, toShelleyStakeCredential, + fromShelleyAddr, + fromShelleyStakeAddr, -- * Serialising addresses SerialiseAddress(..), @@ -515,6 +517,25 @@ toShelleyStakeReference (StakeAddressByPointer ptr) = toShelleyStakeReference NoStakeAddress = Shelley.StakeRefNull + +fromShelleyAddr :: IsShelleyBasedEra era + => Shelley.Addr (ShelleyLedgerEra era) -> AddressInEra era +fromShelleyAddr (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) = + AddressInEra ByronAddressInAnyEra (ByronAddress addr) + +fromShelleyAddr (Shelley.Addr nw pc scr) = + AddressInEra + (ShelleyAddressInEra shelleyBasedEra) + (ShelleyAddress + nw + (coerceShelleyPaymentCredential pc) + (coerceShelleyStakeReference scr)) + +fromShelleyStakeAddr :: Shelley.RewardAcnt ledgerera -> StakeAddress +fromShelleyStakeAddr (Shelley.RewardAcnt nw sc) = + StakeAddress nw (coerceShelleyStakeCredential sc) + + -- The era parameter in these types is a phantom type so it is safe to cast. -- We choose to cast because we need to use an era-independent address -- representation, but have to produce an era-dependent format used by the diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index ea90f85ec20..b1db8ea61ac 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -39,6 +39,7 @@ import qualified Data.Text.Encoding as Text import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Sequence.Strict as Seq +import qualified Data.Foldable as Foldable import Data.IP (IPv4, IPv6) import Network.Socket (PortNumber) @@ -47,7 +48,8 @@ import Cardano.Slotting.Slot (EpochNo (..)) import qualified Cardano.Crypto.Hash.Class as Crypto import Ouroboros.Consensus.Shelley.Eras (StandardShelley) -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.TxBody as Shelley import Shelley.Spec.Ledger.TxBody (MIRPot (..)) @@ -205,8 +207,7 @@ toShelleyPoolParams StakePoolParameters { , Shelley._poolVrf = vrfkh , Shelley._poolPledge = toShelleyLovelace stakePoolPledge , Shelley._poolCost = toShelleyLovelace stakePoolCost - , Shelley._poolMargin = Shelley.truncateUnitInterval - (fromRational stakePoolMargin) + , Shelley._poolMargin = Shelley.unitIntervalFromRational stakePoolMargin , Shelley._poolRAcnt = toShelleyStakeAddr stakePoolRewardAccount , Shelley._poolOwners = Set.fromList [ kh | StakeKeyHash kh <- stakePoolOwners ] @@ -252,6 +253,69 @@ toShelleyPoolParams StakePoolParameters { . Shelley.textToUrl +fromShelleyPoolParams :: Shelley.PoolParams StandardShelley + -> StakePoolParameters +fromShelleyPoolParams + Shelley.PoolParams { + Shelley._poolId + , Shelley._poolVrf + , Shelley._poolPledge + , Shelley._poolCost + , Shelley._poolMargin + , Shelley._poolRAcnt + , Shelley._poolOwners + , Shelley._poolRelays + , Shelley._poolMD + } = + StakePoolParameters { + stakePoolId = StakePoolKeyHash _poolId + , stakePoolVRF = VrfKeyHash _poolVrf + , stakePoolCost = fromShelleyLovelace _poolCost + , stakePoolMargin = Shelley.unitIntervalToRational _poolMargin + , stakePoolRewardAccount = fromShelleyStakeAddr _poolRAcnt + , stakePoolPledge = fromShelleyLovelace _poolPledge + , stakePoolOwners = map StakeKeyHash (Set.toList _poolOwners) + , stakePoolRelays = map fromShelleyStakePoolRelay + (Foldable.toList _poolRelays) + , stakePoolMetadata = fromShelleyPoolMetaData <$> + strictMaybeToMaybe _poolMD + } + where + fromShelleyStakePoolRelay :: Shelley.StakePoolRelay -> StakePoolRelay + fromShelleyStakePoolRelay (Shelley.SingleHostAddr mport mipv4 mipv6) = + StakePoolRelayIp + (strictMaybeToMaybe mipv4) + (strictMaybeToMaybe mipv6) + (fromIntegral . Shelley.portToWord16 <$> strictMaybeToMaybe mport) + + fromShelleyStakePoolRelay (Shelley.SingleHostName mport dnsname) = + StakePoolRelayDnsARecord + (fromShelleyDnsName dnsname) + (fromIntegral . Shelley.portToWord16 <$> strictMaybeToMaybe mport) + + fromShelleyStakePoolRelay (Shelley.MultiHostName dnsname) = + StakePoolRelayDnsSrvRecord + (fromShelleyDnsName dnsname) + + fromShelleyPoolMetaData :: Shelley.PoolMetaData -> StakePoolMetadataReference + fromShelleyPoolMetaData Shelley.PoolMetaData { + Shelley._poolMDUrl + , Shelley._poolMDHash + } = + StakePoolMetadataReference { + stakePoolMetadataURL = Shelley.urlToText _poolMDUrl + , stakePoolMetadataHash = StakePoolMetadataHash + . fromMaybe (error "fromShelleyPoolMetaData: invalid hash. TODO: proper validation") + . Crypto.hashFromBytes + $ _poolMDHash + } + + --TODO: change the ledger rep of the DNS name to use ShortByteString + fromShelleyDnsName :: Shelley.DnsName -> ByteString + fromShelleyDnsName = Text.encodeUtf8 + . Shelley.dnsToText + + -- ---------------------------------------------------------------------------- -- Special certificates -- From 1354aa378812ef15340f8ea5390e4d5e98d44719 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 21 Nov 2020 23:36:18 +0000 Subject: [PATCH 12/31] Add to/fromShelleyCertificate conversion functions We will switch the representation shortly and so these conversion functions will become non-trivial. --- cardano-api/src/Cardano/Api/Certificate.hs | 15 +++++++++++++++ cardano-api/src/Cardano/Api/TxBody.hs | 2 +- 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index b1db8ea61ac..3d25d23a9ef 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -26,6 +26,10 @@ module Cardano.Api.Certificate ( makeMIRCertificate, makeGenesisKeyDelegationCertificate, + -- * Internal conversion functions + toShelleyCertificate, + fromShelleyCertificate, + -- * Data family instances AsType(..) ) where @@ -189,6 +193,17 @@ data StakePoolMetadataReference = } deriving (Eq, Show) + +-- ---------------------------------------------------------------------------- +-- Internal conversion functions +-- + +toShelleyCertificate :: Certificate -> Shelley.DCert StandardShelley +toShelleyCertificate (Certificate c) = c + +fromShelleyCertificate :: Shelley.DCert StandardShelley -> Certificate +fromShelleyCertificate c = Certificate c + toShelleyPoolParams :: StakePoolParameters -> Shelley.PoolParams StandardShelley toShelleyPoolParams StakePoolParameters { stakePoolId = StakePoolKeyHash poolkh diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index e8c6c81d64d..3dc5eac1668 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -319,7 +319,7 @@ makeShelleyTransaction TxExtraContent { (Shelley.TxBody (Set.fromList (map toShelleyTxIn ins)) (Seq.fromList (map toShelleyTxOut outs)) - (Seq.fromList [ cert | Certificate cert <- txCertificates ]) + (Seq.fromList (map toShelleyCertificate txCertificates)) (toShelleyWithdrawal txWithdrawals) (toShelleyLovelace fee) ttl From c026892fe19b254d9764b241320159e4c7875670 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 00:05:39 +0000 Subject: [PATCH 13/31] Change certificate representation to use surface types This will make it easier to convert from a common era-independent type into ledger era-dependent types. We still use the same on-chain binary format. --- cardano-api/src/Cardano/Api/Address.hs | 8 + cardano-api/src/Cardano/Api/Certificate.hs | 246 ++++++++++++--------- cardano-api/src/Cardano/Api/Shelley.hs | 4 +- cardano-api/src/Cardano/Api/Typed.hs | 2 + 4 files changed, 158 insertions(+), 102 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 6dab72799fe..77b269911c7 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -49,6 +49,7 @@ module Cardano.Api.Address ( toShelleyStakeCredential, fromShelleyAddr, fromShelleyStakeAddr, + fromShelleyStakeCredential, -- * Serialising addresses SerialiseAddress(..), @@ -535,6 +536,13 @@ fromShelleyStakeAddr :: Shelley.RewardAcnt ledgerera -> StakeAddress fromShelleyStakeAddr (Shelley.RewardAcnt nw sc) = StakeAddress nw (coerceShelleyStakeCredential sc) +fromShelleyStakeCredential :: Shelley.StakeCredential StandardShelley + -> StakeCredential +fromShelleyStakeCredential (Shelley.KeyHashObj kh) = + StakeCredentialByKey (StakeKeyHash kh) +fromShelleyStakeCredential (Shelley.ScriptHashObj kh) = + StakeCredentialByScript (ScriptHash kh) + -- The era parameter in these types is a phantom type so it is safe to cast. -- We choose to cast because we need to use an era-independent address diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index 3d25d23a9ef..ccbcdbb0633 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -74,86 +74,52 @@ import Cardano.Api.Value -- Certificates embedded in transactions -- -newtype Certificate = Certificate (Shelley.DCert StandardShelley) +data Certificate = + + -- Stake address certificates + StakeAddressRegistrationCertificate StakeCredential + | StakeAddressDeregistrationCertificate StakeCredential + | StakeAddressDelegationCertificate StakeCredential PoolId + + -- Stake pool certificates + | StakePoolRegistrationCertificate StakePoolParameters + | StakePoolRetirementCertificate PoolId EpochNo + + -- Special certificates + | GenesisKeyDelegationCertificate (Hash GenesisKey) + (Hash GenesisDelegateKey) + (Hash VrfKey) + | MIRCertificate MIRPot [(StakeCredential, Lovelace)] + deriving stock (Eq, Show) - deriving newtype (ToCBOR, FromCBOR) deriving anyclass SerialiseAsCBOR instance HasTypeProxy Certificate where data AsType Certificate = AsCertificate proxyToAsType _ = AsCertificate -instance HasTextEnvelope Certificate where - textEnvelopeType _ = "CertificateShelley" - textEnvelopeDefaultDescr (Certificate cert) = case cert of - Shelley.DCertDeleg Shelley.RegKey {} -> "Stake address registration" - Shelley.DCertDeleg Shelley.DeRegKey {} -> "Stake address de-registration" - Shelley.DCertDeleg Shelley.Delegate {} -> "Stake address delegation" - Shelley.DCertPool Shelley.RegPool {} -> "Pool registration" - Shelley.DCertPool Shelley.RetirePool {} -> "Pool retirement" - Shelley.DCertGenesis{} -> "Genesis key delegation" - Shelley.DCertMir{} -> "MIR" - +instance ToCBOR Certificate where + toCBOR = toCBOR . toShelleyCertificate --- ---------------------------------------------------------------------------- --- Stake address certificates --- +instance FromCBOR Certificate where + fromCBOR = fromShelleyCertificate <$> fromCBOR -makeStakeAddressRegistrationCertificate - :: StakeCredential - -> Certificate -makeStakeAddressRegistrationCertificate stakecred = - Certificate - . Shelley.DCertDeleg - $ Shelley.RegKey - (toShelleyStakeCredential stakecred) - -makeStakeAddressDeregistrationCertificate - :: StakeCredential - -> Certificate -makeStakeAddressDeregistrationCertificate stakecred = - Certificate - . Shelley.DCertDeleg - $ Shelley.DeRegKey - (toShelleyStakeCredential stakecred) - -makeStakeAddressDelegationCertificate - :: StakeCredential - -> PoolId - -> Certificate -makeStakeAddressDelegationCertificate stakecred (StakePoolKeyHash poolid) = - Certificate - . Shelley.DCertDeleg - . Shelley.Delegate - $ Shelley.Delegation - (toShelleyStakeCredential stakecred) - poolid +instance HasTextEnvelope Certificate where + textEnvelopeType _ = "CertificateShelley" + textEnvelopeDefaultDescr cert = case cert of + StakeAddressRegistrationCertificate{} -> "Stake address registration" + StakeAddressDeregistrationCertificate{} -> "Stake address de-registration" + StakeAddressDelegationCertificate{} -> "Stake address delegation" + StakePoolRegistrationCertificate{} -> "Pool registration" + StakePoolRetirementCertificate{} -> "Pool retirement" + GenesisKeyDelegationCertificate{} -> "Genesis key delegation" + MIRCertificate{} -> "MIR" -- ---------------------------------------------------------------------------- --- Stake pool certificates +-- Stake pool parameters -- -makeStakePoolRegistrationCertificate - :: StakePoolParameters - -> Certificate -makeStakePoolRegistrationCertificate poolparams = - Certificate - . Shelley.DCertPool - $ Shelley.RegPool - (toShelleyPoolParams poolparams) - -makeStakePoolRetirementCertificate - :: PoolId - -> EpochNo - -> Certificate -makeStakePoolRetirementCertificate (StakePoolKeyHash poolid) epochno = - Certificate - . Shelley.DCertPool - $ Shelley.RetirePool - poolid - epochno - type PoolId = Hash StakePoolKey data StakePoolParameters = @@ -194,15 +160,126 @@ data StakePoolMetadataReference = deriving (Eq, Show) +-- ---------------------------------------------------------------------------- +-- Constructor functions +-- + +makeStakeAddressRegistrationCertificate :: StakeCredential -> Certificate +makeStakeAddressRegistrationCertificate = StakeAddressRegistrationCertificate + +makeStakeAddressDeregistrationCertificate :: StakeCredential -> Certificate +makeStakeAddressDeregistrationCertificate = StakeAddressDeregistrationCertificate + +makeStakeAddressDelegationCertificate :: StakeCredential -> PoolId -> Certificate +makeStakeAddressDelegationCertificate = StakeAddressDelegationCertificate + +makeStakePoolRegistrationCertificate :: StakePoolParameters -> Certificate +makeStakePoolRegistrationCertificate = StakePoolRegistrationCertificate + +makeStakePoolRetirementCertificate :: PoolId -> EpochNo -> Certificate +makeStakePoolRetirementCertificate = StakePoolRetirementCertificate + +makeGenesisKeyDelegationCertificate :: Hash GenesisKey + -> Hash GenesisDelegateKey + -> Hash VrfKey + -> Certificate +makeGenesisKeyDelegationCertificate = GenesisKeyDelegationCertificate + +makeMIRCertificate :: MIRPot -> [(StakeCredential, Lovelace)] -> Certificate +makeMIRCertificate = MIRCertificate + + -- ---------------------------------------------------------------------------- -- Internal conversion functions -- toShelleyCertificate :: Certificate -> Shelley.DCert StandardShelley -toShelleyCertificate (Certificate c) = c +toShelleyCertificate (StakeAddressRegistrationCertificate stakecred) = + Shelley.DCertDeleg $ + Shelley.RegKey + (toShelleyStakeCredential stakecred) + +toShelleyCertificate (StakeAddressDeregistrationCertificate stakecred) = + Shelley.DCertDeleg $ + Shelley.DeRegKey + (toShelleyStakeCredential stakecred) + +toShelleyCertificate (StakeAddressDelegationCertificate + stakecred (StakePoolKeyHash poolid)) = + Shelley.DCertDeleg $ + Shelley.Delegate $ + Shelley.Delegation + (toShelleyStakeCredential stakecred) + poolid + +toShelleyCertificate (StakePoolRegistrationCertificate poolparams) = + Shelley.DCertPool $ + Shelley.RegPool + (toShelleyPoolParams poolparams) + +toShelleyCertificate (StakePoolRetirementCertificate + (StakePoolKeyHash poolid) epochno) = + Shelley.DCertPool $ + Shelley.RetirePool + poolid + epochno + +toShelleyCertificate (GenesisKeyDelegationCertificate + (GenesisKeyHash genesiskh) + (GenesisDelegateKeyHash delegatekh) + (VrfKeyHash vrfkh)) = + Shelley.DCertGenesis $ + Shelley.GenesisDelegCert + genesiskh + delegatekh + vrfkh + +toShelleyCertificate (MIRCertificate mirpot amounts) = + Shelley.DCertMir $ + Shelley.MIRCert + mirpot + (Map.fromListWith (<>) + [ (toShelleyStakeCredential sc, toShelleyLovelace v) + | (sc, v) <- amounts ]) + fromShelleyCertificate :: Shelley.DCert StandardShelley -> Certificate -fromShelleyCertificate c = Certificate c +fromShelleyCertificate (Shelley.DCertDeleg (Shelley.RegKey stakecred)) = + StakeAddressRegistrationCertificate + (fromShelleyStakeCredential stakecred) + +fromShelleyCertificate (Shelley.DCertDeleg (Shelley.DeRegKey stakecred)) = + StakeAddressDeregistrationCertificate + (fromShelleyStakeCredential stakecred) + +fromShelleyCertificate (Shelley.DCertDeleg + (Shelley.Delegate (Shelley.Delegation stakecred poolid))) = + StakeAddressDelegationCertificate + (fromShelleyStakeCredential stakecred) + (StakePoolKeyHash poolid) + +fromShelleyCertificate (Shelley.DCertPool (Shelley.RegPool poolparams)) = + StakePoolRegistrationCertificate + (fromShelleyPoolParams poolparams) + +fromShelleyCertificate (Shelley.DCertPool (Shelley.RetirePool poolid epochno)) = + StakePoolRetirementCertificate + (StakePoolKeyHash poolid) + epochno + +fromShelleyCertificate (Shelley.DCertGenesis + (Shelley.GenesisDelegCert genesiskh delegatekh vrfkh)) = + GenesisKeyDelegationCertificate + (GenesisKeyHash genesiskh) + (GenesisDelegateKeyHash delegatekh) + (VrfKeyHash vrfkh) + +fromShelleyCertificate (Shelley.DCertMir (Shelley.MIRCert mirpot amounts)) = + MIRCertificate + mirpot + [ (fromShelleyStakeCredential sc, fromShelleyLovelace v) + | (sc, v) <- Map.toList amounts ] + toShelleyPoolParams :: StakePoolParameters -> Shelley.PoolParams StandardShelley toShelleyPoolParams StakePoolParameters { @@ -330,36 +407,3 @@ fromShelleyPoolParams fromShelleyDnsName = Text.encodeUtf8 . Shelley.dnsToText - --- ---------------------------------------------------------------------------- --- Special certificates --- - -makeGenesisKeyDelegationCertificate - :: Hash GenesisKey - -> Hash GenesisDelegateKey - -> Hash VrfKey - -> Certificate -makeGenesisKeyDelegationCertificate (GenesisKeyHash genesiskh) - (GenesisDelegateKeyHash delegatekh) - (VrfKeyHash vrfkh) = - Certificate - . Shelley.DCertGenesis - $ Shelley.GenesisDelegCert - genesiskh - delegatekh - vrfkh - -makeMIRCertificate - :: MIRPot - -> [(StakeCredential, Lovelace)] - -> Certificate -makeMIRCertificate mirpot amounts = - Certificate - . Shelley.DCertMir - $ Shelley.MIRCert - mirpot - (Map.fromListWith (<>) - [ (toShelleyStakeCredential sc, toShelleyLovelace v) - | (sc, v) <- amounts ]) - diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index e9e988024d2..0df8b7a5544 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -82,7 +82,9 @@ module Cardano.Api.Shelley parseScriptSig, -- * Certificates - Certificate (Certificate), + Certificate (..), + toShelleyCertificate, + fromShelleyCertificate, -- ** Operational certificates OperationalCertificate(OperationalCertificate), diff --git a/cardano-api/src/Cardano/Api/Typed.hs b/cardano-api/src/Cardano/Api/Typed.hs index bf49449e4fe..1fcdb5ccbcf 100644 --- a/cardano-api/src/Cardano/Api/Typed.hs +++ b/cardano-api/src/Cardano/Api/Typed.hs @@ -148,6 +148,8 @@ module Cardano.Api.Typed ( TxExtraContent(..), txExtraContentEmpty, Certificate(..), + toShelleyCertificate, + fromShelleyCertificate, -- * Signing transactions -- | Creating transaction witnesses one by one, or all in one go. From e85ad6ec7818b3645540824793897b7e4620ff6c Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 00:38:41 +0000 Subject: [PATCH 14/31] Generalise the toShelley*Credential functions for all eras Needed both directly and to be able to generalise other such conversion functions. --- cardano-api/src/Cardano/Api/Address.hs | 36 +++++++++++++++++++------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 77b269911c7..db21f305967 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -68,12 +68,18 @@ import qualified Data.ByteString.Base58 as Base58 import Control.Applicative +import qualified Cardano.Crypto.Hash.Class as Crypto + import qualified Cardano.Chain.Common as Byron +import qualified Cardano.Ledger.Era as Ledger import Ouroboros.Consensus.Shelley.Eras (StandardShelley) +import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) + import qualified Shelley.Spec.Ledger.Address as Shelley import qualified Shelley.Spec.Ledger.BaseTypes as Shelley import qualified Shelley.Spec.Ledger.Credential as Shelley +import qualified Shelley.Spec.Ledger.Scripts as Shelley import Cardano.Api.Eras import Cardano.Api.Hash @@ -495,22 +501,25 @@ toShelleyStakeAddr (StakeAddress nw sc) = Shelley.getRwdCred = coerceShelleyStakeCredential sc } -toShelleyPaymentCredential :: PaymentCredential - -> Shelley.PaymentCredential StandardShelley +toShelleyPaymentCredential :: Ledger.Crypto ledgerera ~ StandardCrypto + => PaymentCredential + -> Shelley.PaymentCredential ledgerera toShelleyPaymentCredential (PaymentCredentialByKey (PaymentKeyHash kh)) = Shelley.KeyHashObj kh toShelleyPaymentCredential (PaymentCredentialByScript (ScriptHash sh)) = - Shelley.ScriptHashObj sh + Shelley.ScriptHashObj (coerceShelleyScriptHash sh) -toShelleyStakeCredential :: StakeCredential - -> Shelley.StakeCredential StandardShelley +toShelleyStakeCredential :: Ledger.Crypto ledgerera ~ StandardCrypto + => StakeCredential + -> Shelley.StakeCredential ledgerera toShelleyStakeCredential (StakeCredentialByKey (StakeKeyHash kh)) = Shelley.KeyHashObj kh toShelleyStakeCredential (StakeCredentialByScript (ScriptHash kh)) = - Shelley.ScriptHashObj kh + Shelley.ScriptHashObj (coerceShelleyScriptHash kh) -toShelleyStakeReference :: StakeAddressReference - -> Shelley.StakeReference StandardShelley +toShelleyStakeReference :: Ledger.Crypto ledgerera ~ StandardCrypto + => StakeAddressReference + -> Shelley.StakeReference ledgerera toShelleyStakeReference (StakeAddressByValue stakecred) = Shelley.StakeRefBase (toShelleyStakeCredential stakecred) toShelleyStakeReference (StakeAddressByPointer ptr) = @@ -536,12 +545,13 @@ fromShelleyStakeAddr :: Shelley.RewardAcnt ledgerera -> StakeAddress fromShelleyStakeAddr (Shelley.RewardAcnt nw sc) = StakeAddress nw (coerceShelleyStakeCredential sc) -fromShelleyStakeCredential :: Shelley.StakeCredential StandardShelley +fromShelleyStakeCredential :: Ledger.Crypto ledgerera ~ StandardCrypto + => Shelley.StakeCredential ledgerera -> StakeCredential fromShelleyStakeCredential (Shelley.KeyHashObj kh) = StakeCredentialByKey (StakeKeyHash kh) fromShelleyStakeCredential (Shelley.ScriptHashObj kh) = - StakeCredentialByScript (ScriptHash kh) + StakeCredentialByScript (ScriptHash (coerceShelleyScriptHash kh)) -- The era parameter in these types is a phantom type so it is safe to cast. @@ -560,3 +570,9 @@ coerceShelleyStakeReference :: Shelley.StakeReference eraA -> Shelley.StakeReference eraB coerceShelleyStakeReference = coerce +coerceShelleyScriptHash :: Ledger.Crypto eraA ~ Ledger.Crypto eraB + => Shelley.ScriptHash eraA + -> Shelley.ScriptHash eraB +coerceShelleyScriptHash (Shelley.ScriptHash h) = + Shelley.ScriptHash (Crypto.castHash h) + From eb6ea84d61e453d27e076481f375f36378b4e87b Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 00:39:44 +0000 Subject: [PATCH 15/31] Generalise to/fromShelleyCertificate over all eras --- cardano-api/src/Cardano/Api/Certificate.hs | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index ccbcdbb0633..718d0fddc51 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | Certificates embedded in transactions @@ -51,7 +52,10 @@ import Network.Socket (PortNumber) import Cardano.Slotting.Slot (EpochNo (..)) import qualified Cardano.Crypto.Hash.Class as Crypto +import qualified Cardano.Ledger.Era as Ledger import Ouroboros.Consensus.Shelley.Eras (StandardShelley) +import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) + import Shelley.Spec.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe) import qualified Shelley.Spec.Ledger.BaseTypes as Shelley @@ -99,10 +103,10 @@ instance HasTypeProxy Certificate where proxyToAsType _ = AsCertificate instance ToCBOR Certificate where - toCBOR = toCBOR . toShelleyCertificate + toCBOR = toCBOR . toShelleyCertificate @StandardShelley instance FromCBOR Certificate where - fromCBOR = fromShelleyCertificate <$> fromCBOR + fromCBOR = fromShelleyCertificate @StandardShelley <$> fromCBOR instance HasTextEnvelope Certificate where textEnvelopeType _ = "CertificateShelley" @@ -193,7 +197,8 @@ makeMIRCertificate = MIRCertificate -- Internal conversion functions -- -toShelleyCertificate :: Certificate -> Shelley.DCert StandardShelley +toShelleyCertificate :: Ledger.Crypto ledgerera ~ StandardCrypto + => Certificate -> Shelley.DCert ledgerera toShelleyCertificate (StakeAddressRegistrationCertificate stakecred) = Shelley.DCertDeleg $ Shelley.RegKey @@ -243,7 +248,8 @@ toShelleyCertificate (MIRCertificate mirpot amounts) = | (sc, v) <- amounts ]) -fromShelleyCertificate :: Shelley.DCert StandardShelley -> Certificate +fromShelleyCertificate :: Ledger.Crypto ledgerera ~ StandardCrypto + => Shelley.DCert ledgerera -> Certificate fromShelleyCertificate (Shelley.DCertDeleg (Shelley.RegKey stakecred)) = StakeAddressRegistrationCertificate (fromShelleyStakeCredential stakecred) @@ -281,7 +287,8 @@ fromShelleyCertificate (Shelley.DCertMir (Shelley.MIRCert mirpot amounts)) = | (sc, v) <- Map.toList amounts ] -toShelleyPoolParams :: StakePoolParameters -> Shelley.PoolParams StandardShelley +toShelleyPoolParams :: Ledger.Crypto ledgerera ~ StandardCrypto + => StakePoolParameters -> Shelley.PoolParams ledgerera toShelleyPoolParams StakePoolParameters { stakePoolId = StakePoolKeyHash poolkh , stakePoolVRF = VrfKeyHash vrfkh @@ -345,7 +352,8 @@ toShelleyPoolParams StakePoolParameters { . Shelley.textToUrl -fromShelleyPoolParams :: Shelley.PoolParams StandardShelley +fromShelleyPoolParams :: Ledger.Crypto ledgerera ~ StandardCrypto + => Shelley.PoolParams ledgerera -> StakePoolParameters fromShelleyPoolParams Shelley.PoolParams { From f095db236a2f88abe14c82a6bd5069160b35eb9b Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 00:45:32 +0000 Subject: [PATCH 16/31] Generalise toShelley{TxId,TxIn,TxOut} over all ledger eras --- cardano-api/src/Cardano/Api/TxBody.hs | 30 ++++++++++++++++++++++----- 1 file changed, 25 insertions(+), 5 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 3dc5eac1668..6bf7e7dd8de 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -1,9 +1,11 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -62,6 +64,8 @@ import qualified Cardano.Crypto.Hashing as Byron import qualified Cardano.Chain.Common as Byron import qualified Cardano.Chain.UTxO as Byron +import qualified Cardano.Ledger.Era as Ledger +import qualified Cardano.Ledger.Shelley as Ledger import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) @@ -113,7 +117,8 @@ toByronTxId :: TxId -> Byron.TxId toByronTxId (TxId h) = Byron.unsafeHashFromBytes (Crypto.hashToBytes h) -toShelleyTxId :: TxId -> Shelley.TxId StandardShelley +toShelleyTxId :: Ledger.Crypto ledgerera ~ StandardCrypto + => TxId -> Shelley.TxId ledgerera toShelleyTxId (TxId h) = Shelley.TxId (Crypto.castHash h) @@ -174,14 +179,29 @@ toByronLovelace (Lovelace x) = Left _ -> Nothing Right x' -> Just x' -toShelleyTxIn :: TxIn -> Shelley.TxIn StandardShelley +toShelleyTxIn :: (Ledger.Era ledgerera, + Ledger.Crypto ledgerera ~ StandardCrypto) + => TxIn -> Shelley.TxIn ledgerera toShelleyTxIn (TxIn txid (TxIx txix)) = Shelley.TxIn (toShelleyTxId txid) (fromIntegral txix) -toShelleyTxOut :: TxOut ShelleyEra -> Shelley.TxOut StandardShelley -toShelleyTxOut (TxOut addr (TxOutAdaOnly _ value)) = +toShelleyTxOut :: forall era ledgerera. + (ShelleyLedgerEra era ~ ledgerera, + IsShelleyBasedEra era, Ledger.ShelleyBased ledgerera) + => TxOut era -> Shelley.TxOut ledgerera +toShelleyTxOut (TxOut _ (TxOutAdaOnly AdaOnlyInByronEra _)) = + case shelleyBasedEra :: ShelleyBasedEra era of {} + +toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value)) = + Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value) + +toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value)) = Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value) -toShelleyTxOut (TxOut _addr (TxOutValue evidence _)) = case evidence of {} + +toShelleyTxOut (TxOut _addr (TxOutValue MultiAssetInMaryEra _value)) = + error "toShelleyTxOut: TODO: TxOutValue MultiAssetInMaryEra" + + -- ---------------------------------------------------------------------------- From 7a9cd1f62a9c5449d30a862c0f60f49c2952ba35 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 00:57:01 +0000 Subject: [PATCH 17/31] Use single Eq, Show and HasTypeProxy instance for TxBody Replace per-era instances with a single era-paramaterised instance. This will be simpler as we add more eras. --- cardano-api/src/Cardano/Api/TxBody.hs | 28 ++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 6bf7e7dd8de..e864f69579f 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -38,7 +39,7 @@ module Cardano.Api.TxBody ( txExtraContentEmpty, -- * Data family instances - AsType(..), + AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody), ) where import Prelude @@ -219,26 +220,27 @@ data TxBody era where -> Maybe Shelley.MetaData -> TxBody ShelleyEra -deriving instance Eq (TxBody ByronEra) -deriving instance Show (TxBody ByronEra) +deriving instance Eq (TxBody era) +deriving instance Show (TxBody era) -deriving instance Eq (TxBody ShelleyEra) -deriving instance Show (TxBody ShelleyEra) +instance HasTypeProxy era => HasTypeProxy (TxBody era) where + data AsType (TxBody era) = AsTxBody (AsType era) + proxyToAsType _ = AsTxBody (proxyToAsType (Proxy :: Proxy era)) -instance HasTypeProxy (TxBody ByronEra) where - data AsType (TxBody ByronEra) = AsByronTxBody - proxyToAsType _ = AsByronTxBody +pattern AsByronTxBody :: AsType (TxBody ByronEra) +pattern AsByronTxBody = AsTxBody AsByronEra +{-# COMPLETE AsByronTxBody #-} -instance HasTypeProxy (TxBody ShelleyEra) where - data AsType (TxBody ShelleyEra) = AsShelleyTxBody - proxyToAsType _ = AsShelleyTxBody +pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra) +pattern AsShelleyTxBody = AsTxBody AsShelleyEra +{-# COMPLETE AsShelleyTxBody #-} instance SerialiseAsCBOR (TxBody ByronEra) where serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody - deserialiseFromCBOR AsByronTxBody bs = do + deserialiseFromCBOR _ bs = do ByronTxBody <$> CBOR.decodeFullAnnotatedBytes "Byron TxBody" @@ -252,7 +254,7 @@ instance SerialiseAsCBOR (TxBody ShelleyEra) where <> CBOR.toCBOR txbody <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata - deserialiseFromCBOR AsShelleyTxBody bs = + deserialiseFromCBOR _ bs = CBOR.decodeAnnotator "Shelley TxBody" decodeAnnotatedPair From afa2961956cba33d1c26333956475c334b58d0f7 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 01:06:45 +0000 Subject: [PATCH 18/31] Use single SerialiseAsCBOR and HasTextEnvelope instance for TxBody Replace per-era instances with a single era-paramaterised instance. This will be simpler as we add more eras. --- cardano-api/src/Cardano/Api/TxBody.hs | 41 +++++++++++++++------------ 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index e864f69579f..7aaf601aed8 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -236,18 +236,11 @@ pattern AsShelleyTxBody = AsTxBody AsShelleyEra {-# COMPLETE AsShelleyTxBody #-} -instance SerialiseAsCBOR (TxBody ByronEra) where +instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where + serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody - deserialiseFromCBOR _ bs = do - ByronTxBody <$> - CBOR.decodeFullAnnotatedBytes - "Byron TxBody" - CBOR.fromCBORAnnotated - (LBS.fromStrict bs) - -instance SerialiseAsCBOR (TxBody ShelleyEra) where serialiseToCBOR (ShelleyTxBody txbody txmetadata) = CBOR.serializeEncoding' $ CBOR.encodeListLen 2 @@ -255,10 +248,20 @@ instance SerialiseAsCBOR (TxBody ShelleyEra) where <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata deserialiseFromCBOR _ bs = - CBOR.decodeAnnotator - "Shelley TxBody" - decodeAnnotatedPair - (LBS.fromStrict bs) + case cardanoEra :: CardanoEra era of + ByronEra -> + ByronTxBody <$> + CBOR.decodeFullAnnotatedBytes + "Byron TxBody" + CBOR.fromCBORAnnotated + (LBS.fromStrict bs) + ShelleyEra -> + CBOR.decodeAnnotator + "Shelley TxBody" + decodeAnnotatedPair + (LBS.fromStrict bs) + AllegraEra -> error "TODO: SerialiseAsCBOR (TxBody AllegraEra)" + MaryEra -> error "TODO: SerialiseAsCBOR (TxBody MaryEra)" where decodeAnnotatedPair :: CBOR.Decoder s (CBOR.Annotator (TxBody ShelleyEra)) decodeAnnotatedPair = do @@ -271,11 +274,13 @@ instance SerialiseAsCBOR (TxBody ShelleyEra) where (CBOR.runAnnotator <$> txmetadata <*> pure fbs) -instance HasTextEnvelope (TxBody ByronEra) where - textEnvelopeType _ = "TxUnsignedByron" - -instance HasTextEnvelope (TxBody ShelleyEra) where - textEnvelopeType _ = "TxUnsignedShelley" +instance IsCardanoEra era => HasTextEnvelope (TxBody era) where + textEnvelopeType _ = + case cardanoEra :: CardanoEra era of + ByronEra -> "TxUnsignedByron" + ShelleyEra -> "TxUnsignedShelley" + AllegraEra -> "TxBodyAllegra" + MaryEra -> "TxBodyMary" data ByronTxBodyConversionError = From 580e50c4e832d130b2147ab778d5f0c9c50ea374 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 01:10:50 +0000 Subject: [PATCH 19/31] Initial step to generalise makeShelleyTransaction over other eras Generalise over the IsShelleyBasedEra class. The Allegra and Mary cases remain to do. --- cardano-api/src/Cardano/Api/TxBody.hs | 35 ++++++++++++++++----------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 7aaf601aed8..5ce1d95cebf 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -329,12 +329,14 @@ txExtraContentEmpty = type TxFee = Lovelace type TTL = SlotNo -makeShelleyTransaction :: TxExtraContent +makeShelleyTransaction :: forall era. + IsShelleyBasedEra era + => TxExtraContent -> TTL -> TxFee -> [TxIn] - -> [TxOut ShelleyEra] - -> TxBody ShelleyEra + -> [TxOut era] + -> TxBody era makeShelleyTransaction TxExtraContent { txMetadata, txWithdrawals, @@ -342,17 +344,22 @@ makeShelleyTransaction TxExtraContent { txUpdateProposal } ttl fee ins outs = --TODO: validate the txins are not empty, and tx out coin values are in range - ShelleyTxBody - (Shelley.TxBody - (Set.fromList (map toShelleyTxIn ins)) - (Seq.fromList (map toShelleyTxOut outs)) - (Seq.fromList (map toShelleyCertificate txCertificates)) - (toShelleyWithdrawal txWithdrawals) - (toShelleyLovelace fee) - ttl - (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) - (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata)) - (toShelleyMetadata <$> txMetadata) + case shelleyBasedEra :: ShelleyBasedEra era of + ShelleyBasedEraShelley -> + ShelleyTxBody + (Shelley.TxBody + (Set.fromList (map toShelleyTxIn ins)) + (Seq.fromList (map toShelleyTxOut outs)) + (Seq.fromList (map toShelleyCertificate txCertificates)) + (toShelleyWithdrawal txWithdrawals) + (toShelleyLovelace fee) + ttl + (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) + (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata)) + (toShelleyMetadata <$> txMetadata) + ShelleyBasedEraAllegra -> error "TODO: makeShelleyTransaction AllegraEra" + ShelleyBasedEraMary -> error "TODO: makeShelleyTransaction MaryEra" + toShelleyWithdrawal :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl ledgerera toShelleyWithdrawal withdrawals = From 630f02db11fa1b81bd16d36cb2c50176d701c0c9 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 01:12:42 +0000 Subject: [PATCH 20/31] Switch TxBody from Shelley-specific type to era-dependent Switch from the Shelley.TxBody concrete type, to using the Ledger.TxBody type family. The type family has different representations for different eras. For this step the specific era remains the same, so there are no other changes. The next step will be to cover multiple eras, at which point we will take advantage of the different tx body representations for each era. --- cardano-api/src/Cardano/Api/TxBody.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 5ce1d95cebf..248e632ddfd 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -66,6 +66,7 @@ import qualified Cardano.Chain.Common as Byron import qualified Cardano.Chain.UTxO as Byron import qualified Cardano.Ledger.Era as Ledger +import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Shelley as Ledger import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) @@ -216,7 +217,7 @@ data TxBody era where -> TxBody ByronEra ShelleyTxBody - :: Shelley.TxBody StandardShelley + :: Ledger.TxBody StandardShelley -> Maybe Shelley.MetaData -> TxBody ShelleyEra From 67b78cf8143420cd603e7f6ff2c8359f5be7dca4 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 01:59:46 +0000 Subject: [PATCH 21/31] Generalise the ShelleyTxBody representation over multiple eras The 'ShelleyBasedEra' GADT tells us what era we are in. The 'ShelleyLedgerEra' type family maps that to the era type from the ledger lib. The 'Ledger.TxBody' type family maps that to a specific tx body type, which is different for each Shelley-based era. Due to this use of GADTs We now need custom Eq and Show instances. Do the minimal changes elsewhere, inserting error cases to fill in next. --- cardano-api/src/Cardano/Api/Tx.hs | 16 +++-- cardano-api/src/Cardano/Api/TxBody.hs | 90 +++++++++++++++++++++++---- 2 files changed, 90 insertions(+), 16 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index c36ff79f915..9e8bda4c8f8 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -262,7 +263,7 @@ getTxBody (ShelleyTx Shelley.Tx { Shelley._body = txbody, Shelley._metadata = txmetadata }) = - ShelleyTxBody txbody (strictMaybeToMaybe txmetadata) + ShelleyTxBody ShelleyBasedEraShelley txbody (strictMaybeToMaybe txmetadata) getTxWitnesses :: Tx era -> [Witness era] @@ -297,7 +298,7 @@ makeSignedTransaction witnesses (ByronTxBody txbody) = selectByronWitness :: Witness ByronEra -> Byron.TxInWitness selectByronWitness (ByronKeyWitness w) = w -makeSignedTransaction witnesses (ShelleyTxBody txbody txmetadata) = +makeSignedTransaction witnesses (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) = ShelleyTx $ Shelley.Tx txbody @@ -307,11 +308,16 @@ makeSignedTransaction witnesses (ShelleyTxBody txbody txmetadata) = | ShelleyScriptWitness sw <- witnesses ]) (Set.fromList [ w | ShelleyBootstrapWitness w <- witnesses ])) (maybeToStrictMaybe txmetadata) +makeSignedTransaction _ (ShelleyTxBody ShelleyBasedEraAllegra _ _) = + error "TODO: makeSignedTransaction AllegraEra" +makeSignedTransaction _ (ShelleyTxBody ShelleyBasedEraMary _ _) = + error "TODO: makeSignedTransaction MaryEra" makeByronKeyWitness :: NetworkId -> TxBody ByronEra -> SigningKey ByronKey -> Witness ByronEra +makeByronKeyWitness _ (ShelleyTxBody era _ _) = case era of {} makeByronKeyWitness nw (ByronTxBody txbody) = let txhash :: Byron.Hash Byron.Tx txhash = Byron.hashDecoded txbody @@ -347,7 +353,9 @@ makeShelleyBootstrapWitness :: WitnessNetworkIdOrByronAddress -> TxBody ShelleyEra -> SigningKey ByronKey -> Witness ShelleyEra -makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody txbody _) (ByronSigningKey sk) = +makeShelleyBootstrapWitness nwOrAddr + (ShelleyTxBody ShelleyBasedEraShelley txbody _) + (ByronSigningKey sk) = ShelleyBootstrapWitness $ -- Byron era witnesses were weird. This reveals all that weirdness. Shelley.BootstrapWitness { @@ -434,7 +442,7 @@ data ShelleyWitnessSigningKey = makeShelleyKeyWitness :: TxBody ShelleyEra -> ShelleyWitnessSigningKey -> Witness ShelleyEra -makeShelleyKeyWitness (ShelleyTxBody txbody _) = +makeShelleyKeyWitness (ShelleyTxBody ShelleyBasedEraShelley txbody _) = let txhash :: Shelley.Hash StandardCrypto Shelley.EraIndependentTxBody txhash = Shelley.hashAnnotated txbody diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 248e632ddfd..602d73592f2 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -68,6 +68,7 @@ import qualified Cardano.Chain.UTxO as Byron import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Shelley as Ledger +import qualified Cardano.Ledger.ShelleyMA.TxBody () import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) @@ -134,12 +135,20 @@ getTxId (ByronTxBody tx) = . recoverBytes $ tx -getTxId (ShelleyTxBody tx _) = - TxId - . Crypto.castHash - . (\(Shelley.TxId txhash) -> txhash) - . Shelley.txid - $ tx +getTxId (ShelleyTxBody era tx _) = + case era of + ShelleyBasedEraShelley -> getTxIdShelley tx + ShelleyBasedEraAllegra -> getTxIdShelley tx + ShelleyBasedEraMary -> getTxIdShelley tx + where + getTxIdShelley :: Ledger.Crypto ledgerera ~ StandardCrypto + => Ledger.TxBodyConstraints ledgerera + => Ledger.TxBody ledgerera -> TxId + getTxIdShelley = + TxId + . Crypto.castHash + . (\(Shelley.TxId txhash) -> txhash) + . Shelley.txid -- ---------------------------------------------------------------------------- @@ -217,12 +226,63 @@ data TxBody era where -> TxBody ByronEra ShelleyTxBody - :: Ledger.TxBody StandardShelley + :: ShelleyBasedEra era + -> Ledger.TxBody (ShelleyLedgerEra era) -> Maybe Shelley.MetaData - -> TxBody ShelleyEra - -deriving instance Eq (TxBody era) -deriving instance Show (TxBody era) + -> TxBody era + -- The 'ShelleyBasedEra' GADT tells us what era we are in. + -- The 'ShelleyLedgerEra' type family maps that to the era type from the + -- ledger lib. The 'Ledger.TxBody' type family maps that to a specific + -- tx body type, which is different for each Shelley-based era. + + +-- The GADT in the ShelleyTxBody case requires a custom instance +instance Eq (TxBody era) where + (==) (ByronTxBody txbodyA) + (ByronTxBody txbodyB) = txbodyA == txbodyB + + (==) (ShelleyTxBody era txbodyA txmetadataA) + (ShelleyTxBody _ txbodyB txmetadataB) = + txmetadataA == txmetadataB + && case era of + ShelleyBasedEraShelley -> txbodyA == txbodyB + ShelleyBasedEraAllegra -> txbodyA == txbodyB + ShelleyBasedEraMary -> txbodyA == txbodyB + + (==) (ByronTxBody{}) (ShelleyTxBody era _ _) = case era of {} + + +-- The GADT in the ShelleyTxBody case requires a custom instance +instance Show (TxBody era) where + showsPrec p (ByronTxBody txbody) = + showParen (p >= 11) + ( showString "ByronTxBody " + . showsPrec 11 txbody + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraShelley " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txmetadata + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraAllegra txbody txmetadata) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraAllegra " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txmetadata + ) + + showsPrec p (ShelleyTxBody ShelleyBasedEraMary txbody txmetadata) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraMary " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txmetadata + ) instance HasTypeProxy era => HasTypeProxy (TxBody era) where data AsType (TxBody era) = AsTxBody (AsType era) @@ -242,11 +302,15 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody - serialiseToCBOR (ShelleyTxBody txbody txmetadata) = + serialiseToCBOR (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) = CBOR.serializeEncoding' $ CBOR.encodeListLen 2 <> CBOR.toCBOR txbody <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata + serialiseToCBOR (ShelleyTxBody ShelleyBasedEraAllegra _ _) = + error "TODO: SerialiseAsCBOR (TxBody AllegraEra)" + serialiseToCBOR (ShelleyTxBody ShelleyBasedEraMary _ _) = + error "TODO: SerialiseAsCBOR (TxBody MaryEra)" deserialiseFromCBOR _ bs = case cardanoEra :: CardanoEra era of @@ -271,6 +335,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where txmetadata <- CBOR.decodeNullMaybe fromCBOR return $ CBOR.Annotator $ \fbs -> ShelleyTxBody + ShelleyBasedEraShelley (CBOR.runAnnotator txbody fbs) (CBOR.runAnnotator <$> txmetadata <*> pure fbs) @@ -348,6 +413,7 @@ makeShelleyTransaction TxExtraContent { case shelleyBasedEra :: ShelleyBasedEra era of ShelleyBasedEraShelley -> ShelleyTxBody + ShelleyBasedEraShelley (Shelley.TxBody (Set.fromList (map toShelleyTxIn ins)) (Seq.fromList (map toShelleyTxOut outs)) From 134403fddb5d7d59c92c9b86943ec7a92b778620 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sun, 22 Nov 2020 02:10:04 +0000 Subject: [PATCH 22/31] Generalise several tx and witness functions over eras This is partial in that we generalise the type, but the Allegra and Mary cases are error TODOs for now. This is still helpful to allow downstream code to type check at other eras. --- cardano-api/src/Cardano/Api/Tx.hs | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index 9e8bda4c8f8..078f929559b 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -350,9 +350,9 @@ data WitnessNetworkIdOrByronAddress -- address and used in the construction of the witness. makeShelleyBootstrapWitness :: WitnessNetworkIdOrByronAddress - -> TxBody ShelleyEra + -> TxBody era -> SigningKey ByronKey - -> Witness ShelleyEra + -> Witness era makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody ShelleyBasedEraShelley txbody _) (ByronSigningKey sk) = @@ -425,6 +425,14 @@ makeShelleyBootstrapWitness nwOrAddr (Byron.aaNetworkMagic . unAddrAttrs) eitherNwOrAddr +makeShelleyBootstrapWitness _ (ShelleyTxBody ShelleyBasedEraAllegra _ _) _ = + error "TODO: makeShelleyBootstrapWitness AllegraEra" +makeShelleyBootstrapWitness _ (ShelleyTxBody ShelleyBasedEraMary _ _) _ = + error "TODO: makeShelleyBootstrapWitness MaryEra" +makeShelleyBootstrapWitness _ ByronTxBody{} _ = + error "TODO: makeShelleyBootstrapWitness ByronEra" + + data ShelleyWitnessSigningKey = WitnessPaymentKey (SigningKey PaymentKey) | WitnessPaymentExtendedKey (SigningKey PaymentExtendedKey) @@ -439,9 +447,9 @@ data ShelleyWitnessSigningKey = | WitnessGenesisUTxOKey (SigningKey GenesisUTxOKey) -makeShelleyKeyWitness :: TxBody ShelleyEra +makeShelleyKeyWitness :: TxBody era -> ShelleyWitnessSigningKey - -> Witness ShelleyEra + -> Witness era makeShelleyKeyWitness (ShelleyTxBody ShelleyBasedEraShelley txbody _) = let txhash :: Shelley.Hash StandardCrypto Shelley.EraIndependentTxBody txhash = Shelley.hashAnnotated txbody @@ -454,6 +462,12 @@ makeShelleyKeyWitness (ShelleyTxBody ShelleyBasedEraShelley txbody _) = signature = makeShelleySignature txhash sk in ShelleyKeyWitness $ Shelley.WitVKey vk signature +makeShelleyKeyWitness (ShelleyTxBody ShelleyBasedEraAllegra _ _) = + error "TODO: makeShelleyKeyWitness AllegraEra" +makeShelleyKeyWitness (ShelleyTxBody ShelleyBasedEraMary _ _) = + error "TODO: makeShelleyKeyWitness MaryEra" +makeShelleyKeyWitness ByronTxBody{} = + error "TODO: makeShelleyKeyWitness ByronEra" -- | We support making key witnesses with both normal and extended signing keys. @@ -555,9 +569,9 @@ signByronTransaction nw txbody sks = witnesses = map (makeByronKeyWitness nw txbody) sks -- signing keys is a set -signShelleyTransaction :: TxBody ShelleyEra +signShelleyTransaction :: TxBody era -> [ShelleyWitnessSigningKey] - -> Tx ShelleyEra + -> Tx era signShelleyTransaction txbody sks = makeSignedTransaction witnesses txbody where From b54ad5824300eb9f64a35a9859e7dbdb090e969f Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 10:53:54 +0000 Subject: [PATCH 23/31] Extend TxBody serialisation to the Allegra and Mary eras All the Shelley-based eras are supported with one overloaded implementation used at different types. --- cardano-api/src/Cardano/Api/TxBody.hs | 74 +++++++++++++++++---------- 1 file changed, 47 insertions(+), 27 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 602d73592f2..0c3637c88d3 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -302,15 +302,12 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody - serialiseToCBOR (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) = - CBOR.serializeEncoding' $ - CBOR.encodeListLen 2 - <> CBOR.toCBOR txbody - <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata - serialiseToCBOR (ShelleyTxBody ShelleyBasedEraAllegra _ _) = - error "TODO: SerialiseAsCBOR (TxBody AllegraEra)" - serialiseToCBOR (ShelleyTxBody ShelleyBasedEraMary _ _) = - error "TODO: SerialiseAsCBOR (TxBody MaryEra)" + serialiseToCBOR (ShelleyTxBody era txbody txmetadata) = + case era of + -- Use the same serialisation impl, but at different types: + ShelleyBasedEraShelley -> serialiseShelleyBasedTxBody txbody txmetadata + ShelleyBasedEraAllegra -> serialiseShelleyBasedTxBody txbody txmetadata + ShelleyBasedEraMary -> serialiseShelleyBasedTxBody txbody txmetadata deserialiseFromCBOR _ bs = case cardanoEra :: CardanoEra era of @@ -320,25 +317,48 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where "Byron TxBody" CBOR.fromCBORAnnotated (LBS.fromStrict bs) - ShelleyEra -> - CBOR.decodeAnnotator - "Shelley TxBody" - decodeAnnotatedPair - (LBS.fromStrict bs) - AllegraEra -> error "TODO: SerialiseAsCBOR (TxBody AllegraEra)" - MaryEra -> error "TODO: SerialiseAsCBOR (TxBody MaryEra)" - where - decodeAnnotatedPair :: CBOR.Decoder s (CBOR.Annotator (TxBody ShelleyEra)) - decodeAnnotatedPair = do - CBOR.decodeListLenOf 2 - txbody <- fromCBOR - txmetadata <- CBOR.decodeNullMaybe fromCBOR - return $ CBOR.Annotator $ \fbs -> - ShelleyTxBody - ShelleyBasedEraShelley - (CBOR.runAnnotator txbody fbs) - (CBOR.runAnnotator <$> txmetadata <*> pure fbs) + -- Use the same derialisation impl, but at different types: + ShelleyEra -> deserialiseShelleyBasedTxBody + (ShelleyTxBody ShelleyBasedEraShelley) bs + AllegraEra -> deserialiseShelleyBasedTxBody + (ShelleyTxBody ShelleyBasedEraAllegra) bs + MaryEra -> deserialiseShelleyBasedTxBody + (ShelleyTxBody ShelleyBasedEraMary) bs + +-- | The serialisation format for the different Shelley-based eras are not the +-- same, but they can be handled generally with one overloaded implementation. +-- +serialiseShelleyBasedTxBody :: forall txbody metadata. + (ToCBOR txbody, ToCBOR metadata) + => txbody -> Maybe metadata -> ByteString +serialiseShelleyBasedTxBody txbody txmetadata = + CBOR.serializeEncoding' $ + CBOR.encodeListLen 2 + <> CBOR.toCBOR txbody + <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata + +deserialiseShelleyBasedTxBody :: forall txbody metadata pair. + (FromCBOR (CBOR.Annotator txbody), + FromCBOR (CBOR.Annotator metadata)) + => (txbody -> Maybe metadata -> pair) + -> ByteString + -> Either CBOR.DecoderError pair +deserialiseShelleyBasedTxBody mkTxBody bs = + CBOR.decodeAnnotator + "Shelley TxBody" + decodeAnnotatedPair + (LBS.fromStrict bs) + where + decodeAnnotatedPair :: CBOR.Decoder s (CBOR.Annotator pair) + decodeAnnotatedPair = do + CBOR.decodeListLenOf 2 + txbody <- fromCBOR + txmetadata <- CBOR.decodeNullMaybe fromCBOR + return $ CBOR.Annotator $ \fbs -> + mkTxBody + (CBOR.runAnnotator txbody fbs) + (CBOR.runAnnotator <$> txmetadata <*> pure fbs) instance IsCardanoEra era => HasTextEnvelope (TxBody era) where textEnvelopeType _ = From 49edfcbc5b43b9b7417aa7972aa4199d218f1738 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 11:03:23 +0000 Subject: [PATCH 24/31] Partially fill in makeShelleyTransaction for the Allegra & Mary eras Still TODOs for validity intervals and minting. --- cardano-api/src/Cardano/Api/TxBody.hs | 34 ++++++++++++++++++++++++--- 1 file changed, 31 insertions(+), 3 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 0c3637c88d3..5e3394a53b7 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -68,7 +68,7 @@ import qualified Cardano.Chain.UTxO as Byron import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Shelley as Ledger -import qualified Cardano.Ledger.ShelleyMA.TxBody () +import qualified Cardano.Ledger.ShelleyMA.TxBody as Allegra import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) @@ -444,8 +444,36 @@ makeShelleyTransaction TxExtraContent { (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata)) (toShelleyMetadata <$> txMetadata) - ShelleyBasedEraAllegra -> error "TODO: makeShelleyTransaction AllegraEra" - ShelleyBasedEraMary -> error "TODO: makeShelleyTransaction MaryEra" + + ShelleyBasedEraAllegra -> + ShelleyTxBody + ShelleyBasedEraAllegra + (Allegra.TxBody + (Set.fromList (map toShelleyTxIn ins)) + (Seq.fromList (map toShelleyTxOut outs)) + (Seq.fromList (map toShelleyCertificate txCertificates)) + (toShelleyWithdrawal txWithdrawals) + (toShelleyLovelace fee) + (error "TODO: support validity interval") + (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) + (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata) + mempty) -- No minting in Allegra, only Mary + (toShelleyMetadata <$> txMetadata) + + ShelleyBasedEraMary -> + ShelleyTxBody + ShelleyBasedEraMary + (Allegra.TxBody + (Set.fromList (map toShelleyTxIn ins)) + (Seq.fromList (map toShelleyTxOut outs)) + (Seq.fromList (map toShelleyCertificate txCertificates)) + (toShelleyWithdrawal txWithdrawals) + (toShelleyLovelace fee) + (error "TODO: makeShelleyTransaction support validity interval") + (toShelleyUpdate <$> maybeToStrictMaybe txUpdateProposal) + (toShelleyMetadataHash <$> maybeToStrictMaybe txMetadata) + (error "TODO: makeShelleyTransaction support minting")) + (toShelleyMetadata <$> txMetadata) toShelleyWithdrawal :: [(StakeAddress, Lovelace)] -> Shelley.Wdrl ledgerera From ea1885823fe8a026df9cf2db46fc0b69c84dd46a Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 15:20:04 +0000 Subject: [PATCH 25/31] Add to/fromShelleyScriptHash and use them We sort-of already had implementations of these in the impl of to/fromShelleyAddress functions. Pull them out to top level functions and put them next to the definition of the ScriptHash type. We'll reuse these new functions in the next patch. --- cardano-api/src/Cardano/Api/Address.hs | 21 ++++++--------------- cardano-api/src/Cardano/Api/Script.hs | 19 +++++++++++++++++++ 2 files changed, 25 insertions(+), 15 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index db21f305967..221f3b2ea97 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -68,8 +68,6 @@ import qualified Data.ByteString.Base58 as Base58 import Control.Applicative -import qualified Cardano.Crypto.Hash.Class as Crypto - import qualified Cardano.Chain.Common as Byron import qualified Cardano.Ledger.Era as Ledger @@ -79,7 +77,6 @@ import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) import qualified Shelley.Spec.Ledger.Address as Shelley import qualified Shelley.Spec.Ledger.BaseTypes as Shelley import qualified Shelley.Spec.Ledger.Credential as Shelley -import qualified Shelley.Spec.Ledger.Scripts as Shelley import Cardano.Api.Eras import Cardano.Api.Hash @@ -506,16 +503,16 @@ toShelleyPaymentCredential :: Ledger.Crypto ledgerera ~ StandardCrypto -> Shelley.PaymentCredential ledgerera toShelleyPaymentCredential (PaymentCredentialByKey (PaymentKeyHash kh)) = Shelley.KeyHashObj kh -toShelleyPaymentCredential (PaymentCredentialByScript (ScriptHash sh)) = - Shelley.ScriptHashObj (coerceShelleyScriptHash sh) +toShelleyPaymentCredential (PaymentCredentialByScript sh) = + Shelley.ScriptHashObj (toShelleyScriptHash sh) toShelleyStakeCredential :: Ledger.Crypto ledgerera ~ StandardCrypto => StakeCredential -> Shelley.StakeCredential ledgerera toShelleyStakeCredential (StakeCredentialByKey (StakeKeyHash kh)) = Shelley.KeyHashObj kh -toShelleyStakeCredential (StakeCredentialByScript (ScriptHash kh)) = - Shelley.ScriptHashObj (coerceShelleyScriptHash kh) +toShelleyStakeCredential (StakeCredentialByScript sh) = + Shelley.ScriptHashObj (toShelleyScriptHash sh) toShelleyStakeReference :: Ledger.Crypto ledgerera ~ StandardCrypto => StakeAddressReference @@ -550,8 +547,8 @@ fromShelleyStakeCredential :: Ledger.Crypto ledgerera ~ StandardCrypto -> StakeCredential fromShelleyStakeCredential (Shelley.KeyHashObj kh) = StakeCredentialByKey (StakeKeyHash kh) -fromShelleyStakeCredential (Shelley.ScriptHashObj kh) = - StakeCredentialByScript (ScriptHash (coerceShelleyScriptHash kh)) +fromShelleyStakeCredential (Shelley.ScriptHashObj sh) = + StakeCredentialByScript (fromShelleyScriptHash sh) -- The era parameter in these types is a phantom type so it is safe to cast. @@ -570,9 +567,3 @@ coerceShelleyStakeReference :: Shelley.StakeReference eraA -> Shelley.StakeReference eraB coerceShelleyStakeReference = coerce -coerceShelleyScriptHash :: Ledger.Crypto eraA ~ Ledger.Crypto eraB - => Shelley.ScriptHash eraA - -> Shelley.ScriptHash eraB -coerceShelleyScriptHash (Shelley.ScriptHash h) = - Shelley.ScriptHash (Crypto.castHash h) - diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 1647ebbc2c7..6afe51a6378 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -34,6 +34,10 @@ module Cardano.Api.Script ( , MultiSigScript , makeMultiSigScript + -- * Internal conversion functions + , toShelleyScriptHash + , fromShelleyScriptHash + -- * Data family instances , AsType(..) ) where @@ -192,6 +196,21 @@ scriptHash (MaryScript s) = ScriptHash Shelley.ScriptHash (Crypto.castHash sh)) $ Timelock.hashTimelockScript s +toShelleyScriptHash :: Ledger.Crypto ledgerera ~ StandardCrypto + => ScriptHash -> Shelley.ScriptHash ledgerera +toShelleyScriptHash (ScriptHash h) = coerceShelleyScriptHash h + +fromShelleyScriptHash :: Ledger.Crypto ledgerera ~ StandardCrypto + => Shelley.ScriptHash ledgerera -> ScriptHash +fromShelleyScriptHash = ScriptHash . coerceShelleyScriptHash + +coerceShelleyScriptHash :: Ledger.Crypto ledgereraA ~ Ledger.Crypto ledgereraB + => Shelley.ScriptHash ledgereraA + -> Shelley.ScriptHash ledgereraB +coerceShelleyScriptHash (Shelley.ScriptHash h) = + Shelley.ScriptHash (Crypto.castHash h) + + -- ---------------------------------------------------------------------------- -- The simple native script language From 4b476cea6c5020f286925b14626e466465da5c84 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 15:21:50 +0000 Subject: [PATCH 26/31] Add to/fromMaryValue for converting the Value type To/from the equivalent ledger library type. The ledger representation is a pair of the lovelace value and a nested map of the non-ada assets. --- cardano-api/src/Cardano/Api/Value.hs | 45 ++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index a1020181ddf..91ce17dca72 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -- | Currency values @@ -35,6 +36,8 @@ module Cardano.Api.Value -- * Internal conversion functions , toShelleyLovelace , fromShelleyLovelace + , toMaryValue + , fromMaryValue ) where import Prelude @@ -45,7 +48,11 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.String (IsString) +import qualified Cardano.Ledger.Era as Ledger import qualified Shelley.Spec.Ledger.Coin as Shelley +import qualified Cardano.Ledger.Mary.Value as Mary + +import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) import Cardano.Api.Eras import Cardano.Api.Script @@ -162,6 +169,44 @@ lovelaceToValue :: Lovelace -> Value lovelaceToValue = Value . Map.singleton AdaAssetId . lovelaceToQuantity +toMaryValue :: forall ledgerera. + Ledger.Crypto ledgerera ~ StandardCrypto + => Value -> Mary.Value ledgerera +toMaryValue v = + Mary.Value lovelace other + where + Quantity lovelace = selectAsset v AdaAssetId + --TODO: write QC tests to show it's ok to use Map.fromAscListWith here + other = Map.fromListWith Map.union + [ (toMaryPolicyID pid, Map.singleton (toMaryAssetName name) q) + | (AssetId pid name, Quantity q) <- valueToList v ] + + toMaryPolicyID :: PolicyId -> Mary.PolicyID ledgerera + toMaryPolicyID (PolicyId sh) = Mary.PolicyID (toShelleyScriptHash sh) + + toMaryAssetName :: AssetName -> Mary.AssetName + toMaryAssetName (AssetName n) = Mary.AssetName n + + +fromMaryValue :: forall ledgerera. + Ledger.Crypto ledgerera ~ StandardCrypto + => Mary.Value ledgerera -> Value +fromMaryValue (Mary.Value lovelace other) = + Value $ + --TODO: write QC tests to show it's ok to use Map.fromAscList here + Map.fromList $ + [ (AdaAssetId, Quantity lovelace) | lovelace /= 0 ] + ++ [ (AssetId (fromMaryPolicyID pid) (fromMaryAssetName name), Quantity q) + | (pid, as) <- Map.toList other + , (name, q) <- Map.toList as ] + where + fromMaryPolicyID :: Mary.PolicyID ledgerera -> PolicyId + fromMaryPolicyID (Mary.PolicyID sh) = PolicyId (fromShelleyScriptHash sh) + + fromMaryAssetName :: Mary.AssetName -> AssetName + fromMaryAssetName (Mary.AssetName n) = AssetName n + + -- ---------------------------------------------------------------------------- -- Era-dependent use of multi-assert values -- From f6db51cf11873556200fcfd46232e434a9e78542 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 15:22:55 +0000 Subject: [PATCH 27/31] Cover the multi-asset case in toShelleyTxOut Now that we have toMaryValue --- cardano-api/src/Cardano/Api/TxBody.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 5e3394a53b7..adfcc95a2d9 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -209,8 +209,8 @@ toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value)) = toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value)) = Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value) -toShelleyTxOut (TxOut _addr (TxOutValue MultiAssetInMaryEra _value)) = - error "toShelleyTxOut: TODO: TxOutValue MultiAssetInMaryEra" +toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) = + Shelley.TxOut (toShelleyAddr addr) (toMaryValue value) From 844dde7bfa289c7c15cd164d2be7bc941efa91ca Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 15:23:15 +0000 Subject: [PATCH 28/31] Adjust the sort order of Value entries Order the ada case first. --- cardano-api/src/Cardano/Api/Value.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 91ce17dca72..2b6b83b7f65 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -108,8 +108,8 @@ newtype AssetName = AssetName ByteString deriving stock (Show) deriving newtype (Eq, Ord, IsString) -data AssetId = AssetId !PolicyId !AssetName - | AdaAssetId +data AssetId = AdaAssetId + | AssetId !PolicyId !AssetName deriving (Eq, Ord, Show) From eaa770e448f8f3de877dddd79c4bf11dc52bbb07 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 22:31:42 +0000 Subject: [PATCH 29/31] Move toByronLovelace and TxIn/TxOut declarations Move toByronLovelace to the Value module, and split the TxBody module section on TxIn and TxOut so they're in separate sections. We're about to add a bunch more sections for types used in the body. --- cardano-api/src/Cardano/Api/TxBody.hs | 44 +++++++++++++++------------ cardano-api/src/Cardano/Api/Value.hs | 10 ++++++ 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index adfcc95a2d9..3366de43b66 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -19,14 +19,16 @@ module Cardano.Api.TxBody ( TxId(..), getTxId, - -- * Transaction inputs and outputs + -- * Transaction inputs TxIn(..), TxIx(..), + genesisUTxOPseudoTxIn, + + -- * Transaction outputs TxOut(..), TxOutValue(..), AdaOnlyInEra(..), MultiAssetInEra(..), - genesisUTxOPseudoTxIn, -- * Transaction bodies TxBody(..), @@ -152,7 +154,7 @@ getTxId (ShelleyTxBody era tx _) = -- ---------------------------------------------------------------------------- --- Transaction inputs and outputs +-- Transaction inputs -- data TxIn = TxIn TxId TxIx @@ -164,14 +166,27 @@ newtype TxIx = TxIx Word deriving stock (Eq, Ord, Show) deriving newtype (Enum) + +toByronTxIn :: TxIn -> Byron.TxIn +toByronTxIn (TxIn txid (TxIx txix)) = + Byron.TxInUtxo (toByronTxId txid) (fromIntegral txix) + +toShelleyTxIn :: (Ledger.Era ledgerera, + Ledger.Crypto ledgerera ~ StandardCrypto) + => TxIn -> Shelley.TxIn ledgerera +toShelleyTxIn (TxIn txid (TxIx txix)) = + Shelley.TxIn (toShelleyTxId txid) (fromIntegral txix) + + +-- ---------------------------------------------------------------------------- +-- Transaction outputs +-- + data TxOut era = TxOut (AddressInEra era) (TxOutValue era) deriving instance Eq (TxOut era) deriving instance Show (TxOut era) -toByronTxIn :: TxIn -> Byron.TxIn -toByronTxIn (TxIn txid (TxIx txix)) = - Byron.TxInUtxo (toByronTxId txid) (fromIntegral txix) toByronTxOut :: TxOut ByronEra -> Maybe Byron.TxOut toByronTxOut (TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress addr)) @@ -184,17 +199,6 @@ toByronTxOut (TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress _)) toByronTxOut (TxOut (AddressInEra (ShelleyAddressInEra era) ShelleyAddress{}) _) = case era of {} -toByronLovelace :: Lovelace -> Maybe Byron.Lovelace -toByronLovelace (Lovelace x) = - case Byron.integerToLovelace x of - Left _ -> Nothing - Right x' -> Just x' - -toShelleyTxIn :: (Ledger.Era ledgerera, - Ledger.Crypto ledgerera ~ StandardCrypto) - => TxIn -> Shelley.TxIn ledgerera -toShelleyTxIn (TxIn txid (TxIx txix)) = - Shelley.TxIn (toShelleyTxId txid) (fromIntegral txix) toShelleyTxOut :: forall era ledgerera. (ShelleyLedgerEra era ~ ledgerera, @@ -213,8 +217,6 @@ toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) = Shelley.TxOut (toShelleyAddr addr) (toMaryValue value) - - -- ---------------------------------------------------------------------------- -- Transaction bodies -- @@ -484,6 +486,10 @@ toShelleyWithdrawal withdrawals = | (stakeAddr, value) <- withdrawals ] +-- ---------------------------------------------------------------------------- +-- Other utilities helpful with making transaction bodies +-- + -- | Compute the 'TxIn' of the initial UTxO pseudo-transaction corresponding -- to the given address in the genesis initial funds. -- diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 2b6b83b7f65..90ab0fae865 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -34,6 +34,7 @@ module Cardano.Api.Value , MultiAssetInEra(..) -- * Internal conversion functions + , toByronLovelace , toShelleyLovelace , fromShelleyLovelace , toMaryValue @@ -48,6 +49,8 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.String (IsString) +import qualified Cardano.Chain.Common as Byron + import qualified Cardano.Ledger.Era as Ledger import qualified Shelley.Spec.Ledger.Coin as Shelley import qualified Cardano.Ledger.Mary.Value as Mary @@ -72,6 +75,13 @@ instance Semigroup Lovelace where instance Monoid Lovelace where mempty = Lovelace 0 + +toByronLovelace :: Lovelace -> Maybe Byron.Lovelace +toByronLovelace (Lovelace x) = + case Byron.integerToLovelace x of + Left _ -> Nothing + Right x' -> Just x' + toShelleyLovelace :: Lovelace -> Shelley.Coin toShelleyLovelace (Lovelace l) = Shelley.Coin l --TODO: validate bounds From dde36642807f58ae9b77cb843b4cf4267af578f7 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 23 Nov 2020 22:43:11 +0000 Subject: [PATCH 30/31] Move TxOutValue and MintValue types to TxBody module Move the TxOutValue, MintValue and related functions from the Value module to the TxBody module. We're going to end up with a whole bunch of these era-dependent field types for the tx body and it makes most sense to keep them all together in one module. --- cardano-api/src/Cardano/Api/TxBody.hs | 72 ++++++++++++++++++++++++--- cardano-api/src/Cardano/Api/Value.hs | 55 -------------------- 2 files changed, 66 insertions(+), 61 deletions(-) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 3366de43b66..4ad3d976f31 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -15,6 +15,11 @@ -- module Cardano.Api.TxBody ( + -- * Transaction bodies + TxBody(..), + makeByronTransaction, + makeShelleyTransaction, + -- * Transaction Ids TxId(..), getTxId, @@ -27,19 +32,18 @@ module Cardano.Api.TxBody ( -- * Transaction outputs TxOut(..), TxOutValue(..), - AdaOnlyInEra(..), - MultiAssetInEra(..), - -- * Transaction bodies - TxBody(..), + -- * Other transaction body types TTL, TxFee, MintValue(..), - makeByronTransaction, - makeShelleyTransaction, TxExtraContent(..), txExtraContentEmpty, + -- * Era-dependent transaction body features + AdaOnlyInEra(..), + MultiAssetInEra(..), + -- * Data family instances AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody), ) where @@ -217,6 +221,62 @@ toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) = Shelley.TxOut (toShelleyAddr addr) (toMaryValue value) +-- ---------------------------------------------------------------------------- +-- Era-dependent transaction body features +-- + +-- | Representation of whether only ada transactions are supported in a +-- particular era. +-- +data AdaOnlyInEra era where + + AdaOnlyInByronEra :: AdaOnlyInEra ByronEra + AdaOnlyInShelleyEra :: AdaOnlyInEra ShelleyEra + AdaOnlyInAllegraEra :: AdaOnlyInEra AllegraEra + +deriving instance Eq (AdaOnlyInEra era) +deriving instance Show (AdaOnlyInEra era) + +-- | Representation of whether multi-asset transactions are supported in a +-- particular era. +-- +data MultiAssetInEra era where + + -- | Multi-asset transactions are supported in the 'Mary' era. + MultiAssetInMaryEra :: MultiAssetInEra MaryEra + +deriving instance Eq (MultiAssetInEra era) +deriving instance Show (MultiAssetInEra era) + + +-- ---------------------------------------------------------------------------- +-- Transaction output values (era-dependent) +-- + +data TxOutValue era where + + TxOutAdaOnly :: AdaOnlyInEra era -> Lovelace -> TxOutValue era + + TxOutValue :: MultiAssetInEra era -> Value -> TxOutValue era + +deriving instance Eq (TxOutValue era) +deriving instance Show (TxOutValue era) + + +-- ---------------------------------------------------------------------------- +-- Transaction value minting (era-dependent) +-- + +data MintValue era where + + MintNothing :: MintValue era + + MintValue :: MultiAssetInEra era -> Value -> MintValue era + +deriving instance Eq (MintValue era) +deriving instance Show (MintValue era) + + -- ---------------------------------------------------------------------------- -- Transaction bodies -- diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 90ab0fae865..02a367e9e9a 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -27,12 +27,6 @@ module Cardano.Api.Value , selectLovelace , lovelaceToValue - -- * Era-dependent use of multi-assert values - , MintValue(..) - , TxOutValue(..) - , AdaOnlyInEra(..) - , MultiAssetInEra(..) - -- * Internal conversion functions , toByronLovelace , toShelleyLovelace @@ -57,7 +51,6 @@ import qualified Cardano.Ledger.Mary.Value as Mary import Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto) -import Cardano.Api.Eras import Cardano.Api.Script @@ -216,51 +209,3 @@ fromMaryValue (Mary.Value lovelace other) = fromMaryAssetName :: Mary.AssetName -> AssetName fromMaryAssetName (Mary.AssetName n) = AssetName n - --- ---------------------------------------------------------------------------- --- Era-dependent use of multi-assert values --- - -data MintValue era where - - MintNothing :: MintValue era - - MintValue :: MultiAssetInEra era -> Value -> MintValue era - -deriving instance Eq (MintValue era) -deriving instance Show (MintValue era) - - -data TxOutValue era where - - TxOutAdaOnly :: AdaOnlyInEra era -> Lovelace -> TxOutValue era - - TxOutValue :: MultiAssetInEra era -> Value -> TxOutValue era - -deriving instance Eq (TxOutValue era) -deriving instance Show (TxOutValue era) - - --- | Representation of whether only ada transactions are supported in a --- particular era. --- -data AdaOnlyInEra era where - - AdaOnlyInByronEra :: AdaOnlyInEra ByronEra - AdaOnlyInShelleyEra :: AdaOnlyInEra ShelleyEra - AdaOnlyInAllegraEra :: AdaOnlyInEra AllegraEra - -deriving instance Eq (AdaOnlyInEra era) -deriving instance Show (AdaOnlyInEra era) - --- | Representation of whether multi-asset transactions are supported in a --- particular era. --- -data MultiAssetInEra era where - - -- | Multi-asset transactions are supported in the 'Mary' era. - MultiAssetInMaryEra :: MultiAssetInEra MaryEra - -deriving instance Eq (MultiAssetInEra era) -deriving instance Show (MultiAssetInEra era) - From ee54b49ab6b64fbf3d12605c2cae3d9ef680772a Mon Sep 17 00:00:00 2001 From: Luke Nadur <19835357+intricate@users.noreply.github.com> Date: Tue, 24 Nov 2020 17:30:21 -0500 Subject: [PATCH 31/31] Make hlint suggestions --- cardano-api/src/Cardano/Api/Certificate.hs | 2 -- cardano-api/src/Cardano/Api/ProtocolParameters.hs | 8 ++------ cardano-api/src/Cardano/Api/TxBody.hs | 3 +-- cardano-api/src/Cardano/Api/Value.hs | 2 -- 4 files changed, 3 insertions(+), 12 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Certificate.hs b/cardano-api/src/Cardano/Api/Certificate.hs index 718d0fddc51..c79abfc65fc 100644 --- a/cardano-api/src/Cardano/Api/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Certificate.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -414,4 +413,3 @@ fromShelleyPoolParams fromShelleyDnsName :: Shelley.DnsName -> ByteString fromShelleyDnsName = Text.encodeUtf8 . Shelley.dnsToText - diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 5ec291e6ad6..b2d55175a9a 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} @@ -254,11 +253,9 @@ makeShelleyUpdateProposal :: ProtocolParametersUpdate -> [Hash GenesisKey] -> EpochNo -> UpdateProposal -makeShelleyUpdateProposal params genesisKeyHashes epochno = +makeShelleyUpdateProposal params genesisKeyHashes = --TODO decide how to handle parameter validation - UpdateProposal - (Map.fromList [ (kh, params) | kh <- genesisKeyHashes ]) - epochno + UpdateProposal (Map.fromList [ (kh, params) | kh <- genesisKeyHashes ]) toShelleyUpdate :: Ledger.Crypto ledgerera ~ StandardCrypto @@ -411,4 +408,3 @@ toShelleyNonce (Just (PraosNonce h)) = Shelley.Nonce (Crypto.castHash h) fromPraosNonce :: Shelley.Nonce -> Maybe PraosNonce fromPraosNonce Shelley.NeutralNonce = Nothing fromPraosNonce (Shelley.Nonce h) = Just (PraosNonce (Crypto.castHash h)) - diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 4ad3d976f31..f3e58e6a4da 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -311,7 +311,7 @@ instance Eq (TxBody era) where ShelleyBasedEraAllegra -> txbodyA == txbodyB ShelleyBasedEraMary -> txbodyA == txbodyB - (==) (ByronTxBody{}) (ShelleyTxBody era _ _) = case era of {} + (==) ByronTxBody{} (ShelleyTxBody era _ _) = case era of {} -- The GADT in the ShelleyTxBody case requires a custom instance @@ -577,4 +577,3 @@ genesisUTxOPseudoTxIn nw (GenesisUTxOKeyHash kh) = fromShelleyTxId :: Shelley.TxId StandardShelley -> TxId fromShelleyTxId (Shelley.TxId h) = TxId (Crypto.castHash h) - diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 02a367e9e9a..a979a217841 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -2,7 +2,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -- | Currency values -- @@ -208,4 +207,3 @@ fromMaryValue (Mary.Value lovelace other) = fromMaryAssetName :: Mary.AssetName -> AssetName fromMaryAssetName (Mary.AssetName n) = AssetName n -