Update Cardano.Api.Tx in preparation for Alonzo

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

@@ -65,9 +65,7 @@ import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus
 
 import qualified Cardano.Chain.Block as Byron
 import qualified Cardano.Chain.UTxO as Byron
-import qualified Cardano.Ledger.Core as Core
-import qualified Cardano.Ledger.Era as Ledger
-import           Cardano.Ledger.SafeHash (SafeToHash)
+import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo
 
 import qualified Shelley.Spec.Ledger.BlockChain as Shelley
 
@@ -145,18 +143,22 @@ getBlockTxs (ByronBlock Consensus.ByronBlock { Consensus.byronBlockRaw }) =
               Byron.bodyTxPayload = Byron.ATxPayload txs
             }
         } -> map ByronTx txs
-getBlockTxs (ShelleyBlock shelleyEra Consensus.ShelleyBlock{Consensus.shelleyBlockRaw})
-  = case shelleyEra of
-      ShelleyBasedEraShelley -> go
-      ShelleyBasedEraAllegra -> go
-      ShelleyBasedEraMary    -> go
-      ShelleyBasedEraAlonzo  ->
-        error "getBlockTxs: Alonzo era not implemented yet"
-  where
-    go :: Ledger.TxSeq (ShelleyLedgerEra era) ~ Shelley.TxSeq (ShelleyLedgerEra era)
-       => SafeToHash (Core.Witnesses (ShelleyLedgerEra era))
-       => Consensus.ShelleyBasedEra (ShelleyLedgerEra era) => [Tx era]
-    go = case shelleyBlockRaw of Shelley.Block _header (Shelley.TxSeq txs) -> [ShelleyTx shelleyEra x | x <- toList txs]
+getBlockTxs (ShelleyBlock shelleyEra Consensus.ShelleyBlock{Consensus.shelleyBlockRaw}) =
+  case shelleyEra of
+    ShelleyBasedEraShelley ->
+      let Shelley.Block _header (Shelley.TxSeq txs) = shelleyBlockRaw
+      in [ShelleyTx ShelleyBasedEraShelley x | x <- toList txs]
+    ShelleyBasedEraAllegra ->
+      let Shelley.Block _header (Shelley.TxSeq txs) = shelleyBlockRaw
+      in [ShelleyTx ShelleyBasedEraAllegra x | x <- toList txs]
+    ShelleyBasedEraMary ->
+      let Shelley.Block _header (Shelley.TxSeq txs) = shelleyBlockRaw
+      in [ShelleyTx ShelleyBasedEraMary x | x <- toList txs]
+    ShelleyBasedEraAlonzo ->
+      case shelleyBlockRaw of
+        Shelley.Block _header (Alonzo.TxSeq txs) ->
+         [ShelleyTx ShelleyBasedEraAlonzo x | x <- toList txs]
+        Shelley.Block _ _ -> error "getBlockTxs: Why do we have to pattern match again?"
 
 -- ----------------------------------------------------------------------------
 -- Block in a consensus mode

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -20,6 +21,8 @@ import           Numeric.Natural
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Chain.Common as Byron
 
+import qualified Cardano.Ledger.Era as Ledger
+
 import           Cardano.Api.Eras
 import           Cardano.Api.NetworkId
 import           Cardano.Api.Tx
@@ -38,6 +41,7 @@ import           Cardano.Api.Value
 --
 transactionFee :: forall era.
                   IsShelleyBasedEra era
+               => HasField "txsize" (Ledger.TxInBlock (ShelleyLedgerEra era)) Integer
                => Natural -- ^ The fixed tx fee
                -> Natural -- ^ The tx fee per byte
                -> Tx era
@@ -64,17 +68,19 @@ transactionFee txFeeFixed txFeePerByte tx =
 -- contain all the things not subject to coin selection (such as script inputs,
 -- metadata, withdrawals, certs etc)
 --
