Update cardano-cli to use withCardanoEra

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

@@ -29,6 +29,7 @@ module Cardano.Api.Script (
   , ScriptFeatureInEra(..)
   , SignatureFeature
   , TimeLocksFeature
+  , HasScriptFeatures
 
     -- * Deprecated aliases
   , MultiSigScript
@@ -65,12 +66,11 @@ import qualified Cardano.Crypto.Hash.Class as Crypto
 import           Cardano.Slotting.Slot (SlotNo)
 
 import qualified Cardano.Ledger.Core as Shelley
-import qualified Cardano.Ledger.Era  as Ledger
+import qualified Cardano.Ledger.Era as Ledger
 
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelock
-import           Ouroboros.Consensus.Shelley.Eras
-                   (StandardAllegra, StandardMary, StandardShelley,
-                    StandardCrypto)
+import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardCrypto, StandardMary,
+                     StandardShelley)
 import qualified Shelley.Spec.Ledger.Keys as Shelley
 import qualified Shelley.Spec.Ledger.Scripts as Shelley
 import qualified Shelley.Spec.Ledger.Tx as Shelley

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

@@ -1,10 +1,11 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE EmptyCase #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -38,34 +39,35 @@ module Cardano.Api.TxBody (
     txExtraContentEmpty,
 
     -- * Data family instances
-    AsType(..),
+    AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody),
   ) where
 
 import           Prelude
 
-import qualified Data.List.NonEmpty as NonEmpty
-import           Data.String (IsString)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Short as SBS
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as Seq
 import qualified Data.Set as Set
+import           Data.String (IsString)
 
 import           Cardano.Binary (Annotated (..), reAnnotate, recoverBytes)
 import qualified Cardano.Binary as CBOR
-import qualified Shelley.Spec.Ledger.Serialization as CBOR
-                   (decodeNullMaybe, encodeNullMaybe)
+import qualified Shelley.Spec.Ledger.Serialization as CBOR (decodeNullMaybe, encodeNullMaybe)
 
-import           Cardano.Slotting.Slot (SlotNo (..))
 import qualified Cardano.Crypto.Hash.Class as Crypto
+import           Cardano.Slotting.Slot (SlotNo (..))
 
-import qualified Cardano.Crypto.Hashing as Byron
 import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Chain.UTxO as Byron
+import qualified Cardano.Crypto.Hashing as Byron
 
+import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Era 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)
 
@@ -132,12 +134,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
 
 
 -- ----------------------------------------------------------------------------
@@ -201,8 +211,9 @@ toShelleyTxOut (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value)) =
 toShelleyTxOut (TxOut addr (TxOutValue MultiAssetInMaryEra value)) =
     Shelley.TxOut (toShelleyAddr addr) (toMaryValue value)
 
-
-
+-- TODO: Placeholder
+toMaryValue :: a
+toMaryValue = undefined
 
 -- ----------------------------------------------------------------------------
 -- Transaction bodies
@@ -215,48 +226,107 @@ data TxBody era where
        -> TxBody ByronEra
 
      ShelleyTxBody
-       :: Shelley.TxBody StandardShelley
+       :: ShelleyBasedEra era
+       -> Ledger.TxBody (ShelleyLedgerEra era)
        -> Maybe Shelley.MetaData
