View on GitHub
File Changes
        , ForceResyncByronWallet

                      
    , ByronTransactions
+
        , CreateByronTransaction
        , ListByronTransactions
+
        , PostByronTransactionFee
        , DeleteByronTransaction

                      
    , ByronMigrations
-------------------------------------------------------------------------------}

                      
type ByronTransactions n =
-
         ListByronTransactions n
+
    CreateByronTransaction n
+
    :<|> ListByronTransactions n
+
    :<|> PostByronTransactionFee n
    :<|> DeleteByronTransaction

                      
+
-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/postByronTransaction
+
type CreateByronTransaction n = "byron-wallets"
+
    :> Capture "walletId" (ApiT WalletId)
+
    :> "transactions"
+
    :> ReqBody '[JSON] (PostTransactionData n)
+
    :> PostAccepted '[JSON] (ApiTransaction n)
+

                      
-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/listByronTransactions
type ListByronTransactions n = "byron-wallets"
    :> Capture "walletId" (ApiT WalletId)
    :> QueryParam "order" (ApiT SortOrder)
    :> Get '[JSON] [ApiTransaction n]

                      
+
-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/postByronTransactionFee
+
type PostByronTransactionFee n = "byron-wallets"
+
    :> Capture "walletId" (ApiT WalletId)
+
    :> "transactions"
+
    :> "fees"
+
    :> ReqBody '[JSON] (PostTransactionFeeData n)
+
    :> PostAccepted '[JSON] ApiFee
+

                      
-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/deleteByronTransaction
type DeleteByronTransaction = "byron-wallets"
    :> Capture "walletId" (ApiT WalletId)
    , HardDerivation (..)
    , NetworkDiscriminant (..)
    , Passphrase
+
    , PaymentAddress (..)
    , WalletKey (..)
    , XPrv
    , digest
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
    ( ShelleyKey )
import Cardano.Wallet.Primitive.AddressDiscovery
-
    ( IsOwned )
+
    ( GenChange (ArgGenChange), IsOwned )
import Cardano.Wallet.Primitive.AddressDiscovery.Random
    ( RndState, mkRndState )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
        , shelley ~ ApiLayer (SeqState n ShelleyKey) t ShelleyKey

                      
        , DelegationAddress n ShelleyKey
+
        , PaymentAddress n IcarusKey
+

                      
        , Buildable (ErrValidateSelection t)
        )
    => byron

                      
    transactions :: Server (Transactions n)
    transactions =
-
        postTransaction shelley
+
        postTransaction shelley (delegationAddress @n)
        :<|> listTransactions shelley
        :<|> postTransactionFee shelley
        :<|> deleteTransaction shelley

                      
    byronTransactions :: Server (ByronTransactions n)
    byronTransactions =
+
             (\wid tx -> withLegacyLayer wid
+
                 (byron , do
+
                    let pwd = getApiT $ tx ^. #passphrase
+
                    genChange <- rndStateChange byron wid pwd
+
                    postTransaction byron genChange wid tx
+
                 )
+
                 (icarus, do
+
                    let genChange k _ = paymentAddress @n k
+
                    postTransaction icarus genChange wid tx
+
                 )
+
             )
+
        :<|>
             (\wid r0 r1 s -> withLegacyLayer wid
                (byron , listTransactions byron  wid r0 r1 s)
                (icarus, listTransactions icarus wid r0 r1 s)
             )
+
        :<|>