-estimateTransactionFee :: forall era.
-                          IsShelleyBasedEra era
-                       => NetworkId
-                       -> Natural -- ^ The fixed tx fee
-                       -> Natural -- ^ The tx fee per byte
-                       -> Tx era
-                       -> Int -- ^ The number of extra UTxO transaction inputs
-                       -> Int -- ^ The number of extra transaction outputs
-                       -> Int -- ^ The number of extra Shelley key witnesses
-                       -> Int -- ^ The number of extra Byron key witnesses
-                       -> Lovelace
+estimateTransactionFee
+  :: forall era.
+     IsShelleyBasedEra era
+  => HasField "txsize" (Ledger.TxInBlock (ShelleyLedgerEra era)) Integer
+  => NetworkId
+  -> Natural -- ^ The fixed tx fee
+  -> Natural -- ^ The tx fee per byte
+  -> Tx era
+  -> Int -- ^ The number of extra UTxO transaction inputs
+  -> Int -- ^ The number of extra transaction outputs
+  -> Int -- ^ The number of extra Shelley key witnesses
+  -> Int -- ^ The number of extra Byron key witnesses
+  -> Lovelace
 estimateTransactionFee nw txFeeFixed txFeePerByte (ShelleyTx era tx) =
     let Lovelace baseFee = transactionFee txFeeFixed txFeePerByte (ShelleyTx era tx)
      in \nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses ->

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

@@ -84,6 +84,9 @@ import qualified Cardano.Crypto.Signing as Byron
 --
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 
+import qualified Cardano.Ledger.Alonzo as Alonzo
+import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
+import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Era as Ledger
 import qualified Cardano.Ledger.SafeHash as Ledger
@@ -120,7 +123,7 @@ data Tx era where
 
      ShelleyTx
        :: ShelleyBasedEra era
-       -> Shelley.Tx (ShelleyLedgerEra era)
+       -> Ledger.TxInBlock (ShelleyLedgerEra era)
        -> Tx era
 
 -- The GADT in the ShelleyTx case requires a custom instance
@@ -187,8 +190,9 @@ instance IsCardanoEra era => SerialiseAsCBOR (Tx era) where
         ShelleyBasedEraShelley -> serialiseShelleyBasedTx tx
         ShelleyBasedEraAllegra -> serialiseShelleyBasedTx tx
         ShelleyBasedEraMary    -> serialiseShelleyBasedTx tx
-        ShelleyBasedEraAlonzo  ->
-          error "serialiseShelleyBasedTx: Alonzo era not implemented yet"
+        --ShelleyBasedEraAlonzo  ->
+        --  error "serialiseShelleyBasedTx: Alonzo era not implemented yet"
+        ShelleyBasedEraAlonzo  -> serialiseShelleyBasedTx tx
 
     deserialiseFromCBOR _ bs =
       case cardanoEra :: CardanoEra era of
@@ -258,17 +262,15 @@ instance Eq (KeyWitness era) where
         ShelleyBasedEraShelley -> wA == wB
         ShelleyBasedEraAllegra -> wA == wB
         ShelleyBasedEraMary    -> wA == wB
-        ShelleyBasedEraAlonzo  ->
-          error "Eq (KeyWitness era): Alonzo not implemented yet"
+        ShelleyBasedEraAlonzo  -> wA == wB
 
     (==) (ShelleyKeyWitness era wA)
          (ShelleyKeyWitness _   wB) =
       case era of
         ShelleyBasedEraShelley -> wA == wB
         ShelleyBasedEraAllegra -> wA == wB
         ShelleyBasedEraMary    -> wA == wB
-        ShelleyBasedEraAlonzo  ->
-          error "Eq (KeyWitness era): Alonzo not implemented yet"
+        ShelleyBasedEraAlonzo  -> wA == wB
 
     (==) _ _ = False
 
@@ -296,8 +298,10 @@ instance Show (KeyWitness era) where
         showString "ShelleyBootstrapWitness ShelleyBasedEraMary "
       . showsPrec 11 tx
 
