Implement toAlonzoTxOut and fromAlonzoBlock

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -223,6 +223,7 @@ import Ouroboros.Consensus.Cardano.Block
     , CardanoGenTx
     , GenTx (..)
     , HardForkBlock (..)
+    , StandardAlonzo
     , StandardShelley
     )
 import Ouroboros.Consensus.HardFork.Combinator.AcrossEras
@@ -261,6 +262,11 @@ import qualified Cardano.Byron.Codec.Cbor as CBOR
 import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Ledger.Address as SL
+import qualified Cardano.Ledger.Alonzo as Alonzo
+import qualified Cardano.Ledger.Alonzo.Data as Alonzo
+import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
+import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
+import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo
 import qualified Cardano.Ledger.BaseTypes as SL
 import qualified Cardano.Ledger.Core as SL.Core
 import qualified Cardano.Ledger.Credential as SL
@@ -489,11 +495,29 @@ fromMaryBlock gp blk@(ShelleyBlock (SL.Block _ (SL.TxSeq txs')) _) =
         , mconcat poolCerts
         )
 
+-- TODO: We could use the cardano-api `Block` pattern to very elegently get the
+-- header and txs of any era block.
+--
+-- We would need to remove the previous block hash from our `W.BlockHeader`,
+-- which shouldn't be needed modulo some hacks w.r.t. the genesis point which
+-- would need to be cleaned up too. We probably will need to use `Point block`,
+-- in all chain followers (including the DBLayer).
 fromAlonzoBlock
     :: W.GenesisParameters
-    -> ShelleyBlock (AlonzoEra StandardCrypto)
+    -> ShelleyBlock (Alonzo.AlonzoEra StandardCrypto)
     -> (W.Block, [W.PoolCertificate])
-fromAlonzoBlock = error "fromAlonzoBlock unimplemented" -- TODO: [ADP-952] fromAlonzoBlock
+fromAlonzoBlock gp blk@(ShelleyBlock (SL.Block _ txSeq) _) =
+    let
+        Alonzo.TxSeq txs' = txSeq
+        (txs, dlgCerts, poolCerts) = unzip3 $ map fromAlonzoValidatedTx $ toList txs'
+    in
+        ( W.Block
+            { header = toShelleyBlockHeader (W.getGenesisBlockHash gp) blk
+            , transactions = txs
+            , delegations  = mconcat dlgCerts
+            }
+        , mconcat poolCerts
+        )
 
 fromShelleyHash :: ShelleyHash c -> W.Hash "BlockHeader"
 fromShelleyHash (ShelleyHash (SL.HashHeader h)) = W.Hash (hashToBytes h)
@@ -871,13 +895,67 @@ fromMaryTx tx =
         W.TxOut (fromShelleyAddress addr) $
         fromCardanoValue $ Cardano.fromMaryValue value
 
+fromAlonzoTxBodyAndAux
+    :: Alonzo.TxBody (Cardano.ShelleyLedgerEra AlonzoEra)
+    -> SLAPI.StrictMaybe (Alonzo.AuxiliaryData (Cardano.ShelleyLedgerEra AlonzoEra))
+    -> ( W.Tx
+       , [W.DelegationCertificate]
+       , [W.PoolCertificate]
+       )
+fromAlonzoTxBodyAndAux bod mad =
+    ( W.Tx
+        (fromShelleyTxId $ SL.txid @(Cardano.ShelleyLedgerEra AlonzoEra) bod)
+        (Just $ fromShelleyCoin fee)
+        (map ((,W.Coin 0) . fromShelleyTxIn) (toList ins))
+        (map fromAlonzoTxOut (toList outs))
+        (fromShelleyWdrl wdrls)
+        (fromShelleyMD . toSLMetadata <$> SL.strictMaybeToMaybe mad)
+    , mapMaybe fromShelleyDelegationCert (toList certs)
+    , mapMaybe fromShelleyRegistrationCert (toList certs)
+    )
+  where
+    Alonzo.TxBody
+        ins
+        _collateral
+        outs
+        certs
+        wdrls
+        fee
+        _valid
+        _upd
+        _reqSignerHashes
+        _mint
+        _wwpHash
+        _adHash
+        _network
+        = bod
+
+    fromAlonzoTxOut
+         :: Alonzo.TxOut (Cardano.ShelleyLedgerEra AlonzoEra)
+         -> W.TxOut
+    fromAlonzoTxOut (Alonzo.TxOut addr value _) =
+        W.TxOut (fromShelleyAddress addr) $
+        fromCardanoValue $ Cardano.fromMaryValue value
+
+    toSLMetadata (Alonzo.AuxiliaryData blob _scripts) = SL.Metadata blob
+
+fromAlonzoValidatedTx
+    :: Alonzo.ValidatedTx (Cardano.ShelleyLedgerEra AlonzoEra)
+    -> ( W.Tx
+       , [W.DelegationCertificate]
+       , [W.PoolCertificate]
+       )
+fromAlonzoValidatedTx (Alonzo.ValidatedTx bod _wits _isValidating aux) =
+    fromAlonzoTxBodyAndAux bod aux
+
 fromAlonzoTx
-    :: SLAPI.Tx (Cardano.ShelleyLedgerEra Cardano.AlonzoEra)
+    :: SLAPI.Tx (Cardano.ShelleyLedgerEra AlonzoEra)
     -> ( W.Tx
        , [W.DelegationCertificate]
        , [W.PoolCertificate]
        )
-fromAlonzoTx = error "fromAlonzoTx unimplemented" -- TODO: [ADP-952] fromAlonzoTx
+fromAlonzoTx (SL.Tx bod _wits aux) =
+    fromAlonzoTxBodyAndAux bod aux
 
 fromCardanoValue :: Cardano.Value -> TokenBundle.TokenBundle
 fromCardanoValue = uncurry TokenBundle.fromFlatList . extract
@@ -1084,9 +1162,8 @@ toShelleyTxOut (W.TxOut (W.Address addr) tokens) =
     Cardano.TxOut
         addrInEra
         (adaOnly $ toCardanoLovelace $ TokenBundle.getCoin tokens)
-        datumHash
+        Cardano.TxOutDatumHashNone
   where
-    datumHash = error "datumHash unimplemented" -- TODO: [ADP-952] datumHash
     adaOnly = Cardano.TxOutAdaOnly Cardano.AdaOnlyInShelleyEra
     addrInEra = fromMaybe (error "toCardanoTxOut: malformed address") $
         asum
@@ -1103,9 +1180,8 @@ toAllegraTxOut (W.TxOut (W.Address addr) tokens) =
     Cardano.TxOut
         addrInEra
         (adaOnly $ toCardanoLovelace $ TokenBundle.getCoin tokens)
-        datumHash
+        Cardano.TxOutDatumHashNone
   where
-    datumHash = error "datumHash unimplemented" -- TODO: [ADP-952] datumHash
     adaOnly = Cardano.TxOutAdaOnly Cardano.AdaOnlyInAllegraEra
     addrInEra = fromMaybe (error "toCardanoTxOut: malformed address") $
         asum
@@ -1122,9 +1198,8 @@ toMaryTxOut (W.TxOut (W.Address addr) tokens) =
     Cardano.TxOut
         addrInEra
         (Cardano.TxOutValue Cardano.MultiAssetInMaryEra $ toCardanoValue tokens)
-        datumHash
+        Cardano.TxOutDatumHashNone
   where
-    datumHash = error "datumHash unimplemented" -- TODO: [ADP-952] datumHash
     addrInEra = fromMaybe (error "toCardanoTxOut: malformed address") $
         asum
         [ Cardano.AddressInEra (Cardano.ShelleyAddressInEra Cardano.ShelleyBasedEraMary)
@@ -1134,6 +1209,23 @@ toMaryTxOut (W.TxOut (W.Address addr) tokens) =
             <$> deserialiseFromRawBytes AsByronAddress addr
         ]
 
+toAlonzoTxOut :: W.TxOut -> Cardano.TxOut AlonzoEra
+toAlonzoTxOut (W.TxOut (W.Address addr) tokens) =
+    Cardano.TxOut
+        addrInEra
+        (Cardano.TxOutValue Cardano.MultiAssetInAlonzoEra $ toCardanoValue tokens)
+        datumHash
+  where
+    datumHash = Cardano.TxOutDatumHashNone
+    addrInEra = fromMaybe (error "toCardanoTxOut: malformed address") $
+        asum
+        [ Cardano.AddressInEra (Cardano.ShelleyAddressInEra Cardano.ShelleyBasedEraAlonzo)
+            <$> deserialiseFromRawBytes AsShelleyAddress addr
+
+        , Cardano.AddressInEra Cardano.ByronAddressInAnyEra
+            <$> deserialiseFromRawBytes AsByronAddress addr
+        ]
+
 toCardanoValue :: TokenBundle.TokenBundle -> Cardano.Value
 toCardanoValue tb = Cardano.valueFromList $
     (Cardano.AdaAssetId, coinToQuantity coin) :

lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs

@@ -103,6 +103,7 @@ import Cardano.Wallet.Registry
 import Cardano.Wallet.Shelley.Compatibility
     ( StandardCrypto
     , fromAllegraBlock
+    , fromAlonzoBlock
     , fromMaryBlock
     , fromShelleyBlock
     , getProducer
@@ -595,8 +596,6 @@ monitorStakePools followTr (NetworkParameters gp sp _pp) nl DBLayer{..} =
             BlockAlonzo blk ->
                 forEachShelleyBlock (fromAlonzoBlock gp blk) (getProducer blk)
 
-        fromAlonzoBlock = error "todo: fromAlonzoBlock"
-
         forLastBlock = \case
             BlockByron blk ->
                 putHeader (toByronBlockHeader gp blk)

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -119,6 +119,7 @@ import Cardano.Wallet.Shelley.Compatibility
     , maxTokenBundleSerializedLengthBytes
     , sealShelleyTx
     , toAllegraTxOut
+    , toAlonzoTxOut
     , toCardanoLovelace
     , toCardanoStakeCredential
     , toCardanoTxIn
@@ -1316,7 +1317,7 @@ mkUnsignedTx era ttl cs md wdrls certs fees =
         ShelleyBasedEraShelley -> toShelleyTxOut
         ShelleyBasedEraAllegra -> toAllegraTxOut
         ShelleyBasedEraMary -> toMaryTxOut
-        ShelleyBasedEraAlonzo -> error "toAlonzoTxOut unimplemented" -- TODO: [ADP-952] toAlonzoTxOut
+        ShelleyBasedEraAlonzo -> toAlonzoTxOut
 
     metadataSupported :: Cardano.TxMetadataSupportedInEra era
     metadataSupported = case era of