+
            (\wid tx -> withLegacyLayer wid
+
                (byron , postTransactionFee byron wid tx)
+
                (icarus, postTransactionFee icarus wid tx)
+
            )
        :<|> (\wid txid -> withLegacyLayer wid
                (byron , deleteTransaction byron  wid txid)
                (icarus, deleteTransaction icarus wid txid)

                      
-- | A diminished servant server to serve Byron wallets only.
byronServer
-
    :: forall t n. ()
+
    :: forall t n.
+
        ( Buildable (ErrValidateSelection t)
+
        , PaymentAddress n IcarusKey
+
        )
    => ApiLayer (RndState 'Mainnet) t ByronKey
    -> ApiLayer (SeqState 'Mainnet IcarusKey) t IcarusKey
    -> Server (Api n)

                      
    byronTransactions :: Server (ByronTransactions n)
    byronTransactions =
+
             (\wid tx -> withLegacyLayer wid
+
                 (byron , do
+
                    let pwd = getApiT $ tx ^. #passphrase
+
                    genChange <- rndStateChange byron wid pwd
+
                    postTransaction byron genChange wid tx
+
                 )
+
                 (icarus, do
+
                    let genChange k _ = paymentAddress @n k
+
                    postTransaction icarus genChange wid tx
+
                 )
+
             )
+
        :<|>
             (\wid r0 r1 s -> withLegacyLayer wid
                (byron , listTransactions byron  wid r0 r1 s)
                (icarus, listTransactions icarus wid r0 r1 s)
             )
+
        :<|>
+
            (\wid tx -> withLegacyLayer wid
+
                (byron , postTransactionFee byron wid tx)
+
                (icarus, postTransactionFee icarus wid tx)
+
            )
        :<|> (\wid txid -> withLegacyLayer wid
                (byron , deleteTransaction byron  wid txid)
                (icarus, deleteTransaction icarus wid txid)
    fmap mkApiCoinSelection
        $ liftHandler
        $ withWorkerCtx ctx wid liftE
-
        $ \wrk -> W.selectCoinsExternal @_ @s @t @k wrk wid ()
+
        $ \wrk -> W.selectCoinsExternal @_ @s @t @k wrk wid (delegationAddress @n)
        $ coerceCoin <$> body ^. #payments
  where
    liftE = throwE . ErrSelectCoinsExternalNoSuchWallet
postTransaction
    :: forall ctx s t k n.
        ( Buildable (ErrValidateSelection t)
-
        , DelegationAddress n k
-
        , k ~ ShelleyKey
-
        , s ~ SeqState n k
+
        , GenChange s
+
        , IsOwned s k
+
        , NFData s
+
        , Show s
        , ctx ~ ApiLayer s t k
        )
    => ctx
+
    -> ArgGenChange s
    -> ApiT WalletId
    -> PostTransactionData n
    -> Handler (ApiTransaction n)
-
postTransaction ctx (ApiT wid) body = do
+
postTransaction ctx genChange (ApiT wid) body = do
    let outs = coerceCoin <$> (body ^. #payments)
    let pwd = getApiT $ body ^. #passphrase

                      
    selection <- liftHandler $ withWorkerCtx ctx wid liftE1 $ \wrk ->
        W.selectCoinsForPayment @_ @s @t wrk wid outs

                      
    (tx, meta, time, wit) <- liftHandler $ withWorkerCtx ctx wid liftE2 $ \wrk ->
-
        W.signPayment @_ @s @t @k wrk wid () pwd selection
+
        W.signPayment @_ @s @t @k wrk wid genChange pwd selection

                      
    liftHandler $ withWorkerCtx ctx wid liftE3 $ \wrk ->
        W.submitTx @_ @s @t @k wrk wid (tx, meta, wit)
postTransactionFee
    :: forall ctx s t k n.
        ( Buildable (ErrValidateSelection t)
-
        , s ~ SeqState n k
        , ctx ~ ApiLayer s t k
        )
    => ctx
    pools <- liftIO $ knownStakePools spl

                      
    (tx, txMeta, txTime) <- liftHandler $ withWorkerCtx ctx wid liftE $ \wrk ->
-
        W.joinStakePool @_ @s @t @k wrk wid (pid, pools) () pwd
+
        W.joinStakePool @_ @s @t @k wrk wid (pid, pools) (delegationAddress @n) pwd

                      
    pure $ mkApiTransaction
        (txId tx)
    -> Handler (ApiTransaction n)
quitStakePool ctx (ApiT pid) (ApiT wid) (ApiWalletPassphrase (ApiT pwd)) = do
    (tx, txMeta, txTime) <- liftHandler $ withWorkerCtx ctx wid liftE $ \wrk ->
-
        W.quitStakePool @_ @s @t @k wrk wid pid () pwd
+
        W.quitStakePool @_ @s @t @k wrk wid pid (delegationAddress @n) pwd

                      
    pure $ mkApiTransaction
        (txId tx)
            withWorkerCtx sheCtx sheWid liftE $ \sheWrk -> do
                cs <- W.selectCoinsForMigration @_ @_ @t srcWrk srcWid
                withExceptT ErrSelectForMigrationNoSuchWallet $
-
                    W.assignMigrationTargetAddresses sheWrk sheWid () cs
+
                    W.assignMigrationTargetAddresses sheWrk sheWid (delegationAddress @n) cs

                      
    forM migration $ \cs -> do
        (tx, meta, time, wit) <- liftHandler
    re = ctx ^. workerRegistry @s @k
    df = ctx ^. dbFactory @s @k

                      
+
-- | Handler for fetching the 'ArgGenChange' for the 'RndState' (i.e. the root
+
-- XPrv), necessary to derive new change addresses.
+
rndStateChange
+
    :: forall ctx s t k n.
+
        ( ctx ~ ApiLayer s t k
+
        , s ~ RndState n
+
        , k ~ ByronKey
+
        )
+
    => ctx
+
    -> ApiT WalletId
+
    -> Passphrase "encryption"
+
    -> Handler (ArgGenChange s)
+
rndStateChange ctx (ApiT wid) pwd =
+
    liftHandler $ withWorkerCtx @_ @s @k ctx wid liftE $ \wrk ->
+
        W.withRootKey @_ @s @k wrk wid pwd ErrSignPaymentWithRootKey $ \xprv ->
+
            pure (xprv, pwd)
+
  where

                      
instance
    ( SoftDerivation k
-
    , DelegationAddress n k
    ) => GenChange (SeqState n k) where
    -- | We pick indexes in sequence from the first known available index (i.e.
    -- @length addrs - [email protected]) but we do not generate _new change addresses_. As a
    -- result, we can't generate more than @[email protected] _pending_ change addresses and
    -- therefore, rotate the change addresses when we need extra change outputs.
    --
    -- See also: 'nextChangeIndex'
-
    type ArgGenChange (SeqState n k) = ()
-
    genChange () (SeqState intPool extPool pending rpk) =
+
    type ArgGenChange (SeqState n k) =
+
        (k 'AddressK XPub -> k 'AddressK XPub -> Address)
+

                      
+
    genChange mkAddress (SeqState intPool extPool pending rpk) =
        let
            (ix, pending') = nextChangeIndex intPool pending
            accountXPub = accountPubKey intPool
            addressXPub = deriveAddressPublicKey accountXPub UTxOInternal ix
-
            addr = delegationAddress @n addressXPub rpk
+
            addr = mkAddress addressXPub rpk
        in
            (addr, SeqState intPool extPool pending' rpk)