-    showsPrec _ (ShelleyBootstrapWitness ShelleyBasedEraAlonzo _) =
-      error "Show (KeyWitness era): Alonzo era not implemented yet"
+    showsPrec p (ShelleyBootstrapWitness ShelleyBasedEraAlonzo tx) =
+      showParen (p >= 11) $
+        showString "ShelleyBootstrapWitness ShelleyBasedEraAlonzo "
+      . showsPrec 11 tx
 
     showsPrec p (ShelleyKeyWitness ShelleyBasedEraShelley tx) =
       showParen (p >= 11) $
@@ -314,8 +318,10 @@ instance Show (KeyWitness era) where
         showString "ShelleyKeyWitness ShelleyBasedEraMary "
       . showsPrec 11 tx
 
-    showsPrec _ (ShelleyKeyWitness ShelleyBasedEraAlonzo _) =
-      error "Show (KeyWitness era): Alonzo era not implemented yet"
+    showsPrec p (ShelleyKeyWitness ShelleyBasedEraAlonzo tx) =
+      showParen (p >= 11) $
+        showString "ShelleyKeyWitness ShelleyBasedEraAlonzo "
+      . showsPrec 11 tx
 
 
 instance HasTypeProxy era => HasTypeProxy (KeyWitness era) where
@@ -418,8 +424,7 @@ getTxBody (ShelleyTx era tx) =
       ShelleyBasedEraShelley -> getShelleyTxBody tx
       ShelleyBasedEraAllegra -> getShelleyTxBody tx
       ShelleyBasedEraMary    -> getShelleyTxBody tx
-      ShelleyBasedEraAlonzo  ->
-        error "getShelleyTxBody: Alonzo era not implemented yet"
+      ShelleyBasedEraAlonzo  -> getAlonzoTxBody tx
   where
     getShelleyTxBody :: forall ledgerera.
                         ShelleyLedgerEra era ~ ledgerera
@@ -439,6 +444,21 @@ getTxBody (ShelleyTx era tx) =
                     (Map.elems msigWits)
                     (strictMaybeToMaybe txAuxiliaryData)
 
+    getAlonzoTxBody :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera
+                    => Ledger.Script ledgerera ~ Alonzo.Script ledgerera
+                    => Shelley.ShelleyBased ledgerera
+                    => Alonzo.ValidatedTx ledgerera -> TxBody era
+    getAlonzoTxBody Alonzo.ValidatedTx { Alonzo.body = txbody,
+                                Alonzo.wits = Alonzo.TxWitness
+                                                _txwitsVKey
+                                                _txwitsBoot
+                                                txscripts
+                                                _txdats
+                                                _txrdmrs,
+                                Alonzo.isValidating = _isValidating,
+                                Alonzo.auxiliaryData = auxiliaryData
+                              } = ShelleyTxBody era txbody (Map.elems txscripts)
+                                                (strictMaybeToMaybe auxiliaryData)
 
 getTxWitnesses :: forall era. Tx era -> [KeyWitness era]
 getTxWitnesses (ByronTx Byron.ATxAux { Byron.aTaWitness = witnesses }) =
@@ -471,10 +491,31 @@ getTxWitnesses (ShelleyTx era tx) =
                           } =
         map (ShelleyBootstrapWitness era) (Set.elems bootWits)
      ++ map (ShelleyKeyWitness       era) (Set.elems addrWits)
-
-
-makeSignedTransaction :: forall era.
-                         [KeyWitness era]
+{-
+    getAlonzoTxWitnesses :: Ledger.Era ledgerera
+                         => Ledger.Crypto ledgerera ~ StandardCrypto
+                         => ToCBOR (Ledger.AuxiliaryData ledgerera)
+                         => ToCBOR (Ledger.TxBody ledgerera)
+                         => ToCBOR (Ledger.Script ledgerera)
+                         => Alonzo.Tx ledgerera -> [KeyWitness era]
+    getAlonzoTxWitnesses Alonzo.Tx {
+                           Alonzo.wits =
+                             Alonzo.TxWitness
+                               addrWits
+                               bootWits
+                               _msigWits
+                               _datWits
+                               _rdmrWits }=
+        map (ShelleyBootstrapWitness era) (Set.elems bootWits)
+     ++ map (ShelleyKeyWitness       era) (Set.elems addrWits)
+ --  ++ map (AlonzoDataWitness       era) (Map.elems _datWits)
+ --  ++      AlonzoRdmrWitnesses     era _rdmrWits
+    getAlonzoTxWitnesses _ = error "Cardano.Ledger.Alonzo.Tx.TxConstr"
+-}
+
+makeSignedTransaction :: forall era ledgerera.
+                         ShelleyLedgerEra era ~ ledgerera
+                      => [KeyWitness era]
                       -> TxBody era
                       -> Tx era
 makeSignedTransaction witnesses (ByronTxBody txbody) =