-       -> TxBody ShelleyEra
-
-deriving instance Eq (TxBody ByronEra)
-deriving instance Show (TxBody ByronEra)
-
-deriving instance Eq (TxBody ShelleyEra)
-deriving instance Show (TxBody ShelleyEra)
-
-instance HasTypeProxy (TxBody ByronEra) where
-    data AsType (TxBody ByronEra) = AsByronTxBody
-    proxyToAsType _ = AsByronTxBody
+       -> 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)
+    proxyToAsType _ = AsTxBody (proxyToAsType (Proxy :: Proxy era))
+
+pattern AsByronTxBody :: AsType (TxBody ByronEra)
+pattern AsByronTxBody   = AsTxBody AsByronEra
+{-# COMPLETE AsByronTxBody #-}
+
+pattern AsShelleyTxBody :: AsType (TxBody ShelleyEra)
+pattern AsShelleyTxBody = AsTxBody AsShelleyEra
+{-# COMPLETE AsShelleyTxBody #-}
+
+
+instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where
 
-instance HasTypeProxy (TxBody ShelleyEra) where
-    data AsType (TxBody ShelleyEra) = AsShelleyTxBody
-    proxyToAsType _ = AsShelleyTxBody
-
-
-instance SerialiseAsCBOR (TxBody ByronEra) where
     serialiseToCBOR (ByronTxBody txbody) =
       recoverBytes txbody
 
-    deserialiseFromCBOR AsByronTxBody bs = do
-      ByronTxBody <$>
-        CBOR.decodeFullAnnotatedBytes
-          "Byron TxBody"
-          CBOR.fromCBORAnnotated
-          (LBS.fromStrict bs)
-
-instance SerialiseAsCBOR (TxBody ShelleyEra) where
-    serialiseToCBOR (ShelleyTxBody txbody txmetadata) =
+    serialiseToCBOR (ShelleyTxBody ShelleyBasedEraShelley txbody txmetadata) =
       CBOR.serializeEncoding' $
           CBOR.encodeListLen 2
        <> CBOR.toCBOR txbody
        <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata
-
-    deserialiseFromCBOR AsShelleyTxBody bs =
-      CBOR.decodeAnnotator
-        "Shelley TxBody"
-        decodeAnnotatedPair
-        (LBS.fromStrict bs)
+    serialiseToCBOR (ShelleyTxBody ShelleyBasedEraAllegra _ _) =
+      error "TODO: SerialiseAsCBOR (TxBody AllegraEra)"
+    serialiseToCBOR (ShelleyTxBody ShelleyBasedEraMary _ _) =
+      error "TODO: SerialiseAsCBOR (TxBody MaryEra)"
+
+    deserialiseFromCBOR _ 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
@@ -265,15 +335,18 @@ instance SerialiseAsCBOR (TxBody ShelleyEra) where
           txmetadata <- CBOR.decodeNullMaybe fromCBOR
           return $ CBOR.Annotator $ \fbs ->
             ShelleyTxBody
+              ShelleyBasedEraShelley
               (CBOR.runAnnotator txbody fbs)
               (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 =
@@ -322,30 +395,38 @@ 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,
                          txCertificates,
                          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
+          ShelleyBasedEraShelley
+          (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 =

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

@@ -241,6 +241,7 @@ module Cardano.Api.Typed (
     ScriptFeatureInEra(..),
     SignatureFeature,
     TimeLocksFeature,
+    HasScriptFeatures,
     -- *** Deprecated aliases
     MultiSigScript,
     makeMultiSigScript,
@@ -467,7 +468,7 @@ import qualified Cardano.Chain.Slotting as Byron
 --
 -- Shelley imports
 --
-import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardShelley, StandardMary)
+import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary, StandardShelley)
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 
 import qualified Shelley.Spec.Ledger.Address as Shelley

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -48,8 +48,8 @@ module Cardano.CLI.Shelley.Commands
 import           Data.Text (Text)
 import           Prelude
 
-import           Cardano.Api.Typed hiding (PoolId)
 import           Cardano.Api.Protocol (Protocol)
+import           Cardano.Api.Typed hiding (PoolId)
 
 import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
 
@@ -100,7 +100,7 @@ data AddressCmd
       (Maybe (VerificationKeyOrFile StakeKey))
       NetworkId
       (Maybe OutputFile)
-  | AddressBuildMultiSig ScriptFile NetworkId (Maybe OutputFile)
+  | AddressBuildMultiSig UseCardanoEra ScriptFile NetworkId (Maybe OutputFile)
   | AddressInfo Text (Maybe OutputFile)
   deriving (Eq, Show)
 
@@ -161,6 +161,7 @@ renderKeyCmd cmd =
 
 data TransactionCmd
   = TxBuildRaw
+      UseCardanoEra
       [TxIn]
       [TxOut ShelleyEra]
       (Maybe String) -- Placeholder for multi asset Values
@@ -172,8 +173,8 @@ data TransactionCmd
       [MetaDataFile]
       (Maybe UpdateProposalFile)
       TxBodyFile
-  | TxSign TxBodyFile [WitnessSigningData] (Maybe NetworkId) TxFile
-  | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile
+  | TxSign UseCardanoEra TxBodyFile [WitnessSigningData] (Maybe NetworkId) TxFile
+  | TxCreateWitness UseCardanoEra TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile
   | TxAssembleTxBodyWitness TxBodyFile [WitnessFile] OutputFile
   | TxSubmit Protocol NetworkId FilePath
   | TxMintedPolicyId ScriptFile