From 2208573b402bd06079a46fc0ca3f2430d7c10b79 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Mon, 16 Nov 2020 23:01:26 +0000 Subject: [PATCH] Complete the era renaming in the cardano-api --- cardano-api/src/Cardano/Api/Address.hs | 26 ++--- cardano-api/src/Cardano/Api/Fees.hs | 4 +- cardano-api/src/Cardano/Api/Script.hs | 54 +++++----- cardano-api/src/Cardano/Api/Tx.hs | 98 +++++++++---------- cardano-api/src/Cardano/Api/TxBody.hs | 52 +++++----- cardano-api/src/Cardano/Api/TxSubmit.hs | 6 +- cardano-api/src/Cardano/Api/Value.hs | 8 +- cardano-api/test/Test/Cardano/Api/Examples.hs | 18 ++-- .../test/Test/Cardano/Api/Typed/CBOR.hs | 2 +- .../test/Test/Cardano/Api/Typed/Gen.hs | 48 ++++----- 10 files changed, 157 insertions(+), 159 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 5b22d3b6b8c..5d59c7bf661 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -105,23 +105,23 @@ data Address era where :: Shelley.Network -> Shelley.PaymentCredential StandardShelley -> Shelley.StakeReference StandardShelley - -> Address Shelley + -> Address ShelleyEra deriving instance Eq (Address era) deriving instance Ord (Address era) deriving instance Show (Address era) -instance HasTypeProxy (Address Byron) where - data AsType (Address Byron) = AsByronAddress +instance HasTypeProxy (Address ByronEra) where + data AsType (Address ByronEra) = AsByronAddress proxyToAsType _ = AsByronAddress -instance HasTypeProxy (Address Shelley) where - data AsType (Address Shelley) = AsShelleyAddress +instance HasTypeProxy (Address ShelleyEra) where + data AsType (Address ShelleyEra) = AsShelleyAddress proxyToAsType _ = AsShelleyAddress -instance SerialiseAsRawBytes (Address Byron) where +instance SerialiseAsRawBytes (Address ByronEra) where serialiseToRawBytes (ByronAddress addr) = CBOR.serialize' addr deserialiseFromRawBytes AsByronAddress bs = @@ -130,7 +130,7 @@ instance SerialiseAsRawBytes (Address Byron) where Right addr -> Just (ByronAddress addr) -instance SerialiseAsRawBytes (Address Shelley) where +instance SerialiseAsRawBytes (Address ShelleyEra) where serialiseToRawBytes (ByronAddress addr) = Shelley.serialiseAddr . Shelley.AddrBootstrap @@ -149,7 +149,7 @@ instance SerialiseAsRawBytes (Address Shelley) where Just (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) -> Just (ByronAddress addr) -instance SerialiseAsBech32 (Address Shelley) where +instance SerialiseAsBech32 (Address ShelleyEra) where bech32PrefixFor (ShelleyAddress Shelley.Mainnet _ _) = "addr" bech32PrefixFor (ShelleyAddress Shelley.Testnet _ _) = "addr_test" bech32PrefixFor (ByronAddress _) = "addr" @@ -157,7 +157,7 @@ instance SerialiseAsBech32 (Address Shelley) where bech32PrefixesPermitted AsShelleyAddress = ["addr", "addr_test"] -instance SerialiseAddress (Address Byron) where +instance SerialiseAddress (Address ByronEra) where serialiseAddress addr@ByronAddress{} = Text.decodeLatin1 . Base58.encodeBase58 Base58.bitcoinAlphabet @@ -168,9 +168,9 @@ instance SerialiseAddress (Address Byron) where bs <- Base58.decodeBase58 Base58.bitcoinAlphabet (Text.encodeUtf8 txt) deserialiseFromRawBytes AsByronAddress bs -instance SerialiseAddress (Address Shelley) where +instance SerialiseAddress (Address ShelleyEra) where serialiseAddress (ByronAddress addr) = - serialiseAddress (ByronAddress addr :: Address Byron) + serialiseAddress (ByronAddress addr :: Address ByronEra) serialiseAddress addr@ShelleyAddress{} = serialiseToBech32 addr @@ -187,7 +187,7 @@ instance SerialiseAddress (Address Shelley) where castByronToShelleyAddress <$> deserialiseAddress AsByronAddress t - castByronToShelleyAddress :: Address Byron -> Address Shelley + castByronToShelleyAddress :: Address ByronEra -> Address ShelleyEra castByronToShelleyAddress (ByronAddress addr) = ByronAddress addr @@ -204,7 +204,7 @@ makeByronAddress nw (ByronVerificationKey vk) = makeShelleyAddress :: NetworkId -> PaymentCredential -> StakeAddressReference - -> Address Shelley + -> Address ShelleyEra makeShelleyAddress nw pc scr = ShelleyAddress (toShelleyNetwork nw) diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs index fab93329bd4..ff7db9faf78 100644 --- a/cardano-api/src/Cardano/Api/Fees.hs +++ b/cardano-api/src/Cardano/Api/Fees.hs @@ -36,7 +36,7 @@ import Cardano.Api.Value -- transactionFee :: Natural -- ^ The fixed tx fee -> Natural -- ^ The tx fee per byte - -> Tx Shelley + -> Tx ShelleyEra -> Lovelace transactionFee txFeeFixed txFeePerByte (ShelleyTx tx) = Lovelace (a * x + b) @@ -59,7 +59,7 @@ transactionFee txFeeFixed txFeePerByte (ShelleyTx tx) = estimateTransactionFee :: NetworkId -> Natural -- ^ The fixed tx fee -> Natural -- ^ The tx fee per byte - -> Tx Shelley + -> Tx ShelleyEra -> Int -- ^ The number of extra UTxO transaction inputs -> Int -- ^ The number of extra transaction outputs -> Int -- ^ The number of extra Shelley key witnesses diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 6b4619a7a7f..1647ebbc2c7 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -76,8 +76,6 @@ import qualified Shelley.Spec.Ledger.Scripts as Shelley import qualified Shelley.Spec.Ledger.Tx as Shelley import Cardano.Api.Eras - (Shelley, Allegra, Mary, - AsType (AsByron, AsShelley, AsAllegra, AsMary)) import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.KeysShelley @@ -97,9 +95,9 @@ import qualified Cardano.Api.Shelley.Serialisation.Legacy as Legacy data Script era where - ShelleyScript :: Shelley.Script StandardShelley -> Script Shelley - AllegraScript :: Timelock.Timelock StandardAllegra -> Script Allegra - MaryScript :: Timelock.Timelock StandardMary -> Script Mary + ShelleyScript :: Shelley.Script StandardShelley -> Script ShelleyEra + AllegraScript :: Timelock.Timelock StandardAllegra -> Script AllegraEra + MaryScript :: Timelock.Timelock StandardMary -> Script MaryEra deriving stock instance (Eq (Script era)) deriving stock instance (Show (Script era)) @@ -115,7 +113,7 @@ instance HasTypeProxy era => HasTypeProxy (Script era) where data AsType (Script era) = AsScript (AsType era) proxyToAsType _ = AsScript (proxyToAsType (Proxy :: Proxy era)) -instance SerialiseAsCBOR (Script Shelley) where +instance SerialiseAsCBOR (Script ShelleyEra) where serialiseToCBOR (ShelleyScript s) = -- We use 'WrappedMultiSig' here to support the legacy binary -- serialisation format for the @Script@ type from @@ -124,7 +122,7 @@ instance SerialiseAsCBOR (Script Shelley) where -- See the documentation of 'WrappedMultiSig' for more information. CBOR.serialize' (Legacy.WrappedMultiSig s) - deserialiseFromCBOR (AsScript AsShelley) bs = + deserialiseFromCBOR (AsScript AsShelleyEra) bs = -- We use 'WrappedMultiSig' here to support the legacy binary -- serialisation format for the @Script@ type from -- @cardano-ledger-specs@. @@ -133,25 +131,25 @@ instance SerialiseAsCBOR (Script Shelley) where ShelleyScript . Legacy.unWrappedMultiSig <$> CBOR.decodeAnnotator "Script" fromCBOR (LBS.fromStrict bs) -instance HasTextEnvelope (Script Shelley) where +instance HasTextEnvelope (Script ShelleyEra) where textEnvelopeType _ = "Script" textEnvelopeDefaultDescr ShelleyScript{} = "Multi-signature script" -instance SerialiseAsCBOR (Script Allegra) where +instance SerialiseAsCBOR (Script AllegraEra) where serialiseToCBOR (AllegraScript s) = CBOR.serialize' s - deserialiseFromCBOR (AsScript AsAllegra) bs = + deserialiseFromCBOR (AsScript AsAllegraEra) bs = AllegraScript <$> CBOR.decodeAnnotator "Script" fromCBOR (LBS.fromStrict bs) -instance HasTextEnvelope (Script Allegra) where +instance HasTextEnvelope (Script AllegraEra) where textEnvelopeType _ = "Script" textEnvelopeDefaultDescr AllegraScript{} = "Simple script" -instance SerialiseAsCBOR (Script Mary) where +instance SerialiseAsCBOR (Script MaryEra) where serialiseToCBOR (MaryScript s) = CBOR.serialize' s - deserialiseFromCBOR (AsScript AsMary) bs = + deserialiseFromCBOR (AsScript AsMaryEra) bs = MaryScript <$> CBOR.decodeAnnotator "Script" fromCBOR (LBS.fromStrict bs) -instance HasTextEnvelope (Script Mary) where +instance HasTextEnvelope (Script MaryEra) where textEnvelopeType _ = "Script" textEnvelopeDefaultDescr MaryScript{} = "Simple script" @@ -229,12 +227,12 @@ deriving instance Show (SimpleScript era) -- specify which script features are enabled in a given era. -- data ScriptFeatureInEra feature era where - SignaturesInShelleyEra :: ScriptFeatureInEra SignatureFeature Shelley - SignaturesInAllegraEra :: ScriptFeatureInEra SignatureFeature Allegra - SignaturesInMaryEra :: ScriptFeatureInEra SignatureFeature Mary + SignaturesInShelleyEra :: ScriptFeatureInEra SignatureFeature ShelleyEra + SignaturesInAllegraEra :: ScriptFeatureInEra SignatureFeature AllegraEra + SignaturesInMaryEra :: ScriptFeatureInEra SignatureFeature MaryEra - TimeLocksInAllegraEra :: ScriptFeatureInEra TimeLocksFeature Allegra - TimeLocksInMaryEra :: ScriptFeatureInEra TimeLocksFeature Mary + TimeLocksInAllegraEra :: ScriptFeatureInEra TimeLocksFeature AllegraEra + TimeLocksInMaryEra :: ScriptFeatureInEra TimeLocksFeature MaryEra deriving instance Eq (ScriptFeatureInEra feature era) deriving instance Show (ScriptFeatureInEra feature era) @@ -253,33 +251,33 @@ data TimeLocksFeature -- | Is the 'SimpleScript' language supported at all in this era? -- data SimpleScriptSupportedInEra era where - SimpleScriptInShelleyEra :: SimpleScriptSupportedInEra Shelley - SimpleScriptInAllegraEra :: SimpleScriptSupportedInEra Allegra - SimpleScriptInMaryEra :: SimpleScriptSupportedInEra Mary + SimpleScriptInShelleyEra :: SimpleScriptSupportedInEra ShelleyEra + SimpleScriptInAllegraEra :: SimpleScriptSupportedInEra AllegraEra + SimpleScriptInMaryEra :: SimpleScriptSupportedInEra MaryEra class HasScriptFeatures era where simpleScriptSupported :: SimpleScriptSupportedInEra era hasSignatureFeature :: Maybe (ScriptFeatureInEra SignatureFeature era) hasTimeLocksFeature :: Maybe (ScriptFeatureInEra TimeLocksFeature era) -instance HasScriptFeatures Shelley where +instance HasScriptFeatures ShelleyEra where simpleScriptSupported = SimpleScriptInShelleyEra hasSignatureFeature = Just SignaturesInShelleyEra hasTimeLocksFeature = Nothing -instance HasScriptFeatures Allegra where +instance HasScriptFeatures AllegraEra where simpleScriptSupported = SimpleScriptInAllegraEra hasSignatureFeature = Just SignaturesInAllegraEra hasTimeLocksFeature = Just TimeLocksInAllegraEra -instance HasScriptFeatures Mary where +instance HasScriptFeatures MaryEra where simpleScriptSupported = SimpleScriptInMaryEra hasSignatureFeature = Just SignaturesInMaryEra hasTimeLocksFeature = Just TimeLocksInMaryEra --TODO: add a deprecation pragma and switch to the SimpleScript constructor -makeMultiSigScript :: MultiSigScript Shelley -> Script Shelley +makeMultiSigScript :: MultiSigScript ShelleyEra -> Script ShelleyEra makeMultiSigScript = simpleScriptToScript simpleScriptToScript :: forall era. HasScriptFeatures era @@ -288,7 +286,7 @@ simpleScriptToScript = case simpleScriptSupported :: SimpleScriptSupportedInEra era of SimpleScriptInShelleyEra -> ShelleyScript . go where - go :: SimpleScript Shelley -> Shelley.MultiSig StandardShelley + go :: SimpleScript ShelleyEra -> Shelley.MultiSig StandardShelley go (RequireSignature _ (PaymentKeyHash kh)) = Shelley.RequireSignature (Shelley.coerceKeyRole kh) go (RequireAllOf s) = Shelley.RequireAllOf (map go s) @@ -318,7 +316,7 @@ simpleScriptToTimelock = go scriptToSimpleScript :: Script era -> SimpleScript era scriptToSimpleScript (ShelleyScript s0) = go s0 where - go :: Shelley.MultiSig StandardShelley -> SimpleScript Shelley + go :: Shelley.MultiSig StandardShelley -> SimpleScript ShelleyEra go (Shelley.RequireSignature kh) = RequireSignature SignaturesInShelleyEra (PaymentKeyHash (Shelley.coerceKeyRole kh)) diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index 6147fb87738..b7c9a48bc3c 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -118,35 +118,35 @@ data Tx era where ByronTx :: Byron.ATxAux ByteString - -> Tx Byron + -> Tx ByronEra ShelleyTx :: Shelley.Tx StandardShelley - -> Tx Shelley + -> Tx ShelleyEra -deriving instance Eq (Tx Byron) -deriving instance Show (Tx Byron) +deriving instance Eq (Tx ByronEra) +deriving instance Show (Tx ByronEra) -deriving instance Eq (Tx Shelley) -deriving instance Show (Tx Shelley) +deriving instance Eq (Tx ShelleyEra) +deriving instance Show (Tx ShelleyEra) -instance HasTypeProxy (Tx Byron) where - data AsType (Tx Byron) = AsByronTx +instance HasTypeProxy (Tx ByronEra) where + data AsType (Tx ByronEra) = AsByronTx proxyToAsType _ = AsByronTx -instance HasTypeProxy (Tx Shelley) where - data AsType (Tx Shelley) = AsShelleyTx +instance HasTypeProxy (Tx ShelleyEra) where + data AsType (Tx ShelleyEra) = AsShelleyTx proxyToAsType _ = AsShelleyTx -instance SerialiseAsCBOR (Tx Byron) where +instance SerialiseAsCBOR (Tx ByronEra) where serialiseToCBOR (ByronTx tx) = CBOR.recoverBytes tx deserialiseFromCBOR AsByronTx bs = ByronTx <$> CBOR.decodeFullAnnotatedBytes "Byron Tx" fromCBOR (LBS.fromStrict bs) -instance SerialiseAsCBOR (Tx Shelley) where +instance SerialiseAsCBOR (Tx ShelleyEra) where serialiseToCBOR (ShelleyTx tx) = CBOR.serialize' tx @@ -154,10 +154,10 @@ instance SerialiseAsCBOR (Tx Shelley) where ShelleyTx <$> CBOR.decodeAnnotator "Shelley Tx" fromCBOR (LBS.fromStrict bs) -instance HasTextEnvelope (Tx Byron) where +instance HasTextEnvelope (Tx ByronEra) where textEnvelopeType _ = "TxSignedByron" -instance HasTextEnvelope (Tx Shelley) where +instance HasTextEnvelope (Tx ShelleyEra) where textEnvelopeType _ = "TxSignedShelley" @@ -165,52 +165,52 @@ data Witness era where ByronKeyWitness :: Byron.TxInWitness - -> Witness Byron + -> Witness ByronEra ShelleyBootstrapWitness :: Shelley.BootstrapWitness StandardShelley - -> Witness Shelley + -> Witness ShelleyEra ShelleyKeyWitness :: Shelley.WitVKey Shelley.Witness StandardShelley - -> Witness Shelley + -> Witness ShelleyEra ShelleyScriptWitness :: Shelley.Script StandardShelley - -> Witness Shelley + -> Witness ShelleyEra AllegraScriptwitness :: Allegra.Timelock StandardAllegra - -> Witness Allegra + -> Witness AllegraEra MaryScriptWitness :: Allegra.Timelock StandardMary - -> Witness Mary + -> Witness MaryEra -deriving instance Eq (Witness Byron) -deriving instance Show (Witness Byron) +deriving instance Eq (Witness ByronEra) +deriving instance Show (Witness ByronEra) -deriving instance Eq (Witness Shelley) -deriving instance Show (Witness Shelley) +deriving instance Eq (Witness ShelleyEra) +deriving instance Show (Witness ShelleyEra) -instance HasTypeProxy (Witness Byron) where - data AsType (Witness Byron) = AsByronWitness +instance HasTypeProxy (Witness ByronEra) where + data AsType (Witness ByronEra) = AsByronWitness proxyToAsType _ = AsByronWitness -instance HasTypeProxy (Witness Shelley) where - data AsType (Witness Shelley) = AsShelleyWitness +instance HasTypeProxy (Witness ShelleyEra) where + data AsType (Witness ShelleyEra) = AsShelleyWitness proxyToAsType _ = AsShelleyWitness -instance SerialiseAsCBOR (Witness Byron) where +instance SerialiseAsCBOR (Witness ByronEra) where serialiseToCBOR (ByronKeyWitness wit) = CBOR.serialize' wit deserialiseFromCBOR AsByronWitness bs = ByronKeyWitness <$> CBOR.decodeFull' bs -instance SerialiseAsCBOR (Witness Shelley) where +instance SerialiseAsCBOR (Witness ShelleyEra) where serialiseToCBOR = CBOR.serializeEncoding' . encodeShelleyWitness where - encodeShelleyWitness :: Witness Shelley -> CBOR.Encoding + encodeShelleyWitness :: Witness ShelleyEra -> CBOR.Encoding encodeShelleyWitness (ShelleyKeyWitness wit) = CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> toCBOR wit encodeShelleyWitness (ShelleyBootstrapWitness wit) = @@ -230,7 +230,7 @@ instance SerialiseAsCBOR (Witness Shelley) where CBOR.decodeAnnotator "Shelley Witness" decodeShelleyWitness (LBS.fromStrict bs) where - decodeShelleyWitness :: CBOR.Decoder s (CBOR.Annotator (Witness Shelley)) + decodeShelleyWitness :: CBOR.Decoder s (CBOR.Annotator (Witness ShelleyEra)) decodeShelleyWitness = do CBOR.decodeListLenOf 2 t <- CBOR.decodeWord @@ -247,10 +247,10 @@ instance SerialiseAsCBOR (Witness Shelley) where _ -> CBOR.cborError $ CBOR.DecoderErrorUnknownTag "Shelley Witness" (fromIntegral t) -instance HasTextEnvelope (Witness Byron) where +instance HasTextEnvelope (Witness ByronEra) where textEnvelopeType _ = "TxWitnessByron" -instance HasTextEnvelope (Witness Shelley) where +instance HasTextEnvelope (Witness ShelleyEra) where textEnvelopeType _ = "TxWitnessShelley" @@ -294,7 +294,7 @@ makeSignedTransaction witnesses (ByronTxBody txbody) = (unAnnotated txbody) (Vector.fromList (map selectByronWitness witnesses)) where - selectByronWitness :: Witness Byron -> Byron.TxInWitness + selectByronWitness :: Witness ByronEra -> Byron.TxInWitness selectByronWitness (ByronKeyWitness w) = w makeSignedTransaction witnesses (ShelleyTxBody txbody txmetadata) = @@ -309,9 +309,9 @@ makeSignedTransaction witnesses (ShelleyTxBody txbody txmetadata) = (maybeToStrictMaybe txmetadata) makeByronKeyWitness :: NetworkId - -> TxBody Byron + -> TxBody ByronEra -> SigningKey ByronKey - -> Witness Byron + -> Witness ByronEra makeByronKeyWitness nw (ByronTxBody txbody) = let txhash :: Byron.Hash Byron.Tx txhash = Byron.hashDecoded txbody @@ -336,7 +336,7 @@ data WitnessNetworkIdOrByronAddress -- If this value is used in the construction of a Shelley bootstrap witness, -- the result will not consist of a derivation path. If that is required, -- specify a 'WitnessByronAddress' value instead. - | WitnessByronAddress !(Address Byron) + | WitnessByronAddress !(Address ByronEra) -- ^ Byron address. -- -- If this value is used in the construction of a Shelley bootstrap witness, @@ -344,9 +344,9 @@ data WitnessNetworkIdOrByronAddress -- address and used in the construction of the witness. makeShelleyBootstrapWitness :: WitnessNetworkIdOrByronAddress - -> TxBody Shelley + -> TxBody ShelleyEra -> SigningKey ByronKey - -> Witness Shelley + -> Witness ShelleyEra makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody txbody _) (ByronSigningKey sk) = ShelleyBootstrapWitness $ -- Byron era witnesses were weird. This reveals all that weirdness. @@ -391,16 +391,16 @@ makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody txbody _) (ByronSigningKey s } -- The 'WitnessNetworkIdOrByronAddress' value converted to an 'Either'. - eitherNwOrAddr :: Either NetworkId (Address Byron) + eitherNwOrAddr :: Either NetworkId (Address ByronEra) eitherNwOrAddr = case nwOrAddr of WitnessNetworkId nw -> Left nw WitnessByronAddress addr -> Right addr - unByronAddr :: Address Byron -> Byron.Address + unByronAddr :: Address ByronEra -> Byron.Address unByronAddr (ByronAddress addr) = addr - unAddrAttrs :: Address Byron -> Byron.AddrAttributes + unAddrAttrs :: Address ByronEra -> Byron.AddrAttributes unAddrAttrs = Byron.attrData . Byron.addrAttributes . unByronAddr derivationPath :: Maybe Byron.HDAddressPayload @@ -431,9 +431,9 @@ data ShelleyWitnessSigningKey = | WitnessGenesisUTxOKey (SigningKey GenesisUTxOKey) -makeShelleyKeyWitness :: TxBody Shelley +makeShelleyKeyWitness :: TxBody ShelleyEra -> ShelleyWitnessSigningKey - -> Witness Shelley + -> Witness ShelleyEra makeShelleyKeyWitness (ShelleyTxBody txbody _) = let txhash :: Shelley.Hash StandardCrypto Shelley.EraIndependentTxBody txhash = Shelley.hashAnnotated txbody @@ -538,18 +538,18 @@ makeScriptWitness (MaryScript s) = MaryScriptWitness s -- order of signing keys must match txins signByronTransaction :: NetworkId - -> TxBody Byron + -> TxBody ByronEra -> [SigningKey ByronKey] - -> Tx Byron + -> Tx ByronEra signByronTransaction nw txbody sks = makeSignedTransaction witnesses txbody where witnesses = map (makeByronKeyWitness nw txbody) sks -- signing keys is a set -signShelleyTransaction :: TxBody Shelley +signShelleyTransaction :: TxBody ShelleyEra -> [ShelleyWitnessSigningKey] - -> Tx Shelley + -> Tx ShelleyEra signShelleyTransaction txbody sks = makeSignedTransaction witnesses txbody where diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 4116846d484..ea37e763afa 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -150,16 +150,16 @@ newtype TxIx = TxIx Word data TxOut era = TxOut (Address era) (TxOutValue era) -deriving instance Eq (TxOut Byron) -deriving instance Eq (TxOut Shelley) -deriving instance Show (TxOut Byron) -deriving instance Show (TxOut Shelley) +deriving instance Eq (TxOut ByronEra) +deriving instance Eq (TxOut ShelleyEra) +deriving instance Show (TxOut ByronEra) +deriving instance Show (TxOut ShelleyEra) toByronTxIn :: TxIn -> Byron.TxIn toByronTxIn (TxIn txid (TxIx txix)) = Byron.TxInUtxo (toByronTxId txid) (fromIntegral txix) -toByronTxOut :: TxOut Byron -> Maybe Byron.TxOut +toByronTxOut :: TxOut ByronEra -> Maybe Byron.TxOut toByronTxOut (TxOut (ByronAddress addr) (TxOutAdaOnly AdaOnlyInByronEra value)) = Byron.TxOut addr <$> toByronLovelace value @@ -175,7 +175,7 @@ toShelleyTxIn :: TxIn -> Shelley.TxIn StandardShelley toShelleyTxIn (TxIn txid (TxIx txix)) = Shelley.TxIn (toShelleyTxId txid) (fromIntegral txix) -toShelleyTxOut :: TxOut Shelley -> Shelley.TxOut StandardShelley +toShelleyTxOut :: TxOut ShelleyEra -> Shelley.TxOut StandardShelley toShelleyTxOut (TxOut addr (TxOutAdaOnly _ value)) = Shelley.TxOut (toShelleyAddr addr) (toShelleyLovelace value) toShelleyTxOut (TxOut _addr (TxOutValue evidence _)) = case evidence of {} @@ -189,29 +189,29 @@ data TxBody era where ByronTxBody :: Annotated Byron.Tx ByteString - -> TxBody Byron + -> TxBody ByronEra ShelleyTxBody :: Shelley.TxBody StandardShelley -> Maybe Shelley.MetaData - -> TxBody Shelley + -> TxBody ShelleyEra -deriving instance Eq (TxBody Byron) -deriving instance Show (TxBody Byron) +deriving instance Eq (TxBody ByronEra) +deriving instance Show (TxBody ByronEra) -deriving instance Eq (TxBody Shelley) -deriving instance Show (TxBody Shelley) +deriving instance Eq (TxBody ShelleyEra) +deriving instance Show (TxBody ShelleyEra) -instance HasTypeProxy (TxBody Byron) where - data AsType (TxBody Byron) = AsByronTxBody +instance HasTypeProxy (TxBody ByronEra) where + data AsType (TxBody ByronEra) = AsByronTxBody proxyToAsType _ = AsByronTxBody -instance HasTypeProxy (TxBody Shelley) where - data AsType (TxBody Shelley) = AsShelleyTxBody +instance HasTypeProxy (TxBody ShelleyEra) where + data AsType (TxBody ShelleyEra) = AsShelleyTxBody proxyToAsType _ = AsShelleyTxBody -instance SerialiseAsCBOR (TxBody Byron) where +instance SerialiseAsCBOR (TxBody ByronEra) where serialiseToCBOR (ByronTxBody txbody) = recoverBytes txbody @@ -222,7 +222,7 @@ instance SerialiseAsCBOR (TxBody Byron) where CBOR.fromCBORAnnotated (LBS.fromStrict bs) -instance SerialiseAsCBOR (TxBody Shelley) where +instance SerialiseAsCBOR (TxBody ShelleyEra) where serialiseToCBOR (ShelleyTxBody txbody txmetadata) = CBOR.serializeEncoding' $ CBOR.encodeListLen 2 @@ -235,7 +235,7 @@ instance SerialiseAsCBOR (TxBody Shelley) where decodeAnnotatedPair (LBS.fromStrict bs) where - decodeAnnotatedPair :: CBOR.Decoder s (CBOR.Annotator (TxBody Shelley)) + decodeAnnotatedPair :: CBOR.Decoder s (CBOR.Annotator (TxBody ShelleyEra)) decodeAnnotatedPair = do CBOR.decodeListLenOf 2 txbody <- fromCBOR @@ -246,23 +246,23 @@ instance SerialiseAsCBOR (TxBody Shelley) where (CBOR.runAnnotator <$> txmetadata <*> pure fbs) -instance HasTextEnvelope (TxBody Byron) where +instance HasTextEnvelope (TxBody ByronEra) where textEnvelopeType _ = "TxUnsignedByron" -instance HasTextEnvelope (TxBody Shelley) where +instance HasTextEnvelope (TxBody ShelleyEra) where textEnvelopeType _ = "TxUnsignedShelley" data ByronTxBodyConversionError = ByronTxBodyEmptyTxIns | ByronTxBodyEmptyTxOuts - | ByronTxBodyLovelaceOverflow (TxOut Byron) + | ByronTxBodyLovelaceOverflow (TxOut ByronEra) deriving Show makeByronTransaction :: [TxIn] - -> [TxOut Byron] + -> [TxOut ByronEra] -> Either ByronTxBodyConversionError - (TxBody Byron) + (TxBody ByronEra) makeByronTransaction ins outs = do ins' <- NonEmpty.nonEmpty ins ?! ByronTxBodyEmptyTxIns let ins'' = NonEmpty.map toByronTxIn ins' @@ -303,8 +303,8 @@ makeShelleyTransaction :: TxExtraContent -> TTL -> TxFee -> [TxIn] - -> [TxOut Shelley] - -> TxBody Shelley + -> [TxOut ShelleyEra] + -> TxBody ShelleyEra makeShelleyTransaction TxExtraContent { txMetadata, txWithdrawals, diff --git a/cardano-api/src/Cardano/Api/TxSubmit.hs b/cardano-api/src/Cardano/Api/TxSubmit.hs index 573d6420ce0..e43e0f36fa9 100644 --- a/cardano-api/src/Cardano/Api/TxSubmit.hs +++ b/cardano-api/src/Cardano/Api/TxSubmit.hs @@ -35,15 +35,15 @@ import Cardano.Api.Typed data TxForMode mode where TxForByronMode - :: Tx Byron + :: Tx ByronEra -> TxForMode ByronMode TxForShelleyMode - :: Tx Shelley + :: Tx ShelleyEra -> TxForMode ShelleyMode TxForCardanoMode - :: Either (Tx Byron) (Tx Shelley) + :: Either (Tx ByronEra) (Tx ShelleyEra) -> TxForMode CardanoMode diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index f33e0ea8f6a..1f9d100e900 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -187,9 +187,9 @@ deriving instance Show (TxOutValue era) -- data AdaOnlyInEra era where - AdaOnlyInByronEra :: AdaOnlyInEra Byron - AdaOnlyInShelleyEra :: AdaOnlyInEra Shelley - AdaOnlyInAllegraEra :: AdaOnlyInEra Allegra + AdaOnlyInByronEra :: AdaOnlyInEra ByronEra + AdaOnlyInShelleyEra :: AdaOnlyInEra ShelleyEra + AdaOnlyInAllegraEra :: AdaOnlyInEra AllegraEra deriving instance Eq (AdaOnlyInEra era) deriving instance Show (AdaOnlyInEra era) @@ -200,7 +200,7 @@ deriving instance Show (AdaOnlyInEra era) data MultiAssetInEra era where -- | Multi-asset transactions are supported in the 'Mary' era. - MultiAssetInMaryEra :: MultiAssetInEra Mary + MultiAssetInMaryEra :: MultiAssetInEra MaryEra deriving instance Eq (MultiAssetInEra era) deriving instance Show (MultiAssetInEra era) diff --git a/cardano-api/test/Test/Cardano/Api/Examples.hs b/cardano-api/test/Test/Cardano/Api/Examples.hs index 597abb2ce54..b6da4e049be 100644 --- a/cardano-api/test/Test/Cardano/Api/Examples.hs +++ b/cardano-api/test/Test/Cardano/Api/Examples.hs @@ -43,7 +43,7 @@ import Shelley.Spec.Ledger.PParams (PParams' (..), emptyPParams) import Cardano.Api.Shelley.Genesis -exampleAllShelley :: SimpleScript Api.Shelley +exampleAllShelley :: SimpleScript Api.ShelleyEra exampleAllShelley = RequireAllOf [ RequireSignature SignaturesInShelleyEra $ convertToHash "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a" @@ -64,7 +64,7 @@ exampleAllShelley = ] -exampleAnyShelley :: SimpleScript Api.Shelley +exampleAnyShelley :: SimpleScript Api.ShelleyEra exampleAnyShelley = RequireAnyOf [ RequireSignature SignaturesInShelleyEra $ convertToHash "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09" @@ -80,7 +80,7 @@ exampleAnyShelley = $ convertToHash "622be5fab3b5c3f371a50a535e4d3349c942a98cecee93b24e2fd11d" ] -exampleMofNShelley :: SimpleScript Api.Shelley +exampleMofNShelley :: SimpleScript Api.ShelleyEra exampleMofNShelley = RequireMOf 2 [ RequireSignature SignaturesInShelleyEra $ convertToHash "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413" @@ -92,7 +92,7 @@ exampleMofNShelley = $ convertToHash "686024aecb5884d73a11b9ae4e63931112ba737e878d74638b78513a" ] -exampleAllAllegra :: SimpleScript Api.Allegra +exampleAllAllegra :: SimpleScript Api.AllegraEra exampleAllAllegra = RequireAllOf [ RequireSignature SignaturesInAllegraEra (convertToHash "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a") @@ -100,14 +100,14 @@ exampleAllAllegra = ] -exampleAnyAllegra :: SimpleScript Api.Allegra +exampleAnyAllegra :: SimpleScript Api.AllegraEra exampleAnyAllegra = RequireAnyOf [ RequireSignature SignaturesInAllegraEra (convertToHash "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09") , RequireTimeAfter TimeLocksInAllegraEra (SlotNo 42) ] -exampleMofNAllegra :: SimpleScript Api.Allegra +exampleMofNAllegra :: SimpleScript Api.AllegraEra exampleMofNAllegra = RequireMOf 1 [ RequireSignature SignaturesInAllegraEra (convertToHash "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413") @@ -117,7 +117,7 @@ exampleMofNAllegra = ] -exampleAllMary :: SimpleScript Api.Mary +exampleAllMary :: SimpleScript Api.MaryEra exampleAllMary = RequireAllOf [ RequireSignature SignaturesInMaryEra (convertToHash "e09d36c79dec9bd1b3d9e152247701cd0bb860b5ebfd1de8abb6735a") @@ -125,14 +125,14 @@ exampleAllMary = ] -exampleAnyMary :: SimpleScript Api.Mary +exampleAnyMary :: SimpleScript Api.MaryEra exampleAnyMary = RequireAnyOf [ RequireSignature SignaturesInMaryEra (convertToHash "d92b712d1882c3b0f75b6f677e0b2cbef4fbc8b8121bb9dde324ff09") , RequireTimeAfter TimeLocksInMaryEra (SlotNo 42) ] -exampleMofNMary :: SimpleScript Api.Mary +exampleMofNMary :: SimpleScript Api.MaryEra exampleMofNMary = RequireMOf 1 [ RequireSignature SignaturesInMaryEra (convertToHash "2f3d4cf10d0471a1db9f2d2907de867968c27bca6272f062cd1c2413") diff --git a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs index 95f51905ada..eb7fb45f95c 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs @@ -118,7 +118,7 @@ prop_roundtrip_signing_key_kes_CBOR = prop_roundtrip_script_CBOR :: Property prop_roundtrip_script_CBOR = - roundtrip_CBOR (AsScript AsShelley) genScript + roundtrip_CBOR (AsScript AsShelleyEra) genScript -- ----------------------------------------------------------------------------- diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs index 30d0543d0aa..7397ec4b121 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs @@ -41,11 +41,11 @@ import Test.Cardano.Crypto.Gen (genProtocolMagicId) {- HLINT ignore "Reduce duplication" -} -genAddressByron :: Gen (Address Byron) +genAddressByron :: Gen (Address ByronEra) genAddressByron = makeByronAddress <$> genNetworkId <*> genVerificationKey AsByronKey -genAddressShelley :: Gen (Address Shelley) +genAddressShelley :: Gen (Address ShelleyEra) genAddressShelley = Gen.choice [ makeShelleyAddress <$> genNetworkId @@ -89,10 +89,10 @@ genMofN s = do -- Shelley -genMultiSigScriptShelley :: Gen (MultiSigScript Shelley) +genMultiSigScriptShelley :: Gen (MultiSigScript ShelleyEra) genMultiSigScriptShelley = genMultiSigScriptsShelley >>= Gen.element -genMultiSigScriptsShelley :: Gen [MultiSigScript Shelley] +genMultiSigScriptsShelley :: Gen [MultiSigScript ShelleyEra] genMultiSigScriptsShelley = Gen.recursive Gen.choice -- Non-recursive generators @@ -107,10 +107,10 @@ genMultiSigScriptsShelley = -- Allegra -genMultiSigScriptAllegra :: Gen (MultiSigScript Allegra) +genMultiSigScriptAllegra :: Gen (MultiSigScript AllegraEra) genMultiSigScriptAllegra = genMultiSigScriptsAllegra >>= Gen.element -genMultiSigScriptsAllegra :: Gen [MultiSigScript Allegra] +genMultiSigScriptsAllegra :: Gen [MultiSigScript AllegraEra] genMultiSigScriptsAllegra = Gen.recursive Gen.choice -- Non-recursive generators @@ -132,10 +132,10 @@ genMultiSigScriptsAllegra = -- Mary -genMultiSigScriptMary :: Gen (MultiSigScript Mary) +genMultiSigScriptMary :: Gen (MultiSigScript MaryEra) genMultiSigScriptMary = genMultiSigScriptsMary >>= Gen.element -genMultiSigScriptsMary :: Gen [MultiSigScript Mary] +genMultiSigScriptsMary :: Gen [MultiSigScript MaryEra] genMultiSigScriptsMary = Gen.recursive Gen.choice -- Non-recursive generators @@ -155,25 +155,25 @@ genMultiSigScriptsMary = ] -genAllRequiredSig :: Gen (MultiSigScript Shelley) +genAllRequiredSig :: Gen (MultiSigScript ShelleyEra) genAllRequiredSig = RequireAllOf <$> Gen.list (Range.constant 1 10) (genRequiredSig SignaturesInShelleyEra) -genAnyRequiredSig :: Gen (MultiSigScript Shelley) +genAnyRequiredSig :: Gen (MultiSigScript ShelleyEra) genAnyRequiredSig = RequireAnyOf <$> Gen.list (Range.constant 1 10) (genRequiredSig SignaturesInShelleyEra) -genMofNRequiredSig :: Gen (MultiSigScript Shelley) +genMofNRequiredSig :: Gen (MultiSigScript ShelleyEra) genMofNRequiredSig = do required <- Gen.integral (Range.linear 2 15) total <- Gen.integral (Range.linear (required + 1) 15) RequireMOf required <$> Gen.list (Range.singleton total) (genRequiredSig SignaturesInShelleyEra) -genMultiSigScript :: Gen (MultiSigScript Shelley) +genMultiSigScript :: Gen (MultiSigScript ShelleyEra) genMultiSigScript = Gen.choice [genAllRequiredSig, genAnyRequiredSig, genMofNRequiredSig] -genScript :: Gen (Script Shelley) +genScript :: Gen (Script ShelleyEra) genScript = makeMultiSigScript <$> genMultiSigScript genScriptHash :: Gen ScriptHash @@ -250,7 +250,7 @@ genStakeCredential = do vKey <- genVerificationKey AsStakeKey return . StakeCredentialByKey $ verificationKeyHash vKey -genTxBodyShelley :: Gen (TxBody Shelley) +genTxBodyShelley :: Gen (TxBody ShelleyEra) genTxBodyShelley = makeShelleyTransaction <$> genTxExtraContent @@ -259,11 +259,11 @@ genTxBodyShelley = <*> Gen.list (Range.constant 1 10) genTxIn <*> Gen.list (Range.constant 1 10) genShelleyTxOut -genByronTxOut :: Gen (TxOut Byron) +genByronTxOut :: Gen (TxOut ByronEra) genByronTxOut = TxOut <$> genAddressByron <*> (TxOutAdaOnly AdaOnlyInByronEra <$> genLovelace) -genShelleyTxOut :: Gen (TxOut Shelley) +genShelleyTxOut :: Gen (TxOut ShelleyEra) genShelleyTxOut = TxOut <$> genAddressShelley <*> (TxOutAdaOnly AdaOnlyInShelleyEra <$> genLovelace) @@ -274,7 +274,7 @@ genSlotNo :: Gen SlotNo genSlotNo = SlotNo <$> Gen.word64 Range.constantBounded -- TODO: Should probably have a naive generator that generates no inputs, no outputs etc -genTxBodyByron :: Gen (TxBody Byron) +genTxBodyByron :: Gen (TxBody ByronEra) genTxBodyByron = do txIns <- Gen.list (Range.constant 1 10) genTxIn txOuts <- Gen.list (Range.constant 1 10) genByronTxOut @@ -282,7 +282,7 @@ genTxBodyByron = do Left err -> panic $ show err Right txBody -> return txBody -genTxByron :: Gen (Tx Byron) +genTxByron :: Gen (Tx ByronEra) genTxByron = makeSignedTransaction <$> Gen.list (Range.constant 1 10) genByronKeyWitness @@ -297,13 +297,13 @@ genTxId = TxId <$> genShelleyHash genTxIndex :: Gen TxIx genTxIndex = TxIx <$> Gen.word Range.constantBounded -genTxShelley :: Gen (Tx Shelley) +genTxShelley :: Gen (Tx ShelleyEra) genTxShelley = makeSignedTransaction <$> genWitnessList <*> genTxBodyShelley where - genWitnessList :: Gen [Witness Shelley] + genWitnessList :: Gen [Witness ShelleyEra] genWitnessList = do bsWits <- Gen.list (Range.constant 0 10) genShelleyBootstrapWitness keyWits <- Gen.list (Range.constant 0 10) genShelleyKeyWitness @@ -321,7 +321,7 @@ genTxFee = genLovelace genVerificationKey :: Key keyrole => AsType keyrole -> Gen (VerificationKey keyrole) genVerificationKey roletoken = getVerificationKey <$> genSigningKey roletoken -genByronKeyWitness :: Gen (Witness Byron) +genByronKeyWitness :: Gen (Witness ByronEra) genByronKeyWitness = do pmId <- genProtocolMagicId txinWitness <- genVKWitness pmId @@ -334,20 +334,20 @@ genWitnessNetworkIdOrByronAddress = , WitnessByronAddress <$> genAddressByron ] -genShelleyBootstrapWitness :: Gen (Witness Shelley) +genShelleyBootstrapWitness :: Gen (Witness ShelleyEra) genShelleyBootstrapWitness = makeShelleyBootstrapWitness <$> genWitnessNetworkIdOrByronAddress <*> genTxBodyShelley <*> genSigningKey AsByronKey -genShelleyKeyWitness :: Gen (Witness Shelley) +genShelleyKeyWitness :: Gen (Witness ShelleyEra) genShelleyKeyWitness = makeShelleyKeyWitness <$> genTxBodyShelley <*> genShelleyWitnessSigningKey -genShelleyWitness :: Gen (Witness Shelley) +genShelleyWitness :: Gen (Witness ShelleyEra) genShelleyWitness = Gen.choice [genShelleyKeyWitness, genShelleyBootstrapWitness] genShelleyWitnessSigningKey :: Gen ShelleyWitnessSigningKey