@@ -486,23 +527,19 @@ makeSignedTransaction witnesses (ByronTxBody txbody) =
 
 makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata) =
     case era of
-      ShelleyBasedEraShelley -> makeShelleySignedTransaction txbody
-      ShelleyBasedEraAllegra -> makeShelleySignedTransaction txbody
-      ShelleyBasedEraMary    -> makeShelleySignedTransaction txbody
-      ShelleyBasedEraAlonzo  ->
-        error "makeSignedTransaction: Alonzo era not implemented yet"
+      ShelleyBasedEraShelley -> ShelleyTx ShelleyBasedEraShelley $ makeShelleySignedTransaction txbody
+      ShelleyBasedEraAllegra -> ShelleyTx ShelleyBasedEraAllegra $ makeShelleySignedTransaction txbody
+      ShelleyBasedEraMary    -> ShelleyTx ShelleyBasedEraMary $ makeShelleySignedTransaction txbody
+      ShelleyBasedEraAlonzo  -> ShelleyTx ShelleyBasedEraAlonzo $ makeAlonzoSignedTransaction txbody
   where
-    makeShelleySignedTransaction :: forall ledgerera.
-                                    ShelleyLedgerEra era ~ ledgerera
-                                 => Ledger.Crypto ledgerera ~ StandardCrypto
+    makeShelleySignedTransaction :: Ledger.Crypto ledgerera ~ StandardCrypto
                                  => Ledger.Witnesses ledgerera ~ Shelley.WitnessSetHKD Identity ledgerera
                                  => ToCBOR (Ledger.Witnesses ledgerera)
                                  => Shelley.ShelleyBased ledgerera
                                  => Shelley.ValidateScript ledgerera
                                  => Ledger.TxBody ledgerera
-                                 -> Tx era
+                                 -> Shelley.Tx ledgerera
     makeShelleySignedTransaction txbody' =
-      ShelleyTx era $
         Shelley.Tx
           txbody'
           (Shelley.WitnessSet
@@ -512,6 +549,28 @@ makeSignedTransaction witnesses (ShelleyTxBody era txbody txscripts txmetadata)
             (Set.fromList [ w | ShelleyBootstrapWitness _ w <- witnesses ]))
           (maybeToStrictMaybe txmetadata)
 
+    makeAlonzoSignedTransaction
+      :: Ledger.Crypto ledgerera ~ StandardCrypto
+      => Ledger.Era ledgerera
+      => ToCBOR (Ledger.AuxiliaryData ledgerera)
+      => Ledger.Script ledgerera ~ Alonzo.Script ledgerera
+      => ToCBOR (Ledger.TxBody ledgerera)
+      => Shelley.ValidateScript ledgerera
+      => Ledger.TxBody (ShelleyLedgerEra era) -> Alonzo.ValidatedTx ledgerera
+    makeAlonzoSignedTransaction txbody' =
+      Alonzo.ValidatedTx
+        txbody'
+        (Alonzo.TxWitness
+          (Set.fromList [ w | ShelleyKeyWitness _ w <- witnesses ])
+          (Set.fromList [ w | ShelleyBootstrapWitness _ w <- witnesses ])
+          (Map.fromList [ (Shelley.hashScript @ledgerera sw, sw)
+                        | sw <- txscripts ])
+          (error "makeAlonzoSignedTransaction: Map (DataHash (Crypto ledgerera)) (Data ledgerera)")
+          (error "makeAlonzoSignedTransaction: Map RdmrPtr (Data ledgerera, ExUnits)"))
+        -- TODO: Seems to be some discussion around the isValidating flag
+        (error "makeAlonzoSignedTransaction: isValidating flag not implemented")
+        (maybeToStrictMaybe txmetadata)
+
 
 makeByronKeyWitness :: forall key.
                        IsByronKey key
