Diverse witnesses in shelley

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs

@@ -16,7 +16,8 @@ module Test.Integration.Scenario.API.Shelley.Transactions
 import Prelude
 
 import Cardano.Wallet.Api.Types
-    ( ApiFee
+    ( ApiByronWallet
+    , ApiFee
     , ApiT (..)
     , ApiTransaction
     , ApiTxId (..)
@@ -73,6 +74,7 @@ import Test.Integration.Framework.DSL
     , expectSuccess
     , faucetAmt
     , faucetUtxoAmt
+    , fixtureIcarusWallet
     , fixturePassphrase
     , fixtureRandomWallet
     , fixtureWallet
@@ -464,6 +466,73 @@ spec = do
                 (Link.createTransaction @'Shelley w) Default payload
             expectResponseCode @IO HTTP.status400 r
 
+    describe "TRANS_CREATE_09 - Single Output Transaction with non-Shelley witnesses" $
+        forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $
+        \(srcFixture,name) -> it name $ \ctx -> do
+
+        (wByron, wShelley) <- (,) <$> srcFixture ctx <*> fixtureWallet ctx
+        addrs <- listAddresses @n ctx wShelley
+
+        let amt = 1
+        let destination = (addrs !! 1) ^. #id
+        let payload = Json [json|{
+                "payments": [{
+                    "address": #{destination},
+                    "amount": {
+                        "quantity": #{amt},
+                        "unit": "lovelace"
+                    }
+                }]
+            }|]
+
+        rFeeEst <- request @ApiFee ctx
+            (Link.getTransactionFee @'Byron wByron) Default payload
+        verify rFeeEst
+            [ expectSuccess
+            , expectResponseCode HTTP.status202
+            ]
+        let (Quantity feeEstMin) = getFromResponse #estimatedMin rFeeEst
+        let (Quantity feeEstMax) = getFromResponse #estimatedMax rFeeEst
+
+        r <- postTx ctx
+            (wByron, Link.createTransaction @'Byron, fixturePassphrase)
+            wShelley
+            amt
+        verify r
+            [ expectSuccess
+            , expectResponseCode HTTP.status202
+            , expectField (#amount . #getQuantity) $
+                between (feeEstMin + amt, feeEstMax + amt)
+            , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
+            , expectField (#status . #getApiT) (`shouldBe` Pending)
+            ]
+
+        ra <- request @ApiByronWallet ctx (Link.getWallet @'Byron wByron) Default Empty
+        verify ra
+            [ expectSuccess
+            , expectField (#balance . #total) $
+                between
+                    ( Quantity (faucetAmt - feeEstMax - amt)
+                    , Quantity (faucetAmt - feeEstMin - amt)
+                    )
+            , expectField
+                    (#balance . #available)
+                    (.>= Quantity (faucetAmt - faucetUtxoAmt))
+            ]
+
+        eventually "wa and wb balances are as expected" $ do
+            rb <- request @ApiWallet ctx
+                (Link.getWallet @'Shelley wShelley) Default Empty
+            expectField
+                (#balance . #getApiT . #available)
+                (`shouldBe` Quantity (faucetAmt + amt)) rb
+
+            ra2 <- request @ApiByronWallet ctx
+                (Link.getWallet @'Byron wByron) Default Empty
+            expectField
+                (#balance . #available)
+                (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2
+
     describe "TRANS_ESTIMATE_08 - Bad payload" $ do
         let matrix =
                 [ ( "empty payload", NonJson "" )

lib/core/src/Cardano/Byron/Codec/Cbor.hs

@@ -50,6 +50,7 @@ module Cardano.Byron.Codec.Cbor
     , inspectNextToken
     , decodeList
     , decodeListIndef
+    , decodeNestedBytes
     ) where
 
 import Prelude

lib/shelley/cardano-wallet-shelley.cabal

@@ -41,6 +41,7 @@ library
     , cardano-binary
     , cardano-crypto
     , cardano-crypto-class
+    , cardano-crypto-wrapper
     , cardano-ledger
     , cardano-slotting
     , cardano-wallet-cli

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

@@ -56,6 +56,7 @@ module Cardano.Wallet.Shelley.Compatibility
     , toStakeCredential
     , toShelleyCoin
     , fromShelleyCoin
+    , toHDPayloadAddress
 
       -- ** Stake pools
     , fromPoolId
@@ -73,6 +74,7 @@ module Cardano.Wallet.Shelley.Compatibility
     , fromChainHash
     , fromGenesisData
     , fromNetworkMagic
+    , toByronNetworkMagic
     , fromSlotNo
     , fromTip
     , fromTip'
@@ -189,6 +191,7 @@ import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Codec.Binary.Bech32 as Bech32
 import qualified Codec.Binary.Bech32.TH as Bech32
+import qualified Codec.CBOR.Decoding as CBOR
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map.Strict as Map
@@ -757,6 +760,13 @@ fromNetworkDiscriminant _ =
         Just{}  -> SL.Mainnet
         Nothing -> SL.Testnet
 
+toByronNetworkMagic :: W.ProtocolMagic -> Byron.NetworkMagic
+toByronNetworkMagic pm@(W.ProtocolMagic magic) =
+    if pm == W.mainnetMagic then
+        Byron.NetworkMainOrStage
+    else
+        Byron.NetworkTestnet (fromIntegral magic)
+
 -- NOTE: Arguably breaks naming conventions. Perhaps fromCardanoSignedTx instead
 toSealed :: SL.Tx TPraosStandardCrypto -> (W.Tx, W.SealedTx)
 toSealed tx =
@@ -900,6 +910,21 @@ _decodeAddress serverNetwork text =
             Byron.NetworkMainOrStage -> SL.Mainnet
             Byron.NetworkTestnet{}   -> SL.Testnet
 
+toHDPayloadAddress :: W.Address -> Maybe Byron.HDAddressPayload
+toHDPayloadAddress (W.Address addr) = do
+    payload <- CBOR.deserialiseCbor CBOR.decodeAddressPayload addr
+    attributes <- CBOR.deserialiseCbor decodeAllAttributes' payload
+    case filter (\(tag,_) -> tag == 1) attributes of
+        [(1, bytes)] ->
+            Byron.HDAddressPayload <$> CBOR.decodeNestedBytes CBOR.decodeBytes bytes
+        _ ->
+            Nothing
+  where
+    decodeAllAttributes' = do
+        _ <- CBOR.decodeListLenCanonicalOf 3
+        _ <- CBOR.decodeBytes
+        CBOR.decodeAllAttributes
+
 {-------------------------------------------------------------------------------
                                     Logging
 -------------------------------------------------------------------------------}