@@ -581,6 +640,8 @@ makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody era txbody _ _) sk =
       ShelleyBasedEraAlonzo  ->
         error "makeShelleyBootstrapWitness: Alonzo era not implemented yet"
 
+   -- ShelleyBasedEraAlonzo  ->
+   --   makeShelleyBasedBootstrapWitness era nwOrAddr txbody sk
 makeShelleyBasedBootstrapWitness :: forall era.
                                     (Ledger.HashAnnotated
                                        (Ledger.TxBody (ShelleyLedgerEra era))
@@ -683,13 +744,12 @@ makeShelleyKeyWitness :: forall era
                       => TxBody era
                       -> ShelleyWitnessSigningKey
                       -> KeyWitness era
-makeShelleyKeyWitness (ShelleyTxBody era txbody _ _) =
+makeShelleyKeyWitness (ShelleyTxBody era txbody _ _ ) =
     case era of
       ShelleyBasedEraShelley -> makeShelleyBasedKeyWitness txbody
       ShelleyBasedEraAllegra -> makeShelleyBasedKeyWitness txbody
       ShelleyBasedEraMary    -> makeShelleyBasedKeyWitness txbody
-      ShelleyBasedEraAlonzo  ->
-        error "makeShelleyKeyWitness: Alonzo era not implemented yet"
+      ShelleyBasedEraAlonzo  -> makeShelleyBasedKeyWitness txbody
   where
     makeShelleyBasedKeyWitness :: Shelley.ShelleyBased ledgerera
                                => ShelleyLedgerEra era ~ ledgerera

cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs

@@ -34,8 +34,10 @@ import           Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardMary
 import qualified Cardano.Binary as CBOR
 
 --TODO: following import needed for orphan Eq Script instance
+import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.ShelleyMA.TxBody ()
 import           Shelley.Spec.Ledger.Scripts ()
+import qualified Shelley.Spec.Ledger.Tx as Shelley
 
 import           Ouroboros.Consensus.Byron.Ledger (ByronBlock)
 import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
@@ -670,7 +672,7 @@ runTxCalculateMinFee (TxBodyFile txbodyFile) nw protocolParamsSourceSpec
                      (TxShelleyWitnessCount nShelleyKeyWitnesses)
                      (TxByronWitnessCount nByronKeyWitnesses) = do
 
-    InAnyShelleyBasedEra _era txbody <-
+    InAnyShelleyBasedEra sbe txbody <-
           --TODO: in principle we should be able to support Byron era txs too
           onlyInShelleyBasedEras "calculate-min-fee for Byron era transactions"
       =<< readFileTxBody txbodyFile
@@ -684,7 +686,8 @@ runTxCalculateMinFee (TxBodyFile txbodyFile) nw protocolParamsSourceSpec
         ParamsFromFile f -> readProtocolParameters f
 
     let tx = makeSignedTransaction [] txbody
-        Lovelace fee = estimateTransactionFee
+        Lovelace fee = obtainLedgerEraClassConstraints sbe
+                         $ estimateTransactionFee
                              (fromMaybe Mainnet nw)
                              (protocolParamTxFeeFixed pparams)
                              (protocolParamTxFeePerByte pparams)
@@ -1087,3 +1090,12 @@ readFileTxMetadata _ (MetadataFileCBOR fp) = do
     firstExceptT (ShelleyTxCmdMetaValidationError fp) $ hoistEither $ do
         validateTxMetadata txMetadata
         return txMetadata
+
+
+obtainLedgerEraClassConstraints
+  :: ShelleyLedgerEra era ~ ledgerera
+  => ShelleyBasedEra era
+  -> (Core.Tx ledgerera ~ Shelley.Tx ledgerera => a) -> a
+obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f
+obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f
+obtainLedgerEraClassConstraints ShelleyBasedEraMary    f = f