{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- API handlers and server using the underlying wallet layer to provide
-- endpoints reachable through HTTP.

module Cardano.Wallet.Api.Server
    (
    -- * Server Configuration
      Listen (..)
    , ListenError (..)
    , HostPreference
    , TlsConfiguration (..)

    -- * Server Setup
    , start
    , serve
    , withListeningSocket

    -- * ApiLayer
    , newApiLayer

    -- * Handlers
    , delegationFee
    , deleteTransaction
    , deleteWallet
    , derivePublicKey
    , getNetworkClock
    , getNetworkInformation
    , getNetworkParameters
    , getUTxOsStatistics
    , getWalletUtxoSnapshot
    , getWallet
    , joinStakePool
    , listAssets
    , getAsset
    , getAssetDefault
    , listAddresses
    , listTransactions
    , getTransaction
    , constructTransaction
    , listWallets
    , listStakeKeys
    , createMigrationPlan
    , migrateWallet
    , postExternalTransaction
    , postIcarusWallet
    , postLedgerWallet
    , postRandomAddress
    , postRandomWallet
    , postRandomWalletFromXPrv
    , signTransaction
    , postTransactionOld
    , postTransactionFeeOld
    , postTrezorWallet
    , postWallet
    , postShelleyWallet
    , postAccountWallet
    , putByronWalletPassphrase
    , putRandomAddress
    , putRandomAddresses
    , putWallet
    , putWalletPassphrase
    , quitStakePool
    , selectCoins
    , selectCoinsForJoin
    , selectCoinsForQuit
    , signMetadata
    , postAccountPublicKey
    , getAccountPublicKey
    , postSharedWallet
    , patchSharedWallet
    , mkSharedWallet
    , balanceTransaction
    , decodeTransaction
    , submitTransaction
    , getPolicyKey
    , postPolicyKey
    , postPolicyId
    , constructSharedTransaction
    , decodeSharedTransaction

    -- * Server error responses
    , IsServerError(..)
    , liftHandler
    , apiError

    -- * Internals
    , mkShelleyWallet
    , mkLegacyWallet
    , withLegacyLayer
    , withLegacyLayer'
    , rndStateChange
    , withWorkerCtx
    , getCurrentEpoch

    -- * Workers
    , manageRewardBalance
    , idleWorker

    -- * Logging
    , WalletEngineLog (..)
    ) where

import Prelude

import Cardano.Address.Derivation
    ( XPrv, XPub, xpubPublicKey, xpubToBytes )
import Cardano.Address.Script
    ( Cosigner (..)
    , ScriptTemplate (..)
    , ValidationLevel (..)
    , foldScript
    , validateScriptOfTemplate
    )
import Cardano.Api
    ( NetworkId, SerialiseAsCBOR (..), toNetworkMagic, unNetworkMagic )
import Cardano.Api.Extra
    ( asAnyShelleyBasedEra, inAnyCardanoEra, withShelleyBasedTx )
import Cardano.BM.Tracing
    ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
import Cardano.Ledger.Alonzo.TxInfo
    ( TranslationError (TimeTranslationPastHorizon, TranslationLogicMissingInput)
    )
import Cardano.Mnemonic
    ( SomeMnemonic )
import Cardano.Wallet
    ( ErrAddCosignerKey (..)
    , ErrBalanceTx (..)
    , ErrBalanceTxInternalError (..)
    , ErrCannotJoin (..)
    , ErrCannotQuit (..)
    , ErrConstructSharedWallet (..)
    , ErrConstructTx (..)
    , ErrCreateMigrationPlan (..)
    , ErrCreateRandomAddress (..)
    , ErrDecodeTx (..)
    , ErrDerivePublicKey (..)
    , ErrFetchRewards (..)
    , ErrGetPolicyId (..)
    , ErrGetTransaction (..)
    , ErrImportAddress (..)
    , ErrImportRandomAddress (..)
    , ErrInvalidDerivationIndex (..)
    , ErrListTransactions (..)
    , ErrListUTxOStatistics (..)
    , ErrMkTransaction (..)
    , ErrNoSuchTransaction (..)
    , ErrNoSuchWallet (..)
    , ErrNotASequentialWallet (..)
    , ErrPostTx (..)
    , ErrReadAccountPublicKey (..)
    , ErrReadPolicyPublicKey (..)
    , ErrReadRewardAccount (..)
    , ErrRemoveTx (..)
    , ErrSelectAssets (..)
    , ErrSignMetadataWith (..)
    , ErrSignPayment (..)
    , ErrStakePoolDelegation (..)
    , ErrStartTimeLaterThanEndTime (..)
    , ErrSubmitTransaction (..)
    , ErrSubmitTx (..)
    , ErrUpdatePassphrase (..)
    , ErrUpdateSealedTx (..)
    , ErrWalletAlreadyExists (..)
    , ErrWalletNotResponding (..)
    , ErrWithRootKey (..)
    , ErrWithdrawalNotWorth (..)
    , ErrWitnessTx (..)
    , ErrWritePolicyPublicKey (..)
    , ErrWrongPassphrase (..)
    , FeeEstimation (..)
    , HasNetworkLayer
    , TxSubmitLog
    , genesisData
    , manageRewardBalance
    , networkLayer
    )
import Cardano.Wallet.Address.Book
    ( AddressBookIso )
import Cardano.Wallet.Api
    ( ApiLayer (..)
    , HasDBFactory
    , HasTokenMetadataClient
    , HasWorkerRegistry
    , WalletLock (..)
    , dbFactory
    , tokenMetadataClient
    , walletLocks
    , workerRegistry
    )
import Cardano.Wallet.Api.Server.Tls
    ( TlsConfiguration (..), requireClientAuth )
import Cardano.Wallet.Api.Types
    ( AccountPostData (..)
    , AddressAmount (..)
    , AddressAmountNoAssets (..)
    , ApiAccountPublicKey (..)
    , ApiActiveSharedWallet (..)
    , ApiAddress (..)
    , ApiAnyCertificate (..)
    , ApiAsArray (..)
    , ApiAsset (..)
    , ApiAssetMintBurn (..)
    , ApiBalanceTransactionPostData
    , ApiBlockInfo (..)
    , ApiBlockReference (..)
    , ApiBurnData (..)
    , ApiByronWallet (..)
    , ApiByronWalletBalance (..)
    , ApiBytesT (..)
    , ApiCertificate (..)
    , ApiCoinSelection (..)
    , ApiCoinSelectionChange (..)
    , ApiCoinSelectionCollateral (..)
    , ApiCoinSelectionOutput (..)
    , ApiCoinSelectionWithdrawal (..)
    , ApiConstructTransaction (..)
    , ApiConstructTransactionData (..)
    , ApiDecodedTransaction (..)
    , ApiDeregisterPool (..)
    , ApiEpochInfo (ApiEpochInfo)
    , ApiErrorCode (..)
    , ApiExternalCertificate (..)
    , ApiExternalInput (..)
    , ApiFee (..)
    , ApiForeignStakeKey (..)
    , ApiMintBurnData (..)
    , ApiMintBurnOperation (..)
    , ApiMintData (..)
    , ApiMnemonicT (..)
    , ApiMultiDelegationAction (..)
    , ApiNetworkClock (..)
    , ApiNetworkInformation
    , ApiNetworkParameters (..)
    , ApiNullStakeKey (..)
    , ApiOurStakeKey (..)
    , ApiPaymentDestination (..)
    , ApiPendingSharedWallet (..)
    , ApiPolicyId (..)
    , ApiPolicyKey (..)
    , ApiPoolId (..)
    , ApiPostAccountKeyDataWithPurpose (..)
    , ApiPostPolicyIdData
    , ApiPostPolicyKeyData (..)
    , ApiPostRandomAddressData (..)
    , ApiPutAddressesData (..)
    , ApiRedeemer (..)
    , ApiRegisterPool (..)
    , ApiScriptTemplateEntry (..)
    , ApiSelectCoinsPayments
    , ApiSerialisedTransaction (..)
    , ApiSharedWallet (..)
    , ApiSharedWalletPatchData (..)
    , ApiSharedWalletPostData (..)
    , ApiSharedWalletPostDataFromAccountPubX (..)
    , ApiSharedWalletPostDataFromMnemonics (..)
    , ApiSignTransactionPostData (..)
    , ApiSlotId (..)
    , ApiSlotReference (..)
    , ApiStakeKeyIndex (..)
    , ApiStakeKeys (..)
    , ApiT (..)
    , ApiTokenAmountFingerprint (..)
    , ApiTokens (..)
    , ApiTransaction (..)
    , ApiTxCollateral (..)
    , ApiTxId (..)
    , ApiTxInput (..)
    , ApiTxInputGeneral (..)
    , ApiTxMetadata (..)
    , ApiTxOutputGeneral (..)
    , ApiUtxoStatistics (..)
    , ApiValidityBound (..)
    , ApiValidityInterval (..)
    , ApiWallet (..)
    , ApiWalletAssetsBalance (..)
    , ApiWalletBalance (..)
    , ApiWalletDelegation (..)
    , ApiWalletDelegationNext (..)
    , ApiWalletDelegationStatus (..)
    , ApiWalletInput (..)
    , ApiWalletMigrationBalance (..)
    , ApiWalletMigrationPlan (..)
    , ApiWalletMigrationPlanPostData (..)
    , ApiWalletMigrationPostData (..)
    , ApiWalletMode (..)
    , ApiWalletOutput (..)
    , ApiWalletPassphrase (..)
    , ApiWalletPassphraseInfo (..)
    , ApiWalletSignData (..)
    , ApiWalletUtxoSnapshot (..)
    , ApiWalletUtxoSnapshotEntry (..)
    , ApiWithdrawal (..)
    , ApiWithdrawalGeneral (..)
    , ApiWithdrawalPostData (..)
    , ByronWalletFromXPrvPostData
    , ByronWalletPostData (..)
    , ByronWalletPutPassphraseData (..)
    , Iso8601Time (..)
    , KeyFormat (..)
    , KnownDiscovery (..)
    , MinWithdrawal (..)
    , PostTransactionFeeOldData (..)
    , PostTransactionOldData (..)
    , ResourceContext (..)
    , VerificationKeyHashing (..)
    , WalletOrAccountPostData (..)
    , WalletPostData (..)
    , WalletPutData (..)
    , WalletPutPassphraseData (..)
    , XPubOrSelf (..)
    , coinFromQuantity
    , coinToQuantity
    , getApiMnemonicT
    , toApiAsset
    , toApiEpochInfo
    , toApiEra
    , toApiNetworkParameters
    , toApiUtxoStatistics
    )
import Cardano.Wallet.Api.Types.SchemaMetadata
    ( TxMetadataSchema (..), TxMetadataWithSchema (TxMetadataWithSchema) )
import Cardano.Wallet.CoinSelection
    ( SelectionBalanceError (..)
    , SelectionCollateralError
    , SelectionError (..)
    , SelectionOf (..)
    , SelectionOutputCoinInsufficientError (..)
    , SelectionOutputError (..)
    , SelectionOutputSizeExceedsLimitError (..)
    , SelectionOutputTokenQuantityExceedsLimitError (..)
    , SelectionStrategy (..)
    , WalletSelectionContext
    , balanceMissing
    , selectionDelta
    , shortfall
    )
import Cardano.Wallet.Compat
    ( (^?) )
import Cardano.Wallet.DB
    ( DBFactory (..) )
import Cardano.Wallet.Network
    ( NetworkLayer (..), fetchRewardAccountBalances, timeInterpreter )
import Cardano.Wallet.Primitive.AddressDerivation
    ( BoundedAddressLength (..)
    , DelegationAddress (..)
    , Depth (..)
    , DerivationIndex (..)
    , DerivationType (..)
    , HardDerivation (..)
    , Index (..)
    , MkKeyFingerprint
    , NetworkDiscriminant (..)
    , PaymentAddress (..)
    , RewardAccount (..)
    , Role
    , SoftDerivation (..)
    , WalletKey (..)
    , deriveRewardAccount
    , digest
    , publicKey
    )
import Cardano.Wallet.Primitive.AddressDerivation.Byron
    ( ByronKey, mkByronKeyFromMasterKey )
import Cardano.Wallet.Primitive.AddressDerivation.Icarus
    ( IcarusKey )
import Cardano.Wallet.Primitive.AddressDerivation.MintBurn
    ( scriptSlotIntervals
    , toTokenMapAndScript
    , toTokenPolicyId
    , withinSlotInterval
    )
import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
    ( SharedKey (..) )
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
    ( ShelleyKey )
import Cardano.Wallet.Primitive.AddressDiscovery
    ( CompareDiscovery
    , GenChange (ArgGenChange)
    , GetAccount
    , GetPurpose (..)
    , IsOurs
    , IsOwned
    , KnownAddresses
    , MaybeLight
    , isOwned
    )
import Cardano.Wallet.Primitive.AddressDiscovery.Random
    ( RndState, mkRndState )
import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
    ( DerivationPrefix (..)
    , SeqState (..)
    , defaultAddressPoolGap
    , getGap
    , mkSeqStateFromAccountXPub
    , mkSeqStateFromRootXPrv
    , purposeCIP1852
    )
import Cardano.Wallet.Primitive.AddressDiscovery.Shared
    ( CredentialType (..)
    , ErrAddCosigner (..)
    , ErrScriptTemplate (..)
    , SharedState (..)
    , mkSharedStateFromAccountXPub
    , mkSharedStateFromRootXPrv
    , toSharedWalletId
    , validateScriptTemplates
    )
import Cardano.Wallet.Primitive.Delegation.UTxO
    ( stakeKeyCoinDistr )
import Cardano.Wallet.Primitive.Migration
    ( MigrationPlan (..) )
import Cardano.Wallet.Primitive.Model
    ( Wallet
    , availableBalance
    , availableUTxO
    , currentTip
    , getState
    , totalBalance
    , totalUTxO
    )
import Cardano.Wallet.Primitive.Passphrase
    ( Passphrase (..)
    , PassphraseScheme (..)
    , WalletPassphraseInfo (..)
    , currentPassphraseScheme
    , preparePassphrase
    )
import Cardano.Wallet.Primitive.Slotting
    ( PastHorizonException
    , RelativeTime
    , TimeInterpreter
    , currentEpoch
    , currentRelativeTime
    , expectAndThrowFailures
    , hoistTimeInterpreter
    , interpretQuery
    , neverFails
    , ongoingSlotAt
    , slotToUTCTime
    , snapshot
    , timeOfEpoch
    , toSlotId
    , unsafeExtendSafeZone
    )
import Cardano.Wallet.Primitive.SyncProgress
    ( SyncProgress (..) )
import Cardano.Wallet.Primitive.Types
    ( Block
    , BlockHeader (..)
    , NetworkParameters (..)
    , PoolId
    , PoolLifeCycleStatus (..)
    , Signature (..)
    , SlotId
    , SlotNo (..)
    , SortOrder (..)
    , WalletId (..)
    , WalletMetadata (..)
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..), AddressState (..) )
import Cardano.Wallet.Primitive.Types.Coin
    ( Coin (..) )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash (..) )
import Cardano.Wallet.Primitive.Types.Redeemer
    ( Redeemer (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( Flat (..), TokenBundle (..) )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId (..), fromFlatList, toNestedList )
import Cardano.Wallet.Primitive.Types.TokenPolicy
    ( TokenName (..)
    , TokenPolicyId (..)
    , mkTokenFingerprint
    , nullTokenName
    , tokenNameMaxLength
    )
import Cardano.Wallet.Primitive.Types.TokenQuantity
    ( TokenQuantity (..) )
import Cardano.Wallet.Primitive.Types.Tx
    ( TransactionInfo
    , Tx (..)
    , TxChange (..)
    , TxIn (..)
    , TxOut (..)
    , TxStatus (..)
    , UnsignedTx (..)
    , cardanoTxIdeallyNoLaterThan
    , getSealedTxWitnesses
    , txMintBurnMaxTokenQuantity
    , txOutCoin
    )
import Cardano.Wallet.Registry
    ( HasWorkerCtx (..)
    , MkWorker (..)
    , WorkerLog (..)
    , defaultWorkerAfter
    , workerResource
    )
import Cardano.Wallet.TokenMetadata
    ( TokenMetadataClient, fillMetadata )
import Cardano.Wallet.Transaction
    ( DelegationAction (..)
    , ErrAssignRedeemers (..)
    , ErrSignTx (..)
    , TokenMapWithScripts (..)
    , TransactionCtx (..)
    , TransactionLayer (..)
    , Withdrawal (..)
    , defaultTransactionCtx
    )
import Cardano.Wallet.Unsafe
    ( unsafeRunExceptT )
import Cardano.Wallet.Util
    ( invariant )
import Control.Arrow
    ( second, (&&&) )
import Control.DeepSeq
    ( NFData )
import Control.Error.Util
    ( failWith )
import Control.Monad
    ( forM, forever, join, void, when, (>=>) )
import Control.Monad.IO.Class
    ( MonadIO, liftIO )
import Control.Monad.Trans.Except
    ( ExceptT (..), mapExceptT, runExceptT, throwE, withExceptT )
import Control.Monad.Trans.Maybe
    ( MaybeT (..), exceptToMaybeT )
import Control.Tracer
    ( Tracer, contramap )
import Crypto.Hash.Utils
    ( blake2b224 )
import Data.Aeson
    ( (.=) )
import Data.ByteString
    ( ByteString )
import Data.Coerce
    ( coerce )
import Data.Either
    ( isLeft )
import Data.Either.Extra
    ( eitherToMaybe )
import Data.Function
    ( (&) )
import Data.Functor
    ( (<&>) )
import Data.Functor.Identity
    ( Identity (..) )
import Data.Generics.Internal.VL.Lens
    ( Lens', view, (.~), (^.) )
import Data.Generics.Labels
    ()
import Data.List
    ( isInfixOf, isPrefixOf, isSubsequenceOf, sortOn, (\\) )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( catMaybes
    , fromJust
    , fromMaybe
    , isJust
    , isNothing
    , mapMaybe
    , maybeToList
    )
import Data.Proxy
    ( Proxy (..) )
import Data.Quantity
    ( Quantity (..) )
import Data.Set
    ( Set )
import Data.Streaming.Network
    ( HostPreference, bindPortTCP, bindRandomPortTCP )
import Data.Text
    ( Text )
import Data.Text.Class
    ( FromText (..), ToText (..) )
import Data.Time
    ( UTCTime )
import Data.Type.Equality
    ( (:~:) (..), type (==), testEquality )
import Data.Word
    ( Word32 )
import Fmt
    ( listF, pretty )
import GHC.Generics
    ( Generic )
import GHC.Stack
    ( HasCallStack )
import Network.HTTP.Media.RenderHeader
    ( renderHeader )
import Network.HTTP.Types.Header
    ( hContentType )
import Network.Ntp
    ( NtpClient, getNtpStatus )
import Network.Socket
    ( Socket, close )
import Network.Wai
    ( Request, pathInfo )
import Network.Wai.Handler.Warp
    ( Port )
import Network.Wai.Middleware.Logging
    ( ApiLog (..), newApiLoggerSettings, obfuscateKeys, withApiLogger )
import Network.Wai.Middleware.ServerError
    ( handleRawError )
import Numeric.Natural
    ( Natural )
import Servant
    ( Application
    , JSON
    , NoContent (..)
    , contentType
    , err400
    , err403
    , err404
    , err409
    , err500
    , err501
    , err503
    , serve
    )
import Servant.Server
    ( Handler (..), ServerError (..), runHandler )
import System.IO.Error
    ( ioeGetErrorType
    , isAlreadyInUseError
    , isDoesNotExistError
    , isPermissionError
    , isUserError
    )
import System.Random
    ( getStdRandom, random )
import Type.Reflection
    ( Typeable, typeRep )
import UnliftIO.Async
    ( race_ )
import UnliftIO.Concurrent
    ( threadDelay )
import UnliftIO.Exception
    ( IOException, bracket, throwIO, tryAnyDeep, tryJust )

import qualified Cardano.Api as Cardano
import qualified Cardano.Wallet as W
import qualified Cardano.Wallet.Api.Types as Api
import qualified Cardano.Wallet.DB as W
import qualified Cardano.Wallet.Network as NW
import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron
import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus
import qualified Cardano.Wallet.Primitive.AddressDiscovery.Shared as Shared
import qualified Cardano.Wallet.Primitive.Types as W
import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Cardano.Wallet.Primitive.Types.Tx as W
import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO
import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
import qualified Cardano.Wallet.Registry as Registry
import qualified Control.Concurrent.Concierge as Concierge
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WarpTLS as Warp

-- | How the server should listen for incoming requests.
data Listen
    = ListenOnPort Port
      -- ^ Listen on given TCP port
    | ListenOnRandomPort
      -- ^ Listen on an unused TCP port, selected at random
    deriving (Int -> Listen -> ShowS
[Listen] -> ShowS
Listen -> String
(Int -> Listen -> ShowS)
-> (Listen -> String) -> ([Listen] -> ShowS) -> Show Listen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Listen] -> ShowS
$cshowList :: [Listen] -> ShowS
show :: Listen -> String
$cshow :: Listen -> String
showsPrec :: Int -> Listen -> ShowS
$cshowsPrec :: Int -> Listen -> ShowS
Show, Listen -> Listen -> Bool
(Listen -> Listen -> Bool)
-> (Listen -> Listen -> Bool) -> Eq Listen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Listen -> Listen -> Bool
$c/= :: Listen -> Listen -> Bool
== :: Listen -> Listen -> Bool
$c== :: Listen -> Listen -> Bool
Eq)

-- | Start the application server, using the given settings and a bound socket.
start
    :: Warp.Settings
    -> Tracer IO ApiLog
    -> Maybe TlsConfiguration
    -> Socket
    -> Application
    -> IO ()
start :: Settings
-> Tracer IO ApiLog
-> Maybe TlsConfiguration
-> Socket
-> Application
-> IO ()
start Settings
settings Tracer IO ApiLog
tr Maybe TlsConfiguration
tlsConfig Socket
socket Application
application = do
    ApiLoggerSettings
logSettings <- IO ApiLoggerSettings
newApiLoggerSettings IO ApiLoggerSettings
-> (ApiLoggerSettings -> ApiLoggerSettings) -> IO ApiLoggerSettings
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Request -> [Text]) -> ApiLoggerSettings -> ApiLoggerSettings
obfuscateKeys ([Text] -> Request -> [Text]
forall a b. a -> b -> a
const [Text]
sensitive)
    Application -> IO ()
runSocket
        (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$ (Request -> ServerError -> ServerError) -> Middleware
handleRawError (((Request, ServerError) -> ServerError)
-> Request -> ServerError -> ServerError
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Request, ServerError) -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError)
        Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ Tracer IO ApiLog -> ApiLoggerSettings -> Middleware
withApiLogger Tracer IO ApiLog
tr ApiLoggerSettings
logSettings
        Application
application
  where
    runSocket :: Application -> IO ()
    runSocket :: Application -> IO ()
runSocket = case Maybe TlsConfiguration
tlsConfig of
        Maybe TlsConfiguration
Nothing  -> Settings -> Socket -> Application -> IO ()
Warp.runSettingsSocket Settings
settings Socket
socket
        Just TlsConfiguration
tls -> TLSSettings -> Settings -> Socket -> Application -> IO ()
Warp.runTLSSocket (TlsConfiguration -> TLSSettings
requireClientAuth TlsConfiguration
tls) Settings
settings Socket
socket

    sensitive :: [Text]
    sensitive :: [Text]
sensitive =
        [ Text
"passphrase"
        , Text
"old_passphrase"
        , Text
"new_passphrase"
        , Text
"mnemonic_sentence"
        , Text
"mnemonic_second_factor"
        ]

-- | Run an action with a TCP socket bound to a port specified by the `Listen`
-- parameter.
withListeningSocket
    :: HostPreference
    -- ^ Which host to bind.
    -> Listen
    -- ^ Whether to listen on a given port, or random port.
    -> (Either ListenError (Port, Socket) -> IO a)
    -- ^ Action to run with listening socket.
    -> IO a
withListeningSocket :: HostPreference
-> Listen -> (Either ListenError (Int, Socket) -> IO a) -> IO a
withListeningSocket HostPreference
hostPreference Listen
portOpt = IO (Either ListenError (Int, Socket))
-> (Either ListenError (Int, Socket) -> IO ())
-> (Either ListenError (Int, Socket) -> IO a)
-> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO (Either ListenError (Int, Socket))
acquire Either ListenError (Int, Socket) -> IO ()
forall (m :: * -> *) a a. MonadIO m => Either a (a, Socket) -> m ()
release
  where
    acquire :: IO (Either ListenError (Int, Socket))
acquire = (IOException -> Maybe ListenError)
-> IO (Int, Socket) -> IO (Either ListenError (Int, Socket))
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust IOException -> Maybe ListenError
handleErr IO (Int, Socket)
bindAndListen
    -- Note: These Data.Streaming.Network functions also listen on the socket,
    -- even though their name just says "bind".
    bindAndListen :: IO (Int, Socket)
bindAndListen = case Listen
portOpt of
        ListenOnPort Int
port -> (Int
port,) (Socket -> (Int, Socket)) -> IO Socket -> IO (Int, Socket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> HostPreference -> IO Socket
bindPortTCP Int
port HostPreference
hostPreference
        Listen
ListenOnRandomPort -> HostPreference -> IO (Int, Socket)
bindRandomPortTCP HostPreference
hostPreference
    release :: Either a (a, Socket) -> m ()
release (Right (a
_, Socket
socket)) = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
close Socket
socket
    release (Left a
_) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    handleErr :: IOException -> Maybe ListenError
handleErr = HostPreference -> Listen -> IOException -> Maybe ListenError
ioToListenError HostPreference
hostPreference Listen
portOpt

data ListenError
    = ListenErrorAddressAlreadyInUse (Maybe Port)
    | ListenErrorOperationNotPermitted
    | ListenErrorHostDoesNotExist HostPreference
    | ListenErrorInvalidAddress HostPreference
    deriving (Int -> ListenError -> ShowS
[ListenError] -> ShowS
ListenError -> String
(Int -> ListenError -> ShowS)
-> (ListenError -> String)
-> ([ListenError] -> ShowS)
-> Show ListenError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListenError] -> ShowS
$cshowList :: [ListenError] -> ShowS
show :: ListenError -> String
$cshow :: ListenError -> String
showsPrec :: Int -> ListenError -> ShowS
$cshowsPrec :: Int -> ListenError -> ShowS
Show, ListenError -> ListenError -> Bool
(ListenError -> ListenError -> Bool)
-> (ListenError -> ListenError -> Bool) -> Eq ListenError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListenError -> ListenError -> Bool
$c/= :: ListenError -> ListenError -> Bool
== :: ListenError -> ListenError -> Bool
$c== :: ListenError -> ListenError -> Bool
Eq)

ioToListenError :: HostPreference -> Listen -> IOException -> Maybe ListenError
ioToListenError :: HostPreference -> Listen -> IOException -> Maybe ListenError
ioToListenError HostPreference
hostPreference Listen
portOpt IOException
e
    -- A socket is already listening on that address and port
    | IOException -> Bool
isAlreadyInUseError IOException
e =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (Maybe Int -> ListenError
ListenErrorAddressAlreadyInUse (Listen -> Maybe Int
listenPort Listen
portOpt))
    -- Usually caused by trying to listen on a privileged port
    | IOException -> Bool
isPermissionError IOException
e =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just ListenError
ListenErrorOperationNotPermitted
    -- Bad hostname -- Linux and Darwin
    | IOException -> Bool
isDoesNotExistError IOException
e =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (HostPreference -> ListenError
ListenErrorHostDoesNotExist HostPreference
hostPreference)
    -- Bad hostname -- Windows
    -- WSAHOST_NOT_FOUND, WSATRY_AGAIN, or bind: WSAEOPNOTSUPP
    | IOException -> Bool
isUserError IOException
e Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
hasDescription [String
"11001", String
"11002", String
"10045"] =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (HostPreference -> ListenError
ListenErrorHostDoesNotExist HostPreference
hostPreference)
    -- Address is valid, but can't be used for listening -- Linux
    | IOErrorType -> String
forall a. Show a => a -> String
show (IOException -> IOErrorType
ioeGetErrorType IOException
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"invalid argument" =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (HostPreference -> ListenError
ListenErrorInvalidAddress HostPreference
hostPreference)
    -- Address is valid, but can't be used for listening -- Darwin
    | IOErrorType -> String
forall a. Show a => a -> String
show (IOException -> IOErrorType
ioeGetErrorType IOException
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"unsupported operation" =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (HostPreference -> ListenError
ListenErrorInvalidAddress HostPreference
hostPreference)
    -- Address is valid, but can't be used for listening -- Windows
    | IOException -> Bool
isOtherError IOException
e Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
hasDescription [String
"WSAEINVAL", String
"WSAEADDRNOTAVAIL"] =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (HostPreference -> ListenError
ListenErrorInvalidAddress HostPreference
hostPreference)
    -- Listening on an unavailable or privileged port -- Windows
    | IOException -> Bool
isOtherError IOException
e Bool -> Bool -> Bool
&& String -> Bool
hasDescription String
"WSAEACCESS" =
        ListenError -> Maybe ListenError
forall a. a -> Maybe a
Just (Maybe Int -> ListenError
ListenErrorAddressAlreadyInUse (Listen -> Maybe Int
listenPort Listen
portOpt))
    | Bool
otherwise =
        Maybe ListenError
forall a. Maybe a
Nothing
  where
    listenPort :: Listen -> Maybe Int
listenPort (ListenOnPort Int
port) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
port
    listenPort Listen
ListenOnRandomPort = Maybe Int
forall a. Maybe a
Nothing

    isOtherError :: IOException -> Bool
isOtherError IOException
ex = IOErrorType -> String
forall a. Show a => a -> String
show (IOException -> IOErrorType
ioeGetErrorType IOException
ex) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"failed"
    hasDescription :: String -> Bool
hasDescription String
text = String
text String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` IOException -> String
forall a. Show a => a -> String
show IOException
e

{-------------------------------------------------------------------------------
                              Wallet Constructors
-------------------------------------------------------------------------------}

type MkApiWallet ctx s w
    =  ctx
    -> WalletId
    -> Wallet s
    -> WalletMetadata
    -> Set Tx
    -> SyncProgress
    -> Handler w

--------------------- Shelley
postWallet
    :: forall ctx s k n.
        ( s ~ SeqState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasDBFactory s k ctx
        , HasWorkerRegistry s k ctx
        , IsOurs s RewardAccount
        , Typeable s
        , Typeable n
        , (k == SharedKey) ~ 'False
        , AddressBookIso s
        , MaybeLight s
        )
    => ctx
    -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
    -> (XPub -> k 'AccountK XPub)
    -> WalletOrAccountPostData
    -> Handler ApiWallet
postWallet :: ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> (XPub -> k 'AccountK XPub)
-> WalletOrAccountPostData
-> Handler ApiWallet
postWallet ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey XPub -> k 'AccountK XPub
liftKey (WalletOrAccountPostData Either WalletPostData AccountPostData
body) = case Either WalletPostData AccountPostData
body of
    Left  WalletPostData
body' ->
        ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> WalletPostData
-> Handler ApiWallet
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(s ~ SeqState n k, ctx ~ ApiLayer s k, SoftDerivation k,
 MkKeyFingerprint k (Proxy n, k 'AddressK XPub),
 MkKeyFingerprint k Address, WalletKey k, HasDBFactory s k ctx,
 HasWorkerRegistry s k ctx, IsOurs s RewardAccount, MaybeLight s,
 Typeable s, Typeable n, (k == SharedKey) ~ 'False,
 AddressBookIso s) =>
ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> WalletPostData
-> Handler ApiWallet
postShelleyWallet ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey WalletPostData
body'
    Right AccountPostData
body' ->
        ctx
-> MkApiWallet ctx (SeqState n k) ApiWallet
-> (XPub -> k 'AccountK XPub)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> AccountPostData
-> Handler ApiWallet
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant) w.
(s ~ SeqState n k, ctx ~ ApiLayer s k, SoftDerivation k,
 MkKeyFingerprint k (Proxy n, k 'AddressK XPub),
 MkKeyFingerprint k Address, WalletKey k, HasWorkerRegistry s k ctx,
 IsOurs s RewardAccount, MaybeLight s, (k == SharedKey) ~ 'False,
 Typeable n, AddressBookIso s) =>
ctx
-> MkApiWallet ctx s w
-> (XPub -> k 'AccountK XPub)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> AccountPostData
-> Handler w
postAccountWallet ctx
ctx MkApiWallet ctx (SeqState n k) ApiWallet
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SeqState n k, IsOurs s Address,
 IsOurs s RewardAccount, HasWorkerRegistry s k ctx) =>
MkApiWallet ctx s ApiWallet
mkShelleyWallet XPub -> k 'AccountK XPub
liftKey
            (Proxy n -> WalletLayer IO (SeqState n k) k -> WalletId -> IO ()
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasLogger IO WalletWorkerLog ctx, HasNetworkLayer IO ctx,
 HasDBLayer IO s k ctx, Typeable s, Typeable n) =>
Proxy n -> ctx -> WalletId -> IO ()
W.manageRewardBalance @_ @s @k (Proxy n
forall k (t :: k). Proxy t
Proxy @n)) AccountPostData
body'

postShelleyWallet
    :: forall ctx s k n.
        ( s ~ SeqState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasDBFactory s k ctx
        , HasWorkerRegistry s k ctx
        , IsOurs s RewardAccount
        , MaybeLight s
        , Typeable s
        , Typeable n
        , (k == SharedKey) ~ 'False
        , AddressBookIso s
        )
    => ctx
    -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
    -> WalletPostData
    -> Handler ApiWallet
postShelleyWallet :: ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> WalletPostData
-> Handler ApiWallet
postShelleyWallet ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey WalletPostData
body = do
    let state :: SeqState n k
state = (k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
(WalletKey k, SupportsDiscovery n k, (k == SharedKey) ~ 'False) =>
(k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'PurposeK -> AddressPoolGap -> SeqState n k
mkSeqStateFromRootXPrv (k 'RootK XPrv
rootXPrv, Passphrase "encryption"
pwdP) Index 'Hardened 'PurposeK
purposeCIP1852 AddressPoolGap
g
    Handler WalletId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler WalletId -> Handler ()) -> Handler WalletId -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateWallet IO WalletId -> Handler WalletId)
-> ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall a b. (a -> b) -> a -> b
$ ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker @_ @s @k ctx
ctx WalletId
wid
        (\WorkerCtx ctx
wrk -> WorkerCtx ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx (m :: * -> *) s (k :: Depth -> * -> *).
(MonadUnliftIO m, MonadTime m, HasGenesisData ctx,
 HasDBLayer m s k ctx, IsOurs s Address, IsOurs s RewardAccount) =>
ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists m WalletId
W.createWallet @(WorkerCtx ctx) @_ @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName s
SeqState n k
state)
        (\WorkerCtx ctx
wrk WalletId
_ -> Proxy n -> WorkerCtx ctx -> WalletId -> IO ()
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasLogger IO WalletWorkerLog ctx, HasNetworkLayer IO ctx,
 HasDBLayer IO s k ctx, Typeable s, Typeable n) =>
Proxy n -> ctx -> WalletId -> IO ()
W.manageRewardBalance @(WorkerCtx ctx) @s @k (Proxy n
forall k (t :: k). Proxy t
Proxy @n) WorkerCtx ctx
wrk WalletId
wid)
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO () -> Handler ())
-> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO (SeqState n k) k
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrNoSuchWallet IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrNoSuchWallet IO ()
W.attachPrivateKeyFromPwd @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid (k 'RootK XPrv
rootXPrv, Passphrase "user"
pwd)
    (ApiWallet, UTCTime) -> ApiWallet
forall a b. (a, b) -> a
fst ((ApiWallet, UTCTime) -> ApiWallet)
-> Handler (ApiWallet, UTCTime) -> Handler ApiWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx s ApiWallet
-> ApiT WalletId
-> Handler (ApiWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx (forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SeqState n k, IsOurs s Address,
 IsOurs s RewardAccount, HasWorkerRegistry s k ctx) =>
MkApiWallet ctx s ApiWallet
forall (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SeqState n k, IsOurs s Address,
 IsOurs s RewardAccount, HasWorkerRegistry s k ctx) =>
MkApiWallet ctx s ApiWallet
mkShelleyWallet @_ @s @k) (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    seed :: SomeMnemonic
seed = ApiMnemonicT '[15, 18, 21, 24] -> SomeMnemonic
forall (sizes :: [Nat]). ApiMnemonicT sizes -> SomeMnemonic
getApiMnemonicT (WalletPostData
body WalletPostData
-> ((ApiMnemonicT '[15, 18, 21, 24]
     -> Const
          (ApiMnemonicT '[15, 18, 21, 24]) (ApiMnemonicT '[15, 18, 21, 24]))
    -> WalletPostData
    -> Const (ApiMnemonicT '[15, 18, 21, 24]) WalletPostData)
-> ApiMnemonicT '[15, 18, 21, 24]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSentence"
  ((ApiMnemonicT '[15, 18, 21, 24]
    -> Const
         (ApiMnemonicT '[15, 18, 21, 24]) (ApiMnemonicT '[15, 18, 21, 24]))
   -> WalletPostData
   -> Const (ApiMnemonicT '[15, 18, 21, 24]) WalletPostData)
(ApiMnemonicT '[15, 18, 21, 24]
 -> Const
      (ApiMnemonicT '[15, 18, 21, 24]) (ApiMnemonicT '[15, 18, 21, 24]))
-> WalletPostData
-> Const (ApiMnemonicT '[15, 18, 21, 24]) WalletPostData
#mnemonicSentence)
    secondFactor :: Maybe SomeMnemonic
secondFactor = ApiMnemonicT '[9, 12] -> SomeMnemonic
forall (sizes :: [Nat]). ApiMnemonicT sizes -> SomeMnemonic
getApiMnemonicT (ApiMnemonicT '[9, 12] -> SomeMnemonic)
-> Maybe (ApiMnemonicT '[9, 12]) -> Maybe SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WalletPostData
body WalletPostData
-> ((Maybe (ApiMnemonicT '[9, 12])
     -> Const
          (Maybe (ApiMnemonicT '[9, 12])) (Maybe (ApiMnemonicT '[9, 12])))
    -> WalletPostData
    -> Const (Maybe (ApiMnemonicT '[9, 12])) WalletPostData)
-> Maybe (ApiMnemonicT '[9, 12])
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSecondFactor"
  ((Maybe (ApiMnemonicT '[9, 12])
    -> Const
         (Maybe (ApiMnemonicT '[9, 12])) (Maybe (ApiMnemonicT '[9, 12])))
   -> WalletPostData
   -> Const (Maybe (ApiMnemonicT '[9, 12])) WalletPostData)
(Maybe (ApiMnemonicT '[9, 12])
 -> Const
      (Maybe (ApiMnemonicT '[9, 12])) (Maybe (ApiMnemonicT '[9, 12])))
-> WalletPostData
-> Const (Maybe (ApiMnemonicT '[9, 12])) WalletPostData
#mnemonicSecondFactor)
    pwd :: Passphrase "user"
pwd = ApiT (Passphrase "user") -> Passphrase "user"
forall a. ApiT a -> a
getApiT (WalletPostData
body WalletPostData
-> ((ApiT (Passphrase "user")
     -> Const (ApiT (Passphrase "user")) (ApiT (Passphrase "user")))
    -> WalletPostData
    -> Const (ApiT (Passphrase "user")) WalletPostData)
-> ApiT (Passphrase "user")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (ApiT (Passphrase "user")) (ApiT (Passphrase "user")))
   -> WalletPostData
   -> Const (ApiT (Passphrase "user")) WalletPostData)
(ApiT (Passphrase "user")
 -> Const (ApiT (Passphrase "user")) (ApiT (Passphrase "user")))
-> WalletPostData
-> Const (ApiT (Passphrase "user")) WalletPostData
#passphrase)
    pwdP :: Passphrase "encryption"
pwdP = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
pwd
    rootXPrv :: k 'RootK XPrv
rootXPrv = (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey (SomeMnemonic
seed, Maybe SomeMnemonic
secondFactor) Passphrase "encryption"
pwdP
    g :: AddressPoolGap
g = AddressPoolGap
-> (ApiT AddressPoolGap -> AddressPoolGap)
-> Maybe (ApiT AddressPoolGap)
-> AddressPoolGap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AddressPoolGap
defaultAddressPoolGap ApiT AddressPoolGap -> AddressPoolGap
forall a. ApiT a -> a
getApiT (WalletPostData
body WalletPostData
-> ((Maybe (ApiT AddressPoolGap)
     -> Const
          (Maybe (ApiT AddressPoolGap)) (Maybe (ApiT AddressPoolGap)))
    -> WalletPostData
    -> Const (Maybe (ApiT AddressPoolGap)) WalletPostData)
-> Maybe (ApiT AddressPoolGap)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "addressPoolGap"
  ((Maybe (ApiT AddressPoolGap)
    -> Const
         (Maybe (ApiT AddressPoolGap)) (Maybe (ApiT AddressPoolGap)))
   -> WalletPostData
   -> Const (Maybe (ApiT AddressPoolGap)) WalletPostData)
(Maybe (ApiT AddressPoolGap)
 -> Const
      (Maybe (ApiT AddressPoolGap)) (Maybe (ApiT AddressPoolGap)))
-> WalletPostData
-> Const (Maybe (ApiT AddressPoolGap)) WalletPostData
#addressPoolGap)
    wid :: WalletId
wid = Digest Blake2b_160 -> WalletId
WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ k 'RootK XPub -> Digest Blake2b_160
forall (key :: Depth -> * -> *) a (depth :: Depth).
(WalletKey key, HashAlgorithm a) =>
key depth XPub -> Digest a
digest (k 'RootK XPub -> Digest Blake2b_160)
-> k 'RootK XPub -> Digest Blake2b_160
forall a b. (a -> b) -> a -> b
$ k 'RootK XPrv -> k 'RootK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey k 'RootK XPrv
rootXPrv
    wName :: WalletName
wName = ApiT WalletName -> WalletName
forall a. ApiT a -> a
getApiT (WalletPostData
body WalletPostData
-> ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
    -> WalletPostData -> Const (ApiT WalletName) WalletPostData)
-> ApiT WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
   -> WalletPostData -> Const (ApiT WalletName) WalletPostData)
(ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
-> WalletPostData -> Const (ApiT WalletName) WalletPostData
#name)

postAccountWallet
    :: forall ctx s k n w.
        ( s ~ SeqState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasWorkerRegistry s k ctx
        , IsOurs s RewardAccount
        , MaybeLight s
        , (k == SharedKey) ~ 'False
        , Typeable n
        , AddressBookIso s
        )
    => ctx
    -> MkApiWallet ctx s w
    -> (XPub -> k 'AccountK XPub)
    -> (WorkerCtx ctx -> WalletId -> IO ())
        -- ^ Action to run concurrently with restore action
    -> AccountPostData
    -> Handler w
postAccountWallet :: ctx
-> MkApiWallet ctx s w
-> (XPub -> k 'AccountK XPub)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> AccountPostData
-> Handler w
postAccountWallet ctx
ctx MkApiWallet ctx s w
mkWallet XPub -> k 'AccountK XPub
liftKey WorkerCtx ctx -> WalletId -> IO ()
coworker AccountPostData
body = do
    let state :: SeqState n k
state = k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> Index 'Hardened 'PurposeK
-> AddressPoolGap
-> SeqState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
(SupportsDiscovery n k, (k == SharedKey) ~ 'False) =>
k 'AccountK XPub
-> Maybe (k 'PolicyK XPub)
-> Index 'Hardened 'PurposeK
-> AddressPoolGap
-> SeqState n k
mkSeqStateFromAccountXPub
            (XPub -> k 'AccountK XPub
liftKey XPub
accXPub) Maybe (k 'PolicyK XPub)
forall a. Maybe a
Nothing Index 'Hardened 'PurposeK
purposeCIP1852 AddressPoolGap
g
    Handler WalletId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler WalletId -> Handler ()) -> Handler WalletId -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateWallet IO WalletId -> Handler WalletId)
-> ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall a b. (a -> b) -> a -> b
$ ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker @_ @s @k ctx
ctx WalletId
wid
        (\WorkerCtx ctx
wrk -> WorkerCtx ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx (m :: * -> *) s (k :: Depth -> * -> *).
(MonadUnliftIO m, MonadTime m, HasGenesisData ctx,
 HasDBLayer m s k ctx, IsOurs s Address, IsOurs s RewardAccount) =>
ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists m WalletId
W.createWallet @(WorkerCtx ctx) @_ @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName s
SeqState n k
state)
        WorkerCtx ctx -> WalletId -> IO ()
coworker
    (w, UTCTime) -> w
forall a b. (a, b) -> a
fst ((w, UTCTime) -> w) -> Handler (w, UTCTime) -> Handler w
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx -> MkApiWallet ctx s w -> ApiT WalletId -> Handler (w, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx MkApiWallet ctx s w
mkWallet (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    g :: AddressPoolGap
g = AddressPoolGap
-> (ApiT AddressPoolGap -> AddressPoolGap)
-> Maybe (ApiT AddressPoolGap)
-> AddressPoolGap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AddressPoolGap
defaultAddressPoolGap ApiT AddressPoolGap -> AddressPoolGap
forall a. ApiT a -> a
getApiT (AccountPostData
body AccountPostData
-> ((Maybe (ApiT AddressPoolGap)
     -> Const
          (Maybe (ApiT AddressPoolGap)) (Maybe (ApiT AddressPoolGap)))
    -> AccountPostData
    -> Const (Maybe (ApiT AddressPoolGap)) AccountPostData)
-> Maybe (ApiT AddressPoolGap)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "addressPoolGap"
  ((Maybe (ApiT AddressPoolGap)
    -> Const
         (Maybe (ApiT AddressPoolGap)) (Maybe (ApiT AddressPoolGap)))
   -> AccountPostData
   -> Const (Maybe (ApiT AddressPoolGap)) AccountPostData)
(Maybe (ApiT AddressPoolGap)
 -> Const
      (Maybe (ApiT AddressPoolGap)) (Maybe (ApiT AddressPoolGap)))
-> AccountPostData
-> Const (Maybe (ApiT AddressPoolGap)) AccountPostData
#addressPoolGap)
    wName :: WalletName
wName = ApiT WalletName -> WalletName
forall a. ApiT a -> a
getApiT (AccountPostData
body AccountPostData
-> ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
    -> AccountPostData -> Const (ApiT WalletName) AccountPostData)
-> ApiT WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
   -> AccountPostData -> Const (ApiT WalletName) AccountPostData)
(ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
-> AccountPostData -> Const (ApiT WalletName) AccountPostData
#name)
    (ApiAccountPublicKey ApiT XPub
accXPubApiT) =  AccountPostData
body AccountPostData
-> ((ApiAccountPublicKey
     -> Const ApiAccountPublicKey ApiAccountPublicKey)
    -> AccountPostData -> Const ApiAccountPublicKey AccountPostData)
-> ApiAccountPublicKey
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "accountPublicKey"
  ((ApiAccountPublicKey
    -> Const ApiAccountPublicKey ApiAccountPublicKey)
   -> AccountPostData -> Const ApiAccountPublicKey AccountPostData)
(ApiAccountPublicKey
 -> Const ApiAccountPublicKey ApiAccountPublicKey)
-> AccountPostData -> Const ApiAccountPublicKey AccountPostData
#accountPublicKey
    accXPub :: XPub
accXPub = ApiT XPub -> XPub
forall a. ApiT a -> a
getApiT ApiT XPub
accXPubApiT
    wid :: WalletId
wid = Digest Blake2b_160 -> WalletId
WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ k 'AccountK XPub -> Digest Blake2b_160
forall (key :: Depth -> * -> *) a (depth :: Depth).
(WalletKey key, HashAlgorithm a) =>
key depth XPub -> Digest a
digest (XPub -> k 'AccountK XPub
liftKey XPub
accXPub)

mkShelleyWallet
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , IsOurs s Address
        , IsOurs s RewardAccount
        , HasWorkerRegistry s k ctx
        )
    => MkApiWallet ctx s ApiWallet
mkShelleyWallet :: MkApiWallet ctx s ApiWallet
mkShelleyWallet ctx
ctx WalletId
wid Wallet s
cp WalletMetadata
meta Set Tx
pending SyncProgress
progress = do
    Coin
reward <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler Coin)
-> (ErrWalletNotResponding -> Handler Coin)
-> (WorkerCtx ctx -> Handler Coin)
-> Handler Coin
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler Coin
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler Coin
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler Coin) -> Handler Coin)
-> (WorkerCtx ctx -> Handler Coin) -> Handler Coin
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk ->
        -- never fails - returns zero if balance not found
        IO Coin -> Handler Coin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coin -> Handler Coin) -> IO Coin -> Handler Coin
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k -> WalletId -> IO Coin
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx -> WalletId -> IO Coin
W.fetchRewardBalance @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid

    let ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (NetworkLayer IO Block
 -> TimeInterpreter (ExceptT PastHorizonException IO))
-> NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer

    -- In the Shelley era of Byron;Shelley;Allegra toApiWalletDelegation using
    -- an unextended @ti@ will simply fail because of uncertainty about the next
    -- fork.
    --
    -- @unsafeExtendSafeZone@ performs the calculation as if no fork will occur.
    -- This should be fine because:
    -- 1. We expect the next few eras to have the same epoch length as Shelley
    -- 2. It shouldn't be the end of the world to return the wrong time.
    --
    -- But ultimately, we might want to make the uncertainty transparent to API
    -- users. TODO: ADP-575
    ApiWalletDelegation
apiDelegation <- IO ApiWalletDelegation -> Handler ApiWalletDelegation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiWalletDelegation -> Handler ApiWalletDelegation)
-> IO ApiWalletDelegation -> Handler ApiWalletDelegation
forall a b. (a -> b) -> a -> b
$ WalletDelegation -> TimeInterpreter IO -> IO ApiWalletDelegation
toApiWalletDelegation (WalletMetadata
meta WalletMetadata
-> ((WalletDelegation -> Const WalletDelegation WalletDelegation)
    -> WalletMetadata -> Const WalletDelegation WalletMetadata)
-> WalletDelegation
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegation"
  ((WalletDelegation -> Const WalletDelegation WalletDelegation)
   -> WalletMetadata -> Const WalletDelegation WalletMetadata)
(WalletDelegation -> Const WalletDelegation WalletDelegation)
-> WalletMetadata -> Const WalletDelegation WalletMetadata
#delegation)
        (TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
unsafeExtendSafeZone TimeInterpreter (ExceptT PastHorizonException IO)
ti)

    ApiBlockReference
tip' <- IO ApiBlockReference -> Handler ApiBlockReference
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiBlockReference -> Handler ApiBlockReference)
-> IO ApiBlockReference -> Handler ApiBlockReference
forall a b. (a -> b) -> a -> b
$ TimeInterpreter IO -> Wallet s -> IO ApiBlockReference
forall (m :: * -> *) s.
Monad m =>
TimeInterpreter m -> Wallet s -> m ApiBlockReference
getWalletTip
        (String
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
neverFails String
"getWalletTip wallet tip should be behind node tip" TimeInterpreter (ExceptT PastHorizonException IO)
ti)
        Wallet s
cp
    let available :: TokenBundle
available = Set Tx -> Wallet s -> TokenBundle
forall s. Set Tx -> Wallet s -> TokenBundle
availableBalance Set Tx
pending Wallet s
cp
    let total :: TokenBundle
total = Set Tx -> Coin -> Wallet s -> TokenBundle
forall s.
(IsOurs s Address, IsOurs s RewardAccount) =>
Set Tx -> Coin -> Wallet s -> TokenBundle
totalBalance Set Tx
pending Coin
reward Wallet s
cp
    ApiWallet -> Handler ApiWallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiWallet :: ApiT WalletId
-> ApiT AddressPoolGap
-> ApiWalletBalance
-> ApiWalletAssetsBalance
-> ApiWalletDelegation
-> ApiT WalletName
-> Maybe ApiWalletPassphraseInfo
-> ApiT SyncProgress
-> ApiBlockReference
-> ApiWallet
ApiWallet
        { $sel:addressPoolGap:ApiWallet :: ApiT AddressPoolGap
addressPoolGap = AddressPoolGap -> ApiT AddressPoolGap
forall a. a -> ApiT a
ApiT (AddressPoolGap -> ApiT AddressPoolGap)
-> AddressPoolGap -> ApiT AddressPoolGap
forall a b. (a -> b) -> a -> b
$ SeqAddressPool 'UtxoExternal k -> AddressPoolGap
forall (c :: Role) (k :: Depth -> * -> *).
SeqAddressPool c k -> AddressPoolGap
getGap (SeqAddressPool 'UtxoExternal k -> AddressPoolGap)
-> SeqAddressPool 'UtxoExternal k -> AddressPoolGap
forall a b. (a -> b) -> a -> b
$ Wallet s -> s
forall s. Wallet s -> s
getState Wallet s
cp s
-> ((SeqAddressPool 'UtxoExternal k
     -> Const
          (SeqAddressPool 'UtxoExternal k) (SeqAddressPool 'UtxoExternal k))
    -> s -> Const (SeqAddressPool 'UtxoExternal k) s)
-> SeqAddressPool 'UtxoExternal k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "externalPool"
  ((SeqAddressPool 'UtxoExternal k
    -> Const
         (SeqAddressPool 'UtxoExternal k) (SeqAddressPool 'UtxoExternal k))
   -> s -> Const (SeqAddressPool 'UtxoExternal k) s)
(SeqAddressPool 'UtxoExternal k
 -> Const
      (SeqAddressPool 'UtxoExternal k) (SeqAddressPool 'UtxoExternal k))
-> s -> Const (SeqAddressPool 'UtxoExternal k) s
#externalPool
        , $sel:balance:ApiWallet :: ApiWalletBalance
balance = ApiWalletBalance :: Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> ApiWalletBalance
ApiWalletBalance
            { $sel:available:ApiWalletBalance :: Quantity "lovelace" Natural
available = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (TokenBundle
available TokenBundle
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin)
            , $sel:total:ApiWalletBalance :: Quantity "lovelace" Natural
total = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (TokenBundle
total TokenBundle
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin)
            , $sel:reward:ApiWalletBalance :: Quantity "lovelace" Natural
reward = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
reward
            }
        , $sel:assets:ApiWallet :: ApiWalletAssetsBalance
assets = ApiWalletAssetsBalance :: ApiT TokenMap -> ApiT TokenMap -> ApiWalletAssetsBalance
ApiWalletAssetsBalance
            { $sel:available:ApiWalletAssetsBalance :: ApiT TokenMap
available = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenBundle
available TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
            , $sel:total:ApiWalletAssetsBalance :: ApiT TokenMap
total = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenBundle
total TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
            }
        , $sel:delegation:ApiWallet :: ApiWalletDelegation
delegation = ApiWalletDelegation
apiDelegation
        , $sel:id:ApiWallet :: ApiT WalletId
id = WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid
        , $sel:name:ApiWallet :: ApiT WalletName
name = WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT (WalletName -> ApiT WalletName) -> WalletName -> ApiT WalletName
forall a b. (a -> b) -> a -> b
$ WalletMetadata
meta WalletMetadata
-> ((WalletName -> Const WalletName WalletName)
    -> WalletMetadata -> Const WalletName WalletMetadata)
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((WalletName -> Const WalletName WalletName)
   -> WalletMetadata -> Const WalletName WalletMetadata)
(WalletName -> Const WalletName WalletName)
-> WalletMetadata -> Const WalletName WalletMetadata
#name
        , $sel:passphrase:ApiWallet :: Maybe ApiWalletPassphraseInfo
passphrase = UTCTime -> ApiWalletPassphraseInfo
ApiWalletPassphraseInfo
            (UTCTime -> ApiWalletPassphraseInfo)
-> Maybe UTCTime -> Maybe ApiWalletPassphraseInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WalletPassphraseInfo -> UTCTime)
-> Maybe WalletPassphraseInfo -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((UTCTime -> Const UTCTime UTCTime)
 -> WalletPassphraseInfo -> Const UTCTime WalletPassphraseInfo)
-> WalletPassphraseInfo -> UTCTime
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "lastUpdatedAt"
  ((UTCTime -> Const UTCTime UTCTime)
   -> WalletPassphraseInfo -> Const UTCTime WalletPassphraseInfo)
(UTCTime -> Const UTCTime UTCTime)
-> WalletPassphraseInfo -> Const UTCTime WalletPassphraseInfo
#lastUpdatedAt) (WalletMetadata
meta WalletMetadata
-> ((Maybe WalletPassphraseInfo
     -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
    -> WalletMetadata
    -> Const (Maybe WalletPassphraseInfo) WalletMetadata)
-> Maybe WalletPassphraseInfo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphraseInfo"
  ((Maybe WalletPassphraseInfo
    -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
   -> WalletMetadata
   -> Const (Maybe WalletPassphraseInfo) WalletMetadata)
(Maybe WalletPassphraseInfo
 -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
-> WalletMetadata
-> Const (Maybe WalletPassphraseInfo) WalletMetadata
#passphraseInfo)
        , $sel:state:ApiWallet :: ApiT SyncProgress
state = SyncProgress -> ApiT SyncProgress
forall a. a -> ApiT a
ApiT SyncProgress
progress
        , $sel:tip:ApiWallet :: ApiBlockReference
tip = ApiBlockReference
tip'
        }

toApiWalletDelegation
    :: W.WalletDelegation
    -> TimeInterpreter IO
    -> IO ApiWalletDelegation
toApiWalletDelegation :: WalletDelegation -> TimeInterpreter IO -> IO ApiWalletDelegation
toApiWalletDelegation W.WalletDelegation{WalletDelegationStatus
$sel:active:WalletDelegation :: WalletDelegation -> WalletDelegationStatus
active :: WalletDelegationStatus
active,[WalletDelegationNext]
$sel:next:WalletDelegation :: WalletDelegation -> [WalletDelegationNext]
next :: [WalletDelegationNext]
next} TimeInterpreter IO
ti = do
    [ApiWalletDelegationNext]
apiNext <- [WalletDelegationNext]
-> (WalletDelegationNext -> IO ApiWalletDelegationNext)
-> IO [ApiWalletDelegationNext]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [WalletDelegationNext]
next ((WalletDelegationNext -> IO ApiWalletDelegationNext)
 -> IO [ApiWalletDelegationNext])
-> (WalletDelegationNext -> IO ApiWalletDelegationNext)
-> IO [ApiWalletDelegationNext]
forall a b. (a -> b) -> a -> b
$ \W.WalletDelegationNext{WalletDelegationStatus
$sel:status:WalletDelegationNext :: WalletDelegationNext -> WalletDelegationStatus
status :: WalletDelegationStatus
status,EpochNo
$sel:changesAt:WalletDelegationNext :: WalletDelegationNext -> EpochNo
changesAt :: EpochNo
changesAt} -> do
        ApiEpochInfo
info <- TimeInterpreter IO -> Qry ApiEpochInfo -> IO ApiEpochInfo
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter IO
ti (Qry ApiEpochInfo -> IO ApiEpochInfo)
-> Qry ApiEpochInfo -> IO ApiEpochInfo
forall a b. (a -> b) -> a -> b
$ EpochNo -> Qry ApiEpochInfo
toApiEpochInfo EpochNo
changesAt
        ApiWalletDelegationNext -> IO ApiWalletDelegationNext
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiWalletDelegationNext -> IO ApiWalletDelegationNext)
-> ApiWalletDelegationNext -> IO ApiWalletDelegationNext
forall a b. (a -> b) -> a -> b
$ Maybe ApiEpochInfo
-> WalletDelegationStatus -> ApiWalletDelegationNext
toApiWalletDelegationNext (ApiEpochInfo -> Maybe ApiEpochInfo
forall a. a -> Maybe a
Just ApiEpochInfo
info) WalletDelegationStatus
status

    ApiWalletDelegation -> IO ApiWalletDelegation
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiWalletDelegation -> IO ApiWalletDelegation)
-> ApiWalletDelegation -> IO ApiWalletDelegation
forall a b. (a -> b) -> a -> b
$ ApiWalletDelegation :: ApiWalletDelegationNext
-> [ApiWalletDelegationNext] -> ApiWalletDelegation
ApiWalletDelegation
        { $sel:active:ApiWalletDelegation :: ApiWalletDelegationNext
active = Maybe ApiEpochInfo
-> WalletDelegationStatus -> ApiWalletDelegationNext
toApiWalletDelegationNext Maybe ApiEpochInfo
forall a. Maybe a
Nothing WalletDelegationStatus
active
        , $sel:next:ApiWalletDelegation :: [ApiWalletDelegationNext]
next = [ApiWalletDelegationNext]
apiNext
        }
  where
    toApiWalletDelegationNext :: Maybe ApiEpochInfo
-> WalletDelegationStatus -> ApiWalletDelegationNext
toApiWalletDelegationNext Maybe ApiEpochInfo
mepochInfo = \case
        W.Delegating PoolId
pid -> ApiWalletDelegationNext :: ApiWalletDelegationStatus
-> Maybe (ApiT PoolId)
-> Maybe ApiEpochInfo
-> ApiWalletDelegationNext
ApiWalletDelegationNext
            { $sel:status:ApiWalletDelegationNext :: ApiWalletDelegationStatus
status = ApiWalletDelegationStatus
Delegating
            , $sel:target:ApiWalletDelegationNext :: Maybe (ApiT PoolId)
target = ApiT PoolId -> Maybe (ApiT PoolId)
forall a. a -> Maybe a
Just (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
pid)
            , $sel:changesAt:ApiWalletDelegationNext :: Maybe ApiEpochInfo
changesAt = Maybe ApiEpochInfo
mepochInfo
            }

        WalletDelegationStatus
W.NotDelegating -> ApiWalletDelegationNext :: ApiWalletDelegationStatus
-> Maybe (ApiT PoolId)
-> Maybe ApiEpochInfo
-> ApiWalletDelegationNext
ApiWalletDelegationNext
            { $sel:status:ApiWalletDelegationNext :: ApiWalletDelegationStatus
status = ApiWalletDelegationStatus
NotDelegating
            , $sel:target:ApiWalletDelegationNext :: Maybe (ApiT PoolId)
target = Maybe (ApiT PoolId)
forall a. Maybe a
Nothing
            , $sel:changesAt:ApiWalletDelegationNext :: Maybe ApiEpochInfo
changesAt = Maybe ApiEpochInfo
mepochInfo
            }

--------------------- Shared Wallet

postSharedWallet
    :: forall ctx s k n.
        ( s ~ SharedState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasDBFactory s k ctx
        , HasWorkerRegistry s k ctx
        , Typeable n
        , k ~ SharedKey
        )
    => ctx
    -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
    -> (XPub -> k 'AccountK XPub)
    -> ApiSharedWalletPostData
    -> Handler ApiSharedWallet
postSharedWallet :: ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> (XPub -> k 'AccountK XPub)
-> ApiSharedWalletPostData
-> Handler ApiSharedWallet
postSharedWallet ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey XPub -> k 'AccountK XPub
liftKey ApiSharedWalletPostData
postData =
    case ApiSharedWalletPostData
postData of
        ApiSharedWalletPostData (Left ApiSharedWalletPostDataFromMnemonics
body) ->
            ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> ApiSharedWalletPostDataFromMnemonics
-> Handler ApiSharedWallet
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(s ~ SharedState n k, ctx ~ ApiLayer s k, SoftDerivation k,
 MkKeyFingerprint k (Proxy n, k 'AddressK XPub),
 MkKeyFingerprint k Address, WalletKey k, HasDBFactory s k ctx,
 HasWorkerRegistry s k ctx, Typeable n, k ~ SharedKey) =>
ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> ApiSharedWalletPostDataFromMnemonics
-> Handler ApiSharedWallet
postSharedWalletFromRootXPrv ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey ApiSharedWalletPostDataFromMnemonics
body
        ApiSharedWalletPostData (Right ApiSharedWalletPostDataFromAccountPubX
body) ->
            ctx
-> (XPub -> k 'AccountK XPub)
-> ApiSharedWalletPostDataFromAccountPubX
-> Handler ApiSharedWallet
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(s ~ SharedState n k, ctx ~ ApiLayer s k, SoftDerivation k,
 MkKeyFingerprint k (Proxy n, k 'AddressK XPub),
 MkKeyFingerprint k Address, WalletKey k, HasDBFactory s k ctx,
 HasWorkerRegistry s k ctx, Typeable n, k ~ SharedKey) =>
ctx
-> (XPub -> k 'AccountK XPub)
-> ApiSharedWalletPostDataFromAccountPubX
-> Handler ApiSharedWallet
postSharedWalletFromAccountXPub ctx
ctx XPub -> k 'AccountK XPub
liftKey ApiSharedWalletPostDataFromAccountPubX
body

postSharedWalletFromRootXPrv
    :: forall ctx s k n.
        ( s ~ SharedState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasDBFactory s k ctx
        , HasWorkerRegistry s k ctx
        , Typeable n
        , k ~ SharedKey
        )
    => ctx
    -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
    -> ApiSharedWalletPostDataFromMnemonics
    -> Handler ApiSharedWallet
postSharedWalletFromRootXPrv :: ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> ApiSharedWalletPostDataFromMnemonics
-> Handler ApiSharedWallet
postSharedWalletFromRootXPrv ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey ApiSharedWalletPostDataFromMnemonics
body = do
    case k 'AccountK XPub
-> ValidationLevel
-> ScriptTemplate
-> Maybe ScriptTemplate
-> Either ErrScriptTemplate ()
forall (k :: Depth -> * -> *).
WalletKey k =>
k 'AccountK XPub
-> ValidationLevel
-> ScriptTemplate
-> Maybe ScriptTemplate
-> Either ErrScriptTemplate ()
validateScriptTemplates k 'AccountK XPub
accXPub ValidationLevel
scriptValidation ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM of
        Left ErrScriptTemplate
err ->
            ExceptT ErrConstructSharedWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructSharedWallet IO () -> Handler ())
-> ExceptT ErrConstructSharedWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructSharedWallet -> ExceptT ErrConstructSharedWallet IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrConstructSharedWallet
 -> ExceptT ErrConstructSharedWallet IO ())
-> ErrConstructSharedWallet
-> ExceptT ErrConstructSharedWallet IO ()
forall a b. (a -> b) -> a -> b
$ ErrScriptTemplate -> ErrConstructSharedWallet
ErrConstructSharedWalletWrongScriptTemplate ErrScriptTemplate
err
        Right ()
_ -> () -> Handler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Index 'Hardened 'AccountK
ix' <- ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
-> Handler (Index 'Hardened 'AccountK)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
 -> Handler (Index 'Hardened 'AccountK))
-> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
-> Handler (Index 'Hardened 'AccountK)
forall a b. (a -> b) -> a -> b
$ (ErrInvalidDerivationIndex 'Hardened 'AccountK
 -> ErrConstructSharedWallet)
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened 'AccountK)
     IO
     (Index 'Hardened 'AccountK)
-> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrInvalidDerivationIndex 'Hardened 'AccountK
-> ErrConstructSharedWallet
ErrConstructSharedWalletInvalidIndex (ExceptT
   (ErrInvalidDerivationIndex 'Hardened 'AccountK)
   IO
   (Index 'Hardened 'AccountK)
 -> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK))
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened 'AccountK)
     IO
     (Index 'Hardened 'AccountK)
-> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
forall a b. (a -> b) -> a -> b
$
        DerivationIndex
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened 'AccountK)
     IO
     (Index 'Hardened 'AccountK)
forall (m :: * -> *) (level :: Depth) (whatever :: Depth).
Monad m =>
DerivationIndex
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened level)
     m
     (Index 'Hardened whatever)
W.guardHardIndex DerivationIndex
ix
    let state :: SharedState n k
state = (k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'AccountK
-> AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
(SupportsDiscovery n k, WalletKey k, k ~ SharedKey) =>
(k 'RootK XPrv, Passphrase "encryption")
-> Index 'Hardened 'AccountK
-> AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedState n k
mkSharedStateFromRootXPrv (k 'RootK XPrv
rootXPrv, Passphrase "encryption"
pwdP) Index 'Hardened 'AccountK
ix' AddressPoolGap
g ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM
    Handler WalletId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler WalletId -> Handler ()) -> Handler WalletId -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateWallet IO WalletId -> Handler WalletId)
-> ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall a b. (a -> b) -> a -> b
$ ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker @_ @s @k ctx
ctx WalletId
wid
        (\WorkerCtx ctx
wrk -> WorkerCtx ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx (m :: * -> *) s (k :: Depth -> * -> *).
(MonadUnliftIO m, MonadTime m, HasGenesisData ctx,
 HasDBLayer m s k ctx, IsOurs s Address, IsOurs s RewardAccount) =>
ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists m WalletId
W.createWallet @(WorkerCtx ctx) @_ @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName s
SharedState n k
state)
        WorkerCtx ctx -> WalletId -> IO ()
forall ctx wid a. ctx -> wid -> IO a
idleWorker
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO () -> Handler ())
-> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO (SharedState n SharedKey) SharedKey
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrNoSuchWallet IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrNoSuchWallet IO ()
W.attachPrivateKeyFromPwd @_ @s @k WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletId
wid (k 'RootK XPrv
rootXPrv, Passphrase "user"
pwd)
    (ApiSharedWallet, UTCTime) -> ApiSharedWallet
forall a b. (a, b) -> a
fst ((ApiSharedWallet, UTCTime) -> ApiSharedWallet)
-> Handler (ApiSharedWallet, UTCTime) -> Handler ApiSharedWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx s ApiSharedWallet
-> ApiT WalletId
-> Handler (ApiSharedWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx (forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SharedState n k,
 HasWorkerRegistry s k ctx, SupportsDiscovery n k) =>
MkApiWallet ctx s ApiSharedWallet
forall (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SharedState n k,
 HasWorkerRegistry s k ctx, SupportsDiscovery n k) =>
MkApiWallet ctx s ApiSharedWallet
mkSharedWallet @_ @s @k) (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    seed :: SomeMnemonic
seed = ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const SomeMnemonic ApiSharedWalletPostDataFromMnemonics)
-> SomeMnemonic
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSentence"
  ((ApiMnemonicT '[15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[15, 18, 21, 24]))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const SomeMnemonic ApiSharedWalletPostDataFromMnemonics)
(ApiMnemonicT '[15, 18, 21, 24]
 -> Const SomeMnemonic (ApiMnemonicT '[15, 18, 21, 24]))
-> ApiSharedWalletPostDataFromMnemonics
-> Const SomeMnemonic ApiSharedWalletPostDataFromMnemonics
#mnemonicSentence ((ApiMnemonicT '[15, 18, 21, 24]
  -> Const SomeMnemonic (ApiMnemonicT '[15, 18, 21, 24]))
 -> ApiSharedWalletPostDataFromMnemonics
 -> Const SomeMnemonic ApiSharedWalletPostDataFromMnemonics)
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ApiMnemonicT '[15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[15, 18, 21, 24]))
-> (SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ApiSharedWalletPostDataFromMnemonics
-> Const SomeMnemonic ApiSharedWalletPostDataFromMnemonics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiMnemonicT"
  ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
   -> ApiMnemonicT '[15, 18, 21, 24]
   -> Const SomeMnemonic (ApiMnemonicT '[15, 18, 21, 24]))
(SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ApiMnemonicT '[15, 18, 21, 24]
-> Const SomeMnemonic (ApiMnemonicT '[15, 18, 21, 24])
#getApiMnemonicT
    secondFactor :: Maybe SomeMnemonic
secondFactor = ApiMnemonicT '[9, 12] -> SomeMnemonic
forall (sizes :: [Nat]). ApiMnemonicT sizes -> SomeMnemonic
getApiMnemonicT (ApiMnemonicT '[9, 12] -> SomeMnemonic)
-> Maybe (ApiMnemonicT '[9, 12]) -> Maybe SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((Maybe (ApiMnemonicT '[9, 12])
     -> Const
          (Maybe (ApiMnemonicT '[9, 12])) (Maybe (ApiMnemonicT '[9, 12])))
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const
         (Maybe (ApiMnemonicT '[9, 12]))
         ApiSharedWalletPostDataFromMnemonics)
-> Maybe (ApiMnemonicT '[9, 12])
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSecondFactor"
  ((Maybe (ApiMnemonicT '[9, 12])
    -> Const
         (Maybe (ApiMnemonicT '[9, 12])) (Maybe (ApiMnemonicT '[9, 12])))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const
        (Maybe (ApiMnemonicT '[9, 12]))
        ApiSharedWalletPostDataFromMnemonics)
(Maybe (ApiMnemonicT '[9, 12])
 -> Const
      (Maybe (ApiMnemonicT '[9, 12])) (Maybe (ApiMnemonicT '[9, 12])))
-> ApiSharedWalletPostDataFromMnemonics
-> Const
     (Maybe (ApiMnemonicT '[9, 12]))
     ApiSharedWalletPostDataFromMnemonics
#mnemonicSecondFactor
    pwdP :: Passphrase "encryption"
pwdP = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
pwd
    pwd :: Passphrase "user"
pwd = ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const (Passphrase "user") ApiSharedWalletPostDataFromMnemonics)
-> Passphrase "user"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const (Passphrase "user") ApiSharedWalletPostDataFromMnemonics)
(ApiT (Passphrase "user")
 -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> ApiSharedWalletPostDataFromMnemonics
-> Const (Passphrase "user") ApiSharedWalletPostDataFromMnemonics
#passphrase ((ApiT (Passphrase "user")
  -> Const (Passphrase "user") (ApiT (Passphrase "user")))
 -> ApiSharedWalletPostDataFromMnemonics
 -> Const (Passphrase "user") ApiSharedWalletPostDataFromMnemonics)
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> (Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
-> ApiSharedWalletPostDataFromMnemonics
-> Const (Passphrase "user") ApiSharedWalletPostDataFromMnemonics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
   -> ApiT (Passphrase "user")
   -> Const (Passphrase "user") (ApiT (Passphrase "user")))
(Passphrase "user"
 -> Const (Passphrase "user") (Passphrase "user"))
-> ApiT (Passphrase "user")
-> Const (Passphrase "user") (ApiT (Passphrase "user"))
#getApiT
    rootXPrv :: k 'RootK XPrv
rootXPrv = (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
generateKey (SomeMnemonic
seed, Maybe SomeMnemonic
secondFactor) Passphrase "encryption"
pwdP
    g :: AddressPoolGap
g = AddressPoolGap
defaultAddressPoolGap
    ix :: DerivationIndex
ix = ApiT DerivationIndex -> DerivationIndex
forall a. ApiT a -> a
getApiT (ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((ApiT DerivationIndex
     -> Const (ApiT DerivationIndex) (ApiT DerivationIndex))
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const
         (ApiT DerivationIndex) ApiSharedWalletPostDataFromMnemonics)
-> ApiT DerivationIndex
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "accountIndex"
  ((ApiT DerivationIndex
    -> Const (ApiT DerivationIndex) (ApiT DerivationIndex))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const
        (ApiT DerivationIndex) ApiSharedWalletPostDataFromMnemonics)
(ApiT DerivationIndex
 -> Const (ApiT DerivationIndex) (ApiT DerivationIndex))
-> ApiSharedWalletPostDataFromMnemonics
-> Const
     (ApiT DerivationIndex) ApiSharedWalletPostDataFromMnemonics
#accountIndex)
    pTemplate :: ScriptTemplate
pTemplate = XPub -> ApiScriptTemplateEntry -> ScriptTemplate
scriptTemplateFromSelf (k 'AccountK XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey k 'AccountK XPub
accXPub) (ApiScriptTemplateEntry -> ScriptTemplate)
-> ApiScriptTemplateEntry -> ScriptTemplate
forall a b. (a -> b) -> a -> b
$ ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((ApiScriptTemplateEntry
     -> Const ApiScriptTemplateEntry ApiScriptTemplateEntry)
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const
         ApiScriptTemplateEntry ApiSharedWalletPostDataFromMnemonics)
-> ApiScriptTemplateEntry
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "paymentScriptTemplate"
  ((ApiScriptTemplateEntry
    -> Const ApiScriptTemplateEntry ApiScriptTemplateEntry)
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const
        ApiScriptTemplateEntry ApiSharedWalletPostDataFromMnemonics)
(ApiScriptTemplateEntry
 -> Const ApiScriptTemplateEntry ApiScriptTemplateEntry)
-> ApiSharedWalletPostDataFromMnemonics
-> Const
     ApiScriptTemplateEntry ApiSharedWalletPostDataFromMnemonics
#paymentScriptTemplate
    dTemplateM :: Maybe ScriptTemplate
dTemplateM = XPub -> ApiScriptTemplateEntry -> ScriptTemplate
scriptTemplateFromSelf (k 'AccountK XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey k 'AccountK XPub
accXPub) (ApiScriptTemplateEntry -> ScriptTemplate)
-> Maybe ApiScriptTemplateEntry -> Maybe ScriptTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((Maybe ApiScriptTemplateEntry
     -> Const
          (Maybe ApiScriptTemplateEntry) (Maybe ApiScriptTemplateEntry))
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const
         (Maybe ApiScriptTemplateEntry)
         ApiSharedWalletPostDataFromMnemonics)
-> Maybe ApiScriptTemplateEntry
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegationScriptTemplate"
  ((Maybe ApiScriptTemplateEntry
    -> Const
         (Maybe ApiScriptTemplateEntry) (Maybe ApiScriptTemplateEntry))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const
        (Maybe ApiScriptTemplateEntry)
        ApiSharedWalletPostDataFromMnemonics)
(Maybe ApiScriptTemplateEntry
 -> Const
      (Maybe ApiScriptTemplateEntry) (Maybe ApiScriptTemplateEntry))
-> ApiSharedWalletPostDataFromMnemonics
-> Const
     (Maybe ApiScriptTemplateEntry) ApiSharedWalletPostDataFromMnemonics
#delegationScriptTemplate
    wName :: WalletName
wName = ApiT WalletName -> WalletName
forall a. ApiT a -> a
getApiT (ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const (ApiT WalletName) ApiSharedWalletPostDataFromMnemonics)
-> ApiT WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const (ApiT WalletName) ApiSharedWalletPostDataFromMnemonics)
(ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
-> ApiSharedWalletPostDataFromMnemonics
-> Const (ApiT WalletName) ApiSharedWalletPostDataFromMnemonics
#name)
    accXPub :: k 'AccountK XPub
accXPub = k 'AccountK XPrv -> k 'AccountK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey (k 'AccountK XPrv -> k 'AccountK XPub)
-> k 'AccountK XPrv -> k 'AccountK XPub
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption"
-> k 'RootK XPrv -> Index 'Hardened 'AccountK -> k 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'RootK XPrv
-> Index 'Hardened 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
pwdP k 'RootK XPrv
rootXPrv (Word32 -> Index 'Hardened 'AccountK
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Word32 -> Index 'Hardened 'AccountK)
-> Word32 -> Index 'Hardened 'AccountK
forall a b. (a -> b) -> a -> b
$ DerivationIndex -> Word32
getDerivationIndex DerivationIndex
ix)
    wid :: WalletId
wid = Digest Blake2b_160 -> WalletId
WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ k 'AccountK XPub
-> ScriptTemplate -> Maybe ScriptTemplate -> Digest Blake2b_160
forall (k :: Depth -> * -> *).
(WalletKey k, k ~ SharedKey) =>
k 'AccountK XPub
-> ScriptTemplate -> Maybe ScriptTemplate -> Digest Blake2b_160
toSharedWalletId k 'AccountK XPub
accXPub ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM
    scriptValidation :: ValidationLevel
scriptValidation = ValidationLevel
-> (ApiT ValidationLevel -> ValidationLevel)
-> Maybe (ApiT ValidationLevel)
-> ValidationLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValidationLevel
RecommendedValidation ApiT ValidationLevel -> ValidationLevel
forall a. ApiT a -> a
getApiT (ApiSharedWalletPostDataFromMnemonics
body ApiSharedWalletPostDataFromMnemonics
-> ((Maybe (ApiT ValidationLevel)
     -> Const
          (Maybe (ApiT ValidationLevel)) (Maybe (ApiT ValidationLevel)))
    -> ApiSharedWalletPostDataFromMnemonics
    -> Const
         (Maybe (ApiT ValidationLevel))
         ApiSharedWalletPostDataFromMnemonics)
-> Maybe (ApiT ValidationLevel)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidation"
  ((Maybe (ApiT ValidationLevel)
    -> Const
         (Maybe (ApiT ValidationLevel)) (Maybe (ApiT ValidationLevel)))
   -> ApiSharedWalletPostDataFromMnemonics
   -> Const
        (Maybe (ApiT ValidationLevel))
        ApiSharedWalletPostDataFromMnemonics)
(Maybe (ApiT ValidationLevel)
 -> Const
      (Maybe (ApiT ValidationLevel)) (Maybe (ApiT ValidationLevel)))
-> ApiSharedWalletPostDataFromMnemonics
-> Const
     (Maybe (ApiT ValidationLevel)) ApiSharedWalletPostDataFromMnemonics
#scriptValidation)

postSharedWalletFromAccountXPub
    :: forall ctx s k n.
        ( s ~ SharedState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasDBFactory s k ctx
        , HasWorkerRegistry s k ctx
        , Typeable n
        , k ~ SharedKey
        )
    => ctx
    -> (XPub -> k 'AccountK XPub)
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Handler ApiSharedWallet
postSharedWalletFromAccountXPub :: ctx
-> (XPub -> k 'AccountK XPub)
-> ApiSharedWalletPostDataFromAccountPubX
-> Handler ApiSharedWallet
postSharedWalletFromAccountXPub ctx
ctx XPub -> k 'AccountK XPub
liftKey ApiSharedWalletPostDataFromAccountPubX
body = do
    case k 'AccountK XPub
-> ValidationLevel
-> ScriptTemplate
-> Maybe ScriptTemplate
-> Either ErrScriptTemplate ()
forall (k :: Depth -> * -> *).
WalletKey k =>
k 'AccountK XPub
-> ValidationLevel
-> ScriptTemplate
-> Maybe ScriptTemplate
-> Either ErrScriptTemplate ()
validateScriptTemplates (XPub -> k 'AccountK XPub
liftKey XPub
accXPub) ValidationLevel
scriptValidation ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM of
        Left ErrScriptTemplate
err ->
            ExceptT ErrConstructSharedWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructSharedWallet IO () -> Handler ())
-> ExceptT ErrConstructSharedWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructSharedWallet -> ExceptT ErrConstructSharedWallet IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrConstructSharedWallet
 -> ExceptT ErrConstructSharedWallet IO ())
-> ErrConstructSharedWallet
-> ExceptT ErrConstructSharedWallet IO ()
forall a b. (a -> b) -> a -> b
$ ErrScriptTemplate -> ErrConstructSharedWallet
ErrConstructSharedWalletWrongScriptTemplate ErrScriptTemplate
err
        Right ()
_ -> () -> Handler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Index 'Hardened 'AccountK
acctIx <- ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
-> Handler (Index 'Hardened 'AccountK)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
 -> Handler (Index 'Hardened 'AccountK))
-> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
-> Handler (Index 'Hardened 'AccountK)
forall a b. (a -> b) -> a -> b
$ (ErrInvalidDerivationIndex 'Hardened 'AccountK
 -> ErrConstructSharedWallet)
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened 'AccountK)
     IO
     (Index 'Hardened 'AccountK)
-> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrInvalidDerivationIndex 'Hardened 'AccountK
-> ErrConstructSharedWallet
ErrConstructSharedWalletInvalidIndex (ExceptT
   (ErrInvalidDerivationIndex 'Hardened 'AccountK)
   IO
   (Index 'Hardened 'AccountK)
 -> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK))
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened 'AccountK)
     IO
     (Index 'Hardened 'AccountK)
-> ExceptT ErrConstructSharedWallet IO (Index 'Hardened 'AccountK)
forall a b. (a -> b) -> a -> b
$
        DerivationIndex
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened 'AccountK)
     IO
     (Index 'Hardened 'AccountK)
forall (m :: * -> *) (level :: Depth) (whatever :: Depth).
Monad m =>
DerivationIndex
-> ExceptT
     (ErrInvalidDerivationIndex 'Hardened level)
     m
     (Index 'Hardened whatever)
W.guardHardIndex DerivationIndex
ix
    let state :: SharedState n k
state = k 'AccountK XPub
-> Index 'Hardened 'AccountK
-> AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedState n k
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
(SupportsDiscovery n k, WalletKey k, k ~ SharedKey) =>
k 'AccountK XPub
-> Index 'Hardened 'AccountK
-> AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> SharedState n k
mkSharedStateFromAccountXPub (XPub -> k 'AccountK XPub
liftKey XPub
accXPub) Index 'Hardened 'AccountK
acctIx AddressPoolGap
g ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM
    Handler WalletId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler WalletId -> Handler ()) -> Handler WalletId -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateWallet IO WalletId -> Handler WalletId)
-> ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall a b. (a -> b) -> a -> b
$ ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker @_ @s @k ctx
ctx WalletId
wid
        (\WorkerCtx ctx
wrk -> WorkerCtx ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx (m :: * -> *) s (k :: Depth -> * -> *).
(MonadUnliftIO m, MonadTime m, HasGenesisData ctx,
 HasDBLayer m s k ctx, IsOurs s Address, IsOurs s RewardAccount) =>
ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists m WalletId
W.createWallet @(WorkerCtx ctx) @_ @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName s
SharedState n k
state)
        WorkerCtx ctx -> WalletId -> IO ()
forall ctx wid a. ctx -> wid -> IO a
idleWorker
    (ApiSharedWallet, UTCTime) -> ApiSharedWallet
forall a b. (a, b) -> a
fst ((ApiSharedWallet, UTCTime) -> ApiSharedWallet)
-> Handler (ApiSharedWallet, UTCTime) -> Handler ApiSharedWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx s ApiSharedWallet
-> ApiT WalletId
-> Handler (ApiSharedWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx (forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SharedState n k,
 HasWorkerRegistry s k ctx, SupportsDiscovery n k) =>
MkApiWallet ctx s ApiSharedWallet
forall (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SharedState n k,
 HasWorkerRegistry s k ctx, SupportsDiscovery n k) =>
MkApiWallet ctx s ApiSharedWallet
mkSharedWallet @_ @s @k) (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    g :: AddressPoolGap
g = AddressPoolGap
defaultAddressPoolGap
    ix :: DerivationIndex
ix = ApiT DerivationIndex -> DerivationIndex
forall a. ApiT a -> a
getApiT (ApiSharedWalletPostDataFromAccountPubX
body ApiSharedWalletPostDataFromAccountPubX
-> ((ApiT DerivationIndex
     -> Const (ApiT DerivationIndex) (ApiT DerivationIndex))
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Const
         (ApiT DerivationIndex) ApiSharedWalletPostDataFromAccountPubX)
-> ApiT DerivationIndex
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "accountIndex"
  ((ApiT DerivationIndex
    -> Const (ApiT DerivationIndex) (ApiT DerivationIndex))
   -> ApiSharedWalletPostDataFromAccountPubX
   -> Const
        (ApiT DerivationIndex) ApiSharedWalletPostDataFromAccountPubX)
(ApiT DerivationIndex
 -> Const (ApiT DerivationIndex) (ApiT DerivationIndex))
-> ApiSharedWalletPostDataFromAccountPubX
-> Const
     (ApiT DerivationIndex) ApiSharedWalletPostDataFromAccountPubX
#accountIndex)
    pTemplate :: ScriptTemplate
pTemplate = XPub -> ApiScriptTemplateEntry -> ScriptTemplate
scriptTemplateFromSelf XPub
accXPub (ApiScriptTemplateEntry -> ScriptTemplate)
-> ApiScriptTemplateEntry -> ScriptTemplate
forall a b. (a -> b) -> a -> b
$ ApiSharedWalletPostDataFromAccountPubX
body ApiSharedWalletPostDataFromAccountPubX
-> ((ApiScriptTemplateEntry
     -> Const ApiScriptTemplateEntry ApiScriptTemplateEntry)
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Const
         ApiScriptTemplateEntry ApiSharedWalletPostDataFromAccountPubX)
-> ApiScriptTemplateEntry
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "paymentScriptTemplate"
  ((ApiScriptTemplateEntry
    -> Const ApiScriptTemplateEntry ApiScriptTemplateEntry)
   -> ApiSharedWalletPostDataFromAccountPubX
   -> Const
        ApiScriptTemplateEntry ApiSharedWalletPostDataFromAccountPubX)
(ApiScriptTemplateEntry
 -> Const ApiScriptTemplateEntry ApiScriptTemplateEntry)
-> ApiSharedWalletPostDataFromAccountPubX
-> Const
     ApiScriptTemplateEntry ApiSharedWalletPostDataFromAccountPubX
#paymentScriptTemplate
    dTemplateM :: Maybe ScriptTemplate
dTemplateM = XPub -> ApiScriptTemplateEntry -> ScriptTemplate
scriptTemplateFromSelf XPub
accXPub (ApiScriptTemplateEntry -> ScriptTemplate)
-> Maybe ApiScriptTemplateEntry -> Maybe ScriptTemplate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiSharedWalletPostDataFromAccountPubX
body ApiSharedWalletPostDataFromAccountPubX
-> ((Maybe ApiScriptTemplateEntry
     -> Const
          (Maybe ApiScriptTemplateEntry) (Maybe ApiScriptTemplateEntry))
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Const
         (Maybe ApiScriptTemplateEntry)
         ApiSharedWalletPostDataFromAccountPubX)
-> Maybe ApiScriptTemplateEntry
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegationScriptTemplate"
  ((Maybe ApiScriptTemplateEntry
    -> Const
         (Maybe ApiScriptTemplateEntry) (Maybe ApiScriptTemplateEntry))
   -> ApiSharedWalletPostDataFromAccountPubX
   -> Const
        (Maybe ApiScriptTemplateEntry)
        ApiSharedWalletPostDataFromAccountPubX)
(Maybe ApiScriptTemplateEntry
 -> Const
      (Maybe ApiScriptTemplateEntry) (Maybe ApiScriptTemplateEntry))
-> ApiSharedWalletPostDataFromAccountPubX
-> Const
     (Maybe ApiScriptTemplateEntry)
     ApiSharedWalletPostDataFromAccountPubX
#delegationScriptTemplate
    wName :: WalletName
wName = ApiT WalletName -> WalletName
forall a. ApiT a -> a
getApiT (ApiSharedWalletPostDataFromAccountPubX
body ApiSharedWalletPostDataFromAccountPubX
-> ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Const (ApiT WalletName) ApiSharedWalletPostDataFromAccountPubX)
-> ApiT WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
   -> ApiSharedWalletPostDataFromAccountPubX
   -> Const (ApiT WalletName) ApiSharedWalletPostDataFromAccountPubX)
(ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
-> ApiSharedWalletPostDataFromAccountPubX
-> Const (ApiT WalletName) ApiSharedWalletPostDataFromAccountPubX
#name)
    (ApiAccountPublicKey ApiT XPub
accXPubApiT) =  ApiSharedWalletPostDataFromAccountPubX
body ApiSharedWalletPostDataFromAccountPubX
-> ((ApiAccountPublicKey
     -> Const ApiAccountPublicKey ApiAccountPublicKey)
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Const
         ApiAccountPublicKey ApiSharedWalletPostDataFromAccountPubX)
-> ApiAccountPublicKey
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "accountPublicKey"
  ((ApiAccountPublicKey
    -> Const ApiAccountPublicKey ApiAccountPublicKey)
   -> ApiSharedWalletPostDataFromAccountPubX
   -> Const
        ApiAccountPublicKey ApiSharedWalletPostDataFromAccountPubX)
(ApiAccountPublicKey
 -> Const ApiAccountPublicKey ApiAccountPublicKey)
-> ApiSharedWalletPostDataFromAccountPubX
-> Const ApiAccountPublicKey ApiSharedWalletPostDataFromAccountPubX
#accountPublicKey
    accXPub :: XPub
accXPub = ApiT XPub -> XPub
forall a. ApiT a -> a
getApiT ApiT XPub
accXPubApiT
    wid :: WalletId
wid = Digest Blake2b_160 -> WalletId
WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ k 'AccountK XPub
-> ScriptTemplate -> Maybe ScriptTemplate -> Digest Blake2b_160
forall (k :: Depth -> * -> *).
(WalletKey k, k ~ SharedKey) =>
k 'AccountK XPub
-> ScriptTemplate -> Maybe ScriptTemplate -> Digest Blake2b_160
toSharedWalletId (XPub -> k 'AccountK XPub
liftKey XPub
accXPub) ScriptTemplate
pTemplate Maybe ScriptTemplate
dTemplateM
    scriptValidation :: ValidationLevel
scriptValidation = ValidationLevel
-> (ApiT ValidationLevel -> ValidationLevel)
-> Maybe (ApiT ValidationLevel)
-> ValidationLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ValidationLevel
RecommendedValidation ApiT ValidationLevel -> ValidationLevel
forall a. ApiT a -> a
getApiT (ApiSharedWalletPostDataFromAccountPubX
body ApiSharedWalletPostDataFromAccountPubX
-> ((Maybe (ApiT ValidationLevel)
     -> Const
          (Maybe (ApiT ValidationLevel)) (Maybe (ApiT ValidationLevel)))
    -> ApiSharedWalletPostDataFromAccountPubX
    -> Const
         (Maybe (ApiT ValidationLevel))
         ApiSharedWalletPostDataFromAccountPubX)
-> Maybe (ApiT ValidationLevel)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidation"
  ((Maybe (ApiT ValidationLevel)
    -> Const
         (Maybe (ApiT ValidationLevel)) (Maybe (ApiT ValidationLevel)))
   -> ApiSharedWalletPostDataFromAccountPubX
   -> Const
        (Maybe (ApiT ValidationLevel))
        ApiSharedWalletPostDataFromAccountPubX)
(Maybe (ApiT ValidationLevel)
 -> Const
      (Maybe (ApiT ValidationLevel)) (Maybe (ApiT ValidationLevel)))
-> ApiSharedWalletPostDataFromAccountPubX
-> Const
     (Maybe (ApiT ValidationLevel))
     ApiSharedWalletPostDataFromAccountPubX
#scriptValidation)

scriptTemplateFromSelf :: XPub -> ApiScriptTemplateEntry -> ScriptTemplate
scriptTemplateFromSelf :: XPub -> ApiScriptTemplateEntry -> ScriptTemplate
scriptTemplateFromSelf XPub
xpub (ApiScriptTemplateEntry Map Cosigner XPubOrSelf
cosigners' Script Cosigner
template') =
    Map Cosigner XPub -> Script Cosigner -> ScriptTemplate
ScriptTemplate Map Cosigner XPub
cosignersWithoutSelf Script Cosigner
template'
  where
    unSelf :: XPubOrSelf -> XPub
unSelf (SomeAccountKey XPub
xpub') = XPub
xpub'
    unSelf XPubOrSelf
Self = XPub
xpub
    cosignersWithoutSelf :: Map Cosigner XPub
cosignersWithoutSelf = (XPubOrSelf -> XPub)
-> Map Cosigner XPubOrSelf -> Map Cosigner XPub
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map XPubOrSelf -> XPub
unSelf Map Cosigner XPubOrSelf
cosigners'

mkSharedWallet
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ SharedState n k
        , HasWorkerRegistry s k ctx
        , Shared.SupportsDiscovery n k
        )
    => MkApiWallet ctx s ApiSharedWallet
mkSharedWallet :: MkApiWallet ctx s ApiSharedWallet
mkSharedWallet ctx
ctx WalletId
wid Wallet s
cp WalletMetadata
meta Set Tx
pending SyncProgress
progress = case SharedState n k -> Readiness (SharedAddressPools k)
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> Readiness (SharedAddressPools k)
Shared.ready s
SharedState n k
st of
    Readiness (SharedAddressPools k)
Shared.Pending -> ApiSharedWallet -> Handler ApiSharedWallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWallet -> Handler ApiSharedWallet)
-> ApiSharedWallet -> Handler ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
ApiSharedWallet (Either ApiPendingSharedWallet ApiActiveSharedWallet
 -> ApiSharedWallet)
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ ApiPendingSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
forall a b. a -> Either a b
Left (ApiPendingSharedWallet
 -> Either ApiPendingSharedWallet ApiActiveSharedWallet)
-> ApiPendingSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
forall a b. (a -> b) -> a -> b
$ ApiPendingSharedWallet :: ApiT WalletId
-> ApiT WalletName
-> ApiT DerivationIndex
-> ApiT AddressPoolGap
-> ScriptTemplate
-> Maybe ScriptTemplate
-> ApiPendingSharedWallet
ApiPendingSharedWallet
        { $sel:id:ApiPendingSharedWallet :: ApiT WalletId
id = WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid
        , $sel:name:ApiPendingSharedWallet :: ApiT WalletName
name = WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT (WalletName -> ApiT WalletName) -> WalletName -> ApiT WalletName
forall a b. (a -> b) -> a -> b
$ WalletMetadata
meta WalletMetadata
-> ((WalletName -> Const WalletName WalletName)
    -> WalletMetadata -> Const WalletName WalletMetadata)
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((WalletName -> Const WalletName WalletName)
   -> WalletMetadata -> Const WalletName WalletMetadata)
(WalletName -> Const WalletName WalletName)
-> WalletMetadata -> Const WalletName WalletMetadata
#name
        , $sel:accountIndex:ApiPendingSharedWallet :: ApiT DerivationIndex
accountIndex = DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> DerivationIndex -> ApiT DerivationIndex
forall a b. (a -> b) -> a -> b
$ Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'AccountK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'AccountK
accIx
        , $sel:addressPoolGap:ApiPendingSharedWallet :: ApiT AddressPoolGap
addressPoolGap = AddressPoolGap -> ApiT AddressPoolGap
forall a. a -> ApiT a
ApiT (AddressPoolGap -> ApiT AddressPoolGap)
-> AddressPoolGap -> ApiT AddressPoolGap
forall a b. (a -> b) -> a -> b
$ SharedState n k -> AddressPoolGap
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> AddressPoolGap
Shared.poolGap s
SharedState n k
st
        , $sel:paymentScriptTemplate:ApiPendingSharedWallet :: ScriptTemplate
paymentScriptTemplate = SharedState n k -> ScriptTemplate
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> ScriptTemplate
Shared.paymentTemplate s
SharedState n k
st
        , $sel:delegationScriptTemplate:ApiPendingSharedWallet :: Maybe ScriptTemplate
delegationScriptTemplate = SharedState n k -> Maybe ScriptTemplate
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> Maybe ScriptTemplate
Shared.delegationTemplate s
SharedState n k
st
        }
    Shared.Active SharedAddressPools k
_ -> do
        Coin
reward <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler Coin)
-> (ErrWalletNotResponding -> Handler Coin)
-> (WorkerCtx ctx -> Handler Coin)
-> Handler Coin
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler Coin
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler Coin
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler Coin) -> Handler Coin)
-> (WorkerCtx ctx -> Handler Coin) -> Handler Coin
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk ->
            -- never fails - returns zero if balance not found
            IO Coin -> Handler Coin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coin -> Handler Coin) -> IO Coin -> Handler Coin
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SharedState n k) k -> WalletId -> IO Coin
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx -> WalletId -> IO Coin
W.fetchRewardBalance @_ @s @k WalletLayer IO (SharedState n k) k
WorkerCtx ctx
wrk WalletId
wid

        let ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (NetworkLayer IO Block
 -> TimeInterpreter (ExceptT PastHorizonException IO))
-> NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer
        ApiWalletDelegation
apiDelegation <- IO ApiWalletDelegation -> Handler ApiWalletDelegation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiWalletDelegation -> Handler ApiWalletDelegation)
-> IO ApiWalletDelegation -> Handler ApiWalletDelegation
forall a b. (a -> b) -> a -> b
$ WalletDelegation -> TimeInterpreter IO -> IO ApiWalletDelegation
toApiWalletDelegation (WalletMetadata
meta WalletMetadata
-> ((WalletDelegation -> Const WalletDelegation WalletDelegation)
    -> WalletMetadata -> Const WalletDelegation WalletMetadata)
-> WalletDelegation
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegation"
  ((WalletDelegation -> Const WalletDelegation WalletDelegation)
   -> WalletMetadata -> Const WalletDelegation WalletMetadata)
(WalletDelegation -> Const WalletDelegation WalletDelegation)
-> WalletMetadata -> Const WalletDelegation WalletMetadata
#delegation)
            (TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
unsafeExtendSafeZone TimeInterpreter (ExceptT PastHorizonException IO)
ti)

        ApiBlockReference
tip' <- IO ApiBlockReference -> Handler ApiBlockReference
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiBlockReference -> Handler ApiBlockReference)
-> IO ApiBlockReference -> Handler ApiBlockReference
forall a b. (a -> b) -> a -> b
$ TimeInterpreter IO -> Wallet s -> IO ApiBlockReference
forall (m :: * -> *) s.
Monad m =>
TimeInterpreter m -> Wallet s -> m ApiBlockReference
getWalletTip
            (String
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
neverFails String
"getWalletTip wallet tip should be behind node tip" TimeInterpreter (ExceptT PastHorizonException IO)
ti)
            Wallet s
cp
        let available :: TokenBundle
available = Set Tx -> Wallet s -> TokenBundle
forall s. Set Tx -> Wallet s -> TokenBundle
availableBalance Set Tx
pending Wallet s
cp
        let total :: TokenBundle
total = Set Tx -> Coin -> Wallet s -> TokenBundle
forall s.
(IsOurs s Address, IsOurs s RewardAccount) =>
Set Tx -> Coin -> Wallet s -> TokenBundle
totalBalance Set Tx
pending Coin
reward Wallet s
cp
        ApiSharedWallet -> Handler ApiSharedWallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSharedWallet -> Handler ApiSharedWallet)
-> ApiSharedWallet -> Handler ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
ApiSharedWallet (Either ApiPendingSharedWallet ApiActiveSharedWallet
 -> ApiSharedWallet)
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
-> ApiSharedWallet
forall a b. (a -> b) -> a -> b
$ ApiActiveSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
forall a b. b -> Either a b
Right (ApiActiveSharedWallet
 -> Either ApiPendingSharedWallet ApiActiveSharedWallet)
-> ApiActiveSharedWallet
-> Either ApiPendingSharedWallet ApiActiveSharedWallet
forall a b. (a -> b) -> a -> b
$ ApiActiveSharedWallet :: ApiT WalletId
-> ApiT WalletName
-> ApiT DerivationIndex
-> ApiT AddressPoolGap
-> Maybe ApiWalletPassphraseInfo
-> ScriptTemplate
-> Maybe ScriptTemplate
-> ApiWalletDelegation
-> ApiWalletBalance
-> ApiWalletAssetsBalance
-> ApiT SyncProgress
-> ApiBlockReference
-> ApiActiveSharedWallet
ApiActiveSharedWallet
            { $sel:id:ApiActiveSharedWallet :: ApiT WalletId
id = WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid
            , $sel:name:ApiActiveSharedWallet :: ApiT WalletName
name = WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT (WalletName -> ApiT WalletName) -> WalletName -> ApiT WalletName
forall a b. (a -> b) -> a -> b
$ WalletMetadata
meta WalletMetadata
-> ((WalletName -> Const WalletName WalletName)
    -> WalletMetadata -> Const WalletName WalletMetadata)
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((WalletName -> Const WalletName WalletName)
   -> WalletMetadata -> Const WalletName WalletMetadata)
(WalletName -> Const WalletName WalletName)
-> WalletMetadata -> Const WalletName WalletMetadata
#name
            , $sel:accountIndex:ApiActiveSharedWallet :: ApiT DerivationIndex
accountIndex = DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> DerivationIndex -> ApiT DerivationIndex
forall a b. (a -> b) -> a -> b
$ Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Index 'Hardened 'AccountK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'AccountK
accIx
            , $sel:addressPoolGap:ApiActiveSharedWallet :: ApiT AddressPoolGap
addressPoolGap = AddressPoolGap -> ApiT AddressPoolGap
forall a. a -> ApiT a
ApiT (AddressPoolGap -> ApiT AddressPoolGap)
-> AddressPoolGap -> ApiT AddressPoolGap
forall a b. (a -> b) -> a -> b
$ SharedState n k -> AddressPoolGap
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> AddressPoolGap
Shared.poolGap s
SharedState n k
st
            , $sel:passphrase:ApiActiveSharedWallet :: Maybe ApiWalletPassphraseInfo
passphrase = UTCTime -> ApiWalletPassphraseInfo
ApiWalletPassphraseInfo
                (UTCTime -> ApiWalletPassphraseInfo)
-> Maybe UTCTime -> Maybe ApiWalletPassphraseInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WalletPassphraseInfo -> UTCTime)
-> Maybe WalletPassphraseInfo -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((UTCTime -> Const UTCTime UTCTime)
 -> WalletPassphraseInfo -> Const UTCTime WalletPassphraseInfo)
-> WalletPassphraseInfo -> UTCTime
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "lastUpdatedAt"
  ((UTCTime -> Const UTCTime UTCTime)
   -> WalletPassphraseInfo -> Const UTCTime WalletPassphraseInfo)
(UTCTime -> Const UTCTime UTCTime)
-> WalletPassphraseInfo -> Const UTCTime WalletPassphraseInfo
#lastUpdatedAt) (WalletMetadata
meta WalletMetadata
-> ((Maybe WalletPassphraseInfo
     -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
    -> WalletMetadata
    -> Const (Maybe WalletPassphraseInfo) WalletMetadata)
-> Maybe WalletPassphraseInfo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphraseInfo"
  ((Maybe WalletPassphraseInfo
    -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
   -> WalletMetadata
   -> Const (Maybe WalletPassphraseInfo) WalletMetadata)
(Maybe WalletPassphraseInfo
 -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
-> WalletMetadata
-> Const (Maybe WalletPassphraseInfo) WalletMetadata
#passphraseInfo)
            , $sel:paymentScriptTemplate:ApiActiveSharedWallet :: ScriptTemplate
paymentScriptTemplate = SharedState n k -> ScriptTemplate
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> ScriptTemplate
Shared.paymentTemplate s
SharedState n k
st
            , $sel:delegationScriptTemplate:ApiActiveSharedWallet :: Maybe ScriptTemplate
delegationScriptTemplate = SharedState n k -> Maybe ScriptTemplate
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> Maybe ScriptTemplate
Shared.delegationTemplate s
SharedState n k
st
            , $sel:delegation:ApiActiveSharedWallet :: ApiWalletDelegation
delegation = ApiWalletDelegation
apiDelegation
            , $sel:balance:ApiActiveSharedWallet :: ApiWalletBalance
balance = ApiWalletBalance :: Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> ApiWalletBalance
ApiWalletBalance
                { $sel:available:ApiWalletBalance :: Quantity "lovelace" Natural
available = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (TokenBundle
available TokenBundle
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin)
                , $sel:total:ApiWalletBalance :: Quantity "lovelace" Natural
total = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (TokenBundle
total TokenBundle
-> ((Coin -> Const Coin Coin)
    -> TokenBundle -> Const Coin TokenBundle)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin)
                , $sel:reward:ApiWalletBalance :: Quantity "lovelace" Natural
reward = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
reward
                }
            , $sel:assets:ApiActiveSharedWallet :: ApiWalletAssetsBalance
assets = ApiWalletAssetsBalance :: ApiT TokenMap -> ApiT TokenMap -> ApiWalletAssetsBalance
ApiWalletAssetsBalance
                { $sel:available:ApiWalletAssetsBalance :: ApiT TokenMap
available = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenBundle
available TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
                , $sel:total:ApiWalletAssetsBalance :: ApiT TokenMap
total = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenBundle
total TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
                }
            , $sel:state:ApiActiveSharedWallet :: ApiT SyncProgress
state = SyncProgress -> ApiT SyncProgress
forall a. a -> ApiT a
ApiT SyncProgress
progress
            , $sel:tip:ApiActiveSharedWallet :: ApiBlockReference
tip = ApiBlockReference
tip'
            }
  where
    st :: s
st = Wallet s -> s
forall s. Wallet s -> s
getState Wallet s
cp
    DerivationPrefix (Index 'Hardened 'PurposeK
_,Index 'Hardened 'CoinTypeK
_,Index 'Hardened 'AccountK
accIx) = SharedState n k -> DerivationPrefix
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> DerivationPrefix
Shared.derivationPrefix s
SharedState n k
st

patchSharedWallet
    :: forall ctx s k n.
        ( s ~ SharedState n k
        , ctx ~ ApiLayer s k
        , SoftDerivation k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , MkKeyFingerprint k Address
        , WalletKey k
        , HasDBFactory s k ctx
        , Typeable n
        , k ~ SharedKey
        )
    => ctx
    -> (XPub -> k 'AccountK XPub)
    -> CredentialType
    -> ApiT WalletId
    -> ApiSharedWalletPatchData
    -> Handler ApiSharedWallet
patchSharedWallet :: ctx
-> (XPub -> k 'AccountK XPub)
-> CredentialType
-> ApiT WalletId
-> ApiSharedWalletPatchData
-> Handler ApiSharedWallet
patchSharedWallet ctx
ctx XPub -> k 'AccountK XPub
liftKey CredentialType
cred (ApiT WalletId
wid) ApiSharedWalletPatchData
body = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        ExceptT ErrAddCosignerKey IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrAddCosignerKey IO () -> Handler ())
-> ExceptT ErrAddCosignerKey IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SharedState n SharedKey) SharedKey
-> WalletId
-> k 'AccountK XPub
-> Cosigner
-> CredentialType
-> ExceptT ErrAddCosignerKey IO ()
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(s ~ SharedState n k, MkKeyFingerprint k Address, SoftDerivation k,
 Typeable n, WalletKey k, HasDBLayer IO s k ctx, k ~ SharedKey) =>
ctx
-> WalletId
-> k 'AccountK XPub
-> Cosigner
-> CredentialType
-> ExceptT ErrAddCosignerKey IO ()
W.updateCosigner WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletId
wid (XPub -> k 'AccountK XPub
liftKey XPub
accXPub) Cosigner
cosigner CredentialType
cred
    (ApiSharedWallet, UTCTime) -> ApiSharedWallet
forall a b. (a, b) -> a
fst ((ApiSharedWallet, UTCTime) -> ApiSharedWallet)
-> Handler (ApiSharedWallet, UTCTime) -> Handler ApiSharedWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx s ApiSharedWallet
-> ApiT WalletId
-> Handler (ApiSharedWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx (forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SharedState n k,
 HasWorkerRegistry s k ctx, SupportsDiscovery n k) =>
MkApiWallet ctx s ApiSharedWallet
forall (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, s ~ SharedState n k,
 HasWorkerRegistry s k ctx, SupportsDiscovery n k) =>
MkApiWallet ctx s ApiSharedWallet
mkSharedWallet @_ @s @k) (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
      cosigner :: Cosigner
cosigner = ApiT Cosigner -> Cosigner
forall a. ApiT a -> a
getApiT (ApiSharedWalletPatchData
body ApiSharedWalletPatchData
-> ((ApiT Cosigner -> Const (ApiT Cosigner) (ApiT Cosigner))
    -> ApiSharedWalletPatchData
    -> Const (ApiT Cosigner) ApiSharedWalletPatchData)
-> ApiT Cosigner
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "cosigner"
  ((ApiT Cosigner -> Const (ApiT Cosigner) (ApiT Cosigner))
   -> ApiSharedWalletPatchData
   -> Const (ApiT Cosigner) ApiSharedWalletPatchData)
(ApiT Cosigner -> Const (ApiT Cosigner) (ApiT Cosigner))
-> ApiSharedWalletPatchData
-> Const (ApiT Cosigner) ApiSharedWalletPatchData
#cosigner)
      (ApiAccountPublicKey ApiT XPub
accXPubApiT) = (ApiSharedWalletPatchData
body ApiSharedWalletPatchData
-> ((ApiAccountPublicKey
     -> Const ApiAccountPublicKey ApiAccountPublicKey)
    -> ApiSharedWalletPatchData
    -> Const ApiAccountPublicKey ApiSharedWalletPatchData)
-> ApiAccountPublicKey
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "accountPublicKey"
  ((ApiAccountPublicKey
    -> Const ApiAccountPublicKey ApiAccountPublicKey)
   -> ApiSharedWalletPatchData
   -> Const ApiAccountPublicKey ApiSharedWalletPatchData)
(ApiAccountPublicKey
 -> Const ApiAccountPublicKey ApiAccountPublicKey)
-> ApiSharedWalletPatchData
-> Const ApiAccountPublicKey ApiSharedWalletPatchData
#accountPublicKey)
      accXPub :: XPub
accXPub = ApiT XPub -> XPub
forall a. ApiT a -> a
getApiT ApiT XPub
accXPubApiT

--------------------- Legacy

postLegacyWallet
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , KnownDiscovery s
        , IsOurs s RewardAccount
        , IsOurs s Address
        , MaybeLight s
        , HasNetworkLayer IO ctx
        , WalletKey k
        , AddressBookIso s
        )
    => ctx
        -- ^ Surrounding Context
    -> (k 'RootK XPrv, Passphrase "user")
        -- ^ Root key
    -> (  WorkerCtx ctx
       -> WalletId
       -> ExceptT ErrWalletAlreadyExists IO WalletId
       )
        -- ^ How to create this legacy wallet
    -> Handler ApiByronWallet
postLegacyWallet :: ctx
-> (k 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
postLegacyWallet ctx
ctx (k 'RootK XPrv
rootXPrv, Passphrase "user"
pwd) WorkerCtx ctx
-> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId
createWallet = do
    Handler WalletId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler WalletId -> Handler ()) -> Handler WalletId -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateWallet IO WalletId -> Handler WalletId)
-> ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall a b. (a -> b) -> a -> b
$ ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker @_ @s @k ctx
ctx WalletId
wid (WorkerCtx ctx
-> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId
`createWallet` WalletId
wid)
        WorkerCtx ctx -> WalletId -> IO ()
forall ctx wid a. ctx -> wid -> IO a
idleWorker
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO () -> Handler ())
-> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO s k
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrNoSuchWallet IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrNoSuchWallet IO ()
W.attachPrivateKeyFromPwd WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid (k 'RootK XPrv
rootXPrv, Passphrase "user"
pwd)
    (ApiByronWallet, UTCTime) -> ApiByronWallet
forall a b. (a, b) -> a
fst ((ApiByronWallet, UTCTime) -> ApiByronWallet)
-> Handler (ApiByronWallet, UTCTime) -> Handler ApiByronWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx s ApiByronWallet
-> ApiT WalletId
-> Handler (ApiByronWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx MkApiWallet ctx s ApiByronWallet
forall ctx s (k :: Depth -> * -> *).
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, KnownDiscovery s,
 HasNetworkLayer IO ctx, IsOurs s Address,
 IsOurs s RewardAccount) =>
ctx
-> WalletId
-> Wallet s
-> WalletMetadata
-> Set Tx
-> SyncProgress
-> Handler ApiByronWallet
mkLegacyWallet (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    wid :: WalletId
wid = Digest Blake2b_160 -> WalletId
WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ k 'RootK XPub -> Digest Blake2b_160
forall (key :: Depth -> * -> *) a (depth :: Depth).
(WalletKey key, HashAlgorithm a) =>
key depth XPub -> Digest a
digest (k 'RootK XPub -> Digest Blake2b_160)
-> k 'RootK XPub -> Digest Blake2b_160
forall a b. (a -> b) -> a -> b
$ k 'RootK XPrv -> k 'RootK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey k 'RootK XPrv
rootXPrv

mkLegacyWallet
    :: forall ctx s k.
        ( HasWorkerRegistry s k ctx
        , HasDBFactory s k ctx
        , KnownDiscovery s
        , HasNetworkLayer IO ctx
        , IsOurs s Address
        , IsOurs s RewardAccount
        )
    => ctx
    -> WalletId
    -> Wallet s
    -> WalletMetadata
    -> Set Tx
    -> SyncProgress
    -> Handler ApiByronWallet
mkLegacyWallet :: ctx
-> WalletId
-> Wallet s
-> WalletMetadata
-> Set Tx
-> SyncProgress
-> Handler ApiByronWallet
mkLegacyWallet ctx
ctx WalletId
wid Wallet s
cp WalletMetadata
meta Set Tx
pending SyncProgress
progress = do
    -- NOTE
    -- Legacy wallets imported through via XPrv might have an empty passphrase
    -- set. The passphrase is empty from a client perspective, but in practice
    -- it still exists (it is a CBOR-serialized empty bytestring!).
    --
    -- Therefore, if we detect an empty passphrase, we choose to return the
    -- metadata as if no passphrase was set, so that clients can react
    -- appropriately.
    Maybe ApiWalletPassphraseInfo
pwdInfo <- case WalletMetadata
meta WalletMetadata
-> ((Maybe WalletPassphraseInfo
     -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
    -> WalletMetadata
    -> Const (Maybe WalletPassphraseInfo) WalletMetadata)
-> Maybe WalletPassphraseInfo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphraseInfo"
  ((Maybe WalletPassphraseInfo
    -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
   -> WalletMetadata
   -> Const (Maybe WalletPassphraseInfo) WalletMetadata)
(Maybe WalletPassphraseInfo
 -> Const (Maybe WalletPassphraseInfo) (Maybe WalletPassphraseInfo))
-> WalletMetadata
-> Const (Maybe WalletPassphraseInfo) WalletMetadata
#passphraseInfo of
        Maybe WalletPassphraseInfo
Nothing ->
            Maybe ApiWalletPassphraseInfo
-> Handler (Maybe ApiWalletPassphraseInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ApiWalletPassphraseInfo
forall a. Maybe a
Nothing
        Just (WalletPassphraseInfo UTCTime
time PassphraseScheme
EncryptWithPBKDF2) ->
            Maybe ApiWalletPassphraseInfo
-> Handler (Maybe ApiWalletPassphraseInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ApiWalletPassphraseInfo
 -> Handler (Maybe ApiWalletPassphraseInfo))
-> Maybe ApiWalletPassphraseInfo
-> Handler (Maybe ApiWalletPassphraseInfo)
forall a b. (a -> b) -> a -> b
$ ApiWalletPassphraseInfo -> Maybe ApiWalletPassphraseInfo
forall a. a -> Maybe a
Just (ApiWalletPassphraseInfo -> Maybe ApiWalletPassphraseInfo)
-> ApiWalletPassphraseInfo -> Maybe ApiWalletPassphraseInfo
forall a b. (a -> b) -> a -> b
$ UTCTime -> ApiWalletPassphraseInfo
ApiWalletPassphraseInfo UTCTime
time
        Just (WalletPassphraseInfo UTCTime
time PassphraseScheme
EncryptWithScrypt) -> do
            ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (Maybe ApiWalletPassphraseInfo))
-> (ErrWalletNotResponding
    -> Handler (Maybe ApiWalletPassphraseInfo))
-> (WorkerCtx ctx -> Handler (Maybe ApiWalletPassphraseInfo))
-> Handler (Maybe ApiWalletPassphraseInfo)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (Maybe ApiWalletPassphraseInfo)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (Maybe ApiWalletPassphraseInfo)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (Maybe ApiWalletPassphraseInfo))
 -> Handler (Maybe ApiWalletPassphraseInfo))
-> (WorkerCtx ctx -> Handler (Maybe ApiWalletPassphraseInfo))
-> Handler (Maybe ApiWalletPassphraseInfo)
forall a b. (a -> b) -> a -> b
$
                WorkerCtx ctx -> Handler (Either ErrWithRootKey ())
matchEmptyPassphrase (WorkerCtx ctx -> Handler (Either ErrWithRootKey ()))
-> (Either ErrWithRootKey ()
    -> Handler (Maybe ApiWalletPassphraseInfo))
-> WorkerCtx ctx
-> Handler (Maybe ApiWalletPassphraseInfo)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
                    Right{} -> Maybe ApiWalletPassphraseInfo
-> Handler (Maybe ApiWalletPassphraseInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ApiWalletPassphraseInfo
forall a. Maybe a
Nothing
                    Left{} -> Maybe ApiWalletPassphraseInfo
-> Handler (Maybe ApiWalletPassphraseInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ApiWalletPassphraseInfo
 -> Handler (Maybe ApiWalletPassphraseInfo))
-> Maybe ApiWalletPassphraseInfo
-> Handler (Maybe ApiWalletPassphraseInfo)
forall a b. (a -> b) -> a -> b
$ ApiWalletPassphraseInfo -> Maybe ApiWalletPassphraseInfo
forall a. a -> Maybe a
Just (ApiWalletPassphraseInfo -> Maybe ApiWalletPassphraseInfo)
-> ApiWalletPassphraseInfo -> Maybe ApiWalletPassphraseInfo
forall a b. (a -> b) -> a -> b
$ UTCTime -> ApiWalletPassphraseInfo
ApiWalletPassphraseInfo UTCTime
time

    ApiBlockReference
tip' <- IO ApiBlockReference -> Handler ApiBlockReference
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiBlockReference -> Handler ApiBlockReference)
-> IO ApiBlockReference -> Handler ApiBlockReference
forall a b. (a -> b) -> a -> b
$ TimeInterpreter IO -> Wallet s -> IO ApiBlockReference
forall (m :: * -> *) s.
Monad m =>
TimeInterpreter m -> Wallet s -> m ApiBlockReference
getWalletTip (TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
expectAndThrowFailures TimeInterpreter (ExceptT PastHorizonException IO)
ti) Wallet s
cp
    let available :: TokenBundle
available = Set Tx -> Wallet s -> TokenBundle
forall s. Set Tx -> Wallet s -> TokenBundle
availableBalance Set Tx
pending Wallet s
cp
    let total :: TokenBundle
total = Set Tx -> Coin -> Wallet s -> TokenBundle
forall s.
(IsOurs s Address, IsOurs s RewardAccount) =>
Set Tx -> Coin -> Wallet s -> TokenBundle
totalBalance Set Tx
pending (Natural -> Coin
Coin Natural
0) Wallet s
cp
    ApiByronWallet -> Handler ApiByronWallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiByronWallet :: ApiT WalletId
-> ApiByronWalletBalance
-> ApiWalletAssetsBalance
-> ApiWalletDiscovery
-> ApiT WalletName
-> Maybe ApiWalletPassphraseInfo
-> ApiT SyncProgress
-> ApiBlockReference
-> ApiByronWallet
ApiByronWallet
        { $sel:balance:ApiByronWallet :: ApiByronWalletBalance
balance = ApiByronWalletBalance :: Quantity "lovelace" Natural
-> Quantity "lovelace" Natural -> ApiByronWalletBalance
ApiByronWalletBalance
            { $sel:available:ApiByronWalletBalance :: Quantity "lovelace" Natural
available = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
available
            , $sel:total:ApiByronWalletBalance :: Quantity "lovelace" Natural
total = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ TokenBundle -> Coin
TokenBundle.getCoin TokenBundle
total
            }
        , $sel:assets:ApiByronWallet :: ApiWalletAssetsBalance
assets = ApiWalletAssetsBalance :: ApiT TokenMap -> ApiT TokenMap -> ApiWalletAssetsBalance
ApiWalletAssetsBalance
            { $sel:available:ApiWalletAssetsBalance :: ApiT TokenMap
available = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenBundle
available TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
            , $sel:total:ApiWalletAssetsBalance :: ApiT TokenMap
total = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenBundle
total TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
            }
        , $sel:id:ApiByronWallet :: ApiT WalletId
id = WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid
        , $sel:name:ApiByronWallet :: ApiT WalletName
name = WalletName -> ApiT WalletName
forall a. a -> ApiT a
ApiT (WalletName -> ApiT WalletName) -> WalletName -> ApiT WalletName
forall a b. (a -> b) -> a -> b
$ WalletMetadata
meta WalletMetadata
-> ((WalletName -> Const WalletName WalletName)
    -> WalletMetadata -> Const WalletName WalletMetadata)
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((WalletName -> Const WalletName WalletName)
   -> WalletMetadata -> Const WalletName WalletMetadata)
(WalletName -> Const WalletName WalletName)
-> WalletMetadata -> Const WalletName WalletMetadata
#name
        , $sel:passphrase:ApiByronWallet :: Maybe ApiWalletPassphraseInfo
passphrase = Maybe ApiWalletPassphraseInfo
pwdInfo
        , $sel:state:ApiByronWallet :: ApiT SyncProgress
state = SyncProgress -> ApiT SyncProgress
forall a. a -> ApiT a
ApiT SyncProgress
progress
        , $sel:tip:ApiByronWallet :: ApiBlockReference
tip = ApiBlockReference
tip'
        , $sel:discovery:ApiByronWallet :: ApiWalletDiscovery
discovery = KnownDiscovery s => ApiWalletDiscovery
forall k (s :: k). KnownDiscovery s => ApiWalletDiscovery
knownDiscovery @s
        }
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (NetworkLayer IO Block
 -> TimeInterpreter (ExceptT PastHorizonException IO))
-> NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer

    matchEmptyPassphrase
        :: WorkerCtx ctx
        -> Handler (Either ErrWithRootKey ())
    matchEmptyPassphrase :: WorkerCtx ctx -> Handler (Either ErrWithRootKey ())
matchEmptyPassphrase WorkerCtx ctx
wrk = IO (Either ErrWithRootKey ()) -> Handler (Either ErrWithRootKey ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ErrWithRootKey ())
 -> Handler (Either ErrWithRootKey ()))
-> IO (Either ErrWithRootKey ())
-> Handler (Either ErrWithRootKey ())
forall a b. (a -> b) -> a -> b
$ ExceptT ErrWithRootKey IO () -> IO (Either ErrWithRootKey ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ErrWithRootKey IO () -> IO (Either ErrWithRootKey ()))
-> ExceptT ErrWithRootKey IO () -> IO (Either ErrWithRootKey ())
forall a b. (a -> b) -> a -> b
$
        WorkerCtx ctx
-> WalletId
-> Passphrase "user"
-> (ErrWithRootKey -> ErrWithRootKey)
-> (k 'RootK XPrv
    -> PassphraseScheme -> ExceptT ErrWithRootKey IO ())
-> ExceptT ErrWithRootKey IO ()
forall ctx s (k :: Depth -> * -> *) e a.
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Passphrase "user"
-> (ErrWithRootKey -> e)
-> (k 'RootK XPrv -> PassphraseScheme -> ExceptT e IO a)
-> ExceptT e IO a
W.withRootKey @_ @s @k WorkerCtx ctx
wrk WalletId
wid Passphrase "user"
forall a. Monoid a => a
mempty ErrWithRootKey -> ErrWithRootKey
forall a. a -> a
Prelude.id (\k 'RootK XPrv
_ PassphraseScheme
_ -> () -> ExceptT ErrWithRootKey IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

postRandomWallet
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ RndState n
        , k ~ ByronKey
        )
    => ctx
    -> ByronWalletPostData '[12,15,18,21,24]
    -> Handler ApiByronWallet
postRandomWallet :: ctx
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Handler ApiByronWallet
postRandomWallet ctx
ctx ByronWalletPostData '[12, 15, 18, 21, 24]
body = do
    RndState n
s <- IO (RndState n) -> Handler (RndState n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (RndState n) -> Handler (RndState n))
-> IO (RndState n) -> Handler (RndState n)
forall a b. (a -> b) -> a -> b
$ ByronKey 'RootK XPrv -> Int -> RndState n
forall (n :: NetworkDiscriminant).
ByronKey 'RootK XPrv -> Int -> RndState n
mkRndState ByronKey 'RootK XPrv
rootXPrv (Int -> RndState n) -> IO Int -> IO (RndState n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StdGen -> (Int, StdGen)) -> IO Int
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random
    ctx
-> (ByronKey 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, KnownDiscovery s, IsOurs s RewardAccount,
 IsOurs s Address, MaybeLight s, HasNetworkLayer IO ctx,
 WalletKey k, AddressBookIso s) =>
ctx
-> (k 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
postLegacyWallet ctx
ctx (ByronKey 'RootK XPrv
rootXPrv, Passphrase "user"
pwd) ((WorkerCtx ctx
  -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
 -> Handler ApiByronWallet)
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk WalletId
wid ->
        WorkerCtx ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx (m :: * -> *) s (k :: Depth -> * -> *).
(MonadUnliftIO m, MonadTime m, HasGenesisData ctx,
 HasDBLayer m s k ctx, IsOurs s Address, IsOurs s RewardAccount) =>
ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists m WalletId
W.createWallet @(WorkerCtx ctx) @_ @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName s
RndState n
s
  where
    wName :: WalletName
wName    = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((WalletName -> Const WalletName WalletName)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const WalletName (ApiT WalletName))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT WalletName -> Const WalletName (ApiT WalletName))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
#name ((ApiT WalletName -> Const WalletName (ApiT WalletName))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((WalletName -> Const WalletName WalletName)
    -> ApiT WalletName -> Const WalletName (ApiT WalletName))
-> (WalletName -> Const WalletName WalletName)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((WalletName -> Const WalletName WalletName)
   -> ApiT WalletName -> Const WalletName (ApiT WalletName))
(WalletName -> Const WalletName WalletName)
-> ApiT WalletName -> Const WalletName (ApiT WalletName)
#getApiT
    seed :: SomeMnemonic
seed     = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> SomeMnemonic
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSentence"
  ((ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiMnemonicT '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
#mnemonicSentence ((ApiMnemonicT '[12, 15, 18, 21, 24]
  -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> (SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiMnemonicT"
  ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
   -> ApiMnemonicT '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
(SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ApiMnemonicT '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24])
#getApiMnemonicT
    pwd :: Passphrase "user"
pwd      = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const
         (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> Passphrase "user"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const
        (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT (Passphrase "user")
 -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
#passphrase ((ApiT (Passphrase "user")
  -> Const (Passphrase "user") (ApiT (Passphrase "user")))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const
      (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> (Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
   -> ApiT (Passphrase "user")
   -> Const (Passphrase "user") (ApiT (Passphrase "user")))
(Passphrase "user"
 -> Const (Passphrase "user") (Passphrase "user"))
-> ApiT (Passphrase "user")
-> Const (Passphrase "user") (ApiT (Passphrase "user"))
#getApiT
    pwdP :: Passphrase "encryption"
pwdP     = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
pwd
    rootXPrv :: ByronKey 'RootK XPrv
rootXPrv = SomeMnemonic -> Passphrase "encryption" -> ByronKey 'RootK XPrv
Byron.generateKeyFromSeed SomeMnemonic
seed Passphrase "encryption"
pwdP

postRandomWalletFromXPrv
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ RndState n
        , k ~ ByronKey
        , HasNetworkLayer IO ctx
        )
    => ctx
    -> ByronWalletFromXPrvPostData
    -> Handler ApiByronWallet
postRandomWalletFromXPrv :: ctx -> ByronWalletFromXPrvPostData -> Handler ApiByronWallet
postRandomWalletFromXPrv ctx
ctx ByronWalletFromXPrvPostData
body = do
    RndState n
s <- IO (RndState n) -> Handler (RndState n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (RndState n) -> Handler (RndState n))
-> IO (RndState n) -> Handler (RndState n)
forall a b. (a -> b) -> a -> b
$ ByronKey 'RootK XPrv -> Int -> RndState n
forall (n :: NetworkDiscriminant).
ByronKey 'RootK XPrv -> Int -> RndState n
mkRndState ByronKey 'RootK XPrv
byronKey (Int -> RndState n) -> IO Int -> IO (RndState n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StdGen -> (Int, StdGen)) -> IO Int
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom StdGen -> (Int, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random
    Handler WalletId -> Handler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handler WalletId -> Handler ()) -> Handler WalletId -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateWallet IO WalletId -> Handler WalletId)
-> ExceptT ErrCreateWallet IO WalletId -> Handler WalletId
forall a b. (a -> b) -> a -> b
$ ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker @_ @s @k ctx
ctx WalletId
wid
        (\WorkerCtx ctx
wrk -> WorkerCtx ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx (m :: * -> *) s (k :: Depth -> * -> *).
(MonadUnliftIO m, MonadTime m, HasGenesisData ctx,
 HasDBLayer m s k ctx, IsOurs s Address, IsOurs s RewardAccount) =>
ctx
-> WalletId
-> WalletName
-> s
-> ExceptT ErrWalletAlreadyExists m WalletId
W.createWallet @(WorkerCtx ctx) @_ @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName s
RndState n
s)
        WorkerCtx ctx -> WalletId -> IO ()
forall ctx wid a. ctx -> wid -> IO a
idleWorker
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO () -> Handler ())
-> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO (RndState n) ByronKey
-> WalletId
-> (ByronKey 'RootK XPrv, PassphraseHash)
-> ExceptT ErrNoSuchWallet IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> (k 'RootK XPrv, PassphraseHash)
-> ExceptT ErrNoSuchWallet IO ()
W.attachPrivateKeyFromPwdHash WalletLayer IO (RndState n) ByronKey
WorkerCtx ctx
wrk WalletId
wid (ByronKey 'RootK XPrv
byronKey, PassphraseHash
pwd)
    (ApiByronWallet, UTCTime) -> ApiByronWallet
forall a b. (a, b) -> a
fst ((ApiByronWallet, UTCTime) -> ApiByronWallet)
-> Handler (ApiByronWallet, UTCTime) -> Handler ApiByronWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx (RndState n) ApiByronWallet
-> ApiT WalletId
-> Handler (ApiByronWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx MkApiWallet ctx (RndState n) ApiByronWallet
forall ctx s (k :: Depth -> * -> *).
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, KnownDiscovery s,
 HasNetworkLayer IO ctx, IsOurs s Address,
 IsOurs s RewardAccount) =>
ctx
-> WalletId
-> Wallet s
-> WalletMetadata
-> Set Tx
-> SyncProgress
-> Handler ApiByronWallet
mkLegacyWallet (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    wName :: WalletName
wName = ApiT WalletName -> WalletName
forall a. ApiT a -> a
getApiT (ByronWalletFromXPrvPostData
body ByronWalletFromXPrvPostData
-> ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
    -> ByronWalletFromXPrvPostData
    -> Const (ApiT WalletName) ByronWalletFromXPrvPostData)
-> ApiT WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
   -> ByronWalletFromXPrvPostData
   -> Const (ApiT WalletName) ByronWalletFromXPrvPostData)
(ApiT WalletName -> Const (ApiT WalletName) (ApiT WalletName))
-> ByronWalletFromXPrvPostData
-> Const (ApiT WalletName) ByronWalletFromXPrvPostData
#name)
    pwd :: PassphraseHash
pwd   = ApiT PassphraseHash -> PassphraseHash
forall a. ApiT a -> a
getApiT (ByronWalletFromXPrvPostData
body ByronWalletFromXPrvPostData
-> ((ApiT PassphraseHash
     -> Const (ApiT PassphraseHash) (ApiT PassphraseHash))
    -> ByronWalletFromXPrvPostData
    -> Const (ApiT PassphraseHash) ByronWalletFromXPrvPostData)
-> ApiT PassphraseHash
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphraseHash"
  ((ApiT PassphraseHash
    -> Const (ApiT PassphraseHash) (ApiT PassphraseHash))
   -> ByronWalletFromXPrvPostData
   -> Const (ApiT PassphraseHash) ByronWalletFromXPrvPostData)
(ApiT PassphraseHash
 -> Const (ApiT PassphraseHash) (ApiT PassphraseHash))
-> ByronWalletFromXPrvPostData
-> Const (ApiT PassphraseHash) ByronWalletFromXPrvPostData
#passphraseHash)
    masterKey :: XPrv
masterKey = ApiT XPrv -> XPrv
forall a. ApiT a -> a
getApiT (ByronWalletFromXPrvPostData
body ByronWalletFromXPrvPostData
-> ((ApiT XPrv -> Const (ApiT XPrv) (ApiT XPrv))
    -> ByronWalletFromXPrvPostData
    -> Const (ApiT XPrv) ByronWalletFromXPrvPostData)
-> ApiT XPrv
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "encryptedRootPrivateKey"
  ((ApiT XPrv -> Const (ApiT XPrv) (ApiT XPrv))
   -> ByronWalletFromXPrvPostData
   -> Const (ApiT XPrv) ByronWalletFromXPrvPostData)
(ApiT XPrv -> Const (ApiT XPrv) (ApiT XPrv))
-> ByronWalletFromXPrvPostData
-> Const (ApiT XPrv) ByronWalletFromXPrvPostData
#encryptedRootPrivateKey)
    byronKey :: ByronKey 'RootK XPrv
byronKey = XPrv -> ByronKey 'RootK XPrv
mkByronKeyFromMasterKey XPrv
masterKey
    wid :: WalletId
wid = Digest Blake2b_160 -> WalletId
WalletId (Digest Blake2b_160 -> WalletId) -> Digest Blake2b_160 -> WalletId
forall a b. (a -> b) -> a -> b
$ ByronKey 'RootK XPub -> Digest Blake2b_160
forall (key :: Depth -> * -> *) a (depth :: Depth).
(WalletKey key, HashAlgorithm a) =>
key depth XPub -> Digest a
digest (ByronKey 'RootK XPub -> Digest Blake2b_160)
-> ByronKey 'RootK XPub -> Digest Blake2b_160
forall a b. (a -> b) -> a -> b
$ ByronKey 'RootK XPrv -> ByronKey 'RootK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey ByronKey 'RootK XPrv
byronKey

postIcarusWallet
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , k ~ IcarusKey
        , HasWorkerRegistry s k ctx
        , PaymentAddress n IcarusKey
        , Typeable n
        )
    => ctx
    -> ByronWalletPostData '[12,15,18,21,24]
    -> Handler ApiByronWallet
postIcarusWallet :: ctx
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Handler ApiByronWallet
postIcarusWallet ctx
ctx ByronWalletPostData '[12, 15, 18, 21, 24]
body = do
    ctx
-> (IcarusKey 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, KnownDiscovery s, IsOurs s RewardAccount,
 IsOurs s Address, MaybeLight s, HasNetworkLayer IO ctx,
 WalletKey k, AddressBookIso s) =>
ctx
-> (k 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
postLegacyWallet ctx
ctx (IcarusKey 'RootK XPrv
rootXPrv, Passphrase "user"
pwd) ((WorkerCtx ctx
  -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
 -> Handler ApiByronWallet)
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk WalletId
wid ->
        WorkerCtx ctx
-> WalletId
-> WalletName
-> (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasGenesisData ctx, HasDBLayer IO s k ctx, PaymentAddress n k,
 k ~ IcarusKey, s ~ SeqState n k, Typeable n) =>
ctx
-> WalletId
-> WalletName
-> (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT ErrWalletAlreadyExists IO WalletId
W.createIcarusWallet @(WorkerCtx ctx) @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName
            (k 'RootK XPrv
IcarusKey 'RootK XPrv
rootXPrv, Passphrase "encryption"
pwdP)
  where
    wName :: WalletName
wName    = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((WalletName -> Const WalletName WalletName)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const WalletName (ApiT WalletName))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT WalletName -> Const WalletName (ApiT WalletName))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
#name ((ApiT WalletName -> Const WalletName (ApiT WalletName))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((WalletName -> Const WalletName WalletName)
    -> ApiT WalletName -> Const WalletName (ApiT WalletName))
-> (WalletName -> Const WalletName WalletName)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((WalletName -> Const WalletName WalletName)
   -> ApiT WalletName -> Const WalletName (ApiT WalletName))
(WalletName -> Const WalletName WalletName)
-> ApiT WalletName -> Const WalletName (ApiT WalletName)
#getApiT
    seed :: SomeMnemonic
seed     = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> SomeMnemonic
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSentence"
  ((ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiMnemonicT '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
#mnemonicSentence ((ApiMnemonicT '[12, 15, 18, 21, 24]
  -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> (SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiMnemonicT"
  ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
   -> ApiMnemonicT '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
(SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ApiMnemonicT '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24])
#getApiMnemonicT
    pwd :: Passphrase "user"
pwd      = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const
         (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> Passphrase "user"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const
        (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT (Passphrase "user")
 -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
#passphrase ((ApiT (Passphrase "user")
  -> Const (Passphrase "user") (ApiT (Passphrase "user")))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const
      (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> (Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
   -> ApiT (Passphrase "user")
   -> Const (Passphrase "user") (ApiT (Passphrase "user")))
(Passphrase "user"
 -> Const (Passphrase "user") (Passphrase "user"))
-> ApiT (Passphrase "user")
-> Const (Passphrase "user") (ApiT (Passphrase "user"))
#getApiT
    pwdP :: Passphrase "encryption"
pwdP     = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
pwd
    rootXPrv :: IcarusKey 'RootK XPrv
rootXPrv = SomeMnemonic -> Passphrase "encryption" -> IcarusKey 'RootK XPrv
Icarus.generateKeyFromSeed SomeMnemonic
seed Passphrase "encryption"
pwdP

postTrezorWallet
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , k ~ IcarusKey
        , HasWorkerRegistry s k ctx
        , PaymentAddress n IcarusKey
        , Typeable n
        )
    => ctx
    -> ByronWalletPostData '[12,15,18,21,24]
    -> Handler ApiByronWallet
postTrezorWallet :: ctx
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Handler ApiByronWallet
postTrezorWallet ctx
ctx ByronWalletPostData '[12, 15, 18, 21, 24]
body = do
    ctx
-> (IcarusKey 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, KnownDiscovery s, IsOurs s RewardAccount,
 IsOurs s Address, MaybeLight s, HasNetworkLayer IO ctx,
 WalletKey k, AddressBookIso s) =>
ctx
-> (k 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
postLegacyWallet ctx
ctx (IcarusKey 'RootK XPrv
rootXPrv, Passphrase "user"
pwd) ((WorkerCtx ctx
  -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
 -> Handler ApiByronWallet)
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk WalletId
wid ->
        WorkerCtx ctx
-> WalletId
-> WalletName
-> (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasGenesisData ctx, HasDBLayer IO s k ctx, PaymentAddress n k,
 k ~ IcarusKey, s ~ SeqState n k, Typeable n) =>
ctx
-> WalletId
-> WalletName
-> (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT ErrWalletAlreadyExists IO WalletId
W.createIcarusWallet @(WorkerCtx ctx) @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName
            (k 'RootK XPrv
IcarusKey 'RootK XPrv
rootXPrv, Passphrase "encryption"
pwdP)
  where
    wName :: WalletName
wName    = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((WalletName -> Const WalletName WalletName)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const WalletName (ApiT WalletName))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT WalletName -> Const WalletName (ApiT WalletName))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
#name ((ApiT WalletName -> Const WalletName (ApiT WalletName))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((WalletName -> Const WalletName WalletName)
    -> ApiT WalletName -> Const WalletName (ApiT WalletName))
-> (WalletName -> Const WalletName WalletName)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((WalletName -> Const WalletName WalletName)
   -> ApiT WalletName -> Const WalletName (ApiT WalletName))
(WalletName -> Const WalletName WalletName)
-> ApiT WalletName -> Const WalletName (ApiT WalletName)
#getApiT
    seed :: SomeMnemonic
seed     = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> SomeMnemonic
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSentence"
  ((ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiMnemonicT '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
#mnemonicSentence ((ApiMnemonicT '[12, 15, 18, 21, 24]
  -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> (SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiMnemonicT"
  ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
   -> ApiMnemonicT '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
(SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ApiMnemonicT '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24])
#getApiMnemonicT
    pwd :: Passphrase "user"
pwd      = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const
         (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> Passphrase "user"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const
        (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT (Passphrase "user")
 -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
#passphrase ((ApiT (Passphrase "user")
  -> Const (Passphrase "user") (ApiT (Passphrase "user")))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const
      (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> (Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
   -> ApiT (Passphrase "user")
   -> Const (Passphrase "user") (ApiT (Passphrase "user")))
(Passphrase "user"
 -> Const (Passphrase "user") (Passphrase "user"))
-> ApiT (Passphrase "user")
-> Const (Passphrase "user") (ApiT (Passphrase "user"))
#getApiT
    pwdP :: Passphrase "encryption"
pwdP     = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
pwd
    rootXPrv :: IcarusKey 'RootK XPrv
rootXPrv = SomeMnemonic -> Passphrase "encryption" -> IcarusKey 'RootK XPrv
Icarus.generateKeyFromSeed SomeMnemonic
seed Passphrase "encryption"
pwdP

postLedgerWallet
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , k ~ IcarusKey
        , HasWorkerRegistry s k ctx
        , PaymentAddress n IcarusKey
        , Typeable n
        )
    => ctx
    -> ByronWalletPostData '[12,15,18,21,24]
    -> Handler ApiByronWallet
postLedgerWallet :: ctx
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Handler ApiByronWallet
postLedgerWallet ctx
ctx ByronWalletPostData '[12, 15, 18, 21, 24]
body = do
    ctx
-> (IcarusKey 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, KnownDiscovery s, IsOurs s RewardAccount,
 IsOurs s Address, MaybeLight s, HasNetworkLayer IO ctx,
 WalletKey k, AddressBookIso s) =>
ctx
-> (k 'RootK XPrv, Passphrase "user")
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
postLegacyWallet ctx
ctx (IcarusKey 'RootK XPrv
rootXPrv, Passphrase "user"
pwd) ((WorkerCtx ctx
  -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
 -> Handler ApiByronWallet)
-> (WorkerCtx ctx
    -> WalletId -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> Handler ApiByronWallet
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk WalletId
wid ->
        WorkerCtx ctx
-> WalletId
-> WalletName
-> (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT ErrWalletAlreadyExists IO WalletId
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasGenesisData ctx, HasDBLayer IO s k ctx, PaymentAddress n k,
 k ~ IcarusKey, s ~ SeqState n k, Typeable n) =>
ctx
-> WalletId
-> WalletName
-> (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT ErrWalletAlreadyExists IO WalletId
W.createIcarusWallet @(WorkerCtx ctx) @s @k WorkerCtx ctx
wrk WalletId
wid WalletName
wName
            (k 'RootK XPrv
IcarusKey 'RootK XPrv
rootXPrv, Passphrase "encryption"
pwdP)
  where
    wName :: WalletName
wName    = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((WalletName -> Const WalletName WalletName)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> WalletName
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((ApiT WalletName -> Const WalletName (ApiT WalletName))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT WalletName -> Const WalletName (ApiT WalletName))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
#name ((ApiT WalletName -> Const WalletName (ApiT WalletName))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((WalletName -> Const WalletName WalletName)
    -> ApiT WalletName -> Const WalletName (ApiT WalletName))
-> (WalletName -> Const WalletName WalletName)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const WalletName (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((WalletName -> Const WalletName WalletName)
   -> ApiT WalletName -> Const WalletName (ApiT WalletName))
(WalletName -> Const WalletName WalletName)
-> ApiT WalletName -> Const WalletName (ApiT WalletName)
#getApiT
    mw :: SomeMnemonic
mw       = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> SomeMnemonic
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mnemonicSentence"
  ((ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiMnemonicT '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
#mnemonicSentence ((ApiMnemonicT '[12, 15, 18, 21, 24]
  -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
    -> ApiMnemonicT '[12, 15, 18, 21, 24]
    -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
-> (SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiMnemonicT"
  ((SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
   -> ApiMnemonicT '[12, 15, 18, 21, 24]
   -> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24]))
(SomeMnemonic -> Const SomeMnemonic SomeMnemonic)
-> ApiMnemonicT '[12, 15, 18, 21, 24]
-> Const SomeMnemonic (ApiMnemonicT '[12, 15, 18, 21, 24])
#getApiMnemonicT
    pwd :: Passphrase "user"
pwd      = ByronWalletPostData '[12, 15, 18, 21, 24]
body ByronWalletPostData '[12, 15, 18, 21, 24]
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ByronWalletPostData '[12, 15, 18, 21, 24]
    -> Const
         (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> Passphrase "user"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
   -> ByronWalletPostData '[12, 15, 18, 21, 24]
   -> Const
        (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
(ApiT (Passphrase "user")
 -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
#passphrase ((ApiT (Passphrase "user")
  -> Const (Passphrase "user") (ApiT (Passphrase "user")))
 -> ByronWalletPostData '[12, 15, 18, 21, 24]
 -> Const
      (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24]))
-> ((Passphrase "user"
     -> Const (Passphrase "user") (Passphrase "user"))
    -> ApiT (Passphrase "user")
    -> Const (Passphrase "user") (ApiT (Passphrase "user")))
-> (Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
-> ByronWalletPostData '[12, 15, 18, 21, 24]
-> Const
     (Passphrase "user") (ByronWalletPostData '[12, 15, 18, 21, 24])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "user"
    -> Const (Passphrase "user") (Passphrase "user"))
   -> ApiT (Passphrase "user")
   -> Const (Passphrase "user") (ApiT (Passphrase "user")))
(Passphrase "user"
 -> Const (Passphrase "user") (Passphrase "user"))
-> ApiT (Passphrase "user")
-> Const (Passphrase "user") (ApiT (Passphrase "user"))
#getApiT
    pwdP :: Passphrase "encryption"
pwdP     = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
pwd
    rootXPrv :: IcarusKey 'RootK XPrv
rootXPrv = SomeMnemonic -> Passphrase "encryption" -> IcarusKey 'RootK XPrv
Icarus.generateKeyFromHardwareLedger SomeMnemonic
mw Passphrase "encryption"
pwdP

{-------------------------------------------------------------------------------
                             ApiLayer Discrimination
-------------------------------------------------------------------------------}

-- Legacy wallets like 'Byron Random' and 'Icarus Sequential' are handled
-- through the same API endpoints. However, they rely on different contexts.
-- Since they have identical ids, we actually lookup both contexts in sequence.
withLegacyLayer
    :: forall byron icarus n a.
        ( byron ~ ApiLayer (RndState n) ByronKey
        , icarus ~ ApiLayer (SeqState n IcarusKey) IcarusKey
        )
    => ApiT WalletId
    -> (byron, Handler a)
    -> (icarus, Handler a)
    -> Handler a
withLegacyLayer :: ApiT WalletId
-> (byron, Handler a) -> (icarus, Handler a) -> Handler a
withLegacyLayer (ApiT WalletId
wid) (byron
byron, Handler a
withByron) (icarus
icarus, Handler a
withIcarus) =
    ApiT WalletId
-> (byron, Handler a, ErrWalletNotResponding -> Handler a)
-> (icarus, Handler a, ErrWalletNotResponding -> Handler a)
-> Handler a
forall byron icarus (n :: NetworkDiscriminant) a.
(byron ~ ApiLayer (RndState n) ByronKey,
 icarus ~ ApiLayer (SeqState n IcarusKey) IcarusKey) =>
ApiT WalletId
-> (byron, Handler a, ErrWalletNotResponding -> Handler a)
-> (icarus, Handler a, ErrWalletNotResponding -> Handler a)
-> Handler a
withLegacyLayer' (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
        (byron
byron, Handler a
withByron, ErrWalletNotResponding -> Handler a
forall e a. IsServerError e => e -> Handler a
liftE)
        (icarus
icarus, Handler a
withIcarus, ErrWalletNotResponding -> Handler a
forall e a. IsServerError e => e -> Handler a
liftE)

-- | Like 'withLegacyLayer' but allow passing a custom handler for handling dead
-- workers.
withLegacyLayer'
    :: forall byron icarus n a.
        ( byron ~ ApiLayer (RndState n) ByronKey
        , icarus ~ ApiLayer (SeqState n IcarusKey) IcarusKey
        )
    => ApiT WalletId
    -> (byron, Handler a, ErrWalletNotResponding -> Handler a)
    -> (icarus, Handler a, ErrWalletNotResponding -> Handler a)
    -> Handler a
withLegacyLayer' :: ApiT WalletId
-> (byron, Handler a, ErrWalletNotResponding -> Handler a)
-> (icarus, Handler a, ErrWalletNotResponding -> Handler a)
-> Handler a
withLegacyLayer' (ApiT WalletId
wid)
  (byron
byron, Handler a
withByron, ErrWalletNotResponding -> Handler a
deadByron)
  (icarus
icarus, Handler a
withIcarus, ErrWalletNotResponding -> Handler a
deadIcarus)
    = (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a) -> Handler a
tryByron (Handler a -> ErrNoSuchWallet -> Handler a
forall a b. a -> b -> a
const (Handler a -> ErrNoSuchWallet -> Handler a)
-> Handler a -> ErrNoSuchWallet -> Handler a
forall a b. (a -> b) -> a -> b
$ (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a) -> Handler a
tryIcarus ErrNoSuchWallet -> Handler a
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler a
deadIcarus) ErrWalletNotResponding -> Handler a
deadByron
  where
    tryIcarus :: (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a) -> Handler a
tryIcarus ErrNoSuchWallet -> Handler a
onMissing ErrWalletNotResponding -> Handler a
onNotResponding = icarus
-> WalletId
-> (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a)
-> (WorkerCtx icarus -> Handler a)
-> Handler a
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_
        @(SeqState n IcarusKey)
        @IcarusKey
        icarus
icarus
        WalletId
wid
        ErrNoSuchWallet -> Handler a
onMissing
        ErrWalletNotResponding -> Handler a
onNotResponding
        (Handler a
-> WalletLayer IO (SeqState n IcarusKey) IcarusKey -> Handler a
forall a b. a -> b -> a
const Handler a
withIcarus)

    tryByron :: (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a) -> Handler a
tryByron ErrNoSuchWallet -> Handler a
onMissing ErrWalletNotResponding -> Handler a
onNotResponding = byron
-> WalletId
-> (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a)
-> (WorkerCtx byron -> Handler a)
-> Handler a
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_
        @(RndState n)
        @ByronKey
        byron
byron
        WalletId
wid
        ErrNoSuchWallet -> Handler a
onMissing
        ErrWalletNotResponding -> Handler a
onNotResponding
        (Handler a -> WalletLayer IO (RndState n) ByronKey -> Handler a
forall a b. a -> b -> a
const Handler a
withByron)

{-------------------------------------------------------------------------------
                                   Wallets
-------------------------------------------------------------------------------}

deleteWallet
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        )
    => ctx
    -> ApiT WalletId
    -> Handler NoContent
deleteWallet :: ctx -> ApiT WalletId -> Handler NoContent
deleteWallet ctx
ctx (ApiT WalletId
wid) = do
    -- Start a context so that an error is throw if the wallet doesn't exist.
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE
        (Handler () -> ErrWalletNotResponding -> Handler ()
forall a b. a -> b -> a
const (Handler () -> ErrWalletNotResponding -> Handler ())
-> Handler () -> ErrWalletNotResponding -> Handler ()
forall a b. (a -> b) -> a -> b
$ () -> Handler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure()) (Handler () -> WalletLayer IO s k -> Handler ()
forall a b. a -> b -> a
const (Handler () -> WalletLayer IO s k -> Handler ())
-> Handler () -> WalletLayer IO s k -> Handler ()
forall a b. (a -> b) -> a -> b
$ () -> Handler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

    IO () -> Handler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WorkerRegistry WalletId (DBLayer IO s k) -> WalletId -> IO ()
forall key resource.
Ord key =>
WorkerRegistry key resource -> key -> IO ()
Registry.unregister WorkerRegistry WalletId (DBLayer IO s k)
re WalletId
wid
    IO () -> Handler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ DBFactory IO s k -> WalletId -> IO ()
forall (m :: * -> *) s (k :: Depth -> * -> *).
DBFactory m s k -> WalletId -> IO ()
removeDatabase DBFactory IO s k
df WalletId
wid

    NoContent -> Handler NoContent
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent
  where
    re :: WorkerRegistry WalletId (DBLayer IO s k)
re = ctx
ctx ctx
-> ((WorkerRegistry WalletId (DBLayer IO s k)
     -> Const
          (WorkerRegistry WalletId (DBLayer IO s k))
          (WorkerRegistry WalletId (DBLayer IO s k)))
    -> ctx -> Const (WorkerRegistry WalletId (DBLayer IO s k)) ctx)
-> WorkerRegistry WalletId (DBLayer IO s k)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
forall s (k :: Depth -> * -> *) ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
workerRegistry @s @k
    df :: DBFactory IO s k
df = ctx
ctx ctx
-> ((DBFactory IO s k
     -> Const (DBFactory IO s k) (DBFactory IO s k))
    -> ctx -> Const (DBFactory IO s k) ctx)
-> DBFactory IO s k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx. HasDBFactory s k ctx => Lens' ctx (DBFactory IO s k)
forall s (k :: Depth -> * -> *) ctx.
HasDBFactory s k ctx =>
Lens' ctx (DBFactory IO s k)
dbFactory @s @k

getWallet
    :: forall ctx s k apiWallet.
        ( ctx ~ ApiLayer s k
        , HasWorkerRegistry s k ctx
        , HasDBFactory s k ctx
        )
    => ctx
    -> MkApiWallet ctx s apiWallet
    -> ApiT WalletId
    -> Handler (apiWallet, UTCTime)
getWallet :: ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx MkApiWallet ctx s apiWallet
mkApiWallet (ApiT WalletId
wid) = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (apiWallet, UTCTime))
-> (ErrWalletNotResponding -> Handler (apiWallet, UTCTime))
-> (WorkerCtx ctx -> Handler (apiWallet, UTCTime))
-> Handler (apiWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (apiWallet, UTCTime)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (apiWallet, UTCTime)
whenNotResponding WalletLayer IO s k -> Handler (apiWallet, UTCTime)
WorkerCtx ctx -> Handler (apiWallet, UTCTime)
whenAlive
  where
    df :: DBFactory IO s k
df = ctx
ctx ctx
-> ((DBFactory IO s k
     -> Const (DBFactory IO s k) (DBFactory IO s k))
    -> ctx -> Const (DBFactory IO s k) ctx)
-> DBFactory IO s k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx. HasDBFactory s k ctx => Lens' ctx (DBFactory IO s k)
forall s (k :: Depth -> * -> *) ctx.
HasDBFactory s k ctx =>
Lens' ctx (DBFactory IO s k)
dbFactory @s @k

    whenAlive :: WalletLayer IO s k -> Handler (apiWallet, UTCTime)
whenAlive WalletLayer IO s k
wrk = do
        (Wallet s
cp, WalletMetadata
meta, Set Tx
pending) <- ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> Handler (Wallet s, WalletMetadata, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
 -> Handler (Wallet s, WalletMetadata, Set Tx))
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> Handler (Wallet s, WalletMetadata, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
W.readWallet @_ @s @k WalletLayer IO s k
wrk WalletId
wid
        SyncProgress
progress <- IO SyncProgress -> Handler SyncProgress
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SyncProgress -> Handler SyncProgress)
-> IO SyncProgress -> Handler SyncProgress
forall a b. (a -> b) -> a -> b
$ ctx -> Wallet s -> IO SyncProgress
forall ctx s.
HasNetworkLayer IO ctx =>
ctx -> Wallet s -> IO SyncProgress
W.walletSyncProgress @_ @_ ctx
ctx Wallet s
cp
        (, WalletMetadata
meta WalletMetadata
-> ((UTCTime -> Const UTCTime UTCTime)
    -> WalletMetadata -> Const UTCTime WalletMetadata)
-> UTCTime
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "creationTime"
  ((UTCTime -> Const UTCTime UTCTime)
   -> WalletMetadata -> Const UTCTime WalletMetadata)
(UTCTime -> Const UTCTime UTCTime)
-> WalletMetadata -> Const UTCTime WalletMetadata
#creationTime) (apiWallet -> (apiWallet, UTCTime))
-> Handler apiWallet -> Handler (apiWallet, UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiWallet ctx s apiWallet
mkApiWallet ctx
ctx WalletId
wid Wallet s
cp WalletMetadata
meta Set Tx
pending SyncProgress
progress

    whenNotResponding :: ErrWalletNotResponding -> Handler (apiWallet, UTCTime)
whenNotResponding ErrWalletNotResponding
_ = ExceptT ServerError IO (apiWallet, UTCTime)
-> Handler (apiWallet, UTCTime)
forall a. ExceptT ServerError IO a -> Handler a
Handler (ExceptT ServerError IO (apiWallet, UTCTime)
 -> Handler (apiWallet, UTCTime))
-> ExceptT ServerError IO (apiWallet, UTCTime)
-> Handler (apiWallet, UTCTime)
forall a b. (a -> b) -> a -> b
$ IO (Either ServerError (apiWallet, UTCTime))
-> ExceptT ServerError IO (apiWallet, UTCTime)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ServerError (apiWallet, UTCTime))
 -> ExceptT ServerError IO (apiWallet, UTCTime))
-> IO (Either ServerError (apiWallet, UTCTime))
-> ExceptT ServerError IO (apiWallet, UTCTime)
forall a b. (a -> b) -> a -> b
$ DBFactory IO s k
-> WalletId
-> (DBLayer IO s k -> IO (Either ServerError (apiWallet, UTCTime)))
-> IO (Either ServerError (apiWallet, UTCTime))
forall (m :: * -> *) s (k :: Depth -> * -> *).
DBFactory m s k
-> forall a. WalletId -> (DBLayer m s k -> IO a) -> IO a
withDatabase DBFactory IO s k
df WalletId
wid ((DBLayer IO s k -> IO (Either ServerError (apiWallet, UTCTime)))
 -> IO (Either ServerError (apiWallet, UTCTime)))
-> (DBLayer IO s k -> IO (Either ServerError (apiWallet, UTCTime)))
-> IO (Either ServerError (apiWallet, UTCTime))
forall a b. (a -> b) -> a -> b
$ \DBLayer IO s k
db -> Handler (apiWallet, UTCTime)
-> IO (Either ServerError (apiWallet, UTCTime))
forall a. Handler a -> IO (Either ServerError a)
runHandler (Handler (apiWallet, UTCTime)
 -> IO (Either ServerError (apiWallet, UTCTime)))
-> Handler (apiWallet, UTCTime)
-> IO (Either ServerError (apiWallet, UTCTime))
forall a b. (a -> b) -> a -> b
$ do
        let wrk :: WorkerCtx ctx
wrk = DBLayer IO s k
-> (WorkerMsg ctx -> WorkerLog (WorkerKey ctx) (WorkerMsg ctx))
-> ctx
-> WorkerCtx ctx
forall resource ctx.
HasWorkerCtx resource ctx =>
resource
-> (WorkerMsg ctx -> WorkerLog (WorkerKey ctx) (WorkerMsg ctx))
-> ctx
-> WorkerCtx ctx
hoistResource DBLayer IO s k
db (WalletId -> WalletWorkerLog -> WorkerLog WalletId WalletWorkerLog
forall key msg. key -> msg -> WorkerLog key msg
MsgFromWorker WalletId
wid) ctx
ctx
        (Wallet s
cp, WalletMetadata
meta, Set Tx
pending) <- ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> Handler (Wallet s, WalletMetadata, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
 -> Handler (Wallet s, WalletMetadata, Set Tx))
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> Handler (Wallet s, WalletMetadata, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
W.readWallet @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        (, WalletMetadata
meta WalletMetadata
-> ((UTCTime -> Const UTCTime UTCTime)
    -> WalletMetadata -> Const UTCTime WalletMetadata)
-> UTCTime
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "creationTime"
  ((UTCTime -> Const UTCTime UTCTime)
   -> WalletMetadata -> Const UTCTime WalletMetadata)
(UTCTime -> Const UTCTime UTCTime)
-> WalletMetadata -> Const UTCTime WalletMetadata
#creationTime) (apiWallet -> (apiWallet, UTCTime))
-> Handler apiWallet -> Handler (apiWallet, UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiWallet ctx s apiWallet
mkApiWallet ctx
ctx WalletId
wid Wallet s
cp WalletMetadata
meta Set Tx
pending SyncProgress
NotResponding

listWallets
    :: forall ctx s k apiWallet.
        ( ctx ~ ApiLayer s k
        , NFData apiWallet
        )
    => ctx
    -> MkApiWallet ctx s apiWallet
    -> Handler [(apiWallet, UTCTime)]
listWallets :: ctx
-> MkApiWallet ctx s apiWallet -> Handler [(apiWallet, UTCTime)]
listWallets ctx
ctx MkApiWallet ctx s apiWallet
mkApiWallet = do
    [WalletId]
wids <- IO [WalletId] -> Handler [WalletId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WalletId] -> Handler [WalletId])
-> IO [WalletId] -> Handler [WalletId]
forall a b. (a -> b) -> a -> b
$ DBFactory IO s k -> IO [WalletId]
forall (m :: * -> *) s (k :: Depth -> * -> *).
DBFactory m s k -> IO [WalletId]
listDatabases DBFactory IO s k
df
    IO [(apiWallet, UTCTime)] -> Handler [(apiWallet, UTCTime)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(apiWallet, UTCTime)] -> Handler [(apiWallet, UTCTime)])
-> IO [(apiWallet, UTCTime)] -> Handler [(apiWallet, UTCTime)]
forall a b. (a -> b) -> a -> b
$ ((apiWallet, UTCTime) -> UTCTime)
-> [(apiWallet, UTCTime)] -> [(apiWallet, UTCTime)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (apiWallet, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd ([(apiWallet, UTCTime)] -> [(apiWallet, UTCTime)])
-> ([Maybe (apiWallet, UTCTime)] -> [(apiWallet, UTCTime)])
-> [Maybe (apiWallet, UTCTime)]
-> [(apiWallet, UTCTime)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (apiWallet, UTCTime)] -> [(apiWallet, UTCTime)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (apiWallet, UTCTime)] -> [(apiWallet, UTCTime)])
-> IO [Maybe (apiWallet, UTCTime)] -> IO [(apiWallet, UTCTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ApiT WalletId -> IO (Maybe (apiWallet, UTCTime)))
-> [ApiT WalletId] -> IO [Maybe (apiWallet, UTCTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ApiT WalletId -> IO (Maybe (apiWallet, UTCTime))
maybeGetWallet (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT (WalletId -> ApiT WalletId) -> [WalletId] -> [ApiT WalletId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WalletId]
wids)
  where
    df :: DBFactory IO s k
df = ctx
ctx ctx
-> ((DBFactory IO s k
     -> Const (DBFactory IO s k) (DBFactory IO s k))
    -> ctx -> Const (DBFactory IO s k) ctx)
-> DBFactory IO s k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx. HasDBFactory s k ctx => Lens' ctx (DBFactory IO s k)
forall s (k :: Depth -> * -> *) ctx.
HasDBFactory s k ctx =>
Lens' ctx (DBFactory IO s k)
dbFactory @s @k

    -- Under extreme circumstances (like integration tests running in parallel)
    -- there may be race conditions where the wallet is deleted just before we
    -- try to read it.
    --
    -- But.. why do we need to both runHandler and tryAnyDeep?
    maybeGetWallet :: ApiT WalletId -> IO (Maybe (apiWallet, UTCTime))
    maybeGetWallet :: ApiT WalletId -> IO (Maybe (apiWallet, UTCTime))
maybeGetWallet =
        (Either SomeException (Maybe (apiWallet, UTCTime))
 -> Maybe (apiWallet, UTCTime))
-> IO (Either SomeException (Maybe (apiWallet, UTCTime)))
-> IO (Maybe (apiWallet, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Maybe (apiWallet, UTCTime)) -> Maybe (apiWallet, UTCTime)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (apiWallet, UTCTime)) -> Maybe (apiWallet, UTCTime))
-> (Either SomeException (Maybe (apiWallet, UTCTime))
    -> Maybe (Maybe (apiWallet, UTCTime)))
-> Either SomeException (Maybe (apiWallet, UTCTime))
-> Maybe (apiWallet, UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (Maybe (apiWallet, UTCTime))
-> Maybe (Maybe (apiWallet, UTCTime))
forall a b. Either a b -> Maybe b
eitherToMaybe)
        (IO (Either SomeException (Maybe (apiWallet, UTCTime)))
 -> IO (Maybe (apiWallet, UTCTime)))
-> (ApiT WalletId
    -> IO (Either SomeException (Maybe (apiWallet, UTCTime))))
-> ApiT WalletId
-> IO (Maybe (apiWallet, UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe (apiWallet, UTCTime))
-> IO (Either SomeException (Maybe (apiWallet, UTCTime)))
forall (m :: * -> *) a.
(MonadUnliftIO m, NFData a) =>
m a -> m (Either SomeException a)
tryAnyDeep
        (IO (Maybe (apiWallet, UTCTime))
 -> IO (Either SomeException (Maybe (apiWallet, UTCTime))))
-> (ApiT WalletId -> IO (Maybe (apiWallet, UTCTime)))
-> ApiT WalletId
-> IO (Either SomeException (Maybe (apiWallet, UTCTime)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ServerError (apiWallet, UTCTime)
 -> Maybe (apiWallet, UTCTime))
-> IO (Either ServerError (apiWallet, UTCTime))
-> IO (Maybe (apiWallet, UTCTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either ServerError (apiWallet, UTCTime)
-> Maybe (apiWallet, UTCTime)
forall a b. Either a b -> Maybe b
eitherToMaybe
        (IO (Either ServerError (apiWallet, UTCTime))
 -> IO (Maybe (apiWallet, UTCTime)))
-> (ApiT WalletId -> IO (Either ServerError (apiWallet, UTCTime)))
-> ApiT WalletId
-> IO (Maybe (apiWallet, UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler (apiWallet, UTCTime)
-> IO (Either ServerError (apiWallet, UTCTime))
forall a. Handler a -> IO (Either ServerError a)
runHandler
        (Handler (apiWallet, UTCTime)
 -> IO (Either ServerError (apiWallet, UTCTime)))
-> (ApiT WalletId -> Handler (apiWallet, UTCTime))
-> ApiT WalletId
-> IO (Either ServerError (apiWallet, UTCTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx MkApiWallet ctx s apiWallet
mkApiWallet

putWallet
    :: forall ctx s k apiWallet.
        ( ctx ~ ApiLayer s k
        )
    => ctx
    -> MkApiWallet ctx s apiWallet
    -> ApiT WalletId
    -> WalletPutData
    -> Handler apiWallet
putWallet :: ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> WalletPutData
-> Handler apiWallet
putWallet ctx
ctx MkApiWallet ctx s apiWallet
mkApiWallet (ApiT WalletId
wid) WalletPutData
body = do
    case WalletPutData
body WalletPutData
-> ((Maybe (ApiT WalletName)
     -> Const (Maybe (ApiT WalletName)) (Maybe (ApiT WalletName)))
    -> WalletPutData -> Const (Maybe (ApiT WalletName)) WalletPutData)
-> Maybe (ApiT WalletName)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "name"
  ((Maybe (ApiT WalletName)
    -> Const (Maybe (ApiT WalletName)) (Maybe (ApiT WalletName)))
   -> WalletPutData -> Const (Maybe (ApiT WalletName)) WalletPutData)
(Maybe (ApiT WalletName)
 -> Const (Maybe (ApiT WalletName)) (Maybe (ApiT WalletName)))
-> WalletPutData -> Const (Maybe (ApiT WalletName)) WalletPutData
#name of
        Maybe (ApiT WalletName)
Nothing ->
            () -> Handler ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (ApiT WalletName
wName) -> ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
            ExceptT ErrNoSuchWallet IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO () -> Handler ())
-> ExceptT ErrNoSuchWallet IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> (WalletMetadata -> WalletMetadata)
-> ExceptT ErrNoSuchWallet IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> (WalletMetadata -> WalletMetadata)
-> ExceptT ErrNoSuchWallet IO ()
W.updateWallet WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid (WalletName -> WalletMetadata -> WalletMetadata
modify WalletName
wName)
    (apiWallet, UTCTime) -> apiWallet
forall a b. (a, b) -> a
fst ((apiWallet, UTCTime) -> apiWallet)
-> Handler (apiWallet, UTCTime) -> Handler apiWallet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
forall ctx s (k :: Depth -> * -> *) apiWallet.
(ctx ~ ApiLayer s k, HasWorkerRegistry s k ctx,
 HasDBFactory s k ctx) =>
ctx
-> MkApiWallet ctx s apiWallet
-> ApiT WalletId
-> Handler (apiWallet, UTCTime)
getWallet ctx
ctx MkApiWallet ctx s apiWallet
mkApiWallet (WalletId -> ApiT WalletId
forall a. a -> ApiT a
ApiT WalletId
wid)
  where
    modify :: W.WalletName -> WalletMetadata -> WalletMetadata
    modify :: WalletName -> WalletMetadata -> WalletMetadata
modify WalletName
wName WalletMetadata
meta = WalletMetadata
meta { $sel:name:WalletMetadata :: WalletName
name = WalletName
wName }

putWalletPassphrase
    :: forall ctx s k.
        ( WalletKey k
        , ctx ~ ApiLayer s k
        , GetAccount s k
        , HardDerivation k)
    => ctx
    -> ((SomeMnemonic, Maybe SomeMnemonic)
            -> Passphrase "encryption"
            -> k 'RootK XPrv
        )
    -> (k 'AccountK XPub -> XPub)
    -> ApiT WalletId
    -> WalletPutPassphraseData
    -> Handler NoContent
putWalletPassphrase :: ctx
-> ((SomeMnemonic, Maybe SomeMnemonic)
    -> Passphrase "encryption" -> k 'RootK XPrv)
-> (k 'AccountK XPub -> XPub)
-> ApiT WalletId
-> WalletPutPassphraseData
-> Handler NoContent
putWalletPassphrase ctx
ctx (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
createKey k 'AccountK XPub -> XPub
getKey (ApiT WalletId
wid)
    (WalletPutPassphraseData Either
  WalletPutPassphraseOldPassphraseData
  WalletPutPassphraseMnemonicData
method) = (WorkerCtx (ApiLayer s k) -> Handler NoContent)
-> Handler NoContent
forall a. (WorkerCtx (ApiLayer s k) -> Handler a) -> Handler a
withWrk ((WorkerCtx (ApiLayer s k) -> Handler NoContent)
 -> Handler NoContent)
-> (WorkerCtx (ApiLayer s k) -> Handler NoContent)
-> Handler NoContent
forall a b. (a -> b) -> a -> b
$ \WorkerCtx (ApiLayer s k)
wrk ->
        NoContent
NoContent NoContent -> Handler () -> Handler NoContent
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case Either
  WalletPutPassphraseOldPassphraseData
  WalletPutPassphraseMnemonicData
method of
        Left
            (Api.WalletPutPassphraseOldPassphraseData
                (ApiT Passphrase "user"
old)
                (ApiT Passphrase "user"
new)
            ) -> ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                (ExceptT ErrUpdatePassphrase IO () -> Handler ())
-> ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> (Passphrase "user", Passphrase "user")
-> ExceptT ErrUpdatePassphrase IO ()
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, WalletKey k) =>
ctx
-> WalletId
-> (Passphrase "user", Passphrase "user")
-> ExceptT ErrUpdatePassphrase IO ()
W.updateWalletPassphraseWithOldPassphrase WalletLayer IO s k
WorkerCtx (ApiLayer s k)
wrk WalletId
wid (Passphrase "user"
old, Passphrase "user"
new)
        Right
            (Api.WalletPutPassphraseMnemonicData
                    (ApiMnemonicT SomeMnemonic
mnemonic) Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
sndFactor (ApiT Passphrase "user"
new)
            ) -> do
            let encrPass :: Passphrase "encryption"
encrPass = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
currentPassphraseScheme Passphrase "user"
new
                challengeKey :: k 'RootK XPrv
challengeKey = (SomeMnemonic, Maybe SomeMnemonic)
-> Passphrase "encryption" -> k 'RootK XPrv
createKey
                    (SomeMnemonic
mnemonic, ApiMnemonicT '[9, 12] -> SomeMnemonic
forall (sizes :: [Nat]). ApiMnemonicT sizes -> SomeMnemonic
getApiMnemonicT (ApiMnemonicT '[9, 12] -> SomeMnemonic)
-> Maybe (ApiMnemonicT '[9, 12]) -> Maybe SomeMnemonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ApiMnemonicT '[9, 12])
Maybe (ApiMnemonicT (AllowedMnemonics 'SndFactor))
sndFactor) Passphrase "encryption"
encrPass
                challengPubKey :: k 'AccountK XPub
challengPubKey = k 'AccountK XPrv -> k 'AccountK XPub
forall (key :: Depth -> * -> *) (depth :: Depth).
WalletKey key =>
key depth XPrv -> key depth XPub
publicKey
                    (k 'AccountK XPrv -> k 'AccountK XPub)
-> k 'AccountK XPrv -> k 'AccountK XPub
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption"
-> k 'RootK XPrv -> Index 'Hardened 'AccountK -> k 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'RootK XPrv
-> Index 'Hardened 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
encrPass k 'RootK XPrv
challengeKey Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound
            k 'AccountK XPub
storedPubKey <- ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-> Handler (k 'AccountK XPub)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                (ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
 -> Handler (k 'AccountK XPub))
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-> Handler (k 'AccountK XPub)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, GetAccount s k) =>
ctx
-> WalletId
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
W.readAccountPublicKey WalletLayer IO s k
WorkerCtx (ApiLayer s k)
wrk WalletId
wid
            if k 'AccountK XPub -> XPub
getKey k 'AccountK XPub
challengPubKey XPub -> XPub -> Bool
forall a. Eq a => a -> a -> Bool
== k 'AccountK XPub -> XPub
getKey k 'AccountK XPub
storedPubKey
                then ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                    (ExceptT ErrUpdatePassphrase IO () -> Handler ())
-> ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrUpdatePassphrase IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> (k 'RootK XPrv, Passphrase "user")
-> ExceptT ErrUpdatePassphrase IO ()
W.updateWalletPassphraseWithMnemonic
                        WalletLayer IO s k
WorkerCtx (ApiLayer s k)
wrk WalletId
wid (k 'RootK XPrv
challengeKey, Passphrase "user"
new)
                else ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                    (ExceptT ErrUpdatePassphrase IO () -> Handler ())
-> ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrUpdatePassphrase -> ExceptT ErrUpdatePassphrase IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
                    (ErrUpdatePassphrase -> ExceptT ErrUpdatePassphrase IO ())
-> ErrUpdatePassphrase -> ExceptT ErrUpdatePassphrase IO ()
forall a b. (a -> b) -> a -> b
$ ErrWithRootKey -> ErrUpdatePassphrase
ErrUpdatePassphraseWithRootKey
                    (ErrWithRootKey -> ErrUpdatePassphrase)
-> ErrWithRootKey -> ErrUpdatePassphrase
forall a b. (a -> b) -> a -> b
$ WalletId -> ErrWithRootKey
ErrWithRootKeyWrongMnemonic WalletId
wid
    where
        withWrk :: (WorkerCtx (ApiLayer s k) -> Handler a) -> Handler a
        withWrk :: (WorkerCtx (ApiLayer s k) -> Handler a) -> Handler a
withWrk = ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler a)
-> (ErrWalletNotResponding -> Handler a)
-> (WorkerCtx ctx -> Handler a)
-> Handler a
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler a
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler a
forall e a. IsServerError e => e -> Handler a
liftE

putByronWalletPassphrase
    :: forall ctx s k.
        ( WalletKey k
        , ctx ~ ApiLayer s k
        )
    => ctx
    -> ApiT WalletId
    -> ByronWalletPutPassphraseData
    -> Handler NoContent
putByronWalletPassphrase :: ctx
-> ApiT WalletId
-> ByronWalletPutPassphraseData
-> Handler NoContent
putByronWalletPassphrase ctx
ctx (ApiT WalletId
wid) ByronWalletPutPassphraseData
body = do
    let (ByronWalletPutPassphraseData Maybe (ApiT (Passphrase "lenient"))
oldM (ApiT Passphrase "user"
new)) = ByronWalletPutPassphraseData
body
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrUpdatePassphrase IO () -> Handler ())
-> ExceptT ErrUpdatePassphrase IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ do
        let old :: Passphrase "user"
old = Passphrase "user"
-> (ApiT (Passphrase "lenient") -> Passphrase "user")
-> Maybe (ApiT (Passphrase "lenient"))
-> Passphrase "user"
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Passphrase "user"
forall a. Monoid a => a
mempty (Passphrase "lenient" -> Passphrase "user"
coerce (Passphrase "lenient" -> Passphrase "user")
-> (ApiT (Passphrase "lenient") -> Passphrase "lenient")
-> ApiT (Passphrase "lenient")
-> Passphrase "user"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a. ApiT a -> a
getApiT) Maybe (ApiT (Passphrase "lenient"))
oldM
        WalletLayer IO s k
-> WalletId
-> (Passphrase "user", Passphrase "user")
-> ExceptT ErrUpdatePassphrase IO ()
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, WalletKey k) =>
ctx
-> WalletId
-> (Passphrase "user", Passphrase "user")
-> ExceptT ErrUpdatePassphrase IO ()
W.updateWalletPassphraseWithOldPassphrase WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid (Passphrase "user"
old, Passphrase "user"
new)
    NoContent -> Handler NoContent
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent

getUTxOsStatistics
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        )
    => ctx
    -> ApiT WalletId
    -> Handler ApiUtxoStatistics
getUTxOsStatistics :: ctx -> ApiT WalletId -> Handler ApiUtxoStatistics
getUTxOsStatistics ctx
ctx (ApiT WalletId
wid) = do
    UTxOStatistics
stats <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler UTxOStatistics)
-> (ErrWalletNotResponding -> Handler UTxOStatistics)
-> (WorkerCtx ctx -> Handler UTxOStatistics)
-> Handler UTxOStatistics
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler UTxOStatistics
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler UTxOStatistics
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler UTxOStatistics)
 -> Handler UTxOStatistics)
-> (WorkerCtx ctx -> Handler UTxOStatistics)
-> Handler UTxOStatistics
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrListUTxOStatistics IO UTxOStatistics
-> Handler UTxOStatistics
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrListUTxOStatistics IO UTxOStatistics
 -> Handler UTxOStatistics)
-> ExceptT ErrListUTxOStatistics IO UTxOStatistics
-> Handler UTxOStatistics
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO s k
-> WalletId -> ExceptT ErrListUTxOStatistics IO UTxOStatistics
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx -> WalletId -> ExceptT ErrListUTxOStatistics IO UTxOStatistics
W.listUtxoStatistics WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
    ApiUtxoStatistics -> Handler ApiUtxoStatistics
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiUtxoStatistics -> Handler ApiUtxoStatistics)
-> ApiUtxoStatistics -> Handler ApiUtxoStatistics
forall a b. (a -> b) -> a -> b
$ UTxOStatistics -> ApiUtxoStatistics
toApiUtxoStatistics UTxOStatistics
stats

getWalletUtxoSnapshot
    :: forall ctx s k. (ctx ~ ApiLayer s k)
    => ctx
    -> ApiT WalletId
    -> Handler ApiWalletUtxoSnapshot
getWalletUtxoSnapshot :: ctx -> ApiT WalletId -> Handler ApiWalletUtxoSnapshot
getWalletUtxoSnapshot ctx
ctx (ApiT WalletId
wid) = do
    [(TokenBundle, Coin)]
entries <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler [(TokenBundle, Coin)])
-> (ErrWalletNotResponding -> Handler [(TokenBundle, Coin)])
-> (WorkerCtx ctx -> Handler [(TokenBundle, Coin)])
-> Handler [(TokenBundle, Coin)]
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler [(TokenBundle, Coin)]
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler [(TokenBundle, Coin)]
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler [(TokenBundle, Coin)])
 -> Handler [(TokenBundle, Coin)])
-> (WorkerCtx ctx -> Handler [(TokenBundle, Coin)])
-> Handler [(TokenBundle, Coin)]
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrNoSuchWallet IO [(TokenBundle, Coin)]
-> Handler [(TokenBundle, Coin)]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO [(TokenBundle, Coin)]
 -> Handler [(TokenBundle, Coin)])
-> ExceptT ErrNoSuchWallet IO [(TokenBundle, Coin)]
-> Handler [(TokenBundle, Coin)]
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO s k
-> WalletId -> ExceptT ErrNoSuchWallet IO [(TokenBundle, Coin)]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx,
 HasTransactionLayer k ctx) =>
ctx -> WalletId -> ExceptT ErrNoSuchWallet IO [(TokenBundle, Coin)]
W.getWalletUtxoSnapshot WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
    ApiWalletUtxoSnapshot -> Handler ApiWalletUtxoSnapshot
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiWalletUtxoSnapshot -> Handler ApiWalletUtxoSnapshot)
-> ApiWalletUtxoSnapshot -> Handler ApiWalletUtxoSnapshot
forall a b. (a -> b) -> a -> b
$ [(TokenBundle, Coin)] -> ApiWalletUtxoSnapshot
mkApiWalletUtxoSnapshot [(TokenBundle, Coin)]
entries
  where
    mkApiWalletUtxoSnapshot :: [(TokenBundle, Coin)] -> ApiWalletUtxoSnapshot
    mkApiWalletUtxoSnapshot :: [(TokenBundle, Coin)] -> ApiWalletUtxoSnapshot
mkApiWalletUtxoSnapshot [(TokenBundle, Coin)]
bundleMinCoins = ApiWalletUtxoSnapshot :: [ApiWalletUtxoSnapshotEntry] -> ApiWalletUtxoSnapshot
ApiWalletUtxoSnapshot
        { $sel:entries:ApiWalletUtxoSnapshot :: [ApiWalletUtxoSnapshotEntry]
entries = (TokenBundle, Coin) -> ApiWalletUtxoSnapshotEntry
mkApiWalletUtxoSnapshotEntry ((TokenBundle, Coin) -> ApiWalletUtxoSnapshotEntry)
-> [(TokenBundle, Coin)] -> [ApiWalletUtxoSnapshotEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TokenBundle, Coin)]
bundleMinCoins }

    mkApiWalletUtxoSnapshotEntry
        :: (TokenBundle, Coin) -> ApiWalletUtxoSnapshotEntry
    mkApiWalletUtxoSnapshotEntry :: (TokenBundle, Coin) -> ApiWalletUtxoSnapshotEntry
mkApiWalletUtxoSnapshotEntry (TokenBundle
bundle, Coin
minCoin) = ApiWalletUtxoSnapshotEntry :: Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> ApiWalletUtxoSnapshotEntry
ApiWalletUtxoSnapshotEntry
        { $sel:ada:ApiWalletUtxoSnapshotEntry :: Quantity "lovelace" Natural
ada = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin TokenBundle
bundle
        , $sel:adaMinimum:ApiWalletUtxoSnapshotEntry :: Quantity "lovelace" Natural
adaMinimum = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
minCoin
        , $sel:assets:ApiWalletUtxoSnapshotEntry :: ApiT TokenMap
assets = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenMap -> ApiT TokenMap) -> TokenMap -> ApiT TokenMap
forall a b. (a -> b) -> a -> b
$ ((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens TokenBundle
bundle
        }

{-------------------------------------------------------------------------------
                                  Coin Selections
-------------------------------------------------------------------------------}

selectCoins
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , SoftDerivation k
        , IsOurs s Address
        , GenChange s
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , Typeable n
        , Typeable s
        , WalletKey k
        , BoundedAddressLength k
        )
    => ctx
    -> ArgGenChange s
    -> ApiT WalletId
    -> ApiSelectCoinsPayments n
    -> Handler (ApiCoinSelection n)
selectCoins :: ctx
-> ArgGenChange s
-> ApiT WalletId
-> ApiSelectCoinsPayments n
-> Handler (ApiCoinSelection n)
selectCoins ctx
ctx ArgGenChange s
genChange (ApiT WalletId
wid) ApiSelectCoinsPayments n
body = do
    let md :: Maybe TxMetadata
md = ApiSelectCoinsPayments n
body ApiSelectCoinsPayments n
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> ApiSelectCoinsPayments n
    -> Const (First TxMetadata) (ApiSelectCoinsPayments n))
-> Maybe TxMetadata
forall s a.
s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? IsLabel
  "metadata"
  ((Maybe (ApiT TxMetadata)
    -> Const (First TxMetadata) (Maybe (ApiT TxMetadata)))
   -> ApiSelectCoinsPayments n
   -> Const (First TxMetadata) (ApiSelectCoinsPayments n))
(Maybe (ApiT TxMetadata)
 -> Const (First TxMetadata) (Maybe (ApiT TxMetadata)))
-> ApiSelectCoinsPayments n
-> Const (First TxMetadata) (ApiSelectCoinsPayments n)
#metadata ((Maybe (ApiT TxMetadata)
  -> Const (First TxMetadata) (Maybe (ApiT TxMetadata)))
 -> ApiSelectCoinsPayments n
 -> Const (First TxMetadata) (ApiSelectCoinsPayments n))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> Maybe (ApiT TxMetadata)
    -> Const (First TxMetadata) (Maybe (ApiT TxMetadata)))
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> ApiSelectCoinsPayments n
-> Const (First TxMetadata) (ApiSelectCoinsPayments n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiT TxMetadata -> Const (First TxMetadata) (ApiT TxMetadata))
-> Maybe (ApiT TxMetadata)
-> Const (First TxMetadata) (Maybe (ApiT TxMetadata))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ApiT TxMetadata -> Const (First TxMetadata) (ApiT TxMetadata))
 -> Maybe (ApiT TxMetadata)
 -> Const (First TxMetadata) (Maybe (ApiT TxMetadata)))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> ApiT TxMetadata -> Const (First TxMetadata) (ApiT TxMetadata))
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> Maybe (ApiT TxMetadata)
-> Const (First TxMetadata) (Maybe (ApiT TxMetadata))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((TxMetadata -> Const (First TxMetadata) TxMetadata)
   -> ApiT TxMetadata -> Const (First TxMetadata) (ApiT TxMetadata))
(TxMetadata -> Const (First TxMetadata) TxMetadata)
-> ApiT TxMetadata -> Const (First TxMetadata) (ApiT TxMetadata)
#getApiT

    -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
    -- @currentNodeEra@ which is not guaranteed with the era read here. This
    -- could cause problems under exceptional circumstances.
    (Withdrawal
wdrl, RewardAccountBuilder k
_) <-
        ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid (ApiSelectCoinsPayments n
body ApiSelectCoinsPayments n
-> ((Maybe ApiWithdrawalPostData
     -> Const
          (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
    -> ApiSelectCoinsPayments n
    -> Const (Maybe ApiWithdrawalPostData) (ApiSelectCoinsPayments n))
-> Maybe ApiWithdrawalPostData
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawal"
  ((Maybe ApiWithdrawalPostData
    -> Const
         (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
   -> ApiSelectCoinsPayments n
   -> Const (Maybe ApiWithdrawalPostData) (ApiSelectCoinsPayments n))
(Maybe ApiWithdrawalPostData
 -> Const
      (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
-> ApiSelectCoinsPayments n
-> Const (Maybe ApiWithdrawalPostData) (ApiSelectCoinsPayments n)
#withdrawal)

    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiCoinSelection n))
-> (ErrWalletNotResponding -> Handler (ApiCoinSelection n))
-> (WorkerCtx ctx -> Handler (ApiCoinSelection n))
-> Handler (ApiCoinSelection n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiCoinSelection n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiCoinSelection n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiCoinSelection n))
 -> Handler (ApiCoinSelection n))
-> (WorkerCtx ctx -> Handler (ApiCoinSelection n))
-> Handler (ApiCoinSelection n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        let outs :: NonEmpty TxOut
outs = AddressAmount (ApiT Address, Proxy n) -> TxOut
forall (n :: NetworkDiscriminant).
AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address, Proxy n) -> TxOut)
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
-> NonEmpty TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiSelectCoinsPayments n
body ApiSelectCoinsPayments n
-> ((NonEmpty (AddressAmount (ApiT Address, Proxy n))
     -> Const
          (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
          (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
    -> ApiSelectCoinsPayments n
    -> Const
         (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
         (ApiSelectCoinsPayments n))
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((NonEmpty (AddressAmount (ApiT Address, Proxy n))
    -> Const
         (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
         (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
   -> ApiSelectCoinsPayments n
   -> Const
        (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
        (ApiSelectCoinsPayments n))
(NonEmpty (AddressAmount (ApiT Address, Proxy n))
 -> Const
      (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
      (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
-> ApiSelectCoinsPayments n
-> Const
     (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
     (ApiSelectCoinsPayments n)
#payments
        let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
                { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata = ApiT TxMetadata -> TxMetadata
forall a. ApiT a -> a
getApiT (ApiT TxMetadata -> TxMetadata)
-> Maybe (ApiT TxMetadata) -> Maybe TxMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiSelectCoinsPayments n
body ApiSelectCoinsPayments n
-> ((Maybe (ApiT TxMetadata)
     -> Const (Maybe (ApiT TxMetadata)) (Maybe (ApiT TxMetadata)))
    -> ApiSelectCoinsPayments n
    -> Const (Maybe (ApiT TxMetadata)) (ApiSelectCoinsPayments n))
-> Maybe (ApiT TxMetadata)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "metadata"
  ((Maybe (ApiT TxMetadata)
    -> Const (Maybe (ApiT TxMetadata)) (Maybe (ApiT TxMetadata)))
   -> ApiSelectCoinsPayments n
   -> Const (Maybe (ApiT TxMetadata)) (ApiSelectCoinsPayments n))
(Maybe (ApiT TxMetadata)
 -> Const (Maybe (ApiT TxMetadata)) (Maybe (ApiT TxMetadata)))
-> ApiSelectCoinsPayments n
-> Const (Maybe (ApiT TxMetadata)) (ApiSelectCoinsPayments n)
#metadata
                }
        let transform :: s
-> Selection
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
transform s
s Selection
sel =
                ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
forall s.
GenChange s =>
ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
W.assignChangeAddresses ArgGenChange s
genChange Selection
sel s
s
                (SelectionOf TxOut, s)
-> ((SelectionOf TxOut, s)
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b. a -> (a -> b) -> b
& (SelectionOf TxOut
 -> s
 -> UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (SelectionOf TxOut, s)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall s input output change withdrawal.
(IsOurs s Address, input ~ (TxIn, TxOut, NonEmpty DerivationIndex),
 output ~ TxOut, change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx input output change withdrawal
W.selectionToUnsignedTx (TransactionCtx -> Withdrawal
txWithdrawal TransactionCtx
txCtx))
        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        let selectAssetsParams :: SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty TxOut
outs
                , Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs :: Set Tx
pendingTxs
                , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                , Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet :: Wallet s
wallet
                , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                }
        UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
utx <- ExceptT
  ErrSelectAssets
  IO
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrSelectAssets
   IO
   (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
 -> Handler
      (UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex)))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall a b. (a -> b) -> a -> b
$
            WalletLayer IO s k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams
     s
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (s
    -> Selection
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
selectAssetsParams s
-> Selection
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
transform
        ApiCoinSelection n -> Handler (ApiCoinSelection n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiCoinSelection n -> Handler (ApiCoinSelection n))
-> ApiCoinSelection n -> Handler (ApiCoinSelection n)
forall a b. (a -> b) -> a -> b
$ [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant) input output change withdrawal.
(input ~ (TxIn, TxOut, NonEmpty DerivationIndex), output ~ TxOut,
 change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
[Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection [] [] Maybe (DelegationAction, NonEmpty DerivationIndex)
forall a. Maybe a
Nothing Maybe TxMetadata
md UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
utx

selectCoinsForJoin
    :: forall ctx s n k.
        ( s ~ SeqState n k
        , ctx ~ ApiLayer s k
        , DelegationAddress n k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , SoftDerivation k
        , Typeable n
        , Typeable s
        , BoundedAddressLength k
        )
    => ctx
    -> IO (Set PoolId)
       -- ^ Known pools
       -- We could maybe replace this with a @IO (PoolId -> Bool)@
    -> (PoolId -> IO PoolLifeCycleStatus)
    -> PoolId
    -> WalletId
    -> Handler (Api.ApiCoinSelection n)
selectCoinsForJoin :: ctx
-> IO (Set PoolId)
-> (PoolId -> IO PoolLifeCycleStatus)
-> PoolId
-> WalletId
-> Handler (ApiCoinSelection n)
selectCoinsForJoin ctx
ctx IO (Set PoolId)
knownPools PoolId -> IO PoolLifeCycleStatus
getPoolStatus PoolId
pid WalletId
wid = do
    PoolLifeCycleStatus
poolStatus <- IO PoolLifeCycleStatus -> Handler PoolLifeCycleStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PoolId -> IO PoolLifeCycleStatus
getPoolStatus PoolId
pid)
    Set PoolId
pools <- IO (Set PoolId) -> Handler (Set PoolId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Set PoolId)
knownPools
    EpochNo
curEpoch <- ctx -> Handler EpochNo
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k) =>
ctx -> Handler EpochNo
getCurrentEpoch ctx
ctx

    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiCoinSelection n))
-> (ErrWalletNotResponding -> Handler (ApiCoinSelection n))
-> (WorkerCtx ctx -> Handler (ApiCoinSelection n))
-> Handler (ApiCoinSelection n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiCoinSelection n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiCoinSelection n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiCoinSelection n))
 -> Handler (ApiCoinSelection n))
-> (WorkerCtx ctx -> Handler (ApiCoinSelection n))
-> Handler (ApiCoinSelection n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (DelegationAction
action, Maybe Coin
deposit) <- ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
 -> Handler (DelegationAction, Maybe Coin))
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> EpochNo
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> WalletId
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> EpochNo
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> WalletId
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
W.joinStakePool @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk EpochNo
curEpoch Set PoolId
pools PoolId
pid PoolLifeCycleStatus
poolStatus WalletId
wid

        let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
                { $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
action
                }

        let transform :: s
-> Selection
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
transform s
s Selection
sel =
                ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
forall s.
GenChange s =>
ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
W.assignChangeAddresses (forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
DelegationAddress n key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
delegationAddress @n) Selection
sel s
s
                (SelectionOf TxOut, s)
-> ((SelectionOf TxOut, s)
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b. a -> (a -> b) -> b
& (SelectionOf TxOut
 -> s
 -> UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (SelectionOf TxOut, s)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall s input output change withdrawal.
(IsOurs s Address, input ~ (TxIn, TxOut, NonEmpty DerivationIndex),
 output ~ TxOut, change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx input output change withdrawal
W.selectionToUnsignedTx (TransactionCtx -> Withdrawal
txWithdrawal TransactionCtx
txCtx))
        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

        let selectAssetsParams :: SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = []
                , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                }
        UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
utx <- ExceptT
  ErrSelectAssets
  IO
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT
   ErrSelectAssets
   IO
   (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
 -> Handler
      (UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex)))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams
     s
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (s
    -> Selection
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
selectAssetsParams s
-> Selection
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
transform
        (RewardAccount
_, XPub
_, NonEmpty DerivationIndex
path) <- ExceptT
  ErrReadRewardAccount
  IO
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT
   ErrReadRewardAccount
   IO
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Handler (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
W.readRewardAccount @_ @s @k @n WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid

        let deposits :: [Coin]
deposits = Maybe Coin -> [Coin]
forall a. Maybe a -> [a]
maybeToList Maybe Coin
deposit

        ApiCoinSelection n -> Handler (ApiCoinSelection n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiCoinSelection n -> Handler (ApiCoinSelection n))
-> ApiCoinSelection n -> Handler (ApiCoinSelection n)
forall a b. (a -> b) -> a -> b
$ [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant) input output change withdrawal.
(input ~ (TxIn, TxOut, NonEmpty DerivationIndex), output ~ TxOut,
 change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
[Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection [Coin]
deposits [] ((DelegationAction, NonEmpty DerivationIndex)
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just (DelegationAction
action, NonEmpty DerivationIndex
path)) Maybe TxMetadata
forall a. Maybe a
Nothing UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
utx

selectCoinsForQuit
    :: forall ctx s n k.
        ( s ~ SeqState n k
        , ctx ~ ApiLayer s k
        , DelegationAddress n k
        , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , SoftDerivation k
        , Typeable n
        , Typeable s
        , WalletKey k
        , BoundedAddressLength k
        )
    => ctx
    -> ApiT WalletId
    -> Handler (Api.ApiCoinSelection n)
selectCoinsForQuit :: ctx -> ApiT WalletId -> Handler (ApiCoinSelection n)
selectCoinsForQuit ctx
ctx (ApiT WalletId
wid) = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiCoinSelection n))
-> (ErrWalletNotResponding -> Handler (ApiCoinSelection n))
-> (WorkerCtx ctx -> Handler (ApiCoinSelection n))
-> Handler (ApiCoinSelection n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiCoinSelection n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiCoinSelection n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiCoinSelection n))
 -> Handler (ApiCoinSelection n))
-> (WorkerCtx ctx -> Handler (ApiCoinSelection n))
-> Handler (ApiCoinSelection n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
        -- @currentNodeEra@ which is not guaranteed with the era read here. This
        -- could cause problems under exceptional circumstances.
        (Withdrawal
wdrl, RewardAccountBuilder k
_mkRwdAcct) <-
            ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid (ApiWithdrawalPostData -> Maybe ApiWithdrawalPostData
forall a. a -> Maybe a
Just ApiWithdrawalPostData
SelfWithdrawal)
        DelegationAction
action <- ExceptT ErrStakePoolDelegation IO DelegationAction
-> Handler DelegationAction
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrStakePoolDelegation IO DelegationAction
 -> Handler DelegationAction)
-> ExceptT ErrStakePoolDelegation IO DelegationAction
-> Handler DelegationAction
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> Withdrawal
-> ExceptT ErrStakePoolDelegation IO DelegationAction
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Withdrawal
-> ExceptT ErrStakePoolDelegation IO DelegationAction
W.quitStakePool @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid Withdrawal
wdrl

        let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
                { $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
action
                , $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                }

        let transform :: s
-> Selection
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
transform s
s Selection
sel =
                ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
forall s.
GenChange s =>
ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
W.assignChangeAddresses (forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
DelegationAddress n key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
delegationAddress @n) Selection
sel s
s
                (SelectionOf TxOut, s)
-> ((SelectionOf TxOut, s)
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b. a -> (a -> b) -> b
& (SelectionOf TxOut
 -> s
 -> UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (SelectionOf TxOut, s)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall s input output change withdrawal.
(IsOurs s Address, input ~ (TxIn, TxOut, NonEmpty DerivationIndex),
 output ~ TxOut, change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx input output change withdrawal
W.selectionToUnsignedTx (TransactionCtx -> Withdrawal
txWithdrawal TransactionCtx
txCtx))
        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        let refund :: Coin
refund = ProtocolParameters -> Coin
W.stakeKeyDeposit ProtocolParameters
pp
        let selectAssetsParams :: SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = []
                , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                }
        UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
utx <- ExceptT
  ErrSelectAssets
  IO
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT
   ErrSelectAssets
   IO
   (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
 -> Handler
      (UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex)))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams
     s
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (s
    -> Selection
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex))
selectAssetsParams s
-> Selection
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
transform
        (RewardAccount
_, XPub
_, NonEmpty DerivationIndex
path) <- ExceptT
  ErrReadRewardAccount
  IO
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrReadRewardAccount
   IO
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Handler (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
W.readRewardAccount @_ @s @k @n WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid

        ApiCoinSelection n -> Handler (ApiCoinSelection n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiCoinSelection n -> Handler (ApiCoinSelection n))
-> ApiCoinSelection n -> Handler (ApiCoinSelection n)
forall a b. (a -> b) -> a -> b
$ [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant) input output change withdrawal.
(input ~ (TxIn, TxOut, NonEmpty DerivationIndex), output ~ TxOut,
 change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
[Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection [] [Coin
refund] ((DelegationAction, NonEmpty DerivationIndex)
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
forall a. a -> Maybe a
Just (DelegationAction
action, NonEmpty DerivationIndex
path)) Maybe TxMetadata
forall a. Maybe a
Nothing UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
utx

{-------------------------------------------------------------------------------
                                     Assets
-------------------------------------------------------------------------------}

data ErrGetAsset
     = ErrGetAssetNoSuchWallet ErrNoSuchWallet
     | ErrGetAssetNotPresent
    deriving (ErrGetAsset -> ErrGetAsset -> Bool
(ErrGetAsset -> ErrGetAsset -> Bool)
-> (ErrGetAsset -> ErrGetAsset -> Bool) -> Eq ErrGetAsset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrGetAsset -> ErrGetAsset -> Bool
$c/= :: ErrGetAsset -> ErrGetAsset -> Bool
== :: ErrGetAsset -> ErrGetAsset -> Bool
$c== :: ErrGetAsset -> ErrGetAsset -> Bool
Eq, Int -> ErrGetAsset -> ShowS
[ErrGetAsset] -> ShowS
ErrGetAsset -> String
(Int -> ErrGetAsset -> ShowS)
-> (ErrGetAsset -> String)
-> ([ErrGetAsset] -> ShowS)
-> Show ErrGetAsset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrGetAsset] -> ShowS
$cshowList :: [ErrGetAsset] -> ShowS
show :: ErrGetAsset -> String
$cshow :: ErrGetAsset -> String
showsPrec :: Int -> ErrGetAsset -> ShowS
$cshowsPrec :: Int -> ErrGetAsset -> ShowS
Show)

newtype ErrListAssets = ErrListAssetsNoSuchWallet ErrNoSuchWallet
    deriving (ErrListAssets -> ErrListAssets -> Bool
(ErrListAssets -> ErrListAssets -> Bool)
-> (ErrListAssets -> ErrListAssets -> Bool) -> Eq ErrListAssets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrListAssets -> ErrListAssets -> Bool
$c/= :: ErrListAssets -> ErrListAssets -> Bool
== :: ErrListAssets -> ErrListAssets -> Bool
$c== :: ErrListAssets -> ErrListAssets -> Bool
Eq, Int -> ErrListAssets -> ShowS
[ErrListAssets] -> ShowS
ErrListAssets -> String
(Int -> ErrListAssets -> ShowS)
-> (ErrListAssets -> String)
-> ([ErrListAssets] -> ShowS)
-> Show ErrListAssets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrListAssets] -> ShowS
$cshowList :: [ErrListAssets] -> ShowS
show :: ErrListAssets -> String
$cshow :: ErrListAssets -> String
showsPrec :: Int -> ErrListAssets -> ShowS
$cshowsPrec :: Int -> ErrListAssets -> ShowS
Show)

-- | All assets associated with this wallet, and their metadata (if metadata is
-- available). This list may include assets which have already been spent.
listAssets
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s Address
        , HasTokenMetadataClient ctx
        )
    => ctx
    -> ApiT WalletId
    -> Handler [ApiAsset]
listAssets :: ctx -> ApiT WalletId -> Handler [ApiAsset]
listAssets ctx
ctx ApiT WalletId
wid = do
    Set AssetId
assets <- ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
forall s (k :: Depth -> * -> *).
IsOurs s Address =>
ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
listAssetsBase ctx
ApiLayer s k
ctx ApiT WalletId
wid
    IO [ApiAsset] -> Handler [ApiAsset]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ApiAsset] -> Handler [ApiAsset])
-> IO [ApiAsset] -> Handler [ApiAsset]
forall a b. (a -> b) -> a -> b
$ TokenMetadataClient IO
-> [AssetId]
-> (Either TokenMetadataError (Maybe AssetMetadata)
    -> AssetId -> ApiAsset)
-> IO [ApiAsset]
forall (t :: * -> *) a.
(Foldable t, Functor t) =>
TokenMetadataClient IO
-> t AssetId
-> (Either TokenMetadataError (Maybe AssetMetadata)
    -> AssetId -> a)
-> IO (t a)
fillMetadata TokenMetadataClient IO
client (Set AssetId -> [AssetId]
forall a. Set a -> [a]
Set.toList Set AssetId
assets) Either TokenMetadataError (Maybe AssetMetadata)
-> AssetId -> ApiAsset
toApiAsset
  where
    client :: TokenMetadataClient IO
client = ctx
ctx ctx
-> ((TokenMetadataClient IO
     -> Const (TokenMetadataClient IO) (TokenMetadataClient IO))
    -> ctx -> Const (TokenMetadataClient IO) ctx)
-> TokenMetadataClient IO
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (TokenMetadataClient IO
 -> Const (TokenMetadataClient IO) (TokenMetadataClient IO))
-> ctx -> Const (TokenMetadataClient IO) ctx
forall ctx.
HasTokenMetadataClient ctx =>
Lens' ctx (TokenMetadataClient IO)
tokenMetadataClient

-- | Return a list of all AssetIds involved in the transaction history of this
-- wallet.
listAssetsBase
    :: forall s k. IsOurs s Address =>
    ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
listAssetsBase :: ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
listAssetsBase ApiLayer s k
ctx (ApiT WalletId
wallet) =
    ApiLayer s k
-> WalletId
-> (ErrNoSuchWallet -> Handler (Set AssetId))
-> (ErrWalletNotResponding -> Handler (Set AssetId))
-> (WorkerCtx (ApiLayer s k) -> Handler (Set AssetId))
-> Handler (Set AssetId)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ApiLayer s k
ctx WalletId
wallet ErrNoSuchWallet -> Handler (Set AssetId)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (Set AssetId)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx (ApiLayer s k) -> Handler (Set AssetId))
 -> Handler (Set AssetId))
-> (WorkerCtx (ApiLayer s k) -> Handler (Set AssetId))
-> Handler (Set AssetId)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx (ApiLayer s k)
wctx ->
        ExceptT ErrNoSuchWallet IO (Set AssetId) -> Handler (Set AssetId)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO (Set AssetId) -> Handler (Set AssetId))
-> ExceptT ErrNoSuchWallet IO (Set AssetId)
-> Handler (Set AssetId)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId -> ExceptT ErrNoSuchWallet IO (Set AssetId)
forall s (k :: Depth -> * -> *) ctx.
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx -> WalletId -> ExceptT ErrNoSuchWallet IO (Set AssetId)
W.listAssets WalletLayer IO s k
WorkerCtx (ApiLayer s k)
wctx WalletId
wallet

-- | Look up a single asset and its metadata.
--
-- NOTE: This is slightly inefficient because it greps through the transaction
-- history to check if the asset is associated with this wallet.
getAsset
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s Address
        , HasTokenMetadataClient ctx
        )
    => ctx
    -> ApiT WalletId
    -> ApiT TokenPolicyId
    -> ApiT TokenName
    -> Handler ApiAsset
getAsset :: ctx
-> ApiT WalletId
-> ApiT TokenPolicyId
-> ApiT TokenName
-> Handler ApiAsset
getAsset ctx
ctx ApiT WalletId
wid (ApiT TokenPolicyId
policyId) (ApiT TokenName
assetName) = do
    AssetId
assetId <- ExceptT ErrGetAsset IO AssetId -> Handler AssetId
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrGetAsset IO AssetId -> Handler AssetId)
-> (Set AssetId -> ExceptT ErrGetAsset IO AssetId)
-> Set AssetId
-> Handler AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set AssetId -> ExceptT ErrGetAsset IO AssetId
findAsset (Set AssetId -> Handler AssetId)
-> Handler (Set AssetId) -> Handler AssetId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
forall s (k :: Depth -> * -> *).
IsOurs s Address =>
ApiLayer s k -> ApiT WalletId -> Handler (Set AssetId)
listAssetsBase ctx
ApiLayer s k
ctx ApiT WalletId
wid
    IO ApiAsset -> Handler ApiAsset
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiAsset -> Handler ApiAsset)
-> IO ApiAsset -> Handler ApiAsset
forall a b. (a -> b) -> a -> b
$ Identity ApiAsset -> ApiAsset
forall a. Identity a -> a
runIdentity (Identity ApiAsset -> ApiAsset)
-> IO (Identity ApiAsset) -> IO ApiAsset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenMetadataClient IO
-> Identity AssetId
-> (Either TokenMetadataError (Maybe AssetMetadata)
    -> AssetId -> ApiAsset)
-> IO (Identity ApiAsset)
forall (t :: * -> *) a.
(Foldable t, Functor t) =>
TokenMetadataClient IO
-> t AssetId
-> (Either TokenMetadataError (Maybe AssetMetadata)
    -> AssetId -> a)
-> IO (t a)
fillMetadata TokenMetadataClient IO
client (AssetId -> Identity AssetId
forall a. a -> Identity a
Identity AssetId
assetId) Either TokenMetadataError (Maybe AssetMetadata)
-> AssetId -> ApiAsset
toApiAsset
  where
    findAsset :: Set AssetId -> ExceptT ErrGetAsset IO AssetId
findAsset = ExceptT ErrGetAsset IO AssetId
-> (AssetId -> ExceptT ErrGetAsset IO AssetId)
-> Maybe AssetId
-> ExceptT ErrGetAsset IO AssetId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ErrGetAsset -> ExceptT ErrGetAsset IO AssetId
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrGetAsset
ErrGetAssetNotPresent) AssetId -> ExceptT ErrGetAsset IO AssetId
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Maybe AssetId -> ExceptT ErrGetAsset IO AssetId)
-> (Set AssetId -> Maybe AssetId)
-> Set AssetId
-> ExceptT ErrGetAsset IO AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetId -> Bool) -> Set AssetId -> Maybe AssetId
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
F.find (AssetId -> AssetId -> Bool
forall a. Eq a => a -> a -> Bool
== (TokenPolicyId -> TokenName -> AssetId
AssetId TokenPolicyId
policyId TokenName
assetName))
    client :: TokenMetadataClient IO
client = ctx
ctx ctx
-> ((TokenMetadataClient IO
     -> Const (TokenMetadataClient IO) (TokenMetadataClient IO))
    -> ctx -> Const (TokenMetadataClient IO) ctx)
-> TokenMetadataClient IO
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (TokenMetadataClient IO
 -> Const (TokenMetadataClient IO) (TokenMetadataClient IO))
-> ctx -> Const (TokenMetadataClient IO) ctx
forall ctx.
HasTokenMetadataClient ctx =>
Lens' ctx (TokenMetadataClient IO)
tokenMetadataClient

-- | The handler for 'getAsset' when 'TokenName' is empty.
getAssetDefault
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s Address
        , HasTokenMetadataClient ctx
        )
    => ctx
    -> ApiT WalletId
    -> ApiT TokenPolicyId
    -> Handler ApiAsset
getAssetDefault :: ctx -> ApiT WalletId -> ApiT TokenPolicyId -> Handler ApiAsset
getAssetDefault ctx
ctx ApiT WalletId
wid ApiT TokenPolicyId
pid = ctx
-> ApiT WalletId
-> ApiT TokenPolicyId
-> ApiT TokenName
-> Handler ApiAsset
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s Address,
 HasTokenMetadataClient ctx) =>
ctx
-> ApiT WalletId
-> ApiT TokenPolicyId
-> ApiT TokenName
-> Handler ApiAsset
getAsset ctx
ctx ApiT WalletId
wid ApiT TokenPolicyId
pid (TokenName -> ApiT TokenName
forall a. a -> ApiT a
ApiT TokenName
nullTokenName)

{-------------------------------------------------------------------------------
                                    Addresses
-------------------------------------------------------------------------------}

postRandomAddress
    :: forall ctx s k n.
        ( s ~ RndState n
        , k ~ ByronKey
        , ctx ~ ApiLayer s k
        , PaymentAddress n ByronKey
        )
    => ctx
    -> ApiT WalletId
    -> ApiPostRandomAddressData
    -> Handler (ApiAddress n)
postRandomAddress :: ctx
-> ApiT WalletId
-> ApiPostRandomAddressData
-> Handler (ApiAddress n)
postRandomAddress ctx
ctx (ApiT WalletId
wid) ApiPostRandomAddressData
body = do
    let pwd :: Passphrase "user"
pwd = Passphrase "lenient" -> Passphrase "user"
coerce (Passphrase "lenient" -> Passphrase "user")
-> Passphrase "lenient" -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a. ApiT a -> a
getApiT (ApiT (Passphrase "lenient") -> Passphrase "lenient")
-> ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a b. (a -> b) -> a -> b
$ ApiPostRandomAddressData
body ApiPostRandomAddressData
-> ((ApiT (Passphrase "lenient")
     -> Const
          (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
    -> ApiPostRandomAddressData
    -> Const (ApiT (Passphrase "lenient")) ApiPostRandomAddressData)
-> ApiT (Passphrase "lenient")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "lenient")
    -> Const
         (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
   -> ApiPostRandomAddressData
   -> Const (ApiT (Passphrase "lenient")) ApiPostRandomAddressData)
(ApiT (Passphrase "lenient")
 -> Const
      (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
-> ApiPostRandomAddressData
-> Const (ApiT (Passphrase "lenient")) ApiPostRandomAddressData
#passphrase
    let mix :: Maybe (Index 'Hardened 'AddressK)
mix = ApiT (Index 'Hardened 'AddressK) -> Index 'Hardened 'AddressK
forall a. ApiT a -> a
getApiT (ApiT (Index 'Hardened 'AddressK) -> Index 'Hardened 'AddressK)
-> Maybe (ApiT (Index 'Hardened 'AddressK))
-> Maybe (Index 'Hardened 'AddressK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ApiPostRandomAddressData
body ApiPostRandomAddressData
-> ((Maybe (ApiT (Index 'Hardened 'AddressK))
     -> Const
          (Maybe (ApiT (Index 'Hardened 'AddressK)))
          (Maybe (ApiT (Index 'Hardened 'AddressK))))
    -> ApiPostRandomAddressData
    -> Const
         (Maybe (ApiT (Index 'Hardened 'AddressK)))
         ApiPostRandomAddressData)
-> Maybe (ApiT (Index 'Hardened 'AddressK))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "addressIndex"
  ((Maybe (ApiT (Index 'Hardened 'AddressK))
    -> Const
         (Maybe (ApiT (Index 'Hardened 'AddressK)))
         (Maybe (ApiT (Index 'Hardened 'AddressK))))
   -> ApiPostRandomAddressData
   -> Const
        (Maybe (ApiT (Index 'Hardened 'AddressK)))
        ApiPostRandomAddressData)
(Maybe (ApiT (Index 'Hardened 'AddressK))
 -> Const
      (Maybe (ApiT (Index 'Hardened 'AddressK)))
      (Maybe (ApiT (Index 'Hardened 'AddressK))))
-> ApiPostRandomAddressData
-> Const
     (Maybe (ApiT (Index 'Hardened 'AddressK))) ApiPostRandomAddressData
#addressIndex)
    (Address
addr, NonEmpty DerivationIndex
path) <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (Address, NonEmpty DerivationIndex))
-> (ErrWalletNotResponding
    -> Handler (Address, NonEmpty DerivationIndex))
-> (WorkerCtx ctx -> Handler (Address, NonEmpty DerivationIndex))
-> Handler (Address, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (Address, NonEmpty DerivationIndex)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler (Address, NonEmpty DerivationIndex)
forall e a. IsServerError e => e -> Handler a
liftE
        ((WorkerCtx ctx -> Handler (Address, NonEmpty DerivationIndex))
 -> Handler (Address, NonEmpty DerivationIndex))
-> (WorkerCtx ctx -> Handler (Address, NonEmpty DerivationIndex))
-> Handler (Address, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT
  ErrCreateRandomAddress IO (Address, NonEmpty DerivationIndex)
-> Handler (Address, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrCreateRandomAddress IO (Address, NonEmpty DerivationIndex)
 -> Handler (Address, NonEmpty DerivationIndex))
-> ExceptT
     ErrCreateRandomAddress IO (Address, NonEmpty DerivationIndex)
-> Handler (Address, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (RndState n) ByronKey
-> WalletId
-> Passphrase "user"
-> Maybe (Index 'Hardened 'AddressK)
-> ExceptT
     ErrCreateRandomAddress IO (Address, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasDBLayer IO s k ctx, PaymentAddress n k, RndStateLike s,
 k ~ ByronKey, AddressBookIso s) =>
ctx
-> WalletId
-> Passphrase "user"
-> Maybe (Index 'Hardened 'AddressK)
-> ExceptT
     ErrCreateRandomAddress IO (Address, NonEmpty DerivationIndex)
W.createRandomAddress @_ @s @k @n WalletLayer IO (RndState n) ByronKey
WorkerCtx ctx
wrk WalletId
wid Passphrase "user"
pwd Maybe (Index 'Hardened 'AddressK)
mix
    ApiAddress n -> Handler (ApiAddress n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiAddress n -> Handler (ApiAddress n))
-> ApiAddress n -> Handler (ApiAddress n)
forall a b. (a -> b) -> a -> b
$ (Address, AddressState, NonEmpty DerivationIndex) -> ApiAddress n
coerceAddress (Address
addr, AddressState
Unused, NonEmpty DerivationIndex
path)
  where
    coerceAddress :: (Address, AddressState, NonEmpty DerivationIndex) -> ApiAddress n
coerceAddress (Address
a, AddressState
s, NonEmpty DerivationIndex
p) =
        (ApiT Address, Proxy n)
-> ApiT AddressState
-> NonEmpty (ApiT DerivationIndex)
-> ApiAddress n
forall (n :: NetworkDiscriminant).
(ApiT Address, Proxy n)
-> ApiT AddressState
-> NonEmpty (ApiT DerivationIndex)
-> ApiAddress n
ApiAddress (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
a, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (AddressState -> ApiT AddressState
forall a. a -> ApiT a
ApiT AddressState
s) ((DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
p)

putRandomAddress
    :: forall ctx s k n.
        ( s ~ RndState n
        , k ~ ByronKey
        , ctx ~ ApiLayer s k
        )
    => ctx
    -> ApiT WalletId
    -> (ApiT Address, Proxy n)
    -> Handler NoContent
putRandomAddress :: ctx
-> ApiT WalletId -> (ApiT Address, Proxy n) -> Handler NoContent
putRandomAddress ctx
ctx (ApiT WalletId
wid) (ApiT Address
addr, Proxy n
_proxy)  = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE
        ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrImportRandomAddress IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrImportRandomAddress IO () -> Handler ())
-> ExceptT ErrImportRandomAddress IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (RndState n) ByronKey
-> WalletId -> [Address] -> ExceptT ErrImportRandomAddress IO ()
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, RndStateLike s, k ~ ByronKey,
 AddressBookIso s) =>
ctx
-> WalletId -> [Address] -> ExceptT ErrImportRandomAddress IO ()
W.importRandomAddresses @_ @s @k WalletLayer IO (RndState n) ByronKey
WorkerCtx ctx
wrk WalletId
wid [Address
addr]
    NoContent -> Handler NoContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent

putRandomAddresses
    :: forall ctx s k n.
        ( s ~ RndState n
        , k ~ ByronKey
        , ctx ~ ApiLayer s k
        )
    => ctx
    -> ApiT WalletId
    -> ApiPutAddressesData n
    -> Handler NoContent
putRandomAddresses :: ctx -> ApiT WalletId -> ApiPutAddressesData n -> Handler NoContent
putRandomAddresses ctx
ctx (ApiT WalletId
wid) (ApiPutAddressesData [(ApiT Address, Proxy n)]
addrs)  = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE
        ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrImportRandomAddress IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrImportRandomAddress IO () -> Handler ())
-> ExceptT ErrImportRandomAddress IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (RndState n) ByronKey
-> WalletId -> [Address] -> ExceptT ErrImportRandomAddress IO ()
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, RndStateLike s, k ~ ByronKey,
 AddressBookIso s) =>
ctx
-> WalletId -> [Address] -> ExceptT ErrImportRandomAddress IO ()
W.importRandomAddresses @_ @s @k WalletLayer IO (RndState n) ByronKey
WorkerCtx ctx
wrk WalletId
wid [Address]
addrs'
    NoContent -> Handler NoContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent
  where
    addrs' :: [Address]
addrs' = ((ApiT Address, Proxy n) -> Address)
-> [(ApiT Address, Proxy n)] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (ApiT Address -> Address
forall a. ApiT a -> a
getApiT (ApiT Address -> Address)
-> ((ApiT Address, Proxy n) -> ApiT Address)
-> (ApiT Address, Proxy n)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiT Address, Proxy n) -> ApiT Address
forall a b. (a, b) -> a
fst) [(ApiT Address, Proxy n)]
addrs

listAddresses
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , CompareDiscovery s
        , KnownAddresses s
        )
    => ctx
    -> (s -> Address -> Maybe Address)
    -> ApiT WalletId
    -> Maybe (ApiT AddressState)
    -> Handler [ApiAddress n]
listAddresses :: ctx
-> (s -> Address -> Maybe Address)
-> ApiT WalletId
-> Maybe (ApiT AddressState)
-> Handler [ApiAddress n]
listAddresses ctx
ctx s -> Address -> Maybe Address
normalize (ApiT WalletId
wid) Maybe (ApiT AddressState)
stateFilter = do
    [(Address, AddressState, NonEmpty DerivationIndex)]
addrs <- ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
-> (ErrWalletNotResponding
    -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
-> (WorkerCtx ctx
    -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
-> Handler [(Address, AddressState, NonEmpty DerivationIndex)]
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet
-> Handler [(Address, AddressState, NonEmpty DerivationIndex)]
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler [(Address, AddressState, NonEmpty DerivationIndex)]
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
 -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
-> (WorkerCtx ctx
    -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
-> Handler [(Address, AddressState, NonEmpty DerivationIndex)]
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT
  ErrNoSuchWallet
  IO
  [(Address, AddressState, NonEmpty DerivationIndex)]
-> Handler [(Address, AddressState, NonEmpty DerivationIndex)]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet
   IO
   [(Address, AddressState, NonEmpty DerivationIndex)]
 -> Handler [(Address, AddressState, NonEmpty DerivationIndex)])
-> ExceptT
     ErrNoSuchWallet
     IO
     [(Address, AddressState, NonEmpty DerivationIndex)]
-> Handler [(Address, AddressState, NonEmpty DerivationIndex)]
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO s k
-> WalletId
-> (s -> Address -> Maybe Address)
-> ExceptT
     ErrNoSuchWallet
     IO
     [(Address, AddressState, NonEmpty DerivationIndex)]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, CompareDiscovery s, KnownAddresses s) =>
ctx
-> WalletId
-> (s -> Address -> Maybe Address)
-> ExceptT
     ErrNoSuchWallet
     IO
     [(Address, AddressState, NonEmpty DerivationIndex)]
W.listAddresses @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid s -> Address -> Maybe Address
normalize
    [ApiAddress n] -> Handler [ApiAddress n]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ApiAddress n] -> Handler [ApiAddress n])
-> [ApiAddress n] -> Handler [ApiAddress n]
forall a b. (a -> b) -> a -> b
$ (Address, AddressState, NonEmpty DerivationIndex) -> ApiAddress n
coerceAddress ((Address, AddressState, NonEmpty DerivationIndex) -> ApiAddress n)
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [ApiAddress n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Address, AddressState, NonEmpty DerivationIndex) -> Bool)
-> [(Address, AddressState, NonEmpty DerivationIndex)]
-> [(Address, AddressState, NonEmpty DerivationIndex)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Address, AddressState, NonEmpty DerivationIndex) -> Bool
filterCondition [(Address, AddressState, NonEmpty DerivationIndex)]
addrs
  where
    filterCondition :: (Address, AddressState, NonEmpty DerivationIndex) -> Bool
    filterCondition :: (Address, AddressState, NonEmpty DerivationIndex) -> Bool
filterCondition = case Maybe (ApiT AddressState)
stateFilter of
        Maybe (ApiT AddressState)
Nothing -> Bool -> (Address, AddressState, NonEmpty DerivationIndex) -> Bool
forall a b. a -> b -> a
const Bool
True
        Just (ApiT AddressState
s) -> \(Address
_,AddressState
state,NonEmpty DerivationIndex
_) -> (AddressState
state AddressState -> AddressState -> Bool
forall a. Eq a => a -> a -> Bool
== AddressState
s)
    coerceAddress :: (Address, AddressState, NonEmpty DerivationIndex) -> ApiAddress n
coerceAddress (Address
a, AddressState
s, NonEmpty DerivationIndex
p) =
        (ApiT Address, Proxy n)
-> ApiT AddressState
-> NonEmpty (ApiT DerivationIndex)
-> ApiAddress n
forall (n :: NetworkDiscriminant).
(ApiT Address, Proxy n)
-> ApiT AddressState
-> NonEmpty (ApiT DerivationIndex)
-> ApiAddress n
ApiAddress (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
a, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (AddressState -> ApiT AddressState
forall a. a -> ApiT a
ApiT AddressState
s) ((DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
p)

{-------------------------------------------------------------------------------
                                    Transactions
-------------------------------------------------------------------------------}

signTransaction
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , WalletKey k
        , IsOwned s k
        , HardDerivation k
        )
    => ctx
    -> ApiT WalletId
    -> ApiSignTransactionPostData
    -> Handler ApiSerialisedTransaction
signTransaction :: ctx
-> ApiT WalletId
-> ApiSignTransactionPostData
-> Handler ApiSerialisedTransaction
signTransaction ctx
ctx (ApiT WalletId
wid) ApiSignTransactionPostData
body = do
    let pwd :: Passphrase "user"
pwd = Passphrase "lenient" -> Passphrase "user"
coerce (Passphrase "lenient" -> Passphrase "user")
-> Passphrase "lenient" -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ ApiSignTransactionPostData
body ApiSignTransactionPostData
-> ((Passphrase "lenient"
     -> Const (Passphrase "lenient") (Passphrase "lenient"))
    -> ApiSignTransactionPostData
    -> Const (Passphrase "lenient") ApiSignTransactionPostData)
-> Passphrase "lenient"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "lenient")
    -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
   -> ApiSignTransactionPostData
   -> Const (Passphrase "lenient") ApiSignTransactionPostData)
(ApiT (Passphrase "lenient")
 -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
-> ApiSignTransactionPostData
-> Const (Passphrase "lenient") ApiSignTransactionPostData
#passphrase ((ApiT (Passphrase "lenient")
  -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
 -> ApiSignTransactionPostData
 -> Const (Passphrase "lenient") ApiSignTransactionPostData)
-> ((Passphrase "lenient"
     -> Const (Passphrase "lenient") (Passphrase "lenient"))
    -> ApiT (Passphrase "lenient")
    -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
-> (Passphrase "lenient"
    -> Const (Passphrase "lenient") (Passphrase "lenient"))
-> ApiSignTransactionPostData
-> Const (Passphrase "lenient") ApiSignTransactionPostData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "lenient"
    -> Const (Passphrase "lenient") (Passphrase "lenient"))
   -> ApiT (Passphrase "lenient")
   -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
(Passphrase "lenient"
 -> Const (Passphrase "lenient") (Passphrase "lenient"))
-> ApiT (Passphrase "lenient")
-> Const (Passphrase "lenient") (ApiT (Passphrase "lenient"))
#getApiT

    SealedTx
sealedTx' <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler SealedTx)
-> (ErrWalletNotResponding -> Handler SealedTx)
-> (WorkerCtx ctx -> Handler SealedTx)
-> Handler SealedTx
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler SealedTx
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler SealedTx
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler SealedTx) -> Handler SealedTx)
-> (WorkerCtx ctx -> Handler SealedTx) -> Handler SealedTx
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrWitnessTx IO SealedTx -> Handler SealedTx
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrWitnessTx IO SealedTx -> Handler SealedTx)
-> ExceptT ErrWitnessTx IO SealedTx -> Handler SealedTx
forall a b. (a -> b) -> a -> b
$ do
        let
            db :: DBLayer IO s k
db = WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((DBLayer IO s k -> Const (DBLayer IO s k) (DBLayer IO s k))
    -> WalletLayer IO s k
    -> Const (DBLayer IO s k) (WalletLayer IO s k))
-> DBLayer IO s k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx. HasDBLayer IO s k ctx => Lens' ctx (DBLayer IO s k)
forall (m :: * -> *) s (k :: Depth -> * -> *) ctx.
HasDBLayer m s k ctx =>
Lens' ctx (DBLayer m s k)
W.dbLayer @IO @s @k
            tl :: TransactionLayer k SealedTx
tl = WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((TransactionLayer k SealedTx
     -> Const
          (TransactionLayer k SealedTx) (TransactionLayer k SealedTx))
    -> WalletLayer IO s k
    -> Const (TransactionLayer k SealedTx) (WalletLayer IO s k))
-> TransactionLayer k SealedTx
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
forall (k :: Depth -> * -> *) ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
W.transactionLayer @k
            nl :: NetworkLayer IO Block
nl = WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
W.networkLayer
        DBLayer IO s k
db DBLayer IO s k
-> (DBLayer IO s k -> ExceptT ErrWitnessTx IO SealedTx)
-> ExceptT ErrWitnessTx IO SealedTx
forall a b. a -> (a -> b) -> b
& \W.DBLayer{forall a. stm a -> IO a
atomically :: ()
atomically :: forall a. stm a -> IO a
atomically, WalletId -> stm (Maybe (Wallet s))
readCheckpoint :: ()
readCheckpoint :: WalletId -> stm (Maybe (Wallet s))
readCheckpoint} -> do
            WalletLayer IO s k
-> WalletId
-> Passphrase "user"
-> (ErrWithRootKey -> ErrWitnessTx)
-> (k 'RootK XPrv
    -> PassphraseScheme -> ExceptT ErrWitnessTx IO SealedTx)
-> ExceptT ErrWitnessTx IO SealedTx
forall ctx s (k :: Depth -> * -> *) e a.
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Passphrase "user"
-> (ErrWithRootKey -> e)
-> (k 'RootK XPrv -> PassphraseScheme -> ExceptT e IO a)
-> ExceptT e IO a
W.withRootKey @_ @s WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid Passphrase "user"
pwd ErrWithRootKey -> ErrWitnessTx
ErrWitnessTxWithRootKey ((k 'RootK XPrv
  -> PassphraseScheme -> ExceptT ErrWitnessTx IO SealedTx)
 -> ExceptT ErrWitnessTx IO SealedTx)
-> (k 'RootK XPrv
    -> PassphraseScheme -> ExceptT ErrWitnessTx IO SealedTx)
-> ExceptT ErrWitnessTx IO SealedTx
forall a b. (a -> b) -> a -> b
$ \k 'RootK XPrv
rootK PassphraseScheme
scheme -> do
                Wallet s
cp <- (stm (Either ErrWitnessTx (Wallet s))
 -> IO (Either ErrWitnessTx (Wallet s)))
-> ExceptT ErrWitnessTx stm (Wallet s)
-> ExceptT ErrWitnessTx IO (Wallet s)
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT stm (Either ErrWitnessTx (Wallet s))
-> IO (Either ErrWitnessTx (Wallet s))
forall a. stm a -> IO a
atomically
                    (ExceptT ErrWitnessTx stm (Wallet s)
 -> ExceptT ErrWitnessTx IO (Wallet s))
-> ExceptT ErrWitnessTx stm (Wallet s)
-> ExceptT ErrWitnessTx IO (Wallet s)
forall a b. (a -> b) -> a -> b
$ (ErrNoSuchWallet -> ErrWitnessTx)
-> ExceptT ErrNoSuchWallet stm (Wallet s)
-> ExceptT ErrWitnessTx stm (Wallet s)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrNoSuchWallet -> ErrWitnessTx
ErrWitnessTxNoSuchWallet
                    (ExceptT ErrNoSuchWallet stm (Wallet s)
 -> ExceptT ErrWitnessTx stm (Wallet s))
-> ExceptT ErrNoSuchWallet stm (Wallet s)
-> ExceptT ErrWitnessTx stm (Wallet s)
forall a b. (a -> b) -> a -> b
$ WalletId
-> stm (Maybe (Wallet s)) -> ExceptT ErrNoSuchWallet stm (Wallet s)
forall (m :: * -> *) a.
Monad m =>
WalletId -> m (Maybe a) -> ExceptT ErrNoSuchWallet m a
W.withNoSuchWallet WalletId
wid
                    (stm (Maybe (Wallet s)) -> ExceptT ErrNoSuchWallet stm (Wallet s))
-> stm (Maybe (Wallet s)) -> ExceptT ErrNoSuchWallet stm (Wallet s)
forall a b. (a -> b) -> a -> b
$ WalletId -> stm (Maybe (Wallet s))
readCheckpoint WalletId
wid
                let
                    pwdP :: Passphrase "encryption"
                    pwdP :: Passphrase "encryption"
pwdP = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
scheme Passphrase "user"
pwd

                    utxo :: UTxO.UTxO
                    utxo :: UTxO
utxo = Set Tx -> Wallet s -> UTxO
forall s. IsOurs s Address => Set Tx -> Wallet s -> UTxO
totalUTxO Set Tx
forall a. Monoid a => a
mempty Wallet s
cp

                    keyLookup
                        :: Address
                        -> Maybe (k 'AddressK XPrv, Passphrase "encryption")
                    keyLookup :: Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")
keyLookup = s
-> (k 'RootK XPrv, Passphrase "encryption")
-> Address
-> Maybe (k 'AddressK XPrv, Passphrase "encryption")
forall s (key :: Depth -> * -> *).
IsOwned s key =>
s
-> (key 'RootK XPrv, Passphrase "encryption")
-> Address
-> Maybe (key 'AddressK XPrv, Passphrase "encryption")
isOwned (Wallet s -> s
forall s. Wallet s -> s
getState Wallet s
cp) (k 'RootK XPrv
rootK, Passphrase "encryption"
pwdP)

                AnyCardanoEra
era <- IO AnyCardanoEra -> ExceptT ErrWitnessTx IO AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> ExceptT ErrWitnessTx IO AnyCardanoEra)
-> IO AnyCardanoEra -> ExceptT ErrWitnessTx IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra NetworkLayer IO Block
nl
                let sealedTx :: SealedTx
sealedTx = ApiSignTransactionPostData
body ApiSignTransactionPostData
-> ((SealedTx -> Const SealedTx SealedTx)
    -> ApiSignTransactionPostData
    -> Const SealedTx ApiSignTransactionPostData)
-> SealedTx
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "transaction"
  ((ApiT SealedTx -> Const SealedTx (ApiT SealedTx))
   -> ApiSignTransactionPostData
   -> Const SealedTx ApiSignTransactionPostData)
(ApiT SealedTx -> Const SealedTx (ApiT SealedTx))
-> ApiSignTransactionPostData
-> Const SealedTx ApiSignTransactionPostData
#transaction ((ApiT SealedTx -> Const SealedTx (ApiT SealedTx))
 -> ApiSignTransactionPostData
 -> Const SealedTx ApiSignTransactionPostData)
-> ((SealedTx -> Const SealedTx SealedTx)
    -> ApiT SealedTx -> Const SealedTx (ApiT SealedTx))
-> (SealedTx -> Const SealedTx SealedTx)
-> ApiSignTransactionPostData
-> Const SealedTx ApiSignTransactionPostData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((SealedTx -> Const SealedTx SealedTx)
   -> ApiT SealedTx -> Const SealedTx (ApiT SealedTx))
(SealedTx -> Const SealedTx SealedTx)
-> ApiT SealedTx -> Const SealedTx (ApiT SealedTx)
#getApiT
                SealedTx -> ExceptT ErrWitnessTx IO SealedTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SealedTx -> ExceptT ErrWitnessTx IO SealedTx)
-> SealedTx -> ExceptT ErrWitnessTx IO SealedTx
forall a b. (a -> b) -> a -> b
$ TransactionLayer k SealedTx
-> AnyCardanoEra
-> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
-> (k 'RootK XPrv, Passphrase "encryption")
-> UTxO
-> SealedTx
-> SealedTx
forall (k :: Depth -> * -> *).
(WalletKey k, HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK)) =>
TransactionLayer k SealedTx
-> AnyCardanoEra
-> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
-> (k 'RootK XPrv, Passphrase "encryption")
-> UTxO
-> SealedTx
-> SealedTx
W.signTransaction TransactionLayer k SealedTx
tl AnyCardanoEra
era Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")
keyLookup (k 'RootK XPrv
rootK, Passphrase "encryption"
pwdP) UTxO
utxo SealedTx
sealedTx

    -- TODO: The body+witnesses seem redundant with the sealedTx already. What's
    -- the use-case for having them provided separately? In the end, the client
    -- should be able to decouple them if they need to.
    ApiSerialisedTransaction -> Handler ApiSerialisedTransaction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSerialisedTransaction -> Handler ApiSerialisedTransaction)
-> ApiSerialisedTransaction -> Handler ApiSerialisedTransaction
forall a b. (a -> b) -> a -> b
$ ApiSerialisedTransaction :: ApiT SealedTx -> ApiSerialisedTransaction
Api.ApiSerialisedTransaction
        { $sel:transaction:ApiSerialisedTransaction :: ApiT SealedTx
transaction = SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
ApiT SealedTx
sealedTx'
        }

postTransactionOld
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , GenChange s
        , HardDerivation k
        , HasNetworkLayer IO ctx
        , IsOwned s k
        , Typeable n
        , Typeable s
        , WalletKey k
        , AddressBookIso s
        , BoundedAddressLength k
        )
    => ctx
    -> ArgGenChange s
    -> ApiT WalletId
    -> PostTransactionOldData n
    -> Handler (ApiTransaction n)
postTransactionOld :: ctx
-> ArgGenChange s
-> ApiT WalletId
-> PostTransactionOldData n
-> Handler (ApiTransaction n)
postTransactionOld ctx
ctx ArgGenChange s
genChange (ApiT WalletId
wid) PostTransactionOldData n
body = do
    let pwd :: Passphrase "user"
pwd = Passphrase "lenient" -> Passphrase "user"
coerce (Passphrase "lenient" -> Passphrase "user")
-> Passphrase "lenient" -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ PostTransactionOldData n
body PostTransactionOldData n
-> ((Passphrase "lenient"
     -> Const (Passphrase "lenient") (Passphrase "lenient"))
    -> PostTransactionOldData n
    -> Const (Passphrase "lenient") (PostTransactionOldData n))
-> Passphrase "lenient"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "lenient")
    -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
   -> PostTransactionOldData n
   -> Const (Passphrase "lenient") (PostTransactionOldData n))
(ApiT (Passphrase "lenient")
 -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
-> PostTransactionOldData n
-> Const (Passphrase "lenient") (PostTransactionOldData n)
#passphrase ((ApiT (Passphrase "lenient")
  -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
 -> PostTransactionOldData n
 -> Const (Passphrase "lenient") (PostTransactionOldData n))
-> ((Passphrase "lenient"
     -> Const (Passphrase "lenient") (Passphrase "lenient"))
    -> ApiT (Passphrase "lenient")
    -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
-> (Passphrase "lenient"
    -> Const (Passphrase "lenient") (Passphrase "lenient"))
-> PostTransactionOldData n
-> Const (Passphrase "lenient") (PostTransactionOldData n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "lenient"
    -> Const (Passphrase "lenient") (Passphrase "lenient"))
   -> ApiT (Passphrase "lenient")
   -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
(Passphrase "lenient"
 -> Const (Passphrase "lenient") (Passphrase "lenient"))
-> ApiT (Passphrase "lenient")
-> Const (Passphrase "lenient") (ApiT (Passphrase "lenient"))
#getApiT
    let outs :: NonEmpty TxOut
outs = AddressAmount (ApiT Address, Proxy n) -> TxOut
forall (n :: NetworkDiscriminant).
AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address, Proxy n) -> TxOut)
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
-> NonEmpty TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PostTransactionOldData n
body PostTransactionOldData n
-> ((NonEmpty (AddressAmount (ApiT Address, Proxy n))
     -> Const
          (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
          (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
    -> PostTransactionOldData n
    -> Const
         (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
         (PostTransactionOldData n))
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((NonEmpty (AddressAmount (ApiT Address, Proxy n))
    -> Const
         (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
         (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
   -> PostTransactionOldData n
   -> Const
        (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
        (PostTransactionOldData n))
(NonEmpty (AddressAmount (ApiT Address, Proxy n))
 -> Const
      (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
      (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
-> PostTransactionOldData n
-> Const
     (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
     (PostTransactionOldData n)
#payments
    let md :: Maybe TxMetadata
md = PostTransactionOldData n
body PostTransactionOldData n
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> PostTransactionOldData n
    -> Const (First TxMetadata) (PostTransactionOldData n))
-> Maybe TxMetadata
forall s a.
s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? IsLabel
  "metadata"
  ((Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
   -> PostTransactionOldData n
   -> Const (First TxMetadata) (PostTransactionOldData n))
(Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> PostTransactionOldData n
-> Const (First TxMetadata) (PostTransactionOldData n)
#metadata ((Maybe TxMetadataWithSchema
  -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
 -> PostTransactionOldData n
 -> Const (First TxMetadata) (PostTransactionOldData n))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> PostTransactionOldData n
-> Const (First TxMetadata) (PostTransactionOldData n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMetadataWithSchema
 -> Const (First TxMetadata) TxMetadataWithSchema)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TxMetadataWithSchema
  -> Const (First TxMetadata) TxMetadataWithSchema)
 -> Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> TxMetadataWithSchema
    -> Const (First TxMetadata) TxMetadataWithSchema)
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "txMetadataWithSchema_metadata"
  ((TxMetadata -> Const (First TxMetadata) TxMetadata)
   -> TxMetadataWithSchema
   -> Const (First TxMetadata) TxMetadataWithSchema)
(TxMetadata -> Const (First TxMetadata) TxMetadata)
-> TxMetadataWithSchema
-> Const (First TxMetadata) TxMetadataWithSchema
#txMetadataWithSchema_metadata
    let mTTL :: Maybe NominalDiffTime
mTTL = PostTransactionOldData n
body PostTransactionOldData n
-> ((NominalDiffTime
     -> Const (First NominalDiffTime) NominalDiffTime)
    -> PostTransactionOldData n
    -> Const (First NominalDiffTime) (PostTransactionOldData n))
-> Maybe NominalDiffTime
forall s a.
s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? IsLabel
  "timeToLive"
  ((Maybe (Quantity "second" NominalDiffTime)
    -> Const
         (First NominalDiffTime)
         (Maybe (Quantity "second" NominalDiffTime)))
   -> PostTransactionOldData n
   -> Const (First NominalDiffTime) (PostTransactionOldData n))
(Maybe (Quantity "second" NominalDiffTime)
 -> Const
      (First NominalDiffTime)
      (Maybe (Quantity "second" NominalDiffTime)))
-> PostTransactionOldData n
-> Const (First NominalDiffTime) (PostTransactionOldData n)
#timeToLive ((Maybe (Quantity "second" NominalDiffTime)
  -> Const
       (First NominalDiffTime)
       (Maybe (Quantity "second" NominalDiffTime)))
 -> PostTransactionOldData n
 -> Const (First NominalDiffTime) (PostTransactionOldData n))
-> ((NominalDiffTime
     -> Const (First NominalDiffTime) NominalDiffTime)
    -> Maybe (Quantity "second" NominalDiffTime)
    -> Const
         (First NominalDiffTime)
         (Maybe (Quantity "second" NominalDiffTime)))
-> (NominalDiffTime
    -> Const (First NominalDiffTime) NominalDiffTime)
-> PostTransactionOldData n
-> Const (First NominalDiffTime) (PostTransactionOldData n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Quantity "second" NominalDiffTime
 -> Const
      (First NominalDiffTime) (Quantity "second" NominalDiffTime))
-> Maybe (Quantity "second" NominalDiffTime)
-> Const
     (First NominalDiffTime) (Maybe (Quantity "second" NominalDiffTime))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Quantity "second" NominalDiffTime
  -> Const
       (First NominalDiffTime) (Quantity "second" NominalDiffTime))
 -> Maybe (Quantity "second" NominalDiffTime)
 -> Const
      (First NominalDiffTime)
      (Maybe (Quantity "second" NominalDiffTime)))
-> ((NominalDiffTime
     -> Const (First NominalDiffTime) NominalDiffTime)
    -> Quantity "second" NominalDiffTime
    -> Const
         (First NominalDiffTime) (Quantity "second" NominalDiffTime))
-> (NominalDiffTime
    -> Const (First NominalDiffTime) NominalDiffTime)
-> Maybe (Quantity "second" NominalDiffTime)
-> Const
     (First NominalDiffTime) (Maybe (Quantity "second" NominalDiffTime))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getQuantity"
  ((NominalDiffTime -> Const (First NominalDiffTime) NominalDiffTime)
   -> Quantity "second" NominalDiffTime
   -> Const
        (First NominalDiffTime) (Quantity "second" NominalDiffTime))
(NominalDiffTime -> Const (First NominalDiffTime) NominalDiffTime)
-> Quantity "second" NominalDiffTime
-> Const
     (First NominalDiffTime) (Quantity "second" NominalDiffTime)
#getQuantity

    -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
    -- @currentNodeEra@ which is not guaranteed with the era read here. This
    -- could cause problems under exceptional circumstances.
    (Withdrawal
wdrl, RewardAccountBuilder k
mkRwdAcct) <-
        ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid (PostTransactionOldData n
body PostTransactionOldData n
-> ((Maybe ApiWithdrawalPostData
     -> Const
          (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
    -> PostTransactionOldData n
    -> Const (Maybe ApiWithdrawalPostData) (PostTransactionOldData n))
-> Maybe ApiWithdrawalPostData
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawal"
  ((Maybe ApiWithdrawalPostData
    -> Const
         (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
   -> PostTransactionOldData n
   -> Const (Maybe ApiWithdrawalPostData) (PostTransactionOldData n))
(Maybe ApiWithdrawalPostData
 -> Const
      (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
-> PostTransactionOldData n
-> Const (Maybe ApiWithdrawalPostData) (PostTransactionOldData n)
#withdrawal)

    SlotNo
ttl <- IO SlotNo -> Handler SlotNo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlotNo -> Handler SlotNo) -> IO SlotNo -> Handler SlotNo
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe NominalDiffTime
mTTL
    let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
            { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
            , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
md
            , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (Maybe SlotNo
forall a. Maybe a
Nothing, SlotNo
ttl)
            }

    (Selection
sel, Tx
tx, TxMeta
txMeta, UTCTime
txTime, ProtocolParameters
pp) <- ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (ErrWalletNotResponding
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (WorkerCtx ctx
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
 -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (WorkerCtx ctx
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk ->
        Concierge IO WalletLock
-> WalletLock
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall lock a.
Ord lock =>
Concierge IO lock -> lock -> Handler a -> Handler a
atomicallyWithHandler (ctx
ctx ctx
-> ((Concierge IO WalletLock
     -> Const (Concierge IO WalletLock) (Concierge IO WalletLock))
    -> ctx -> Const (Concierge IO WalletLock) ctx)
-> Concierge IO WalletLock
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (Concierge IO WalletLock
 -> Const (Concierge IO WalletLock) (Concierge IO WalletLock))
-> ctx -> Const (Concierge IO WalletLock) ctx
forall ctx.
HasType (Concierge IO WalletLock) ctx =>
Lens' ctx (Concierge IO WalletLock)
walletLocks) (WalletId -> WalletLock
PostTransactionOld WalletId
wid) (Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
 -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ do
            (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
                ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
            ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
            AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
            let selectAssetsParams :: SelectAssetsParams s Selection
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                    { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty TxOut
outs
                    , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                    , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                    , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                    , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs =
                        UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                    , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral =
                        UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                    , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                    , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                    }
            Selection
sel <- ExceptT ErrSelectAssets IO Selection -> Handler Selection
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                (ExceptT ErrSelectAssets IO Selection -> Handler Selection)
-> ExceptT ErrSelectAssets IO Selection -> Handler Selection
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s Selection
-> (s -> Selection -> Selection)
-> ExceptT ErrSelectAssets IO Selection
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams s Selection
selectAssetsParams
                ((s -> Selection -> Selection)
 -> ExceptT ErrSelectAssets IO Selection)
-> (s -> Selection -> Selection)
-> ExceptT ErrSelectAssets IO Selection
forall a b. (a -> b) -> a -> b
$ (Selection -> Selection) -> s -> Selection -> Selection
forall a b. a -> b -> a
const Selection -> Selection
forall a. a -> a
Prelude.id
            SelectionOf TxOut
sel' <- ExceptT ErrSignPayment IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                (ExceptT ErrSignPayment IO (SelectionOf TxOut)
 -> Handler (SelectionOf TxOut))
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
forall ctx s (k :: Depth -> * -> *).
(GenChange s, HasDBLayer IO s k ctx, AddressBookIso s) =>
ctx
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
W.assignChangeAddressesAndUpdateDb WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid ArgGenChange s
genChange Selection
sel
            (Tx
tx, TxMeta
txMeta, UTCTime
txTime, SealedTx
sealedTx) <- ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                (ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
 -> Handler (Tx, TxMeta, UTCTime, SealedTx))
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> AnyCardanoEra
-> RewardAccountBuilder k
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
forall ctx s (k :: Depth -> * -> *).
(HasTransactionLayer k ctx, HasDBLayer IO s k ctx,
 HasNetworkLayer IO ctx, IsOwned s k) =>
ctx
-> WalletId
-> AnyCardanoEra
-> ((k 'RootK XPrv, Passphrase "encryption")
    -> (XPrv, Passphrase "encryption"))
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
W.buildAndSignTransaction
                    @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid AnyCardanoEra
era RewardAccountBuilder k
mkRwdAcct Passphrase "user"
pwd TransactionCtx
txCtx SelectionOf TxOut
sel'
            ExceptT ErrSubmitTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                (ExceptT ErrSubmitTx IO () -> Handler ())
-> ExceptT ErrSubmitTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
forall ctx s (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasDBLayer IO s k ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
W.submitTx @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid (Tx
tx, TxMeta
txMeta, SealedTx
sealedTx)
            (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection
sel, Tx
tx, TxMeta
txMeta, UTCTime
txTime, ProtocolParameters
pp)

    IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ApiTransaction n) -> Handler (ApiTransaction n))
-> IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
forall (n :: NetworkDiscriminant).
TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
mkApiTransaction
        (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (NetworkLayer IO Block
 -> TimeInterpreter (ExceptT PastHorizonException IO))
-> NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        #pendingSince
        (MkApiTransactionParams -> IO (ApiTransaction n))
-> MkApiTransactionParams -> IO (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ MkApiTransactionParams :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Maybe TxOut)]
-> [(TxIn, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Maybe TxMetadata
-> UTCTime
-> Maybe TxScriptValidity
-> Coin
-> TxMetadataSchema
-> MkApiTransactionParams
MkApiTransactionParams
            { $sel:txId:MkApiTransactionParams :: Hash "Tx"
txId = Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId
            , $sel:txFee:MkApiTransactionParams :: Maybe Coin
txFee = Tx
tx Tx
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> Tx -> Const (Maybe Coin) Tx)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "fee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> Tx -> Const (Maybe Coin) Tx)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> Tx -> Const (Maybe Coin) Tx
#fee
            , $sel:txInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txInputs = NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)])
-> NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a b. (a -> b) -> a -> b
$ (TxOut -> Maybe TxOut) -> (TxIn, TxOut) -> (TxIn, Maybe TxOut)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just ((TxIn, TxOut) -> (TxIn, Maybe TxOut))
-> NonEmpty (TxIn, TxOut) -> NonEmpty (TxIn, Maybe TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection
sel Selection
-> ((NonEmpty (TxIn, TxOut)
     -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
    -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> NonEmpty (TxIn, TxOut)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs
              -- TODO: ADP-957:
            , $sel:txCollateralInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txCollateralInputs = []
            , $sel:txOutputs:MkApiTransactionParams :: [TxOut]
txOutputs = Tx
tx Tx
-> (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx
#outputs
            , $sel:txCollateralOutput:MkApiTransactionParams :: Maybe TxOut
txCollateralOutput = Tx
tx Tx
-> ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
    -> Tx -> Const (Maybe TxOut) Tx)
-> Maybe TxOut
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> Tx -> Const (Maybe TxOut) Tx)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> Tx -> Const (Maybe TxOut) Tx
#collateralOutput
            , $sel:txWithdrawals:MkApiTransactionParams :: Map RewardAccount Coin
txWithdrawals = Tx
tx Tx
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> Tx -> Const (Map RewardAccount Coin) Tx)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> Tx -> Const (Map RewardAccount Coin) Tx)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> Tx -> Const (Map RewardAccount Coin) Tx
#withdrawals
            , TxMeta
$sel:txMeta:MkApiTransactionParams :: TxMeta
txMeta :: TxMeta
txMeta
            , $sel:txMetadata:MkApiTransactionParams :: Maybe TxMetadata
txMetadata = Tx
tx Tx
-> ((Maybe TxMetadata
     -> Const (Maybe TxMetadata) (Maybe TxMetadata))
    -> Tx -> Const (Maybe TxMetadata) Tx)
-> Maybe TxMetadata
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "metadata"
  ((Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
   -> Tx -> Const (Maybe TxMetadata) Tx)
(Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
-> Tx -> Const (Maybe TxMetadata) Tx
#metadata
            , UTCTime
$sel:txTime:MkApiTransactionParams :: UTCTime
txTime :: UTCTime
txTime
            , $sel:txScriptValidity:MkApiTransactionParams :: Maybe TxScriptValidity
txScriptValidity = Tx
tx Tx
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> Tx -> Const (Maybe TxScriptValidity) Tx)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> Tx -> Const (Maybe TxScriptValidity) Tx)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> Tx -> Const (Maybe TxScriptValidity) Tx
#scriptValidity
            , $sel:txDeposit:MkApiTransactionParams :: Coin
txDeposit = ProtocolParameters -> Coin
W.stakeKeyDeposit ProtocolParameters
pp
            , $sel:txMetadataSchema:MkApiTransactionParams :: TxMetadataSchema
txMetadataSchema = TxMetadataSchema
TxMetadataDetailedSchema
            }
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

deleteTransaction
    :: forall ctx s k. ctx ~ ApiLayer s k
    => ctx
    -> ApiT WalletId
    -> ApiTxId
    -> Handler NoContent
deleteTransaction :: ctx -> ApiT WalletId -> ApiTxId -> Handler NoContent
deleteTransaction ctx
ctx (ApiT WalletId
wid) (ApiTxId (ApiT (Hash "Tx"
tid))) = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrRemoveTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrRemoveTx IO () -> Handler ())
-> ExceptT ErrRemoveTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO s k
-> WalletId -> Hash "Tx" -> ExceptT ErrRemoveTx IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx -> WalletId -> Hash "Tx" -> ExceptT ErrRemoveTx IO ()
W.forgetTx WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid Hash "Tx"
tid
    NoContent -> Handler NoContent
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent

listTransactions
    :: forall ctx s k n. (ctx ~ ApiLayer s k)
    => ctx
    -> ApiT WalletId
    -> Maybe MinWithdrawal
    -> Maybe Iso8601Time
    -> Maybe Iso8601Time
    -> Maybe (ApiT SortOrder)
    -> TxMetadataSchema
    -> Handler [ApiTransaction n]
listTransactions :: ctx
-> ApiT WalletId
-> Maybe MinWithdrawal
-> Maybe Iso8601Time
-> Maybe Iso8601Time
-> Maybe (ApiT SortOrder)
-> TxMetadataSchema
-> Handler [ApiTransaction n]
listTransactions
    ctx
ctx (ApiT WalletId
wid) Maybe MinWithdrawal
mMinWithdrawal Maybe Iso8601Time
mStart Maybe Iso8601Time
mEnd Maybe (ApiT SortOrder)
mOrder TxMetadataSchema
metadataSchema = do
        ([TransactionInfo]
txs, Coin
depo) <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ([TransactionInfo], Coin))
-> (ErrWalletNotResponding -> Handler ([TransactionInfo], Coin))
-> (WorkerCtx ctx -> Handler ([TransactionInfo], Coin))
-> Handler ([TransactionInfo], Coin)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ([TransactionInfo], Coin)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ([TransactionInfo], Coin)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ([TransactionInfo], Coin))
 -> Handler ([TransactionInfo], Coin))
-> (WorkerCtx ctx -> Handler ([TransactionInfo], Coin))
-> Handler ([TransactionInfo], Coin)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
            [TransactionInfo]
txs <- ExceptT ErrListTransactions IO [TransactionInfo]
-> Handler [TransactionInfo]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrListTransactions IO [TransactionInfo]
 -> Handler [TransactionInfo])
-> ExceptT ErrListTransactions IO [TransactionInfo]
-> Handler [TransactionInfo]
forall a b. (a -> b) -> a -> b
$
                WalletLayer IO s k
-> WalletId
-> Maybe Coin
-> Maybe UTCTime
-> Maybe UTCTime
-> SortOrder
-> ExceptT ErrListTransactions IO [TransactionInfo]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx) =>
ctx
-> WalletId
-> Maybe Coin
-> Maybe UTCTime
-> Maybe UTCTime
-> SortOrder
-> ExceptT ErrListTransactions IO [TransactionInfo]
W.listTransactions @_ @_ @_ WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
                (Natural -> Coin
Coin (Natural -> Coin)
-> (MinWithdrawal -> Natural) -> MinWithdrawal -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural)
-> (MinWithdrawal -> Natural) -> MinWithdrawal -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinWithdrawal -> Natural
getMinWithdrawal (MinWithdrawal -> Coin) -> Maybe MinWithdrawal -> Maybe Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MinWithdrawal
mMinWithdrawal)
                (Iso8601Time -> UTCTime
getIso8601Time (Iso8601Time -> UTCTime) -> Maybe Iso8601Time -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Iso8601Time
mStart)
                (Iso8601Time -> UTCTime
getIso8601Time (Iso8601Time -> UTCTime) -> Maybe Iso8601Time -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Iso8601Time
mEnd)
                (SortOrder
-> (ApiT SortOrder -> SortOrder)
-> Maybe (ApiT SortOrder)
-> SortOrder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SortOrder
defaultSortOrder ApiT SortOrder -> SortOrder
forall a. ApiT a -> a
getApiT Maybe (ApiT SortOrder)
mOrder)
            Coin
depo <- IO Coin -> Handler Coin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coin -> Handler Coin) -> IO Coin -> Handler Coin
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Coin
W.stakeKeyDeposit (ProtocolParameters -> Coin) -> IO ProtocolParameters -> IO Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
            ([TransactionInfo], Coin) -> Handler ([TransactionInfo], Coin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TransactionInfo]
txs, Coin
depo)
        IO [ApiTransaction n] -> Handler [ApiTransaction n]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ApiTransaction n] -> Handler [ApiTransaction n])
-> IO [ApiTransaction n] -> Handler [ApiTransaction n]
forall a b. (a -> b) -> a -> b
$ [TransactionInfo]
-> (TransactionInfo -> IO (ApiTransaction n))
-> IO [ApiTransaction n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TransactionInfo]
txs ((TransactionInfo -> IO (ApiTransaction n))
 -> IO [ApiTransaction n])
-> (TransactionInfo -> IO (ApiTransaction n))
-> IO [ApiTransaction n]
forall a b. (a -> b) -> a -> b
$ \TransactionInfo
tx ->
            TimeInterpreter (ExceptT PastHorizonException IO)
-> Coin
-> TransactionInfo
-> TxMetadataSchema
-> IO (ApiTransaction n)
forall (m :: * -> *) (n :: NetworkDiscriminant).
MonadIO m =>
TimeInterpreter (ExceptT PastHorizonException IO)
-> Coin
-> TransactionInfo
-> TxMetadataSchema
-> m (ApiTransaction n)
mkApiTransactionFromInfo
                (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer))
                Coin
depo
                TransactionInfo
tx
                TxMetadataSchema
metadataSchema
  where
    defaultSortOrder :: SortOrder
    defaultSortOrder :: SortOrder
defaultSortOrder = SortOrder
Descending

getTransaction
    :: forall ctx s k n. (ctx ~ ApiLayer s k)
    => ctx
    -> ApiT WalletId
    -> ApiTxId
    -> TxMetadataSchema
    -> Handler (ApiTransaction n)
getTransaction :: ctx
-> ApiT WalletId
-> ApiTxId
-> TxMetadataSchema
-> Handler (ApiTransaction n)
getTransaction ctx
ctx (ApiT WalletId
wid) (ApiTxId (ApiT (Hash "Tx"
tid))) TxMetadataSchema
metadataSchema = do
    (TransactionInfo
tx, Coin
depo) <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (TransactionInfo, Coin))
-> (ErrWalletNotResponding -> Handler (TransactionInfo, Coin))
-> (WorkerCtx ctx -> Handler (TransactionInfo, Coin))
-> Handler (TransactionInfo, Coin)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (TransactionInfo, Coin)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (TransactionInfo, Coin)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (TransactionInfo, Coin))
 -> Handler (TransactionInfo, Coin))
-> (WorkerCtx ctx -> Handler (TransactionInfo, Coin))
-> Handler (TransactionInfo, Coin)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        TransactionInfo
tx <- ExceptT ErrGetTransaction IO TransactionInfo
-> Handler TransactionInfo
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrGetTransaction IO TransactionInfo
 -> Handler TransactionInfo)
-> ExceptT ErrGetTransaction IO TransactionInfo
-> Handler TransactionInfo
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> Hash "Tx"
-> ExceptT ErrGetTransaction IO TransactionInfo
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Hash "Tx"
-> ExceptT ErrGetTransaction IO TransactionInfo
W.getTransaction WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid Hash "Tx"
tid
        Coin
depo <- IO Coin -> Handler Coin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coin -> Handler Coin) -> IO Coin -> Handler Coin
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Coin
W.stakeKeyDeposit (ProtocolParameters -> Coin) -> IO ProtocolParameters -> IO Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        (TransactionInfo, Coin) -> Handler (TransactionInfo, Coin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransactionInfo
tx, Coin
depo)
    IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO (ApiTransaction n) -> Handler (ApiTransaction n))
-> IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Coin
-> TransactionInfo
-> TxMetadataSchema
-> IO (ApiTransaction n)
forall (m :: * -> *) (n :: NetworkDiscriminant).
MonadIO m =>
TimeInterpreter (ExceptT PastHorizonException IO)
-> Coin
-> TransactionInfo
-> TxMetadataSchema
-> m (ApiTransaction n)
mkApiTransactionFromInfo
            (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)) Coin
depo TransactionInfo
tx
            TxMetadataSchema
metadataSchema

-- Populate an API transaction record with 'TransactionInfo' from the wallet
-- layer.
mkApiTransactionFromInfo
    :: MonadIO m
    => TimeInterpreter (ExceptT PastHorizonException IO)
    -> Coin
    -> TransactionInfo
    -> TxMetadataSchema
    -> m (ApiTransaction n)
mkApiTransactionFromInfo :: TimeInterpreter (ExceptT PastHorizonException IO)
-> Coin
-> TransactionInfo
-> TxMetadataSchema
-> m (ApiTransaction n)
mkApiTransactionFromInfo TimeInterpreter (ExceptT PastHorizonException IO)
ti Coin
deposit TransactionInfo
info TxMetadataSchema
metadataSchema = do
    ApiTransaction n
apiTx <- IO (ApiTransaction n) -> m (ApiTransaction n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ApiTransaction n) -> m (ApiTransaction n))
-> IO (ApiTransaction n) -> m (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
forall (n :: NetworkDiscriminant).
TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
mkApiTransaction
        TimeInterpreter (ExceptT PastHorizonException IO)
ti
        forall (n :: NetworkDiscriminant).
Lens' (ApiTransaction n) (Maybe ApiBlockReference)
Lens' (ApiTransaction n) (Maybe ApiBlockReference)
status
        MkApiTransactionParams :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Maybe TxOut)]
-> [(TxIn, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Maybe TxMetadata
-> UTCTime
-> Maybe TxScriptValidity
-> Coin
-> TxMetadataSchema
-> MkApiTransactionParams
MkApiTransactionParams
            { $sel:txId:MkApiTransactionParams :: Hash "Tx"
txId = TransactionInfo
info TransactionInfo
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> TransactionInfo -> Const (Hash "Tx") TransactionInfo)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> TransactionInfo -> Const (Hash "Tx") TransactionInfo)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> TransactionInfo -> Const (Hash "Tx") TransactionInfo
#txInfoId
            , $sel:txFee:MkApiTransactionParams :: Maybe Coin
txFee = TransactionInfo
info TransactionInfo
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> TransactionInfo -> Const (Maybe Coin) TransactionInfo)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoFee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> TransactionInfo -> Const (Maybe Coin) TransactionInfo)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> TransactionInfo -> Const (Maybe Coin) TransactionInfo
#txInfoFee
            , $sel:txInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txInputs = TransactionInfo
info TransactionInfo
-> (([(TxIn, Coin, Maybe TxOut)]
     -> Const [(TxIn, Coin, Maybe TxOut)] [(TxIn, Coin, Maybe TxOut)])
    -> TransactionInfo
    -> Const [(TxIn, Coin, Maybe TxOut)] TransactionInfo)
-> [(TxIn, Coin, Maybe TxOut)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoInputs"
  (([(TxIn, Coin, Maybe TxOut)]
    -> Const [(TxIn, Coin, Maybe TxOut)] [(TxIn, Coin, Maybe TxOut)])
   -> TransactionInfo
   -> Const [(TxIn, Coin, Maybe TxOut)] TransactionInfo)
([(TxIn, Coin, Maybe TxOut)]
 -> Const [(TxIn, Coin, Maybe TxOut)] [(TxIn, Coin, Maybe TxOut)])
-> TransactionInfo
-> Const [(TxIn, Coin, Maybe TxOut)] TransactionInfo
#txInfoInputs [(TxIn, Coin, Maybe TxOut)]
-> ((TxIn, Coin, Maybe TxOut) -> (TxIn, Maybe TxOut))
-> [(TxIn, Maybe TxOut)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (TxIn, Coin, Maybe TxOut) -> (TxIn, Maybe TxOut)
forall a b b. (a, b, b) -> (a, b)
drop2nd
            , $sel:txCollateralInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txCollateralInputs = TransactionInfo
info TransactionInfo
-> (([(TxIn, Coin, Maybe TxOut)]
     -> Const [(TxIn, Coin, Maybe TxOut)] [(TxIn, Coin, Maybe TxOut)])
    -> TransactionInfo
    -> Const [(TxIn, Coin, Maybe TxOut)] TransactionInfo)
-> [(TxIn, Coin, Maybe TxOut)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoCollateralInputs"
  (([(TxIn, Coin, Maybe TxOut)]
    -> Const [(TxIn, Coin, Maybe TxOut)] [(TxIn, Coin, Maybe TxOut)])
   -> TransactionInfo
   -> Const [(TxIn, Coin, Maybe TxOut)] TransactionInfo)
([(TxIn, Coin, Maybe TxOut)]
 -> Const [(TxIn, Coin, Maybe TxOut)] [(TxIn, Coin, Maybe TxOut)])
-> TransactionInfo
-> Const [(TxIn, Coin, Maybe TxOut)] TransactionInfo
#txInfoCollateralInputs [(TxIn, Coin, Maybe TxOut)]
-> ((TxIn, Coin, Maybe TxOut) -> (TxIn, Maybe TxOut))
-> [(TxIn, Maybe TxOut)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (TxIn, Coin, Maybe TxOut) -> (TxIn, Maybe TxOut)
forall a b b. (a, b, b) -> (a, b)
drop2nd
            , $sel:txOutputs:MkApiTransactionParams :: [TxOut]
txOutputs = TransactionInfo
info TransactionInfo
-> (([TxOut] -> Const [TxOut] [TxOut])
    -> TransactionInfo -> Const [TxOut] TransactionInfo)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoOutputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> TransactionInfo -> Const [TxOut] TransactionInfo)
([TxOut] -> Const [TxOut] [TxOut])
-> TransactionInfo -> Const [TxOut] TransactionInfo
#txInfoOutputs
            , $sel:txCollateralOutput:MkApiTransactionParams :: Maybe TxOut
txCollateralOutput = TransactionInfo
info TransactionInfo
-> ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
    -> TransactionInfo -> Const (Maybe TxOut) TransactionInfo)
-> Maybe TxOut
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoCollateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> TransactionInfo -> Const (Maybe TxOut) TransactionInfo)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> TransactionInfo -> Const (Maybe TxOut) TransactionInfo
#txInfoCollateralOutput
            , $sel:txWithdrawals:MkApiTransactionParams :: Map RewardAccount Coin
txWithdrawals = TransactionInfo
info TransactionInfo
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> TransactionInfo
    -> Const (Map RewardAccount Coin) TransactionInfo)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoWithdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> TransactionInfo
   -> Const (Map RewardAccount Coin) TransactionInfo)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> TransactionInfo
-> Const (Map RewardAccount Coin) TransactionInfo
#txInfoWithdrawals
            , $sel:txMeta:MkApiTransactionParams :: TxMeta
txMeta = TransactionInfo
info TransactionInfo
-> ((TxMeta -> Const TxMeta TxMeta)
    -> TransactionInfo -> Const TxMeta TransactionInfo)
-> TxMeta
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoMeta"
  ((TxMeta -> Const TxMeta TxMeta)
   -> TransactionInfo -> Const TxMeta TransactionInfo)
(TxMeta -> Const TxMeta TxMeta)
-> TransactionInfo -> Const TxMeta TransactionInfo
#txInfoMeta
            , $sel:txMetadata:MkApiTransactionParams :: Maybe TxMetadata
txMetadata = TransactionInfo
info TransactionInfo
-> ((Maybe TxMetadata
     -> Const (Maybe TxMetadata) (Maybe TxMetadata))
    -> TransactionInfo -> Const (Maybe TxMetadata) TransactionInfo)
-> Maybe TxMetadata
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoMetadata"
  ((Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
   -> TransactionInfo -> Const (Maybe TxMetadata) TransactionInfo)
(Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
-> TransactionInfo -> Const (Maybe TxMetadata) TransactionInfo
#txInfoMetadata
            , $sel:txTime:MkApiTransactionParams :: UTCTime
txTime = TransactionInfo
info TransactionInfo
-> ((UTCTime -> Const UTCTime UTCTime)
    -> TransactionInfo -> Const UTCTime TransactionInfo)
-> UTCTime
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoTime"
  ((UTCTime -> Const UTCTime UTCTime)
   -> TransactionInfo -> Const UTCTime TransactionInfo)
(UTCTime -> Const UTCTime UTCTime)
-> TransactionInfo -> Const UTCTime TransactionInfo
#txInfoTime
            , $sel:txScriptValidity:MkApiTransactionParams :: Maybe TxScriptValidity
txScriptValidity = TransactionInfo
info TransactionInfo
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> TransactionInfo
    -> Const (Maybe TxScriptValidity) TransactionInfo)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoScriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> TransactionInfo
   -> Const (Maybe TxScriptValidity) TransactionInfo)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> TransactionInfo
-> Const (Maybe TxScriptValidity) TransactionInfo
#txInfoScriptValidity
            , $sel:txDeposit:MkApiTransactionParams :: Coin
txDeposit = Coin
deposit
            , $sel:txMetadataSchema:MkApiTransactionParams :: TxMetadataSchema
txMetadataSchema = TxMetadataSchema
metadataSchema
            }
    ApiTransaction n -> m (ApiTransaction n)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiTransaction n -> m (ApiTransaction n))
-> ApiTransaction n -> m (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ case TransactionInfo
info TransactionInfo
-> ((TxStatus -> Const TxStatus TxStatus)
    -> TransactionInfo -> Const TxStatus TransactionInfo)
-> TxStatus
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txInfoMeta"
  ((TxMeta -> Const TxStatus TxMeta)
   -> TransactionInfo -> Const TxStatus TransactionInfo)
(TxMeta -> Const TxStatus TxMeta)
-> TransactionInfo -> Const TxStatus TransactionInfo
#txInfoMeta ((TxMeta -> Const TxStatus TxMeta)
 -> TransactionInfo -> Const TxStatus TransactionInfo)
-> ((TxStatus -> Const TxStatus TxStatus)
    -> TxMeta -> Const TxStatus TxMeta)
-> (TxStatus -> Const TxStatus TxStatus)
-> TransactionInfo
-> Const TxStatus TransactionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "status"
  ((TxStatus -> Const TxStatus TxStatus)
   -> TxMeta -> Const TxStatus TxMeta)
(TxStatus -> Const TxStatus TxStatus)
-> TxMeta -> Const TxStatus TxMeta
#status) of
        TxStatus
Pending  -> ApiTransaction n
apiTx
        TxStatus
InLedger -> ApiTransaction n
apiTx {$sel:depth:ApiTransaction :: Maybe (Quantity "block" Natural)
depth = Quantity "block" Natural -> Maybe (Quantity "block" Natural)
forall a. a -> Maybe a
Just (Quantity "block" Natural -> Maybe (Quantity "block" Natural))
-> Quantity "block" Natural -> Maybe (Quantity "block" Natural)
forall a b. (a -> b) -> a -> b
$ TransactionInfo
info TransactionInfo
-> ((Quantity "block" Natural
     -> Const (Quantity "block" Natural) (Quantity "block" Natural))
    -> TransactionInfo
    -> Const (Quantity "block" Natural) TransactionInfo)
-> Quantity "block" Natural
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInfoDepth"
  ((Quantity "block" Natural
    -> Const (Quantity "block" Natural) (Quantity "block" Natural))
   -> TransactionInfo
   -> Const (Quantity "block" Natural) TransactionInfo)
(Quantity "block" Natural
 -> Const (Quantity "block" Natural) (Quantity "block" Natural))
-> TransactionInfo
-> Const (Quantity "block" Natural) TransactionInfo
#txInfoDepth}
        TxStatus
Expired  -> ApiTransaction n
apiTx
  where
    drop2nd :: (a, b, b) -> (a, b)
drop2nd (a
a,b
_,b
c) = (a
a,b
c)
    status :: Lens' (ApiTransaction n) (Maybe ApiBlockReference)
    status :: (Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
status = case TransactionInfo
info TransactionInfo
-> ((TxStatus -> Const TxStatus TxStatus)
    -> TransactionInfo -> Const TxStatus TransactionInfo)
-> TxStatus
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txInfoMeta"
  ((TxMeta -> Const TxStatus TxMeta)
   -> TransactionInfo -> Const TxStatus TransactionInfo)
(TxMeta -> Const TxStatus TxMeta)
-> TransactionInfo -> Const TxStatus TransactionInfo
#txInfoMeta ((TxMeta -> Const TxStatus TxMeta)
 -> TransactionInfo -> Const TxStatus TransactionInfo)
-> ((TxStatus -> Const TxStatus TxStatus)
    -> TxMeta -> Const TxStatus TxMeta)
-> (TxStatus -> Const TxStatus TxStatus)
-> TransactionInfo
-> Const TxStatus TransactionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "status"
  ((TxStatus -> Const TxStatus TxStatus)
   -> TxMeta -> Const TxStatus TxMeta)
(TxStatus -> Const TxStatus TxStatus)
-> TxMeta -> Const TxStatus TxMeta
#status) of
        TxStatus
Pending  -> IsLabel
  "pendingSince"
  ((Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
   -> ApiTransaction n -> f (ApiTransaction n))
(Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
#pendingSince
        TxStatus
InLedger -> IsLabel
  "insertedAt"
  ((Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
   -> ApiTransaction n -> f (ApiTransaction n))
(Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
#insertedAt
        TxStatus
Expired  -> IsLabel
  "pendingSince"
  ((Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
   -> ApiTransaction n -> f (ApiTransaction n))
(Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
#pendingSince

postTransactionFeeOld
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , HardDerivation k
        , Typeable n
        , Typeable s
        , WalletKey k
        , BoundedAddressLength k
        )
    => ctx
    -> ApiT WalletId
    -> PostTransactionFeeOldData n
    -> Handler ApiFee
postTransactionFeeOld :: ctx
-> ApiT WalletId -> PostTransactionFeeOldData n -> Handler ApiFee
postTransactionFeeOld ctx
ctx (ApiT WalletId
wid) PostTransactionFeeOldData n
body = do

    -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
    -- @currentNodeEra@ which is not guaranteed with the era read here. This
    -- could cause problems under exceptional circumstances.
    (Withdrawal
wdrl, RewardAccountBuilder k
_) <- ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid (PostTransactionFeeOldData n
body PostTransactionFeeOldData n
-> ((Maybe ApiWithdrawalPostData
     -> Const
          (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
    -> PostTransactionFeeOldData n
    -> Const
         (Maybe ApiWithdrawalPostData) (PostTransactionFeeOldData n))
-> Maybe ApiWithdrawalPostData
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawal"
  ((Maybe ApiWithdrawalPostData
    -> Const
         (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
   -> PostTransactionFeeOldData n
   -> Const
        (Maybe ApiWithdrawalPostData) (PostTransactionFeeOldData n))
(Maybe ApiWithdrawalPostData
 -> Const
      (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
-> PostTransactionFeeOldData n
-> Const
     (Maybe ApiWithdrawalPostData) (PostTransactionFeeOldData n)
#withdrawal)
    let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
            { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
            , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata
                = PostTransactionFeeOldData n
body PostTransactionFeeOldData n
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> PostTransactionFeeOldData n
    -> Const (First TxMetadata) (PostTransactionFeeOldData n))
-> Maybe TxMetadata
forall s a.
s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? IsLabel
  "metadata"
  ((Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
   -> PostTransactionFeeOldData n
   -> Const (First TxMetadata) (PostTransactionFeeOldData n))
(Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> PostTransactionFeeOldData n
-> Const (First TxMetadata) (PostTransactionFeeOldData n)
#metadata
                ((Maybe TxMetadataWithSchema
  -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
 -> PostTransactionFeeOldData n
 -> Const (First TxMetadata) (PostTransactionFeeOldData n))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> PostTransactionFeeOldData n
-> Const (First TxMetadata) (PostTransactionFeeOldData n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMetadataWithSchema
 -> Const (First TxMetadata) TxMetadataWithSchema)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
                ((TxMetadataWithSchema
  -> Const (First TxMetadata) TxMetadataWithSchema)
 -> Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> TxMetadataWithSchema
    -> Const (First TxMetadata) TxMetadataWithSchema)
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "txMetadataWithSchema_metadata"
  ((TxMetadata -> Const (First TxMetadata) TxMetadata)
   -> TxMetadataWithSchema
   -> Const (First TxMetadata) TxMetadataWithSchema)
(TxMetadata -> Const (First TxMetadata) TxMetadata)
-> TxMetadataWithSchema
-> Const (First TxMetadata) TxMetadataWithSchema
#txMetadataWithSchema_metadata
            }
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ApiFee)
-> (ErrWalletNotResponding -> Handler ApiFee)
-> (WorkerCtx ctx -> Handler ApiFee)
-> Handler ApiFee
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ApiFee
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ApiFee
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ApiFee) -> Handler ApiFee)
-> (WorkerCtx ctx -> Handler ApiFee) -> Handler ApiFee
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        let outs :: NonEmpty TxOut
outs = AddressAmount (ApiT Address, Proxy n) -> TxOut
forall (n :: NetworkDiscriminant).
AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address, Proxy n) -> TxOut)
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
-> NonEmpty TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PostTransactionFeeOldData n
body PostTransactionFeeOldData n
-> ((NonEmpty (AddressAmount (ApiT Address, Proxy n))
     -> Const
          (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
          (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
    -> PostTransactionFeeOldData n
    -> Const
         (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
         (PostTransactionFeeOldData n))
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((NonEmpty (AddressAmount (ApiT Address, Proxy n))
    -> Const
         (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
         (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
   -> PostTransactionFeeOldData n
   -> Const
        (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
        (PostTransactionFeeOldData n))
(NonEmpty (AddressAmount (ApiT Address, Proxy n))
 -> Const
      (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
      (NonEmpty (AddressAmount (ApiT Address, Proxy n))))
-> PostTransactionFeeOldData n
-> Const
     (NonEmpty (AddressAmount (ApiT Address, Proxy n)))
     (PostTransactionFeeOldData n)
#payments
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        let getFee :: b -> Selection -> Coin
getFee = (Selection -> Coin) -> b -> Selection -> Coin
forall a b. a -> b -> a
const ((TokenBundle -> Coin) -> Selection -> Coin
forall change. (change -> Coin) -> SelectionOf change -> Coin
selectionDelta TokenBundle -> Coin
TokenBundle.getCoin)
        let selectAssetsParams :: SelectAssetsParams s Coin
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty TxOut
outs
                , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                }
        let runSelection :: ExceptT ErrSelectAssets IO Coin
runSelection =
                WalletLayer IO s k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s Coin
-> (s -> Selection -> Coin)
-> ExceptT ErrSelectAssets IO Coin
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams s Coin
selectAssetsParams s -> Selection -> Coin
forall b. b -> Selection -> Coin
getFee
        [Coin]
minCoins <- IO [Coin] -> Handler [Coin]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WalletLayer IO s k -> AnyCardanoEra -> [TxOut] -> IO [Coin]
forall ctx (k :: Depth -> * -> *) (f :: * -> *).
(HasTransactionLayer k ctx, HasNetworkLayer IO ctx,
 Applicative f) =>
ctx -> AnyCardanoEra -> f TxOut -> IO (f Coin)
W.calcMinimumCoinValues @_ @k WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era (NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty TxOut
outs))
        ExceptT ErrSelectAssets IO ApiFee -> Handler ApiFee
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSelectAssets IO ApiFee -> Handler ApiFee)
-> ExceptT ErrSelectAssets IO ApiFee -> Handler ApiFee
forall a b. (a -> b) -> a -> b
$ Maybe Coin -> [Coin] -> FeeEstimation -> ApiFee
mkApiFee Maybe Coin
forall a. Maybe a
Nothing [Coin]
minCoins (FeeEstimation -> ApiFee)
-> ExceptT ErrSelectAssets IO FeeEstimation
-> ExceptT ErrSelectAssets IO ApiFee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT ErrSelectAssets IO Coin
-> ExceptT ErrSelectAssets IO FeeEstimation
forall (m :: * -> *).
Monad m =>
ExceptT ErrSelectAssets m Coin
-> ExceptT ErrSelectAssets m FeeEstimation
W.estimateFee ExceptT ErrSelectAssets IO Coin
runSelection

constructTransaction
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , GenChange s
        , HardDerivation k
        , HasNetworkLayer IO ctx
        , IsOurs s Address
        , Typeable n
        , Typeable s
        , WalletKey k
        , BoundedAddressLength k
        )
    => ctx
    -> ArgGenChange s
    -> IO (Set PoolId)
    -> (PoolId -> IO PoolLifeCycleStatus)
    -> ApiT WalletId
    -> ApiConstructTransactionData n
    -> Handler (ApiConstructTransaction n)
constructTransaction :: ctx
-> ArgGenChange s
-> IO (Set PoolId)
-> (PoolId -> IO PoolLifeCycleStatus)
-> ApiT WalletId
-> ApiConstructTransactionData n
-> Handler (ApiConstructTransaction n)
constructTransaction ctx
ctx ArgGenChange s
genChange IO (Set PoolId)
knownPools PoolId -> IO PoolLifeCycleStatus
getPoolStatus (ApiT WalletId
wid) ApiConstructTransactionData n
body = do
    let isNoPayload :: Bool
isNoPayload =
            Maybe (ApiPaymentDestination n) -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (ApiPaymentDestination n)
     -> Const
          (Maybe (ApiPaymentDestination n))
          (Maybe (ApiPaymentDestination n)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
-> Maybe (ApiPaymentDestination n)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((Maybe (ApiPaymentDestination n)
    -> Const
         (Maybe (ApiPaymentDestination n))
         (Maybe (ApiPaymentDestination n)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
(Maybe (ApiPaymentDestination n)
 -> Const
      (Maybe (ApiPaymentDestination n))
      (Maybe (ApiPaymentDestination n)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n)
#payments) Bool -> Bool -> Bool
&&
            Maybe ApiWithdrawalPostData -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe ApiWithdrawalPostData
     -> Const
          (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n))
-> Maybe ApiWithdrawalPostData
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawal"
  ((Maybe ApiWithdrawalPostData
    -> Const
         (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n))
(Maybe ApiWithdrawalPostData
 -> Const
      (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
-> ApiConstructTransactionData n
-> Const
     (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n)
#withdrawal) Bool -> Bool -> Bool
&&
            Maybe TxMetadataWithSchema -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe TxMetadataWithSchema
     -> Const (Maybe TxMetadataWithSchema) (Maybe TxMetadataWithSchema))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe TxMetadataWithSchema) (ApiConstructTransactionData n))
-> Maybe TxMetadataWithSchema
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "metadata"
  ((Maybe TxMetadataWithSchema
    -> Const (Maybe TxMetadataWithSchema) (Maybe TxMetadataWithSchema))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe TxMetadataWithSchema) (ApiConstructTransactionData n))
(Maybe TxMetadataWithSchema
 -> Const (Maybe TxMetadataWithSchema) (Maybe TxMetadataWithSchema))
-> ApiConstructTransactionData n
-> Const
     (Maybe TxMetadataWithSchema) (ApiConstructTransactionData n)
#metadata) Bool -> Bool -> Bool
&&
            Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty (ApiMintBurnData n))
     -> Const
          (Maybe (NonEmpty (ApiMintBurnData n)))
          (Maybe (NonEmpty (ApiMintBurnData n))))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty (ApiMintBurnData n)))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty (ApiMintBurnData n))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mintBurn"
  ((Maybe (NonEmpty (ApiMintBurnData n))
    -> Const
         (Maybe (NonEmpty (ApiMintBurnData n)))
         (Maybe (NonEmpty (ApiMintBurnData n))))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty (ApiMintBurnData n)))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty (ApiMintBurnData n))
 -> Const
      (Maybe (NonEmpty (ApiMintBurnData n)))
      (Maybe (NonEmpty (ApiMintBurnData n))))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty (ApiMintBurnData n)))
     (ApiConstructTransactionData n)
#mintBurn) Bool -> Bool -> Bool
&&
            Maybe (NonEmpty ApiMultiDelegationAction) -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty ApiMultiDelegationAction)
     -> Const
          (Maybe (NonEmpty ApiMultiDelegationAction))
          (Maybe (NonEmpty ApiMultiDelegationAction)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty ApiMultiDelegationAction)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegations"
  ((Maybe (NonEmpty ApiMultiDelegationAction)
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (Maybe (NonEmpty ApiMultiDelegationAction)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty ApiMultiDelegationAction))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty ApiMultiDelegationAction)
 -> Const
      (Maybe (NonEmpty ApiMultiDelegationAction))
      (Maybe (NonEmpty ApiMultiDelegationAction)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty ApiMultiDelegationAction))
     (ApiConstructTransactionData n)
#delegations)
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNoPayload (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxWrongPayload

    let mintingBurning :: Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning = ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty (ApiMintBurnData n))
     -> Const
          (Maybe (NonEmpty (ApiMintBurnData n)))
          (Maybe (NonEmpty (ApiMintBurnData n))))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty (ApiMintBurnData n)))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty (ApiMintBurnData n))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mintBurn"
  ((Maybe (NonEmpty (ApiMintBurnData n))
    -> Const
         (Maybe (NonEmpty (ApiMintBurnData n)))
         (Maybe (NonEmpty (ApiMintBurnData n))))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty (ApiMintBurnData n)))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty (ApiMintBurnData n))
 -> Const
      (Maybe (NonEmpty (ApiMintBurnData n)))
      (Maybe (NonEmpty (ApiMintBurnData n))))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty (ApiMintBurnData n)))
     (ApiConstructTransactionData n)
#mintBurn
    let handleMissingAssetName :: ApiMintBurnData n -> ApiMintBurnData n
        handleMissingAssetName :: ApiMintBurnData n -> ApiMintBurnData n
handleMissingAssetName ApiMintBurnData n
mb = case ApiMintBurnData n
mb ApiMintBurnData n
-> ((Maybe (ApiT TokenName)
     -> Const (Maybe (ApiT TokenName)) (Maybe (ApiT TokenName)))
    -> ApiMintBurnData n
    -> Const (Maybe (ApiT TokenName)) (ApiMintBurnData n))
-> Maybe (ApiT TokenName)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "assetName"
  ((Maybe (ApiT TokenName)
    -> Const (Maybe (ApiT TokenName)) (Maybe (ApiT TokenName)))
   -> ApiMintBurnData n
   -> Const (Maybe (ApiT TokenName)) (ApiMintBurnData n))
(Maybe (ApiT TokenName)
 -> Const (Maybe (ApiT TokenName)) (Maybe (ApiT TokenName)))
-> ApiMintBurnData n
-> Const (Maybe (ApiT TokenName)) (ApiMintBurnData n)
#assetName of
            Maybe (ApiT TokenName)
Nothing -> ApiMintBurnData n
mb {$sel:assetName:ApiMintBurnData :: Maybe (ApiT TokenName)
assetName = ApiT TokenName -> Maybe (ApiT TokenName)
forall a. a -> Maybe a
Just (ApiT TokenName -> Maybe (ApiT TokenName))
-> ApiT TokenName -> Maybe (ApiT TokenName)
forall a b. (a -> b) -> a -> b
$ TokenName -> ApiT TokenName
forall a. a -> ApiT a
ApiT TokenName
nullTokenName}
            Just ApiT TokenName
_ -> ApiMintBurnData n
mb
    let mintingBurning' :: Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' = (ApiMintBurnData n -> ApiMintBurnData n)
-> NonEmpty (ApiMintBurnData n) -> NonEmpty (ApiMintBurnData n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ApiMintBurnData n -> ApiMintBurnData n
handleMissingAssetName (NonEmpty (ApiMintBurnData n) -> NonEmpty (ApiMintBurnData n))
-> Maybe (NonEmpty (ApiMintBurnData n))
-> Maybe (NonEmpty (ApiMintBurnData n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning
    let retrieveAllCosigners :: Script a -> [a]
retrieveAllCosigners = (a -> [a] -> [a]) -> [a] -> Script a -> [a]
forall a b. (a -> b -> b) -> b -> Script a -> b
foldScript (:) []
    let wrongMintingTemplate :: ApiMintBurnData n -> Bool
wrongMintingTemplate (ApiMintBurnData (ApiT Script Cosigner
scriptTempl) Maybe (ApiT TokenName)
_ ApiMintBurnOperation n
_) =
            Either ErrValidateScript () -> Bool
forall a b. Either a b -> Bool
isLeft (ValidationLevel -> Script Cosigner -> Either ErrValidateScript ()
validateScriptOfTemplate ValidationLevel
RecommendedValidation Script Cosigner
scriptTempl)
            Bool -> Bool -> Bool
|| [Cosigner] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Script Cosigner -> [Cosigner]
forall a. Script a -> [a]
retrieveAllCosigners Script Cosigner
scriptTempl) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
            Bool -> Bool -> Bool
|| ((Cosigner -> Bool) -> [Cosigner] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any (Cosigner -> Cosigner -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> Cosigner
Cosigner Word8
0)) (Script Cosigner -> [Cosigner]
forall a. Script a -> [a]
retrieveAllCosigners Script Cosigner
scriptTempl)
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' Bool -> Bool -> Bool
&&
          (ApiMintBurnData n -> Bool) -> [ApiMintBurnData n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any ApiMintBurnData n -> Bool
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> Bool
wrongMintingTemplate (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n])
-> NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmpty (ApiMintBurnData n))
-> NonEmpty (ApiMintBurnData n)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning')
        ) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxWrongMintingBurningTemplate

    let assetNameTooLong :: ApiMintBurnData n -> Bool
assetNameTooLong = \case
            (ApiMintBurnData ApiT (Script Cosigner)
_ (Just (ApiT (UnsafeTokenName ByteString
bs))) ApiMintBurnOperation n
_) ->
                ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
tokenNameMaxLength
            ApiMintBurnData n
_ ->
                String -> Bool
forall a. HasCallStack => String -> a
error String
"tokenName should be nonempty at this step"
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' Bool -> Bool -> Bool
&&
          (ApiMintBurnData n -> Bool) -> [ApiMintBurnData n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any ApiMintBurnData n -> Bool
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> Bool
assetNameTooLong (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n])
-> NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmpty (ApiMintBurnData n))
-> NonEmpty (ApiMintBurnData n)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning')
        ) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxAssetNameTooLong

    let assetQuantityOutOfBounds :: ApiMintBurnData n -> Bool
assetQuantityOutOfBounds
            (ApiMintBurnData ApiT (Script Cosigner)
_ Maybe (ApiT TokenName)
_ (ApiMint (ApiMintData Maybe (ApiT Address, Proxy n)
_ Natural
amt))) =
            Natural
amt Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
0 Bool -> Bool -> Bool
|| Natural
amt Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> TokenQuantity -> Natural
unTokenQuantity TokenQuantity
txMintBurnMaxTokenQuantity
        assetQuantityOutOfBounds
            (ApiMintBurnData ApiT (Script Cosigner)
_ Maybe (ApiT TokenName)
_ (ApiBurn (ApiBurnData Natural
amt))) =
            Natural
amt Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
0 Bool -> Bool -> Bool
|| Natural
amt Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> TokenQuantity -> Natural
unTokenQuantity TokenQuantity
txMintBurnMaxTokenQuantity
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' Bool -> Bool -> Bool
&&
          (ApiMintBurnData n -> Bool) -> [ApiMintBurnData n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any ApiMintBurnData n -> Bool
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> Bool
assetQuantityOutOfBounds (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n])
-> NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmpty (ApiMintBurnData n))
-> NonEmpty (ApiMintBurnData n)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning')
        ) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
            ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxMintOrBurnAssetQuantityOutOfBounds

    let checkIx :: ApiStakeKeyIndex -> Bool
checkIx (ApiStakeKeyIndex (ApiT DerivationIndex
derIndex)) =
            DerivationIndex
derIndex DerivationIndex -> DerivationIndex -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> DerivationIndex
DerivationIndex (Index 'Hardened Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Hardened Index 'Hardened Any
forall a. Bounded a => a
minBound)
    let validApiDelAction :: ApiMultiDelegationAction -> Bool
validApiDelAction = \case
            Joining ApiT PoolId
_ ApiStakeKeyIndex
stakeKeyIx -> ApiStakeKeyIndex -> Bool
checkIx ApiStakeKeyIndex
stakeKeyIx
            Leaving ApiStakeKeyIndex
stakeKeyIx -> ApiStakeKeyIndex -> Bool
checkIx ApiStakeKeyIndex
stakeKeyIx
    let notall0Haccount :: Bool
notall0Haccount = case ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty ApiMultiDelegationAction)
     -> Const
          (Maybe (NonEmpty ApiMultiDelegationAction))
          (Maybe (NonEmpty ApiMultiDelegationAction)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty ApiMultiDelegationAction)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegations"
  ((Maybe (NonEmpty ApiMultiDelegationAction)
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (Maybe (NonEmpty ApiMultiDelegationAction)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty ApiMultiDelegationAction))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty ApiMultiDelegationAction)
 -> Const
      (Maybe (NonEmpty ApiMultiDelegationAction))
      (Maybe (NonEmpty ApiMultiDelegationAction)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty ApiMultiDelegationAction))
     (ApiConstructTransactionData n)
#delegations of
            Maybe (NonEmpty ApiMultiDelegationAction)
Nothing -> Bool
False
            Just NonEmpty ApiMultiDelegationAction
delegs -> Bool -> Bool
not (Bool -> Bool)
-> ([ApiMultiDelegationAction] -> Bool)
-> [ApiMultiDelegationAction]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiMultiDelegationAction -> Bool)
-> [ApiMultiDelegationAction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ApiMultiDelegationAction -> Bool
validApiDelAction ([ApiMultiDelegationAction] -> Bool)
-> [ApiMultiDelegationAction] -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty ApiMultiDelegationAction -> [ApiMultiDelegationAction]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ApiMultiDelegationAction
delegs
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notall0Haccount (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxMultiaccountNotSupported

    let md :: Maybe TxMetadata
md = ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> ApiConstructTransactionData n
    -> Const (First TxMetadata) (ApiConstructTransactionData n))
-> Maybe TxMetadata
forall s a.
s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? IsLabel
  "metadata"
  ((Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
   -> ApiConstructTransactionData n
   -> Const (First TxMetadata) (ApiConstructTransactionData n))
(Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> ApiConstructTransactionData n
-> Const (First TxMetadata) (ApiConstructTransactionData n)
#metadata ((Maybe TxMetadataWithSchema
  -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
 -> ApiConstructTransactionData n
 -> Const (First TxMetadata) (ApiConstructTransactionData n))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> ApiConstructTransactionData n
-> Const (First TxMetadata) (ApiConstructTransactionData n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMetadataWithSchema
 -> Const (First TxMetadata) TxMetadataWithSchema)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TxMetadataWithSchema
  -> Const (First TxMetadata) TxMetadataWithSchema)
 -> Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> TxMetadataWithSchema
    -> Const (First TxMetadata) TxMetadataWithSchema)
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "txMetadataWithSchema_metadata"
  ((TxMetadata -> Const (First TxMetadata) TxMetadata)
   -> TxMetadataWithSchema
   -> Const (First TxMetadata) TxMetadataWithSchema)
(TxMetadata -> Const (First TxMetadata) TxMetadata)
-> TxMetadataWithSchema
-> Const (First TxMetadata) TxMetadataWithSchema
#txMetadataWithSchema_metadata

    (SlotNo
before, SlotNo
hereafter, Bool
isThereNegativeTime) <-
        TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe ApiValidityInterval -> Handler (SlotNo, SlotNo, Bool)
decodeValidityInterval TimeInterpreter (ExceptT PastHorizonException IO)
ti (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe ApiValidityInterval
     -> Const (Maybe ApiValidityInterval) (Maybe ApiValidityInterval))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe ApiValidityInterval) (ApiConstructTransactionData n))
-> Maybe ApiValidityInterval
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "validityInterval"
  ((Maybe ApiValidityInterval
    -> Const (Maybe ApiValidityInterval) (Maybe ApiValidityInterval))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe ApiValidityInterval) (ApiConstructTransactionData n))
(Maybe ApiValidityInterval
 -> Const (Maybe ApiValidityInterval) (Maybe ApiValidityInterval))
-> ApiConstructTransactionData n
-> Const
     (Maybe ApiValidityInterval) (ApiConstructTransactionData n)
#validityInterval)

    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SlotNo
hereafter SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
before Bool -> Bool -> Bool
|| Bool
isThereNegativeTime) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxWrongValidityBounds

    let notWithinValidityInterval :: ApiMintBurnData n -> Bool
notWithinValidityInterval (ApiMintBurnData (ApiT Script Cosigner
scriptTempl) Maybe (ApiT TokenName)
_ ApiMintBurnOperation n
_) =
            Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SlotNo -> SlotNo -> [Interval Natural] -> Bool
withinSlotInterval SlotNo
before SlotNo
hereafter ([Interval Natural] -> Bool) -> [Interval Natural] -> Bool
forall a b. (a -> b) -> a -> b
$
            Script Cosigner -> [Interval Natural]
forall a. Script a -> [Interval Natural]
scriptSlotIntervals Script Cosigner
scriptTempl
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' Bool -> Bool -> Bool
&&
          (ApiMintBurnData n -> Bool) -> [ApiMintBurnData n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any ApiMintBurnData n -> Bool
notWithinValidityInterval (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n])
-> NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmpty (ApiMintBurnData n))
-> NonEmpty (ApiMintBurnData n)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning')
        )
        (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
        (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxValidityIntervalNotWithinScriptTimelock


    -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
    -- @currentNodeEra@ which is not guaranteed with the era read here. This
    -- could cause problems under exceptional circumstances.
    (Withdrawal
wdrl, RewardAccountBuilder k
_) <-
        ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe ApiWithdrawalPostData
     -> Const
          (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n))
-> Maybe ApiWithdrawalPostData
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawal"
  ((Maybe ApiWithdrawalPostData
    -> Const
         (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n))
(Maybe ApiWithdrawalPostData
 -> Const
      (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
-> ApiConstructTransactionData n
-> Const
     (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n)
#withdrawal)

    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiConstructTransaction n))
-> (ErrWalletNotResponding -> Handler (ApiConstructTransaction n))
-> (WorkerCtx ctx -> Handler (ApiConstructTransaction n))
-> Handler (ApiConstructTransaction n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiConstructTransaction n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiConstructTransaction n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiConstructTransaction n))
 -> Handler (ApiConstructTransaction n))
-> (WorkerCtx ctx -> Handler (ApiConstructTransaction n))
-> Handler (ApiConstructTransaction n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        (Maybe Coin
deposit, Maybe Coin
refund, TransactionCtx
txCtx) <- case ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty ApiMultiDelegationAction)
     -> Const
          (Maybe (NonEmpty ApiMultiDelegationAction))
          (Maybe (NonEmpty ApiMultiDelegationAction)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty ApiMultiDelegationAction)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegations"
  ((Maybe (NonEmpty ApiMultiDelegationAction)
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (Maybe (NonEmpty ApiMultiDelegationAction)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty ApiMultiDelegationAction))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty ApiMultiDelegationAction)
 -> Const
      (Maybe (NonEmpty ApiMultiDelegationAction))
      (Maybe (NonEmpty ApiMultiDelegationAction)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty ApiMultiDelegationAction))
     (ApiConstructTransactionData n)
#delegations of
            Maybe (NonEmpty ApiMultiDelegationAction)
Nothing -> (Maybe Coin, Maybe Coin, TransactionCtx)
-> Handler (Maybe Coin, Maybe Coin, TransactionCtx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Coin
forall a. Maybe a
Nothing, Maybe Coin
forall a. Maybe a
Nothing, TransactionCtx
defaultTransactionCtx
                 { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                 , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
md
                 , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
before, SlotNo
hereafter)
                 })
            Just NonEmpty ApiMultiDelegationAction
delegs -> do
                -- TODO: Current limitation:
                -- at this moment we are handling just one delegation action:
                -- either joining pool, or rejoining or quitting
                -- When we support multi-account this should be lifted
                (DelegationAction
action, Maybe Coin
deposit, Maybe Coin
refund) <- case NonEmpty ApiMultiDelegationAction -> [ApiMultiDelegationAction]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ApiMultiDelegationAction
delegs of
                    [(Joining (ApiT PoolId
pid) ApiStakeKeyIndex
_)] -> do
                        PoolLifeCycleStatus
poolStatus <- IO PoolLifeCycleStatus -> Handler PoolLifeCycleStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PoolId -> IO PoolLifeCycleStatus
getPoolStatus PoolId
pid)
                        Set PoolId
pools <- IO (Set PoolId) -> Handler (Set PoolId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Set PoolId)
knownPools
                        EpochNo
curEpoch <- ctx -> Handler EpochNo
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k) =>
ctx -> Handler EpochNo
getCurrentEpoch ctx
ctx
                        (DelegationAction
del, Maybe Coin
act) <- ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
 -> Handler (DelegationAction, Maybe Coin))
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> EpochNo
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> WalletId
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> EpochNo
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> WalletId
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
W.joinStakePool
                            @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk EpochNo
curEpoch Set PoolId
pools PoolId
pid PoolLifeCycleStatus
poolStatus WalletId
wid
                        (DelegationAction, Maybe Coin, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin, Maybe Coin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelegationAction
del, Maybe Coin
act, Maybe Coin
forall a. Maybe a
Nothing)
                    [(Leaving ApiStakeKeyIndex
_)] -> do
                        DelegationAction
del <- ExceptT ErrStakePoolDelegation IO DelegationAction
-> Handler DelegationAction
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrStakePoolDelegation IO DelegationAction
 -> Handler DelegationAction)
-> ExceptT ErrStakePoolDelegation IO DelegationAction
-> Handler DelegationAction
forall a b. (a -> b) -> a -> b
$
                            WalletLayer IO s k
-> WalletId
-> Withdrawal
-> ExceptT ErrStakePoolDelegation IO DelegationAction
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Withdrawal
-> ExceptT ErrStakePoolDelegation IO DelegationAction
W.quitStakePool @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid Withdrawal
wdrl
                        (DelegationAction, Maybe Coin, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin, Maybe Coin)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DelegationAction
del, Maybe Coin
forall a. Maybe a
Nothing, Coin -> Maybe Coin
forall a. a -> Maybe a
Just (Coin -> Maybe Coin) -> Coin -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Coin
W.stakeKeyDeposit ProtocolParameters
pp)
                    [ApiMultiDelegationAction]
_ ->
                        ExceptT
  ErrConstructTx IO (DelegationAction, Maybe Coin, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin, Maybe Coin)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrConstructTx IO (DelegationAction, Maybe Coin, Maybe Coin)
 -> Handler (DelegationAction, Maybe Coin, Maybe Coin))
-> ExceptT
     ErrConstructTx IO (DelegationAction, Maybe Coin, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin, Maybe Coin)
forall a b. (a -> b) -> a -> b
$
                            ErrConstructTx
-> ExceptT
     ErrConstructTx IO (DelegationAction, Maybe Coin, Maybe Coin)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxMultidelegationNotSupported

                (Maybe Coin, Maybe Coin, TransactionCtx)
-> Handler (Maybe Coin, Maybe Coin, TransactionCtx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Coin
deposit, Maybe Coin
refund, TransactionCtx
defaultTransactionCtx
                    { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                    , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
md
                    , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
before, SlotNo
hereafter)
                    , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
action
                    })
        let transform :: s
-> Selection
-> (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex),
    Selection, Coin)
transform s
s Selection
sel =
                ( ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
forall s.
GenChange s =>
ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
W.assignChangeAddresses ArgGenChange s
genChange Selection
sel s
s
                    (SelectionOf TxOut, s)
-> ((SelectionOf TxOut, s)
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b. a -> (a -> b) -> b
& (SelectionOf TxOut
 -> s
 -> UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (SelectionOf TxOut, s)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall s input output change withdrawal.
(IsOurs s Address, input ~ (TxIn, TxOut, NonEmpty DerivationIndex),
 output ~ TxOut, change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx input output change withdrawal
W.selectionToUnsignedTx (TransactionCtx -> Withdrawal
txWithdrawal TransactionCtx
txCtx))
                , Selection
sel
                , (TokenBundle -> Coin) -> Selection -> Coin
forall change. (change -> Coin) -> SelectionOf change -> Coin
selectionDelta TokenBundle -> Coin
TokenBundle.getCoin Selection
sel
                )

        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        (TransactionCtx
txCtx', Maybe XPub
policyXPubM) <-
            if Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' then do
                (XPub
policyXPub, NonEmpty DerivationIndex
_) <-
                    ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
 -> Handler (XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
W.readPolicyPublicKey @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
                let isMinting :: ApiMintBurnData n -> Bool
isMinting (ApiMintBurnData ApiT (Script Cosigner)
_ Maybe (ApiT TokenName)
_ (ApiMint ApiMintData n
_)) = Bool
True
                    isMinting ApiMintBurnData n
_ = Bool
False
                let getMinting :: ApiMintBurnData n -> (AssetId, TokenQuantity, Script KeyHash)
getMinting = \case
                        ApiMintBurnData
                            (ApiT Script Cosigner
scriptT)
                            (Just (ApiT TokenName
tName))
                            (ApiMint (ApiMintData Maybe (ApiT Address, Proxy n)
_ Natural
amt)) ->
                            Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
forall (key :: Depth -> * -> *).
WalletKey key =>
Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
toTokenMapAndScript @k
                                Script Cosigner
scriptT
                                (Cosigner -> XPub -> Map Cosigner XPub
forall k a. k -> a -> Map k a
Map.singleton (Word8 -> Cosigner
Cosigner Word8
0) XPub
policyXPub)
                                TokenName
tName
                                Natural
amt
                        ApiMintBurnData n
_ -> String -> (AssetId, TokenQuantity, Script KeyHash)
forall a. HasCallStack => String -> a
error String
"getMinting should not be used in this way"
                let getBurning :: ApiMintBurnData n -> (AssetId, TokenQuantity, Script KeyHash)
getBurning = \case
                        ApiMintBurnData
                            (ApiT Script Cosigner
scriptT)
                            (Just (ApiT TokenName
tName))
                            (ApiBurn (ApiBurnData Natural
amt)) ->
                            Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
forall (key :: Depth -> * -> *).
WalletKey key =>
Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
toTokenMapAndScript @k
                                Script Cosigner
scriptT
                                (Cosigner -> XPub -> Map Cosigner XPub
forall k a. k -> a -> Map k a
Map.singleton (Word8 -> Cosigner
Cosigner Word8
0) XPub
policyXPub)
                                TokenName
tName
                                Natural
amt
                        ApiMintBurnData n
_ -> String -> (AssetId, TokenQuantity, Script KeyHash)
forall a. HasCallStack => String -> a
error String
"getBurning should not be used in this way"
                let toTokenMap :: [(AssetId, TokenQuantity, c)] -> TokenMap
toTokenMap =
                        [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList ([(AssetId, TokenQuantity)] -> TokenMap)
-> ([(AssetId, TokenQuantity, c)] -> [(AssetId, TokenQuantity)])
-> [(AssetId, TokenQuantity, c)]
-> TokenMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        ((AssetId, TokenQuantity, c) -> (AssetId, TokenQuantity))
-> [(AssetId, TokenQuantity, c)] -> [(AssetId, TokenQuantity)]
forall a b. (a -> b) -> [a] -> [b]
map (\(AssetId
a,TokenQuantity
q,c
_) -> (AssetId
a,TokenQuantity
q))
                let toScriptTemplateMap :: [(AssetId, b, a)] -> Map AssetId a
toScriptTemplateMap =
                        [(AssetId, a)] -> Map AssetId a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(AssetId, a)] -> Map AssetId a)
-> ([(AssetId, b, a)] -> [(AssetId, a)])
-> [(AssetId, b, a)]
-> Map AssetId a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        ((AssetId, b, a) -> (AssetId, a))
-> [(AssetId, b, a)] -> [(AssetId, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(AssetId
a,b
_,a
s) -> (AssetId
a,a
s))
                let mintingData :: (TokenMap, Map AssetId (Script KeyHash))
mintingData =
                        [(AssetId, TokenQuantity, Script KeyHash)] -> TokenMap
forall c. [(AssetId, TokenQuantity, c)] -> TokenMap
toTokenMap ([(AssetId, TokenQuantity, Script KeyHash)] -> TokenMap)
-> ([(AssetId, TokenQuantity, Script KeyHash)]
    -> Map AssetId (Script KeyHash))
-> [(AssetId, TokenQuantity, Script KeyHash)]
-> (TokenMap, Map AssetId (Script KeyHash))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [(AssetId, TokenQuantity, Script KeyHash)]
-> Map AssetId (Script KeyHash)
forall b a. [(AssetId, b, a)] -> Map AssetId a
toScriptTemplateMap ([(AssetId, TokenQuantity, Script KeyHash)]
 -> (TokenMap, Map AssetId (Script KeyHash)))
-> [(AssetId, TokenQuantity, Script KeyHash)]
-> (TokenMap, Map AssetId (Script KeyHash))
forall a b. (a -> b) -> a -> b
$
                        (ApiMintBurnData n -> (AssetId, TokenQuantity, Script KeyHash))
-> [ApiMintBurnData n]
-> [(AssetId, TokenQuantity, Script KeyHash)]
forall a b. (a -> b) -> [a] -> [b]
map ApiMintBurnData n -> (AssetId, TokenQuantity, Script KeyHash)
getMinting ([ApiMintBurnData n] -> [(AssetId, TokenQuantity, Script KeyHash)])
-> [ApiMintBurnData n]
-> [(AssetId, TokenQuantity, Script KeyHash)]
forall a b. (a -> b) -> a -> b
$
                        (ApiMintBurnData n -> Bool)
-> [ApiMintBurnData n] -> [ApiMintBurnData n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiMintBurnData n -> Bool
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> Bool
isMinting ([ApiMintBurnData n] -> [ApiMintBurnData n])
-> [ApiMintBurnData n] -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$
                        NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n])
-> NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmpty (ApiMintBurnData n))
-> NonEmpty (ApiMintBurnData n)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning'
                let burningData :: (TokenMap, Map AssetId (Script KeyHash))
burningData =
                        [(AssetId, TokenQuantity, Script KeyHash)] -> TokenMap
forall c. [(AssetId, TokenQuantity, c)] -> TokenMap
toTokenMap ([(AssetId, TokenQuantity, Script KeyHash)] -> TokenMap)
-> ([(AssetId, TokenQuantity, Script KeyHash)]
    -> Map AssetId (Script KeyHash))
-> [(AssetId, TokenQuantity, Script KeyHash)]
-> (TokenMap, Map AssetId (Script KeyHash))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [(AssetId, TokenQuantity, Script KeyHash)]
-> Map AssetId (Script KeyHash)
forall b a. [(AssetId, b, a)] -> Map AssetId a
toScriptTemplateMap ([(AssetId, TokenQuantity, Script KeyHash)]
 -> (TokenMap, Map AssetId (Script KeyHash)))
-> [(AssetId, TokenQuantity, Script KeyHash)]
-> (TokenMap, Map AssetId (Script KeyHash))
forall a b. (a -> b) -> a -> b
$
                        (ApiMintBurnData n -> (AssetId, TokenQuantity, Script KeyHash))
-> [ApiMintBurnData n]
-> [(AssetId, TokenQuantity, Script KeyHash)]
forall a b. (a -> b) -> [a] -> [b]
map ApiMintBurnData n -> (AssetId, TokenQuantity, Script KeyHash)
getBurning ([ApiMintBurnData n] -> [(AssetId, TokenQuantity, Script KeyHash)])
-> [ApiMintBurnData n]
-> [(AssetId, TokenQuantity, Script KeyHash)]
forall a b. (a -> b) -> a -> b
$
                        (ApiMintBurnData n -> Bool)
-> [ApiMintBurnData n] -> [ApiMintBurnData n]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (ApiMintBurnData n -> Bool) -> ApiMintBurnData n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiMintBurnData n -> Bool
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> Bool
isMinting) ([ApiMintBurnData n] -> [ApiMintBurnData n])
-> [ApiMintBurnData n] -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$
                        NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n])
-> NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmpty (ApiMintBurnData n))
-> NonEmpty (ApiMintBurnData n)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning'
                (TransactionCtx, Maybe XPub)
-> Handler (TransactionCtx, Maybe XPub)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( TransactionCtx
txCtx
                      { $sel:txAssetsToMint:TransactionCtx :: (TokenMap, Map AssetId (Script KeyHash))
txAssetsToMint = (TokenMap, Map AssetId (Script KeyHash))
mintingData
                      , $sel:txAssetsToBurn:TransactionCtx :: (TokenMap, Map AssetId (Script KeyHash))
txAssetsToBurn = (TokenMap, Map AssetId (Script KeyHash))
burningData
                      }
                     , XPub -> Maybe XPub
forall a. a -> Maybe a
Just XPub
policyXPub)
            else
                (TransactionCtx, Maybe XPub)
-> Handler (TransactionCtx, Maybe XPub)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransactionCtx
txCtx, Maybe XPub
forall a. Maybe a
Nothing)

        let runSelection :: [TxOut]
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
runSelection [TxOut]
outs =
                WalletLayer IO s k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams
     s
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
-> (s
    -> Selection
    -> (UnsignedTx
          (TxIn, TxOut, NonEmpty DerivationIndex)
          TxOut
          (TxChange (NonEmpty DerivationIndex))
          (RewardAccount, Coin, NonEmpty DerivationIndex),
        Selection, Coin))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex),
   Selection, Coin)
selectAssetsParams s
-> Selection
-> (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex),
    Selection, Coin)
transform
              where
                selectAssetsParams :: SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex),
   Selection, Coin)
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                    { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = [TxOut]
outs
                    , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                    , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                    , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx'
                    , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs =
                        UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                    , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral =
                        UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                    , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                    , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                    }

        (SelectionOf TxOut
sel, UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel', Word64
fee) <- do
            [TxOut]
outs <- case (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (ApiPaymentDestination n)
     -> Const
          (Maybe (ApiPaymentDestination n))
          (Maybe (ApiPaymentDestination n)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
-> Maybe (ApiPaymentDestination n)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((Maybe (ApiPaymentDestination n)
    -> Const
         (Maybe (ApiPaymentDestination n))
         (Maybe (ApiPaymentDestination n)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
(Maybe (ApiPaymentDestination n)
 -> Const
      (Maybe (ApiPaymentDestination n))
      (Maybe (ApiPaymentDestination n)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n)
#payments) of
                Maybe (ApiPaymentDestination n)
Nothing -> [TxOut] -> Handler [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just (ApiPaymentAddresses NonEmpty (AddressAmount (ApiAddressIdT n))
content) ->
                    [TxOut] -> Handler [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TxOut] -> Handler [TxOut]) -> [TxOut] -> Handler [TxOut]
forall a b. (a -> b) -> a -> b
$ NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (AddressAmount (ApiT Address, Proxy n) -> TxOut
forall (n :: NetworkDiscriminant).
AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address, Proxy n) -> TxOut)
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
-> NonEmpty TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (AddressAmount (ApiT Address, Proxy n))
NonEmpty (AddressAmount (ApiAddressIdT n))
content)
                Just (ApiPaymentAll NonEmpty (ApiT Address, Proxy n)
_) -> do
                    ExceptT ErrConstructTx IO [TxOut] -> Handler [TxOut]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO [TxOut] -> Handler [TxOut])
-> ExceptT ErrConstructTx IO [TxOut] -> Handler [TxOut]
forall a b. (a -> b) -> a -> b
$
                        ErrConstructTx -> ExceptT ErrConstructTx IO [TxOut]
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrConstructTx -> ExceptT ErrConstructTx IO [TxOut])
-> ErrConstructTx -> ExceptT ErrConstructTx IO [TxOut]
forall a b. (a -> b) -> a -> b
$ String -> ErrConstructTx
ErrConstructTxNotImplemented String
"ADP-1189"

            let mintWithAddress :: ApiMintBurnData n -> Bool
mintWithAddress
                    (ApiMintBurnData ApiT (Script Cosigner)
_ Maybe (ApiT TokenName)
_ (ApiMint (ApiMintData (Just (ApiT Address, Proxy n)
_) Natural
_)))
                    = Bool
True
                mintWithAddress ApiMintBurnData n
_ = Bool
False
            let mintingOuts :: [TxOut]
mintingOuts = case Maybe (NonEmpty (ApiMintBurnData n))
mintingBurning' of
                    Just NonEmpty (ApiMintBurnData n)
mintBurns ->
                        [((ApiT Address, Proxy n), TokenMap)] -> [TxOut]
forall (n :: NetworkDiscriminant).
[((ApiT Address, Proxy n), TokenMap)] -> [TxOut]
coalesceTokensPerAddr ([((ApiT Address, Proxy n), TokenMap)] -> [TxOut])
-> [((ApiT Address, Proxy n), TokenMap)] -> [TxOut]
forall a b. (a -> b) -> a -> b
$
                        (ApiMintBurnData n -> ((ApiT Address, Proxy n), TokenMap))
-> [ApiMintBurnData n] -> [((ApiT Address, Proxy n), TokenMap)]
forall a b. (a -> b) -> [a] -> [b]
map (XPub -> ApiMintBurnData n -> ((ApiT Address, Proxy n), TokenMap)
toMintTxOut (Maybe XPub -> XPub
forall a. HasCallStack => Maybe a -> a
fromJust Maybe XPub
policyXPubM)) ([ApiMintBurnData n] -> [((ApiT Address, Proxy n), TokenMap)])
-> [ApiMintBurnData n] -> [((ApiT Address, Proxy n), TokenMap)]
forall a b. (a -> b) -> a -> b
$
                        (ApiMintBurnData n -> Bool)
-> [ApiMintBurnData n] -> [ApiMintBurnData n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiMintBurnData n -> Bool
forall (n :: NetworkDiscriminant). ApiMintBurnData n -> Bool
mintWithAddress ([ApiMintBurnData n] -> [ApiMintBurnData n])
-> [ApiMintBurnData n] -> [ApiMintBurnData n]
forall a b. (a -> b) -> a -> b
$
                        NonEmpty (ApiMintBurnData n) -> [ApiMintBurnData n]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (ApiMintBurnData n)
mintBurns
                    Maybe (NonEmpty (ApiMintBurnData n))
Nothing -> []

            (UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel', Selection
utx, Coin
fee') <- ExceptT
  ErrSelectAssets
  IO
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex),
   Selection, Coin)
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrSelectAssets
   IO
   (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex),
    Selection, Coin)
 -> Handler
      (UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex),
       Selection, Coin))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
forall a b. (a -> b) -> a -> b
$
                [TxOut]
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
runSelection ([TxOut]
outs [TxOut] -> [TxOut] -> [TxOut]
forall a. [a] -> [a] -> [a]
++ [TxOut]
mintingOuts)
            SelectionOf TxOut
sel <- ExceptT ErrConstructTx IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO (SelectionOf TxOut)
 -> Handler (SelectionOf TxOut))
-> ExceptT ErrConstructTx IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall a b. (a -> b) -> a -> b
$
                WalletLayer IO s k
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrConstructTx IO (SelectionOf TxOut)
forall ctx s (k :: Depth -> * -> *).
(GenChange s, HasDBLayer IO s k ctx) =>
ctx
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrConstructTx IO (SelectionOf TxOut)
W.assignChangeAddressesWithoutDbUpdate WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid ArgGenChange s
genChange Selection
utx
            (FeeEstimation Word64
estMin Word64
_) <- ExceptT ErrSelectAssets IO FeeEstimation -> Handler FeeEstimation
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSelectAssets IO FeeEstimation -> Handler FeeEstimation)
-> ExceptT ErrSelectAssets IO FeeEstimation
-> Handler FeeEstimation
forall a b. (a -> b) -> a -> b
$ ExceptT ErrSelectAssets IO Coin
-> ExceptT ErrSelectAssets IO FeeEstimation
forall (m :: * -> *).
Monad m =>
ExceptT ErrSelectAssets m Coin
-> ExceptT ErrSelectAssets m FeeEstimation
W.estimateFee (Coin -> ExceptT ErrSelectAssets IO Coin
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
fee')
            (SelectionOf TxOut,
 UnsignedTx
   (TxIn, TxOut, NonEmpty DerivationIndex)
   TxOut
   (TxChange (NonEmpty DerivationIndex))
   (RewardAccount, Coin, NonEmpty DerivationIndex),
 Word64)
-> Handler
     (SelectionOf TxOut,
      UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectionOf TxOut
sel, UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel', Word64
estMin)

        SealedTx
tx <- ExceptT ErrConstructTx IO SealedTx -> Handler SealedTx
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrConstructTx IO SealedTx -> Handler SealedTx)
-> ExceptT ErrConstructTx IO SealedTx -> Handler SealedTx
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> AnyCardanoEra
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrConstructTx IO SealedTx
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasTransactionLayer k ctx, HasDBLayer IO s k ctx,
 HasNetworkLayer IO ctx, Typeable s, Typeable n) =>
ctx
-> WalletId
-> AnyCardanoEra
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrConstructTx IO SealedTx
W.constructTransaction @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid AnyCardanoEra
era TransactionCtx
txCtx' SelectionOf TxOut
sel

        ApiConstructTransaction n -> Handler (ApiConstructTransaction n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiConstructTransaction n -> Handler (ApiConstructTransaction n))
-> ApiConstructTransaction n -> Handler (ApiConstructTransaction n)
forall a b. (a -> b) -> a -> b
$ ApiConstructTransaction :: forall (n :: NetworkDiscriminant).
ApiT SealedTx
-> ApiCoinSelection n
-> Quantity "lovelace" Natural
-> ApiConstructTransaction n
ApiConstructTransaction
            { $sel:transaction:ApiConstructTransaction :: ApiT SealedTx
transaction = SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
ApiT SealedTx
tx
            , $sel:coinSelection:ApiConstructTransaction :: ApiCoinSelection n
coinSelection = [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant) input output change withdrawal.
(input ~ (TxIn, TxOut, NonEmpty DerivationIndex), output ~ TxOut,
 change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
[Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection
                (Maybe Coin -> [Coin]
forall a. Maybe a -> [a]
maybeToList Maybe Coin
deposit) (Maybe Coin -> [Coin]
forall a. Maybe a -> [a]
maybeToList Maybe Coin
refund) Maybe (DelegationAction, NonEmpty DerivationIndex)
forall a. Maybe a
Nothing Maybe TxMetadata
md UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel'
            , $sel:fee:ApiConstructTransaction :: Quantity "lovelace" Natural
fee = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
fee
            }
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

    toMintTxOut :: XPub -> ApiMintBurnData n -> ((ApiT Address, Proxy n), TokenMap)
toMintTxOut XPub
policyXPub
        (ApiMintBurnData (ApiT Script Cosigner
scriptT) (Just (ApiT TokenName
tName))
            (ApiMint (ApiMintData (Just (ApiT Address, Proxy n)
addr) Natural
amt))) =
                let (AssetId
assetId, TokenQuantity
tokenQuantity, Script KeyHash
_) =
                        Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
forall (key :: Depth -> * -> *).
WalletKey key =>
Script Cosigner
-> Map Cosigner XPub
-> TokenName
-> Natural
-> (AssetId, TokenQuantity, Script KeyHash)
toTokenMapAndScript @k
                            Script Cosigner
scriptT (Cosigner -> XPub -> Map Cosigner XPub
forall k a. k -> a -> Map k a
Map.singleton (Word8 -> Cosigner
Cosigner Word8
0) XPub
policyXPub)
                            TokenName
tName Natural
amt
                    assets :: TokenMap
assets = [(AssetId, TokenQuantity)] -> TokenMap
fromFlatList [(AssetId
assetId, TokenQuantity
tokenQuantity)]
                in
                ((ApiT Address, Proxy n)
addr, TokenMap
assets)
    toMintTxOut XPub
_ ApiMintBurnData n
_ = String -> ((ApiT Address, Proxy n), TokenMap)
forall a. HasCallStack => String -> a
error
        String
"toMintTxOut can only be used in the minting context with addr \
        \specified"

    coalesceTokensPerAddr :: [((ApiT Address, Proxy n), TokenMap)] -> [TxOut]
coalesceTokensPerAddr =
        let toTxOut :: ((ApiT Address, Proxy n), TokenMap) -> TxOut
toTxOut ((ApiT Address, Proxy n)
addr, TokenMap
assets) =
                AddressAmount (ApiT Address, Proxy n) -> TxOut
forall (n :: NetworkDiscriminant).
AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address, Proxy n) -> TxOut)
-> AddressAmount (ApiT Address, Proxy n) -> TxOut
forall a b. (a -> b) -> a -> b
$
                (ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount (ApiT Address, Proxy n)
forall addr.
addr
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount addr
AddressAmount (ApiT Address, Proxy n)
addr (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity Natural
0) (TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
assets)
        in
        (((ApiT Address, Proxy n), TokenMap) -> TxOut)
-> [((ApiT Address, Proxy n), TokenMap)] -> [TxOut]
forall a b. (a -> b) -> [a] -> [b]
map ((ApiT Address, Proxy n), TokenMap) -> TxOut
forall (n :: NetworkDiscriminant).
((ApiT Address, Proxy n), TokenMap) -> TxOut
toTxOut
            ([((ApiT Address, Proxy n), TokenMap)] -> [TxOut])
-> ([((ApiT Address, Proxy n), TokenMap)]
    -> [((ApiT Address, Proxy n), TokenMap)])
-> [((ApiT Address, Proxy n), TokenMap)]
-> [TxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (ApiT Address, Proxy n) TokenMap
-> [((ApiT Address, Proxy n), TokenMap)]
forall k a. Map k a -> [(k, a)]
Map.toList
            (Map (ApiT Address, Proxy n) TokenMap
 -> [((ApiT Address, Proxy n), TokenMap)])
-> ([((ApiT Address, Proxy n), TokenMap)]
    -> Map (ApiT Address, Proxy n) TokenMap)
-> [((ApiT Address, Proxy n), TokenMap)]
-> [((ApiT Address, Proxy n), TokenMap)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((ApiT Address, Proxy n), TokenMap)
 -> Map (ApiT Address, Proxy n) TokenMap
 -> Map (ApiT Address, Proxy n) TokenMap)
-> Map (ApiT Address, Proxy n) TokenMap
-> [((ApiT Address, Proxy n), TokenMap)]
-> Map (ApiT Address, Proxy n) TokenMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((ApiT Address, Proxy n)
 -> TokenMap
 -> Map (ApiT Address, Proxy n) TokenMap
 -> Map (ApiT Address, Proxy n) TokenMap)
-> ((ApiT Address, Proxy n), TokenMap)
-> Map (ApiT Address, Proxy n) TokenMap
-> Map (ApiT Address, Proxy n) TokenMap
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((TokenMap -> TokenMap -> TokenMap)
-> (ApiT Address, Proxy n)
-> TokenMap
-> Map (ApiT Address, Proxy n) TokenMap
-> Map (ApiT Address, Proxy n) TokenMap
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith TokenMap -> TokenMap -> TokenMap
forall a. Semigroup a => a -> a -> a
(<>))) Map (ApiT Address, Proxy n) TokenMap
forall k a. Map k a
Map.empty

decodeValidityInterval
    :: TimeInterpreter (ExceptT PastHorizonException IO)
    -> Maybe ApiValidityInterval
    -> Handler (SlotNo, SlotNo, Bool)
decodeValidityInterval :: TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe ApiValidityInterval -> Handler (SlotNo, SlotNo, Bool)
decodeValidityInterval TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe ApiValidityInterval
validityInterval = do
    let isValidityBoundTimeNegative :: ApiValidityBound -> Bool
isValidityBoundTimeNegative
            (ApiValidityBoundAsTimeFromNow (Quantity NominalDiffTime
sec)) = NominalDiffTime
sec NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
0
        isValidityBoundTimeNegative ApiValidityBound
_ = Bool
False

    let isThereNegativeTime :: Bool
isThereNegativeTime = case Maybe ApiValidityInterval
validityInterval of
            Just (ApiValidityInterval (Just ApiValidityBound
before') Maybe ApiValidityBound
Nothing) ->
                ApiValidityBound -> Bool
isValidityBoundTimeNegative ApiValidityBound
before'
            Just (ApiValidityInterval Maybe ApiValidityBound
Nothing (Just ApiValidityBound
hereafter')) ->
                ApiValidityBound -> Bool
isValidityBoundTimeNegative ApiValidityBound
hereafter'
            Just (ApiValidityInterval (Just ApiValidityBound
before') (Just ApiValidityBound
hereafter')) ->
                ApiValidityBound -> Bool
isValidityBoundTimeNegative ApiValidityBound
before' Bool -> Bool -> Bool
||
                ApiValidityBound -> Bool
isValidityBoundTimeNegative ApiValidityBound
hereafter'
            Maybe ApiValidityInterval
_ -> Bool
False

    let fromValidityBound :: Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound = IO SlotNo -> Handler SlotNo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlotNo -> Handler SlotNo)
-> (Either ApiValidityBound ApiValidityBound -> IO SlotNo)
-> Either ApiValidityBound ApiValidityBound
-> Handler SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Left ApiValidityBound
ApiValidityBoundUnspecified ->
                SlotNo -> IO SlotNo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> IO SlotNo) -> SlotNo -> IO SlotNo
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
0
            Right ApiValidityBound
ApiValidityBoundUnspecified ->
                TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe NominalDiffTime
forall a. Maybe a
Nothing
            Right (ApiValidityBoundAsTimeFromNow (Quantity NominalDiffTime
sec)) ->
                TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti (NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
sec)
            Left (ApiValidityBoundAsTimeFromNow (Quantity NominalDiffTime
sec)) ->
                TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti (NominalDiffTime -> Maybe NominalDiffTime
forall a. a -> Maybe a
Just NominalDiffTime
sec)
            Right (ApiValidityBoundAsSlot (Quantity Word64
slot)) ->
                SlotNo -> IO SlotNo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> IO SlotNo) -> SlotNo -> IO SlotNo
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
slot
            Left (ApiValidityBoundAsSlot (Quantity Word64
slot)) ->
                SlotNo -> IO SlotNo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> IO SlotNo) -> SlotNo -> IO SlotNo
forall a b. (a -> b) -> a -> b
$ Word64 -> SlotNo
SlotNo Word64
slot

    (SlotNo
before, SlotNo
hereafter) <- case Maybe ApiValidityInterval
validityInterval of
        Maybe ApiValidityInterval
Nothing -> do
            SlotNo
before' <-
                Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound (ApiValidityBound -> Either ApiValidityBound ApiValidityBound
forall a b. a -> Either a b
Left ApiValidityBound
ApiValidityBoundUnspecified)
            SlotNo
hereafter' <-
                Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound (ApiValidityBound -> Either ApiValidityBound ApiValidityBound
forall a b. b -> Either a b
Right ApiValidityBound
ApiValidityBoundUnspecified)
            (SlotNo, SlotNo) -> Handler (SlotNo, SlotNo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
before', SlotNo
hereafter')
        Just (ApiValidityInterval Maybe ApiValidityBound
before' Maybe ApiValidityBound
hereafter') -> do
            SlotNo
before'' <- case Maybe ApiValidityBound
before' of
                Maybe ApiValidityBound
Nothing ->
                    Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound (ApiValidityBound -> Either ApiValidityBound ApiValidityBound
forall a b. a -> Either a b
Left ApiValidityBound
ApiValidityBoundUnspecified)
                Just ApiValidityBound
val ->
                    Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound (ApiValidityBound -> Either ApiValidityBound ApiValidityBound
forall a b. a -> Either a b
Left ApiValidityBound
val)
            SlotNo
hereafter'' <- case Maybe ApiValidityBound
hereafter' of
                Maybe ApiValidityBound
Nothing ->
                    Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound (ApiValidityBound -> Either ApiValidityBound ApiValidityBound
forall a b. b -> Either a b
Right ApiValidityBound
ApiValidityBoundUnspecified)
                Just ApiValidityBound
val ->
                    Either ApiValidityBound ApiValidityBound -> Handler SlotNo
fromValidityBound (ApiValidityBound -> Either ApiValidityBound ApiValidityBound
forall a b. b -> Either a b
Right ApiValidityBound
val)
            (SlotNo, SlotNo) -> Handler (SlotNo, SlotNo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
before'', SlotNo
hereafter'')

    (SlotNo, SlotNo, Bool) -> Handler (SlotNo, SlotNo, Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
before, SlotNo
hereafter, Bool
isThereNegativeTime)

-- TO-DO delegations/withdrawals
-- TO-DO minting/burning
constructSharedTransaction
    :: forall ctx s k n.
        ( k ~ SharedKey
        , s ~ SharedState n k
        , ctx ~ ApiLayer s k
        , GenChange s
        , HasNetworkLayer IO ctx
        , IsOurs s Address
        , BoundedAddressLength k
        )
    => ctx
    -> ArgGenChange s
    -> IO (Set PoolId)
    -> (PoolId -> IO PoolLifeCycleStatus)
    -> ApiT WalletId
    -> ApiConstructTransactionData n
    -> Handler (ApiConstructTransaction n)
constructSharedTransaction :: ctx
-> ArgGenChange s
-> IO (Set PoolId)
-> (PoolId -> IO PoolLifeCycleStatus)
-> ApiT WalletId
-> ApiConstructTransactionData n
-> Handler (ApiConstructTransaction n)
constructSharedTransaction
    ctx
ctx ArgGenChange s
genChange IO (Set PoolId)
_knownPools PoolId -> IO PoolLifeCycleStatus
_getPoolStatus (ApiT WalletId
wid) ApiConstructTransactionData n
body = do
    let isNoPayload :: Bool
isNoPayload =
            Maybe (ApiPaymentDestination n) -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (ApiPaymentDestination n)
     -> Const
          (Maybe (ApiPaymentDestination n))
          (Maybe (ApiPaymentDestination n)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
-> Maybe (ApiPaymentDestination n)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((Maybe (ApiPaymentDestination n)
    -> Const
         (Maybe (ApiPaymentDestination n))
         (Maybe (ApiPaymentDestination n)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
(Maybe (ApiPaymentDestination n)
 -> Const
      (Maybe (ApiPaymentDestination n))
      (Maybe (ApiPaymentDestination n)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n)
#payments) Bool -> Bool -> Bool
&&
            Maybe ApiWithdrawalPostData -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe ApiWithdrawalPostData
     -> Const
          (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n))
-> Maybe ApiWithdrawalPostData
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawal"
  ((Maybe ApiWithdrawalPostData
    -> Const
         (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n))
(Maybe ApiWithdrawalPostData
 -> Const
      (Maybe ApiWithdrawalPostData) (Maybe ApiWithdrawalPostData))
-> ApiConstructTransactionData n
-> Const
     (Maybe ApiWithdrawalPostData) (ApiConstructTransactionData n)
#withdrawal) Bool -> Bool -> Bool
&&
            Maybe TxMetadataWithSchema -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe TxMetadataWithSchema
     -> Const (Maybe TxMetadataWithSchema) (Maybe TxMetadataWithSchema))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe TxMetadataWithSchema) (ApiConstructTransactionData n))
-> Maybe TxMetadataWithSchema
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "metadata"
  ((Maybe TxMetadataWithSchema
    -> Const (Maybe TxMetadataWithSchema) (Maybe TxMetadataWithSchema))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe TxMetadataWithSchema) (ApiConstructTransactionData n))
(Maybe TxMetadataWithSchema
 -> Const (Maybe TxMetadataWithSchema) (Maybe TxMetadataWithSchema))
-> ApiConstructTransactionData n
-> Const
     (Maybe TxMetadataWithSchema) (ApiConstructTransactionData n)
#metadata) Bool -> Bool -> Bool
&&
            Maybe (NonEmpty (ApiMintBurnData n)) -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty (ApiMintBurnData n))
     -> Const
          (Maybe (NonEmpty (ApiMintBurnData n)))
          (Maybe (NonEmpty (ApiMintBurnData n))))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty (ApiMintBurnData n)))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty (ApiMintBurnData n))
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "mintBurn"
  ((Maybe (NonEmpty (ApiMintBurnData n))
    -> Const
         (Maybe (NonEmpty (ApiMintBurnData n)))
         (Maybe (NonEmpty (ApiMintBurnData n))))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty (ApiMintBurnData n)))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty (ApiMintBurnData n))
 -> Const
      (Maybe (NonEmpty (ApiMintBurnData n)))
      (Maybe (NonEmpty (ApiMintBurnData n))))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty (ApiMintBurnData n)))
     (ApiConstructTransactionData n)
#mintBurn) Bool -> Bool -> Bool
&&
            Maybe (NonEmpty ApiMultiDelegationAction) -> Bool
forall a. Maybe a -> Bool
isNothing (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (NonEmpty ApiMultiDelegationAction)
     -> Const
          (Maybe (NonEmpty ApiMultiDelegationAction))
          (Maybe (NonEmpty ApiMultiDelegationAction)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (ApiConstructTransactionData n))
-> Maybe (NonEmpty ApiMultiDelegationAction)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegations"
  ((Maybe (NonEmpty ApiMultiDelegationAction)
    -> Const
         (Maybe (NonEmpty ApiMultiDelegationAction))
         (Maybe (NonEmpty ApiMultiDelegationAction)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (NonEmpty ApiMultiDelegationAction))
        (ApiConstructTransactionData n))
(Maybe (NonEmpty ApiMultiDelegationAction)
 -> Const
      (Maybe (NonEmpty ApiMultiDelegationAction))
      (Maybe (NonEmpty ApiMultiDelegationAction)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (NonEmpty ApiMultiDelegationAction))
     (ApiConstructTransactionData n)
#delegations)
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isNoPayload (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxWrongPayload

    let md :: Maybe TxMetadata
md = ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> ApiConstructTransactionData n
    -> Const (First TxMetadata) (ApiConstructTransactionData n))
-> Maybe TxMetadata
forall s a.
s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? IsLabel
  "metadata"
  ((Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
   -> ApiConstructTransactionData n
   -> Const (First TxMetadata) (ApiConstructTransactionData n))
(Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> ApiConstructTransactionData n
-> Const (First TxMetadata) (ApiConstructTransactionData n)
#metadata ((Maybe TxMetadataWithSchema
  -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
 -> ApiConstructTransactionData n
 -> Const (First TxMetadata) (ApiConstructTransactionData n))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> Maybe TxMetadataWithSchema
    -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> ApiConstructTransactionData n
-> Const (First TxMetadata) (ApiConstructTransactionData n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxMetadataWithSchema
 -> Const (First TxMetadata) TxMetadataWithSchema)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TxMetadataWithSchema
  -> Const (First TxMetadata) TxMetadataWithSchema)
 -> Maybe TxMetadataWithSchema
 -> Const (First TxMetadata) (Maybe TxMetadataWithSchema))
-> ((TxMetadata -> Const (First TxMetadata) TxMetadata)
    -> TxMetadataWithSchema
    -> Const (First TxMetadata) TxMetadataWithSchema)
-> (TxMetadata -> Const (First TxMetadata) TxMetadata)
-> Maybe TxMetadataWithSchema
-> Const (First TxMetadata) (Maybe TxMetadataWithSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "txMetadataWithSchema_metadata"
  ((TxMetadata -> Const (First TxMetadata) TxMetadata)
   -> TxMetadataWithSchema
   -> Const (First TxMetadata) TxMetadataWithSchema)
(TxMetadata -> Const (First TxMetadata) TxMetadata)
-> TxMetadataWithSchema
-> Const (First TxMetadata) TxMetadataWithSchema
#txMetadataWithSchema_metadata

    (SlotNo
before, SlotNo
hereafter, Bool
isThereNegativeTime) <-
        TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe ApiValidityInterval -> Handler (SlotNo, SlotNo, Bool)
decodeValidityInterval TimeInterpreter (ExceptT PastHorizonException IO)
ti (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe ApiValidityInterval
     -> Const (Maybe ApiValidityInterval) (Maybe ApiValidityInterval))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe ApiValidityInterval) (ApiConstructTransactionData n))
-> Maybe ApiValidityInterval
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "validityInterval"
  ((Maybe ApiValidityInterval
    -> Const (Maybe ApiValidityInterval) (Maybe ApiValidityInterval))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe ApiValidityInterval) (ApiConstructTransactionData n))
(Maybe ApiValidityInterval
 -> Const (Maybe ApiValidityInterval) (Maybe ApiValidityInterval))
-> ApiConstructTransactionData n
-> Const
     (Maybe ApiValidityInterval) (ApiConstructTransactionData n)
#validityInterval)

    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SlotNo
hereafter SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
before Bool -> Bool -> Bool
|| Bool
isThereNegativeTime) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrConstructTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO () -> Handler ())
-> ExceptT ErrConstructTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrConstructTx -> ExceptT ErrConstructTx IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxWrongValidityBounds

    let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
            { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
NoWithdrawal
            , $sel:txMetadata:TransactionCtx :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
md
            , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
before, SlotNo
hereafter)
            , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = Maybe DelegationAction
forall a. Maybe a
Nothing
            }

    let transform :: s
-> Selection
-> (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex),
    Selection, Coin)
transform s
s Selection
sel =
            ( ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
forall s.
GenChange s =>
ArgGenChange s -> Selection -> s -> (SelectionOf TxOut, s)
W.assignChangeAddresses ArgGenChange s
genChange Selection
sel s
s
                (SelectionOf TxOut, s)
-> ((SelectionOf TxOut, s)
    -> UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex))
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b. a -> (a -> b) -> b
& (SelectionOf TxOut
 -> s
 -> UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
-> (SelectionOf TxOut, s)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall s input output change withdrawal.
(IsOurs s Address, input ~ (TxIn, TxOut, NonEmpty DerivationIndex),
 output ~ TxOut, change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx input output change withdrawal
W.selectionToUnsignedTx (TransactionCtx -> Withdrawal
txWithdrawal TransactionCtx
txCtx))
            , Selection
sel
            , (TokenBundle -> Coin) -> Selection -> Coin
forall change. (change -> Coin) -> SelectionOf change -> Coin
selectionDelta TokenBundle -> Coin
TokenBundle.getCoin Selection
sel
            )

    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiConstructTransaction n))
-> (ErrWalletNotResponding -> Handler (ApiConstructTransaction n))
-> (WorkerCtx ctx -> Handler (ApiConstructTransaction n))
-> Handler (ApiConstructTransaction n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiConstructTransaction n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiConstructTransaction n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiConstructTransaction n))
 -> Handler (ApiConstructTransaction n))
-> (WorkerCtx ctx -> Handler (ApiConstructTransaction n))
-> Handler (ApiConstructTransaction n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (Wallet s
cp, WalletMetadata
_, Set Tx
_) <- ExceptT ErrConstructTx IO (Wallet s, WalletMetadata, Set Tx)
-> Handler (Wallet s, WalletMetadata, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO (Wallet s, WalletMetadata, Set Tx)
 -> Handler (Wallet s, WalletMetadata, Set Tx))
-> ExceptT ErrConstructTx IO (Wallet s, WalletMetadata, Set Tx)
-> Handler (Wallet s, WalletMetadata, Set Tx)
forall a b. (a -> b) -> a -> b
$ (ErrNoSuchWallet -> ErrConstructTx)
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> ExceptT ErrConstructTx IO (Wallet s, WalletMetadata, Set Tx)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrNoSuchWallet -> ErrConstructTx
ErrConstructTxNoSuchWallet (ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
 -> ExceptT ErrConstructTx IO (Wallet s, WalletMetadata, Set Tx))
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> ExceptT ErrConstructTx IO (Wallet s, WalletMetadata, Set Tx)
forall a b. (a -> b) -> a -> b
$
            WalletLayer IO (SharedState n SharedKey) SharedKey
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
W.readWallet @_ @s @k WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletId
wid
        case SharedState n SharedKey -> Readiness (SharedAddressPools SharedKey)
forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *).
SharedState n k -> Readiness (SharedAddressPools k)
Shared.ready (Wallet s -> s
forall s. Wallet s -> s
getState Wallet s
cp) of
            Readiness (SharedAddressPools SharedKey)
Shared.Pending ->
                ExceptT ErrConstructTx IO (ApiConstructTransaction n)
-> Handler (ApiConstructTransaction n)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO (ApiConstructTransaction n)
 -> Handler (ApiConstructTransaction n))
-> ExceptT ErrConstructTx IO (ApiConstructTransaction n)
-> Handler (ApiConstructTransaction n)
forall a b. (a -> b) -> a -> b
$ ErrConstructTx
-> ExceptT ErrConstructTx IO (ApiConstructTransaction n)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrConstructTx
ErrConstructTxSharedWalletPending
            Shared.Active SharedAddressPools SharedKey
_ -> do
                ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletLayer IO (SharedState n SharedKey) SharedKey
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SharedState n SharedKey) SharedKey
    -> Const
         (NetworkLayer IO Block)
         (WalletLayer IO (SharedState n SharedKey) SharedKey))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SharedState n SharedKey) SharedKey
-> Const
     (NetworkLayer IO Block)
     (WalletLayer IO (SharedState n SharedKey) SharedKey)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
                AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletLayer IO (SharedState n SharedKey) SharedKey
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SharedState n SharedKey) SharedKey
    -> Const
         (NetworkLayer IO Block)
         (WalletLayer IO (SharedState n SharedKey) SharedKey))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SharedState n SharedKey) SharedKey
-> Const
     (NetworkLayer IO Block)
     (WalletLayer IO (SharedState n SharedKey) SharedKey)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

                (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
                    ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SharedState n SharedKey) SharedKey
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletId
wid

                let runSelection :: [TxOut]
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
runSelection [TxOut]
outs = WalletLayer IO (SharedState n SharedKey) SharedKey
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams
     s
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
-> (s
    -> Selection
    -> (UnsignedTx
          (TxIn, TxOut, NonEmpty DerivationIndex)
          TxOut
          (TxChange (NonEmpty DerivationIndex))
          (RewardAccount, Coin, NonEmpty DerivationIndex),
        Selection, Coin))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k
                        WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex),
   Selection, Coin)
selectAssetsParams s
-> Selection
-> (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex),
    Selection, Coin)
transform
                      where
                        selectAssetsParams :: SelectAssetsParams
  s
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex),
   Selection, Coin)
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                            { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = [TxOut]
outs
                            , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                            , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                            , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                            , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs =
                                UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                            , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral =
                                UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                            , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                            , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                            }
                (SelectionOf TxOut
sel, UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel', Word64
fee) <- do
                    [TxOut]
outs <- case (ApiConstructTransactionData n
body ApiConstructTransactionData n
-> ((Maybe (ApiPaymentDestination n)
     -> Const
          (Maybe (ApiPaymentDestination n))
          (Maybe (ApiPaymentDestination n)))
    -> ApiConstructTransactionData n
    -> Const
         (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
-> Maybe (ApiPaymentDestination n)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "payments"
  ((Maybe (ApiPaymentDestination n)
    -> Const
         (Maybe (ApiPaymentDestination n))
         (Maybe (ApiPaymentDestination n)))
   -> ApiConstructTransactionData n
   -> Const
        (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n))
(Maybe (ApiPaymentDestination n)
 -> Const
      (Maybe (ApiPaymentDestination n))
      (Maybe (ApiPaymentDestination n)))
-> ApiConstructTransactionData n
-> Const
     (Maybe (ApiPaymentDestination n)) (ApiConstructTransactionData n)
#payments) of
                        Just (ApiPaymentAddresses NonEmpty (AddressAmount (ApiAddressIdT n))
content) ->
                            [TxOut] -> Handler [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TxOut] -> Handler [TxOut]) -> [TxOut] -> Handler [TxOut]
forall a b. (a -> b) -> a -> b
$ NonEmpty TxOut -> [TxOut]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (AddressAmount (ApiT Address, Proxy n) -> TxOut
forall (n :: NetworkDiscriminant).
AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address, Proxy n) -> TxOut)
-> NonEmpty (AddressAmount (ApiT Address, Proxy n))
-> NonEmpty TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (AddressAmount (ApiT Address, Proxy n))
NonEmpty (AddressAmount (ApiAddressIdT n))
content)
                        Maybe (ApiPaymentDestination n)
_ ->
                            [TxOut] -> Handler [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

                    (UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel', Selection
utx, Coin
fee') <- ExceptT
  ErrSelectAssets
  IO
  (UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex),
   Selection, Coin)
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrSelectAssets
   IO
   (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex),
    Selection, Coin)
 -> Handler
      (UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex),
       Selection, Coin))
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
-> Handler
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
forall a b. (a -> b) -> a -> b
$ [TxOut]
-> ExceptT
     ErrSelectAssets
     IO
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Selection, Coin)
runSelection [TxOut]
outs
                    SelectionOf TxOut
sel <- ExceptT ErrConstructTx IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrConstructTx IO (SelectionOf TxOut)
 -> Handler (SelectionOf TxOut))
-> ExceptT ErrConstructTx IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall a b. (a -> b) -> a -> b
$
                        WalletLayer IO (SharedState n SharedKey) SharedKey
-> WalletId
-> ArgGenChange (SharedState n SharedKey)
-> Selection
-> ExceptT ErrConstructTx IO (SelectionOf TxOut)
forall ctx s (k :: Depth -> * -> *).
(GenChange s, HasDBLayer IO s k ctx) =>
ctx
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrConstructTx IO (SelectionOf TxOut)
W.assignChangeAddressesWithoutDbUpdate WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletId
wid ArgGenChange s
ArgGenChange (SharedState n SharedKey)
genChange Selection
utx
                    (FeeEstimation Word64
estMin Word64
_) <- ExceptT ErrSelectAssets IO FeeEstimation -> Handler FeeEstimation
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSelectAssets IO FeeEstimation -> Handler FeeEstimation)
-> ExceptT ErrSelectAssets IO FeeEstimation
-> Handler FeeEstimation
forall a b. (a -> b) -> a -> b
$ ExceptT ErrSelectAssets IO Coin
-> ExceptT ErrSelectAssets IO FeeEstimation
forall (m :: * -> *).
Monad m =>
ExceptT ErrSelectAssets m Coin
-> ExceptT ErrSelectAssets m FeeEstimation
W.estimateFee (Coin -> ExceptT ErrSelectAssets IO Coin
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
fee')
                    (SelectionOf TxOut,
 UnsignedTx
   (TxIn, TxOut, NonEmpty DerivationIndex)
   TxOut
   (TxChange (NonEmpty DerivationIndex))
   (RewardAccount, Coin, NonEmpty DerivationIndex),
 Word64)
-> Handler
     (SelectionOf TxOut,
      UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex),
      Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectionOf TxOut
sel, UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel', Word64
estMin)

                SealedTx
tx <- ExceptT ErrConstructTx IO SealedTx -> Handler SealedTx
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
                    (ExceptT ErrConstructTx IO SealedTx -> Handler SealedTx)
-> ExceptT ErrConstructTx IO SealedTx -> Handler SealedTx
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SharedState n SharedKey) SharedKey
-> WalletId
-> AnyCardanoEra
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrConstructTx IO SealedTx
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasTransactionLayer k ctx, HasDBLayer IO s k ctx,
 HasNetworkLayer IO ctx, k ~ SharedKey, s ~ SharedState n k) =>
ctx
-> WalletId
-> AnyCardanoEra
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrConstructTx IO SealedTx
W.constructSharedTransaction @_ @s @k @n WalletLayer IO (SharedState n SharedKey) SharedKey
WorkerCtx ctx
wrk WalletId
wid AnyCardanoEra
era TransactionCtx
txCtx SelectionOf TxOut
sel

                ApiConstructTransaction n -> Handler (ApiConstructTransaction n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiConstructTransaction n -> Handler (ApiConstructTransaction n))
-> ApiConstructTransaction n -> Handler (ApiConstructTransaction n)
forall a b. (a -> b) -> a -> b
$ ApiConstructTransaction :: forall (n :: NetworkDiscriminant).
ApiT SealedTx
-> ApiCoinSelection n
-> Quantity "lovelace" Natural
-> ApiConstructTransaction n
ApiConstructTransaction
                    { $sel:transaction:ApiConstructTransaction :: ApiT SealedTx
transaction = SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
ApiT SealedTx
tx
                    , $sel:coinSelection:ApiConstructTransaction :: ApiCoinSelection n
coinSelection = [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant) input output change withdrawal.
(input ~ (TxIn, TxOut, NonEmpty DerivationIndex), output ~ TxOut,
 change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
[Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection [] [] Maybe (DelegationAction, NonEmpty DerivationIndex)
forall a. Maybe a
Nothing Maybe TxMetadata
md UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
sel'
                    , $sel:fee:ApiConstructTransaction :: Quantity "lovelace" Natural
fee = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
fee
                    }
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

decodeSharedTransaction
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , IsOurs s Address
        , HasNetworkLayer IO ctx
        )
    => ctx
    -> ApiT WalletId
    -> ApiSerialisedTransaction
    -> Handler (ApiDecodedTransaction n)
decodeSharedTransaction :: ctx
-> ApiT WalletId
-> ApiSerialisedTransaction
-> Handler (ApiDecodedTransaction n)
decodeSharedTransaction ctx
ctx (ApiT WalletId
wid) (ApiSerialisedTransaction (ApiT SealedTx
sealed)) = do
    AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra NetworkLayer IO Block
nl
    let (Tx
decodedTx, TokenMapWithScripts
_toMint, TokenMapWithScripts
_toBurn, [Certificate]
_allCerts, Maybe ValidityIntervalExplicit
interval) =
            TransactionLayer k SealedTx
-> AnyCardanoEra
-> SealedTx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
forall (k :: Depth -> * -> *) tx.
TransactionLayer k tx
-> AnyCardanoEra
-> tx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
decodeTx TransactionLayer k SealedTx
tl AnyCardanoEra
era SealedTx
sealed
    let (Tx { Hash "Tx"
$sel:txId:Tx :: Tx -> Hash "Tx"
txId :: Hash "Tx"
txId
            , Maybe Coin
$sel:fee:Tx :: Tx -> Maybe Coin
fee :: Maybe Coin
fee
            , [(TxIn, Coin)]
$sel:resolvedInputs:Tx :: Tx -> [(TxIn, Coin)]
resolvedInputs :: [(TxIn, Coin)]
resolvedInputs
            , [(TxIn, Coin)]
$sel:resolvedCollateralInputs:Tx :: Tx -> [(TxIn, Coin)]
resolvedCollateralInputs :: [(TxIn, Coin)]
resolvedCollateralInputs
            , [TxOut]
$sel:outputs:Tx :: Tx -> [TxOut]
outputs :: [TxOut]
outputs
            , Maybe TxMetadata
$sel:metadata:Tx :: Tx -> Maybe TxMetadata
metadata :: Maybe TxMetadata
metadata
            , Maybe TxScriptValidity
$sel:scriptValidity:Tx :: Tx -> Maybe TxScriptValidity
scriptValidity :: Maybe TxScriptValidity
scriptValidity
            }) = Tx
decodedTx
    ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
txinsOutsPaths, [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInsOutsPaths, [(TxOut, Maybe (NonEmpty DerivationIndex))]
outsPath)
        <- ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))]))
-> (ErrWalletNotResponding
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))]))
-> (WorkerCtx ctx
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))]))
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))])
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))])
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))])
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler
       ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
        [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
        [(TxOut, Maybe (NonEmpty DerivationIndex))]))
 -> Handler
      ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
       [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
       [(TxOut, Maybe (NonEmpty DerivationIndex))]))
-> (WorkerCtx ctx
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))]))
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))])
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
inputPaths <-
            ExceptT
  ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
 -> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
W.lookupTxIns @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid ([TxIn]
 -> ExceptT
      ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$
            (TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, Coin)]
resolvedInputs
        [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInputPaths <-
            ExceptT
  ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
 -> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
W.lookupTxIns @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid ([TxIn]
 -> ExceptT
      ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$
            (TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, Coin)]
resolvedCollateralInputs
        [(TxOut, Maybe (NonEmpty DerivationIndex))]
outputPaths <-
            ExceptT ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
-> Handler [(TxOut, Maybe (NonEmpty DerivationIndex))]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
 -> Handler [(TxOut, Maybe (NonEmpty DerivationIndex))])
-> ExceptT
     ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
-> Handler [(TxOut, Maybe (NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> [TxOut]
-> ExceptT
     ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx
-> WalletId
-> [TxOut]
-> ExceptT
     ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
W.lookupTxOuts @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid [TxOut]
outputs
        ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
 [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
 [(TxOut, Maybe (NonEmpty DerivationIndex))])
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
inputPaths
            , [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInputPaths
            , [(TxOut, Maybe (NonEmpty DerivationIndex))]
outputPaths
            )
    ApiDecodedTransaction n -> Handler (ApiDecodedTransaction n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiDecodedTransaction n -> Handler (ApiDecodedTransaction n))
-> ApiDecodedTransaction n -> Handler (ApiDecodedTransaction n)
forall a b. (a -> b) -> a -> b
$ ApiDecodedTransaction :: forall (n :: NetworkDiscriminant).
ApiT (Hash "Tx")
-> Quantity "lovelace" Natural
-> [ApiTxInputGeneral n]
-> [ApiTxOutputGeneral n]
-> [ApiTxInputGeneral n]
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
-> [ApiWithdrawalGeneral n]
-> ApiAssetMintBurn
-> ApiAssetMintBurn
-> [ApiAnyCertificate n]
-> [Quantity "lovelace" Natural]
-> [Quantity "lovelace" Natural]
-> ApiTxMetadata
-> Maybe (ApiT TxScriptValidity)
-> Maybe ValidityIntervalExplicit
-> ApiDecodedTransaction n
ApiDecodedTransaction
        { $sel:id:ApiDecodedTransaction :: ApiT (Hash "Tx")
id = Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
txId
        , $sel:fee:ApiDecodedTransaction :: Quantity "lovelace" Natural
fee = Quantity "lovelace" Natural
-> (Coin -> Quantity "lovelace" Natural)
-> Maybe Coin
-> Quantity "lovelace" Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity Natural
0) (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (Coin -> Natural) -> Coin -> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin) Maybe Coin
fee
        , $sel:inputs:ApiDecodedTransaction :: [ApiTxInputGeneral n]
inputs = ((TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
 -> ApiTxInputGeneral n)
-> [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> [ApiTxInputGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant).
(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
toInp [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
txinsOutsPaths
        , $sel:outputs:ApiDecodedTransaction :: [ApiTxOutputGeneral n]
outputs = ((TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n)
-> [(TxOut, Maybe (NonEmpty DerivationIndex))]
-> [ApiTxOutputGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant).
(TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n
toOut [(TxOut, Maybe (NonEmpty DerivationIndex))]
outsPath
        , $sel:collateral:ApiDecodedTransaction :: [ApiTxInputGeneral n]
collateral = ((TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
 -> ApiTxInputGeneral n)
-> [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> [ApiTxInputGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant).
(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
toInp [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInsOutsPaths
        -- TODO: [ADP-1670]
        , $sel:collateralOutputs:ApiDecodedTransaction :: ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
collateralOutputs = Maybe (ApiTxOutputGeneral n)
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
forall (s :: Symbol) a. a -> ApiAsArray s a
ApiAsArray Maybe (ApiTxOutputGeneral n)
forall a. Maybe a
Nothing
        , $sel:withdrawals:ApiDecodedTransaction :: [ApiWithdrawalGeneral n]
withdrawals = []
        -- TODO minting/burning multisig
        , $sel:mint:ApiDecodedTransaction :: ApiAssetMintBurn
mint = ApiAssetMintBurn
emptyApiAssetMntBurn
        , $sel:burn:ApiDecodedTransaction :: ApiAssetMintBurn
burn = ApiAssetMintBurn
emptyApiAssetMntBurn
        -- TODO delegation/withdrawals multisig
        , $sel:certificates:ApiDecodedTransaction :: [ApiAnyCertificate n]
certificates = []
        , $sel:depositsTaken:ApiDecodedTransaction :: [Quantity "lovelace" Natural]
depositsTaken = []
        , $sel:depositsReturned:ApiDecodedTransaction :: [Quantity "lovelace" Natural]
depositsReturned = []
        , $sel:metadata:ApiDecodedTransaction :: ApiTxMetadata
metadata = Maybe (ApiT TxMetadata) -> ApiTxMetadata
ApiTxMetadata (Maybe (ApiT TxMetadata) -> ApiTxMetadata)
-> Maybe (ApiT TxMetadata) -> ApiTxMetadata
forall a b. (a -> b) -> a -> b
$ TxMetadata -> ApiT TxMetadata
forall a. a -> ApiT a
ApiT (TxMetadata -> ApiT TxMetadata)
-> Maybe TxMetadata -> Maybe (ApiT TxMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxMetadata
metadata
        , $sel:scriptValidity:ApiDecodedTransaction :: Maybe (ApiT TxScriptValidity)
scriptValidity = TxScriptValidity -> ApiT TxScriptValidity
forall a. a -> ApiT a
ApiT (TxScriptValidity -> ApiT TxScriptValidity)
-> Maybe TxScriptValidity -> Maybe (ApiT TxScriptValidity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxScriptValidity
scriptValidity
        , $sel:validityInterval:ApiDecodedTransaction :: Maybe ValidityIntervalExplicit
validityInterval = Maybe ValidityIntervalExplicit
interval
        }
  where
    tl :: TransactionLayer k SealedTx
tl = ctx
ctx ctx
-> ((TransactionLayer k SealedTx
     -> Const
          (TransactionLayer k SealedTx) (TransactionLayer k SealedTx))
    -> ctx -> Const (TransactionLayer k SealedTx) ctx)
-> TransactionLayer k SealedTx
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
forall (k :: Depth -> * -> *) ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
W.transactionLayer @k
    nl :: NetworkLayer IO Block
nl = ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasNetworkLayer IO ctx =>
Lens' ctx (NetworkLayer IO Block)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
W.networkLayer @IO

    emptyApiAssetMntBurn :: ApiAssetMintBurn
emptyApiAssetMntBurn = ApiAssetMintBurn :: [ApiTokens]
-> Maybe ApiPolicyKey
-> Maybe (ApiT DerivationIndex)
-> ApiAssetMintBurn
ApiAssetMintBurn
        { $sel:tokens:ApiAssetMintBurn :: [ApiTokens]
tokens = []
        , $sel:walletPolicyKeyHash:ApiAssetMintBurn :: Maybe ApiPolicyKey
walletPolicyKeyHash = Maybe ApiPolicyKey
forall a. Maybe a
Nothing
        , $sel:walletPolicyKeyIndex:ApiAssetMintBurn :: Maybe (ApiT DerivationIndex)
walletPolicyKeyIndex = Maybe (ApiT DerivationIndex)
forall a. Maybe a
Nothing
        }

-- TODO: Most of the body of this function should really belong to
-- Cardano.Wallet to keep the Api.Server module free of business logic!
balanceTransaction
    :: forall ctx s k (n :: NetworkDiscriminant).
        ( ctx ~ ApiLayer s k
        , HasNetworkLayer IO ctx
        , GenChange s
        , BoundedAddressLength k
        )
    => ctx
    -> ArgGenChange s
    -> ApiT WalletId
    -> ApiBalanceTransactionPostData n
    -> Handler ApiSerialisedTransaction
balanceTransaction :: ctx
-> ArgGenChange s
-> ApiT WalletId
-> ApiBalanceTransactionPostData n
-> Handler ApiSerialisedTransaction
balanceTransaction ctx
ctx ArgGenChange s
genChange (ApiT WalletId
wid) ApiBalanceTransactionPostData n
body = do
    -- NOTE: Ideally we'd read @pp@ and @era@ atomically.
    ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters NetworkLayer IO Block
nl
    -- TODO: This throws when still in the Byron era.
    AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra NetworkLayer IO Block
nl
    let nodePParams :: ProtocolParameters
nodePParams = Maybe ProtocolParameters -> ProtocolParameters
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ProtocolParameters -> ProtocolParameters)
-> Maybe ProtocolParameters -> ProtocolParameters
forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> Maybe ProtocolParameters
W.currentNodeProtocolParameters ProtocolParameters
pp
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ApiSerialisedTransaction)
-> (ErrWalletNotResponding -> Handler ApiSerialisedTransaction)
-> (WorkerCtx ctx -> Handler ApiSerialisedTransaction)
-> Handler ApiSerialisedTransaction
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ApiSerialisedTransaction
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ApiSerialisedTransaction
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ApiSerialisedTransaction)
 -> Handler ApiSerialisedTransaction)
-> (WorkerCtx ctx -> Handler ApiSerialisedTransaction)
-> Handler ApiSerialisedTransaction
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (UTxOIndex WalletUTxO, Wallet s, Set Tx)
wallet <- ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        TimeInterpreter (Either PastHorizonException)
ti <- IO (TimeInterpreter (Either PastHorizonException))
-> Handler (TimeInterpreter (Either PastHorizonException))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TimeInterpreter (Either PastHorizonException))
 -> Handler (TimeInterpreter (Either PastHorizonException)))
-> IO (TimeInterpreter (Either PastHorizonException))
-> Handler (TimeInterpreter (Either PastHorizonException))
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> IO (TimeInterpreter (Either PastHorizonException))
snapshot (TimeInterpreter (ExceptT PastHorizonException IO)
 -> IO (TimeInterpreter (Either PastHorizonException)))
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> IO (TimeInterpreter (Either PastHorizonException))
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (NetworkLayer IO Block
 -> TimeInterpreter (ExceptT PastHorizonException IO))
-> NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer

        let mkPartialTx
                :: forall era. Cardano.Tx era
                -> W.PartialTx era
            mkPartialTx :: Tx era -> PartialTx era
mkPartialTx Tx era
tx = Tx era
-> [(TxIn, TxOut, Maybe (Hash "Datum"))]
-> [Redeemer]
-> PartialTx era
forall era.
Tx era
-> [(TxIn, TxOut, Maybe (Hash "Datum"))]
-> [Redeemer]
-> PartialTx era
W.PartialTx
                    Tx era
tx
                    (ApiExternalInput n -> (TxIn, TxOut, Maybe (Hash "Datum"))
forall (n :: NetworkDiscriminant).
ApiExternalInput n -> (TxIn, TxOut, Maybe (Hash "Datum"))
fromExternalInput (ApiExternalInput n -> (TxIn, TxOut, Maybe (Hash "Datum")))
-> [ApiExternalInput n] -> [(TxIn, TxOut, Maybe (Hash "Datum"))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiBalanceTransactionPostData n
body ApiBalanceTransactionPostData n
-> (([ApiExternalInput n]
     -> Const [ApiExternalInput n] [ApiExternalInput n])
    -> ApiBalanceTransactionPostData n
    -> Const [ApiExternalInput n] (ApiBalanceTransactionPostData n))
-> [ApiExternalInput n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  (([ApiExternalInput n]
    -> Const [ApiExternalInput n] [ApiExternalInput n])
   -> ApiBalanceTransactionPostData n
   -> Const [ApiExternalInput n] (ApiBalanceTransactionPostData n))
([ApiExternalInput n]
 -> Const [ApiExternalInput n] [ApiExternalInput n])
-> ApiBalanceTransactionPostData n
-> Const [ApiExternalInput n] (ApiBalanceTransactionPostData n)
#inputs)
                    (ApiRedeemer n -> Redeemer
forall (n :: NetworkDiscriminant). ApiRedeemer n -> Redeemer
fromApiRedeemer (ApiRedeemer n -> Redeemer) -> [ApiRedeemer n] -> [Redeemer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiBalanceTransactionPostData n
body ApiBalanceTransactionPostData n
-> (([ApiRedeemer n] -> Const [ApiRedeemer n] [ApiRedeemer n])
    -> ApiBalanceTransactionPostData n
    -> Const [ApiRedeemer n] (ApiBalanceTransactionPostData n))
-> [ApiRedeemer n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "redeemers"
  (([ApiRedeemer n] -> Const [ApiRedeemer n] [ApiRedeemer n])
   -> ApiBalanceTransactionPostData n
   -> Const [ApiRedeemer n] (ApiBalanceTransactionPostData n))
([ApiRedeemer n] -> Const [ApiRedeemer n] [ApiRedeemer n])
-> ApiBalanceTransactionPostData n
-> Const [ApiRedeemer n] (ApiBalanceTransactionPostData n)
#redeemers)

        let balanceTx
                :: forall era. Cardano.IsShelleyBasedEra era
                => W.PartialTx era
                -> Handler (Cardano.Tx era)
            balanceTx :: PartialTx era -> Handler (Tx era)
balanceTx PartialTx era
partialTx =
                ExceptT ErrBalanceTx IO (Tx era) -> Handler (Tx era)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrBalanceTx IO (Tx era) -> Handler (Tx era))
-> ExceptT ErrBalanceTx IO (Tx era) -> Handler (Tx era)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> ArgGenChange s
-> (ProtocolParameters, ProtocolParameters)
-> TimeInterpreter (Either PastHorizonException)
-> (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> PartialTx era
-> ExceptT ErrBalanceTx IO (Tx era)
forall era (m :: * -> *) s (k :: Depth -> * -> *) ctx.
(HasTransactionLayer k ctx, GenChange s, MonadRandom m,
 HasLogger m WalletWorkerLog ctx, IsShelleyBasedEra era,
 BoundedAddressLength k) =>
ctx
-> ArgGenChange s
-> (ProtocolParameters, ProtocolParameters)
-> TimeInterpreter (Either PastHorizonException)
-> (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> PartialTx era
-> ExceptT ErrBalanceTx m (Tx era)
W.balanceTransaction @_ @IO @s @k
                    WalletLayer IO s k
WorkerCtx ctx
wrk
                    ArgGenChange s
genChange
                    (ProtocolParameters
pp, ProtocolParameters
nodePParams)
                    TimeInterpreter (Either PastHorizonException)
ti
                    (UTxOIndex WalletUTxO, Wallet s, Set Tx)
wallet
                    PartialTx era
partialTx

        InAnyShelleyBasedEra Tx
anyShelleyTx <- ErrBalanceTx
-> Maybe (InAnyShelleyBasedEra Tx)
-> Handler (InAnyShelleyBasedEra Tx)
forall e a. IsServerError e => e -> Maybe a -> Handler a
maybeToHandler ErrBalanceTx
ErrByronTxNotSupported
            (Maybe (InAnyShelleyBasedEra Tx)
 -> Handler (InAnyShelleyBasedEra Tx))
-> (ApiT SealedTx -> Maybe (InAnyShelleyBasedEra Tx))
-> ApiT SealedTx
-> Handler (InAnyShelleyBasedEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InAnyCardanoEra Tx -> Maybe (InAnyShelleyBasedEra Tx)
forall (a :: * -> *).
InAnyCardanoEra a -> Maybe (InAnyShelleyBasedEra a)
asAnyShelleyBasedEra
            (InAnyCardanoEra Tx -> Maybe (InAnyShelleyBasedEra Tx))
-> (ApiT SealedTx -> InAnyCardanoEra Tx)
-> ApiT SealedTx
-> Maybe (InAnyShelleyBasedEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> SealedTx -> InAnyCardanoEra Tx
cardanoTxIdeallyNoLaterThan AnyCardanoEra
era
            (SealedTx -> InAnyCardanoEra Tx)
-> (ApiT SealedTx -> SealedTx)
-> ApiT SealedTx
-> InAnyCardanoEra Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT SealedTx -> SealedTx
forall a. ApiT a -> a
getApiT (ApiT SealedTx -> Handler (InAnyShelleyBasedEra Tx))
-> ApiT SealedTx -> Handler (InAnyShelleyBasedEra Tx)
forall a b. (a -> b) -> a -> b
$ ApiBalanceTransactionPostData n
body ApiBalanceTransactionPostData n
-> ((ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
    -> ApiBalanceTransactionPostData n
    -> Const (ApiT SealedTx) (ApiBalanceTransactionPostData n))
-> ApiT SealedTx
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "transaction"
  ((ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
   -> ApiBalanceTransactionPostData n
   -> Const (ApiT SealedTx) (ApiBalanceTransactionPostData n))
(ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
-> ApiBalanceTransactionPostData n
-> Const (ApiT SealedTx) (ApiBalanceTransactionPostData n)
#transaction

        InAnyCardanoEra Tx
res <- InAnyShelleyBasedEra Tx
-> (forall era.
    IsShelleyBasedEra era =>
    Tx era -> Handler (InAnyCardanoEra Tx))
-> Handler (InAnyCardanoEra Tx)
forall a.
InAnyShelleyBasedEra Tx
-> (forall era. IsShelleyBasedEra era => Tx era -> a) -> a
withShelleyBasedTx InAnyShelleyBasedEra Tx
anyShelleyTx
            ((Tx era -> InAnyCardanoEra Tx)
-> Handler (Tx era) -> Handler (InAnyCardanoEra Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx era -> InAnyCardanoEra Tx
forall era. IsCardanoEra era => Tx era -> InAnyCardanoEra Tx
inAnyCardanoEra (Handler (Tx era) -> Handler (InAnyCardanoEra Tx))
-> (Tx era -> Handler (Tx era))
-> Tx era
-> Handler (InAnyCardanoEra Tx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialTx era -> Handler (Tx era)
forall era.
IsShelleyBasedEra era =>
PartialTx era -> Handler (Tx era)
balanceTx (PartialTx era -> Handler (Tx era))
-> (Tx era -> PartialTx era) -> Tx era -> Handler (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> PartialTx era
forall era. Tx era -> PartialTx era
mkPartialTx)

        ApiSerialisedTransaction -> Handler ApiSerialisedTransaction
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiSerialisedTransaction -> Handler ApiSerialisedTransaction)
-> ApiSerialisedTransaction -> Handler ApiSerialisedTransaction
forall a b. (a -> b) -> a -> b
$ ApiT SealedTx -> ApiSerialisedTransaction
ApiSerialisedTransaction (ApiT SealedTx -> ApiSerialisedTransaction)
-> ApiT SealedTx -> ApiSerialisedTransaction
forall a b. (a -> b) -> a -> b
$ SealedTx -> ApiT SealedTx
forall a. a -> ApiT a
ApiT (SealedTx -> ApiT SealedTx) -> SealedTx -> ApiT SealedTx
forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra Tx -> SealedTx
W.sealedTxFromCardano InAnyCardanoEra Tx
res
  where
    nl :: NetworkLayer IO Block
nl = ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer

    maybeToHandler :: IsServerError e => e -> Maybe a -> Handler a
    maybeToHandler :: e -> Maybe a -> Handler a
maybeToHandler e
_ (Just a
a) = a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    maybeToHandler e
e Maybe a
Nothing  = ExceptT e IO a -> Handler a
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT e IO a -> Handler a) -> ExceptT e IO a -> Handler a
forall a b. (a -> b) -> a -> b
$ e -> ExceptT e IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e

decodeTransaction
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , IsOurs s Address
        , Typeable s
        , Typeable n
        , HasNetworkLayer IO ctx
        )
    => ctx
    -> ApiT WalletId
    -> ApiSerialisedTransaction
    -> Handler (ApiDecodedTransaction n)
decodeTransaction :: ctx
-> ApiT WalletId
-> ApiSerialisedTransaction
-> Handler (ApiDecodedTransaction n)
decodeTransaction ctx
ctx (ApiT WalletId
wid) (ApiSerialisedTransaction (ApiT SealedTx
sealed)) = do
    AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra NetworkLayer IO Block
nl
    let (Tx
decodedTx, TokenMapWithScripts
toMint, TokenMapWithScripts
toBurn, [Certificate]
allCerts, Maybe ValidityIntervalExplicit
interval) =
            TransactionLayer k SealedTx
-> AnyCardanoEra
-> SealedTx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
forall (k :: Depth -> * -> *) tx.
TransactionLayer k tx
-> AnyCardanoEra
-> tx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
decodeTx TransactionLayer k SealedTx
tl AnyCardanoEra
era SealedTx
sealed
    let (Tx { Hash "Tx"
txId :: Hash "Tx"
$sel:txId:Tx :: Tx -> Hash "Tx"
txId
            , Maybe Coin
fee :: Maybe Coin
$sel:fee:Tx :: Tx -> Maybe Coin
fee
            , [(TxIn, Coin)]
resolvedInputs :: [(TxIn, Coin)]
$sel:resolvedInputs:Tx :: Tx -> [(TxIn, Coin)]
resolvedInputs
            , [(TxIn, Coin)]
resolvedCollateralInputs :: [(TxIn, Coin)]
$sel:resolvedCollateralInputs:Tx :: Tx -> [(TxIn, Coin)]
resolvedCollateralInputs
            , [TxOut]
outputs :: [TxOut]
$sel:outputs:Tx :: Tx -> [TxOut]
outputs
            , Map RewardAccount Coin
$sel:withdrawals:Tx :: Tx -> Map RewardAccount Coin
withdrawals :: Map RewardAccount Coin
withdrawals
            , Maybe TxMetadata
metadata :: Maybe TxMetadata
$sel:metadata:Tx :: Tx -> Maybe TxMetadata
metadata
            , Maybe TxScriptValidity
scriptValidity :: Maybe TxScriptValidity
$sel:scriptValidity:Tx :: Tx -> Maybe TxScriptValidity
scriptValidity
            }) = Tx
decodedTx
    ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
txinsOutsPaths, [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInsOutsPaths, [(TxOut, Maybe (NonEmpty DerivationIndex))]
outsPath, RewardAccount
acct, NonEmpty DerivationIndex
acctPath, ProtocolParameters
pp, Maybe XPub
policyXPubM)
        <- ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
          NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub))
-> (ErrWalletNotResponding
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
          NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub))
-> (WorkerCtx ctx
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
          NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub))
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
      NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
      NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
      NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler
       ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
        [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
        [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
        NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub))
 -> Handler
      ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
       [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
       [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
       NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub))
-> (WorkerCtx ctx
    -> Handler
         ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
          [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
          NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub))
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
      NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (RewardAccount
acct, XPub
_, NonEmpty DerivationIndex
acctPath) <-
            ExceptT
  ErrReadRewardAccount
  IO
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrReadRewardAccount
   IO
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Handler (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
W.readRewardAccount @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
inputPaths <-
            ExceptT
  ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
 -> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
W.lookupTxIns @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid ([TxIn]
 -> ExceptT
      ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$
            (TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, Coin)]
resolvedInputs
        [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInputPaths <-
            ExceptT
  ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
 -> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> Handler [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx
-> WalletId
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
W.lookupTxIns @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid ([TxIn]
 -> ExceptT
      ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))])
-> [TxIn]
-> ExceptT
     ErrDecodeTx IO [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$
            (TxIn, Coin) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, Coin) -> TxIn) -> [(TxIn, Coin)] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxIn, Coin)]
resolvedCollateralInputs
        [(TxOut, Maybe (NonEmpty DerivationIndex))]
outputPaths <-
            ExceptT ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
-> Handler [(TxOut, Maybe (NonEmpty DerivationIndex))]
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
 -> Handler [(TxOut, Maybe (NonEmpty DerivationIndex))])
-> ExceptT
     ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
-> Handler [(TxOut, Maybe (NonEmpty DerivationIndex))]
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> [TxOut]
-> ExceptT
     ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, IsOurs s Address) =>
ctx
-> WalletId
-> [TxOut]
-> ExceptT
     ErrDecodeTx IO [(TxOut, Maybe (NonEmpty DerivationIndex))]
W.lookupTxOuts @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid [TxOut]
outputs
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        Maybe XPub
policyXPubM <- (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)
 -> Maybe XPub)
-> Handler
     (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
-> Handler (Maybe XPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((XPub, NonEmpty DerivationIndex) -> XPub)
-> Maybe (XPub, NonEmpty DerivationIndex) -> Maybe XPub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XPub, NonEmpty DerivationIndex) -> XPub
forall a b. (a, b) -> a
fst (Maybe (XPub, NonEmpty DerivationIndex) -> Maybe XPub)
-> (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)
    -> Maybe (XPub, NonEmpty DerivationIndex))
-> Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)
-> Maybe XPub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)
-> Maybe (XPub, NonEmpty DerivationIndex)
forall a b. Either a b -> Maybe b
eitherToMaybe)
            (Handler
   (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
 -> Handler (Maybe XPub))
-> (ExceptT
      ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
    -> Handler
         (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)))
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (Maybe XPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
-> Handler
     (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
 -> Handler
      (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)))
-> (ExceptT
      ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
    -> IO
         (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex)))
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler
     (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> IO
     (Either ErrReadPolicyPublicKey (XPub, NonEmpty DerivationIndex))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
 -> Handler (Maybe XPub))
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (Maybe XPub)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
W.readPolicyPublicKey @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
 [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
 [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
 NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub)
-> Handler
     ([(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))],
      [(TxOut, Maybe (NonEmpty DerivationIndex))], RewardAccount,
      NonEmpty DerivationIndex, ProtocolParameters, Maybe XPub)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
inputPaths
            , [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInputPaths
            , [(TxOut, Maybe (NonEmpty DerivationIndex))]
outputPaths
            , RewardAccount
acct
            , NonEmpty DerivationIndex
acctPath
            , ProtocolParameters
pp
            , Maybe XPub
policyXPubM
            )
    ApiDecodedTransaction n -> Handler (ApiDecodedTransaction n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiDecodedTransaction n -> Handler (ApiDecodedTransaction n))
-> ApiDecodedTransaction n -> Handler (ApiDecodedTransaction n)
forall a b. (a -> b) -> a -> b
$ ApiDecodedTransaction :: forall (n :: NetworkDiscriminant).
ApiT (Hash "Tx")
-> Quantity "lovelace" Natural
-> [ApiTxInputGeneral n]
-> [ApiTxOutputGeneral n]
-> [ApiTxInputGeneral n]
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
-> [ApiWithdrawalGeneral n]
-> ApiAssetMintBurn
-> ApiAssetMintBurn
-> [ApiAnyCertificate n]
-> [Quantity "lovelace" Natural]
-> [Quantity "lovelace" Natural]
-> ApiTxMetadata
-> Maybe (ApiT TxScriptValidity)
-> Maybe ValidityIntervalExplicit
-> ApiDecodedTransaction n
ApiDecodedTransaction
        { $sel:id:ApiDecodedTransaction :: ApiT (Hash "Tx")
id = Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
txId
        , $sel:fee:ApiDecodedTransaction :: Quantity "lovelace" Natural
fee = Quantity "lovelace" Natural
-> (Coin -> Quantity "lovelace" Natural)
-> Maybe Coin
-> Quantity "lovelace" Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity Natural
0) (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (Coin -> Natural) -> Coin -> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin) Maybe Coin
fee
        , $sel:inputs:ApiDecodedTransaction :: [ApiTxInputGeneral n]
inputs = ((TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
 -> ApiTxInputGeneral n)
-> [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> [ApiTxInputGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant).
(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
toInp [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
txinsOutsPaths
        , $sel:outputs:ApiDecodedTransaction :: [ApiTxOutputGeneral n]
outputs = ((TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n)
-> [(TxOut, Maybe (NonEmpty DerivationIndex))]
-> [ApiTxOutputGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant).
(TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n
toOut [(TxOut, Maybe (NonEmpty DerivationIndex))]
outsPath
        , $sel:collateral:ApiDecodedTransaction :: [ApiTxInputGeneral n]
collateral = ((TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
 -> ApiTxInputGeneral n)
-> [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
-> [ApiTxInputGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant).
(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
toInp [(TxIn, Maybe (TxOut, NonEmpty DerivationIndex))]
collateralInsOutsPaths
        -- TODO: [ADP-1670]
        , $sel:collateralOutputs:ApiDecodedTransaction :: ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
collateralOutputs = Maybe (ApiTxOutputGeneral n)
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutputGeneral n))
forall (s :: Symbol) a. a -> ApiAsArray s a
ApiAsArray Maybe (ApiTxOutputGeneral n)
forall a. Maybe a
Nothing
        , $sel:withdrawals:ApiDecodedTransaction :: [ApiWithdrawalGeneral n]
withdrawals = ((RewardAccount, Coin) -> ApiWithdrawalGeneral n)
-> [(RewardAccount, Coin)] -> [ApiWithdrawalGeneral n]
forall a b. (a -> b) -> [a] -> [b]
map (RewardAccount -> (RewardAccount, Coin) -> ApiWithdrawalGeneral n
toWrdl RewardAccount
acct) ([(RewardAccount, Coin)] -> [ApiWithdrawalGeneral n])
-> [(RewardAccount, Coin)] -> [ApiWithdrawalGeneral n]
forall a b. (a -> b) -> a -> b
$ Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map RewardAccount Coin
withdrawals
        , $sel:mint:ApiDecodedTransaction :: ApiAssetMintBurn
mint = Maybe XPub -> TokenMapWithScripts -> ApiAssetMintBurn
toApiAssetMintBurn Maybe XPub
policyXPubM TokenMapWithScripts
toMint
        , $sel:burn:ApiDecodedTransaction :: ApiAssetMintBurn
burn = Maybe XPub -> TokenMapWithScripts -> ApiAssetMintBurn
toApiAssetMintBurn Maybe XPub
policyXPubM TokenMapWithScripts
toBurn
        , $sel:certificates:ApiDecodedTransaction :: [ApiAnyCertificate n]
certificates = (Certificate -> ApiAnyCertificate n)
-> [Certificate] -> [ApiAnyCertificate n]
forall a b. (a -> b) -> [a] -> [b]
map (RewardAccount
-> NonEmpty DerivationIndex -> Certificate -> ApiAnyCertificate n
toApiAnyCert RewardAccount
acct NonEmpty DerivationIndex
acctPath) [Certificate]
allCerts
        , $sel:depositsTaken:ApiDecodedTransaction :: [Quantity "lovelace" Natural]
depositsTaken =
            (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (ProtocolParameters -> Natural)
-> ProtocolParameters
-> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural)
-> (ProtocolParameters -> Natural) -> ProtocolParameters -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin (Coin -> Natural)
-> (ProtocolParameters -> Coin) -> ProtocolParameters -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Coin
W.stakeKeyDeposit (ProtocolParameters -> Quantity "lovelace" Natural)
-> ProtocolParameters -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ ProtocolParameters
pp)
                Quantity "lovelace" Natural
-> [ApiAnyCertificate n] -> [Quantity "lovelace" Natural]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ApiAnyCertificate n -> Bool)
-> [ApiAnyCertificate n] -> [ApiAnyCertificate n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiAnyCertificate n -> Bool
forall (n :: NetworkDiscriminant). ApiAnyCertificate n -> Bool
ourRewardAccountRegistration
                    (RewardAccount
-> NonEmpty DerivationIndex -> Certificate -> ApiAnyCertificate n
toApiAnyCert RewardAccount
acct NonEmpty DerivationIndex
acctPath (Certificate -> ApiAnyCertificate n)
-> [Certificate] -> [ApiAnyCertificate n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Certificate]
allCerts)
        , $sel:depositsReturned:ApiDecodedTransaction :: [Quantity "lovelace" Natural]
depositsReturned =
            (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (ProtocolParameters -> Natural)
-> ProtocolParameters
-> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural)
-> (ProtocolParameters -> Natural) -> ProtocolParameters -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin (Coin -> Natural)
-> (ProtocolParameters -> Coin) -> ProtocolParameters -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolParameters -> Coin
W.stakeKeyDeposit (ProtocolParameters -> Quantity "lovelace" Natural)
-> ProtocolParameters -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ ProtocolParameters
pp)
                Quantity "lovelace" Natural
-> [ApiAnyCertificate n] -> [Quantity "lovelace" Natural]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ApiAnyCertificate n -> Bool)
-> [ApiAnyCertificate n] -> [ApiAnyCertificate n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiAnyCertificate n -> Bool
forall (n :: NetworkDiscriminant). ApiAnyCertificate n -> Bool
ourRewardAccountDeregistration
                    (RewardAccount
-> NonEmpty DerivationIndex -> Certificate -> ApiAnyCertificate n
toApiAnyCert RewardAccount
acct NonEmpty DerivationIndex
acctPath (Certificate -> ApiAnyCertificate n)
-> [Certificate] -> [ApiAnyCertificate n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Certificate]
allCerts)
        , $sel:metadata:ApiDecodedTransaction :: ApiTxMetadata
metadata = Maybe (ApiT TxMetadata) -> ApiTxMetadata
ApiTxMetadata (Maybe (ApiT TxMetadata) -> ApiTxMetadata)
-> Maybe (ApiT TxMetadata) -> ApiTxMetadata
forall a b. (a -> b) -> a -> b
$ TxMetadata -> ApiT TxMetadata
forall a. a -> ApiT a
ApiT (TxMetadata -> ApiT TxMetadata)
-> Maybe TxMetadata -> Maybe (ApiT TxMetadata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxMetadata
metadata
        , $sel:scriptValidity:ApiDecodedTransaction :: Maybe (ApiT TxScriptValidity)
scriptValidity = TxScriptValidity -> ApiT TxScriptValidity
forall a. a -> ApiT a
ApiT (TxScriptValidity -> ApiT TxScriptValidity)
-> Maybe TxScriptValidity -> Maybe (ApiT TxScriptValidity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxScriptValidity
scriptValidity
        , $sel:validityInterval:ApiDecodedTransaction :: Maybe ValidityIntervalExplicit
validityInterval = Maybe ValidityIntervalExplicit
interval
        }
  where
    tl :: TransactionLayer k SealedTx
tl = ctx
ctx ctx
-> ((TransactionLayer k SealedTx
     -> Const
          (TransactionLayer k SealedTx) (TransactionLayer k SealedTx))
    -> ctx -> Const (TransactionLayer k SealedTx) ctx)
-> TransactionLayer k SealedTx
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
forall (k :: Depth -> * -> *) ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
W.transactionLayer @k
    nl :: NetworkLayer IO Block
nl = ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasNetworkLayer IO ctx =>
Lens' ctx (NetworkLayer IO Block)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
W.networkLayer @IO

    policyIx :: ApiT DerivationIndex
policyIx = DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> DerivationIndex -> ApiT DerivationIndex
forall a b. (a -> b) -> a -> b
$ Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$
        Index 'Hardened 'PolicyK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex (Index 'Hardened 'PolicyK
forall a. Bounded a => a
minBound :: Index 'Hardened 'PolicyK)

    askForScript :: k -> Map k p -> p
askForScript k
policyId Map k p
scriptMap =
        case k -> Map k p -> Maybe p
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
policyId Map k p
scriptMap of
            Just p
script -> p
script
            Maybe p
Nothing -> String -> p
forall a. HasCallStack => String -> a
error String
"askForScript: no minting/burning without either\
                             \ native or plutus script"

    toIdScriptAssets :: Map TokenPolicyId b
-> TokenMap
-> [(TokenPolicyId, b, NonEmpty (TokenName, TokenQuantity))]
toIdScriptAssets Map TokenPolicyId b
scriptmap TokenMap
tokenmap =
        [ (TokenPolicyId
policy, TokenPolicyId -> Map TokenPolicyId b -> b
forall k p. Ord k => k -> Map k p -> p
askForScript TokenPolicyId
policy Map TokenPolicyId b
scriptmap, NonEmpty (TokenName, TokenQuantity)
tokenQuantities)
        | (TokenPolicyId
policy, NonEmpty (TokenName, TokenQuantity)
tokenQuantities) <- TokenMap -> [(TokenPolicyId, NonEmpty (TokenName, TokenQuantity))]
toNestedList TokenMap
tokenmap
        ]

    toTokenAmountFingerprint :: TokenPolicyId
-> (TokenName, TokenQuantity) -> ApiTokenAmountFingerprint
toTokenAmountFingerprint TokenPolicyId
policy (TokenName
name, TokenQuantity
tokenquantity) =
        ApiTokenAmountFingerprint :: ApiT TokenName
-> Natural -> ApiT TokenFingerprint -> ApiTokenAmountFingerprint
ApiTokenAmountFingerprint
            { $sel:assetName:ApiTokenAmountFingerprint :: ApiT TokenName
assetName = TokenName -> ApiT TokenName
forall a. a -> ApiT a
ApiT TokenName
name
            , $sel:quantity:ApiTokenAmountFingerprint :: Natural
quantity = TokenQuantity -> Natural
unTokenQuantity TokenQuantity
tokenquantity
            , $sel:fingerprint:ApiTokenAmountFingerprint :: ApiT TokenFingerprint
fingerprint = TokenFingerprint -> ApiT TokenFingerprint
forall a. a -> ApiT a
ApiT (TokenFingerprint -> ApiT TokenFingerprint)
-> TokenFingerprint -> ApiT TokenFingerprint
forall a b. (a -> b) -> a -> b
$ TokenPolicyId -> TokenName -> TokenFingerprint
mkTokenFingerprint TokenPolicyId
policy TokenName
name
            }

    fromIdScriptAssets :: (TokenPolicyId, AnyScript, NonEmpty (TokenName, TokenQuantity))
-> ApiTokens
fromIdScriptAssets (TokenPolicyId
policy, AnyScript
script, NonEmpty (TokenName, TokenQuantity)
tokens) = ApiTokens :: ApiT TokenPolicyId
-> ApiT AnyScript
-> NonEmpty ApiTokenAmountFingerprint
-> ApiTokens
ApiTokens
        { $sel:policyId:ApiTokens :: ApiT TokenPolicyId
policyId = TokenPolicyId -> ApiT TokenPolicyId
forall a. a -> ApiT a
ApiT TokenPolicyId
policy
        , $sel:policyScript:ApiTokens :: ApiT AnyScript
policyScript = AnyScript -> ApiT AnyScript
forall a. a -> ApiT a
ApiT AnyScript
script
        , $sel:assets:ApiTokens :: NonEmpty ApiTokenAmountFingerprint
assets = ((TokenName, TokenQuantity) -> ApiTokenAmountFingerprint)
-> NonEmpty (TokenName, TokenQuantity)
-> NonEmpty ApiTokenAmountFingerprint
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (TokenPolicyId
-> (TokenName, TokenQuantity) -> ApiTokenAmountFingerprint
toTokenAmountFingerprint TokenPolicyId
policy) NonEmpty (TokenName, TokenQuantity)
tokens
        }

    toApiTokens :: TokenMapWithScripts -> [ApiTokens]
toApiTokens (TokenMapWithScripts TokenMap
tokenMap Map TokenPolicyId AnyScript
scriptMap) =
        ((TokenPolicyId, AnyScript, NonEmpty (TokenName, TokenQuantity))
 -> ApiTokens)
-> [(TokenPolicyId, AnyScript,
     NonEmpty (TokenName, TokenQuantity))]
-> [ApiTokens]
forall a b. (a -> b) -> [a] -> [b]
map (TokenPolicyId, AnyScript, NonEmpty (TokenName, TokenQuantity))
-> ApiTokens
fromIdScriptAssets ([(TokenPolicyId, AnyScript, NonEmpty (TokenName, TokenQuantity))]
 -> [ApiTokens])
-> [(TokenPolicyId, AnyScript,
     NonEmpty (TokenName, TokenQuantity))]
-> [ApiTokens]
forall a b. (a -> b) -> a -> b
$
        Map TokenPolicyId AnyScript
-> TokenMap
-> [(TokenPolicyId, AnyScript,
     NonEmpty (TokenName, TokenQuantity))]
forall b.
Map TokenPolicyId b
-> TokenMap
-> [(TokenPolicyId, b, NonEmpty (TokenName, TokenQuantity))]
toIdScriptAssets Map TokenPolicyId AnyScript
scriptMap TokenMap
tokenMap
    includePolicyKeyInfo :: TokenMapWithScripts -> Maybe a -> Maybe a
includePolicyKeyInfo (TokenMapWithScripts TokenMap
tokenMap Map TokenPolicyId AnyScript
_) Maybe a
xpubM =
        if TokenMap
tokenMap TokenMap -> TokenMap -> Bool
forall a. Eq a => a -> a -> Bool
== TokenMap
TokenMap.empty then
            Maybe a
forall a. Maybe a
Nothing
        else
            Maybe a
xpubM
    toApiAssetMintBurn :: Maybe XPub -> TokenMapWithScripts -> ApiAssetMintBurn
toApiAssetMintBurn Maybe XPub
xpubM TokenMapWithScripts
tokenWithScripts = ApiAssetMintBurn :: [ApiTokens]
-> Maybe ApiPolicyKey
-> Maybe (ApiT DerivationIndex)
-> ApiAssetMintBurn
ApiAssetMintBurn
        { $sel:tokens:ApiAssetMintBurn :: [ApiTokens]
tokens = TokenMapWithScripts -> [ApiTokens]
toApiTokens TokenMapWithScripts
tokenWithScripts
        , $sel:walletPolicyKeyHash:ApiAssetMintBurn :: Maybe ApiPolicyKey
walletPolicyKeyHash =
            (ByteString -> VerificationKeyHashing -> ApiPolicyKey)
-> (ByteString, VerificationKeyHashing) -> ApiPolicyKey
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> VerificationKeyHashing -> ApiPolicyKey
ApiPolicyKey ((ByteString, VerificationKeyHashing) -> ApiPolicyKey)
-> (XPub -> (ByteString, VerificationKeyHashing))
-> XPub
-> ApiPolicyKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bool -> XPub -> (ByteString, VerificationKeyHashing)
computeKeyPayload (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (XPub -> ApiPolicyKey) -> Maybe XPub -> Maybe ApiPolicyKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            TokenMapWithScripts -> Maybe XPub -> Maybe XPub
forall a. TokenMapWithScripts -> Maybe a -> Maybe a
includePolicyKeyInfo TokenMapWithScripts
tokenWithScripts Maybe XPub
xpubM
        , $sel:walletPolicyKeyIndex:ApiAssetMintBurn :: Maybe (ApiT DerivationIndex)
walletPolicyKeyIndex =
            ApiT DerivationIndex
policyIx ApiT DerivationIndex -> Maybe XPub -> Maybe (ApiT DerivationIndex)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TokenMapWithScripts -> Maybe XPub -> Maybe XPub
forall a. TokenMapWithScripts -> Maybe a -> Maybe a
includePolicyKeyInfo TokenMapWithScripts
tokenWithScripts Maybe XPub
xpubM
        }
    toWrdl :: RewardAccount -> (RewardAccount, Coin) -> ApiWithdrawalGeneral n
toWrdl RewardAccount
acct (RewardAccount
rewardKey, (Coin Natural
c)) =
        if RewardAccount
rewardKey RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== RewardAccount
acct then
           (ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
ApiWithdrawalGeneral (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
rewardKey, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c) ResourceContext
Our
        else
           (ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> ResourceContext
-> ApiWithdrawalGeneral n
ApiWithdrawalGeneral (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
rewardKey, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c) ResourceContext
External

    toApiAnyCert :: RewardAccount
-> NonEmpty DerivationIndex -> Certificate -> ApiAnyCertificate n
toApiAnyCert RewardAccount
acct NonEmpty DerivationIndex
acctPath = \case
        W.CertificateOfDelegation DelegationCertificate
delCert -> RewardAccount
-> NonEmpty DerivationIndex
-> DelegationCertificate
-> ApiAnyCertificate n
toApiDelCert RewardAccount
acct NonEmpty DerivationIndex
acctPath DelegationCertificate
delCert
        W.CertificateOfPool PoolCertificate
poolCert -> PoolCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
PoolCertificate -> ApiAnyCertificate n
toApiPoolCert PoolCertificate
poolCert
        W.CertificateOther NonWalletCertificate
otherCert -> NonWalletCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
NonWalletCertificate -> ApiAnyCertificate n
toApiOtherCert NonWalletCertificate
otherCert
    toApiOtherCert :: NonWalletCertificate -> ApiAnyCertificate n
toApiOtherCert = ApiT NonWalletCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiT NonWalletCertificate -> ApiAnyCertificate n
OtherCertificate (ApiT NonWalletCertificate -> ApiAnyCertificate n)
-> (NonWalletCertificate -> ApiT NonWalletCertificate)
-> NonWalletCertificate
-> ApiAnyCertificate n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonWalletCertificate -> ApiT NonWalletCertificate
forall a. a -> ApiT a
ApiT

    toApiPoolCert :: PoolCertificate -> ApiAnyCertificate n
toApiPoolCert (W.Registration (W.PoolRegistrationCertificate PoolId
poolId' [PoolOwner]
poolOwners' Percentage
poolMargin' Coin
poolCost' Coin
poolPledge' Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
poolMetadata')) =
        let enrich :: (a, a) -> (ApiT a, ApiT a)
enrich (a
a, a
b) = (a -> ApiT a
forall a. a -> ApiT a
ApiT a
a, a -> ApiT a
forall a. a -> ApiT a
ApiT a
b)
        in ApiRegisterPool -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiRegisterPool -> ApiAnyCertificate n
StakePoolRegister (ApiRegisterPool -> ApiAnyCertificate n)
-> ApiRegisterPool -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$ ApiT PoolId
-> [ApiT PoolOwner]
-> Quantity "percent" Percentage
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> Maybe (ApiT StakePoolMetadataUrl, ApiT StakePoolMetadataHash)
-> ApiRegisterPool
ApiRegisterPool
           (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
poolId')
           ((PoolOwner -> ApiT PoolOwner) -> [PoolOwner] -> [ApiT PoolOwner]
forall a b. (a -> b) -> [a] -> [b]
map PoolOwner -> ApiT PoolOwner
forall a. a -> ApiT a
ApiT [PoolOwner]
poolOwners')
           (Percentage -> Quantity "percent" Percentage
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity Percentage
poolMargin')
           (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Coin -> Natural
unCoin Coin
poolCost')
           (Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Coin -> Natural
unCoin Coin
poolPledge')
           ((StakePoolMetadataUrl, StakePoolMetadataHash)
-> (ApiT StakePoolMetadataUrl, ApiT StakePoolMetadataHash)
forall a a. (a, a) -> (ApiT a, ApiT a)
enrich ((StakePoolMetadataUrl, StakePoolMetadataHash)
 -> (ApiT StakePoolMetadataUrl, ApiT StakePoolMetadataHash))
-> Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
-> Maybe (ApiT StakePoolMetadataUrl, ApiT StakePoolMetadataHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (StakePoolMetadataUrl, StakePoolMetadataHash)
poolMetadata')
    toApiPoolCert (W.Retirement (W.PoolRetirementCertificate PoolId
poolId' EpochNo
retirementEpoch')) =
        ApiDeregisterPool -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiDeregisterPool -> ApiAnyCertificate n
StakePoolDeregister (ApiDeregisterPool -> ApiAnyCertificate n)
-> ApiDeregisterPool -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$ ApiT PoolId -> ApiT EpochNo -> ApiDeregisterPool
ApiDeregisterPool
        (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
poolId')
        (EpochNo -> ApiT EpochNo
forall a. a -> ApiT a
ApiT EpochNo
retirementEpoch')

    toApiDelCert :: RewardAccount
-> NonEmpty DerivationIndex
-> DelegationCertificate
-> ApiAnyCertificate n
toApiDelCert RewardAccount
acct NonEmpty DerivationIndex
acctPath (W.CertDelegateNone RewardAccount
rewardKey) =
        if RewardAccount
rewardKey RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== RewardAccount
acct then
            ApiCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiCertificate -> ApiAnyCertificate n
WalletDelegationCertificate (ApiCertificate -> ApiAnyCertificate n)
-> ApiCertificate -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$ NonEmpty (ApiT DerivationIndex) -> ApiCertificate
QuitPool (NonEmpty (ApiT DerivationIndex) -> ApiCertificate)
-> NonEmpty (ApiT DerivationIndex) -> ApiCertificate
forall a b. (a -> b) -> a -> b
$ (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
acctPath
        else
            ApiExternalCertificate n -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiAnyCertificate n
DelegationCertificate (ApiExternalCertificate n -> ApiAnyCertificate n)
-> ApiExternalCertificate n -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$ (ApiT RewardAccount, Proxy n) -> ApiExternalCertificate n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n) -> ApiExternalCertificate n
QuitPoolExternal (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
rewardKey, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
    toApiDelCert RewardAccount
acct NonEmpty DerivationIndex
acctPath (W.CertRegisterKey RewardAccount
rewardKey) =
        if RewardAccount
rewardKey RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== RewardAccount
acct then
            ApiCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiCertificate -> ApiAnyCertificate n
WalletDelegationCertificate (ApiCertificate -> ApiAnyCertificate n)
-> ApiCertificate -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$
            NonEmpty (ApiT DerivationIndex) -> ApiCertificate
RegisterRewardAccount (NonEmpty (ApiT DerivationIndex) -> ApiCertificate)
-> NonEmpty (ApiT DerivationIndex) -> ApiCertificate
forall a b. (a -> b) -> a -> b
$ (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
acctPath
        else
            ApiExternalCertificate n -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiAnyCertificate n
DelegationCertificate (ApiExternalCertificate n -> ApiAnyCertificate n)
-> ApiExternalCertificate n -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$
            (ApiT RewardAccount, Proxy n) -> ApiExternalCertificate n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n) -> ApiExternalCertificate n
RegisterRewardAccountExternal (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
rewardKey, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
    toApiDelCert RewardAccount
acct NonEmpty DerivationIndex
acctPath (W.CertDelegateFull RewardAccount
rewardKey PoolId
poolId') =
        if RewardAccount
rewardKey RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== RewardAccount
acct then
            ApiCertificate -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiCertificate -> ApiAnyCertificate n
WalletDelegationCertificate (ApiCertificate -> ApiAnyCertificate n)
-> ApiCertificate -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$
            NonEmpty (ApiT DerivationIndex) -> ApiT PoolId -> ApiCertificate
JoinPool ((DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
acctPath) (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
poolId')
        else
            ApiExternalCertificate n -> ApiAnyCertificate n
forall (n :: NetworkDiscriminant).
ApiExternalCertificate n -> ApiAnyCertificate n
DelegationCertificate (ApiExternalCertificate n -> ApiAnyCertificate n)
-> ApiExternalCertificate n -> ApiAnyCertificate n
forall a b. (a -> b) -> a -> b
$
            (ApiT RewardAccount, Proxy n)
-> ApiT PoolId -> ApiExternalCertificate n
forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n)
-> ApiT PoolId -> ApiExternalCertificate n
JoinPoolExternal (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
rewardKey, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
poolId')

    ourRewardAccountRegistration :: ApiAnyCertificate n -> Bool
ourRewardAccountRegistration = \case
        WalletDelegationCertificate (RegisterRewardAccount NonEmpty (ApiT DerivationIndex)
_) -> Bool
True
        ApiAnyCertificate n
_ -> Bool
False
    ourRewardAccountDeregistration :: ApiAnyCertificate n -> Bool
ourRewardAccountDeregistration = \case
        WalletDelegationCertificate (QuitPool NonEmpty (ApiT DerivationIndex)
_) -> Bool
True
        ApiAnyCertificate n
_ -> Bool
False

toInp
    :: forall n. (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
    -> ApiTxInputGeneral n
toInp :: (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
-> ApiTxInputGeneral n
toInp (txin :: TxIn
txin@(TxIn Hash "Tx"
txid Word32
ix), Maybe (TxOut, NonEmpty DerivationIndex)
txoutPathM) =
    case Maybe (TxOut, NonEmpty DerivationIndex)
txoutPathM of
        Maybe (TxOut, NonEmpty DerivationIndex)
Nothing ->
            ApiT TxIn -> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant). ApiT TxIn -> ApiTxInputGeneral n
ExternalInput (TxIn -> ApiT TxIn
forall a. a -> ApiT a
ApiT TxIn
txin)
        Just (TxOut Address
addr (TokenBundle (Coin Natural
c) TokenMap
tmap), NonEmpty DerivationIndex
path) ->
            ApiWalletInput n -> ApiTxInputGeneral n
forall (n :: NetworkDiscriminant).
ApiWalletInput n -> ApiTxInputGeneral n
WalletInput (ApiWalletInput n -> ApiTxInputGeneral n)
-> ApiWalletInput n -> ApiTxInputGeneral n
forall a b. (a -> b) -> a -> b
$ ApiWalletInput :: forall (n :: NetworkDiscriminant).
ApiT (Hash "Tx")
-> Word32
-> (ApiT Address, Proxy n)
-> NonEmpty (ApiT DerivationIndex)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> ApiWalletInput n
ApiWalletInput
                { $sel:id:ApiWalletInput :: ApiT (Hash "Tx")
id = Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
txid
                , $sel:index:ApiWalletInput :: Word32
index = Word32
ix
                , $sel:address:ApiWalletInput :: (ApiT Address, Proxy n)
address = (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
                , $sel:derivationPath:ApiWalletInput :: NonEmpty (ApiT DerivationIndex)
derivationPath = (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
path
                , $sel:amount:ApiWalletInput :: Quantity "lovelace" Natural
amount = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c
                , $sel:assets:ApiWalletInput :: ApiT TokenMap
assets = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
tmap
                }

toOut
    :: forall n. (TxOut, Maybe (NonEmpty DerivationIndex))
    -> ApiTxOutputGeneral n
toOut :: (TxOut, Maybe (NonEmpty DerivationIndex)) -> ApiTxOutputGeneral n
toOut (TxOut
txoutIncoming, Maybe (NonEmpty DerivationIndex)
Nothing) =
    ApiTxOutput n -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant).
ApiTxOutput n -> ApiTxOutputGeneral n
ExternalOutput (ApiTxOutput n -> ApiTxOutputGeneral n)
-> ApiTxOutput n -> ApiTxOutputGeneral n
forall a b. (a -> b) -> a -> b
$ TxOut -> ApiTxOutput n
forall (n :: NetworkDiscriminant).
TxOut -> AddressAmount (ApiT Address, Proxy n)
toAddressAmount @n TxOut
txoutIncoming
toOut ((TxOut Address
addr (TokenBundle (Coin Natural
c) TokenMap
tmap)), (Just NonEmpty DerivationIndex
path)) =
        ApiWalletOutput n -> ApiTxOutputGeneral n
forall (n :: NetworkDiscriminant).
ApiWalletOutput n -> ApiTxOutputGeneral n
WalletOutput (ApiWalletOutput n -> ApiTxOutputGeneral n)
-> ApiWalletOutput n -> ApiTxOutputGeneral n
forall a b. (a -> b) -> a -> b
$ ApiWalletOutput :: forall (n :: NetworkDiscriminant).
(ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> NonEmpty (ApiT DerivationIndex)
-> ApiWalletOutput n
ApiWalletOutput
            { $sel:address:ApiWalletOutput :: (ApiT Address, Proxy n)
address = (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
            , $sel:amount:ApiWalletOutput :: Quantity "lovelace" Natural
amount = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c
            , $sel:assets:ApiWalletOutput :: ApiT TokenMap
assets = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
tmap
            , $sel:derivationPath:ApiWalletOutput :: NonEmpty (ApiT DerivationIndex)
derivationPath = (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT NonEmpty DerivationIndex
path
            }

submitTransaction
    :: forall ctx s k (n :: NetworkDiscriminant).
        ( ctx ~ ApiLayer s k
        , HasNetworkLayer IO ctx
        , IsOwned s k
        , Typeable s
        , Typeable n
        )
    => ctx
    -> ApiT WalletId
    -> ApiSerialisedTransaction
    -> Handler ApiTxId
submitTransaction :: ctx -> ApiT WalletId -> ApiSerialisedTransaction -> Handler ApiTxId
submitTransaction ctx
ctx apiw :: ApiT WalletId
apiw@(ApiT WalletId
wid) ApiSerialisedTransaction
apitx = do
    --TODO: revisit/possibly set proper ttls in ADP-1193
    SlotNo
ttl <- IO SlotNo -> Handler SlotNo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlotNo -> Handler SlotNo) -> IO SlotNo -> Handler SlotNo
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe NominalDiffTime
forall a. Maybe a
Nothing
    AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra NetworkLayer IO Block
nl

    let sealedTx :: SealedTx
sealedTx = ApiT SealedTx -> SealedTx
forall a. ApiT a -> a
getApiT (ApiT SealedTx -> SealedTx)
-> (ApiSerialisedTransaction -> ApiT SealedTx)
-> ApiSerialisedTransaction
-> SealedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
 -> ApiSerialisedTransaction
 -> Const (ApiT SealedTx) ApiSerialisedTransaction)
-> ApiSerialisedTransaction -> ApiT SealedTx
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "transaction"
  ((ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
   -> ApiSerialisedTransaction
   -> Const (ApiT SealedTx) ApiSerialisedTransaction)
(ApiT SealedTx -> Const (ApiT SealedTx) (ApiT SealedTx))
-> ApiSerialisedTransaction
-> Const (ApiT SealedTx) ApiSerialisedTransaction
#transaction) (ApiSerialisedTransaction -> SealedTx)
-> ApiSerialisedTransaction -> SealedTx
forall a b. (a -> b) -> a -> b
$ ApiSerialisedTransaction
apitx
    let (Tx
tx,TokenMapWithScripts
_,TokenMapWithScripts
_,[Certificate]
_,Maybe ValidityIntervalExplicit
_) = TransactionLayer k SealedTx
-> AnyCardanoEra
-> SealedTx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
forall (k :: Depth -> * -> *) tx.
TransactionLayer k tx
-> AnyCardanoEra
-> tx
-> (Tx, TokenMapWithScripts, TokenMapWithScripts, [Certificate],
    Maybe ValidityIntervalExplicit)
decodeTx TransactionLayer k SealedTx
tl AnyCardanoEra
era SealedTx
sealedTx

    ApiDecodedTransaction n
apiDecoded <- ctx
-> ApiT WalletId
-> ApiSerialisedTransaction
-> Handler (ApiDecodedTransaction n)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(ctx ~ ApiLayer s k, IsOurs s Address, Typeable s, Typeable n,
 HasNetworkLayer IO ctx) =>
ctx
-> ApiT WalletId
-> ApiSerialisedTransaction
-> Handler (ApiDecodedTransaction n)
decodeTransaction @_ @s @k @n ctx
ctx ApiT WalletId
apiw ApiSerialisedTransaction
apitx
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ApiDecodedTransaction n -> Bool
forall s (t :: * -> *) (n :: NetworkDiscriminant) (t :: * -> *)
       (n :: NetworkDiscriminant).
(HasField' "inputs" s (t (ApiTxInputGeneral n)),
 HasField' "withdrawals" s (t (ApiWithdrawalGeneral n)), Foldable t,
 Foldable t) =>
s -> Bool
isForeign ApiDecodedTransaction n
apiDecoded) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrSubmitTransaction IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSubmitTransaction IO () -> Handler ())
-> ExceptT ErrSubmitTransaction IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrSubmitTransaction -> ExceptT ErrSubmitTransaction IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrSubmitTransaction
ErrSubmitTransactionForeignWallet
    let ourOuts :: [TxOut]
ourOuts = ApiDecodedTransaction n -> [TxOut]
forall s (n :: NetworkDiscriminant).
HasField' "outputs" s [ApiTxOutputGeneral n] =>
s -> [TxOut]
getOurOuts ApiDecodedTransaction n
apiDecoded
    let ourInps :: [(TxIn, Coin)]
ourInps = ApiDecodedTransaction n -> [(TxIn, Coin)]
forall s (n :: NetworkDiscriminant).
HasField' "inputs" s [ApiTxInputGeneral n] =>
s -> [(TxIn, Coin)]
getOurInps ApiDecodedTransaction n
apiDecoded

    -- TODO: when partial signing is switched on we will need to revise this.
    -- The following needs to be taken into account. Wits could come from:
    -- (a) our wallet
    -- (b) other parties
    -- (c) script inputs
    -- With (b) not supported we can now filter our inputs and look for the unique payment keys
    -- Also with multisig switched on the input would need more than 1 wits
    let witsRequiredForInputs :: Int
witsRequiredForInputs = [ApiTxInputGeneral n] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ApiTxInputGeneral n] -> Int) -> [ApiTxInputGeneral n] -> Int
forall a b. (a -> b) -> a -> b
$ (ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool)
-> [ApiTxInputGeneral n] -> [ApiTxInputGeneral n]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
forall (n :: NetworkDiscriminant) (n :: NetworkDiscriminant).
ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
samePaymentKey ([ApiTxInputGeneral n] -> [ApiTxInputGeneral n])
-> [ApiTxInputGeneral n] -> [ApiTxInputGeneral n]
forall a b. (a -> b) -> a -> b
$
            (ApiTxInputGeneral n -> Bool)
-> [ApiTxInputGeneral n] -> [ApiTxInputGeneral n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiTxInputGeneral n -> Bool
forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> Bool
isInpOurs ([ApiTxInputGeneral n] -> [ApiTxInputGeneral n])
-> [ApiTxInputGeneral n] -> [ApiTxInputGeneral n]
forall a b. (a -> b) -> a -> b
$
            (ApiDecodedTransaction n
apiDecoded ApiDecodedTransaction n
-> (([ApiTxInputGeneral n]
     -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
    -> ApiDecodedTransaction n
    -> Const [ApiTxInputGeneral n] (ApiDecodedTransaction n))
-> [ApiTxInputGeneral n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  (([ApiTxInputGeneral n]
    -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
   -> ApiDecodedTransaction n
   -> Const [ApiTxInputGeneral n] (ApiDecodedTransaction n))
([ApiTxInputGeneral n]
 -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
-> ApiDecodedTransaction n
-> Const [ApiTxInputGeneral n] (ApiDecodedTransaction n)
#inputs) [ApiTxInputGeneral n]
-> [ApiTxInputGeneral n] -> [ApiTxInputGeneral n]
forall a. [a] -> [a] -> [a]
++ (ApiDecodedTransaction n
apiDecoded ApiDecodedTransaction n
-> (([ApiTxInputGeneral n]
     -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
    -> ApiDecodedTransaction n
    -> Const [ApiTxInputGeneral n] (ApiDecodedTransaction n))
-> [ApiTxInputGeneral n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateral"
  (([ApiTxInputGeneral n]
    -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
   -> ApiDecodedTransaction n
   -> Const [ApiTxInputGeneral n] (ApiDecodedTransaction n))
([ApiTxInputGeneral n]
 -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
-> ApiDecodedTransaction n
-> Const [ApiTxInputGeneral n] (ApiDecodedTransaction n)
#collateral)
    let totalNumberOfWits :: Int
totalNumberOfWits = [InAnyCardanoEra KeyWitness] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([InAnyCardanoEra KeyWitness] -> Int)
-> [InAnyCardanoEra KeyWitness] -> Int
forall a b. (a -> b) -> a -> b
$ SealedTx -> [InAnyCardanoEra KeyWitness]
getSealedTxWitnesses SealedTx
sealedTx
    let ourDel :: [Maybe DelegationAction]
ourDel =
            (Maybe DelegationAction -> Bool)
-> [Maybe DelegationAction] -> [Maybe DelegationAction]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe DelegationAction -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe DelegationAction] -> [Maybe DelegationAction])
-> [Maybe DelegationAction] -> [Maybe DelegationAction]
forall a b. (a -> b) -> a -> b
$
            (ApiAnyCertificate n -> Maybe DelegationAction)
-> [ApiAnyCertificate n] -> [Maybe DelegationAction]
forall a b. (a -> b) -> [a] -> [b]
map ApiAnyCertificate n -> Maybe DelegationAction
forall (n :: NetworkDiscriminant).
ApiAnyCertificate n -> Maybe DelegationAction
isJoiningOrQuitting ([ApiAnyCertificate n] -> [Maybe DelegationAction])
-> [ApiAnyCertificate n] -> [Maybe DelegationAction]
forall a b. (a -> b) -> a -> b
$ ApiDecodedTransaction n
apiDecoded ApiDecodedTransaction n
-> (([ApiAnyCertificate n]
     -> Const [ApiAnyCertificate n] [ApiAnyCertificate n])
    -> ApiDecodedTransaction n
    -> Const [ApiAnyCertificate n] (ApiDecodedTransaction n))
-> [ApiAnyCertificate n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "certificates"
  (([ApiAnyCertificate n]
    -> Const [ApiAnyCertificate n] [ApiAnyCertificate n])
   -> ApiDecodedTransaction n
   -> Const [ApiAnyCertificate n] (ApiDecodedTransaction n))
([ApiAnyCertificate n]
 -> Const [ApiAnyCertificate n] [ApiAnyCertificate n])
-> ApiDecodedTransaction n
-> Const [ApiAnyCertificate n] (ApiDecodedTransaction n)
#certificates
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Maybe DelegationAction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe DelegationAction]
ourDel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrSubmitTransaction IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSubmitTransaction IO () -> Handler ())
-> ExceptT ErrSubmitTransaction IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrSubmitTransaction -> ExceptT ErrSubmitTransaction IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrSubmitTransaction
ErrSubmitTransactionMultidelegationNotSupported

    let delAction :: Maybe DelegationAction
delAction = case [Maybe DelegationAction]
ourDel of
            [Just DelegationAction
del] -> DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
del
            [] -> Maybe DelegationAction
forall a. Maybe a
Nothing
            [Maybe DelegationAction]
_ -> String -> Maybe DelegationAction
forall a. HasCallStack => String -> a
error String
"impossible to be here due to check above"

    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
witsRequiredForInputs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
totalNumberOfWits) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrSubmitTransaction IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSubmitTransaction IO () -> Handler ())
-> ExceptT ErrSubmitTransaction IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrSubmitTransaction -> ExceptT ErrSubmitTransaction IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrSubmitTransaction -> ExceptT ErrSubmitTransaction IO ())
-> ErrSubmitTransaction -> ExceptT ErrSubmitTransaction IO ()
forall a b. (a -> b) -> a -> b
$
        Int -> Int -> ErrSubmitTransaction
ErrSubmitTransactionPartiallySignedOrNoSignedTx Int
witsRequiredForInputs Int
totalNumberOfWits

    ()
_ <- ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ())
-> (ErrWalletNotResponding -> Handler ())
-> (WorkerCtx ctx -> Handler ())
-> Handler ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ()
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ()) -> Handler ())
-> (WorkerCtx ctx -> Handler ()) -> Handler ()
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (RewardAccount
acct, XPub
_, NonEmpty DerivationIndex
path) <- ExceptT
  ErrReadRewardAccount
  IO
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrReadRewardAccount
   IO
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Handler (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
W.readRewardAccount @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        let wdrl :: Withdrawal
wdrl = RewardAccount
-> NonEmpty DerivationIndex
-> ApiDecodedTransaction n
-> Withdrawal
forall s (n :: NetworkDiscriminant).
HasField' "withdrawals" s [ApiWithdrawalGeneral n] =>
RewardAccount -> NonEmpty DerivationIndex -> s -> Withdrawal
getOurWdrl RewardAccount
acct NonEmpty DerivationIndex
path ApiDecodedTransaction n
apiDecoded
        let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
                { -- TODO: [ADP-1193]
                  -- Get this from decodeTx:
                  $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (Maybe SlotNo
forall a. Maybe a
Nothing, SlotNo
ttl)
                , $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = Maybe DelegationAction
delAction
                }
        TxMeta
txMeta <- ExceptT ErrSubmitTransaction IO TxMeta -> Handler TxMeta
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSubmitTransaction IO TxMeta -> Handler TxMeta)
-> ExceptT ErrSubmitTransaction IO TxMeta -> Handler TxMeta
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> TransactionCtx
-> [(TxIn, Coin)]
-> [TxOut]
-> ExceptT ErrSubmitTransaction IO TxMeta
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> TransactionCtx
-> [(TxIn, Coin)]
-> [TxOut]
-> ExceptT ErrSubmitTransaction IO TxMeta
W.constructTxMeta @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid TransactionCtx
txCtx [(TxIn, Coin)]
ourInps [TxOut]
ourOuts
        ExceptT ErrSubmitTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSubmitTx IO () -> Handler ())
-> ExceptT ErrSubmitTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
forall ctx s (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasDBLayer IO s k ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
W.submitTx @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid (Tx
tx, TxMeta
txMeta, SealedTx
sealedTx)
    ApiTxId -> Handler ApiTxId
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiTxId -> Handler ApiTxId) -> ApiTxId -> Handler ApiTxId
forall a b. (a -> b) -> a -> b
$ ApiT (Hash "Tx") -> ApiTxId
ApiTxId (ApiDecodedTransaction n
apiDecoded ApiDecodedTransaction n
-> ((ApiT (Hash "Tx")
     -> Const (ApiT (Hash "Tx")) (ApiT (Hash "Tx")))
    -> ApiDecodedTransaction n
    -> Const (ApiT (Hash "Tx")) (ApiDecodedTransaction n))
-> ApiT (Hash "Tx")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "id"
  ((ApiT (Hash "Tx") -> Const (ApiT (Hash "Tx")) (ApiT (Hash "Tx")))
   -> ApiDecodedTransaction n
   -> Const (ApiT (Hash "Tx")) (ApiDecodedTransaction n))
(ApiT (Hash "Tx") -> Const (ApiT (Hash "Tx")) (ApiT (Hash "Tx")))
-> ApiDecodedTransaction n
-> Const (ApiT (Hash "Tx")) (ApiDecodedTransaction n)
#id)
  where
    tl :: TransactionLayer k SealedTx
tl = ctx
ctx ctx
-> ((TransactionLayer k SealedTx
     -> Const
          (TransactionLayer k SealedTx) (TransactionLayer k SealedTx))
    -> ctx -> Const (TransactionLayer k SealedTx) ctx)
-> TransactionLayer k SealedTx
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
forall (k :: Depth -> * -> *) ctx.
HasTransactionLayer k ctx =>
Lens' ctx (TransactionLayer k SealedTx)
W.transactionLayer @k
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    nl :: NetworkLayer IO Block
nl = ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter NetworkLayer IO Block
nl

    isOutOurs :: ApiTxOutputGeneral n -> Bool
isOutOurs (WalletOutput ApiWalletOutput n
_) = Bool
True
    isOutOurs ApiTxOutputGeneral n
_ = Bool
False
    toTxOut :: ApiTxOutputGeneral n -> TxOut
toTxOut (WalletOutput (ApiWalletOutput (ApiT Address
addr, Proxy n
_) (Quantity Natural
amt) (ApiT TokenMap
tmap) NonEmpty (ApiT DerivationIndex)
_)) =
        Address -> TokenBundle -> TxOut
TxOut Address
addr (Coin -> TokenMap -> TokenBundle
TokenBundle (Natural -> Coin
Coin (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
amt) TokenMap
tmap)
    toTxOut ApiTxOutputGeneral n
_ = String -> TxOut
forall a. HasCallStack => String -> a
error String
"we should have only our outputs at this point"
    getOurOuts :: s -> [TxOut]
getOurOuts s
apiDecodedTx =
        let generalOuts :: [ApiTxOutputGeneral n]
generalOuts = s
apiDecodedTx s
-> (([ApiTxOutputGeneral n]
     -> Const [ApiTxOutputGeneral n] [ApiTxOutputGeneral n])
    -> s -> Const [ApiTxOutputGeneral n] s)
-> [ApiTxOutputGeneral n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([ApiTxOutputGeneral n]
    -> Const [ApiTxOutputGeneral n] [ApiTxOutputGeneral n])
   -> s -> Const [ApiTxOutputGeneral n] s)
([ApiTxOutputGeneral n]
 -> Const [ApiTxOutputGeneral n] [ApiTxOutputGeneral n])
-> s -> Const [ApiTxOutputGeneral n] s
#outputs
        in (ApiTxOutputGeneral n -> TxOut)
-> [ApiTxOutputGeneral n] -> [TxOut]
forall a b. (a -> b) -> [a] -> [b]
map ApiTxOutputGeneral n -> TxOut
forall (n :: NetworkDiscriminant). ApiTxOutputGeneral n -> TxOut
toTxOut ([ApiTxOutputGeneral n] -> [TxOut])
-> [ApiTxOutputGeneral n] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ (ApiTxOutputGeneral n -> Bool)
-> [ApiTxOutputGeneral n] -> [ApiTxOutputGeneral n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiTxOutputGeneral n -> Bool
forall (n :: NetworkDiscriminant). ApiTxOutputGeneral n -> Bool
isOutOurs [ApiTxOutputGeneral n]
generalOuts

    getOurWdrl :: RewardAccount -> NonEmpty DerivationIndex -> s -> Withdrawal
getOurWdrl RewardAccount
rewardAcct NonEmpty DerivationIndex
path s
apiDecodedTx =
        let generalWdrls :: [ApiWithdrawalGeneral n]
generalWdrls = s
apiDecodedTx s
-> (([ApiWithdrawalGeneral n]
     -> Const [ApiWithdrawalGeneral n] [ApiWithdrawalGeneral n])
    -> s -> Const [ApiWithdrawalGeneral n] s)
-> [ApiWithdrawalGeneral n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawals"
  (([ApiWithdrawalGeneral n]
    -> Const [ApiWithdrawalGeneral n] [ApiWithdrawalGeneral n])
   -> s -> Const [ApiWithdrawalGeneral n] s)
([ApiWithdrawalGeneral n]
 -> Const [ApiWithdrawalGeneral n] [ApiWithdrawalGeneral n])
-> s -> Const [ApiWithdrawalGeneral n] s
#withdrawals
            isWdrlOurs :: ApiWithdrawalGeneral n -> Bool
isWdrlOurs (ApiWithdrawalGeneral (ApiT RewardAccount, Proxy n)
_ Quantity "lovelace" Natural
_ ResourceContext
context) = ResourceContext
context ResourceContext -> ResourceContext -> Bool
forall a. Eq a => a -> a -> Bool
== ResourceContext
Our
        in case (ApiWithdrawalGeneral n -> Bool)
-> [ApiWithdrawalGeneral n] -> [ApiWithdrawalGeneral n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiWithdrawalGeneral n -> Bool
forall (n :: NetworkDiscriminant). ApiWithdrawalGeneral n -> Bool
isWdrlOurs [ApiWithdrawalGeneral n]
generalWdrls of
            [ApiWithdrawalGeneral (ApiT RewardAccount
acct, Proxy n
_) (Quantity Natural
amt) ResourceContext
_] ->
                let acct' :: RewardAccount
acct' = String -> RewardAccount -> (RewardAccount -> Bool) -> RewardAccount
forall a. HasCallStack => String -> a -> (a -> Bool) -> a
invariant String
"reward account should be the same" RewardAccount
acct (RewardAccount
rewardAcct RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
==)
                in RewardAccount -> NonEmpty DerivationIndex -> Coin -> Withdrawal
WithdrawalSelf RewardAccount
acct' NonEmpty DerivationIndex
path (Natural -> Coin
Coin Natural
amt)
            [ApiWithdrawalGeneral n]
_ ->
                Withdrawal
NoWithdrawal

    isInpOurs :: ApiTxInputGeneral n -> Bool
isInpOurs (WalletInput ApiWalletInput n
_) = Bool
True
    isInpOurs ApiTxInputGeneral n
_ = Bool
False
    toTxInp :: ApiTxInputGeneral n -> (TxIn, Coin)
toTxInp (WalletInput (ApiWalletInput (ApiT Hash "Tx"
txid) Word32
ix (ApiT Address, Proxy n)
_ NonEmpty (ApiT DerivationIndex)
_ (Quantity Natural
amt) ApiT TokenMap
_)) =
        (Hash "Tx" -> Word32 -> TxIn
TxIn Hash "Tx"
txid Word32
ix, Natural -> Coin
Coin (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
amt)
    toTxInp ApiTxInputGeneral n
_ = String -> (TxIn, Coin)
forall a. HasCallStack => String -> a
error String
"we should have only our inputs at this point"
    getOurInps :: s -> [(TxIn, Coin)]
getOurInps s
apiDecodedTx =
        let generalInps :: [ApiTxInputGeneral n]
generalInps = s
apiDecodedTx s
-> (([ApiTxInputGeneral n]
     -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
    -> s -> Const [ApiTxInputGeneral n] s)
-> [ApiTxInputGeneral n]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  (([ApiTxInputGeneral n]
    -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
   -> s -> Const [ApiTxInputGeneral n] s)
([ApiTxInputGeneral n]
 -> Const [ApiTxInputGeneral n] [ApiTxInputGeneral n])
-> s -> Const [ApiTxInputGeneral n] s
#inputs
        in (ApiTxInputGeneral n -> (TxIn, Coin))
-> [ApiTxInputGeneral n] -> [(TxIn, Coin)]
forall a b. (a -> b) -> [a] -> [b]
map ApiTxInputGeneral n -> (TxIn, Coin)
forall (n :: NetworkDiscriminant).
ApiTxInputGeneral n -> (TxIn, Coin)
toTxInp ([ApiTxInputGeneral n] -> [(TxIn, Coin)])
-> [ApiTxInputGeneral n] -> [(TxIn, Coin)]
forall a b. (a -> b) -> a -> b
$ (ApiTxInputGeneral n -> Bool)
-> [ApiTxInputGeneral n] -> [ApiTxInputGeneral n]
forall a. (a -> Bool) -> [a] -> [a]
filter ApiTxInputGeneral n -> Bool
forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> Bool
isInpOurs [ApiTxInputGeneral n]
generalInps

    isForeign :: s -> Bool
isForeign s
apiDecodedTx =
        let generalInps :: t (ApiTxInputGeneral n)
generalInps = s
apiDecodedTx s
-> ((t (ApiTxInputGeneral n)
     -> Const (t (ApiTxInputGeneral n)) (t (ApiTxInputGeneral n)))
    -> s -> Const (t (ApiTxInputGeneral n)) s)
-> t (ApiTxInputGeneral n)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  ((t (ApiTxInputGeneral n)
    -> Const (t (ApiTxInputGeneral n)) (t (ApiTxInputGeneral n)))
   -> s -> Const (t (ApiTxInputGeneral n)) s)
(t (ApiTxInputGeneral n)
 -> Const (t (ApiTxInputGeneral n)) (t (ApiTxInputGeneral n)))
-> s -> Const (t (ApiTxInputGeneral n)) s
#inputs
            generalWdrls :: t (ApiWithdrawalGeneral n)
generalWdrls = s
apiDecodedTx s
-> ((t (ApiWithdrawalGeneral n)
     -> Const (t (ApiWithdrawalGeneral n)) (t (ApiWithdrawalGeneral n)))
    -> s -> Const (t (ApiWithdrawalGeneral n)) s)
-> t (ApiWithdrawalGeneral n)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawals"
  ((t (ApiWithdrawalGeneral n)
    -> Const (t (ApiWithdrawalGeneral n)) (t (ApiWithdrawalGeneral n)))
   -> s -> Const (t (ApiWithdrawalGeneral n)) s)
(t (ApiWithdrawalGeneral n)
 -> Const (t (ApiWithdrawalGeneral n)) (t (ApiWithdrawalGeneral n)))
-> s -> Const (t (ApiWithdrawalGeneral n)) s
#withdrawals
            isInpForeign :: ApiTxInputGeneral n -> Bool
isInpForeign (WalletInput ApiWalletInput n
_) = Bool
False
            isInpForeign ApiTxInputGeneral n
_ = Bool
True
            isWdrlForeign :: ApiWithdrawalGeneral n -> Bool
isWdrlForeign (ApiWithdrawalGeneral (ApiT RewardAccount, Proxy n)
_ Quantity "lovelace" Natural
_ ResourceContext
context) = ResourceContext
context ResourceContext -> ResourceContext -> Bool
forall a. Eq a => a -> a -> Bool
== ResourceContext
External
        in
            (ApiTxInputGeneral n -> Bool) -> t (ApiTxInputGeneral n) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ApiTxInputGeneral n -> Bool
forall (n :: NetworkDiscriminant). ApiTxInputGeneral n -> Bool
isInpForeign t (ApiTxInputGeneral n)
generalInps Bool -> Bool -> Bool
&&
            (ApiWithdrawalGeneral n -> Bool)
-> t (ApiWithdrawalGeneral n) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ApiWithdrawalGeneral n -> Bool
forall (n :: NetworkDiscriminant). ApiWithdrawalGeneral n -> Bool
isWdrlForeign t (ApiWithdrawalGeneral n)
generalWdrls

    samePaymentKey :: ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
samePaymentKey ApiTxInputGeneral n
inp1 ApiTxInputGeneral n
inp2 = case (ApiTxInputGeneral n
inp1, ApiTxInputGeneral n
inp2) of
        (WalletInput (ApiWalletInput ApiT (Hash "Tx")
_ Word32
_ (ApiT Address, Proxy n)
_ NonEmpty (ApiT DerivationIndex)
derPath1 Quantity "lovelace" Natural
_ ApiT TokenMap
_), WalletInput (ApiWalletInput ApiT (Hash "Tx")
_ Word32
_ (ApiT Address, Proxy n)
_ NonEmpty (ApiT DerivationIndex)
derPath2 Quantity "lovelace" Natural
_ ApiT TokenMap
_) ) ->
               NonEmpty (ApiT DerivationIndex)
derPath1 NonEmpty (ApiT DerivationIndex)
-> NonEmpty (ApiT DerivationIndex) -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (ApiT DerivationIndex)
derPath2
        (ApiTxInputGeneral n, ApiTxInputGeneral n)
_ -> Bool
False
    isJoiningOrQuitting :: ApiAnyCertificate n -> Maybe DelegationAction
isJoiningOrQuitting = \case
        WalletDelegationCertificate (JoinPool NonEmpty (ApiT DerivationIndex)
_ (ApiT PoolId
poolId)) ->
            DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just (DelegationAction -> Maybe DelegationAction)
-> DelegationAction -> Maybe DelegationAction
forall a b. (a -> b) -> a -> b
$ PoolId -> DelegationAction
Join PoolId
poolId
        WalletDelegationCertificate (QuitPool NonEmpty (ApiT DerivationIndex)
_) ->
            DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
Quit
        ApiAnyCertificate n
_ ->
            Maybe DelegationAction
forall a. Maybe a
Nothing

joinStakePool
    :: forall ctx s n k.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , AddressIndexDerivationType k ~ 'Soft
        , DelegationAddress n k
        , GenChange s
        , IsOwned s k
        , SoftDerivation k
        , Typeable n
        , Typeable s
        , WalletKey k
        , AddressBookIso s
        , BoundedAddressLength k
        )
    => ctx
    -> IO (Set PoolId)
       -- ^ Known pools
       -- We could maybe replace this with a @IO (PoolId -> Bool)@
    -> (PoolId -> IO PoolLifeCycleStatus)
    -> ApiPoolId
    -> ApiT WalletId
    -> ApiWalletPassphrase
    -> Handler (ApiTransaction n)
joinStakePool :: ctx
-> IO (Set PoolId)
-> (PoolId -> IO PoolLifeCycleStatus)
-> ApiPoolId
-> ApiT WalletId
-> ApiWalletPassphrase
-> Handler (ApiTransaction n)
joinStakePool ctx
ctx IO (Set PoolId)
knownPools PoolId -> IO PoolLifeCycleStatus
getPoolStatus ApiPoolId
apiPoolId (ApiT WalletId
wid) ApiWalletPassphrase
body = do
    let pwd :: Passphrase "user"
pwd = Passphrase "lenient" -> Passphrase "user"
coerce (Passphrase "lenient" -> Passphrase "user")
-> Passphrase "lenient" -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a. ApiT a -> a
getApiT (ApiT (Passphrase "lenient") -> Passphrase "lenient")
-> ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a b. (a -> b) -> a -> b
$ ApiWalletPassphrase
body ApiWalletPassphrase
-> ((ApiT (Passphrase "lenient")
     -> Const
          (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
    -> ApiWalletPassphrase
    -> Const (ApiT (Passphrase "lenient")) ApiWalletPassphrase)
-> ApiT (Passphrase "lenient")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "lenient")
    -> Const
         (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
   -> ApiWalletPassphrase
   -> Const (ApiT (Passphrase "lenient")) ApiWalletPassphrase)
(ApiT (Passphrase "lenient")
 -> Const
      (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
-> ApiWalletPassphrase
-> Const (ApiT (Passphrase "lenient")) ApiWalletPassphrase
#passphrase

    PoolId
pid <- case ApiPoolId
apiPoolId of
        ApiPoolId
ApiPoolIdPlaceholder -> ErrUnexpectedPoolIdPlaceholder -> Handler PoolId
forall e a. IsServerError e => e -> Handler a
liftE ErrUnexpectedPoolIdPlaceholder
ErrUnexpectedPoolIdPlaceholder
        ApiPoolId PoolId
pid -> PoolId -> Handler PoolId
forall (f :: * -> *) a. Applicative f => a -> f a
pure PoolId
pid

    PoolLifeCycleStatus
poolStatus <- IO PoolLifeCycleStatus -> Handler PoolLifeCycleStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PoolId -> IO PoolLifeCycleStatus
getPoolStatus PoolId
pid)
    Set PoolId
pools <- IO (Set PoolId) -> Handler (Set PoolId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Set PoolId)
knownPools
    EpochNo
curEpoch <- ctx -> Handler EpochNo
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k) =>
ctx -> Handler EpochNo
getCurrentEpoch ctx
ctx

    (Selection
sel, Tx
tx, TxMeta
txMeta, UTCTime
txTime, ProtocolParameters
pp) <- ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (ErrWalletNotResponding
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (WorkerCtx ctx
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
 -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (WorkerCtx ctx
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (DelegationAction
action, Maybe Coin
_) <- ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
 -> Handler (DelegationAction, Maybe Coin))
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
-> Handler (DelegationAction, Maybe Coin)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> EpochNo
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> WalletId
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> EpochNo
-> Set PoolId
-> PoolId
-> PoolLifeCycleStatus
-> WalletId
-> ExceptT ErrStakePoolDelegation IO (DelegationAction, Maybe Coin)
W.joinStakePool @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk EpochNo
curEpoch Set PoolId
pools PoolId
pid PoolLifeCycleStatus
poolStatus WalletId
wid

        -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
        -- @currentNodeEra@ which is not guaranteed with the era read here. This
        -- could cause problems under exceptional circumstances.
        (Withdrawal
wdrl, RewardAccountBuilder k
mkRwdAcct) <- ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid Maybe ApiWithdrawalPostData
forall a. Maybe a
Nothing
        SlotNo
ttl <- IO SlotNo -> Handler SlotNo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlotNo -> Handler SlotNo) -> IO SlotNo -> Handler SlotNo
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe NominalDiffTime
forall a. Maybe a
Nothing
        let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
                { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (Maybe SlotNo
forall a. Maybe a
Nothing, SlotNo
ttl)
                , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
action
                }
        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
        -- FIXME [ADP-1489] pp and era are not guaranteed to be consistent,
        -- which could cause problems under exceptional circumstances.
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        let selectAssetsParams :: SelectAssetsParams s Selection
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = []
                , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                }
        Selection
sel <- ExceptT ErrSelectAssets IO Selection -> Handler Selection
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSelectAssets IO Selection -> Handler Selection)
-> ExceptT ErrSelectAssets IO Selection -> Handler Selection
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s Selection
-> (s -> Selection -> Selection)
-> ExceptT ErrSelectAssets IO Selection
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams s Selection
selectAssetsParams
            ((s -> Selection -> Selection)
 -> ExceptT ErrSelectAssets IO Selection)
-> (s -> Selection -> Selection)
-> ExceptT ErrSelectAssets IO Selection
forall a b. (a -> b) -> a -> b
$ (Selection -> Selection) -> s -> Selection -> Selection
forall a b. a -> b -> a
const Selection -> Selection
forall a. a -> a
Prelude.id
        SelectionOf TxOut
sel' <- ExceptT ErrSignPayment IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSignPayment IO (SelectionOf TxOut)
 -> Handler (SelectionOf TxOut))
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ArgGenChange (SeqState n k)
-> Selection
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
forall ctx s (k :: Depth -> * -> *).
(GenChange s, HasDBLayer IO s k ctx, AddressBookIso s) =>
ctx
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
W.assignChangeAddressesAndUpdateDb WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid ArgGenChange (SeqState n k)
k 'AddressK XPub -> k 'AddressK XPub -> Address
genChange Selection
sel
        (Tx
tx, TxMeta
txMeta, UTCTime
txTime, SealedTx
sealedTx) <- ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
 -> Handler (Tx, TxMeta, UTCTime, SealedTx))
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> AnyCardanoEra
-> RewardAccountBuilder k
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
forall ctx s (k :: Depth -> * -> *).
(HasTransactionLayer k ctx, HasDBLayer IO s k ctx,
 HasNetworkLayer IO ctx, IsOwned s k) =>
ctx
-> WalletId
-> AnyCardanoEra
-> ((k 'RootK XPrv, Passphrase "encryption")
    -> (XPrv, Passphrase "encryption"))
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
W.buildAndSignTransaction @_ @s @k
                WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid AnyCardanoEra
era RewardAccountBuilder k
mkRwdAcct Passphrase "user"
pwd TransactionCtx
txCtx SelectionOf TxOut
sel'
        ExceptT ErrSubmitTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSubmitTx IO () -> Handler ())
-> ExceptT ErrSubmitTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
forall ctx s (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasDBLayer IO s k ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
W.submitTx @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid (Tx
tx, TxMeta
txMeta, SealedTx
sealedTx)

        (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection
sel, Tx
tx, TxMeta
txMeta, UTCTime
txTime, ProtocolParameters
pp)

    IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ApiTransaction n) -> Handler (ApiTransaction n))
-> IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
forall (n :: NetworkDiscriminant).
TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
mkApiTransaction
        (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer))
        (IsLabel
  "pendingSince"
  ((Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
   -> ApiTransaction n -> f (ApiTransaction n))
(Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
#pendingSince)
        MkApiTransactionParams :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Maybe TxOut)]
-> [(TxIn, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Maybe TxMetadata
-> UTCTime
-> Maybe TxScriptValidity
-> Coin
-> TxMetadataSchema
-> MkApiTransactionParams
MkApiTransactionParams
            { $sel:txId:MkApiTransactionParams :: Hash "Tx"
txId = Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId
            , $sel:txFee:MkApiTransactionParams :: Maybe Coin
txFee = Tx
tx Tx
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> Tx -> Const (Maybe Coin) Tx)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "fee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> Tx -> Const (Maybe Coin) Tx)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> Tx -> Const (Maybe Coin) Tx
#fee
            , $sel:txInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txInputs = NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)])
-> NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a b. (a -> b) -> a -> b
$ (TxOut -> Maybe TxOut) -> (TxIn, TxOut) -> (TxIn, Maybe TxOut)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just ((TxIn, TxOut) -> (TxIn, Maybe TxOut))
-> NonEmpty (TxIn, TxOut) -> NonEmpty (TxIn, Maybe TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection
sel Selection
-> ((NonEmpty (TxIn, TxOut)
     -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
    -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> NonEmpty (TxIn, TxOut)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs
              -- Joining a stake pool does not require collateral:
            , $sel:txCollateralInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txCollateralInputs = []
            , $sel:txOutputs:MkApiTransactionParams :: [TxOut]
txOutputs = Tx
tx Tx
-> (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx
#outputs
            , $sel:txCollateralOutput:MkApiTransactionParams :: Maybe TxOut
txCollateralOutput = Tx
tx Tx
-> ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
    -> Tx -> Const (Maybe TxOut) Tx)
-> Maybe TxOut
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> Tx -> Const (Maybe TxOut) Tx)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> Tx -> Const (Maybe TxOut) Tx
#collateralOutput
            , $sel:txWithdrawals:MkApiTransactionParams :: Map RewardAccount Coin
txWithdrawals = Tx
tx Tx
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> Tx -> Const (Map RewardAccount Coin) Tx)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> Tx -> Const (Map RewardAccount Coin) Tx)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> Tx -> Const (Map RewardAccount Coin) Tx
#withdrawals
            , TxMeta
txMeta :: TxMeta
$sel:txMeta:MkApiTransactionParams :: TxMeta
txMeta
            , $sel:txMetadata:MkApiTransactionParams :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
forall a. Maybe a
Nothing
            , UTCTime
txTime :: UTCTime
$sel:txTime:MkApiTransactionParams :: UTCTime
txTime
            , $sel:txScriptValidity:MkApiTransactionParams :: Maybe TxScriptValidity
txScriptValidity = Tx
tx Tx
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> Tx -> Const (Maybe TxScriptValidity) Tx)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> Tx -> Const (Maybe TxScriptValidity) Tx)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> Tx -> Const (Maybe TxScriptValidity) Tx
#scriptValidity
            , $sel:txDeposit:MkApiTransactionParams :: Coin
txDeposit = ProtocolParameters -> Coin
W.stakeKeyDeposit ProtocolParameters
pp
            , $sel:txMetadataSchema:MkApiTransactionParams :: TxMetadataSchema
txMetadataSchema = TxMetadataSchema
TxMetadataDetailedSchema
            }
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

    genChange :: k 'AddressK XPub -> k 'AddressK XPub -> Address
genChange = forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
DelegationAddress n key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
delegationAddress @n

delegationFee
    :: forall ctx s n k.
        ( s ~ SeqState n k
        , ctx ~ ApiLayer s k
        , BoundedAddressLength k
        )
    => ctx
    -> ApiT WalletId
    -> Handler ApiFee
delegationFee :: ctx -> ApiT WalletId -> Handler ApiFee
delegationFee ctx
ctx (ApiT WalletId
wid) = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ApiFee)
-> (ErrWalletNotResponding -> Handler ApiFee)
-> (WorkerCtx ctx -> Handler ApiFee)
-> Handler ApiFee
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ApiFee
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ApiFee
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ApiFee) -> Handler ApiFee)
-> (WorkerCtx ctx -> Handler ApiFee) -> Handler ApiFee
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrSelectAssets IO ApiFee -> Handler ApiFee
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSelectAssets IO ApiFee -> Handler ApiFee)
-> ExceptT ErrSelectAssets IO ApiFee -> Handler ApiFee
forall a b. (a -> b) -> a -> b
$ do
        (UTxOIndex WalletUTxO, Wallet s, Set Tx)
w <- (ErrNoSuchWallet -> ErrSelectAssets)
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> ExceptT
     ErrSelectAssets IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrNoSuchWallet -> ErrSelectAssets
ErrSelectAssetsNoSuchWallet (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> ExceptT
      ErrSelectAssets IO (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> ExceptT
     ErrSelectAssets IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$
            WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
        ProtocolParameters
pp <- IO ProtocolParameters
-> ExceptT ErrSelectAssets IO ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters
 -> ExceptT ErrSelectAssets IO ProtocolParameters)
-> IO ProtocolParameters
-> ExceptT ErrSelectAssets IO ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> ExceptT ErrSelectAssets IO AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> ExceptT ErrSelectAssets IO AnyCardanoEra)
-> IO AnyCardanoEra -> ExceptT ErrSelectAssets IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        Coin
deposit <- WalletLayer IO (SeqState n k) k
-> WalletId -> ExceptT ErrSelectAssets IO Coin
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx) =>
ctx -> WalletId -> ExceptT ErrSelectAssets IO Coin
W.calcMinimumDeposit @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
        Maybe Coin -> [Coin] -> FeeEstimation -> ApiFee
mkApiFee (Coin -> Maybe Coin
forall a. a -> Maybe a
Just Coin
deposit) [] (FeeEstimation -> ApiFee)
-> ExceptT ErrSelectAssets IO FeeEstimation
-> ExceptT ErrSelectAssets IO ApiFee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ExceptT ErrSelectAssets IO Coin
-> ExceptT ErrSelectAssets IO FeeEstimation
forall (m :: * -> *).
Monad m =>
ExceptT ErrSelectAssets m Coin
-> ExceptT ErrSelectAssets m FeeEstimation
W.estimateFee (WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> Coin
-> (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> ExceptT ErrSelectAssets IO Coin
runSelection WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp Coin
deposit (UTxOIndex WalletUTxO, Wallet s, Set Tx)
w)
  where
    txCtx :: TransactionCtx
    txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx

    runSelection :: WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> Coin
-> (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> ExceptT ErrSelectAssets IO Coin
runSelection WalletLayer IO (SeqState n k) k
wrk AnyCardanoEra
era ProtocolParameters
pp Coin
_deposit (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) =
        WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s Coin
-> (s -> Selection -> Coin)
-> ExceptT ErrSelectAssets IO Coin
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO (SeqState n k) k
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams s Coin
selectAssetsParams s -> Selection -> Coin
forall b. b -> Selection -> Coin
calcFee
      where
        calcFee :: p -> Selection -> Coin
calcFee p
_ = (TokenBundle -> Coin) -> Selection -> Coin
forall change. (change -> Coin) -> SelectionOf change -> Coin
selectionDelta TokenBundle -> Coin
TokenBundle.getCoin
        selectAssetsParams :: SelectAssetsParams s Coin
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
            { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = []
            , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
            , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
            , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
            , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
            , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
            , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
            , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
            }

quitStakePool
    :: forall ctx s n k.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , AddressIndexDerivationType k ~ 'Soft
        , DelegationAddress n k
        , GenChange s
        , HasNetworkLayer IO ctx
        , IsOwned s k
        , SoftDerivation k
        , Typeable n
        , Typeable s
        , WalletKey k
        , AddressBookIso s
        , BoundedAddressLength k
        )
    => ctx
    -> ApiT WalletId
    -> ApiWalletPassphrase
    -> Handler (ApiTransaction n)
quitStakePool :: ctx
-> ApiT WalletId
-> ApiWalletPassphrase
-> Handler (ApiTransaction n)
quitStakePool ctx
ctx (ApiT WalletId
wid) ApiWalletPassphrase
body = do
    let pwd :: Passphrase "user"
pwd = Passphrase "lenient" -> Passphrase "user"
coerce (Passphrase "lenient" -> Passphrase "user")
-> Passphrase "lenient" -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a. ApiT a -> a
getApiT (ApiT (Passphrase "lenient") -> Passphrase "lenient")
-> ApiT (Passphrase "lenient") -> Passphrase "lenient"
forall a b. (a -> b) -> a -> b
$ ApiWalletPassphrase
body ApiWalletPassphrase
-> ((ApiT (Passphrase "lenient")
     -> Const
          (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
    -> ApiWalletPassphrase
    -> Const (ApiT (Passphrase "lenient")) ApiWalletPassphrase)
-> ApiT (Passphrase "lenient")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "lenient")
    -> Const
         (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
   -> ApiWalletPassphrase
   -> Const (ApiT (Passphrase "lenient")) ApiWalletPassphrase)
(ApiT (Passphrase "lenient")
 -> Const
      (ApiT (Passphrase "lenient")) (ApiT (Passphrase "lenient")))
-> ApiWalletPassphrase
-> Const (ApiT (Passphrase "lenient")) ApiWalletPassphrase
#passphrase

    (Selection
sel, Tx
tx, TxMeta
txMeta, UTCTime
txTime, ProtocolParameters
pp) <- ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (ErrWalletNotResponding
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (WorkerCtx ctx
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
 -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> (WorkerCtx ctx
    -> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters))
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
        -- @currentNodeEra@ which is not guaranteed with the era read here. This
        -- could cause problems under exceptional circumstances.
        (Withdrawal
wdrl, RewardAccountBuilder k
mkRwdAcct) <-
            ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid (ApiWithdrawalPostData -> Maybe ApiWithdrawalPostData
forall a. a -> Maybe a
Just ApiWithdrawalPostData
SelfWithdrawal)
        DelegationAction
action <- ExceptT ErrStakePoolDelegation IO DelegationAction
-> Handler DelegationAction
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrStakePoolDelegation IO DelegationAction
 -> Handler DelegationAction)
-> ExceptT ErrStakePoolDelegation IO DelegationAction
-> Handler DelegationAction
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> Withdrawal
-> ExceptT ErrStakePoolDelegation IO DelegationAction
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Withdrawal
-> ExceptT ErrStakePoolDelegation IO DelegationAction
W.quitStakePool WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid Withdrawal
wdrl
        SlotNo
ttl <- IO SlotNo -> Handler SlotNo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlotNo -> Handler SlotNo) -> IO SlotNo -> Handler SlotNo
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe NominalDiffTime
forall a. Maybe a
Nothing
        let txCtx :: TransactionCtx
txCtx = TransactionCtx
defaultTransactionCtx
                { $sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal = Withdrawal
wdrl
                , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (Maybe SlotNo
forall a. Maybe a
Nothing, SlotNo
ttl)
                , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = DelegationAction -> Maybe DelegationAction
forall a. a -> Maybe a
Just DelegationAction
action
                }

        (UTxOIndex WalletUTxO
utxoAvailable, Wallet s
wallet, Set Tx
pendingTxs) <-
            ExceptT ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
 -> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx))
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
-> Handler (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT
     ErrNoSuchWallet IO (UTxOIndex WalletUTxO, Wallet s, Set Tx)
W.readWalletUTxOIndex @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletLayer IO (SeqState n k) k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO (SeqState n k) k
    -> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO (SeqState n k) k
-> Const (NetworkLayer IO Block) (WalletLayer IO (SeqState n k) k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        let selectAssetsParams :: SelectAssetsParams s Selection
selectAssetsParams = SelectAssetsParams :: forall s result.
[TxOut]
-> Set Tx
-> Maybe StdGenSeed
-> TransactionCtx
-> Map WalletUTxO TokenBundle
-> UTxOSelection WalletUTxO
-> Wallet s
-> SelectionStrategy
-> SelectAssetsParams s result
W.SelectAssetsParams
                { $sel:outputs:SelectAssetsParams :: [TxOut]
outputs = []
                , Set Tx
pendingTxs :: Set Tx
$sel:pendingTxs:SelectAssetsParams :: Set Tx
pendingTxs
                , $sel:randomSeed:SelectAssetsParams :: Maybe StdGenSeed
randomSeed = Maybe StdGenSeed
forall a. Maybe a
Nothing
                , $sel:txContext:SelectAssetsParams :: TransactionCtx
txContext = TransactionCtx
txCtx
                , $sel:utxoAvailableForInputs:SelectAssetsParams :: UTxOSelection WalletUTxO
utxoAvailableForInputs = UTxOIndex WalletUTxO -> UTxOSelection WalletUTxO
forall u. UTxOIndex u -> UTxOSelection u
UTxOSelection.fromIndex UTxOIndex WalletUTxO
utxoAvailable
                , $sel:utxoAvailableForCollateral:SelectAssetsParams :: Map WalletUTxO TokenBundle
utxoAvailableForCollateral = UTxOIndex WalletUTxO -> Map WalletUTxO TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
UTxOIndex.toMap UTxOIndex WalletUTxO
utxoAvailable
                , Wallet s
wallet :: Wallet s
$sel:wallet:SelectAssetsParams :: Wallet s
wallet
                , $sel:selectionStrategy:SelectAssetsParams :: SelectionStrategy
selectionStrategy = SelectionStrategy
SelectionStrategyOptimal
                }
        Selection
sel <- ExceptT ErrSelectAssets IO Selection -> Handler Selection
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSelectAssets IO Selection -> Handler Selection)
-> ExceptT ErrSelectAssets IO Selection -> Handler Selection
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s Selection
-> (s -> Selection -> Selection)
-> ExceptT ErrSelectAssets IO Selection
forall ctx (m :: * -> *) s (k :: Depth -> * -> *) result.
(BoundedAddressLength k, HasTransactionLayer k ctx,
 HasLogger m WalletWorkerLog ctx, MonadRandom m) =>
ctx
-> AnyCardanoEra
-> ProtocolParameters
-> SelectAssetsParams s result
-> (s -> Selection -> result)
-> ExceptT ErrSelectAssets m result
W.selectAssets @_ @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk AnyCardanoEra
era ProtocolParameters
pp SelectAssetsParams s Selection
selectAssetsParams
            ((s -> Selection -> Selection)
 -> ExceptT ErrSelectAssets IO Selection)
-> (s -> Selection -> Selection)
-> ExceptT ErrSelectAssets IO Selection
forall a b. (a -> b) -> a -> b
$ (Selection -> Selection) -> s -> Selection -> Selection
forall a b. a -> b -> a
const Selection -> Selection
forall a. a -> a
Prelude.id
        SelectionOf TxOut
sel' <- ExceptT ErrSignPayment IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSignPayment IO (SelectionOf TxOut)
 -> Handler (SelectionOf TxOut))
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
-> Handler (SelectionOf TxOut)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ArgGenChange (SeqState n k)
-> Selection
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
forall ctx s (k :: Depth -> * -> *).
(GenChange s, HasDBLayer IO s k ctx, AddressBookIso s) =>
ctx
-> WalletId
-> ArgGenChange s
-> Selection
-> ExceptT ErrSignPayment IO (SelectionOf TxOut)
W.assignChangeAddressesAndUpdateDb WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid ArgGenChange (SeqState n k)
k 'AddressK XPub -> k 'AddressK XPub -> Address
genChange Selection
sel
        (Tx
tx, TxMeta
txMeta, UTCTime
txTime, SealedTx
sealedTx) <- ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
 -> Handler (Tx, TxMeta, UTCTime, SealedTx))
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> AnyCardanoEra
-> RewardAccountBuilder k
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
forall ctx s (k :: Depth -> * -> *).
(HasTransactionLayer k ctx, HasDBLayer IO s k ctx,
 HasNetworkLayer IO ctx, IsOwned s k) =>
ctx
-> WalletId
-> AnyCardanoEra
-> ((k 'RootK XPrv, Passphrase "encryption")
    -> (XPrv, Passphrase "encryption"))
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
W.buildAndSignTransaction @_ @s @k
                WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid AnyCardanoEra
era RewardAccountBuilder k
mkRwdAcct Passphrase "user"
pwd TransactionCtx
txCtx SelectionOf TxOut
sel'
        ExceptT ErrSubmitTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT ErrSubmitTx IO () -> Handler ())
-> ExceptT ErrSubmitTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
forall ctx s (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasDBLayer IO s k ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
W.submitTx @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid (Tx
tx, TxMeta
txMeta, SealedTx
sealedTx)

        (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
-> Handler (Selection, Tx, TxMeta, UTCTime, ProtocolParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection
sel, Tx
tx, TxMeta
txMeta, UTCTime
txTime, ProtocolParameters
pp)

    IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ApiTransaction n) -> Handler (ApiTransaction n))
-> IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
forall (n :: NetworkDiscriminant).
TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
mkApiTransaction
        (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer))
        (IsLabel
  "pendingSince"
  ((Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
   -> ApiTransaction n -> f (ApiTransaction n))
(Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
#pendingSince)
        MkApiTransactionParams :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Maybe TxOut)]
-> [(TxIn, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Maybe TxMetadata
-> UTCTime
-> Maybe TxScriptValidity
-> Coin
-> TxMetadataSchema
-> MkApiTransactionParams
MkApiTransactionParams
            { $sel:txId:MkApiTransactionParams :: Hash "Tx"
txId = Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId
            , $sel:txFee:MkApiTransactionParams :: Maybe Coin
txFee = Tx
tx Tx
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> Tx -> Const (Maybe Coin) Tx)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "fee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> Tx -> Const (Maybe Coin) Tx)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> Tx -> Const (Maybe Coin) Tx
#fee
            , $sel:txInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txInputs = NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)])
-> NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a b. (a -> b) -> a -> b
$ (TxOut -> Maybe TxOut) -> (TxIn, TxOut) -> (TxIn, Maybe TxOut)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just ((TxIn, TxOut) -> (TxIn, Maybe TxOut))
-> NonEmpty (TxIn, TxOut) -> NonEmpty (TxIn, Maybe TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selection
sel Selection
-> ((NonEmpty (TxIn, TxOut)
     -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
    -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
-> NonEmpty (TxIn, TxOut)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> Selection -> Const (NonEmpty (TxIn, TxOut)) Selection
#inputs
              -- Quitting a stake pool does not require collateral:
            , $sel:txCollateralInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txCollateralInputs = []
            , $sel:txOutputs:MkApiTransactionParams :: [TxOut]
txOutputs = Tx
tx Tx
-> (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx
#outputs
            , $sel:txCollateralOutput:MkApiTransactionParams :: Maybe TxOut
txCollateralOutput = Tx
tx Tx
-> ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
    -> Tx -> Const (Maybe TxOut) Tx)
-> Maybe TxOut
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> Tx -> Const (Maybe TxOut) Tx)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> Tx -> Const (Maybe TxOut) Tx
#collateralOutput
            , $sel:txWithdrawals:MkApiTransactionParams :: Map RewardAccount Coin
txWithdrawals = Tx
tx Tx
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> Tx -> Const (Map RewardAccount Coin) Tx)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> Tx -> Const (Map RewardAccount Coin) Tx)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> Tx -> Const (Map RewardAccount Coin) Tx
#withdrawals
            , TxMeta
txMeta :: TxMeta
$sel:txMeta:MkApiTransactionParams :: TxMeta
txMeta
            , $sel:txMetadata:MkApiTransactionParams :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
forall a. Maybe a
Nothing
            , UTCTime
txTime :: UTCTime
$sel:txTime:MkApiTransactionParams :: UTCTime
txTime
            , $sel:txScriptValidity:MkApiTransactionParams :: Maybe TxScriptValidity
txScriptValidity = Tx
tx Tx
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> Tx -> Const (Maybe TxScriptValidity) Tx)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> Tx -> Const (Maybe TxScriptValidity) Tx)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> Tx -> Const (Maybe TxScriptValidity) Tx
#scriptValidity
            , $sel:txDeposit:MkApiTransactionParams :: Coin
txDeposit = ProtocolParameters -> Coin
W.stakeKeyDeposit ProtocolParameters
pp
            , $sel:txMetadataSchema:MkApiTransactionParams :: TxMetadataSchema
txMetadataSchema = TxMetadataSchema
TxMetadataDetailedSchema
            }
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

    genChange :: k 'AddressK XPub -> k 'AddressK XPub -> Address
genChange = forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
DelegationAddress n key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
delegationAddress @n

-- More testable helper for `listStakeKeys`.
--
-- TODO: Ideally test things like
-- no rewards => ada in distr == utxo balance
-- all keys in inputs appear (once) in output
listStakeKeys'
    :: forall (n :: NetworkDiscriminant) m. Monad m
    => UTxO.UTxO
        -- ^ The wallet's UTxO
    -> (Address -> Maybe RewardAccount)
        -- ^ Lookup reward account of addr
    -> (Set RewardAccount -> m (Map RewardAccount Coin))
        -- ^ Batch fetch of rewards
    -> [(RewardAccount, Natural, ApiWalletDelegation)]
        -- ^ The wallet's known stake keys, along with derivation index, and
        -- delegation status.
    -> m (ApiStakeKeys n)
listStakeKeys' :: UTxO
-> (Address -> Maybe RewardAccount)
-> (Set RewardAccount -> m (Map RewardAccount Coin))
-> [(RewardAccount, Natural, ApiWalletDelegation)]
-> m (ApiStakeKeys n)
listStakeKeys' UTxO
utxo Address -> Maybe RewardAccount
lookupStakeRef Set RewardAccount -> m (Map RewardAccount Coin)
fetchRewards [(RewardAccount, Natural, ApiWalletDelegation)]
ourKeysWithInfo = do
        let distr :: Map (Maybe RewardAccount) Coin
distr = (Address -> Maybe RewardAccount)
-> UTxO -> Map (Maybe RewardAccount) Coin
stakeKeyCoinDistr Address -> Maybe RewardAccount
lookupStakeRef UTxO
utxo
        let stakeKeysInUTxO :: [RewardAccount]
stakeKeysInUTxO = [Maybe RewardAccount] -> [RewardAccount]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe RewardAccount] -> [RewardAccount])
-> [Maybe RewardAccount] -> [RewardAccount]
forall a b. (a -> b) -> a -> b
$ Map (Maybe RewardAccount) Coin -> [Maybe RewardAccount]
forall k a. Map k a -> [k]
Map.keys Map (Maybe RewardAccount) Coin
distr
        let stake :: Maybe RewardAccount -> Coin
stake Maybe RewardAccount
acc = Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe (Natural -> Coin
Coin Natural
0) (Maybe Coin -> Coin) -> Maybe Coin -> Coin
forall a b. (a -> b) -> a -> b
$ Maybe RewardAccount -> Map (Maybe RewardAccount) Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Maybe RewardAccount
acc Map (Maybe RewardAccount) Coin
distr

        let ourKeys :: [RewardAccount]
ourKeys = ((RewardAccount, Natural, ApiWalletDelegation) -> RewardAccount)
-> [(RewardAccount, Natural, ApiWalletDelegation)]
-> [RewardAccount]
forall a b. (a -> b) -> [a] -> [b]
map (\(RewardAccount
acc,Natural
_,ApiWalletDelegation
_) -> RewardAccount
acc) [(RewardAccount, Natural, ApiWalletDelegation)]
ourKeysWithInfo

        let allKeys :: [RewardAccount]
allKeys = [RewardAccount]
ourKeys [RewardAccount] -> [RewardAccount] -> [RewardAccount]
forall a. Semigroup a => a -> a -> a
<> [RewardAccount]
stakeKeysInUTxO

        -- If we wanted to know whether a stake key is registered or not, we
        -- could expose the difference between `Nothing` and `Just 0` in the
        -- `NetworkLayer` interface.
        Map RewardAccount Coin
rewardsMap <- Set RewardAccount -> m (Map RewardAccount Coin)
fetchRewards (Set RewardAccount -> m (Map RewardAccount Coin))
-> Set RewardAccount -> m (Map RewardAccount Coin)
forall a b. (a -> b) -> a -> b
$ [RewardAccount] -> Set RewardAccount
forall a. Ord a => [a] -> Set a
Set.fromList [RewardAccount]
allKeys

        let rewards :: RewardAccount -> Coin
rewards RewardAccount
acc = Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe (Natural -> Coin
Coin Natural
0) (Maybe Coin -> Coin) -> Maybe Coin -> Coin
forall a b. (a -> b) -> a -> b
$
                RewardAccount -> Map RewardAccount Coin -> Maybe Coin
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RewardAccount
acc Map RewardAccount Coin
rewardsMap

        let mkOurs :: (RewardAccount, Natural, ApiWalletDelegation) -> ApiOurStakeKey n
mkOurs (RewardAccount
acc, Natural
ix, ApiWalletDelegation
deleg) = ApiOurStakeKey :: forall (n :: NetworkDiscriminant).
Natural
-> (ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> ApiWalletDelegation
-> ApiOurStakeKey n
ApiOurStakeKey
                { $sel:_index:ApiOurStakeKey :: Natural
_index = Natural
ix
                , $sel:_key:ApiOurStakeKey :: (ApiT RewardAccount, Proxy n)
_key = (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
acc, Proxy n
forall k (t :: k). Proxy t
Proxy)
                , $sel:_rewardBalance:ApiOurStakeKey :: Quantity "lovelace" Natural
_rewardBalance = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$
                    RewardAccount -> Coin
rewards RewardAccount
acc
                , $sel:_delegation:ApiOurStakeKey :: ApiWalletDelegation
_delegation = ApiWalletDelegation
deleg
                , $sel:_stake:ApiOurStakeKey :: Quantity "lovelace" Natural
_stake = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$
                    Maybe RewardAccount -> Coin
stake (RewardAccount -> Maybe RewardAccount
forall a. a -> Maybe a
Just RewardAccount
acc) Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> RewardAccount -> Coin
rewards RewardAccount
acc
                }

        let mkForeign :: RewardAccount -> ApiForeignStakeKey n
mkForeign RewardAccount
acc = ApiForeignStakeKey :: forall (n :: NetworkDiscriminant).
(ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> ApiForeignStakeKey n
ApiForeignStakeKey
                { $sel:_key:ApiForeignStakeKey :: (ApiT RewardAccount, Proxy n)
_key = (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
acc, Proxy n
forall k (t :: k). Proxy t
Proxy)
                , $sel:_rewardBalance:ApiForeignStakeKey :: Quantity "lovelace" Natural
_rewardBalance = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$
                    RewardAccount -> Coin
rewards RewardAccount
acc
                , $sel:_stake:ApiForeignStakeKey :: Quantity "lovelace" Natural
_stake = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$
                    Maybe RewardAccount -> Coin
stake (RewardAccount -> Maybe RewardAccount
forall a. a -> Maybe a
Just RewardAccount
acc) Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> RewardAccount -> Coin
rewards RewardAccount
acc
                }

        let foreignKeys :: [RewardAccount]
foreignKeys = [RewardAccount]
stakeKeysInUTxO [RewardAccount] -> [RewardAccount] -> [RewardAccount]
forall a. Eq a => [a] -> [a] -> [a]
\\ [RewardAccount]
ourKeys

        let nullKey :: ApiNullStakeKey
nullKey = ApiNullStakeKey :: Quantity "lovelace" Natural -> ApiNullStakeKey
ApiNullStakeKey
                { $sel:_stake:ApiNullStakeKey :: Quantity "lovelace" Natural
_stake = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Maybe RewardAccount -> Coin
stake Maybe RewardAccount
forall a. Maybe a
Nothing
                }

        ApiStakeKeys n -> m (ApiStakeKeys n)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiStakeKeys n -> m (ApiStakeKeys n))
-> ApiStakeKeys n -> m (ApiStakeKeys n)
forall a b. (a -> b) -> a -> b
$ ApiStakeKeys :: forall (n :: NetworkDiscriminant).
[ApiOurStakeKey n]
-> [ApiForeignStakeKey n] -> ApiNullStakeKey -> ApiStakeKeys n
ApiStakeKeys
            { $sel:_ours:ApiStakeKeys :: [ApiOurStakeKey n]
_ours = ((RewardAccount, Natural, ApiWalletDelegation) -> ApiOurStakeKey n)
-> [(RewardAccount, Natural, ApiWalletDelegation)]
-> [ApiOurStakeKey n]
forall a b. (a -> b) -> [a] -> [b]
map (RewardAccount, Natural, ApiWalletDelegation) -> ApiOurStakeKey n
mkOurs [(RewardAccount, Natural, ApiWalletDelegation)]
ourKeysWithInfo
            , $sel:_foreign:ApiStakeKeys :: [ApiForeignStakeKey n]
_foreign = (RewardAccount -> ApiForeignStakeKey n)
-> [RewardAccount] -> [ApiForeignStakeKey n]
forall a b. (a -> b) -> [a] -> [b]
map RewardAccount -> ApiForeignStakeKey n
mkForeign [RewardAccount]
foreignKeys
            , $sel:_none:ApiStakeKeys :: ApiNullStakeKey
_none = ApiNullStakeKey
nullKey
            }

listStakeKeys
    :: forall ctx s n k.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , HasNetworkLayer IO ctx
        , Typeable n
        , Typeable s
        )
    => (Address -> Maybe RewardAccount)
    -> ctx
    -> ApiT WalletId
    -> Handler (ApiStakeKeys n)
listStakeKeys :: (Address -> Maybe RewardAccount)
-> ctx -> ApiT WalletId -> Handler (ApiStakeKeys n)
listStakeKeys Address -> Maybe RewardAccount
lookupStakeRef ctx
ctx (ApiT WalletId
wid) = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiStakeKeys n))
-> (ErrWalletNotResponding -> Handler (ApiStakeKeys n))
-> (WorkerCtx ctx -> Handler (ApiStakeKeys n))
-> Handler (ApiStakeKeys n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiStakeKeys n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiStakeKeys n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiStakeKeys n))
 -> Handler (ApiStakeKeys n))
-> (WorkerCtx ctx -> Handler (ApiStakeKeys n))
-> Handler (ApiStakeKeys n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrNoSuchWallet IO (ApiStakeKeys n)
-> Handler (ApiStakeKeys n)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrNoSuchWallet IO (ApiStakeKeys n)
 -> Handler (ApiStakeKeys n))
-> ExceptT ErrNoSuchWallet IO (ApiStakeKeys n)
-> Handler (ApiStakeKeys n)
forall a b. (a -> b) -> a -> b
$ do
            (Wallet s
wal, WalletMetadata
meta, Set Tx
pending) <- WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
W.readWallet @_ @s @k WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
            let utxo :: UTxO
utxo = Set Tx -> Wallet s -> UTxO
forall s. Set Tx -> Wallet s -> UTxO
availableUTxO @s Set Tx
pending Wallet s
wal

            let takeFst :: (a, b, c) -> a
takeFst (a
a,b
_,c
_) = a
a
            Maybe RewardAccount
mourAccount <- (Either
   ErrReadRewardAccount
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Maybe RewardAccount)
-> ExceptT
     ErrNoSuchWallet
     IO
     (Either
        ErrReadRewardAccount
        (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT ErrNoSuchWallet IO (Maybe RewardAccount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((RewardAccount, XPub, NonEmpty DerivationIndex) -> RewardAccount)
-> Maybe (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Maybe RewardAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RewardAccount, XPub, NonEmpty DerivationIndex) -> RewardAccount
forall a b c. (a, b, c) -> a
takeFst (Maybe (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Maybe RewardAccount)
-> (Either
      ErrReadRewardAccount
      (RewardAccount, XPub, NonEmpty DerivationIndex)
    -> Maybe (RewardAccount, XPub, NonEmpty DerivationIndex))
-> Either
     ErrReadRewardAccount
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Maybe RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  ErrReadRewardAccount
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Maybe (RewardAccount, XPub, NonEmpty DerivationIndex)
forall a b. Either a b -> Maybe b
eitherToMaybe)
                (ExceptT
   ErrNoSuchWallet
   IO
   (Either
      ErrReadRewardAccount
      (RewardAccount, XPub, NonEmpty DerivationIndex))
 -> ExceptT ErrNoSuchWallet IO (Maybe RewardAccount))
-> (ExceptT
      ErrReadRewardAccount
      IO
      (RewardAccount, XPub, NonEmpty DerivationIndex)
    -> ExceptT
         ErrNoSuchWallet
         IO
         (Either
            ErrReadRewardAccount
            (RewardAccount, XPub, NonEmpty DerivationIndex)))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> ExceptT ErrNoSuchWallet IO (Maybe RewardAccount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO
  (Either
     ErrReadRewardAccount
     (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrNoSuchWallet
     IO
     (Either
        ErrReadRewardAccount
        (RewardAccount, XPub, NonEmpty DerivationIndex))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      ErrReadRewardAccount
      (RewardAccount, XPub, NonEmpty DerivationIndex))
 -> ExceptT
      ErrNoSuchWallet
      IO
      (Either
         ErrReadRewardAccount
         (RewardAccount, XPub, NonEmpty DerivationIndex)))
-> (ExceptT
      ErrReadRewardAccount
      IO
      (RewardAccount, XPub, NonEmpty DerivationIndex)
    -> IO
         (Either
            ErrReadRewardAccount
            (RewardAccount, XPub, NonEmpty DerivationIndex)))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> ExceptT
     ErrNoSuchWallet
     IO
     (Either
        ErrReadRewardAccount
        (RewardAccount, XPub, NonEmpty DerivationIndex))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  ErrReadRewardAccount
  IO
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> IO
     (Either
        ErrReadRewardAccount
        (RewardAccount, XPub, NonEmpty DerivationIndex))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   ErrReadRewardAccount
   IO
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> ExceptT ErrNoSuchWallet IO (Maybe RewardAccount))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> ExceptT ErrNoSuchWallet IO (Maybe RewardAccount)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n k) k
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
W.readRewardAccount @_ @s @k @n WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid
            ApiWalletDelegation
ourApiDelegation <- IO ApiWalletDelegation
-> ExceptT ErrNoSuchWallet IO ApiWalletDelegation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiWalletDelegation
 -> ExceptT ErrNoSuchWallet IO ApiWalletDelegation)
-> IO ApiWalletDelegation
-> ExceptT ErrNoSuchWallet IO ApiWalletDelegation
forall a b. (a -> b) -> a -> b
$ WalletDelegation -> TimeInterpreter IO -> IO ApiWalletDelegation
toApiWalletDelegation (WalletMetadata
meta WalletMetadata
-> ((WalletDelegation -> Const WalletDelegation WalletDelegation)
    -> WalletMetadata -> Const WalletDelegation WalletMetadata)
-> WalletDelegation
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "delegation"
  ((WalletDelegation -> Const WalletDelegation WalletDelegation)
   -> WalletMetadata -> Const WalletDelegation WalletMetadata)
(WalletDelegation -> Const WalletDelegation WalletDelegation)
-> WalletMetadata -> Const WalletDelegation WalletMetadata
#delegation)
                (TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
unsafeExtendSafeZone (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (NetworkLayer IO Block
 -> TimeInterpreter (ExceptT PastHorizonException IO))
-> NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall a b. (a -> b) -> a -> b
$ ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer))
            let ourKeys :: [(RewardAccount, Natural, ApiWalletDelegation)]
ourKeys = case Maybe RewardAccount
mourAccount of
                    Just RewardAccount
acc -> [(RewardAccount
acc, Natural
0, ApiWalletDelegation
ourApiDelegation)]
                    Maybe RewardAccount
Nothing -> []

            IO (ApiStakeKeys n) -> ExceptT ErrNoSuchWallet IO (ApiStakeKeys n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ApiStakeKeys n)
 -> ExceptT ErrNoSuchWallet IO (ApiStakeKeys n))
-> IO (ApiStakeKeys n)
-> ExceptT ErrNoSuchWallet IO (ApiStakeKeys n)
forall a b. (a -> b) -> a -> b
$ UTxO
-> (Address -> Maybe RewardAccount)
-> (Set RewardAccount -> IO (Map RewardAccount Coin))
-> [(RewardAccount, Natural, ApiWalletDelegation)]
-> IO (ApiStakeKeys n)
forall (n :: NetworkDiscriminant) (m :: * -> *).
Monad m =>
UTxO
-> (Address -> Maybe RewardAccount)
-> (Set RewardAccount -> m (Map RewardAccount Coin))
-> [(RewardAccount, Natural, ApiWalletDelegation)]
-> m (ApiStakeKeys n)
listStakeKeys' @n
                UTxO
utxo
                Address -> Maybe RewardAccount
lookupStakeRef
                (NetworkLayer IO Block
-> Set RewardAccount -> IO (Map RewardAccount Coin)
forall (m :: * -> *) block.
NetworkLayer m block
-> Set RewardAccount -> m (Map RewardAccount Coin)
fetchRewardAccountBalances NetworkLayer IO Block
nl)
                [(RewardAccount, Natural, ApiWalletDelegation)]
ourKeys
  where
    nl :: NetworkLayer IO Block
nl = ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer

{-------------------------------------------------------------------------------
                                Migrations
-------------------------------------------------------------------------------}

createMigrationPlan
    :: forall ctx n s k.
        ( ctx ~ ApiLayer s k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , HardDerivation k
        , IsOwned s k
        , Typeable n
        , Typeable s
        , WalletKey k
        )
    => ctx
    -> Maybe ApiWithdrawalPostData
        -- ^ What type of reward withdrawal to attempt
    -> ApiT WalletId
        -- ^ Source wallet
    -> ApiWalletMigrationPlanPostData n
        -- ^ Target addresses
    -> Handler (ApiWalletMigrationPlan n)
createMigrationPlan :: ctx
-> Maybe ApiWithdrawalPostData
-> ApiT WalletId
-> ApiWalletMigrationPlanPostData n
-> Handler (ApiWalletMigrationPlan n)
createMigrationPlan ctx
ctx Maybe ApiWithdrawalPostData
withdrawalType (ApiT WalletId
wid) ApiWalletMigrationPlanPostData n
postData = do
    -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
    -- @currentNodeEra@ which is not guaranteed with the era read here. This
    -- could cause problems under exceptional circumstances.
    (Withdrawal
rewardWithdrawal, RewardAccountBuilder k
_) <-
        ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid Maybe ApiWithdrawalPostData
withdrawalType
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (ApiWalletMigrationPlan n))
-> (ErrWalletNotResponding -> Handler (ApiWalletMigrationPlan n))
-> (WorkerCtx ctx -> Handler (ApiWalletMigrationPlan n))
-> Handler (ApiWalletMigrationPlan n)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (ApiWalletMigrationPlan n)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (ApiWalletMigrationPlan n)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (ApiWalletMigrationPlan n))
 -> Handler (ApiWalletMigrationPlan n))
-> (WorkerCtx ctx -> Handler (ApiWalletMigrationPlan n))
-> Handler (ApiWalletMigrationPlan n)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrCreateMigrationPlan IO (ApiWalletMigrationPlan n)
-> Handler (ApiWalletMigrationPlan n)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateMigrationPlan IO (ApiWalletMigrationPlan n)
 -> Handler (ApiWalletMigrationPlan n))
-> ExceptT ErrCreateMigrationPlan IO (ApiWalletMigrationPlan n)
-> Handler (ApiWalletMigrationPlan n)
forall a b. (a -> b) -> a -> b
$ do
        AnyCardanoEra
era <- IO AnyCardanoEra -> ExceptT ErrCreateMigrationPlan IO AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra
 -> ExceptT ErrCreateMigrationPlan IO AnyCardanoEra)
-> IO AnyCardanoEra
-> ExceptT ErrCreateMigrationPlan IO AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        (Wallet s
wallet, WalletMetadata
_, Set Tx
_) <- (ErrNoSuchWallet -> ErrCreateMigrationPlan)
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> ExceptT
     ErrCreateMigrationPlan IO (Wallet s, WalletMetadata, Set Tx)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrNoSuchWallet -> ErrCreateMigrationPlan
ErrCreateMigrationPlanNoSuchWallet (ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
 -> ExceptT
      ErrCreateMigrationPlan IO (Wallet s, WalletMetadata, Set Tx))
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
-> ExceptT
     ErrCreateMigrationPlan IO (Wallet s, WalletMetadata, Set Tx)
forall a b. (a -> b) -> a -> b
$
            WalletLayer IO s k
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata, Set Tx)
W.readWallet WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        MigrationPlan
plan <- WalletLayer IO s k
-> AnyCardanoEra
-> WalletId
-> Withdrawal
-> ExceptT ErrCreateMigrationPlan IO MigrationPlan
forall ctx (k :: Depth -> * -> *) s.
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx,
 HasTransactionLayer k ctx) =>
ctx
-> AnyCardanoEra
-> WalletId
-> Withdrawal
-> ExceptT ErrCreateMigrationPlan IO MigrationPlan
W.createMigrationPlan WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era WalletId
wid Withdrawal
rewardWithdrawal
        ErrCreateMigrationPlan
-> Maybe (ApiWalletMigrationPlan n)
-> ExceptT ErrCreateMigrationPlan IO (ApiWalletMigrationPlan n)
forall (m :: * -> *) e a.
Applicative m =>
e -> Maybe a -> ExceptT e m a
failWith ErrCreateMigrationPlan
ErrCreateMigrationPlanEmpty (Maybe (ApiWalletMigrationPlan n)
 -> ExceptT ErrCreateMigrationPlan IO (ApiWalletMigrationPlan n))
-> Maybe (ApiWalletMigrationPlan n)
-> ExceptT ErrCreateMigrationPlan IO (ApiWalletMigrationPlan n)
forall a b. (a -> b) -> a -> b
$ s
-> NonEmpty (ApiT Address, Proxy n)
-> Withdrawal
-> MigrationPlan
-> Maybe (ApiWalletMigrationPlan n)
forall (n :: NetworkDiscriminant) s.
IsOurs s Address =>
s
-> NonEmpty (ApiT Address, Proxy n)
-> Withdrawal
-> MigrationPlan
-> Maybe (ApiWalletMigrationPlan n)
mkApiWalletMigrationPlan
            (Wallet s -> s
forall s. Wallet s -> s
getState Wallet s
wallet)
            (((NonEmpty (ApiT Address, Proxy n)
  -> Const
       (NonEmpty (ApiT Address, Proxy n))
       (NonEmpty (ApiT Address, Proxy n)))
 -> ApiWalletMigrationPlanPostData n
 -> Const
      (NonEmpty (ApiT Address, Proxy n))
      (ApiWalletMigrationPlanPostData n))
-> ApiWalletMigrationPlanPostData n
-> NonEmpty (ApiT Address, Proxy n)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "addresses"
  ((NonEmpty (ApiT Address, Proxy n)
    -> Const
         (NonEmpty (ApiT Address, Proxy n))
         (NonEmpty (ApiT Address, Proxy n)))
   -> ApiWalletMigrationPlanPostData n
   -> Const
        (NonEmpty (ApiT Address, Proxy n))
        (ApiWalletMigrationPlanPostData n))
(NonEmpty (ApiT Address, Proxy n)
 -> Const
      (NonEmpty (ApiT Address, Proxy n))
      (NonEmpty (ApiT Address, Proxy n)))
-> ApiWalletMigrationPlanPostData n
-> Const
     (NonEmpty (ApiT Address, Proxy n))
     (ApiWalletMigrationPlanPostData n)
#addresses ApiWalletMigrationPlanPostData n
postData)
            (Withdrawal
rewardWithdrawal)
            (MigrationPlan
plan)

mkApiWalletMigrationPlan
    :: forall n s. IsOurs s Address
    => s
    -> NonEmpty (ApiT Address, Proxy n)
    -> Withdrawal
    -> MigrationPlan
    -> Maybe (ApiWalletMigrationPlan n)
mkApiWalletMigrationPlan :: s
-> NonEmpty (ApiT Address, Proxy n)
-> Withdrawal
-> MigrationPlan
-> Maybe (ApiWalletMigrationPlan n)
mkApiWalletMigrationPlan s
s NonEmpty (ApiT Address, Proxy n)
addresses Withdrawal
rewardWithdrawal MigrationPlan
plan =
    NonEmpty (ApiCoinSelection n) -> ApiWalletMigrationPlan n
mkApiPlan (NonEmpty (ApiCoinSelection n) -> ApiWalletMigrationPlan n)
-> Maybe (NonEmpty (ApiCoinSelection n))
-> Maybe (ApiWalletMigrationPlan n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (ApiCoinSelection n))
maybeSelections
  where
    mkApiPlan :: NonEmpty (ApiCoinSelection n) -> ApiWalletMigrationPlan n
    mkApiPlan :: NonEmpty (ApiCoinSelection n) -> ApiWalletMigrationPlan n
mkApiPlan NonEmpty (ApiCoinSelection n)
selections = ApiWalletMigrationPlan :: forall (n :: NetworkDiscriminant).
NonEmpty (ApiCoinSelection n)
-> Quantity "lovelace" Natural
-> ApiWalletMigrationBalance
-> ApiWalletMigrationBalance
-> ApiWalletMigrationPlan n
ApiWalletMigrationPlan
        { NonEmpty (ApiCoinSelection n)
$sel:selections:ApiWalletMigrationPlan :: NonEmpty (ApiCoinSelection n)
selections :: NonEmpty (ApiCoinSelection n)
selections
        , Quantity "lovelace" Natural
$sel:totalFee:ApiWalletMigrationPlan :: Quantity "lovelace" Natural
totalFee :: Quantity "lovelace" Natural
totalFee
        , ApiWalletMigrationBalance
$sel:balanceLeftover:ApiWalletMigrationPlan :: ApiWalletMigrationBalance
balanceLeftover :: ApiWalletMigrationBalance
balanceLeftover
        , ApiWalletMigrationBalance
$sel:balanceSelected:ApiWalletMigrationPlan :: ApiWalletMigrationBalance
balanceSelected :: ApiWalletMigrationBalance
balanceSelected
        }

    maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n))
    maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n))
maybeSelections = (UnsignedTx
   (TxIn, TxOut, NonEmpty DerivationIndex)
   TxOut
   (TxChange (NonEmpty DerivationIndex))
   (RewardAccount, Coin, NonEmpty DerivationIndex)
 -> ApiCoinSelection n)
-> NonEmpty
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
-> NonEmpty (ApiCoinSelection n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant).
UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
mkApiCoinSelectionForMigration (NonEmpty
   (UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
 -> NonEmpty (ApiCoinSelection n))
-> Maybe
     (NonEmpty
        (UnsignedTx
           (TxIn, TxOut, NonEmpty DerivationIndex)
           TxOut
           (TxChange (NonEmpty DerivationIndex))
           (RewardAccount, Coin, NonEmpty DerivationIndex)))
-> Maybe (NonEmpty (ApiCoinSelection n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (NonEmpty
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex)))
maybeUnsignedTxs

    maybeSelectionWithdrawals
        :: Maybe (NonEmpty (W.SelectionWithoutChange, Withdrawal))
    maybeSelectionWithdrawals :: Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
maybeSelectionWithdrawals
        = MigrationPlan
-> Withdrawal
-> NonEmpty Address
-> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
W.migrationPlanToSelectionWithdrawals MigrationPlan
plan Withdrawal
rewardWithdrawal
        (NonEmpty Address
 -> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal)))
-> NonEmpty Address
-> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
forall a b. (a -> b) -> a -> b
$ ApiT Address -> Address
forall a. ApiT a -> a
getApiT (ApiT Address -> Address)
-> ((ApiT Address, Proxy n) -> ApiT Address)
-> (ApiT Address, Proxy n)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiT Address, Proxy n) -> ApiT Address
forall a b. (a, b) -> a
fst ((ApiT Address, Proxy n) -> Address)
-> NonEmpty (ApiT Address, Proxy n) -> NonEmpty Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ApiT Address, Proxy n)
addresses

    maybeUnsignedTxs :: Maybe
  (NonEmpty
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex)))
maybeUnsignedTxs = ((SelectionWithoutChange, Withdrawal)
 -> UnsignedTx
      (TxIn, TxOut, NonEmpty DerivationIndex)
      TxOut
      (TxChange (NonEmpty DerivationIndex))
      (RewardAccount, Coin, NonEmpty DerivationIndex))
-> NonEmpty (SelectionWithoutChange, Withdrawal)
-> NonEmpty
     (UnsignedTx
        (TxIn, TxOut, NonEmpty DerivationIndex)
        TxOut
        (TxChange (NonEmpty DerivationIndex))
        (RewardAccount, Coin, NonEmpty DerivationIndex))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SelectionWithoutChange, Withdrawal)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
mkUnsignedTx (NonEmpty (SelectionWithoutChange, Withdrawal)
 -> NonEmpty
      (UnsignedTx
         (TxIn, TxOut, NonEmpty DerivationIndex)
         TxOut
         (TxChange (NonEmpty DerivationIndex))
         (RewardAccount, Coin, NonEmpty DerivationIndex)))
-> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
-> Maybe
     (NonEmpty
        (UnsignedTx
           (TxIn, TxOut, NonEmpty DerivationIndex)
           TxOut
           (TxChange (NonEmpty DerivationIndex))
           (RewardAccount, Coin, NonEmpty DerivationIndex)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
maybeSelectionWithdrawals
      where
        mkUnsignedTx :: (SelectionWithoutChange, Withdrawal)
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
mkUnsignedTx (SelectionWithoutChange
selection, Withdrawal
withdrawal) = Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
forall s input output change withdrawal.
(IsOurs s Address, input ~ (TxIn, TxOut, NonEmpty DerivationIndex),
 output ~ TxOut, change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
Withdrawal
-> SelectionOf TxOut
-> s
-> UnsignedTx input output change withdrawal
W.selectionToUnsignedTx
            Withdrawal
withdrawal (SelectionWithoutChange
selection {$sel:change:Selection :: [TxOut]
change = []}) s
s

    totalFee :: Quantity "lovelace" Natural
    totalFee :: Quantity "lovelace" Natural
totalFee = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ ((Coin -> Const Coin Coin)
 -> MigrationPlan -> Const Coin MigrationPlan)
-> MigrationPlan -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "totalFee"
  ((Coin -> Const Coin Coin)
   -> MigrationPlan -> Const Coin MigrationPlan)
(Coin -> Const Coin Coin)
-> MigrationPlan -> Const Coin MigrationPlan
#totalFee MigrationPlan
plan

    balanceLeftover :: ApiWalletMigrationBalance
    balanceLeftover :: ApiWalletMigrationBalance
balanceLeftover = MigrationPlan
plan
        MigrationPlan -> (MigrationPlan -> UTxO) -> UTxO
forall a b. a -> (a -> b) -> b
& ((UTxO -> Const UTxO UTxO)
 -> MigrationPlan -> Const UTxO MigrationPlan)
-> MigrationPlan -> UTxO
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "unselected"
  ((UTxO -> Const UTxO UTxO)
   -> MigrationPlan -> Const UTxO MigrationPlan)
(UTxO -> Const UTxO UTxO)
-> MigrationPlan -> Const UTxO MigrationPlan
#unselected
        UTxO -> (UTxO -> TokenBundle) -> TokenBundle
forall a b. a -> (a -> b) -> b
& UTxO -> TokenBundle
UTxO.balance
        TokenBundle
-> (TokenBundle -> ApiWalletMigrationBalance)
-> ApiWalletMigrationBalance
forall a b. a -> (a -> b) -> b
& TokenBundle -> ApiWalletMigrationBalance
mkApiWalletMigrationBalance

    balanceSelected :: ApiWalletMigrationBalance
    balanceSelected :: ApiWalletMigrationBalance
balanceSelected = TokenBundle -> ApiWalletMigrationBalance
mkApiWalletMigrationBalance (TokenBundle -> ApiWalletMigrationBalance)
-> TokenBundle -> ApiWalletMigrationBalance
forall a b. (a -> b) -> a -> b
$
        Coin -> TokenBundle
TokenBundle.fromCoin Coin
balanceRewardWithdrawal TokenBundle -> TokenBundle -> TokenBundle
forall a. Semigroup a => a -> a -> a
<> TokenBundle
balanceUTxO
      where
        balanceUTxO :: TokenBundle
balanceUTxO = MigrationPlan
plan
            MigrationPlan
-> (MigrationPlan -> [Selection (TxIn, TxOut)])
-> [Selection (TxIn, TxOut)]
forall a b. a -> (a -> b) -> b
& (([Selection (TxIn, TxOut)]
  -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
 -> MigrationPlan -> Const [Selection (TxIn, TxOut)] MigrationPlan)
-> MigrationPlan -> [Selection (TxIn, TxOut)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "selections"
  (([Selection (TxIn, TxOut)]
    -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
   -> MigrationPlan -> Const [Selection (TxIn, TxOut)] MigrationPlan)
([Selection (TxIn, TxOut)]
 -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
-> MigrationPlan -> Const [Selection (TxIn, TxOut)] MigrationPlan
#selections
            [Selection (TxIn, TxOut)]
-> ([Selection (TxIn, TxOut)] -> TokenBundle) -> TokenBundle
forall a b. a -> (a -> b) -> b
& (Selection (TxIn, TxOut) -> TokenBundle)
-> [Selection (TxIn, TxOut)] -> TokenBundle
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (((TokenBundle -> Const TokenBundle TokenBundle)
 -> Selection (TxIn, TxOut)
 -> Const TokenBundle (Selection (TxIn, TxOut)))
-> Selection (TxIn, TxOut) -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputBalance"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> Selection (TxIn, TxOut)
   -> Const TokenBundle (Selection (TxIn, TxOut)))
(TokenBundle -> Const TokenBundle TokenBundle)
-> Selection (TxIn, TxOut)
-> Const TokenBundle (Selection (TxIn, TxOut))
#inputBalance)
        balanceRewardWithdrawal :: Coin
balanceRewardWithdrawal = MigrationPlan
plan
            MigrationPlan
-> (MigrationPlan -> [Selection (TxIn, TxOut)])
-> [Selection (TxIn, TxOut)]
forall a b. a -> (a -> b) -> b
& (([Selection (TxIn, TxOut)]
  -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
 -> MigrationPlan -> Const [Selection (TxIn, TxOut)] MigrationPlan)
-> MigrationPlan -> [Selection (TxIn, TxOut)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "selections"
  (([Selection (TxIn, TxOut)]
    -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
   -> MigrationPlan -> Const [Selection (TxIn, TxOut)] MigrationPlan)
([Selection (TxIn, TxOut)]
 -> Const [Selection (TxIn, TxOut)] [Selection (TxIn, TxOut)])
-> MigrationPlan -> Const [Selection (TxIn, TxOut)] MigrationPlan
#selections
            [Selection (TxIn, TxOut)]
-> ([Selection (TxIn, TxOut)] -> Coin) -> Coin
forall a b. a -> (a -> b) -> b
& (Selection (TxIn, TxOut) -> Coin)
-> [Selection (TxIn, TxOut)] -> Coin
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (((Coin -> Const Coin Coin)
 -> Selection (TxIn, TxOut) -> Const Coin (Selection (TxIn, TxOut)))
-> Selection (TxIn, TxOut) -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "rewardWithdrawal"
  ((Coin -> Const Coin Coin)
   -> Selection (TxIn, TxOut) -> Const Coin (Selection (TxIn, TxOut)))
(Coin -> Const Coin Coin)
-> Selection (TxIn, TxOut) -> Const Coin (Selection (TxIn, TxOut))
#rewardWithdrawal)

    mkApiCoinSelectionForMigration :: UnsignedTx
  (TxIn, TxOut, NonEmpty DerivationIndex)
  TxOut
  (TxChange (NonEmpty DerivationIndex))
  (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
mkApiCoinSelectionForMigration = [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx
     (TxIn, TxOut, NonEmpty DerivationIndex)
     TxOut
     (TxChange (NonEmpty DerivationIndex))
     (RewardAccount, Coin, NonEmpty DerivationIndex)
-> ApiCoinSelection n
forall (n :: NetworkDiscriminant) input output change withdrawal.
(input ~ (TxIn, TxOut, NonEmpty DerivationIndex), output ~ TxOut,
 change ~ TxChange (NonEmpty DerivationIndex),
 withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)) =>
[Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection [] [] Maybe (DelegationAction, NonEmpty DerivationIndex)
forall a. Maybe a
Nothing Maybe TxMetadata
forall a. Maybe a
Nothing

    mkApiWalletMigrationBalance :: TokenBundle -> ApiWalletMigrationBalance
    mkApiWalletMigrationBalance :: TokenBundle -> ApiWalletMigrationBalance
mkApiWalletMigrationBalance TokenBundle
b = ApiWalletMigrationBalance :: Quantity "lovelace" Natural
-> ApiT TokenMap -> ApiWalletMigrationBalance
ApiWalletMigrationBalance
        { $sel:ada:ApiWalletMigrationBalance :: Quantity "lovelace" Natural
ada = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ ((Coin -> Const Coin Coin)
 -> TokenBundle -> Const Coin TokenBundle)
-> TokenBundle -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "coin"
  ((Coin -> Const Coin Coin)
   -> TokenBundle -> Const Coin TokenBundle)
(Coin -> Const Coin Coin) -> TokenBundle -> Const Coin TokenBundle
#coin TokenBundle
b
        , $sel:assets:ApiWalletMigrationBalance :: ApiT TokenMap
assets = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenMap -> ApiT TokenMap) -> TokenMap -> ApiT TokenMap
forall a b. (a -> b) -> a -> b
$ ((TokenMap -> Const TokenMap TokenMap)
 -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenBundle -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens TokenBundle
b
        }

migrateWallet
    :: forall ctx s k n p.
        ( ctx ~ ApiLayer s k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , HardDerivation k
        , HasNetworkLayer IO ctx
        , IsOwned s k
        , Typeable n
        , Typeable s
        , WalletKey k
        )
    => ctx
    -> Maybe ApiWithdrawalPostData
        -- ^ What type of reward withdrawal to attempt
    -> ApiT WalletId
    -> ApiWalletMigrationPostData n p
    -> Handler (NonEmpty (ApiTransaction n))
migrateWallet :: ctx
-> Maybe ApiWithdrawalPostData
-> ApiT WalletId
-> ApiWalletMigrationPostData n p
-> Handler (NonEmpty (ApiTransaction n))
migrateWallet ctx
ctx Maybe ApiWithdrawalPostData
withdrawalType (ApiT WalletId
wid) ApiWalletMigrationPostData n p
postData = do
    -- FIXME [ADP-1489] mkRewardAccountBuilder does itself read
    -- @currentNodeEra@ which is not guaranteed with the era read here. This
    -- could cause problems under exceptional circumstances.
    (Withdrawal
rewardWithdrawal, RewardAccountBuilder k
mkRewardAccount) <-
        ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(ctx ~ ApiLayer s k, shelley ~ SeqState n ShelleyKey,
 HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK),
 WalletKey k, Typeable s, Typeable n) =>
ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder @_ @s @_ @n ctx
ctx WalletId
wid Maybe ApiWithdrawalPostData
withdrawalType
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler (NonEmpty (ApiTransaction n)))
-> (ErrWalletNotResponding
    -> Handler (NonEmpty (ApiTransaction n)))
-> (WorkerCtx ctx -> Handler (NonEmpty (ApiTransaction n)))
-> Handler (NonEmpty (ApiTransaction n))
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (NonEmpty (ApiTransaction n))
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler (NonEmpty (ApiTransaction n))
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (NonEmpty (ApiTransaction n)))
 -> Handler (NonEmpty (ApiTransaction n)))
-> (WorkerCtx ctx -> Handler (NonEmpty (ApiTransaction n)))
-> Handler (NonEmpty (ApiTransaction n))
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        MigrationPlan
plan <- ExceptT ErrCreateMigrationPlan IO MigrationPlan
-> Handler MigrationPlan
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrCreateMigrationPlan IO MigrationPlan
 -> Handler MigrationPlan)
-> ExceptT ErrCreateMigrationPlan IO MigrationPlan
-> Handler MigrationPlan
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> AnyCardanoEra
-> WalletId
-> Withdrawal
-> ExceptT ErrCreateMigrationPlan IO MigrationPlan
forall ctx (k :: Depth -> * -> *) s.
(HasDBLayer IO s k ctx, HasNetworkLayer IO ctx,
 HasTransactionLayer k ctx) =>
ctx
-> AnyCardanoEra
-> WalletId
-> Withdrawal
-> ExceptT ErrCreateMigrationPlan IO MigrationPlan
W.createMigrationPlan WalletLayer IO s k
WorkerCtx ctx
wrk AnyCardanoEra
era WalletId
wid Withdrawal
rewardWithdrawal
        SlotNo
ttl <- IO SlotNo -> Handler SlotNo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlotNo -> Handler SlotNo) -> IO SlotNo -> Handler SlotNo
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Maybe NominalDiffTime -> IO SlotNo
W.getTxExpiry TimeInterpreter (ExceptT PastHorizonException IO)
ti Maybe NominalDiffTime
forall a. Maybe a
Nothing
        ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        NonEmpty (SelectionWithoutChange, Withdrawal)
selectionWithdrawals <- ExceptT
  ErrCreateMigrationPlan
  IO
  (NonEmpty (SelectionWithoutChange, Withdrawal))
-> Handler (NonEmpty (SelectionWithoutChange, Withdrawal))
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler
            (ExceptT
   ErrCreateMigrationPlan
   IO
   (NonEmpty (SelectionWithoutChange, Withdrawal))
 -> Handler (NonEmpty (SelectionWithoutChange, Withdrawal)))
-> ExceptT
     ErrCreateMigrationPlan
     IO
     (NonEmpty (SelectionWithoutChange, Withdrawal))
-> Handler (NonEmpty (SelectionWithoutChange, Withdrawal))
forall a b. (a -> b) -> a -> b
$ ErrCreateMigrationPlan
-> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
-> ExceptT
     ErrCreateMigrationPlan
     IO
     (NonEmpty (SelectionWithoutChange, Withdrawal))
forall (m :: * -> *) e a.
Applicative m =>
e -> Maybe a -> ExceptT e m a
failWith ErrCreateMigrationPlan
ErrCreateMigrationPlanEmpty
            (Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
 -> ExceptT
      ErrCreateMigrationPlan
      IO
      (NonEmpty (SelectionWithoutChange, Withdrawal)))
-> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
-> ExceptT
     ErrCreateMigrationPlan
     IO
     (NonEmpty (SelectionWithoutChange, Withdrawal))
forall a b. (a -> b) -> a -> b
$ MigrationPlan
-> Withdrawal
-> NonEmpty Address
-> Maybe (NonEmpty (SelectionWithoutChange, Withdrawal))
W.migrationPlanToSelectionWithdrawals
                MigrationPlan
plan Withdrawal
rewardWithdrawal NonEmpty Address
addresses
        NonEmpty (SelectionWithoutChange, Withdrawal)
-> ((SelectionWithoutChange, Withdrawal)
    -> Handler (ApiTransaction n))
-> Handler (NonEmpty (ApiTransaction n))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (SelectionWithoutChange, Withdrawal)
selectionWithdrawals (((SelectionWithoutChange, Withdrawal)
  -> Handler (ApiTransaction n))
 -> Handler (NonEmpty (ApiTransaction n)))
-> ((SelectionWithoutChange, Withdrawal)
    -> Handler (ApiTransaction n))
-> Handler (NonEmpty (ApiTransaction n))
forall a b. (a -> b) -> a -> b
$ \(SelectionWithoutChange
selection, Withdrawal
txWithdrawal) -> do
            let txContext :: TransactionCtx
txContext = TransactionCtx
defaultTransactionCtx
                    { Withdrawal
txWithdrawal :: Withdrawal
$sel:txWithdrawal:TransactionCtx :: Withdrawal
txWithdrawal
                    , $sel:txValidityInterval:TransactionCtx :: (Maybe SlotNo, SlotNo)
txValidityInterval = (Maybe SlotNo
forall a. Maybe a
Nothing, SlotNo
ttl)
                    , $sel:txDelegationAction:TransactionCtx :: Maybe DelegationAction
txDelegationAction = Maybe DelegationAction
forall a. Maybe a
Nothing
                    }
            (Tx
tx, TxMeta
txMeta, UTCTime
txTime, SealedTx
sealedTx) <- ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
 -> Handler (Tx, TxMeta, UTCTime, SealedTx))
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
-> Handler (Tx, TxMeta, UTCTime, SealedTx)
forall a b. (a -> b) -> a -> b
$
                WalletLayer IO s k
-> WalletId
-> AnyCardanoEra
-> RewardAccountBuilder k
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
forall ctx s (k :: Depth -> * -> *).
(HasTransactionLayer k ctx, HasDBLayer IO s k ctx,
 HasNetworkLayer IO ctx, IsOwned s k) =>
ctx
-> WalletId
-> AnyCardanoEra
-> ((k 'RootK XPrv, Passphrase "encryption")
    -> (XPrv, Passphrase "encryption"))
-> Passphrase "user"
-> TransactionCtx
-> SelectionOf TxOut
-> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx)
W.buildAndSignTransaction @_ @s @k
                    WalletLayer IO s k
WorkerCtx ctx
wrk
                    WalletId
wid
                    AnyCardanoEra
era
                    RewardAccountBuilder k
mkRewardAccount
                    Passphrase "user"
pwd
                    TransactionCtx
txContext (SelectionWithoutChange
selection {$sel:change:Selection :: [TxOut]
change = []})
            ExceptT ErrSubmitTx IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSubmitTx IO () -> Handler ())
-> ExceptT ErrSubmitTx IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$
                WalletLayer IO s k
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
forall ctx s (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasDBLayer IO s k ctx,
 HasLogger IO WalletWorkerLog ctx) =>
ctx
-> WalletId -> (Tx, TxMeta, SealedTx) -> ExceptT ErrSubmitTx IO ()
W.submitTx @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid (Tx
tx, TxMeta
txMeta, SealedTx
sealedTx)
            IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ApiTransaction n) -> Handler (ApiTransaction n))
-> IO (ApiTransaction n) -> Handler (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
forall (n :: NetworkDiscriminant).
TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
mkApiTransaction
                (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer))
                (IsLabel
  "pendingSince"
  ((Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
   -> ApiTransaction n -> f (ApiTransaction n))
(Maybe ApiBlockReference -> f (Maybe ApiBlockReference))
-> ApiTransaction n -> f (ApiTransaction n)
#pendingSince)
                MkApiTransactionParams :: Hash "Tx"
-> Maybe Coin
-> [(TxIn, Maybe TxOut)]
-> [(TxIn, Maybe TxOut)]
-> [TxOut]
-> Maybe TxOut
-> Map RewardAccount Coin
-> TxMeta
-> Maybe TxMetadata
-> UTCTime
-> Maybe TxScriptValidity
-> Coin
-> TxMetadataSchema
-> MkApiTransactionParams
MkApiTransactionParams
                    { $sel:txId:MkApiTransactionParams :: Hash "Tx"
txId = Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId
                    , $sel:txFee:MkApiTransactionParams :: Maybe Coin
txFee = Tx
tx Tx
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> Tx -> Const (Maybe Coin) Tx)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "fee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> Tx -> Const (Maybe Coin) Tx)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> Tx -> Const (Maybe Coin) Tx
#fee
                    , $sel:txInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txInputs =
                        NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)])
-> NonEmpty (TxIn, Maybe TxOut) -> [(TxIn, Maybe TxOut)]
forall a b. (a -> b) -> a -> b
$ (TxOut -> Maybe TxOut) -> (TxIn, TxOut) -> (TxIn, Maybe TxOut)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just ((TxIn, TxOut) -> (TxIn, Maybe TxOut))
-> NonEmpty (TxIn, TxOut) -> NonEmpty (TxIn, Maybe TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SelectionWithoutChange
selection SelectionWithoutChange
-> ((NonEmpty (TxIn, TxOut)
     -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
    -> SelectionWithoutChange
    -> Const (NonEmpty (TxIn, TxOut)) SelectionWithoutChange)
-> NonEmpty (TxIn, TxOut)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "inputs"
  ((NonEmpty (TxIn, TxOut)
    -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
   -> SelectionWithoutChange
   -> Const (NonEmpty (TxIn, TxOut)) SelectionWithoutChange)
(NonEmpty (TxIn, TxOut)
 -> Const (NonEmpty (TxIn, TxOut)) (NonEmpty (TxIn, TxOut)))
-> SelectionWithoutChange
-> Const (NonEmpty (TxIn, TxOut)) SelectionWithoutChange
#inputs
                      -- Migrations never require collateral:
                    , $sel:txCollateralInputs:MkApiTransactionParams :: [(TxIn, Maybe TxOut)]
txCollateralInputs = []
                    , $sel:txOutputs:MkApiTransactionParams :: [TxOut]
txOutputs = Tx
tx Tx
-> (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "outputs"
  (([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx)
([TxOut] -> Const [TxOut] [TxOut]) -> Tx -> Const [TxOut] Tx
#outputs
                    , $sel:txCollateralOutput:MkApiTransactionParams :: Maybe TxOut
txCollateralOutput = Tx
tx Tx
-> ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
    -> Tx -> Const (Maybe TxOut) Tx)
-> Maybe TxOut
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "collateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> Tx -> Const (Maybe TxOut) Tx)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> Tx -> Const (Maybe TxOut) Tx
#collateralOutput
                    , $sel:txWithdrawals:MkApiTransactionParams :: Map RewardAccount Coin
txWithdrawals = Tx
tx Tx
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> Tx -> Const (Map RewardAccount Coin) Tx)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "withdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> Tx -> Const (Map RewardAccount Coin) Tx)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> Tx -> Const (Map RewardAccount Coin) Tx
#withdrawals
                    , TxMeta
txMeta :: TxMeta
$sel:txMeta:MkApiTransactionParams :: TxMeta
txMeta
                    , $sel:txMetadata:MkApiTransactionParams :: Maybe TxMetadata
txMetadata = Maybe TxMetadata
forall a. Maybe a
Nothing
                    , UTCTime
txTime :: UTCTime
$sel:txTime:MkApiTransactionParams :: UTCTime
txTime
                    , $sel:txScriptValidity:MkApiTransactionParams :: Maybe TxScriptValidity
txScriptValidity = Tx
tx Tx
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> Tx -> Const (Maybe TxScriptValidity) Tx)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "scriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> Tx -> Const (Maybe TxScriptValidity) Tx)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> Tx -> Const (Maybe TxScriptValidity) Tx
#scriptValidity
                    , $sel:txDeposit:MkApiTransactionParams :: Coin
txDeposit = ProtocolParameters -> Coin
W.stakeKeyDeposit ProtocolParameters
pp
                    , $sel:txMetadataSchema:MkApiTransactionParams :: TxMetadataSchema
txMetadataSchema = TxMetadataSchema
TxMetadataDetailedSchema
                    }
  where
    addresses :: NonEmpty Address
addresses = ApiT Address -> Address
forall a. ApiT a -> a
getApiT (ApiT Address -> Address)
-> ((ApiT Address, Proxy n) -> ApiT Address)
-> (ApiT Address, Proxy n)
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApiT Address, Proxy n) -> ApiT Address
forall a b. (a, b) -> a
fst ((ApiT Address, Proxy n) -> Address)
-> NonEmpty (ApiT Address, Proxy n) -> NonEmpty Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((NonEmpty (ApiT Address, Proxy n)
  -> Const
       (NonEmpty (ApiT Address, Proxy n))
       (NonEmpty (ApiT Address, Proxy n)))
 -> ApiWalletMigrationPostData n p
 -> Const
      (NonEmpty (ApiT Address, Proxy n))
      (ApiWalletMigrationPostData n p))
-> ApiWalletMigrationPostData n p
-> NonEmpty (ApiT Address, Proxy n)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "addresses"
  ((NonEmpty (ApiT Address, Proxy n)
    -> Const
         (NonEmpty (ApiT Address, Proxy n))
         (NonEmpty (ApiT Address, Proxy n)))
   -> ApiWalletMigrationPostData n p
   -> Const
        (NonEmpty (ApiT Address, Proxy n))
        (ApiWalletMigrationPostData n p))
(NonEmpty (ApiT Address, Proxy n)
 -> Const
      (NonEmpty (ApiT Address, Proxy n))
      (NonEmpty (ApiT Address, Proxy n)))
-> ApiWalletMigrationPostData n p
-> Const
     (NonEmpty (ApiT Address, Proxy n)) (ApiWalletMigrationPostData n p)
#addresses ApiWalletMigrationPostData n p
postData
    pwd :: Passphrase "user"
pwd = Passphrase p -> Passphrase "user"
coerce (Passphrase p -> Passphrase "user")
-> Passphrase p -> Passphrase "user"
forall a b. (a -> b) -> a -> b
$ ApiT (Passphrase p) -> Passphrase p
forall a. ApiT a -> a
getApiT (ApiT (Passphrase p) -> Passphrase p)
-> ApiT (Passphrase p) -> Passphrase p
forall a b. (a -> b) -> a -> b
$ ApiWalletMigrationPostData n p
postData ApiWalletMigrationPostData n p
-> ((ApiT (Passphrase p)
     -> Const (ApiT (Passphrase p)) (ApiT (Passphrase p)))
    -> ApiWalletMigrationPostData n p
    -> Const (ApiT (Passphrase p)) (ApiWalletMigrationPostData n p))
-> ApiT (Passphrase p)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase p)
    -> Const (ApiT (Passphrase p)) (ApiT (Passphrase p)))
   -> ApiWalletMigrationPostData n p
   -> Const (ApiT (Passphrase p)) (ApiWalletMigrationPostData n p))
(ApiT (Passphrase p)
 -> Const (ApiT (Passphrase p)) (ApiT (Passphrase p)))
-> ApiWalletMigrationPostData n p
-> Const (ApiT (Passphrase p)) (ApiWalletMigrationPostData n p)
#passphrase
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

{-------------------------------------------------------------------------------
                                    Network
-------------------------------------------------------------------------------}

data ErrCurrentEpoch
    = ErrUnableToDetermineCurrentEpoch  -- fixme: unused
    | ErrCurrentEpochPastHorizonException PastHorizonException

getCurrentEpoch
    :: forall ctx s k . (ctx ~ ApiLayer s k)
    => ctx
    -> Handler W.EpochNo
getCurrentEpoch :: ctx -> Handler EpochNo
getCurrentEpoch ctx
ctx = IO (Either PastHorizonException EpochNo)
-> Handler (Either PastHorizonException EpochNo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT PastHorizonException IO EpochNo
-> IO (Either PastHorizonException EpochNo)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (TimeInterpreter (ExceptT PastHorizonException IO)
-> ExceptT PastHorizonException IO EpochNo
forall (m :: * -> *). MonadIO m => TimeInterpreter m -> m EpochNo
currentEpoch TimeInterpreter (ExceptT PastHorizonException IO)
ti)) Handler (Either PastHorizonException EpochNo)
-> (Either PastHorizonException EpochNo -> Handler EpochNo)
-> Handler EpochNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left PastHorizonException
e -> ErrCurrentEpoch -> Handler EpochNo
forall e a. IsServerError e => e -> Handler a
liftE (ErrCurrentEpoch -> Handler EpochNo)
-> ErrCurrentEpoch -> Handler EpochNo
forall a b. (a -> b) -> a -> b
$ PastHorizonException -> ErrCurrentEpoch
ErrCurrentEpochPastHorizonException PastHorizonException
e
    Right EpochNo
x -> EpochNo -> Handler EpochNo
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
x
  where
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
    ti :: TimeInterpreter (ExceptT PastHorizonException IO)
ti = NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter (ctx
ctx ctx
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> ctx -> Const (NetworkLayer IO Block) ctx)
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> ctx -> Const (NetworkLayer IO Block) ctx
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)

getNetworkInformation
    :: HasCallStack
    => NetworkId
    -> NetworkLayer IO Block
    -> ApiWalletMode
    -> Handler ApiNetworkInformation
getNetworkInformation :: NetworkId
-> NetworkLayer IO Block
-> ApiWalletMode
-> Handler ApiNetworkInformation
getNetworkInformation NetworkId
nid
    NetworkLayer
        { SlotNo -> IO SyncProgress
syncProgress :: forall (m :: * -> *) block.
NetworkLayer m block -> SlotNo -> m SyncProgress
syncProgress :: SlotNo -> IO SyncProgress
syncProgress
        , IO BlockHeader
currentNodeTip :: forall (m :: * -> *) block. NetworkLayer m block -> m BlockHeader
currentNodeTip :: IO BlockHeader
currentNodeTip
        , IO AnyCardanoEra
currentNodeEra :: IO AnyCardanoEra
currentNodeEra :: forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
currentNodeEra
        , TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter :: TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter :: forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter
        }
    ApiWalletMode
mode = IO ApiNetworkInformation -> Handler ApiNetworkInformation
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiNetworkInformation -> Handler ApiNetworkInformation)
-> IO ApiNetworkInformation -> Handler ApiNetworkInformation
forall a b. (a -> b) -> a -> b
$ do
        RelativeTime
now <- TimeInterpreter (MaybeT IO) -> IO RelativeTime
forall (m :: * -> *) (n :: * -> *).
MonadIO m =>
TimeInterpreter n -> m RelativeTime
currentRelativeTime TimeInterpreter (MaybeT IO)
ti
        BlockHeader
nodeTip <- IO BlockHeader
currentNodeTip
        AnyCardanoEra
nodeEra <- IO AnyCardanoEra
currentNodeEra
        ApiBlockReference
apiNodeTip <- TimeInterpreter IO -> BlockHeader -> IO ApiBlockReference
forall (m :: * -> *).
Monad m =>
TimeInterpreter m -> BlockHeader -> m ApiBlockReference
makeApiBlockReferenceFromHeader
            (String
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
neverFails String
"node tip is within safe-zone" TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter)
            BlockHeader
nodeTip
        Maybe (ApiSlotReference, ApiEpochInfo)
nowInfo <- MaybeT IO (ApiSlotReference, ApiEpochInfo)
-> IO (Maybe (ApiSlotReference, ApiEpochInfo))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO (ApiSlotReference, ApiEpochInfo)
 -> IO (Maybe (ApiSlotReference, ApiEpochInfo)))
-> MaybeT IO (ApiSlotReference, ApiEpochInfo)
-> IO (Maybe (ApiSlotReference, ApiEpochInfo))
forall a b. (a -> b) -> a -> b
$ RelativeTime -> MaybeT IO (ApiSlotReference, ApiEpochInfo)
networkTipInfo RelativeTime
now
        SyncProgress
progress <- SlotNo -> IO SyncProgress
syncProgress (SlotNo -> IO SyncProgress) -> SlotNo -> IO SyncProgress
forall a b. (a -> b) -> a -> b
$ ((SlotNo -> Const SlotNo SlotNo)
 -> BlockHeader -> Const SlotNo BlockHeader)
-> BlockHeader -> SlotNo
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo)
   -> BlockHeader -> Const SlotNo BlockHeader)
(SlotNo -> Const SlotNo SlotNo)
-> BlockHeader -> Const SlotNo BlockHeader
#slotNo BlockHeader
nodeTip
        ApiNetworkInformation -> IO ApiNetworkInformation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApiNetworkInformation :: ApiT SyncProgress
-> Maybe ApiEpochInfo
-> ApiBlockReference
-> Maybe ApiSlotReference
-> ApiEra
-> ApiNetworkInfo
-> ApiWalletMode
-> ApiNetworkInformation
Api.ApiNetworkInformation
            { $sel:syncProgress:ApiNetworkInformation :: ApiT SyncProgress
Api.syncProgress = SyncProgress -> ApiT SyncProgress
forall a. a -> ApiT a
ApiT SyncProgress
progress
            , $sel:nextEpoch:ApiNetworkInformation :: Maybe ApiEpochInfo
Api.nextEpoch = (ApiSlotReference, ApiEpochInfo) -> ApiEpochInfo
forall a b. (a, b) -> b
snd ((ApiSlotReference, ApiEpochInfo) -> ApiEpochInfo)
-> Maybe (ApiSlotReference, ApiEpochInfo) -> Maybe ApiEpochInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ApiSlotReference, ApiEpochInfo)
nowInfo
            , $sel:nodeTip:ApiNetworkInformation :: ApiBlockReference
Api.nodeTip = ApiBlockReference
apiNodeTip
            , $sel:networkTip:ApiNetworkInformation :: Maybe ApiSlotReference
Api.networkTip = (ApiSlotReference, ApiEpochInfo) -> ApiSlotReference
forall a b. (a, b) -> a
fst ((ApiSlotReference, ApiEpochInfo) -> ApiSlotReference)
-> Maybe (ApiSlotReference, ApiEpochInfo) -> Maybe ApiSlotReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ApiSlotReference, ApiEpochInfo)
nowInfo
            , $sel:nodeEra:ApiNetworkInformation :: ApiEra
Api.nodeEra = AnyCardanoEra -> ApiEra
toApiEra AnyCardanoEra
nodeEra
            , $sel:networkInfo:ApiNetworkInformation :: ApiNetworkInfo
Api.networkInfo =
                Text -> Integer -> ApiNetworkInfo
Api.ApiNetworkInfo
                    ( case NetworkId
nid of
                        NetworkId
Cardano.Mainnet -> Text
"mainnet"
                        Cardano.Testnet NetworkMagic
_ -> Text
"testnet"
                    )
                    (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Word32 -> Integer
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> Word32
unNetworkMagic (NetworkMagic -> Word32) -> NetworkMagic -> Word32
forall a b. (a -> b) -> a -> b
$ NetworkId -> NetworkMagic
toNetworkMagic NetworkId
nid)
            , $sel:walletMode:ApiNetworkInformation :: ApiWalletMode
Api.walletMode = ApiWalletMode
mode
            }
  where
    ti :: TimeInterpreter (MaybeT IO)
    ti :: TimeInterpreter (MaybeT IO)
ti = (forall a. ExceptT PastHorizonException IO a -> MaybeT IO a)
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter (MaybeT IO)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> TimeInterpreter m -> TimeInterpreter n
hoistTimeInterpreter forall a. ExceptT PastHorizonException IO a -> MaybeT IO a
forall (m :: * -> *) e a. Functor m => ExceptT e m a -> MaybeT m a
exceptToMaybeT TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter

    -- (network tip, next epoch)
    -- May be unavailable if the node is still syncing.
    networkTipInfo :: RelativeTime -> MaybeT IO (ApiSlotReference, ApiEpochInfo)
    networkTipInfo :: RelativeTime -> MaybeT IO (ApiSlotReference, ApiEpochInfo)
networkTipInfo RelativeTime
now = do
        SlotNo
networkTipSlot <- TimeInterpreter (MaybeT IO) -> Qry SlotNo -> MaybeT IO SlotNo
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter (MaybeT IO)
ti (Qry SlotNo -> MaybeT IO SlotNo) -> Qry SlotNo -> MaybeT IO SlotNo
forall a b. (a -> b) -> a -> b
$ RelativeTime -> Qry SlotNo
ongoingSlotAt RelativeTime
now
        ApiSlotReference
tip <- TimeInterpreter (MaybeT IO) -> SlotNo -> MaybeT IO ApiSlotReference
forall (m :: * -> *).
Monad m =>
TimeInterpreter m -> SlotNo -> m ApiSlotReference
makeApiSlotReference TimeInterpreter (MaybeT IO)
ti SlotNo
networkTipSlot
        let curEpoch :: EpochNo
curEpoch = ApiSlotReference
tip ApiSlotReference
-> ((EpochNo -> Const EpochNo EpochNo)
    -> ApiSlotReference -> Const EpochNo ApiSlotReference)
-> EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "slotId"
  ((ApiSlotId -> Const EpochNo ApiSlotId)
   -> ApiSlotReference -> Const EpochNo ApiSlotReference)
(ApiSlotId -> Const EpochNo ApiSlotId)
-> ApiSlotReference -> Const EpochNo ApiSlotReference
#slotId ((ApiSlotId -> Const EpochNo ApiSlotId)
 -> ApiSlotReference -> Const EpochNo ApiSlotReference)
-> ((EpochNo -> Const EpochNo EpochNo)
    -> ApiSlotId -> Const EpochNo ApiSlotId)
-> (EpochNo -> Const EpochNo EpochNo)
-> ApiSlotReference
-> Const EpochNo ApiSlotReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "epochNumber"
  ((ApiT EpochNo -> Const EpochNo (ApiT EpochNo))
   -> ApiSlotId -> Const EpochNo ApiSlotId)
(ApiT EpochNo -> Const EpochNo (ApiT EpochNo))
-> ApiSlotId -> Const EpochNo ApiSlotId
#epochNumber ((ApiT EpochNo -> Const EpochNo (ApiT EpochNo))
 -> ApiSlotId -> Const EpochNo ApiSlotId)
-> ((EpochNo -> Const EpochNo EpochNo)
    -> ApiT EpochNo -> Const EpochNo (ApiT EpochNo))
-> (EpochNo -> Const EpochNo EpochNo)
-> ApiSlotId
-> Const EpochNo ApiSlotId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((EpochNo -> Const EpochNo EpochNo)
   -> ApiT EpochNo -> Const EpochNo (ApiT EpochNo))
(EpochNo -> Const EpochNo EpochNo)
-> ApiT EpochNo -> Const EpochNo (ApiT EpochNo)
#getApiT
        (UTCTime
_, UTCTime
nextEpochStart) <- TimeInterpreter (MaybeT IO)
-> Qry (UTCTime, UTCTime) -> MaybeT IO (UTCTime, UTCTime)
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter (MaybeT IO)
ti (Qry (UTCTime, UTCTime) -> MaybeT IO (UTCTime, UTCTime))
-> Qry (UTCTime, UTCTime) -> MaybeT IO (UTCTime, UTCTime)
forall a b. (a -> b) -> a -> b
$ EpochNo -> Qry (UTCTime, UTCTime)
timeOfEpoch EpochNo
curEpoch
        let nextEpoch :: ApiEpochInfo
nextEpoch = ApiT EpochNo -> UTCTime -> ApiEpochInfo
ApiEpochInfo
                (EpochNo -> ApiT EpochNo
forall a. a -> ApiT a
ApiT (EpochNo -> ApiT EpochNo) -> EpochNo -> ApiT EpochNo
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
curEpoch)
                UTCTime
nextEpochStart
        (ApiSlotReference, ApiEpochInfo)
-> MaybeT IO (ApiSlotReference, ApiEpochInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiSlotReference
tip, ApiEpochInfo
nextEpoch)

getNetworkParameters
    :: (Block, NetworkParameters)
    -> NetworkLayer IO Block
    -> TransactionLayer k W.SealedTx
    -> Handler ApiNetworkParameters
getNetworkParameters :: (Block, NetworkParameters)
-> NetworkLayer IO Block
-> TransactionLayer k SealedTx
-> Handler ApiNetworkParameters
getNetworkParameters (Block
_block0, NetworkParameters
genesisNp) NetworkLayer IO Block
nl TransactionLayer k SealedTx
tl = do
    ProtocolParameters
pp <- IO ProtocolParameters -> Handler ProtocolParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProtocolParameters -> Handler ProtocolParameters)
-> IO ProtocolParameters -> Handler ProtocolParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO ProtocolParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m ProtocolParameters
NW.currentProtocolParameters NetworkLayer IO Block
nl
    SlottingParameters
sp <- IO SlottingParameters -> Handler SlottingParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SlottingParameters -> Handler SlottingParameters)
-> IO SlottingParameters -> Handler SlottingParameters
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO SlottingParameters
forall (m :: * -> *) block.
NetworkLayer m block -> m SlottingParameters
NW.currentSlottingParameters NetworkLayer IO Block
nl
    AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra NetworkLayer IO Block
nl
    let np :: NetworkParameters
np = NetworkParameters
genesisNp { $sel:protocolParameters:NetworkParameters :: ProtocolParameters
protocolParameters = ProtocolParameters
pp, $sel:slottingParameters:NetworkParameters :: SlottingParameters
slottingParameters = SlottingParameters
sp }
    let txConstraints :: TxConstraints
txConstraints = TransactionLayer k SealedTx
-> AnyCardanoEra -> ProtocolParameters -> TxConstraints
forall (k :: Depth -> * -> *) tx.
TransactionLayer k tx
-> AnyCardanoEra -> ProtocolParameters -> TxConstraints
constraints TransactionLayer k SealedTx
tl AnyCardanoEra
era ProtocolParameters
pp
    IO ApiNetworkParameters -> Handler ApiNetworkParameters
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiNetworkParameters -> Handler ApiNetworkParameters)
-> IO ApiNetworkParameters -> Handler ApiNetworkParameters
forall a b. (a -> b) -> a -> b
$ NetworkParameters
-> TxConstraints
-> (EpochNo -> IO ApiEpochInfo)
-> IO ApiNetworkParameters
forall (m :: * -> *).
Monad m =>
NetworkParameters
-> TxConstraints
-> (EpochNo -> m ApiEpochInfo)
-> m ApiNetworkParameters
toApiNetworkParameters NetworkParameters
np TxConstraints
txConstraints (TimeInterpreter IO -> Qry ApiEpochInfo -> IO ApiEpochInfo
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter IO
ti (Qry ApiEpochInfo -> IO ApiEpochInfo)
-> (EpochNo -> Qry ApiEpochInfo) -> EpochNo -> IO ApiEpochInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochNo -> Qry ApiEpochInfo
toApiEpochInfo)
  where
    ti :: TimeInterpreter IO
    ti :: TimeInterpreter IO
ti = String
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
neverFails
        String
"PastHorizonException should never happen in getNetworkParameters \
        \because the ledger is being queried for slotting info about its own \
        \tip."
        (NetworkLayer IO Block
-> TimeInterpreter (ExceptT PastHorizonException IO)
forall (m :: * -> *) block.
NetworkLayer m block
-> TimeInterpreter (ExceptT PastHorizonException m)
timeInterpreter NetworkLayer IO Block
nl)

getNetworkClock :: NtpClient -> Bool -> Handler ApiNetworkClock
getNetworkClock :: NtpClient -> Bool -> Handler ApiNetworkClock
getNetworkClock NtpClient
client = IO ApiNetworkClock -> Handler ApiNetworkClock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ApiNetworkClock -> Handler ApiNetworkClock)
-> (Bool -> IO ApiNetworkClock) -> Bool -> Handler ApiNetworkClock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NtpClient -> Bool -> IO ApiNetworkClock
getNtpStatus NtpClient
client

{-------------------------------------------------------------------------------
                               Miscellaneous
-------------------------------------------------------------------------------}

postExternalTransaction
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        )
    => ctx
    -> ApiT W.SealedTx
    -> Handler ApiTxId
postExternalTransaction :: ctx -> ApiT SealedTx -> Handler ApiTxId
postExternalTransaction ctx
ctx (ApiT SealedTx
sealed) = do
    Tx
tx <- ExceptT ErrPostTx IO Tx -> Handler Tx
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrPostTx IO Tx -> Handler Tx)
-> ExceptT ErrPostTx IO Tx -> Handler Tx
forall a b. (a -> b) -> a -> b
$ ctx -> SealedTx -> ExceptT ErrPostTx IO Tx
forall ctx (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasTransactionLayer k ctx,
 HasLogger IO TxSubmitLog ctx) =>
ctx -> SealedTx -> ExceptT ErrPostTx IO Tx
W.submitExternalTx @ctx @k ctx
ctx SealedTx
sealed
    ApiTxId -> Handler ApiTxId
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiTxId -> Handler ApiTxId) -> ApiTxId -> Handler ApiTxId
forall a b. (a -> b) -> a -> b
$ ApiT (Hash "Tx") -> ApiTxId
ApiTxId (Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT (Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId))

signMetadata
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ SeqState n k
        , HardDerivation k
        , AddressIndexDerivationType k ~ 'Soft
        , WalletKey k
        )
    => ctx
    -> ApiT WalletId
    -> ApiT Role
    -> ApiT DerivationIndex
    -> ApiWalletSignData
    -> Handler ByteString
signMetadata :: ctx
-> ApiT WalletId
-> ApiT Role
-> ApiT DerivationIndex
-> ApiWalletSignData
-> Handler ByteString
signMetadata ctx
ctx (ApiT WalletId
wid) (ApiT Role
role_) (ApiT DerivationIndex
ix) ApiWalletSignData
body = do
    let meta :: TxMetadata
meta = ApiWalletSignData
body ApiWalletSignData
-> ((TxMetadata -> Const TxMetadata TxMetadata)
    -> ApiWalletSignData -> Const TxMetadata ApiWalletSignData)
-> TxMetadata
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "metadata"
  ((ApiT TxMetadata -> Const TxMetadata (ApiT TxMetadata))
   -> ApiWalletSignData -> Const TxMetadata ApiWalletSignData)
(ApiT TxMetadata -> Const TxMetadata (ApiT TxMetadata))
-> ApiWalletSignData -> Const TxMetadata ApiWalletSignData
#metadata ((ApiT TxMetadata -> Const TxMetadata (ApiT TxMetadata))
 -> ApiWalletSignData -> Const TxMetadata ApiWalletSignData)
-> ((TxMetadata -> Const TxMetadata TxMetadata)
    -> ApiT TxMetadata -> Const TxMetadata (ApiT TxMetadata))
-> (TxMetadata -> Const TxMetadata TxMetadata)
-> ApiWalletSignData
-> Const TxMetadata ApiWalletSignData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((TxMetadata -> Const TxMetadata TxMetadata)
   -> ApiT TxMetadata -> Const TxMetadata (ApiT TxMetadata))
(TxMetadata -> Const TxMetadata TxMetadata)
-> ApiT TxMetadata -> Const TxMetadata (ApiT TxMetadata)
#getApiT
    let pwd :: Passphrase "lenient"
pwd  = ApiWalletSignData
body ApiWalletSignData
-> ((Passphrase "lenient"
     -> Const (Passphrase "lenient") (Passphrase "lenient"))
    -> ApiWalletSignData
    -> Const (Passphrase "lenient") ApiWalletSignData)
-> Passphrase "lenient"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "lenient")
    -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
   -> ApiWalletSignData
   -> Const (Passphrase "lenient") ApiWalletSignData)
(ApiT (Passphrase "lenient")
 -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
-> ApiWalletSignData
-> Const (Passphrase "lenient") ApiWalletSignData
#passphrase ((ApiT (Passphrase "lenient")
  -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
 -> ApiWalletSignData
 -> Const (Passphrase "lenient") ApiWalletSignData)
-> ((Passphrase "lenient"
     -> Const (Passphrase "lenient") (Passphrase "lenient"))
    -> ApiT (Passphrase "lenient")
    -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
-> (Passphrase "lenient"
    -> Const (Passphrase "lenient") (Passphrase "lenient"))
-> ApiWalletSignData
-> Const (Passphrase "lenient") ApiWalletSignData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "getApiT"
  ((Passphrase "lenient"
    -> Const (Passphrase "lenient") (Passphrase "lenient"))
   -> ApiT (Passphrase "lenient")
   -> Const (Passphrase "lenient") (ApiT (Passphrase "lenient")))
(Passphrase "lenient"
 -> Const (Passphrase "lenient") (Passphrase "lenient"))
-> ApiT (Passphrase "lenient")
-> Const (Passphrase "lenient") (ApiT (Passphrase "lenient"))
#getApiT

    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ByteString)
-> (ErrWalletNotResponding -> Handler ByteString)
-> (WorkerCtx ctx -> Handler ByteString)
-> Handler ByteString
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ByteString
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ByteString
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ByteString) -> Handler ByteString)
-> (WorkerCtx ctx -> Handler ByteString) -> Handler ByteString
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrSignMetadataWith IO ByteString -> Handler ByteString
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSignMetadataWith IO ByteString -> Handler ByteString)
-> ExceptT ErrSignMetadataWith IO ByteString -> Handler ByteString
forall a b. (a -> b) -> a -> b
$ do
        Signature TxMetadata -> ByteString
forall what. Signature what -> ByteString
getSignature (Signature TxMetadata -> ByteString)
-> ExceptT ErrSignMetadataWith IO (Signature TxMetadata)
-> ExceptT ErrSignMetadataWith IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WalletLayer IO (SeqState n k) k
-> WalletId
-> Passphrase "user"
-> (Role, DerivationIndex)
-> TxMetadata
-> ExceptT ErrSignMetadataWith IO (Signature TxMetadata)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant).
(HasDBLayer IO s k ctx, HardDerivation k,
 AddressIndexDerivationType k ~ 'Soft, WalletKey k,
 s ~ SeqState n k) =>
ctx
-> WalletId
-> Passphrase "user"
-> (Role, DerivationIndex)
-> TxMetadata
-> ExceptT ErrSignMetadataWith IO (Signature TxMetadata)
W.signMetadataWith @_ @s @k @n
            WalletLayer IO (SeqState n k) k
WorkerCtx ctx
wrk WalletId
wid (Passphrase "lenient" -> Passphrase "user"
coerce Passphrase "lenient"
pwd) (Role
role_, DerivationIndex
ix) TxMetadata
meta

derivePublicKey
    :: forall ctx s k ver.
        ( ctx ~ ApiLayer s k
        , SoftDerivation k
        , WalletKey k
        , GetAccount s k
        )
    => ctx
    -> ((ByteString, Role) -> VerificationKeyHashing -> ver)
    -> ApiT WalletId
    -> ApiT Role
    -> ApiT DerivationIndex
    -> Maybe Bool
    -> Handler ver
derivePublicKey :: ctx
-> ((ByteString, Role) -> VerificationKeyHashing -> ver)
-> ApiT WalletId
-> ApiT Role
-> ApiT DerivationIndex
-> Maybe Bool
-> Handler ver
derivePublicKey ctx
ctx (ByteString, Role) -> VerificationKeyHashing -> ver
mkVer (ApiT WalletId
wid) (ApiT Role
role_) (ApiT DerivationIndex
ix) Maybe Bool
hashed = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ver)
-> (ErrWalletNotResponding -> Handler ver)
-> (WorkerCtx ctx -> Handler ver)
-> Handler ver
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ver
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ver
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ver) -> Handler ver)
-> (WorkerCtx ctx -> Handler ver) -> Handler ver
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        k 'AddressK XPub
k <- ExceptT ErrDerivePublicKey IO (k 'AddressK XPub)
-> Handler (k 'AddressK XPub)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrDerivePublicKey IO (k 'AddressK XPub)
 -> Handler (k 'AddressK XPub))
-> ExceptT ErrDerivePublicKey IO (k 'AddressK XPub)
-> Handler (k 'AddressK XPub)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> Role
-> DerivationIndex
-> ExceptT ErrDerivePublicKey IO (k 'AddressK XPub)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, SoftDerivation k, GetAccount s k) =>
ctx
-> WalletId
-> Role
-> DerivationIndex
-> ExceptT ErrDerivePublicKey IO (k 'AddressK XPub)
W.derivePublicKey @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid Role
role_ DerivationIndex
ix
        let (ByteString
payload, VerificationKeyHashing
hashing) = Maybe Bool -> XPub -> (ByteString, VerificationKeyHashing)
computeKeyPayload Maybe Bool
hashed (k 'AddressK XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey k 'AddressK XPub
k)
        ver -> Handler ver
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ver -> Handler ver) -> ver -> Handler ver
forall a b. (a -> b) -> a -> b
$ (ByteString, Role) -> VerificationKeyHashing -> ver
mkVer (ByteString
payload, Role
role_) VerificationKeyHashing
hashing

computeKeyPayload :: Maybe Bool -> XPub -> (ByteString, VerificationKeyHashing)
computeKeyPayload :: Maybe Bool -> XPub -> (ByteString, VerificationKeyHashing)
computeKeyPayload Maybe Bool
hashed XPub
k = case VerificationKeyHashing
hashing of
    VerificationKeyHashing
WithoutHashing -> (XPub -> ByteString
xpubPublicKey XPub
k, VerificationKeyHashing
WithoutHashing)
    VerificationKeyHashing
WithHashing -> (ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> ByteString
xpubPublicKey XPub
k, VerificationKeyHashing
WithHashing)
  where
    hashing :: VerificationKeyHashing
hashing = case Maybe Bool
hashed of
        Maybe Bool
Nothing -> VerificationKeyHashing
WithoutHashing
        Just Bool
v -> if Bool
v then VerificationKeyHashing
WithHashing else VerificationKeyHashing
WithoutHashing

postAccountPublicKey
    :: forall ctx s k account.
        ( ctx ~ ApiLayer s k
        , WalletKey k
        , GetPurpose k
        )
    => ctx
    -> (ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account)
    -> ApiT WalletId
    -> ApiT DerivationIndex
    -> ApiPostAccountKeyDataWithPurpose
    -> Handler account
postAccountPublicKey :: ctx
-> (ByteString
    -> KeyFormat -> Index 'Hardened 'PurposeK -> account)
-> ApiT WalletId
-> ApiT DerivationIndex
-> ApiPostAccountKeyDataWithPurpose
-> Handler account
postAccountPublicKey ctx
ctx ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account
mkAccount (ApiT WalletId
wid) (ApiT DerivationIndex
ix) (ApiPostAccountKeyDataWithPurpose (ApiT Passphrase "user"
pwd) KeyFormat
extd Maybe (ApiT DerivationIndex)
purposeM) = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler account)
-> (ErrWalletNotResponding -> Handler account)
-> (WorkerCtx ctx -> Handler account)
-> Handler account
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler account
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler account
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler account) -> Handler account)
-> (WorkerCtx ctx -> Handler account) -> Handler account
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        k 'AccountK XPub
k <- ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-> Handler (k 'AccountK XPub)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
 -> Handler (k 'AccountK XPub))
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-> Handler (k 'AccountK XPub)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> Passphrase "user"
-> DerivationIndex
-> Maybe DerivationIndex
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, WalletKey k, GetPurpose k) =>
ctx
-> WalletId
-> Passphrase "user"
-> DerivationIndex
-> Maybe DerivationIndex
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
W.getAccountPublicKeyAtIndex @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid Passphrase "user"
pwd DerivationIndex
ix (ApiT DerivationIndex -> DerivationIndex
forall a. ApiT a -> a
getApiT (ApiT DerivationIndex -> DerivationIndex)
-> Maybe (ApiT DerivationIndex) -> Maybe DerivationIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ApiT DerivationIndex)
purposeM)
        account -> Handler account
forall (f :: * -> *) a. Applicative f => a -> f a
pure (account -> Handler account) -> account -> Handler account
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account
mkAccount (KeyFormat -> XPub -> ByteString
publicKeyToBytes' KeyFormat
extd (XPub -> ByteString) -> XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ k 'AccountK XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey k 'AccountK XPub
k) KeyFormat
extd Index 'Hardened 'PurposeK
ixPurpose'
  where
    ixPurpose' :: Index 'Hardened 'PurposeK
ixPurpose' =
        Index 'Hardened 'PurposeK
-> (ApiT DerivationIndex -> Index 'Hardened 'PurposeK)
-> Maybe (ApiT DerivationIndex)
-> Index 'Hardened 'PurposeK
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GetPurpose k => Index 'Hardened 'PurposeK
forall (key :: Depth -> * -> *).
GetPurpose key =>
Index 'Hardened 'PurposeK
getPurpose @k) (Word32 -> Index 'Hardened 'PurposeK
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Word32 -> Index 'Hardened 'PurposeK)
-> (ApiT DerivationIndex -> Word32)
-> ApiT DerivationIndex
-> Index 'Hardened 'PurposeK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivationIndex -> Word32
getDerivationIndex (DerivationIndex -> Word32)
-> (ApiT DerivationIndex -> DerivationIndex)
-> ApiT DerivationIndex
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiT DerivationIndex -> DerivationIndex
forall a. ApiT a -> a
getApiT) Maybe (ApiT DerivationIndex)
purposeM

publicKeyToBytes' :: KeyFormat -> XPub -> ByteString
publicKeyToBytes' :: KeyFormat -> XPub -> ByteString
publicKeyToBytes' = \case
    KeyFormat
Extended -> XPub -> ByteString
xpubToBytes
    KeyFormat
NonExtended -> XPub -> ByteString
xpubPublicKey

getAccountPublicKey
    :: forall ctx s k account.
        ( ctx ~ ApiLayer s k
        , GetAccount s k
        , WalletKey k
        , GetPurpose k
        )
    => ctx
    -> (ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account)
    -> ApiT WalletId
    -> Maybe KeyFormat
    -> Handler account
getAccountPublicKey :: ctx
-> (ByteString
    -> KeyFormat -> Index 'Hardened 'PurposeK -> account)
-> ApiT WalletId
-> Maybe KeyFormat
-> Handler account
getAccountPublicKey ctx
ctx ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account
mkAccount (ApiT WalletId
wid) Maybe KeyFormat
extended = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler account)
-> (ErrWalletNotResponding -> Handler account)
-> (WorkerCtx ctx -> Handler account)
-> Handler account
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler account
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler account
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler account) -> Handler account)
-> (WorkerCtx ctx -> Handler account) -> Handler account
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        k 'AccountK XPub
k <- ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-> Handler (k 'AccountK XPub)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
 -> Handler (k 'AccountK XPub))
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-> Handler (k 'AccountK XPub)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
forall ctx s (k :: Depth -> * -> *).
(HasDBLayer IO s k ctx, GetAccount s k) =>
ctx
-> WalletId
-> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
W.readAccountPublicKey @_ @s @k WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        account -> Handler account
forall (f :: * -> *) a. Applicative f => a -> f a
pure (account -> Handler account) -> account -> Handler account
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account
mkAccount (KeyFormat -> XPub -> ByteString
publicKeyToBytes' KeyFormat
extd (XPub -> ByteString) -> XPub -> ByteString
forall a b. (a -> b) -> a -> b
$ k 'AccountK XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey k 'AccountK XPub
k) KeyFormat
extd (GetPurpose k => Index 'Hardened 'PurposeK
forall (key :: Depth -> * -> *).
GetPurpose key =>
Index 'Hardened 'PurposeK
getPurpose @k)
  where
      extd :: KeyFormat
extd = case Maybe KeyFormat
extended of
          Just KeyFormat
Extended -> KeyFormat
Extended
          Maybe KeyFormat
_ -> KeyFormat
NonExtended

getPolicyKey
    :: forall ctx s k (n :: NetworkDiscriminant).
        ( ctx ~ ApiLayer s k
        , Typeable s
        , Typeable n
        )
    => ctx
    -> ApiT WalletId
    -> Maybe Bool
    -> Handler ApiPolicyKey
getPolicyKey :: ctx -> ApiT WalletId -> Maybe Bool -> Handler ApiPolicyKey
getPolicyKey ctx
ctx (ApiT WalletId
wid) Maybe Bool
hashed = do
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ApiPolicyKey)
-> (ErrWalletNotResponding -> Handler ApiPolicyKey)
-> (WorkerCtx ctx -> Handler ApiPolicyKey)
-> Handler ApiPolicyKey
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ApiPolicyKey
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ApiPolicyKey
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ApiPolicyKey) -> Handler ApiPolicyKey)
-> (WorkerCtx ctx -> Handler ApiPolicyKey) -> Handler ApiPolicyKey
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (XPub
k, NonEmpty DerivationIndex
_) <- ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
 -> Handler (XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
W.readPolicyPublicKey @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        ApiPolicyKey -> Handler ApiPolicyKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiPolicyKey -> Handler ApiPolicyKey)
-> ApiPolicyKey -> Handler ApiPolicyKey
forall a b. (a -> b) -> a -> b
$ (ByteString -> VerificationKeyHashing -> ApiPolicyKey)
-> (ByteString, VerificationKeyHashing) -> ApiPolicyKey
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> VerificationKeyHashing -> ApiPolicyKey
ApiPolicyKey (Maybe Bool -> XPub -> (ByteString, VerificationKeyHashing)
computeKeyPayload Maybe Bool
hashed XPub
k)

postPolicyKey
    :: forall ctx s (n :: NetworkDiscriminant).
        ( ctx ~ ApiLayer s ShelleyKey
        , s ~ SeqState n ShelleyKey
        )
    => ctx
    -> ApiT WalletId
    -> Maybe Bool
    -> ApiPostPolicyKeyData
    -> Handler ApiPolicyKey
postPolicyKey :: ctx
-> ApiT WalletId
-> Maybe Bool
-> ApiPostPolicyKeyData
-> Handler ApiPolicyKey
postPolicyKey ctx
ctx (ApiT WalletId
wid) Maybe Bool
hashed ApiPostPolicyKeyData
apiPassphrase =
    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ApiPolicyKey)
-> (ErrWalletNotResponding -> Handler ApiPolicyKey)
-> (WorkerCtx ctx -> Handler ApiPolicyKey)
-> Handler ApiPolicyKey
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @ShelleyKey ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ApiPolicyKey
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ApiPolicyKey
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ApiPolicyKey) -> Handler ApiPolicyKey)
-> (WorkerCtx ctx -> Handler ApiPolicyKey) -> Handler ApiPolicyKey
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        ShelleyKey 'PolicyK XPub
k <- ExceptT ErrWritePolicyPublicKey IO (ShelleyKey 'PolicyK XPub)
-> Handler (ShelleyKey 'PolicyK XPub)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrWritePolicyPublicKey IO (ShelleyKey 'PolicyK XPub)
 -> Handler (ShelleyKey 'PolicyK XPub))
-> ExceptT ErrWritePolicyPublicKey IO (ShelleyKey 'PolicyK XPub)
-> Handler (ShelleyKey 'PolicyK XPub)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n ShelleyKey) ShelleyKey
-> WalletId
-> Passphrase "user"
-> ExceptT ErrWritePolicyPublicKey IO (ShelleyKey 'PolicyK XPub)
forall ctx s (n :: NetworkDiscriminant).
(HasDBLayer IO s ShelleyKey ctx, s ~ SeqState n ShelleyKey) =>
ctx
-> WalletId
-> Passphrase "user"
-> ExceptT ErrWritePolicyPublicKey IO (ShelleyKey 'PolicyK XPub)
W.writePolicyPublicKey @_ @s @n WalletLayer IO (SeqState n ShelleyKey) ShelleyKey
WorkerCtx ctx
wrk WalletId
wid Passphrase "user"
pwd
        ApiPolicyKey -> Handler ApiPolicyKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiPolicyKey -> Handler ApiPolicyKey)
-> ApiPolicyKey -> Handler ApiPolicyKey
forall a b. (a -> b) -> a -> b
$ (ByteString -> VerificationKeyHashing -> ApiPolicyKey)
-> (ByteString, VerificationKeyHashing) -> ApiPolicyKey
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> VerificationKeyHashing -> ApiPolicyKey
ApiPolicyKey (Maybe Bool -> XPub -> (ByteString, VerificationKeyHashing)
computeKeyPayload Maybe Bool
hashed (ShelleyKey 'PolicyK XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey ShelleyKey 'PolicyK XPub
k))
  where
    pwd :: Passphrase "user"
pwd = ApiT (Passphrase "user") -> Passphrase "user"
forall a. ApiT a -> a
getApiT (ApiPostPolicyKeyData
apiPassphrase ApiPostPolicyKeyData
-> ((ApiT (Passphrase "user")
     -> Const (ApiT (Passphrase "user")) (ApiT (Passphrase "user")))
    -> ApiPostPolicyKeyData
    -> Const (ApiT (Passphrase "user")) ApiPostPolicyKeyData)
-> ApiT (Passphrase "user")
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "passphrase"
  ((ApiT (Passphrase "user")
    -> Const (ApiT (Passphrase "user")) (ApiT (Passphrase "user")))
   -> ApiPostPolicyKeyData
   -> Const (ApiT (Passphrase "user")) ApiPostPolicyKeyData)
(ApiT (Passphrase "user")
 -> Const (ApiT (Passphrase "user")) (ApiT (Passphrase "user")))
-> ApiPostPolicyKeyData
-> Const (ApiT (Passphrase "user")) ApiPostPolicyKeyData
#passphrase)

postPolicyId
    :: forall ctx s k (n :: NetworkDiscriminant).
        ( ctx ~ ApiLayer s k
        , WalletKey k
        , Typeable s
        , Typeable n
        )
    => ctx
    -> ApiT WalletId
    -> ApiPostPolicyIdData
    -> Handler ApiPolicyId
postPolicyId :: ctx -> ApiT WalletId -> ApiPostPolicyIdData -> Handler ApiPolicyId
postPolicyId ctx
ctx (ApiT WalletId
wid) ApiPostPolicyIdData
payload = do
    let retrieveAllCosigners :: Script a -> [a]
retrieveAllCosigners = (a -> [a] -> [a]) -> [a] -> Script a -> [a]
forall a b. (a -> b -> b) -> b -> Script a -> b
foldScript (:) []
    let wrongMintingTemplate :: Script Cosigner -> Bool
wrongMintingTemplate Script Cosigner
templ =
            Either ErrValidateScript () -> Bool
forall a b. Either a b -> Bool
isLeft (ValidationLevel -> Script Cosigner -> Either ErrValidateScript ()
validateScriptOfTemplate ValidationLevel
RecommendedValidation Script Cosigner
templ)
            Bool -> Bool -> Bool
|| [Cosigner] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Script Cosigner -> [Cosigner]
forall a. Script a -> [a]
retrieveAllCosigners Script Cosigner
templ) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
            Bool -> Bool -> Bool
|| ((Cosigner -> Bool) -> [Cosigner] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any (Cosigner -> Cosigner -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8 -> Cosigner
Cosigner Word8
0)) (Script Cosigner -> [Cosigner]
forall a. Script a -> [a]
retrieveAllCosigners Script Cosigner
templ)
    Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ( Script Cosigner -> Bool
wrongMintingTemplate Script Cosigner
scriptTempl ) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        ExceptT ErrGetPolicyId IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrGetPolicyId IO () -> Handler ())
-> ExceptT ErrGetPolicyId IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrGetPolicyId -> ExceptT ErrGetPolicyId IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrGetPolicyId
ErrGetPolicyIdWrongMintingBurningTemplate

    ctx
-> WalletId
-> (ErrNoSuchWallet -> Handler ApiPolicyId)
-> (ErrWalletNotResponding -> Handler ApiPolicyId)
-> (WorkerCtx ctx -> Handler ApiPolicyId)
-> Handler ApiPolicyId
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler ApiPolicyId
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding -> Handler ApiPolicyId
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler ApiPolicyId) -> Handler ApiPolicyId)
-> (WorkerCtx ctx -> Handler ApiPolicyId) -> Handler ApiPolicyId
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        (XPub
xpub, NonEmpty DerivationIndex
_) <- ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
 -> Handler (XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
-> Handler (XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadPolicyPublicKey IO (XPub, NonEmpty DerivationIndex)
W.readPolicyPublicKey @_ @s @k @n WalletLayer IO s k
WorkerCtx ctx
wrk WalletId
wid
        ApiPolicyId -> Handler ApiPolicyId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiPolicyId -> Handler ApiPolicyId)
-> ApiPolicyId -> Handler ApiPolicyId
forall a b. (a -> b) -> a -> b
$ ApiT TokenPolicyId -> ApiPolicyId
ApiPolicyId (ApiT TokenPolicyId -> ApiPolicyId)
-> ApiT TokenPolicyId -> ApiPolicyId
forall a b. (a -> b) -> a -> b
$ TokenPolicyId -> ApiT TokenPolicyId
forall a. a -> ApiT a
ApiT (TokenPolicyId -> ApiT TokenPolicyId)
-> TokenPolicyId -> ApiT TokenPolicyId
forall a b. (a -> b) -> a -> b
$
            Script Cosigner -> Map Cosigner XPub -> TokenPolicyId
forall (key :: Depth -> * -> *).
WalletKey key =>
Script Cosigner -> Map Cosigner XPub -> TokenPolicyId
toTokenPolicyId @k Script Cosigner
scriptTempl (Cosigner -> XPub -> Map Cosigner XPub
forall k a. k -> a -> Map k a
Map.singleton (Word8 -> Cosigner
Cosigner Word8
0) XPub
xpub)
  where
    scriptTempl :: Script Cosigner
scriptTempl = ApiT (Script Cosigner) -> Script Cosigner
forall a. ApiT a -> a
getApiT (ApiPostPolicyIdData
payload ApiPostPolicyIdData
-> ((ApiT (Script Cosigner)
     -> Const (ApiT (Script Cosigner)) (ApiT (Script Cosigner)))
    -> ApiPostPolicyIdData
    -> Const (ApiT (Script Cosigner)) ApiPostPolicyIdData)
-> ApiT (Script Cosigner)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "policyScriptTemplate"
  ((ApiT (Script Cosigner)
    -> Const (ApiT (Script Cosigner)) (ApiT (Script Cosigner)))
   -> ApiPostPolicyIdData
   -> Const (ApiT (Script Cosigner)) ApiPostPolicyIdData)
(ApiT (Script Cosigner)
 -> Const (ApiT (Script Cosigner)) (ApiT (Script Cosigner)))
-> ApiPostPolicyIdData
-> Const (ApiT (Script Cosigner)) ApiPostPolicyIdData
#policyScriptTemplate)

{-------------------------------------------------------------------------------
                                  Helpers
-------------------------------------------------------------------------------}

-- | Handler for fetching the 'ArgGenChange' for the 'RndState' (i.e. the root
-- XPrv), necessary to derive new change addresses.
rndStateChange
    :: forall ctx s k n.
        ( ctx ~ ApiLayer s k
        , s ~ RndState n
        , k ~ ByronKey
        )
    => ctx
    -> ApiT WalletId
    -> Passphrase "user"
    -> Handler (ArgGenChange s)
rndStateChange :: ctx
-> ApiT WalletId -> Passphrase "user" -> Handler (ArgGenChange s)
rndStateChange ctx
ctx (ApiT WalletId
wid) Passphrase "user"
pwd =
    ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler (k 'RootK XPrv, Passphrase "encryption"))
-> (ErrWalletNotResponding
    -> Handler (k 'RootK XPrv, Passphrase "encryption"))
-> (WorkerCtx ctx
    -> Handler (k 'RootK XPrv, Passphrase "encryption"))
-> Handler (k 'RootK XPrv, Passphrase "encryption")
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx @_ @s @k ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (k 'RootK XPrv, Passphrase "encryption")
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler (k 'RootK XPrv, Passphrase "encryption")
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx
  -> Handler (k 'RootK XPrv, Passphrase "encryption"))
 -> Handler (k 'RootK XPrv, Passphrase "encryption"))
-> (WorkerCtx ctx
    -> Handler (k 'RootK XPrv, Passphrase "encryption"))
-> Handler (k 'RootK XPrv, Passphrase "encryption")
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> ExceptT ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption")
-> Handler (k 'RootK XPrv, Passphrase "encryption")
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption")
 -> Handler (k 'RootK XPrv, Passphrase "encryption"))
-> ExceptT
     ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption")
-> Handler (k 'RootK XPrv, Passphrase "encryption")
forall a b. (a -> b) -> a -> b
$
        WalletLayer IO (RndState n) ByronKey
-> WalletId
-> Passphrase "user"
-> (ErrWithRootKey -> ErrSignPayment)
-> (k 'RootK XPrv
    -> PassphraseScheme
    -> ExceptT
         ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption"))
-> ExceptT
     ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption")
forall ctx s (k :: Depth -> * -> *) e a.
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> Passphrase "user"
-> (ErrWithRootKey -> e)
-> (k 'RootK XPrv -> PassphraseScheme -> ExceptT e IO a)
-> ExceptT e IO a
W.withRootKey @_ @s @k WalletLayer IO (RndState n) ByronKey
WorkerCtx ctx
wrk WalletId
wid Passphrase "user"
pwd ErrWithRootKey -> ErrSignPayment
ErrSignPaymentWithRootKey ((k 'RootK XPrv
  -> PassphraseScheme
  -> ExceptT
       ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption"))
 -> ExceptT
      ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption"))
-> (k 'RootK XPrv
    -> PassphraseScheme
    -> ExceptT
         ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption"))
-> ExceptT
     ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption")
forall a b. (a -> b) -> a -> b
$ \k 'RootK XPrv
xprv PassphraseScheme
scheme ->
            (k 'RootK XPrv, Passphrase "encryption")
-> ExceptT
     ErrSignPayment IO (k 'RootK XPrv, Passphrase "encryption")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k 'RootK XPrv
xprv, PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
scheme Passphrase "user"
pwd)

type RewardAccountBuilder k
        =  (k 'RootK XPrv, Passphrase "encryption")
        -> (XPrv, Passphrase "encryption")

mkRewardAccountBuilder
    :: forall ctx s k (n :: NetworkDiscriminant) shelley.
        ( ctx ~ ApiLayer s k
        , shelley ~ SeqState n ShelleyKey
        , HardDerivation k
        , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
        , WalletKey k
        , Typeable s
        , Typeable n
        )
    => ctx
    -> WalletId
    -> Maybe ApiWithdrawalPostData
    -> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder :: ctx
-> WalletId
-> Maybe ApiWithdrawalPostData
-> Handler (Withdrawal, RewardAccountBuilder k)
mkRewardAccountBuilder ctx
ctx WalletId
wid Maybe ApiWithdrawalPostData
withdrawal = do
    let selfRewardCredentials :: RewardAccountBuilder k
selfRewardCredentials (k 'RootK XPrv
rootK, Passphrase "encryption"
pwdP) =
            (k 'AddressK XPrv -> XPrv
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey (k 'AddressK XPrv -> XPrv) -> k 'AddressK XPrv -> XPrv
forall a b. (a -> b) -> a -> b
$ Passphrase "encryption" -> k 'RootK XPrv -> k 'AddressK XPrv
forall (k :: Depth -> * -> *).
(HardDerivation k,
 Bounded (Index (AddressIndexDerivationType k) 'AddressK)) =>
Passphrase "encryption" -> k 'RootK XPrv -> k 'AddressK XPrv
deriveRewardAccount @k Passphrase "encryption"
pwdP k 'RootK XPrv
rootK, Passphrase "encryption"
pwdP)

    ctx
-> WalletId
-> (ErrNoSuchWallet
    -> Handler (Withdrawal, RewardAccountBuilder k))
-> (ErrWalletNotResponding
    -> Handler (Withdrawal, RewardAccountBuilder k))
-> (WorkerCtx ctx -> Handler (Withdrawal, RewardAccountBuilder k))
-> Handler (Withdrawal, RewardAccountBuilder k)
forall ctx s (k :: Depth -> * -> *) (m :: * -> *) a.
(HasWorkerRegistry s k ctx, HasDBFactory s k ctx, MonadIO m) =>
ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> Handler (Withdrawal, RewardAccountBuilder k)
forall e a. IsServerError e => e -> Handler a
liftE ErrWalletNotResponding
-> Handler (Withdrawal, RewardAccountBuilder k)
forall e a. IsServerError e => e -> Handler a
liftE ((WorkerCtx ctx -> Handler (Withdrawal, RewardAccountBuilder k))
 -> Handler (Withdrawal, RewardAccountBuilder k))
-> (WorkerCtx ctx -> Handler (Withdrawal, RewardAccountBuilder k))
-> Handler (Withdrawal, RewardAccountBuilder k)
forall a b. (a -> b) -> a -> b
$ \WorkerCtx ctx
wrk -> do
        AnyCardanoEra
era <- IO AnyCardanoEra -> Handler AnyCardanoEra
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnyCardanoEra -> Handler AnyCardanoEra)
-> IO AnyCardanoEra -> Handler AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ NetworkLayer IO Block -> IO AnyCardanoEra
forall (m :: * -> *) block. NetworkLayer m block -> m AnyCardanoEra
NW.currentNodeEra (WalletLayer IO s k
WorkerCtx ctx
wrk WalletLayer IO s k
-> ((NetworkLayer IO Block
     -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
    -> WalletLayer IO s k
    -> Const (NetworkLayer IO Block) (WalletLayer IO s k))
-> NetworkLayer IO Block
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (NetworkLayer IO Block
 -> Const (NetworkLayer IO Block) (NetworkLayer IO Block))
-> WalletLayer IO s k
-> Const (NetworkLayer IO Block) (WalletLayer IO s k)
forall (m :: * -> *) ctx.
HasNetworkLayer m ctx =>
Lens' ctx (NetworkLayer m Block)
networkLayer)
        case (TypeRep s -> TypeRep shelley -> Maybe (s :~: shelley)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (Typeable s => TypeRep s
forall k (a :: k). Typeable a => TypeRep a
typeRep @s) (Typeable shelley => TypeRep shelley
forall k (a :: k). Typeable a => TypeRep a
typeRep @shelley), Maybe ApiWithdrawalPostData
withdrawal) of
            (Maybe (s :~: shelley)
Nothing, Just{}) ->
                ExceptT
  ErrReadRewardAccount IO (Withdrawal, RewardAccountBuilder k)
-> Handler (Withdrawal, RewardAccountBuilder k)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrReadRewardAccount IO (Withdrawal, RewardAccountBuilder k)
 -> Handler (Withdrawal, RewardAccountBuilder k))
-> ExceptT
     ErrReadRewardAccount IO (Withdrawal, RewardAccountBuilder k)
-> Handler (Withdrawal, RewardAccountBuilder k)
forall a b. (a -> b) -> a -> b
$ ErrReadRewardAccount
-> ExceptT
     ErrReadRewardAccount IO (Withdrawal, RewardAccountBuilder k)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrReadRewardAccount
ErrReadRewardAccountNotAShelleyWallet

            (Maybe (s :~: shelley)
_, Maybe ApiWithdrawalPostData
Nothing) ->
                (Withdrawal, RewardAccountBuilder k)
-> Handler (Withdrawal, RewardAccountBuilder k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Withdrawal
NoWithdrawal, RewardAccountBuilder k
selfRewardCredentials)

            (Just s :~: shelley
Refl, Just ApiWithdrawalPostData
SelfWithdrawal) -> do
                (RewardAccount
acct, XPub
_, NonEmpty DerivationIndex
path) <- ExceptT
  ErrReadRewardAccount
  IO
  (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT
   ErrReadRewardAccount
   IO
   (RewardAccount, XPub, NonEmpty DerivationIndex)
 -> Handler (RewardAccount, XPub, NonEmpty DerivationIndex))
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
-> Handler (RewardAccount, XPub, NonEmpty DerivationIndex)
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n ShelleyKey) k
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
forall ctx s (k :: Depth -> * -> *) (n :: NetworkDiscriminant)
       shelley.
(HasDBLayer IO s k ctx, shelley ~ SeqState n ShelleyKey,
 Typeable n, Typeable s) =>
ctx
-> WalletId
-> ExceptT
     ErrReadRewardAccount
     IO
     (RewardAccount, XPub, NonEmpty DerivationIndex)
W.readRewardAccount @_ @s @k @n WalletLayer IO (SeqState n ShelleyKey) k
WorkerCtx ctx
wrk WalletId
wid
                Coin
wdrl <- ExceptT ErrFetchRewards IO Coin -> Handler Coin
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrFetchRewards IO Coin -> Handler Coin)
-> ExceptT ErrFetchRewards IO Coin -> Handler Coin
forall a b. (a -> b) -> a -> b
$ WalletLayer IO (SeqState n ShelleyKey) k
-> RewardAccount -> ExceptT ErrFetchRewards IO Coin
forall ctx.
HasNetworkLayer IO ctx =>
ctx -> RewardAccount -> ExceptT ErrFetchRewards IO Coin
W.queryRewardBalance @_ WalletLayer IO (SeqState n ShelleyKey) k
WorkerCtx ctx
wrk RewardAccount
acct
                (, RewardAccountBuilder k
selfRewardCredentials) (Withdrawal -> (Withdrawal, RewardAccountBuilder k))
-> (Coin -> Withdrawal)
-> Coin
-> (Withdrawal, RewardAccountBuilder k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> NonEmpty DerivationIndex -> Coin -> Withdrawal
WithdrawalSelf RewardAccount
acct NonEmpty DerivationIndex
path
                    (Coin -> (Withdrawal, RewardAccountBuilder k))
-> Handler Coin -> Handler (Withdrawal, RewardAccountBuilder k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Coin -> Handler Coin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WalletLayer IO (SeqState n ShelleyKey) k
-> AnyCardanoEra -> Coin -> IO Coin
forall ctx (k :: Depth -> * -> *).
(HasTransactionLayer k ctx, HasNetworkLayer IO ctx) =>
ctx -> AnyCardanoEra -> Coin -> IO Coin
W.readNextWithdrawal @_ @k WalletLayer IO (SeqState n ShelleyKey) k
WorkerCtx ctx
wrk AnyCardanoEra
era Coin
wdrl)

            (Just s :~: shelley
Refl, Just (ExternalWithdrawal (ApiMnemonicT SomeMnemonic
mw))) -> do
                let (XPrv
xprv, RewardAccount
acct, NonEmpty DerivationIndex
path) = SomeMnemonic -> (XPrv, RewardAccount, NonEmpty DerivationIndex)
forall (k :: Depth -> * -> *).
ToRewardAccount k =>
SomeMnemonic -> (XPrv, RewardAccount, NonEmpty DerivationIndex)
W.someRewardAccount @ShelleyKey SomeMnemonic
mw
                Coin
wdrl <- ExceptT ErrFetchRewards IO Coin -> Handler Coin
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (WalletLayer IO (SeqState n ShelleyKey) k
-> RewardAccount -> ExceptT ErrFetchRewards IO Coin
forall ctx.
HasNetworkLayer IO ctx =>
ctx -> RewardAccount -> ExceptT ErrFetchRewards IO Coin
W.queryRewardBalance @_ WalletLayer IO (SeqState n ShelleyKey) k
WorkerCtx ctx
wrk RewardAccount
acct)
                    Handler Coin -> (Coin -> Handler Coin) -> Handler Coin
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Coin -> Handler Coin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Coin -> Handler Coin)
-> (Coin -> IO Coin) -> Coin -> Handler Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletLayer IO (SeqState n ShelleyKey) k
-> AnyCardanoEra -> Coin -> IO Coin
forall ctx (k :: Depth -> * -> *).
(HasTransactionLayer k ctx, HasNetworkLayer IO ctx) =>
ctx -> AnyCardanoEra -> Coin -> IO Coin
W.readNextWithdrawal @_ @k WalletLayer IO (SeqState n ShelleyKey) k
WorkerCtx ctx
wrk AnyCardanoEra
era
                Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Coin
wdrl Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Natural -> Coin
Coin Natural
0) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$ do
                    ExceptT ErrWithdrawalNotWorth IO () -> Handler ()
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT ErrWithdrawalNotWorth IO () -> Handler ())
-> ExceptT ErrWithdrawalNotWorth IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ErrWithdrawalNotWorth -> ExceptT ErrWithdrawalNotWorth IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrWithdrawalNotWorth
ErrWithdrawalNotWorth
                (Withdrawal, RewardAccountBuilder k)
-> Handler (Withdrawal, RewardAccountBuilder k)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RewardAccount -> NonEmpty DerivationIndex -> Coin -> Withdrawal
WithdrawalExternal RewardAccount
acct NonEmpty DerivationIndex
path Coin
wdrl, (XPrv, Passphrase "encryption") -> RewardAccountBuilder k
forall a b. a -> b -> a
const (XPrv
xprv, Passphrase "encryption"
forall a. Monoid a => a
mempty))

-- | Makes an 'ApiCoinSelection' from the given 'UnsignedTx'.
mkApiCoinSelection
    :: forall n input output change withdrawal.
        ( input ~ (TxIn, TxOut, NonEmpty DerivationIndex)
        , output ~ TxOut
        , change ~ TxChange (NonEmpty DerivationIndex)
        , withdrawal ~ (RewardAccount, Coin, NonEmpty DerivationIndex)
        )
    => [Coin]
    -> [Coin]
    -> Maybe (DelegationAction, NonEmpty DerivationIndex)
    -> Maybe W.TxMetadata
    -> UnsignedTx input output change withdrawal
    -> ApiCoinSelection n
mkApiCoinSelection :: [Coin]
-> [Coin]
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe TxMetadata
-> UnsignedTx input output change withdrawal
-> ApiCoinSelection n
mkApiCoinSelection [Coin]
deps [Coin]
refunds Maybe (DelegationAction, NonEmpty DerivationIndex)
mcerts Maybe TxMetadata
metadata UnsignedTx input output change withdrawal
unsignedTx =
    ApiCoinSelection :: forall (n :: NetworkDiscriminant).
[ApiWalletInput n]
-> [ApiCoinSelectionOutput n]
-> [ApiCoinSelectionChange n]
-> [ApiCoinSelectionCollateral n]
-> [ApiCoinSelectionWithdrawal n]
-> Maybe (NonEmpty ApiCertificate)
-> [Quantity "lovelace" Natural]
-> [Quantity "lovelace" Natural]
-> Maybe ApiBase64
-> ApiCoinSelection n
ApiCoinSelection
        { $sel:inputs:ApiCoinSelection :: [ApiWalletInput n]
inputs = input -> ApiWalletInput n
mkApiCoinSelectionInput
            (input -> ApiWalletInput n) -> [input] -> [ApiWalletInput n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsignedTx input output change withdrawal
unsignedTx UnsignedTx input output change withdrawal
-> (([input] -> Const [input] [input])
    -> UnsignedTx input output change withdrawal
    -> Const [input] (UnsignedTx input output change withdrawal))
-> [input]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "unsignedInputs"
  (([input] -> Const [input] [input])
   -> UnsignedTx input output change withdrawal
   -> Const [input] (UnsignedTx input output change withdrawal))
([input] -> Const [input] [input])
-> UnsignedTx input output change withdrawal
-> Const [input] (UnsignedTx input output change withdrawal)
#unsignedInputs
        , $sel:outputs:ApiCoinSelection :: [ApiCoinSelectionOutput n]
outputs = output -> ApiCoinSelectionOutput n
mkApiCoinSelectionOutput
            (output -> ApiCoinSelectionOutput n)
-> [output] -> [ApiCoinSelectionOutput n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsignedTx input output change withdrawal
unsignedTx UnsignedTx input output change withdrawal
-> (([output] -> Const [output] [output])
    -> UnsignedTx input output change withdrawal
    -> Const [output] (UnsignedTx input output change withdrawal))
-> [output]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "unsignedOutputs"
  (([output] -> Const [output] [output])
   -> UnsignedTx input output change withdrawal
   -> Const [output] (UnsignedTx input output change withdrawal))
([output] -> Const [output] [output])
-> UnsignedTx input output change withdrawal
-> Const [output] (UnsignedTx input output change withdrawal)
#unsignedOutputs
        , $sel:change:ApiCoinSelection :: [ApiCoinSelectionChange n]
change = change -> ApiCoinSelectionChange n
mkApiCoinSelectionChange
            (change -> ApiCoinSelectionChange n)
-> [change] -> [ApiCoinSelectionChange n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsignedTx input output change withdrawal
unsignedTx UnsignedTx input output change withdrawal
-> (([change] -> Const [change] [change])
    -> UnsignedTx input output change withdrawal
    -> Const [change] (UnsignedTx input output change withdrawal))
-> [change]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "unsignedChange"
  (([change] -> Const [change] [change])
   -> UnsignedTx input output change withdrawal
   -> Const [change] (UnsignedTx input output change withdrawal))
([change] -> Const [change] [change])
-> UnsignedTx input output change withdrawal
-> Const [change] (UnsignedTx input output change withdrawal)
#unsignedChange
        , $sel:collateral:ApiCoinSelection :: [ApiCoinSelectionCollateral n]
collateral = input -> ApiCoinSelectionCollateral n
mkApiCoinSelectionCollateral
            (input -> ApiCoinSelectionCollateral n)
-> [input] -> [ApiCoinSelectionCollateral n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsignedTx input output change withdrawal
unsignedTx UnsignedTx input output change withdrawal
-> (([input] -> Const [input] [input])
    -> UnsignedTx input output change withdrawal
    -> Const [input] (UnsignedTx input output change withdrawal))
-> [input]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "unsignedCollateral"
  (([input] -> Const [input] [input])
   -> UnsignedTx input output change withdrawal
   -> Const [input] (UnsignedTx input output change withdrawal))
([input] -> Const [input] [input])
-> UnsignedTx input output change withdrawal
-> Const [input] (UnsignedTx input output change withdrawal)
#unsignedCollateral
        , $sel:withdrawals:ApiCoinSelection :: [ApiCoinSelectionWithdrawal n]
withdrawals = withdrawal -> ApiCoinSelectionWithdrawal n
mkApiCoinSelectionWithdrawal
            (withdrawal -> ApiCoinSelectionWithdrawal n)
-> [withdrawal] -> [ApiCoinSelectionWithdrawal n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnsignedTx input output change withdrawal
unsignedTx UnsignedTx input output change withdrawal
-> (([withdrawal] -> Const [withdrawal] [withdrawal])
    -> UnsignedTx input output change withdrawal
    -> Const [withdrawal] (UnsignedTx input output change withdrawal))
-> [withdrawal]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "unsignedWithdrawals"
  (([withdrawal] -> Const [withdrawal] [withdrawal])
   -> UnsignedTx input output change withdrawal
   -> Const [withdrawal] (UnsignedTx input output change withdrawal))
([withdrawal] -> Const [withdrawal] [withdrawal])
-> UnsignedTx input output change withdrawal
-> Const [withdrawal] (UnsignedTx input output change withdrawal)
#unsignedWithdrawals
        , $sel:certificates:ApiCoinSelection :: Maybe (NonEmpty ApiCertificate)
certificates = (DelegationAction
 -> NonEmpty DerivationIndex -> NonEmpty ApiCertificate)
-> (DelegationAction, NonEmpty DerivationIndex)
-> NonEmpty ApiCertificate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry DelegationAction
-> NonEmpty DerivationIndex -> NonEmpty ApiCertificate
mkCertificates
            ((DelegationAction, NonEmpty DerivationIndex)
 -> NonEmpty ApiCertificate)
-> Maybe (DelegationAction, NonEmpty DerivationIndex)
-> Maybe (NonEmpty ApiCertificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DelegationAction, NonEmpty DerivationIndex)
mcerts
        , $sel:depositsTaken:ApiCoinSelection :: [Quantity "lovelace" Natural]
depositsTaken = Coin -> Quantity "lovelace" Natural
mkApiCoin
            (Coin -> Quantity "lovelace" Natural)
-> [Coin] -> [Quantity "lovelace" Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Coin]
deps
        , $sel:depositsReturned:ApiCoinSelection :: [Quantity "lovelace" Natural]
depositsReturned = Coin -> Quantity "lovelace" Natural
mkApiCoin
            (Coin -> Quantity "lovelace" Natural)
-> [Coin] -> [Quantity "lovelace" Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Coin]
refunds
        , $sel:metadata:ApiCoinSelection :: Maybe ApiBase64
metadata = ByteString -> ApiBase64
forall (base :: Base) bs. bs -> ApiBytesT base bs
ApiBytesT(ByteString -> ApiBase64)
-> (TxMetadata -> ByteString) -> TxMetadata -> ApiBase64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMetadata -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR
            (TxMetadata -> ApiBase64) -> Maybe TxMetadata -> Maybe ApiBase64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxMetadata
metadata
        }
  where
    mkCertificates
        :: DelegationAction
        -> NonEmpty DerivationIndex
        -> NonEmpty Api.ApiCertificate
    mkCertificates :: DelegationAction
-> NonEmpty DerivationIndex -> NonEmpty ApiCertificate
mkCertificates DelegationAction
action NonEmpty DerivationIndex
xs =
        case DelegationAction
action of
            Join PoolId
pid -> [ApiCertificate] -> NonEmpty ApiCertificate
forall a. [a] -> NonEmpty a
NE.fromList
                [ NonEmpty (ApiT DerivationIndex) -> ApiT PoolId -> ApiCertificate
Api.JoinPool NonEmpty (ApiT DerivationIndex)
apiStakePath (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
pid)
                ]

            RegisterKeyAndJoin PoolId
pid -> [ApiCertificate] -> NonEmpty ApiCertificate
forall a. [a] -> NonEmpty a
NE.fromList
                [ NonEmpty (ApiT DerivationIndex) -> ApiCertificate
Api.RegisterRewardAccount NonEmpty (ApiT DerivationIndex)
apiStakePath
                , NonEmpty (ApiT DerivationIndex) -> ApiT PoolId -> ApiCertificate
Api.JoinPool NonEmpty (ApiT DerivationIndex)
apiStakePath (PoolId -> ApiT PoolId
forall a. a -> ApiT a
ApiT PoolId
pid)
                ]

            DelegationAction
Quit -> [ApiCertificate] -> NonEmpty ApiCertificate
forall a. [a] -> NonEmpty a
NE.fromList
                [ NonEmpty (ApiT DerivationIndex) -> ApiCertificate
Api.QuitPool NonEmpty (ApiT DerivationIndex)
apiStakePath
                ]
      where
        apiStakePath :: NonEmpty (ApiT DerivationIndex)
apiStakePath = DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty DerivationIndex
xs

    mkApiCoinSelectionInput :: input -> ApiWalletInput n
    mkApiCoinSelectionInput :: input -> ApiWalletInput n
mkApiCoinSelectionInput
        (TxIn txid index, TxOut addr (TokenBundle amount assets), path) =
        ApiWalletInput :: forall (n :: NetworkDiscriminant).
ApiT (Hash "Tx")
-> Word32
-> (ApiT Address, Proxy n)
-> NonEmpty (ApiT DerivationIndex)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> ApiWalletInput n
ApiWalletInput
            { $sel:id:ApiWalletInput :: ApiT (Hash "Tx")
id = Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
txid
            , $sel:index:ApiWalletInput :: Word32
index = Word32
index
            , $sel:address:ApiWalletInput :: (ApiT Address, Proxy n)
address = (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
            , $sel:amount:ApiWalletInput :: Quantity "lovelace" Natural
amount = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
amount
            , $sel:assets:ApiWalletInput :: ApiT TokenMap
assets = TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
assets
            , $sel:derivationPath:ApiWalletInput :: NonEmpty (ApiT DerivationIndex)
derivationPath = DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty DerivationIndex
path
            }

    mkApiCoinSelectionOutput :: output -> ApiCoinSelectionOutput n
    mkApiCoinSelectionOutput :: output -> ApiCoinSelectionOutput n
mkApiCoinSelectionOutput (TxOut addr (TokenBundle amount assets)) =
        (ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> ApiCoinSelectionOutput n
forall (n :: NetworkDiscriminant).
(ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> ApiCoinSelectionOutput n
ApiCoinSelectionOutput (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
        (Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
amount)
        (TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
assets)

    mkApiCoinSelectionChange :: change -> ApiCoinSelectionChange n
    mkApiCoinSelectionChange :: change -> ApiCoinSelectionChange n
mkApiCoinSelectionChange change
txChange =
        ApiCoinSelectionChange :: forall (n :: NetworkDiscriminant).
(ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> NonEmpty (ApiT DerivationIndex)
-> ApiCoinSelectionChange n
ApiCoinSelectionChange
            { $sel:address:ApiCoinSelectionChange :: (ApiT Address, Proxy n)
address =
                (Address -> ApiT Address
forall a. a -> ApiT a
ApiT (Address -> ApiT Address) -> Address -> ApiT Address
forall a b. (a -> b) -> a -> b
$ ((Address -> Const Address Address)
 -> change -> Const Address change)
-> change -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "address"
  ((Address -> Const Address Address)
   -> change -> Const Address change)
(Address -> Const Address Address)
-> change -> Const Address change
#address change
txChange, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
            , $sel:amount:ApiCoinSelectionChange :: Quantity "lovelace" Natural
amount =
                Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ ((Coin -> Const Coin Coin) -> change -> Const Coin change)
-> change -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "amount" ((Coin -> Const Coin Coin) -> change -> Const Coin change)
(Coin -> Const Coin Coin) -> change -> Const Coin change
#amount change
txChange
            , $sel:assets:ApiCoinSelectionChange :: ApiT TokenMap
assets =
                TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT (TokenMap -> ApiT TokenMap) -> TokenMap -> ApiT TokenMap
forall a b. (a -> b) -> a -> b
$ ((TokenMap -> Const TokenMap TokenMap)
 -> change -> Const TokenMap change)
-> change -> TokenMap
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "assets"
  ((TokenMap -> Const TokenMap TokenMap)
   -> change -> Const TokenMap change)
(TokenMap -> Const TokenMap TokenMap)
-> change -> Const TokenMap change
#assets change
txChange
            , $sel:derivationPath:ApiCoinSelectionChange :: NonEmpty (ApiT DerivationIndex)
derivationPath =
                DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((NonEmpty DerivationIndex
  -> Const (NonEmpty DerivationIndex) (NonEmpty DerivationIndex))
 -> change -> Const (NonEmpty DerivationIndex) change)
-> change -> NonEmpty DerivationIndex
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "derivationPath"
  ((NonEmpty DerivationIndex
    -> Const (NonEmpty DerivationIndex) (NonEmpty DerivationIndex))
   -> change -> Const (NonEmpty DerivationIndex) change)
(NonEmpty DerivationIndex
 -> Const (NonEmpty DerivationIndex) (NonEmpty DerivationIndex))
-> change -> Const (NonEmpty DerivationIndex) change
#derivationPath change
txChange
            }

    mkApiCoinSelectionCollateral :: input -> ApiCoinSelectionCollateral n
    mkApiCoinSelectionCollateral :: input -> ApiCoinSelectionCollateral n
mkApiCoinSelectionCollateral
        (TxIn txid index, TxOut addr (TokenBundle amount _), path) =
        ApiCoinSelectionCollateral :: forall (n :: NetworkDiscriminant).
ApiT (Hash "Tx")
-> Word32
-> (ApiT Address, Proxy n)
-> NonEmpty (ApiT DerivationIndex)
-> Quantity "lovelace" Natural
-> ApiCoinSelectionCollateral n
ApiCoinSelectionCollateral
            { $sel:id:ApiCoinSelectionCollateral :: ApiT (Hash "Tx")
id = Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT Hash "Tx"
txid
            , $sel:index:ApiCoinSelectionCollateral :: Word32
index = Word32
index
            , $sel:address:ApiCoinSelectionCollateral :: (ApiT Address, Proxy n)
address = (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
            , $sel:amount:ApiCoinSelectionCollateral :: Quantity "lovelace" Natural
amount = Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
amount
            , $sel:derivationPath:ApiCoinSelectionCollateral :: NonEmpty (ApiT DerivationIndex)
derivationPath = DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty DerivationIndex
path
            }

    mkApiCoinSelectionWithdrawal :: withdrawal -> ApiCoinSelectionWithdrawal n
    mkApiCoinSelectionWithdrawal :: withdrawal -> ApiCoinSelectionWithdrawal n
mkApiCoinSelectionWithdrawal (rewardAcct, wdrl, path) =
        ApiCoinSelectionWithdrawal :: forall k (n :: k).
(ApiT RewardAccount, Proxy n)
-> NonEmpty (ApiT DerivationIndex)
-> Quantity "lovelace" Natural
-> ApiCoinSelectionWithdrawal n
ApiCoinSelectionWithdrawal
            { $sel:stakeAddress:ApiCoinSelectionWithdrawal :: (ApiT RewardAccount, Proxy n)
stakeAddress =
                (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
rewardAcct, Proxy n
forall k (t :: k). Proxy t
Proxy @n)
            , $sel:amount:ApiCoinSelectionWithdrawal :: Quantity "lovelace" Natural
amount =
                Coin -> Quantity "lovelace" Natural
forall n. Integral n => Coin -> Quantity "lovelace" n
coinToQuantity Coin
wdrl
            , $sel:derivationPath:ApiCoinSelectionWithdrawal :: NonEmpty (ApiT DerivationIndex)
derivationPath =
                DerivationIndex -> ApiT DerivationIndex
forall a. a -> ApiT a
ApiT (DerivationIndex -> ApiT DerivationIndex)
-> NonEmpty DerivationIndex -> NonEmpty (ApiT DerivationIndex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty DerivationIndex
path
            }

data MkApiTransactionParams = MkApiTransactionParams
    { MkApiTransactionParams -> Hash "Tx"
txId :: Hash "Tx"
    , MkApiTransactionParams -> Maybe Coin
txFee :: Maybe Coin
    , MkApiTransactionParams -> [(TxIn, Maybe TxOut)]
txInputs :: [(TxIn, Maybe TxOut)]
    , MkApiTransactionParams -> [(TxIn, Maybe TxOut)]
txCollateralInputs :: [(TxIn, Maybe TxOut)]
    , MkApiTransactionParams -> [TxOut]
txOutputs :: [TxOut]
    , MkApiTransactionParams -> Maybe TxOut
txCollateralOutput :: Maybe TxOut
    , MkApiTransactionParams -> Map RewardAccount Coin
txWithdrawals :: Map RewardAccount Coin
    , MkApiTransactionParams -> TxMeta
txMeta :: W.TxMeta
    , MkApiTransactionParams -> Maybe TxMetadata
txMetadata :: Maybe W.TxMetadata
    , MkApiTransactionParams -> UTCTime
txTime :: UTCTime
    , MkApiTransactionParams -> Maybe TxScriptValidity
txScriptValidity :: Maybe W.TxScriptValidity
    , MkApiTransactionParams -> Coin
txDeposit :: Coin
    , MkApiTransactionParams -> TxMetadataSchema
txMetadataSchema :: TxMetadataSchema
    }
    deriving (MkApiTransactionParams -> MkApiTransactionParams -> Bool
(MkApiTransactionParams -> MkApiTransactionParams -> Bool)
-> (MkApiTransactionParams -> MkApiTransactionParams -> Bool)
-> Eq MkApiTransactionParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MkApiTransactionParams -> MkApiTransactionParams -> Bool
$c/= :: MkApiTransactionParams -> MkApiTransactionParams -> Bool
== :: MkApiTransactionParams -> MkApiTransactionParams -> Bool
$c== :: MkApiTransactionParams -> MkApiTransactionParams -> Bool
Eq, (forall x. MkApiTransactionParams -> Rep MkApiTransactionParams x)
-> (forall x.
    Rep MkApiTransactionParams x -> MkApiTransactionParams)
-> Generic MkApiTransactionParams
forall x. Rep MkApiTransactionParams x -> MkApiTransactionParams
forall x. MkApiTransactionParams -> Rep MkApiTransactionParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MkApiTransactionParams x -> MkApiTransactionParams
$cfrom :: forall x. MkApiTransactionParams -> Rep MkApiTransactionParams x
Generic, Int -> MkApiTransactionParams -> ShowS
[MkApiTransactionParams] -> ShowS
MkApiTransactionParams -> String
(Int -> MkApiTransactionParams -> ShowS)
-> (MkApiTransactionParams -> String)
-> ([MkApiTransactionParams] -> ShowS)
-> Show MkApiTransactionParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MkApiTransactionParams] -> ShowS
$cshowList :: [MkApiTransactionParams] -> ShowS
show :: MkApiTransactionParams -> String
$cshow :: MkApiTransactionParams -> String
showsPrec :: Int -> MkApiTransactionParams -> ShowS
$cshowsPrec :: Int -> MkApiTransactionParams -> ShowS
Show)

mkApiTransaction
    :: forall n. ()
    => TimeInterpreter (ExceptT PastHorizonException IO)
    -> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
    -> MkApiTransactionParams
    -> IO (ApiTransaction n)
mkApiTransaction :: TimeInterpreter (ExceptT PastHorizonException IO)
-> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
-> MkApiTransactionParams
-> IO (ApiTransaction n)
mkApiTransaction TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter Lens' (ApiTransaction n) (Maybe ApiBlockReference)
setTimeReference MkApiTransactionParams
tx = do
    ApiBlockReference
timeRef <- (IsLabel
  "time"
  ((UTCTime -> Identity UTCTime)
   -> ApiBlockReference -> Identity ApiBlockReference)
(UTCTime -> Identity UTCTime)
-> ApiBlockReference -> Identity ApiBlockReference
#time ((UTCTime -> Identity UTCTime)
 -> ApiBlockReference -> Identity ApiBlockReference)
-> UTCTime -> ApiBlockReference -> ApiBlockReference
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ (MkApiTransactionParams
tx MkApiTransactionParams
-> ((UTCTime -> Const UTCTime UTCTime)
    -> MkApiTransactionParams -> Const UTCTime MkApiTransactionParams)
-> UTCTime
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txTime"
  ((UTCTime -> Const UTCTime UTCTime)
   -> MkApiTransactionParams -> Const UTCTime MkApiTransactionParams)
(UTCTime -> Const UTCTime UTCTime)
-> MkApiTransactionParams -> Const UTCTime MkApiTransactionParams
#txTime)) (ApiBlockReference -> ApiBlockReference)
-> IO ApiBlockReference -> IO ApiBlockReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeInterpreter IO
-> SlotNo -> Quantity "block" Natural -> IO ApiBlockReference
forall (m :: * -> *).
Monad m =>
TimeInterpreter m
-> SlotNo -> Quantity "block" Natural -> m ApiBlockReference
makeApiBlockReference
        (String
-> TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
neverFails
            String
"makeApiBlockReference shouldn't fail getting the time of \
            \transactions with slots in the past" TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter)
        (MkApiTransactionParams
tx MkApiTransactionParams
-> ((SlotNo -> Const SlotNo SlotNo)
    -> MkApiTransactionParams -> Const SlotNo MkApiTransactionParams)
-> SlotNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const SlotNo TxMeta)
   -> MkApiTransactionParams -> Const SlotNo MkApiTransactionParams)
(TxMeta -> Const SlotNo TxMeta)
-> MkApiTransactionParams -> Const SlotNo MkApiTransactionParams
#txMeta ((TxMeta -> Const SlotNo TxMeta)
 -> MkApiTransactionParams -> Const SlotNo MkApiTransactionParams)
-> ((SlotNo -> Const SlotNo SlotNo)
    -> TxMeta -> Const SlotNo TxMeta)
-> (SlotNo -> Const SlotNo SlotNo)
-> MkApiTransactionParams
-> Const SlotNo MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo) -> TxMeta -> Const SlotNo TxMeta)
(SlotNo -> Const SlotNo SlotNo) -> TxMeta -> Const SlotNo TxMeta
#slotNo))
        (Quantity "block" Word32 -> Quantity "block" Natural
forall (q :: Symbol). Quantity q Word32 -> Quantity q Natural
natural (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Quantity "block" Word32
     -> Const (Quantity "block" Word32) (Quantity "block" Word32))
    -> MkApiTransactionParams
    -> Const (Quantity "block" Word32) MkApiTransactionParams)
-> Quantity "block" Word32
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const (Quantity "block" Word32) TxMeta)
   -> MkApiTransactionParams
   -> Const (Quantity "block" Word32) MkApiTransactionParams)
(TxMeta -> Const (Quantity "block" Word32) TxMeta)
-> MkApiTransactionParams
-> Const (Quantity "block" Word32) MkApiTransactionParams
#txMeta ((TxMeta -> Const (Quantity "block" Word32) TxMeta)
 -> MkApiTransactionParams
 -> Const (Quantity "block" Word32) MkApiTransactionParams)
-> ((Quantity "block" Word32
     -> Const (Quantity "block" Word32) (Quantity "block" Word32))
    -> TxMeta -> Const (Quantity "block" Word32) TxMeta)
-> (Quantity "block" Word32
    -> Const (Quantity "block" Word32) (Quantity "block" Word32))
-> MkApiTransactionParams
-> Const (Quantity "block" Word32) MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "blockHeight"
  ((Quantity "block" Word32
    -> Const (Quantity "block" Word32) (Quantity "block" Word32))
   -> TxMeta -> Const (Quantity "block" Word32) TxMeta)
(Quantity "block" Word32
 -> Const (Quantity "block" Word32) (Quantity "block" Word32))
-> TxMeta -> Const (Quantity "block" Word32) TxMeta
#blockHeight)))

    Maybe ApiSlotReference
expRef <- (SlotNo -> IO ApiSlotReference)
-> Maybe SlotNo -> IO (Maybe ApiSlotReference)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SlotNo -> IO ApiSlotReference
makeApiSlotReference' (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Maybe SlotNo -> Const (Maybe SlotNo) (Maybe SlotNo))
    -> MkApiTransactionParams
    -> Const (Maybe SlotNo) MkApiTransactionParams)
-> Maybe SlotNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const (Maybe SlotNo) TxMeta)
   -> MkApiTransactionParams
   -> Const (Maybe SlotNo) MkApiTransactionParams)
(TxMeta -> Const (Maybe SlotNo) TxMeta)
-> MkApiTransactionParams
-> Const (Maybe SlotNo) MkApiTransactionParams
#txMeta ((TxMeta -> Const (Maybe SlotNo) TxMeta)
 -> MkApiTransactionParams
 -> Const (Maybe SlotNo) MkApiTransactionParams)
-> ((Maybe SlotNo -> Const (Maybe SlotNo) (Maybe SlotNo))
    -> TxMeta -> Const (Maybe SlotNo) TxMeta)
-> (Maybe SlotNo -> Const (Maybe SlotNo) (Maybe SlotNo))
-> MkApiTransactionParams
-> Const (Maybe SlotNo) MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "expiry"
  ((Maybe SlotNo -> Const (Maybe SlotNo) (Maybe SlotNo))
   -> TxMeta -> Const (Maybe SlotNo) TxMeta)
(Maybe SlotNo -> Const (Maybe SlotNo) (Maybe SlotNo))
-> TxMeta -> Const (Maybe SlotNo) TxMeta
#expiry))
    ApiTransaction n -> IO (ApiTransaction n)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiTransaction n -> IO (ApiTransaction n))
-> ApiTransaction n -> IO (ApiTransaction n)
forall a b. (a -> b) -> a -> b
$ ApiTransaction n
apiTx ApiTransaction n
-> (ApiTransaction n -> ApiTransaction n) -> ApiTransaction n
forall a b. a -> (a -> b) -> b
& (Maybe ApiBlockReference -> Identity (Maybe ApiBlockReference))
-> ApiTransaction n -> Identity (ApiTransaction n)
Lens' (ApiTransaction n) (Maybe ApiBlockReference)
setTimeReference ((Maybe ApiBlockReference -> Identity (Maybe ApiBlockReference))
 -> ApiTransaction n -> Identity (ApiTransaction n))
-> Maybe ApiBlockReference -> ApiTransaction n -> ApiTransaction n
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ ApiBlockReference -> Maybe ApiBlockReference
forall a. a -> Maybe a
Just ApiBlockReference
timeRef ApiTransaction n
-> (ApiTransaction n -> ApiTransaction n) -> ApiTransaction n
forall a b. a -> (a -> b) -> b
& IsLabel
  "expiresAt"
  ((Maybe ApiSlotReference -> Identity (Maybe ApiSlotReference))
   -> ApiTransaction n -> Identity (ApiTransaction n))
(Maybe ApiSlotReference -> Identity (Maybe ApiSlotReference))
-> ApiTransaction n -> Identity (ApiTransaction n)
#expiresAt ((Maybe ApiSlotReference -> Identity (Maybe ApiSlotReference))
 -> ApiTransaction n -> Identity (ApiTransaction n))
-> Maybe ApiSlotReference -> ApiTransaction n -> ApiTransaction n
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ Maybe ApiSlotReference
expRef
  where
    -- Since tx expiry can be far in the future, we use unsafeExtendSafeZone for
    -- now.
    makeApiSlotReference' :: SlotNo -> IO ApiSlotReference
makeApiSlotReference' = TimeInterpreter IO -> SlotNo -> IO ApiSlotReference
forall (m :: * -> *).
Monad m =>
TimeInterpreter m -> SlotNo -> m ApiSlotReference
makeApiSlotReference
        (TimeInterpreter IO -> SlotNo -> IO ApiSlotReference)
-> TimeInterpreter IO -> SlotNo -> IO ApiSlotReference
forall a b. (a -> b) -> a -> b
$ TimeInterpreter (ExceptT PastHorizonException IO)
-> TimeInterpreter IO
unsafeExtendSafeZone TimeInterpreter (ExceptT PastHorizonException IO)
timeInterpreter

    apiTx :: ApiTransaction n
    apiTx :: ApiTransaction n
apiTx = ApiTransaction :: forall (n :: NetworkDiscriminant).
ApiT (Hash "Tx")
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> Maybe ApiBlockReference
-> Maybe ApiBlockReference
-> Maybe ApiSlotReference
-> Maybe (Quantity "block" Natural)
-> ApiT Direction
-> [ApiTxInput n]
-> [ApiTxOutput n]
-> [ApiTxCollateral n]
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n))
-> [ApiWithdrawal n]
-> ApiT TxStatus
-> Maybe TxMetadataWithSchema
-> Maybe (ApiT TxScriptValidity)
-> ApiTransaction n
ApiTransaction
        { $sel:id:ApiTransaction :: ApiT (Hash "Tx")
id = Hash "Tx" -> ApiT (Hash "Tx")
forall a. a -> ApiT a
ApiT (Hash "Tx" -> ApiT (Hash "Tx")) -> Hash "Tx" -> ApiT (Hash "Tx")
forall a b. (a -> b) -> a -> b
$ MkApiTransactionParams
tx MkApiTransactionParams
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> MkApiTransactionParams
    -> Const (Hash "Tx") MkApiTransactionParams)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> MkApiTransactionParams
   -> Const (Hash "Tx") MkApiTransactionParams)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> MkApiTransactionParams
-> Const (Hash "Tx") MkApiTransactionParams
#txId
        , $sel:amount:ApiTransaction :: Quantity "lovelace" Natural
amount = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (Natural -> Natural) -> Natural -> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ MkApiTransactionParams
tx MkApiTransactionParams
-> ((Natural -> Const Natural Natural)
    -> MkApiTransactionParams -> Const Natural MkApiTransactionParams)
-> Natural
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const Natural TxMeta)
   -> MkApiTransactionParams -> Const Natural MkApiTransactionParams)
(TxMeta -> Const Natural TxMeta)
-> MkApiTransactionParams -> Const Natural MkApiTransactionParams
#txMeta ((TxMeta -> Const Natural TxMeta)
 -> MkApiTransactionParams -> Const Natural MkApiTransactionParams)
-> ((Natural -> Const Natural Natural)
    -> TxMeta -> Const Natural TxMeta)
-> (Natural -> Const Natural Natural)
-> MkApiTransactionParams
-> Const Natural MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "amount"
  ((Coin -> Const Natural Coin) -> TxMeta -> Const Natural TxMeta)
(Coin -> Const Natural Coin) -> TxMeta -> Const Natural TxMeta
#amount ((Coin -> Const Natural Coin) -> TxMeta -> Const Natural TxMeta)
-> ((Natural -> Const Natural Natural)
    -> Coin -> Const Natural Coin)
-> (Natural -> Const Natural Natural)
-> TxMeta
-> Const Natural TxMeta
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "unCoin"
  ((Natural -> Const Natural Natural) -> Coin -> Const Natural Coin)
(Natural -> Const Natural Natural) -> Coin -> Const Natural Coin
#unCoin)
        , $sel:fee:ApiTransaction :: Quantity "lovelace" Natural
fee = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Natural -> (Coin -> Natural) -> Maybe Coin -> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
0 (Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin) (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> MkApiTransactionParams
    -> Const (Maybe Coin) MkApiTransactionParams)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txFee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> MkApiTransactionParams
   -> Const (Maybe Coin) MkApiTransactionParams)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> MkApiTransactionParams
-> Const (Maybe Coin) MkApiTransactionParams
#txFee)
        , $sel:depositTaken:ApiTransaction :: Quantity "lovelace" Natural
depositTaken = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity Natural
depositIfAny
        , $sel:depositReturned:ApiTransaction :: Quantity "lovelace" Natural
depositReturned = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity Natural
reclaimIfAny
        , $sel:insertedAt:ApiTransaction :: Maybe ApiBlockReference
insertedAt = Maybe ApiBlockReference
forall a. Maybe a
Nothing
        , $sel:pendingSince:ApiTransaction :: Maybe ApiBlockReference
pendingSince = Maybe ApiBlockReference
forall a. Maybe a
Nothing
        , $sel:expiresAt:ApiTransaction :: Maybe ApiSlotReference
expiresAt = Maybe ApiSlotReference
forall a. Maybe a
Nothing
        , $sel:depth:ApiTransaction :: Maybe (Quantity "block" Natural)
depth = Maybe (Quantity "block" Natural)
forall a. Maybe a
Nothing
        , $sel:direction:ApiTransaction :: ApiT Direction
direction = Direction -> ApiT Direction
forall a. a -> ApiT a
ApiT (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Direction -> Const Direction Direction)
    -> MkApiTransactionParams
    -> Const Direction MkApiTransactionParams)
-> Direction
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const Direction TxMeta)
   -> MkApiTransactionParams
   -> Const Direction MkApiTransactionParams)
(TxMeta -> Const Direction TxMeta)
-> MkApiTransactionParams -> Const Direction MkApiTransactionParams
#txMeta ((TxMeta -> Const Direction TxMeta)
 -> MkApiTransactionParams
 -> Const Direction MkApiTransactionParams)
-> ((Direction -> Const Direction Direction)
    -> TxMeta -> Const Direction TxMeta)
-> (Direction -> Const Direction Direction)
-> MkApiTransactionParams
-> Const Direction MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "direction"
  ((Direction -> Const Direction Direction)
   -> TxMeta -> Const Direction TxMeta)
(Direction -> Const Direction Direction)
-> TxMeta -> Const Direction TxMeta
#direction))
        , $sel:inputs:ApiTransaction :: [ApiTxInput n]
inputs =
            [ Maybe (ApiTxOutput n) -> ApiT TxIn -> ApiTxInput n
forall (n :: NetworkDiscriminant).
Maybe (ApiTxOutput n) -> ApiT TxIn -> ApiTxInput n
ApiTxInput ((TxOut -> ApiTxOutput n) -> Maybe TxOut -> Maybe (ApiTxOutput n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOut -> ApiTxOutput n
forall (n :: NetworkDiscriminant).
TxOut -> AddressAmount (ApiT Address, Proxy n)
toAddressAmount @n) Maybe TxOut
o) (TxIn -> ApiT TxIn
forall a. a -> ApiT a
ApiT TxIn
i)
            | (TxIn
i, Maybe TxOut
o) <- MkApiTransactionParams
tx MkApiTransactionParams
-> (([(TxIn, Maybe TxOut)]
     -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
    -> MkApiTransactionParams
    -> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams)
-> [(TxIn, Maybe TxOut)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInputs"
  (([(TxIn, Maybe TxOut)]
    -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
   -> MkApiTransactionParams
   -> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams)
([(TxIn, Maybe TxOut)]
 -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
-> MkApiTransactionParams
-> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams
#txInputs
            ]
        , $sel:collateral:ApiTransaction :: [ApiTxCollateral n]
collateral =
            [ Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
-> ApiT TxIn -> ApiTxCollateral n
forall (n :: NetworkDiscriminant).
Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
-> ApiT TxIn -> ApiTxCollateral n
ApiTxCollateral ((TxOut -> AddressAmountNoAssets (ApiT Address, Proxy n))
-> Maybe TxOut
-> Maybe (AddressAmountNoAssets (ApiT Address, Proxy n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOut -> AddressAmountNoAssets (ApiT Address, Proxy n)
toAddressAmountNoAssets Maybe TxOut
o) (TxIn -> ApiT TxIn
forall a. a -> ApiT a
ApiT TxIn
i)
            | (TxIn
i, Maybe TxOut
o) <- MkApiTransactionParams
tx MkApiTransactionParams
-> (([(TxIn, Maybe TxOut)]
     -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
    -> MkApiTransactionParams
    -> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams)
-> [(TxIn, Maybe TxOut)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txCollateralInputs"
  (([(TxIn, Maybe TxOut)]
    -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
   -> MkApiTransactionParams
   -> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams)
([(TxIn, Maybe TxOut)]
 -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
-> MkApiTransactionParams
-> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams
#txCollateralInputs
            ]
        , $sel:outputs:ApiTransaction :: [ApiTxOutput n]
outputs = TxOut -> ApiTxOutput n
forall (n :: NetworkDiscriminant).
TxOut -> AddressAmount (ApiT Address, Proxy n)
toAddressAmount @n (TxOut -> ApiTxOutput n) -> [TxOut] -> [ApiTxOutput n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiTransactionParams
tx MkApiTransactionParams
-> (([TxOut] -> Const [TxOut] [TxOut])
    -> MkApiTransactionParams -> Const [TxOut] MkApiTransactionParams)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txOutputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> MkApiTransactionParams -> Const [TxOut] MkApiTransactionParams)
([TxOut] -> Const [TxOut] [TxOut])
-> MkApiTransactionParams -> Const [TxOut] MkApiTransactionParams
#txOutputs
        , $sel:collateralOutputs:ApiTransaction :: ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n))
collateralOutputs = Maybe (ApiTxOutput n)
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n))
forall (s :: Symbol) a. a -> ApiAsArray s a
ApiAsArray (Maybe (ApiTxOutput n)
 -> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n)))
-> Maybe (ApiTxOutput n)
-> ApiAsArray "collateral_outputs" (Maybe (ApiTxOutput n))
forall a b. (a -> b) -> a -> b
$
            TxOut -> ApiTxOutput n
forall (n :: NetworkDiscriminant).
TxOut -> AddressAmount (ApiT Address, Proxy n)
toAddressAmount @n (TxOut -> ApiTxOutput n) -> Maybe TxOut -> Maybe (ApiTxOutput n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiTransactionParams
tx MkApiTransactionParams
-> ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
    -> MkApiTransactionParams
    -> Const (Maybe TxOut) MkApiTransactionParams)
-> Maybe TxOut
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txCollateralOutput"
  ((Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
   -> MkApiTransactionParams
   -> Const (Maybe TxOut) MkApiTransactionParams)
(Maybe TxOut -> Const (Maybe TxOut) (Maybe TxOut))
-> MkApiTransactionParams
-> Const (Maybe TxOut) MkApiTransactionParams
#txCollateralOutput
        , $sel:withdrawals:ApiTransaction :: [ApiWithdrawal n]
withdrawals = (RewardAccount, Coin) -> ApiWithdrawal n
forall (n :: NetworkDiscriminant).
(RewardAccount, Coin) -> ApiWithdrawal n
mkApiWithdrawal @n ((RewardAccount, Coin) -> ApiWithdrawal n)
-> [(RewardAccount, Coin)] -> [ApiWithdrawal n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map RewardAccount Coin -> [(RewardAccount, Coin)]
forall k a. Map k a -> [(k, a)]
Map.toList (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> MkApiTransactionParams
    -> Const (Map RewardAccount Coin) MkApiTransactionParams)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txWithdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> MkApiTransactionParams
   -> Const (Map RewardAccount Coin) MkApiTransactionParams)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> MkApiTransactionParams
-> Const (Map RewardAccount Coin) MkApiTransactionParams
#txWithdrawals)
        , $sel:status:ApiTransaction :: ApiT TxStatus
status = TxStatus -> ApiT TxStatus
forall a. a -> ApiT a
ApiT (MkApiTransactionParams
tx MkApiTransactionParams
-> ((TxStatus -> Const TxStatus TxStatus)
    -> MkApiTransactionParams -> Const TxStatus MkApiTransactionParams)
-> TxStatus
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const TxStatus TxMeta)
   -> MkApiTransactionParams -> Const TxStatus MkApiTransactionParams)
(TxMeta -> Const TxStatus TxMeta)
-> MkApiTransactionParams -> Const TxStatus MkApiTransactionParams
#txMeta ((TxMeta -> Const TxStatus TxMeta)
 -> MkApiTransactionParams -> Const TxStatus MkApiTransactionParams)
-> ((TxStatus -> Const TxStatus TxStatus)
    -> TxMeta -> Const TxStatus TxMeta)
-> (TxStatus -> Const TxStatus TxStatus)
-> MkApiTransactionParams
-> Const TxStatus MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "status"
  ((TxStatus -> Const TxStatus TxStatus)
   -> TxMeta -> Const TxStatus TxMeta)
(TxStatus -> Const TxStatus TxStatus)
-> TxMeta -> Const TxStatus TxMeta
#status))
        , $sel:metadata:ApiTransaction :: Maybe TxMetadataWithSchema
metadata = TxMetadataSchema -> TxMetadata -> TxMetadataWithSchema
TxMetadataWithSchema (MkApiTransactionParams
tx MkApiTransactionParams
-> ((TxMetadataSchema -> Const TxMetadataSchema TxMetadataSchema)
    -> MkApiTransactionParams
    -> Const TxMetadataSchema MkApiTransactionParams)
-> TxMetadataSchema
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txMetadataSchema"
  ((TxMetadataSchema -> Const TxMetadataSchema TxMetadataSchema)
   -> MkApiTransactionParams
   -> Const TxMetadataSchema MkApiTransactionParams)
(TxMetadataSchema -> Const TxMetadataSchema TxMetadataSchema)
-> MkApiTransactionParams
-> Const TxMetadataSchema MkApiTransactionParams
#txMetadataSchema)
            (TxMetadata -> TxMetadataWithSchema)
-> Maybe TxMetadata -> Maybe TxMetadataWithSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiTransactionParams
tx MkApiTransactionParams
-> ((Maybe TxMetadata
     -> Const (Maybe TxMetadata) (Maybe TxMetadata))
    -> MkApiTransactionParams
    -> Const (Maybe TxMetadata) MkApiTransactionParams)
-> Maybe TxMetadata
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txMetadata"
  ((Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
   -> MkApiTransactionParams
   -> Const (Maybe TxMetadata) MkApiTransactionParams)
(Maybe TxMetadata -> Const (Maybe TxMetadata) (Maybe TxMetadata))
-> MkApiTransactionParams
-> Const (Maybe TxMetadata) MkApiTransactionParams
#txMetadata
        , $sel:scriptValidity:ApiTransaction :: Maybe (ApiT TxScriptValidity)
scriptValidity = TxScriptValidity -> ApiT TxScriptValidity
forall a. a -> ApiT a
ApiT (TxScriptValidity -> ApiT TxScriptValidity)
-> Maybe TxScriptValidity -> Maybe (ApiT TxScriptValidity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiTransactionParams
tx MkApiTransactionParams
-> ((Maybe TxScriptValidity
     -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
    -> MkApiTransactionParams
    -> Const (Maybe TxScriptValidity) MkApiTransactionParams)
-> Maybe TxScriptValidity
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txScriptValidity"
  ((Maybe TxScriptValidity
    -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
   -> MkApiTransactionParams
   -> Const (Maybe TxScriptValidity) MkApiTransactionParams)
(Maybe TxScriptValidity
 -> Const (Maybe TxScriptValidity) (Maybe TxScriptValidity))
-> MkApiTransactionParams
-> Const (Maybe TxScriptValidity) MkApiTransactionParams
#txScriptValidity
        }

    depositIfAny :: Natural
    depositIfAny :: Natural
depositIfAny
        | MkApiTransactionParams
tx MkApiTransactionParams
-> ((Direction -> Const Direction Direction)
    -> MkApiTransactionParams
    -> Const Direction MkApiTransactionParams)
-> Direction
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const Direction TxMeta)
   -> MkApiTransactionParams
   -> Const Direction MkApiTransactionParams)
(TxMeta -> Const Direction TxMeta)
-> MkApiTransactionParams -> Const Direction MkApiTransactionParams
#txMeta ((TxMeta -> Const Direction TxMeta)
 -> MkApiTransactionParams
 -> Const Direction MkApiTransactionParams)
-> ((Direction -> Const Direction Direction)
    -> TxMeta -> Const Direction TxMeta)
-> (Direction -> Const Direction Direction)
-> MkApiTransactionParams
-> Const Direction MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "direction"
  ((Direction -> Const Direction Direction)
   -> TxMeta -> Const Direction TxMeta)
(Direction -> Const Direction Direction)
-> TxMeta -> Const Direction TxMeta
#direction) Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
W.Outgoing =
            if Natural
totalIn Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
totalOut
            then Natural
0
            else Natural
totalIn Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
totalOut
        | Bool
otherwise = Natural
0

    -- (pending) when reclaim is coming we have (fee+out) - inp = deposit
    -- tx is incoming, and the wallet spent for fee and received deposit - fee as out
    -- (inLedger) when reclaim is accommodated we have out - inp < deposit as fee was incurred
    -- So in order to detect this we need to have
    -- 1. deposit
    -- 2. have inpsWithoutFee of the wallet non-empty
    -- 3. outs of the wallet non-empty
    -- 4. tx Incoming
    -- 5. outs - inpsWithoutFee <= deposit
    -- assumption: this should work when
    depositValue :: Natural
    depositValue :: Natural
depositValue = Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin (Coin -> Natural) -> Coin -> Natural
forall a b. (a -> b) -> a -> b
$ MkApiTransactionParams
tx MkApiTransactionParams
-> ((Coin -> Const Coin Coin)
    -> MkApiTransactionParams -> Const Coin MkApiTransactionParams)
-> Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txDeposit"
  ((Coin -> Const Coin Coin)
   -> MkApiTransactionParams -> Const Coin MkApiTransactionParams)
(Coin -> Const Coin Coin)
-> MkApiTransactionParams -> Const Coin MkApiTransactionParams
#txDeposit

    reclaimIfAny :: Natural
    reclaimIfAny :: Natural
reclaimIfAny
        | MkApiTransactionParams
tx MkApiTransactionParams
-> ((Direction -> Const Direction Direction)
    -> MkApiTransactionParams
    -> Const Direction MkApiTransactionParams)
-> Direction
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (IsLabel
  "txMeta"
  ((TxMeta -> Const Direction TxMeta)
   -> MkApiTransactionParams
   -> Const Direction MkApiTransactionParams)
(TxMeta -> Const Direction TxMeta)
-> MkApiTransactionParams -> Const Direction MkApiTransactionParams
#txMeta ((TxMeta -> Const Direction TxMeta)
 -> MkApiTransactionParams
 -> Const Direction MkApiTransactionParams)
-> ((Direction -> Const Direction Direction)
    -> TxMeta -> Const Direction TxMeta)
-> (Direction -> Const Direction Direction)
-> MkApiTransactionParams
-> Const Direction MkApiTransactionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "direction"
  ((Direction -> Const Direction Direction)
   -> TxMeta -> Const Direction TxMeta)
(Direction -> Const Direction Direction)
-> TxMeta -> Const Direction TxMeta
#direction) Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
W.Incoming =
              if ( Natural
totalIn Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 Bool -> Bool -> Bool
&& Natural
totalOut Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
0 Bool -> Bool -> Bool
&& Natural
totalOut Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
totalIn)
                 Bool -> Bool -> Bool
&& (Natural
totalOut Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
totalIn Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
depositValue) then
                  Natural
depositValue
              else
                  Natural
0
        | Bool
otherwise = Natural
0

    totalIn :: Natural
    totalIn :: Natural
totalIn
        = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (TxOut -> Natural
txOutValue (TxOut -> Natural) -> [TxOut] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TxIn, Maybe TxOut) -> Maybe TxOut)
-> [(TxIn, Maybe TxOut)] -> [TxOut]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (TxIn, Maybe TxOut) -> Maybe TxOut
forall a b. (a, b) -> b
snd (MkApiTransactionParams
tx MkApiTransactionParams
-> (([(TxIn, Maybe TxOut)]
     -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
    -> MkApiTransactionParams
    -> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams)
-> [(TxIn, Maybe TxOut)]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txInputs"
  (([(TxIn, Maybe TxOut)]
    -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
   -> MkApiTransactionParams
   -> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams)
([(TxIn, Maybe TxOut)]
 -> Const [(TxIn, Maybe TxOut)] [(TxIn, Maybe TxOut)])
-> MkApiTransactionParams
-> Const [(TxIn, Maybe TxOut)] MkApiTransactionParams
#txInputs))
        Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin (Coin -> Natural) -> [Coin] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map RewardAccount Coin -> [Coin]
forall k a. Map k a -> [a]
Map.elems (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Map RewardAccount Coin
     -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
    -> MkApiTransactionParams
    -> Const (Map RewardAccount Coin) MkApiTransactionParams)
-> Map RewardAccount Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txWithdrawals"
  ((Map RewardAccount Coin
    -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
   -> MkApiTransactionParams
   -> Const (Map RewardAccount Coin) MkApiTransactionParams)
(Map RewardAccount Coin
 -> Const (Map RewardAccount Coin) (Map RewardAccount Coin))
-> MkApiTransactionParams
-> Const (Map RewardAccount Coin) MkApiTransactionParams
#txWithdrawals))

    totalOut :: Natural
    totalOut :: Natural
totalOut
        = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (TxOut -> Natural
txOutValue (TxOut -> Natural) -> [TxOut] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MkApiTransactionParams
tx MkApiTransactionParams
-> (([TxOut] -> Const [TxOut] [TxOut])
    -> MkApiTransactionParams -> Const [TxOut] MkApiTransactionParams)
-> [TxOut]
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txOutputs"
  (([TxOut] -> Const [TxOut] [TxOut])
   -> MkApiTransactionParams -> Const [TxOut] MkApiTransactionParams)
([TxOut] -> Const [TxOut] [TxOut])
-> MkApiTransactionParams -> Const [TxOut] MkApiTransactionParams
#txOutputs)
        Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural -> (Coin -> Natural) -> Maybe Coin -> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
0 (Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Coin -> Natural) -> Coin -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin) (MkApiTransactionParams
tx MkApiTransactionParams
-> ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
    -> MkApiTransactionParams
    -> Const (Maybe Coin) MkApiTransactionParams)
-> Maybe Coin
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txFee"
  ((Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
   -> MkApiTransactionParams
   -> Const (Maybe Coin) MkApiTransactionParams)
(Maybe Coin -> Const (Maybe Coin) (Maybe Coin))
-> MkApiTransactionParams
-> Const (Maybe Coin) MkApiTransactionParams
#txFee)

    txOutValue :: TxOut -> Natural
    txOutValue :: TxOut -> Natural
txOutValue = Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (TxOut -> Natural) -> TxOut -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
unCoin (Coin -> Natural) -> (TxOut -> Coin) -> TxOut -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Coin
txOutCoin

    toAddressAmountNoAssets
        :: TxOut
        -> AddressAmountNoAssets (ApiT Address, Proxy n)
    toAddressAmountNoAssets :: TxOut -> AddressAmountNoAssets (ApiT Address, Proxy n)
toAddressAmountNoAssets (TxOut Address
addr (TokenBundle.TokenBundle Coin
coin TokenMap
_)) =
        (ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> AddressAmountNoAssets (ApiT Address, Proxy n)
forall addr.
addr -> Quantity "lovelace" Natural -> AddressAmountNoAssets addr
AddressAmountNoAssets (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Coin -> Quantity "lovelace" Natural
mkApiCoin Coin
coin)

toAddressAmount
    :: forall (n :: NetworkDiscriminant). ()
    => TxOut
    -> AddressAmount (ApiT Address, Proxy n)
toAddressAmount :: TxOut -> AddressAmount (ApiT Address, Proxy n)
toAddressAmount (TxOut Address
addr (TokenBundle.TokenBundle Coin
coin TokenMap
assets)) =
    (ApiT Address, Proxy n)
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount (ApiT Address, Proxy n)
forall addr.
addr
-> Quantity "lovelace" Natural
-> ApiT TokenMap
-> AddressAmount addr
AddressAmount (Address -> ApiT Address
forall a. a -> ApiT a
ApiT Address
addr, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Coin -> Quantity "lovelace" Natural
mkApiCoin Coin
coin) (TokenMap -> ApiT TokenMap
forall a. a -> ApiT a
ApiT TokenMap
assets)

mkApiCoin
    :: Coin
    -> Quantity "lovelace" Natural
mkApiCoin :: Coin -> Quantity "lovelace" Natural
mkApiCoin (Coin Natural
c) = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> Natural -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c

mkApiFee :: Maybe Coin -> [Coin] -> FeeEstimation -> ApiFee
mkApiFee :: Maybe Coin -> [Coin] -> FeeEstimation -> ApiFee
mkApiFee Maybe Coin
mDeposit [Coin]
minCoins (FeeEstimation Word64
estMin Word64
estMax) = ApiFee :: Quantity "lovelace" Natural
-> Quantity "lovelace" Natural
-> [Quantity "lovelace" Natural]
-> Quantity "lovelace" Natural
-> ApiFee
ApiFee
    { $sel:estimatedMin:ApiFee :: Quantity "lovelace" Natural
estimatedMin = Word64 -> Quantity "lovelace" Natural
forall (unit :: Symbol). Word64 -> Quantity unit Natural
qty Word64
estMin
    , $sel:estimatedMax:ApiFee :: Quantity "lovelace" Natural
estimatedMax = Word64 -> Quantity "lovelace" Natural
forall (unit :: Symbol). Word64 -> Quantity unit Natural
qty Word64
estMax
    , $sel:minimumCoins:ApiFee :: [Quantity "lovelace" Natural]
minimumCoins = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (Coin -> Natural) -> Coin -> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
Coin.toNatural (Coin -> Quantity "lovelace" Natural)
-> [Coin] -> [Quantity "lovelace" Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Coin]
minCoins
    , $sel:deposit:ApiFee :: Quantity "lovelace" Natural
deposit = Natural -> Quantity "lovelace" Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity "lovelace" Natural)
-> (Coin -> Natural) -> Coin -> Quantity "lovelace" Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Natural
Coin.toNatural (Coin -> Quantity "lovelace" Natural)
-> Coin -> Quantity "lovelace" Natural
forall a b. (a -> b) -> a -> b
$ Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe (Natural -> Coin
Coin Natural
0) Maybe Coin
mDeposit
    }
  where
    qty :: Word64 -> Quantity unit Natural
qty = Natural -> Quantity unit Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity unit Natural)
-> (Word64 -> Natural) -> Word64 -> Quantity unit Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral

mkApiWithdrawal
    :: forall (n :: NetworkDiscriminant). ()
    => (RewardAccount, Coin)
    -> ApiWithdrawal n
mkApiWithdrawal :: (RewardAccount, Coin) -> ApiWithdrawal n
mkApiWithdrawal (RewardAccount
acct, Coin
c) =
    (ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural -> ApiWithdrawal n
forall k (n :: k).
(ApiT RewardAccount, Proxy n)
-> Quantity "lovelace" Natural -> ApiWithdrawal n
ApiWithdrawal (RewardAccount -> ApiT RewardAccount
forall a. a -> ApiT a
ApiT RewardAccount
acct, Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Coin -> Quantity "lovelace" Natural
mkApiCoin Coin
c)

addressAmountToTxOut
    :: forall (n :: NetworkDiscriminant). AddressAmount (ApiT Address, Proxy n)
    -> TxOut
addressAmountToTxOut :: AddressAmount (ApiT Address, Proxy n) -> TxOut
addressAmountToTxOut (AddressAmount (ApiT Address
addr, Proxy n
_) Quantity "lovelace" Natural
c (ApiT TokenMap
assets)) =
    Address -> TokenBundle -> TxOut
TxOut Address
addr (Coin -> TokenMap -> TokenBundle
TokenBundle.TokenBundle (Quantity "lovelace" Natural -> Coin
forall n. Integral n => Quantity "lovelace" n -> Coin
coinFromQuantity Quantity "lovelace" Natural
c) TokenMap
assets)

natural :: Quantity q Word32 -> Quantity q Natural
natural :: Quantity q Word32 -> Quantity q Natural
natural = Natural -> Quantity q Natural
forall (unit :: Symbol) a. a -> Quantity unit a
Quantity (Natural -> Quantity q Natural)
-> (Quantity q Word32 -> Natural)
-> Quantity q Word32
-> Quantity q Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural)
-> (Quantity q Word32 -> Word32) -> Quantity q Word32 -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity q Word32 -> Word32
forall (unit :: Symbol) a. Quantity unit a -> a
getQuantity

apiSlotId :: SlotId -> ApiSlotId
apiSlotId :: SlotId -> ApiSlotId
apiSlotId SlotId
slotId = ApiT EpochNo -> ApiT SlotInEpoch -> ApiSlotId
ApiSlotId
   (EpochNo -> ApiT EpochNo
forall a. a -> ApiT a
ApiT (EpochNo -> ApiT EpochNo) -> EpochNo -> ApiT EpochNo
forall a b. (a -> b) -> a -> b
$ SlotId
slotId SlotId
-> ((EpochNo -> Const EpochNo EpochNo)
    -> SlotId -> Const EpochNo SlotId)
-> EpochNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "epochNumber"
  ((EpochNo -> Const EpochNo EpochNo)
   -> SlotId -> Const EpochNo SlotId)
(EpochNo -> Const EpochNo EpochNo)
-> SlotId -> Const EpochNo SlotId
#epochNumber)
   (SlotInEpoch -> ApiT SlotInEpoch
forall a. a -> ApiT a
ApiT (SlotInEpoch -> ApiT SlotInEpoch)
-> SlotInEpoch -> ApiT SlotInEpoch
forall a b. (a -> b) -> a -> b
$ SlotId
slotId SlotId
-> ((SlotInEpoch -> Const SlotInEpoch SlotInEpoch)
    -> SlotId -> Const SlotInEpoch SlotId)
-> SlotInEpoch
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "slotNumber"
  ((SlotInEpoch -> Const SlotInEpoch SlotInEpoch)
   -> SlotId -> Const SlotInEpoch SlotId)
(SlotInEpoch -> Const SlotInEpoch SlotInEpoch)
-> SlotId -> Const SlotInEpoch SlotId
#slotNumber)

makeApiBlockReference
    :: Monad m
    => TimeInterpreter m
    -> SlotNo
    -> Quantity "block" Natural
    -> m ApiBlockReference
makeApiBlockReference :: TimeInterpreter m
-> SlotNo -> Quantity "block" Natural -> m ApiBlockReference
makeApiBlockReference TimeInterpreter m
ti SlotNo
sl Quantity "block" Natural
height = do
    SlotId
slotId <- TimeInterpreter m -> Qry SlotId -> m SlotId
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter m
ti (SlotNo -> Qry SlotId
toSlotId SlotNo
sl)
    UTCTime
slotTime <- TimeInterpreter m -> Qry UTCTime -> m UTCTime
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter m
ti (SlotNo -> Qry UTCTime
slotToUTCTime SlotNo
sl)
    ApiBlockReference -> m ApiBlockReference
forall (m :: * -> *) a. Monad m => a -> m a
return (ApiBlockReference -> m ApiBlockReference)
-> ApiBlockReference -> m ApiBlockReference
forall a b. (a -> b) -> a -> b
$ ApiBlockReference :: ApiT SlotNo
-> ApiSlotId -> UTCTime -> ApiBlockInfo -> ApiBlockReference
ApiBlockReference
        { $sel:absoluteSlotNumber:ApiBlockReference :: ApiT SlotNo
absoluteSlotNumber = SlotNo -> ApiT SlotNo
forall a. a -> ApiT a
ApiT SlotNo
sl
        , $sel:slotId:ApiBlockReference :: ApiSlotId
slotId = SlotId -> ApiSlotId
apiSlotId SlotId
slotId
        , $sel:time:ApiBlockReference :: UTCTime
time = UTCTime
slotTime
        , $sel:block:ApiBlockReference :: ApiBlockInfo
block = ApiBlockInfo :: Quantity "block" Natural -> ApiBlockInfo
ApiBlockInfo { Quantity "block" Natural
$sel:height:ApiBlockInfo :: Quantity "block" Natural
height :: Quantity "block" Natural
height }
        }

makeApiBlockReferenceFromHeader
    :: Monad m
    => TimeInterpreter m
    -> BlockHeader
    -> m ApiBlockReference
makeApiBlockReferenceFromHeader :: TimeInterpreter m -> BlockHeader -> m ApiBlockReference
makeApiBlockReferenceFromHeader TimeInterpreter m
ti BlockHeader
tip =
    TimeInterpreter m
-> SlotNo -> Quantity "block" Natural -> m ApiBlockReference
forall (m :: * -> *).
Monad m =>
TimeInterpreter m
-> SlotNo -> Quantity "block" Natural -> m ApiBlockReference
makeApiBlockReference TimeInterpreter m
ti (BlockHeader
tip BlockHeader
-> ((SlotNo -> Const SlotNo SlotNo)
    -> BlockHeader -> Const SlotNo BlockHeader)
-> SlotNo
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "slotNo"
  ((SlotNo -> Const SlotNo SlotNo)
   -> BlockHeader -> Const SlotNo BlockHeader)
(SlotNo -> Const SlotNo SlotNo)
-> BlockHeader -> Const SlotNo BlockHeader
#slotNo) (Quantity "block" Word32 -> Quantity "block" Natural
forall (q :: Symbol). Quantity q Word32 -> Quantity q Natural
natural (Quantity "block" Word32 -> Quantity "block" Natural)
-> Quantity "block" Word32 -> Quantity "block" Natural
forall a b. (a -> b) -> a -> b
$ BlockHeader
tip BlockHeader
-> ((Quantity "block" Word32
     -> Const (Quantity "block" Word32) (Quantity "block" Word32))
    -> BlockHeader -> Const (Quantity "block" Word32) BlockHeader)
-> Quantity "block" Word32
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "blockHeight"
  ((Quantity "block" Word32
    -> Const (Quantity "block" Word32) (Quantity "block" Word32))
   -> BlockHeader -> Const (Quantity "block" Word32) BlockHeader)
(Quantity "block" Word32
 -> Const (Quantity "block" Word32) (Quantity "block" Word32))
-> BlockHeader -> Const (Quantity "block" Word32) BlockHeader
#blockHeight)

makeApiSlotReference
    :: Monad m
    => TimeInterpreter m
    -> SlotNo
    -> m ApiSlotReference
makeApiSlotReference :: TimeInterpreter m -> SlotNo -> m ApiSlotReference
makeApiSlotReference TimeInterpreter m
ti SlotNo
sl =
    ApiT SlotNo -> ApiSlotId -> UTCTime -> ApiSlotReference
ApiSlotReference (SlotNo -> ApiT SlotNo
forall a. a -> ApiT a
ApiT SlotNo
sl)
        (ApiSlotId -> UTCTime -> ApiSlotReference)
-> m ApiSlotId -> m (UTCTime -> ApiSlotReference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SlotId -> ApiSlotId) -> m SlotId -> m ApiSlotId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SlotId -> ApiSlotId
apiSlotId (TimeInterpreter m -> Qry SlotId -> m SlotId
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter m
ti (Qry SlotId -> m SlotId) -> Qry SlotId -> m SlotId
forall a b. (a -> b) -> a -> b
$ SlotNo -> Qry SlotId
toSlotId SlotNo
sl)
        m (UTCTime -> ApiSlotReference) -> m UTCTime -> m ApiSlotReference
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TimeInterpreter m -> Qry UTCTime -> m UTCTime
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
TimeInterpreter m -> Qry a -> m a
interpretQuery TimeInterpreter m
ti (SlotNo -> Qry UTCTime
slotToUTCTime SlotNo
sl)

getWalletTip
    :: Monad m
    => TimeInterpreter m
    -> Wallet s
    -> m ApiBlockReference
getWalletTip :: TimeInterpreter m -> Wallet s -> m ApiBlockReference
getWalletTip TimeInterpreter m
ti = TimeInterpreter m -> BlockHeader -> m ApiBlockReference
forall (m :: * -> *).
Monad m =>
TimeInterpreter m -> BlockHeader -> m ApiBlockReference
makeApiBlockReferenceFromHeader TimeInterpreter m
ti (BlockHeader -> m ApiBlockReference)
-> (Wallet s -> BlockHeader) -> Wallet s -> m ApiBlockReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet s -> BlockHeader
forall s. Wallet s -> BlockHeader
currentTip

fromExternalInput :: ApiExternalInput n -> (TxIn, TxOut, Maybe (Hash "Datum"))
fromExternalInput :: ApiExternalInput n -> (TxIn, TxOut, Maybe (Hash "Datum"))
fromExternalInput ApiExternalInput
    { $sel:id:ApiExternalInput :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> ApiT (Hash "Tx")
id = ApiT Hash "Tx"
tid
    , $sel:index:ApiExternalInput :: forall (n :: NetworkDiscriminant). ApiExternalInput n -> Word32
index = Word32
ix
    , $sel:address:ApiExternalInput :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> (ApiT Address, Proxy n)
address = (ApiT Address
addr, Proxy n
_)
    , $sel:amount:ApiExternalInput :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> Quantity "lovelace" Natural
amount = Quantity Natural
amt
    , $sel:assets:ApiExternalInput :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> ApiT TokenMap
assets = ApiT TokenMap
assets
    , Maybe (ApiT (Hash "Datum"))
$sel:datum:ApiExternalInput :: forall (n :: NetworkDiscriminant).
ApiExternalInput n -> Maybe (ApiT (Hash "Datum"))
datum :: Maybe (ApiT (Hash "Datum"))
datum
    }
  =
    ( Hash "Tx" -> Word32 -> TxIn
TxIn Hash "Tx"
tid Word32
ix
    , Address -> TokenBundle -> TxOut
TxOut Address
addr (Coin -> TokenMap -> TokenBundle
TokenBundle (Natural -> Coin
Coin (Natural -> Coin) -> Natural -> Coin
forall a b. (a -> b) -> a -> b
$ Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
amt) TokenMap
assets)
    , ApiT (Hash "Datum") -> Hash "Datum"
forall a. ApiT a -> a
getApiT (ApiT (Hash "Datum") -> Hash "Datum")
-> Maybe (ApiT (Hash "Datum")) -> Maybe (Hash "Datum")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ApiT (Hash "Datum"))
datum
    )

fromApiRedeemer :: ApiRedeemer n -> Redeemer
fromApiRedeemer :: ApiRedeemer n -> Redeemer
fromApiRedeemer = \case
    ApiRedeemerSpending (ApiBytesT ByteString
bytes) (ApiT TxIn
i) ->
        ByteString -> TxIn -> Redeemer
RedeemerSpending ByteString
bytes TxIn
i
    ApiRedeemerMinting (ApiBytesT ByteString
bytes) (ApiT TokenPolicyId
p) ->
        ByteString -> TokenPolicyId -> Redeemer
RedeemerMinting ByteString
bytes TokenPolicyId
p
    ApiRedeemerRewarding (ApiBytesT ByteString
bytes) StakeAddress
r ->
        ByteString -> StakeAddress -> Redeemer
RedeemerRewarding ByteString
bytes StakeAddress
r

{-------------------------------------------------------------------------------
                                Api Layer
-------------------------------------------------------------------------------}

-- | Create a new instance of the wallet layer.
newApiLayer
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s RewardAccount
        , IsOurs s Address
        , AddressBookIso s
        , MaybeLight s
        )
    => Tracer IO WalletEngineLog
    -> (Block, NetworkParameters)
    -> NetworkLayer IO Block
    -> TransactionLayer k W.SealedTx
    -> DBFactory IO s k
    -> TokenMetadataClient IO
    -> (WorkerCtx ctx -> WalletId -> IO ())
        -- ^ Action to run concurrently with wallet restore
    -> IO ctx
newApiLayer :: Tracer IO WalletEngineLog
-> (Block, NetworkParameters)
-> NetworkLayer IO Block
-> TransactionLayer k SealedTx
-> DBFactory IO s k
-> TokenMetadataClient IO
-> (WorkerCtx ctx -> WalletId -> IO ())
-> IO ctx
newApiLayer Tracer IO WalletEngineLog
tr (Block, NetworkParameters)
g0 NetworkLayer IO Block
nw TransactionLayer k SealedTx
tl DBFactory IO s k
df TokenMetadataClient IO
tokenMeta WorkerCtx ctx -> WalletId -> IO ()
coworker = do
    WorkerRegistry WalletId (DBLayer IO s k)
re <- IO (WorkerRegistry WalletId (DBLayer IO s k))
forall key resource. Ord key => IO (WorkerRegistry key resource)
Registry.empty
    let trTx :: Tracer IO TxSubmitLog
trTx = (TxSubmitLog -> WalletEngineLog)
-> Tracer IO WalletEngineLog -> Tracer IO TxSubmitLog
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap TxSubmitLog -> WalletEngineLog
MsgSubmitSealedTx Tracer IO WalletEngineLog
tr
    let trW :: Tracer IO (WorkerLog WalletId WalletWorkerLog)
trW = (WorkerLog WalletId WalletWorkerLog -> WalletEngineLog)
-> Tracer IO WalletEngineLog
-> Tracer IO (WorkerLog WalletId WalletWorkerLog)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap WorkerLog WalletId WalletWorkerLog -> WalletEngineLog
MsgWalletWorker Tracer IO WalletEngineLog
tr
    Concierge IO WalletLock
locks <- IO (Concierge IO WalletLock)
forall (m :: * -> *) lock. MonadSTM m => m (Concierge m lock)
Concierge.newConcierge
    let ctx :: ApiLayer s k
ctx = Tracer IO TxSubmitLog
-> Tracer IO (WorkerLog WalletId WalletWorkerLog)
-> (Block, NetworkParameters)
-> NetworkLayer IO Block
-> TransactionLayer k SealedTx
-> DBFactory IO s k
-> WorkerRegistry WalletId (DBLayer IO s k)
-> Concierge IO WalletLock
-> TokenMetadataClient IO
-> ApiLayer s k
forall s (k :: Depth -> * -> *).
Tracer IO TxSubmitLog
-> Tracer IO (WorkerLog WalletId WalletWorkerLog)
-> (Block, NetworkParameters)
-> NetworkLayer IO Block
-> TransactionLayer k SealedTx
-> DBFactory IO s k
-> WorkerRegistry WalletId (DBLayer IO s k)
-> Concierge IO WalletLock
-> TokenMetadataClient IO
-> ApiLayer s k
ApiLayer Tracer IO TxSubmitLog
trTx Tracer IO (WorkerLog WalletId WalletWorkerLog)
trW (Block, NetworkParameters)
g0 NetworkLayer IO Block
nw TransactionLayer k SealedTx
tl DBFactory IO s k
df WorkerRegistry WalletId (DBLayer IO s k)
re Concierge IO WalletLock
locks TokenMetadataClient IO
tokenMeta
    DBFactory IO s k -> IO [WalletId]
forall (m :: * -> *) s (k :: Depth -> * -> *).
DBFactory m s k -> IO [WalletId]
listDatabases DBFactory IO s k
df IO [WalletId] -> ([WalletId] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WalletId -> IO ()) -> [WalletId] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ApiLayer s k
-> (WorkerCtx (ApiLayer s k) -> WalletId -> IO ())
-> WalletId
-> IO ()
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx -> (WorkerCtx ctx -> WalletId -> IO ()) -> WalletId -> IO ()
startWalletWorker ApiLayer s k
ctx WorkerCtx ctx -> WalletId -> IO ()
WorkerCtx (ApiLayer s k) -> WalletId -> IO ()
coworker)
    ApiLayer s k -> IO (ApiLayer s k)
forall (m :: * -> *) a. Monad m => a -> m a
return ApiLayer s k
ctx

-- | Register a wallet restoration thread with the worker registry.
startWalletWorker
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s RewardAccount
        , IsOurs s Address
        , AddressBookIso s
        , MaybeLight s
        )
    => ctx
    -> (WorkerCtx ctx -> WalletId -> IO ())
        -- ^ Action to run concurrently with restore
    -> WalletId
    -> IO ()
startWalletWorker :: ctx -> (WorkerCtx ctx -> WalletId -> IO ()) -> WalletId -> IO ()
startWalletWorker ctx
ctx WorkerCtx ctx -> WalletId -> IO ()
coworker = IO (Maybe ctx) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ctx) -> IO ())
-> (WalletId -> IO (Maybe ctx)) -> WalletId -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx
-> (WorkerCtx ctx -> WalletId -> IO ())
-> (WorkerCtx ctx -> WalletId -> IO ())
-> WalletId
-> IO (Maybe ctx)
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> (WorkerCtx ctx -> WalletId -> IO ())
-> (WorkerCtx ctx -> WalletId -> IO ())
-> WalletId
-> IO (Maybe ctx)
registerWorker ctx
ctx WalletLayer IO s k -> WalletId -> IO ()
WorkerCtx ctx -> WalletId -> IO ()
before WorkerCtx ctx -> WalletId -> IO ()
coworker
  where
    before :: WalletLayer IO s k -> WalletId -> IO ()
before WalletLayer IO s k
ctx' WalletId
wid =
        ExceptT ErrCheckWalletIntegrity IO ()
-> IO (Either ErrCheckWalletIntegrity ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (WalletLayer IO s k
-> WalletId
-> GenesisParameters
-> ExceptT ErrCheckWalletIntegrity IO ()
forall ctx s (k :: Depth -> * -> *).
HasDBLayer IO s k ctx =>
ctx
-> WalletId
-> GenesisParameters
-> ExceptT ErrCheckWalletIntegrity IO ()
W.checkWalletIntegrity WalletLayer IO s k
ctx' WalletId
wid GenesisParameters
gp)
        IO (Either ErrCheckWalletIntegrity ())
-> (Either ErrCheckWalletIntegrity () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ErrCheckWalletIntegrity -> IO ())
-> (() -> IO ()) -> Either ErrCheckWalletIntegrity () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrCheckWalletIntegrity -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Block
_, NetworkParameters GenesisParameters
gp SlottingParameters
_ ProtocolParameters
_) = ctx
ctx ctx
-> (((Block, NetworkParameters)
     -> Const (Block, NetworkParameters) (Block, NetworkParameters))
    -> ctx -> Const (Block, NetworkParameters) ctx)
-> (Block, NetworkParameters)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. ((Block, NetworkParameters)
 -> Const (Block, NetworkParameters) (Block, NetworkParameters))
-> ctx -> Const (Block, NetworkParameters) ctx
forall ctx.
HasGenesisData ctx =>
Lens' ctx (Block, NetworkParameters)
genesisData

-- | Register a wallet create and restore thread with the worker registry.
-- See 'Cardano.Wallet#createWallet'
createWalletWorker
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s RewardAccount
        , IsOurs s Address
        , AddressBookIso s
        , MaybeLight s
        )
    => ctx
        -- ^ Surrounding API context
    -> WalletId
        -- ^ Wallet Id
    -> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
        -- ^ Create action
    -> (WorkerCtx ctx -> WalletId -> IO ())
        -- ^ Action to run concurrently with restore
    -> ExceptT ErrCreateWallet IO WalletId
createWalletWorker :: ctx
-> WalletId
-> (WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId)
-> (WorkerCtx ctx -> WalletId -> IO ())
-> ExceptT ErrCreateWallet IO WalletId
createWalletWorker ctx
ctx WalletId
wid WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId
createWallet WorkerCtx ctx -> WalletId -> IO ()
coworker =
    IO (Maybe (Worker WalletId (DBLayer IO s k)))
-> ExceptT
     ErrCreateWallet IO (Maybe (Worker WalletId (DBLayer IO s k)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WorkerRegistry WalletId (DBLayer IO s k)
-> WalletId -> IO (Maybe (Worker WalletId (DBLayer IO s k)))
forall (m :: * -> *) key resource.
(MonadIO m, Ord key) =>
WorkerRegistry key resource
-> key -> m (Maybe (Worker key resource))
Registry.lookup WorkerRegistry WalletId (DBLayer IO s k)
re WalletId
wid) ExceptT
  ErrCreateWallet IO (Maybe (Worker WalletId (DBLayer IO s k)))
-> (Maybe (Worker WalletId (DBLayer IO s k))
    -> ExceptT ErrCreateWallet IO WalletId)
-> ExceptT ErrCreateWallet IO WalletId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Worker WalletId (DBLayer IO s k)
_ ->
            ErrCreateWallet -> ExceptT ErrCreateWallet IO WalletId
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrCreateWallet -> ExceptT ErrCreateWallet IO WalletId)
-> ErrCreateWallet -> ExceptT ErrCreateWallet IO WalletId
forall a b. (a -> b) -> a -> b
$ ErrWalletAlreadyExists -> ErrCreateWallet
ErrCreateWalletAlreadyExists (ErrWalletAlreadyExists -> ErrCreateWallet)
-> ErrWalletAlreadyExists -> ErrCreateWallet
forall a b. (a -> b) -> a -> b
$ WalletId -> ErrWalletAlreadyExists
ErrWalletAlreadyExists WalletId
wid
        Maybe (Worker WalletId (DBLayer IO s k))
Nothing ->
            IO (Maybe ctx) -> ExceptT ErrCreateWallet IO (Maybe ctx)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ctx
-> (WorkerCtx ctx -> WalletId -> IO ())
-> (WorkerCtx ctx -> WalletId -> IO ())
-> WalletId
-> IO (Maybe ctx)
forall ctx s (k :: Depth -> * -> *).
(ctx ~ ApiLayer s k, IsOurs s RewardAccount, IsOurs s Address,
 AddressBookIso s, MaybeLight s) =>
ctx
-> (WorkerCtx ctx -> WalletId -> IO ())
-> (WorkerCtx ctx -> WalletId -> IO ())
-> WalletId
-> IO (Maybe ctx)
registerWorker ctx
ctx WalletLayer IO s k -> WalletId -> IO ()
WorkerCtx ctx -> WalletId -> IO ()
before WorkerCtx ctx -> WalletId -> IO ()
coworker WalletId
wid) ExceptT ErrCreateWallet IO (Maybe ctx)
-> (Maybe ctx -> ExceptT ErrCreateWallet IO WalletId)
-> ExceptT ErrCreateWallet IO WalletId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe ctx
Nothing -> ErrCreateWallet -> ExceptT ErrCreateWallet IO WalletId
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ErrCreateWallet
ErrCreateWalletFailedToCreateWorker
                Just ctx
_ -> WalletId -> ExceptT ErrCreateWallet IO WalletId
forall (f :: * -> *) a. Applicative f => a -> f a
pure WalletId
wid
  where
    before :: WalletLayer IO s k -> WalletId -> IO ()
before WalletLayer IO s k
ctx' WalletId
_ = IO WalletId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO WalletId -> IO ()) -> IO WalletId -> IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT ErrWalletAlreadyExists IO WalletId -> IO WalletId
forall (m :: * -> *) e a.
(MonadFail m, Show e) =>
ExceptT e m a -> m a
unsafeRunExceptT (ExceptT ErrWalletAlreadyExists IO WalletId -> IO WalletId)
-> ExceptT ErrWalletAlreadyExists IO WalletId -> IO WalletId
forall a b. (a -> b) -> a -> b
$ WorkerCtx ctx -> ExceptT ErrWalletAlreadyExists IO WalletId
createWallet WalletLayer IO s k
WorkerCtx ctx
ctx'
    re :: WorkerRegistry WalletId (DBLayer IO s k)
re = ctx
ctx ctx
-> ((WorkerRegistry WalletId (DBLayer IO s k)
     -> Const
          (WorkerRegistry WalletId (DBLayer IO s k))
          (WorkerRegistry WalletId (DBLayer IO s k)))
    -> ctx -> Const (WorkerRegistry WalletId (DBLayer IO s k)) ctx)
-> WorkerRegistry WalletId (DBLayer IO s k)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
forall s (k :: Depth -> * -> *) ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
workerRegistry @s @k

-- | Create a worker for an existing wallet, register it, then start the worker
-- thread. This is used by 'startWalletWorker' and 'createWalletWorker'.
registerWorker
    :: forall ctx s k.
        ( ctx ~ ApiLayer s k
        , IsOurs s RewardAccount
        , IsOurs s Address
        , AddressBookIso s
        , MaybeLight s
        )
    => ctx
    -> (WorkerCtx ctx -> WalletId -> IO ())
        -- ^ First action to run after starting the worker thread.
    -> (WorkerCtx ctx -> WalletId -> IO ())
        -- ^ Action to run concurrently with restore.
    -> WalletId
    -> IO (Maybe ctx)
registerWorker :: ctx
-> (WorkerCtx ctx -> WalletId -> IO ())
-> (WorkerCtx ctx -> WalletId -> IO ())
-> WalletId
-> IO (Maybe ctx)
registerWorker ctx
ctx WorkerCtx ctx -> WalletId -> IO ()
before WorkerCtx ctx -> WalletId -> IO ()
coworker WalletId
wid =
    (Worker WalletId (DBLayer IO s k) -> ctx)
-> Maybe (Worker WalletId (DBLayer IO s k)) -> Maybe ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ctx -> Worker WalletId (DBLayer IO s k) -> ctx
forall a b. a -> b -> a
const ctx
ctx) (Maybe (Worker WalletId (DBLayer IO s k)) -> Maybe ctx)
-> IO (Maybe (Worker WalletId (DBLayer IO s k))) -> IO (Maybe ctx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WorkerRegistry WalletId (DBLayer IO s k)
-> ctx
-> WalletId
-> MkWorker WalletId (DBLayer IO s k) WalletWorkerLog ctx
-> IO (Maybe (Worker WalletId (DBLayer IO s k)))
forall resource ctx key msg.
(Ord key, key ~ WorkerKey ctx, msg ~ WorkerMsg ctx,
 HasLogger IO (WorkerLog key msg) ctx, HasWorkerCtx resource ctx) =>
WorkerRegistry key resource
-> ctx
-> key
-> MkWorker key resource msg ctx
-> IO (Maybe (Worker key resource))
Registry.register @_ @ctx WorkerRegistry WalletId (DBLayer IO s k)
re ctx
ctx WalletId
wid MkWorker WalletId (DBLayer IO s k) WalletWorkerLog ctx
config
  where
    re :: WorkerRegistry WalletId (DBLayer IO s k)
re = ctx
ctx ctx
-> ((WorkerRegistry WalletId (DBLayer IO s k)
     -> Const
          (WorkerRegistry WalletId (DBLayer IO s k))
          (WorkerRegistry WalletId (DBLayer IO s k)))
    -> ctx -> Const (WorkerRegistry WalletId (DBLayer IO s k)) ctx)
-> WorkerRegistry WalletId (DBLayer IO s k)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
forall s (k :: Depth -> * -> *) ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
workerRegistry @s @k
    df :: DBFactory IO s k
df = ctx
ctx ctx
-> ((DBFactory IO s k
     -> Const (DBFactory IO s k) (DBFactory IO s k))
    -> ctx -> Const (DBFactory IO s k) ctx)
-> DBFactory IO s k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (DBFactory IO s k -> Const (DBFactory IO s k) (DBFactory IO s k))
-> ctx -> Const (DBFactory IO s k) ctx
forall s (k :: Depth -> * -> *) ctx.
HasDBFactory s k ctx =>
Lens' ctx (DBFactory IO s k)
dbFactory
    config :: MkWorker WalletId (DBLayer IO s k) WalletWorkerLog ctx
config = MkWorker :: forall key resource msg ctx.
(WorkerCtx ctx -> key -> IO ())
-> (WorkerCtx ctx -> key -> IO ())
-> (Tracer IO (WorkerLog key msg)
    -> Either SomeException () -> IO ())
-> ((resource -> IO ()) -> IO ())
-> MkWorker key resource msg ctx
MkWorker
        { workerAcquire :: (DBLayer IO s k -> IO ()) -> IO ()
workerAcquire = DBFactory IO s k -> WalletId -> (DBLayer IO s k -> IO ()) -> IO ()
forall (m :: * -> *) s (k :: Depth -> * -> *).
DBFactory m s k
-> forall a. WalletId -> (DBLayer m s k -> IO a) -> IO a
withDatabase DBFactory IO s k
df WalletId
wid
        , workerBefore :: WorkerCtx ctx -> WalletId -> IO ()
workerBefore = WorkerCtx ctx -> WalletId -> IO ()
before
        , workerAfter :: Tracer IO (WorkerLog WalletId WalletWorkerLog)
-> Either SomeException () -> IO ()
workerAfter = Tracer IO (WorkerLog WalletId WalletWorkerLog)
-> Either SomeException () -> IO ()
forall key msg a.
Tracer IO (WorkerLog key msg) -> Either SomeException a -> IO ()
defaultWorkerAfter
        -- fixme: ADP-641 Review error handling here
        , workerMain :: WorkerCtx ctx -> WalletId -> IO ()
workerMain = \WorkerCtx ctx
ctx' WalletId
_ -> IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
race_
            (ExceptT ErrNoSuchWallet IO () -> IO ()
forall (m :: * -> *) e a.
(MonadFail m, Show e) =>
ExceptT e m a -> m a
unsafeRunExceptT (ExceptT ErrNoSuchWallet IO () -> IO ())
-> ExceptT ErrNoSuchWallet IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WalletLayer IO s k -> WalletId -> ExceptT ErrNoSuchWallet IO ()
forall ctx s (k :: Depth -> * -> *).
(HasNetworkLayer IO ctx, HasDBLayer IO s k ctx,
 HasLogger IO WalletWorkerLog ctx, IsOurs s Address,
 IsOurs s RewardAccount, AddressBookIso s, MaybeLight s) =>
ctx -> WalletId -> ExceptT ErrNoSuchWallet IO ()
W.restoreWallet WalletLayer IO s k
WorkerCtx ctx
ctx' WalletId
wid)
            (IO Any -> IO () -> IO ()
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
race_
                (IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ LocalTxSubmissionConfig -> WalletLayer IO s k -> WalletId -> IO ()
forall ctx s (k :: Depth -> * -> *) (m :: * -> *).
(MonadUnliftIO m, MonadMonotonicTime m,
 HasLogger IO WalletWorkerLog ctx, HasNetworkLayer m ctx,
 HasDBLayer m s k ctx) =>
LocalTxSubmissionConfig -> ctx -> WalletId -> m ()
W.runLocalTxSubmissionPool LocalTxSubmissionConfig
txCfg WalletLayer IO s k
WorkerCtx ctx
ctx' WalletId
wid)
                (WorkerCtx ctx -> WalletId -> IO ()
coworker WorkerCtx ctx
ctx' WalletId
wid))
        }
    txCfg :: LocalTxSubmissionConfig
txCfg = LocalTxSubmissionConfig
W.defaultLocalTxSubmissionConfig

-- | Something to pass as the coworker action to 'newApiLayer', which does
-- nothing, and never exits.
idleWorker :: ctx -> wid -> IO a
idleWorker :: ctx -> wid -> IO a
idleWorker ctx
_ wid
_ = IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO a) -> IO () -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
forall a. Bounded a => a
maxBound

-- | Run an action in a particular worker context. Fails if there's no worker
-- for a given id.
withWorkerCtx
    :: forall ctx s k m a.
        ( HasWorkerRegistry s k ctx
        , HasDBFactory s k ctx
        , MonadIO m
        )
    => ctx
        -- ^ A context that has a registry
    -> WalletId
        -- ^ Wallet to look for
    -> (ErrNoSuchWallet -> m a)
        -- ^ Wallet not present, handle error
    -> (ErrWalletNotResponding -> m a)
        -- ^ Wallet worker is dead, handle error
    -> (WorkerCtx ctx -> m a)
        -- ^ Do something with the wallet
    -> m a
withWorkerCtx :: ctx
-> WalletId
-> (ErrNoSuchWallet -> m a)
-> (ErrWalletNotResponding -> m a)
-> (WorkerCtx ctx -> m a)
-> m a
withWorkerCtx ctx
ctx WalletId
wid ErrNoSuchWallet -> m a
onMissing ErrWalletNotResponding -> m a
onNotResponding WorkerCtx ctx -> m a
action =
    WorkerRegistry WalletId (DBLayer IO s k)
-> WalletId -> m (Maybe (Worker WalletId (DBLayer IO s k)))
forall (m :: * -> *) key resource.
(MonadIO m, Ord key) =>
WorkerRegistry key resource
-> key -> m (Maybe (Worker key resource))
Registry.lookup WorkerRegistry WalletId (DBLayer IO s k)
re WalletId
wid m (Maybe (Worker WalletId (DBLayer IO s k)))
-> (Maybe (Worker WalletId (DBLayer IO s k)) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Worker WalletId (DBLayer IO s k))
Nothing -> do
            [WalletId]
wids <- IO [WalletId] -> m [WalletId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WalletId] -> m [WalletId]) -> IO [WalletId] -> m [WalletId]
forall a b. (a -> b) -> a -> b
$ DBFactory IO s k -> IO [WalletId]
forall (m :: * -> *) s (k :: Depth -> * -> *).
DBFactory m s k -> IO [WalletId]
listDatabases DBFactory IO s k
df
            if WalletId
wid WalletId -> [WalletId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WalletId]
wids then
                ErrWalletNotResponding -> m a
onNotResponding (WalletId -> ErrWalletNotResponding
ErrWalletNotResponding WalletId
wid)
            else
                ErrNoSuchWallet -> m a
onMissing (WalletId -> ErrNoSuchWallet
ErrNoSuchWallet WalletId
wid)
        Just Worker WalletId (DBLayer IO s k)
wrk ->
            WorkerCtx ctx -> m a
action (WorkerCtx ctx -> m a) -> WorkerCtx ctx -> m a
forall a b. (a -> b) -> a -> b
$ DBLayer IO s k
-> (WorkerMsg ctx -> WorkerLog (WorkerKey ctx) (WorkerMsg ctx))
-> ctx
-> WorkerCtx ctx
forall resource ctx.
HasWorkerCtx resource ctx =>
resource
-> (WorkerMsg ctx -> WorkerLog (WorkerKey ctx) (WorkerMsg ctx))
-> ctx
-> WorkerCtx ctx
hoistResource (Worker WalletId (DBLayer IO s k) -> DBLayer IO s k
forall key resource. Worker key resource -> resource
workerResource Worker WalletId (DBLayer IO s k)
wrk) (WalletId -> WalletWorkerLog -> WorkerLog WalletId WalletWorkerLog
forall key msg. key -> msg -> WorkerLog key msg
MsgFromWorker WalletId
wid) ctx
ctx
  where
    re :: WorkerRegistry WalletId (DBLayer IO s k)
re = ctx
ctx ctx
-> ((WorkerRegistry WalletId (DBLayer IO s k)
     -> Const
          (WorkerRegistry WalletId (DBLayer IO s k))
          (WorkerRegistry WalletId (DBLayer IO s k)))
    -> ctx -> Const (WorkerRegistry WalletId (DBLayer IO s k)) ctx)
-> WorkerRegistry WalletId (DBLayer IO s k)
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
forall s (k :: Depth -> * -> *) ctx.
HasWorkerRegistry s k ctx =>
Lens' ctx (WorkerRegistry WalletId (DBLayer IO s k))
workerRegistry @s @k
    df :: DBFactory IO s k
df = ctx
ctx ctx
-> ((DBFactory IO s k
     -> Const (DBFactory IO s k) (DBFactory IO s k))
    -> ctx -> Const (DBFactory IO s k) ctx)
-> DBFactory IO s k
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. forall ctx. HasDBFactory s k ctx => Lens' ctx (DBFactory IO s k)
forall s (k :: Depth -> * -> *) ctx.
HasDBFactory s k ctx =>
Lens' ctx (DBFactory IO s k)
dbFactory @s @k

{-------------------------------------------------------------------------------
    Atomic handler operations
-------------------------------------------------------------------------------}
atomicallyWithHandler
    :: Ord lock
    => Concierge.Concierge IO lock -> lock -> Handler a -> Handler a
atomicallyWithHandler :: Concierge IO lock -> lock -> Handler a -> Handler a
atomicallyWithHandler Concierge IO lock
c lock
l = ExceptT ServerError IO a -> Handler a
forall a. ExceptT ServerError IO a -> Handler a
Handler (ExceptT ServerError IO a -> Handler a)
-> (Handler a -> ExceptT ServerError IO a)
-> Handler a
-> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concierge IO lock
-> lock -> ExceptT ServerError IO a -> ExceptT ServerError IO a
forall lock (m :: * -> *) a.
(Ord lock, MonadIO m, MonadThrow m) =>
Concierge IO lock -> lock -> m a -> m a
Concierge.atomicallyWith Concierge IO lock
c lock
l (ExceptT ServerError IO a -> ExceptT ServerError IO a)
-> (Handler a -> ExceptT ServerError IO a)
-> Handler a
-> ExceptT ServerError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler a -> ExceptT ServerError IO a
forall a. Handler a -> ExceptT ServerError IO a
runHandler'

{-------------------------------------------------------------------------------
                                Error Handling
-------------------------------------------------------------------------------}

-- | Maps types to servant error responses.
class IsServerError e where
    -- | A structured human-readable error code to return to API clients.
    toServerError :: e -> ServerError

-- | Lift our wallet layer into servant 'Handler', by mapping each error to a
-- corresponding servant error.
liftHandler :: IsServerError e => ExceptT e IO a -> Handler a
liftHandler :: ExceptT e IO a -> Handler a
liftHandler ExceptT e IO a
action = ExceptT ServerError IO a -> Handler a
forall a. ExceptT ServerError IO a -> Handler a
Handler ((e -> ServerError) -> ExceptT e IO a -> ExceptT ServerError IO a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT e -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ExceptT e IO a
action)

liftE :: IsServerError e => e -> Handler a
liftE :: e -> Handler a
liftE = ExceptT e IO a -> Handler a
forall e a. IsServerError e => ExceptT e IO a -> Handler a
liftHandler (ExceptT e IO a -> Handler a)
-> (e -> ExceptT e IO a) -> e -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExceptT e IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE

apiError :: ServerError -> ApiErrorCode -> Text -> ServerError
apiError :: ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
code Text
message = ServerError
err
    { errBody :: ByteString
errBody = Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object
        [ Key
"code" Key -> ApiErrorCode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ApiErrorCode
code
        , Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Text -> Text -> Text
T.replace Text
"\n" Text
" " Text
message
        ]
    , errHeaders :: [Header]
errHeaders =
        (HeaderName
hContentType, MediaType -> ByteString
forall h. RenderHeader h => h -> ByteString
renderHeader (MediaType -> ByteString) -> MediaType -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy JSON -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy JSON -> MediaType) -> Proxy JSON -> MediaType
forall a b. (a -> b) -> a -> b
$ Proxy JSON
forall k (t :: k). Proxy t
Proxy @JSON)
        Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: ServerError -> [Header]
errHeaders ServerError
err
    }

data ErrUnexpectedPoolIdPlaceholder = ErrUnexpectedPoolIdPlaceholder
    deriving (ErrUnexpectedPoolIdPlaceholder
-> ErrUnexpectedPoolIdPlaceholder -> Bool
(ErrUnexpectedPoolIdPlaceholder
 -> ErrUnexpectedPoolIdPlaceholder -> Bool)
-> (ErrUnexpectedPoolIdPlaceholder
    -> ErrUnexpectedPoolIdPlaceholder -> Bool)
-> Eq ErrUnexpectedPoolIdPlaceholder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrUnexpectedPoolIdPlaceholder
-> ErrUnexpectedPoolIdPlaceholder -> Bool
$c/= :: ErrUnexpectedPoolIdPlaceholder
-> ErrUnexpectedPoolIdPlaceholder -> Bool
== :: ErrUnexpectedPoolIdPlaceholder
-> ErrUnexpectedPoolIdPlaceholder -> Bool
$c== :: ErrUnexpectedPoolIdPlaceholder
-> ErrUnexpectedPoolIdPlaceholder -> Bool
Eq, Int -> ErrUnexpectedPoolIdPlaceholder -> ShowS
[ErrUnexpectedPoolIdPlaceholder] -> ShowS
ErrUnexpectedPoolIdPlaceholder -> String
(Int -> ErrUnexpectedPoolIdPlaceholder -> ShowS)
-> (ErrUnexpectedPoolIdPlaceholder -> String)
-> ([ErrUnexpectedPoolIdPlaceholder] -> ShowS)
-> Show ErrUnexpectedPoolIdPlaceholder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrUnexpectedPoolIdPlaceholder] -> ShowS
$cshowList :: [ErrUnexpectedPoolIdPlaceholder] -> ShowS
show :: ErrUnexpectedPoolIdPlaceholder -> String
$cshow :: ErrUnexpectedPoolIdPlaceholder -> String
showsPrec :: Int -> ErrUnexpectedPoolIdPlaceholder -> ShowS
$cshowsPrec :: Int -> ErrUnexpectedPoolIdPlaceholder -> ShowS
Show)

data ErrCreateWallet
    = ErrCreateWalletAlreadyExists ErrWalletAlreadyExists
        -- ^ Wallet already exists
    | ErrCreateWalletFailedToCreateWorker
        -- ^ Somehow, we couldn't create a worker or open a db connection
    deriving (ErrCreateWallet -> ErrCreateWallet -> Bool
(ErrCreateWallet -> ErrCreateWallet -> Bool)
-> (ErrCreateWallet -> ErrCreateWallet -> Bool)
-> Eq ErrCreateWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrCreateWallet -> ErrCreateWallet -> Bool
$c/= :: ErrCreateWallet -> ErrCreateWallet -> Bool
== :: ErrCreateWallet -> ErrCreateWallet -> Bool
$c== :: ErrCreateWallet -> ErrCreateWallet -> Bool
Eq, Int -> ErrCreateWallet -> ShowS
[ErrCreateWallet] -> ShowS
ErrCreateWallet -> String
(Int -> ErrCreateWallet -> ShowS)
-> (ErrCreateWallet -> String)
-> ([ErrCreateWallet] -> ShowS)
-> Show ErrCreateWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrCreateWallet] -> ShowS
$cshowList :: [ErrCreateWallet] -> ShowS
show :: ErrCreateWallet -> String
$cshow :: ErrCreateWallet -> String
showsPrec :: Int -> ErrCreateWallet -> ShowS
$cshowsPrec :: Int -> ErrCreateWallet -> ShowS
Show)

data ErrTemporarilyDisabled = ErrTemporarilyDisabled
    deriving (ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool
(ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool)
-> (ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool)
-> Eq ErrTemporarilyDisabled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool
$c/= :: ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool
== :: ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool
$c== :: ErrTemporarilyDisabled -> ErrTemporarilyDisabled -> Bool
Eq, Int -> ErrTemporarilyDisabled -> ShowS
[ErrTemporarilyDisabled] -> ShowS
ErrTemporarilyDisabled -> String
(Int -> ErrTemporarilyDisabled -> ShowS)
-> (ErrTemporarilyDisabled -> String)
-> ([ErrTemporarilyDisabled] -> ShowS)
-> Show ErrTemporarilyDisabled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrTemporarilyDisabled] -> ShowS
$cshowList :: [ErrTemporarilyDisabled] -> ShowS
show :: ErrTemporarilyDisabled -> String
$cshow :: ErrTemporarilyDisabled -> String
showsPrec :: Int -> ErrTemporarilyDisabled -> ShowS
$cshowsPrec :: Int -> ErrTemporarilyDisabled -> ShowS
Show)

-- | Small helper to easy show things to Text
showT :: Show a => a -> Text
showT :: a -> Text
showT = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

instance IsServerError ErrCurrentEpoch where
    toServerError :: ErrCurrentEpoch -> ServerError
toServerError = \case
        ErrCurrentEpoch
ErrUnableToDetermineCurrentEpoch ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
UnableToDetermineCurrentEpoch (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I'm unable to determine the current epoch. "
                , Text
"Please wait a while for the node to sync and try again."
                ]
        ErrCurrentEpochPastHorizonException PastHorizonException
e -> PastHorizonException -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError PastHorizonException
e

instance IsServerError ErrUnexpectedPoolIdPlaceholder where
    toServerError :: ErrUnexpectedPoolIdPlaceholder -> ServerError
toServerError = \case
        ErrUnexpectedPoolIdPlaceholder
ErrUnexpectedPoolIdPlaceholder ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
BadRequest (TextDecodingError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty TextDecodingError
msg)
      where
        Left TextDecodingError
msg = Text -> Either TextDecodingError PoolId
forall a. FromText a => Text -> Either TextDecodingError a
fromText @PoolId Text
"INVALID"

instance IsServerError ErrNoSuchWallet where
    toServerError :: ErrNoSuchWallet -> ServerError
toServerError = \case
        ErrNoSuchWallet WalletId
wid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err404 ApiErrorCode
NoSuchWallet (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't find a wallet with the given id: "
                , WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid
                ]

instance IsServerError ErrWalletNotResponding where
    toServerError :: ErrWalletNotResponding -> ServerError
toServerError = \case
        ErrWalletNotResponding WalletId
wid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
WalletNotResponding (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"That's embarrassing. My associated worker for", WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid
                , Text
"is no longer responding. This is not something that is supposed"
                , Text
"to happen. The worker must have left a trace in the logs of"
                , Text
"severity 'Error' when it died which might explain the cause."
                , Text
"Said differently, this wallet won't be accessible until the"
                , Text
"server is restarted but there are good chances it'll recover"
                , Text
"itself upon restart."
                ]

instance IsServerError ErrWalletAlreadyExists where
    toServerError :: ErrWalletAlreadyExists -> ServerError
toServerError = \case
        ErrWalletAlreadyExists WalletId
wid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err409 ApiErrorCode
WalletAlreadyExists (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"This operation would yield a wallet with the following id: "
                , WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid
                , Text
" However, I already know of a wallet with this id."
                ]

instance IsServerError ErrCreateWallet where
    toServerError :: ErrCreateWallet -> ServerError
toServerError = \case
        ErrCreateWalletAlreadyExists ErrWalletAlreadyExists
e -> ErrWalletAlreadyExists -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWalletAlreadyExists
e
        ErrCreateWallet
ErrCreateWalletFailedToCreateWorker ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
UnexpectedError (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"That's embarrassing. Your wallet looks good, but I couldn't "
                , Text
"open a new database to store its data. This is unexpected "
                , Text
"and likely not your fault. Perhaps, check your filesystem's "
                , Text
"permissions or available space?"
                ]

instance IsServerError ErrWithRootKey where
    toServerError :: ErrWithRootKey -> ServerError
toServerError = \case
        ErrWithRootKeyNoRootKey WalletId
wid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
NoRootKey (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't find a root private key for the given wallet: "
                , WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid, Text
". However, this operation requires that I do "
                , Text
"have such a key. Either there's no such wallet, or I don't "
                , Text
"fully own it."
                ]
        ErrWithRootKeyWrongPassphrase WalletId
wid ErrWrongPassphrase
ErrWrongPassphrase ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
WrongEncryptionPassphrase (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The given encryption passphrase doesn't match the one I use "
                , Text
"to encrypt the root private key of the given wallet: "
                , WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid
                ]
        ErrWithRootKeyWrongMnemonic WalletId
wid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
WrongMnemonic (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The given mnemonic doesn't match the one this wallet was created with "
                , Text
": "
                , WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid
                ]
        ErrWithRootKeyWrongPassphrase WalletId
wid (ErrPassphraseSchemeUnsupported PassphraseScheme
s) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err501 ApiErrorCode
WrongEncryptionPassphrase (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"This build is not compiled with support for the "
                , PassphraseScheme -> Text
forall a. ToText a => a -> Text
toText PassphraseScheme
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" scheme used by the given wallet: "
                , WalletId -> Text
forall a. ToText a => a -> Text
toText WalletId
wid
                ]

instance IsServerError ErrListAssets where
    toServerError :: ErrListAssets -> ServerError
toServerError = \case
        ErrListAssetsNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e

instance IsServerError ErrGetAsset where
    toServerError :: ErrGetAsset -> ServerError
toServerError = \case
        ErrGetAssetNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrGetAsset
ErrGetAssetNotPresent ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err404 ApiErrorCode
AssetNotPresent (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The requested asset is not associated with this wallet."
                ]

instance IsServerError ErrListUTxOStatistics where
    toServerError :: ErrListUTxOStatistics -> ServerError
toServerError = \case
        ErrListUTxOStatisticsNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e

instance IsServerError ErrSignPayment where
    toServerError :: ErrSignPayment -> ServerError
toServerError = \case
        ErrSignPaymentMkTx ErrMkTransaction
e -> ErrMkTransaction -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrMkTransaction
e
        ErrSignPaymentNoSuchWallet ErrNoSuchWallet
e -> (ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e)
            { errHTTPCode :: Int
errHTTPCode = Int
404
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err404
            }
        ErrSignPaymentWithRootKey e :: ErrWithRootKey
e@ErrWithRootKeyNoRootKey{} -> (ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e)
            { errHTTPCode :: Int
errHTTPCode = Int
403
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err403
            }
        ErrSignPaymentWithRootKey e :: ErrWithRootKey
e@ErrWithRootKeyWrongPassphrase{} -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrSignPaymentWithRootKey e :: ErrWithRootKey
e@ErrWithRootKeyWrongMnemonic{} -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrSignPaymentIncorrectTTL PastHorizonException
e -> PastHorizonException -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError PastHorizonException
e

instance IsServerError ErrWitnessTx where
    toServerError :: ErrWitnessTx -> ServerError
toServerError = \case
        ErrWitnessTxSignTx ErrSignTx
e -> ErrSignTx -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrSignTx
e
        ErrWitnessTxNoSuchWallet ErrNoSuchWallet
e -> (ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e)
            { errHTTPCode :: Int
errHTTPCode = Int
404
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err404
            }
        ErrWitnessTxWithRootKey e :: ErrWithRootKey
e@ErrWithRootKeyNoRootKey{} -> (ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e)
            { errHTTPCode :: Int
errHTTPCode = Int
403
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err403
            }
        ErrWitnessTxWithRootKey e :: ErrWithRootKey
e@ErrWithRootKeyWrongPassphrase{} -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrWitnessTxWithRootKey e :: ErrWithRootKey
e@ErrWithRootKeyWrongMnemonic{} -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrWitnessTxIncorrectTTL PastHorizonException
e -> PastHorizonException -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError PastHorizonException
e

instance IsServerError ErrSignTx where
    toServerError :: ErrSignTx -> ServerError
toServerError = \case
        ErrSignTxAddressUnknown TxIn
txin ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
KeyNotFoundForAddress (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't sign the given transaction because I "
                , Text
"could not resolve the address of a transaction input "
                , Text
"that I should be tracking: ", TxIn -> Text
forall a. Show a => a -> Text
showT TxIn
txin, Text
"."
                ]
        ErrSignTx
ErrSignTxUnimplemented ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err501 ApiErrorCode
NotImplemented
                Text
"This feature is not yet implemented."

instance IsServerError ErrMkTransaction where
    toServerError :: ErrMkTransaction -> ServerError
toServerError = \case
        ErrMkTransactionTxBodyError Text
hint ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
CreatedInvalidTransaction Text
hint
        ErrMkTransactionInvalidEra AnyCardanoEra
_era ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
CreatedInvalidTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"Whoops, it seems like I just experienced a hard-fork in the "
                , Text
"middle of other tasks. This is a pretty rare situation but "
                , Text
"as a result, I must throw away what I was doing. Please "
                , Text
"retry your request."
                ]
        ErrMkTransactionJoinStakePool ErrCannotJoin
e -> ErrCannotJoin -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrCannotJoin
e
        ErrMkTransactionQuitStakePool ErrCannotQuit
e -> ErrCannotQuit -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrCannotQuit
e
        ErrMkTransactionNoSuchWallet WalletId
wid -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError (WalletId -> ErrNoSuchWallet
ErrNoSuchWallet WalletId
wid)
        ErrMkTransactionIncorrectTTL PastHorizonException
e -> PastHorizonException -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError PastHorizonException
e

instance IsServerError ErrConstructTx where
    toServerError :: ErrConstructTx -> ServerError
toServerError = \case
        ErrConstructTx
ErrConstructTxWrongPayload ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CreatedInvalidTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like I've created an empty transaction "
            , Text
"that does not have any payments, withdrawals, delegations, "
            , Text
"metadata nor minting. Include at least one of them."
            ]
        ErrConstructTxBody ErrMkTransaction
e -> ErrMkTransaction -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrMkTransaction
e
        ErrConstructTxNoSuchWallet ErrNoSuchWallet
e -> (ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e)
            { errHTTPCode :: Int
errHTTPCode = Int
404
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err404
            }
        ErrConstructTxReadRewardAccount ErrReadRewardAccount
e -> ErrReadRewardAccount -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrReadRewardAccount
e
        ErrConstructTxIncorrectTTL PastHorizonException
e -> PastHorizonException -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError PastHorizonException
e
        ErrConstructTx
ErrConstructTxMultidelegationNotSupported ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CreatedMultidelegationTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like I've created a transaction "
            , Text
"with multiple delegations, which is not supported at this moment."
            , Text
"Please use at most one delegation action: join, quit or none."
            ]
        ErrConstructTx
ErrConstructTxMultiaccountNotSupported ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CreatedMultiaccountTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like I've created a transaction "
            , Text
"with a delegation, which uses a stake key for the unsupported account."
            , Text
"Please use delegation action engaging '0H' account."
            ]
        ErrConstructTx
ErrConstructTxWrongMintingBurningTemplate ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CreatedWrongPolicyScriptTemplate (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like I've created a transaction with a minting/burning "
            , Text
"policy script that either does not pass validation, contains "
            , Text
"more than one cosigner, or has a cosigner that is different "
            , Text
"from cosigner#0."
            ]
        ErrConstructTx
ErrConstructTxAssetNameTooLong ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
AssetNameTooLong (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Attempted to create a transaction with an asset name that is "
            , Text
"too long. The maximum length is 32 bytes."
            ]
        ErrConstructTx
ErrConstructTxMintOrBurnAssetQuantityOutOfBounds ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
MintOrBurnAssetQuantityOutOfBounds (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Attempted to mint or burn an asset quantity that is out of "
            , Text
"bounds. The asset quantity must be greater than zero and must "
            , Text
"not exceed 9223372036854775807 (2^63 - 1)."
            ]
        ErrConstructTx
ErrConstructTxWrongValidityBounds ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InvalidValidityBounds (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
            [ Text
"Attempted to create a transaction with invalid validity bounds."
            , Text
"Please make sure that the 'invalid_before' bound precedes the"
            , Text
"'invalid_hereafter' bound, and that you have not used negative"
            , Text
"time values."
            ]
        ErrConstructTx
ErrConstructTxValidityIntervalNotWithinScriptTimelock ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
ValidityIntervalNotInsideScriptTimelock (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
            [ Text
"Attempted to create a transaction with a validity interval"
            , Text
"that is not a subinterval of an associated script's timelock"
            , Text
"interval."
            ]
        ErrConstructTx
ErrConstructTxSharedWalletPending ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletPending (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"I cannot construct transaction for a shared wallet that is in 'incomplete' "
            , Text
"state. Please update your wallet accordingly with "
            , Text
"'PATCH /shared-wallets/{walletId}/payment-script-template' or "
            , Text
"'PATCH /shared-wallets/{walletId}/delegation-script-template' to make "
            , Text
"it applicable for constructing transaction."
            ]
        ErrConstructTxNotImplemented String
_ ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err501 ApiErrorCode
NotImplemented
                Text
"This feature is not yet implemented."

instance IsServerError ErrGetPolicyId where
    toServerError :: ErrGetPolicyId -> ServerError
toServerError = \case
        ErrGetPolicyIdReadPolicyPubliKey ErrReadPolicyPublicKey
e -> ErrReadPolicyPublicKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrReadPolicyPublicKey
e
        ErrGetPolicyId
ErrGetPolicyIdWrongMintingBurningTemplate ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CreatedWrongPolicyScriptTemplate (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like policy id is requested for a "
            , Text
"policy script that either does not pass validation, contains "
            , Text
"more than one cosigner, or has a cosigner that is different "
            , Text
"from cosigner#0."
            ]

instance IsServerError ErrDecodeTx where
    toServerError :: ErrDecodeTx -> ServerError
toServerError = \case
        ErrDecodeTxNoSuchWallet ErrNoSuchWallet
e -> (ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e)
            { errHTTPCode :: Int
errHTTPCode = Int
404
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err404
            }

instance IsServerError ErrBalanceTx where
    toServerError :: ErrBalanceTx -> ServerError
toServerError = \case
        ErrBalanceTx
ErrByronTxNotSupported ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxByronNotSupported
                Text
"Balancing Byron transactions is not supported."
        ErrBalanceTxUpdateError (ErrExistingKeyWitnesses Int
n) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxExistingKeyWitnesses (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The transaction could not be balanced, because it contains "
                , String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n), Text
" "
                , Text
"existing key-witnesses which would be invalid after "
                , Text
"the transaction body is modified. "
                , Text
"Please sign the transaction after it is balanced instead."
                ]
        ErrBalanceTxSelectAssets ErrSelectAssets
err -> ErrSelectAssets -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrSelectAssets
err
        ErrBalanceTxAssignRedeemers ErrAssignRedeemers
err -> ErrAssignRedeemers -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrAssignRedeemers
err
        ErrBalanceTx
ErrBalanceTxConflictingNetworks ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxConflictingNetworks (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"There are withdrawals for multiple networks (e.g. both"
                , Text
"mainnet and testnet) in the provided transaction. This"
                , Text
"makes no sense, and I'm confused."
                ]
        ErrBalanceTx
ErrBalanceTxExistingCollateral ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxExistingCollateral
                Text
"I cannot balance transactions with pre-defined collateral."

        ErrBalanceTx
ErrBalanceTxExistingTotalCollateral ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxExistingTotalCollateral (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I cannot balance transactions"
                , Text
"with pre-defined total collateral."
                ]
        ErrBalanceTx
ErrBalanceTxExistingReturnCollateral ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxExistingReturnCollateral (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"Balancing transactions with pre-defined"
                , Text
"collateral return outputs is not yet supported."
                ]
        ErrBalanceTx
ErrBalanceTxZeroAdaOutput ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err501 ApiErrorCode
BalanceTxZeroAdaOutput (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I don't currently support balancing transactions containing"
                , Text
"one or more zero-ada outputs. In the future I might be able"
                , Text
"to increase the values to the minimum allowed ada value."
                ]
        ErrBalanceTxInternalError (ErrFailedBalancing Value
v) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
BalanceTxInternalError (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I have somehow failed to balance the transaction."
                , Text
"The balance is"
                , String -> Text
T.pack (Value -> String
forall a. Show a => a -> String
show Value
v)
                ]
        ErrBalanceTxInternalError (ErrUnderestimatedFee Coin
c SealedTx
_) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
BalanceTxUnderestimatedFee (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I have somehow underestimated the fee of the transaction by"
                , Coin -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Coin
c
                , Text
"and cannot finish balancing."
                ]
        ErrBalanceTx
ErrBalanceTxMaxSizeLimitExceeded ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
BalanceTxMaxSizeLimitExceeded (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I was not able to balance the transaction without exceeding"
                , Text
"the maximum transaction size."
                ]


instance IsServerError ErrRemoveTx where
    toServerError :: ErrRemoveTx -> ServerError
toServerError = \case
        ErrRemoveTxNoSuchWallet ErrNoSuchWallet
wid -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
wid
        ErrRemoveTxNoSuchTransaction (ErrNoSuchTransaction WalletId
_wid Hash "Tx"
tid) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err404 ApiErrorCode
NoSuchTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't find a transaction with the given id: "
                , Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText Hash "Tx"
tid
                ]
        ErrRemoveTxAlreadyInLedger Hash "Tx"
tid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
TransactionAlreadyInLedger (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The transaction with id: ", Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText Hash "Tx"
tid,
                  Text
" cannot be forgotten as it is already in the ledger."
                ]

instance IsServerError ErrPostTx where
    toServerError :: ErrPostTx -> ServerError
toServerError = \case
        ErrPostTxValidationError Text
err ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err500 ApiErrorCode
CreatedInvalidTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The submitted transaction was rejected by the local "
                , Text
"node. Here's an error message that may help with "
                , Text
"debugging:\n", Text
err
                ]

instance IsServerError ErrSubmitTransaction where
    toServerError :: ErrSubmitTransaction -> ServerError
toServerError = \case
        ErrSubmitTransactionNoSuchWallet ErrNoSuchWallet
e -> (ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e)
            { errHTTPCode :: Int
errHTTPCode = Int
404
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err404
            }
        ErrSubmitTransaction
ErrSubmitTransactionForeignWallet ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
ForeignTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The transaction to be submitted is foreign to the current wallet "
                , Text
"and cannot be sent. Submit a transaction that has either input "
                , Text
"or withdrawal belonging to the wallet."
                ]
        ErrSubmitTransactionPartiallySignedOrNoSignedTx Int
expectedWitsNo Int
foundWitsNo ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
MissingWitnessesInTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"The transaction has ", Int -> Text
forall a. ToText a => a -> Text
toText Int
expectedWitsNo
                , Text
" inputs and ", Int -> Text
forall a. ToText a => a -> Text
toText Int
foundWitsNo, Text
" witnesses included."
                , Text
" Submit fully-signed transaction."
                ]
        ErrSubmitTransaction
ErrSubmitTransactionMultidelegationNotSupported ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CreatedMultidelegationTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like the transaction to be sent contains"
            , Text
"multiple delegations, which is not supported at this moment."
            , Text
"Please use at most one delegation action in a submitted transaction: join, quit or none."
            ]

instance IsServerError ErrSubmitTx where
    toServerError :: ErrSubmitTx -> ServerError
toServerError = \case
        ErrSubmitTxNetwork ErrPostTx
e -> ErrPostTx -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrPostTx
e
        ErrSubmitTxNoSuchWallet e :: ErrNoSuchWallet
e@ErrNoSuchWallet{} -> (ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e)
            { errHTTPCode :: Int
errHTTPCode = Int
404
            , errReasonPhrase :: String
errReasonPhrase = ServerError -> String
errReasonPhrase ServerError
err404
            }
        ErrSubmitTxImpossible ErrNoSuchTransaction
e -> ErrNoSuchTransaction -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchTransaction
e

instance IsServerError ErrUpdatePassphrase where
    toServerError :: ErrUpdatePassphrase -> ServerError
toServerError = \case
        ErrUpdatePassphraseNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrUpdatePassphraseWithRootKey ErrWithRootKey
e  -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e

instance IsServerError ErrListTransactions where
    toServerError :: ErrListTransactions -> ServerError
toServerError = \case
        ErrListTransactionsNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrListTransactionsStartTimeLaterThanEndTime ErrStartTimeLaterThanEndTime
e -> ErrStartTimeLaterThanEndTime -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrStartTimeLaterThanEndTime
e
        ErrListTransactions
ErrListTransactionsMinWithdrawalWrong ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
MinWithdrawalWrong
            Text
"The minimum withdrawal value must be at least 1 Lovelace."
        ErrListTransactionsPastHorizonException PastHorizonException
e -> PastHorizonException -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError PastHorizonException
e

instance IsServerError ErrStartTimeLaterThanEndTime where
    toServerError :: ErrStartTimeLaterThanEndTime -> ServerError
toServerError ErrStartTimeLaterThanEndTime
err = ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
StartTimeLaterThanEndTime (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"The specified start time '"
        , Iso8601Time -> Text
forall a. ToText a => a -> Text
toText (Iso8601Time -> Text) -> Iso8601Time -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> Iso8601Time
Iso8601Time (UTCTime -> Iso8601Time) -> UTCTime -> Iso8601Time
forall a b. (a -> b) -> a -> b
$ ErrStartTimeLaterThanEndTime -> UTCTime
errStartTime ErrStartTimeLaterThanEndTime
err
        , Text
"' is later than the specified end time '"
        , Iso8601Time -> Text
forall a. ToText a => a -> Text
toText (Iso8601Time -> Text) -> Iso8601Time -> Text
forall a b. (a -> b) -> a -> b
$ UTCTime -> Iso8601Time
Iso8601Time (UTCTime -> Iso8601Time) -> UTCTime -> Iso8601Time
forall a b. (a -> b) -> a -> b
$ ErrStartTimeLaterThanEndTime -> UTCTime
errEndTime ErrStartTimeLaterThanEndTime
err
        , Text
"'."
        ]

instance IsServerError PastHorizonException where
    toServerError :: PastHorizonException -> ServerError
toServerError PastHorizonException
_ = ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err503 ApiErrorCode
PastHorizon (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Tried to convert something that is past the horizon"
        , Text
" (due to uncertainty about the next hard fork)."
        , Text
" Wait for the node to finish syncing to the hard fork."
        , Text
" Depending on the blockchain, this process can take an"
        , Text
" unknown amount of time."
        ]

instance IsServerError ErrGetTransaction where
    toServerError :: ErrGetTransaction -> ServerError
toServerError = \case
        ErrGetTransactionNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrGetTransactionNoSuchTransaction ErrNoSuchTransaction
e -> ErrNoSuchTransaction -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchTransaction
e

instance IsServerError ErrNoSuchTransaction where
    toServerError :: ErrNoSuchTransaction -> ServerError
toServerError = \case
        ErrNoSuchTransaction WalletId
_wid Hash "Tx"
tid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err404 ApiErrorCode
NoSuchTransaction (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't find a transaction with the given id: "
                , Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText Hash "Tx"
tid
                ]

instance IsServerError ErrStakePoolDelegation where
    toServerError :: ErrStakePoolDelegation -> ServerError
toServerError = \case
        ErrStakePoolDelegationNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrStakePoolJoin ErrCannotJoin
e -> ErrCannotJoin -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrCannotJoin
e
        ErrStakePoolQuit ErrCannotQuit
e -> ErrCannotQuit -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrCannotQuit
e

instance IsServerError ErrCannotJoin where
    toServerError :: ErrCannotJoin -> ServerError
toServerError = \case
        ErrAlreadyDelegating PoolId
pid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
PoolAlreadyJoined (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't join a stake pool with the given id: "
                , PoolId -> Text
forall a. ToText a => a -> Text
toText PoolId
pid
                , Text
". I have already joined this pool;"
                , Text
" joining again would incur an unnecessary fee!"
                ]
        ErrNoSuchPool PoolId
pid ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err404 ApiErrorCode
NoSuchPool (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't find any stake pool with the given id: "
                , PoolId -> Text
forall a. ToText a => a -> Text
toText PoolId
pid
                ]

instance IsServerError ErrCannotQuit where
    toServerError :: ErrCannotQuit -> ServerError
toServerError = \case
        ErrCannotQuit
ErrNotDelegatingOrAboutTo ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
NotDelegatingTo (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It seems that you're trying to retire from delegation "
                , Text
"although you're not even delegating, nor won't be in an "
                , Text
"immediate future."
                ]
        ErrNonNullRewards Coin
rewards ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
NonNullRewards (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It seems that you're trying to retire from delegation "
                , Text
"although you've unspoiled rewards in your rewards "
                , Text
"account! Make sure to withdraw your ", Coin -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Coin
rewards
                , Text
" lovelace first."
                ]

instance IsServerError ErrFetchRewards where
    toServerError :: ErrFetchRewards -> ServerError
toServerError = \case
        ErrFetchRewardsReadRewardAccount ErrReadRewardAccount
e -> ErrReadRewardAccount -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrReadRewardAccount
e

instance IsServerError ErrReadRewardAccount where
    toServerError :: ErrReadRewardAccount -> ServerError
toServerError = \case
        ErrReadRewardAccountNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrReadRewardAccount
ErrReadRewardAccountNotAShelleyWallet ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InvalidWalletType (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It is regrettable but you've just attempted an operation "
                , Text
"that is invalid for this type of wallet. Only new 'Shelley' "
                , Text
"wallets can do something with rewards and this one isn't."
                ]

instance IsServerError ErrReadPolicyPublicKey where
    toServerError :: ErrReadPolicyPublicKey -> ServerError
toServerError = \case
        ErrReadPolicyPublicKeyNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrReadPolicyPublicKey
ErrReadPolicyPublicKeyNotAShelleyWallet ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InvalidWalletType (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"You have attempted an operation that is invalid for this "
                , Text
"type of wallet. Only wallets from the Shelley era onwards "
                , Text
"can have rewards, but this wallet is from an era before "
                , Text
"Shelley."
                ]
        ErrReadPolicyPublicKey
ErrReadPolicyPublicKeyAbsent ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
MissingPolicyPublicKey (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"It seems the wallet lacks a policy public key. Therefore"
                , Text
"it's not possible to create a minting/burning"
                , Text
"transaction or get a policy id. Please first POST to endpoint"
                , Text
"/wallets/{walletId}/policy-key to set a policy key."
                ]

instance IsServerError ErrWritePolicyPublicKey where
    toServerError :: ErrWritePolicyPublicKey -> ServerError
toServerError = \case
        ErrWritePolicyPublicKeyNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrWritePolicyPublicKeyWithRootKey  ErrWithRootKey
e -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e

instance IsServerError ErrCreateRandomAddress where
    toServerError :: ErrCreateRandomAddress -> ServerError
toServerError = \case
        ErrCreateAddrNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrCreateAddrWithRootKey  ErrWithRootKey
e -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrIndexAlreadyExists Index 'Hardened 'AddressK
ix ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err409 ApiErrorCode
AddressAlreadyExists (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I cannot derive a new unused address #", Int -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Index 'Hardened 'AddressK -> Int
forall a. Enum a => a -> Int
fromEnum Index 'Hardened 'AddressK
ix)
                , Text
" because I already know of such address."
                ]
        ErrCreateRandomAddress
ErrCreateAddressNotAByronWallet ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InvalidWalletType (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I cannot derive new address for this wallet type."
                , Text
" Make sure to use Byron random wallet id."
                ]

instance IsServerError ErrImportRandomAddress where
    toServerError :: ErrImportRandomAddress -> ServerError
toServerError = \case
        ErrImportAddrNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrImportRandomAddress
ErrImportAddressNotAByronWallet ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InvalidWalletType (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I cannot derive new address for this wallet type."
                , Text
" Make sure to use Byron random wallet id."
                ]
        ErrImportAddr ErrAddrDoesNotBelong{} ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
KeyNotFoundForAddress (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't identify this address as one of mine. It likely "
                , Text
"belongs to another wallet and I will therefore not import it."
                ]

instance IsServerError ErrNotASequentialWallet where
    toServerError :: ErrNotASequentialWallet -> ServerError
toServerError = \case
        ErrNotASequentialWallet
ErrNotASequentialWallet ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InvalidWalletType (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I cannot derive new address for this wallet type. "
                , Text
"Make sure to use a sequential wallet style, like Icarus."
                ]

instance IsServerError ErrWithdrawalNotWorth where
    toServerError :: ErrWithdrawalNotWorth -> ServerError
toServerError = \case
        ErrWithdrawalNotWorth
ErrWithdrawalNotWorth ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
WithdrawalNotWorth (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I've noticed that you're requesting a withdrawal from an "
                , Text
"account that is either empty or doesn't have a balance big "
                , Text
"enough to deserve being withdrawn. I won't proceed with that "
                , Text
"request."
                ]

instance IsServerError ErrSignMetadataWith where
    toServerError :: ErrSignMetadataWith -> ServerError
toServerError = \case
        ErrSignMetadataWithRootKey ErrWithRootKey
e -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrSignMetadataWithNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrSignMetadataWithInvalidIndex ErrInvalidDerivationIndex 'Soft 'AddressK
e -> ErrInvalidDerivationIndex 'Soft 'AddressK -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrInvalidDerivationIndex 'Soft 'AddressK
e

instance IsServerError ErrReadAccountPublicKey where
    toServerError :: ErrReadAccountPublicKey -> ServerError
toServerError = \case
        ErrReadAccountPublicKeyRootKey ErrWithRootKey
e -> ErrWithRootKey -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrWithRootKey
e
        ErrReadAccountPublicKeyNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrReadAccountPublicKeyInvalidAccountIndex ErrInvalidDerivationIndex 'Hardened 'AccountK
e -> ErrInvalidDerivationIndex 'Hardened 'AccountK -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrInvalidDerivationIndex 'Hardened 'AccountK
e
        ErrReadAccountPublicKeyInvalidPurposeIndex ErrInvalidDerivationIndex 'Hardened 'PurposeK
e -> ErrInvalidDerivationIndex 'Hardened 'PurposeK -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrInvalidDerivationIndex 'Hardened 'PurposeK
e

instance IsServerError ErrDerivePublicKey where
    toServerError :: ErrDerivePublicKey -> ServerError
toServerError = \case
        ErrDerivePublicKeyNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrDerivePublicKeyInvalidIndex ErrInvalidDerivationIndex 'Soft 'AddressK
e -> ErrInvalidDerivationIndex 'Soft 'AddressK -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrInvalidDerivationIndex 'Soft 'AddressK
e

instance IsServerError ErrAddCosignerKey where
    toServerError :: ErrAddCosignerKey -> ServerError
toServerError = \case
        ErrAddCosignerKeyNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrAddCosignerKey ErrAddCosigner
WalletAlreadyActive ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletNotPending (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've tried to add a cosigner key for a "
                , Text
"shared wallet that is active. This can be done only for "
                , Text
"pending shared wallet."
                ]
        ErrAddCosignerKey ErrAddCosigner
NoDelegationTemplate ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletNoDelegationTemplate (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've tried to add a cosigner key to "
                , Text
"a shared wallet's delegation template. This cannot be done "
                , Text
"for the wallet that does not define any delegation template."
                ]
        ErrAddCosignerKey (KeyAlreadyPresent CredentialType
cred) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletKeyAlreadyExists (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've tried to add a cosigner key to a "
                , Text
"shared wallet's ", CredentialType -> Text
forall a. ToText a => a -> Text
toText CredentialType
cred, Text
" template that is already "
                , Text
"ascribed to another cosigner. "
                , Text
"Please make sure to assign a different key to each cosigner."
                ]
        ErrAddCosignerKey (NoSuchCosigner CredentialType
cred (Cosigner Word8
c)) ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletNoSuchCosigner (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've tried to add a cosigner key to a "
                , Text
"shared wallet's ", CredentialType -> Text
forall a. ToText a => a -> Text
toText CredentialType
cred, Text
" template to a "
                , Text
"non-existing cosigner index: ", Word8 -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Word8
c,Text
"."
                ]
        ErrAddCosignerKey ErrAddCosigner
CannotUpdateSharedWalletKey ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletCannotUpdateKey (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've tried to update the key of a cosigner having "
                , Text
"the shared wallet's account key. Only other cosigner key(s) can be updated."
                ]

instance IsServerError ErrConstructSharedWallet where
    toServerError :: ErrConstructSharedWallet -> ServerError
toServerError = \case
        ErrConstructSharedWalletWrongScriptTemplate (ErrScriptTemplateInvalid CredentialType
cred ErrValidateScriptTemplate
reason) ->
            CredentialType -> Text -> ServerError
forall a. ToText a => a -> Text -> ServerError
handleTemplateErr CredentialType
cred (ErrValidateScriptTemplate -> Text
forall a. ToText a => a -> Text
toText ErrValidateScriptTemplate
reason)
        ErrConstructSharedWalletWrongScriptTemplate (ErrScriptTemplateMissingKey CredentialType
cred Text
reason) ->
            CredentialType -> Text -> ServerError
forall a. ToText a => a -> Text -> ServerError
handleTemplateErr CredentialType
cred Text
reason
        ErrConstructSharedWalletInvalidIndex ErrInvalidDerivationIndex 'Hardened 'AccountK
e -> ErrInvalidDerivationIndex 'Hardened 'AccountK -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrInvalidDerivationIndex 'Hardened 'AccountK
e
      where
          handleTemplateErr :: a -> Text -> ServerError
handleTemplateErr a
cred Text
reason =
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SharedWalletScriptTemplateInvalid (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've tried to create a shared wallet "
                , Text
"with a template script for ", a -> Text
forall a. ToText a => a -> Text
toText a
cred, Text
" credential that does not "
                , Text
"pass validation. The problem is: ", Text
reason
                ]

instance IsServerError (ErrInvalidDerivationIndex 'Soft level) where
    toServerError :: ErrInvalidDerivationIndex 'Soft level -> ServerError
toServerError = \case
        ErrIndexOutOfBound Index 'Soft level
minIx Index 'Soft level
maxIx DerivationIndex
_ix ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
SoftDerivationRequired (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've provided a derivation index that is "
                , Text
"out of bound. The index is well-formed, but I require "
                , Text
"indexes valid for soft derivation only. That is, indexes "
                , Text
"between ", Index 'Soft level -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Index 'Soft level
minIx, Text
" and ", Index 'Soft level -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Index 'Soft level
maxIx, Text
" without a suffix."
                ]

instance IsServerError (SelectionOutputError WalletSelectionContext) where
    toServerError :: SelectionOutputError WalletSelectionContext -> ServerError
toServerError = \case
        SelectionOutputCoinInsufficient SelectionOutputCoinInsufficientError WalletSelectionContext
e ->
            SelectionOutputCoinInsufficientError WalletSelectionContext
-> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionOutputCoinInsufficientError WalletSelectionContext
e
        SelectionOutputSizeExceedsLimit SelectionOutputSizeExceedsLimitError WalletSelectionContext
e ->
            SelectionOutputSizeExceedsLimitError WalletSelectionContext
-> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionOutputSizeExceedsLimitError WalletSelectionContext
e
        SelectionOutputTokenQuantityExceedsLimit SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e ->
            SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
-> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e

instance IsServerError
    (SelectionOutputCoinInsufficientError WalletSelectionContext)
  where
    toServerError :: SelectionOutputCoinInsufficientError WalletSelectionContext
-> ServerError
toServerError SelectionOutputCoinInsufficientError WalletSelectionContext
e =
        ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
UtxoTooSmall (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text
preamble, Text
details]
      where
        preamble :: Text
preamble = [Text] -> Text
T.unwords
            [ Text
"One of the outputs you've specified has an ada quantity that is"
            , Text
"below the minimum required. Either increase the ada quantity to"
            , Text
"at least the minimum, or specify an ada quantity of zero, in"
            , Text
"which case the wallet will automatically assign the correct"
            , Text
"minimum ada quantity to the output."
            ]
        details :: Text
details = [Text] -> Text
T.unlines
            [ Text
"Destination address:"
            , Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ((Address, TokenBundle) -> Address
forall a b. (a, b) -> a
fst ((Address, TokenBundle) -> Address)
-> (Address, TokenBundle) -> Address
forall a b. (a -> b) -> a -> b
$ (((Address, TokenBundle)
  -> Const (Address, TokenBundle) (Address, TokenBundle))
 -> SelectionOutputCoinInsufficientError WalletSelectionContext
 -> Const
      (Address, TokenBundle)
      (SelectionOutputCoinInsufficientError WalletSelectionContext))
-> SelectionOutputCoinInsufficientError WalletSelectionContext
-> (Address, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "output"
  (((Address, TokenBundle)
    -> Const (Address, TokenBundle) (Address, TokenBundle))
   -> SelectionOutputCoinInsufficientError WalletSelectionContext
   -> Const
        (Address, TokenBundle)
        (SelectionOutputCoinInsufficientError WalletSelectionContext))
((Address, TokenBundle)
 -> Const (Address, TokenBundle) (Address, TokenBundle))
-> SelectionOutputCoinInsufficientError WalletSelectionContext
-> Const
     (Address, TokenBundle)
     (SelectionOutputCoinInsufficientError WalletSelectionContext)
#output SelectionOutputCoinInsufficientError WalletSelectionContext
e)
            , Text
"Required minimum ada quantity:"
            , Coin -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((Coin -> Const Coin Coin)
 -> SelectionOutputCoinInsufficientError WalletSelectionContext
 -> Const
      Coin (SelectionOutputCoinInsufficientError WalletSelectionContext))
-> SelectionOutputCoinInsufficientError WalletSelectionContext
-> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "minimumExpectedCoin"
  ((Coin -> Const Coin Coin)
   -> SelectionOutputCoinInsufficientError WalletSelectionContext
   -> Const
        Coin (SelectionOutputCoinInsufficientError WalletSelectionContext))
(Coin -> Const Coin Coin)
-> SelectionOutputCoinInsufficientError WalletSelectionContext
-> Const
     Coin (SelectionOutputCoinInsufficientError WalletSelectionContext)
#minimumExpectedCoin SelectionOutputCoinInsufficientError WalletSelectionContext
e)
            , Text
"Specified ada quantity:"
            , Coin -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (TokenBundle -> Coin
TokenBundle.getCoin (TokenBundle -> Coin) -> TokenBundle -> Coin
forall a b. (a -> b) -> a -> b
$ (Address, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd ((Address, TokenBundle) -> TokenBundle)
-> (Address, TokenBundle) -> TokenBundle
forall a b. (a -> b) -> a -> b
$ (((Address, TokenBundle)
  -> Const (Address, TokenBundle) (Address, TokenBundle))
 -> SelectionOutputCoinInsufficientError WalletSelectionContext
 -> Const
      (Address, TokenBundle)
      (SelectionOutputCoinInsufficientError WalletSelectionContext))
-> SelectionOutputCoinInsufficientError WalletSelectionContext
-> (Address, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "output"
  (((Address, TokenBundle)
    -> Const (Address, TokenBundle) (Address, TokenBundle))
   -> SelectionOutputCoinInsufficientError WalletSelectionContext
   -> Const
        (Address, TokenBundle)
        (SelectionOutputCoinInsufficientError WalletSelectionContext))
((Address, TokenBundle)
 -> Const (Address, TokenBundle) (Address, TokenBundle))
-> SelectionOutputCoinInsufficientError WalletSelectionContext
-> Const
     (Address, TokenBundle)
     (SelectionOutputCoinInsufficientError WalletSelectionContext)
#output SelectionOutputCoinInsufficientError WalletSelectionContext
e)
            ]

instance IsServerError
    (SelectionOutputSizeExceedsLimitError WalletSelectionContext)
  where
    toServerError :: SelectionOutputSizeExceedsLimitError WalletSelectionContext
-> ServerError
toServerError SelectionOutputSizeExceedsLimitError WalletSelectionContext
e = ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
OutputTokenBundleSizeExceedsLimit (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"One of the outputs you've specified contains too many assets. "
        , Text
"Try splitting these assets across two or more outputs. "
        , Text
"Destination address: "
        , Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ((Address, TokenBundle) -> Address
forall a b. (a, b) -> a
fst (Address, TokenBundle)
output)
        , Text
". Asset count: "
        , Int -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (TokenMap -> Int
TokenMap.size (TokenMap -> Int) -> TokenMap -> Int
forall a b. (a -> b) -> a -> b
$ (Address, TokenBundle) -> TokenBundle
forall a b. (a, b) -> b
snd (Address, TokenBundle)
output TokenBundle
-> ((TokenMap -> Const TokenMap TokenMap)
    -> TokenBundle -> Const TokenMap TokenBundle)
-> TokenMap
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "tokens"
  ((TokenMap -> Const TokenMap TokenMap)
   -> TokenBundle -> Const TokenMap TokenBundle)
(TokenMap -> Const TokenMap TokenMap)
-> TokenBundle -> Const TokenMap TokenBundle
#tokens)
        , Text
"."
        ]
      where
        output :: (Address, TokenBundle)
output = (((Address, TokenBundle)
  -> Const (Address, TokenBundle) (Address, TokenBundle))
 -> SelectionOutputSizeExceedsLimitError WalletSelectionContext
 -> Const
      (Address, TokenBundle)
      (SelectionOutputSizeExceedsLimitError WalletSelectionContext))
-> SelectionOutputSizeExceedsLimitError WalletSelectionContext
-> (Address, TokenBundle)
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "outputThatExceedsLimit"
  (((Address, TokenBundle)
    -> Const (Address, TokenBundle) (Address, TokenBundle))
   -> SelectionOutputSizeExceedsLimitError WalletSelectionContext
   -> Const
        (Address, TokenBundle)
        (SelectionOutputSizeExceedsLimitError WalletSelectionContext))
((Address, TokenBundle)
 -> Const (Address, TokenBundle) (Address, TokenBundle))
-> SelectionOutputSizeExceedsLimitError WalletSelectionContext
-> Const
     (Address, TokenBundle)
     (SelectionOutputSizeExceedsLimitError WalletSelectionContext)
#outputThatExceedsLimit SelectionOutputSizeExceedsLimitError WalletSelectionContext
e

instance IsServerError
    (SelectionOutputTokenQuantityExceedsLimitError WalletSelectionContext)
  where
    toServerError :: SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
-> ServerError
toServerError SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e = ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
OutputTokenQuantityExceedsLimit (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"One of the token quantities you've specified is greater than the "
        , Text
"maximum quantity allowed in a single transaction output. Try "
        , Text
"splitting this quantity across two or more outputs. "
        , Text
"Destination address: "
        , Address -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((Address -> Const Address Address)
 -> SelectionOutputTokenQuantityExceedsLimitError
      WalletSelectionContext
 -> Const
      Address
      (SelectionOutputTokenQuantityExceedsLimitError
         WalletSelectionContext))
-> SelectionOutputTokenQuantityExceedsLimitError
     WalletSelectionContext
-> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "address"
  ((Address -> Const Address Address)
   -> SelectionOutputTokenQuantityExceedsLimitError
        WalletSelectionContext
   -> Const
        Address
        (SelectionOutputTokenQuantityExceedsLimitError
           WalletSelectionContext))
(Address -> Const Address Address)
-> SelectionOutputTokenQuantityExceedsLimitError
     WalletSelectionContext
-> Const
     Address
     (SelectionOutputTokenQuantityExceedsLimitError
        WalletSelectionContext)
#address SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e)
        , Text
". Token policy identifier: "
        , TokenPolicyId -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((TokenPolicyId -> Const TokenPolicyId TokenPolicyId)
 -> AssetId -> Const TokenPolicyId AssetId)
-> AssetId -> TokenPolicyId
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokenPolicyId"
  ((TokenPolicyId -> Const TokenPolicyId TokenPolicyId)
   -> AssetId -> Const TokenPolicyId AssetId)
(TokenPolicyId -> Const TokenPolicyId TokenPolicyId)
-> AssetId -> Const TokenPolicyId AssetId
#tokenPolicyId (AssetId -> TokenPolicyId) -> AssetId -> TokenPolicyId
forall a b. (a -> b) -> a -> b
$ SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
-> AssetId
forall ctx.
SelectionOutputTokenQuantityExceedsLimitError ctx -> AssetId
asset SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e)
        , Text
". Asset name: "
        , TokenName -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((TokenName -> Const TokenName TokenName)
 -> AssetId -> Const TokenName AssetId)
-> AssetId -> TokenName
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokenName"
  ((TokenName -> Const TokenName TokenName)
   -> AssetId -> Const TokenName AssetId)
(TokenName -> Const TokenName TokenName)
-> AssetId -> Const TokenName AssetId
#tokenName (AssetId -> TokenName) -> AssetId -> TokenName
forall a b. (a -> b) -> a -> b
$ SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
-> AssetId
forall ctx.
SelectionOutputTokenQuantityExceedsLimitError ctx -> AssetId
asset SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e)
        , Text
". Token quantity specified: "
        , TokenQuantity -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((TokenQuantity -> Const TokenQuantity TokenQuantity)
 -> SelectionOutputTokenQuantityExceedsLimitError
      WalletSelectionContext
 -> Const
      TokenQuantity
      (SelectionOutputTokenQuantityExceedsLimitError
         WalletSelectionContext))
-> SelectionOutputTokenQuantityExceedsLimitError
     WalletSelectionContext
-> TokenQuantity
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "quantity"
  ((TokenQuantity -> Const TokenQuantity TokenQuantity)
   -> SelectionOutputTokenQuantityExceedsLimitError
        WalletSelectionContext
   -> Const
        TokenQuantity
        (SelectionOutputTokenQuantityExceedsLimitError
           WalletSelectionContext))
(TokenQuantity -> Const TokenQuantity TokenQuantity)
-> SelectionOutputTokenQuantityExceedsLimitError
     WalletSelectionContext
-> Const
     TokenQuantity
     (SelectionOutputTokenQuantityExceedsLimitError
        WalletSelectionContext)
#quantity SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e)
        , Text
". Maximum allowable token quantity: "
        , TokenQuantity -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((TokenQuantity -> Const TokenQuantity TokenQuantity)
 -> SelectionOutputTokenQuantityExceedsLimitError
      WalletSelectionContext
 -> Const
      TokenQuantity
      (SelectionOutputTokenQuantityExceedsLimitError
         WalletSelectionContext))
-> SelectionOutputTokenQuantityExceedsLimitError
     WalletSelectionContext
-> TokenQuantity
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "quantityMaxBound"
  ((TokenQuantity -> Const TokenQuantity TokenQuantity)
   -> SelectionOutputTokenQuantityExceedsLimitError
        WalletSelectionContext
   -> Const
        TokenQuantity
        (SelectionOutputTokenQuantityExceedsLimitError
           WalletSelectionContext))
(TokenQuantity -> Const TokenQuantity TokenQuantity)
-> SelectionOutputTokenQuantityExceedsLimitError
     WalletSelectionContext
-> Const
     TokenQuantity
     (SelectionOutputTokenQuantityExceedsLimitError
        WalletSelectionContext)
#quantityMaxBound SelectionOutputTokenQuantityExceedsLimitError
  WalletSelectionContext
e)
        , Text
"."
        ]

instance IsServerError ErrCreateMigrationPlan where
    toServerError :: ErrCreateMigrationPlan -> ServerError
toServerError = \case
        ErrCreateMigrationPlan
ErrCreateMigrationPlanEmpty ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
NothingToMigrate (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I wasn't able to construct a migration plan. This could be "
                , Text
"because your wallet is empty, or it could be because the "
                , Text
"amount of ada in your wallet is insufficient to pay for "
                , Text
"any of the funds to be migrated. Try adding some ada to "
                , Text
"your wallet before trying again."
                ]
        ErrCreateMigrationPlanNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e

instance IsServerError ErrSelectAssets where
    toServerError :: ErrSelectAssets -> ServerError
toServerError = \case
        ErrSelectAssetsPrepareOutputsError SelectionOutputError WalletSelectionContext
e -> SelectionOutputError WalletSelectionContext -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionOutputError WalletSelectionContext
e
        ErrSelectAssetsNoSuchWallet ErrNoSuchWallet
e -> ErrNoSuchWallet -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError ErrNoSuchWallet
e
        ErrSelectAssetsAlreadyWithdrawing Tx
tx ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
AlreadyWithdrawing (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I already know of a pending transaction with withdrawals: "
                , Hash "Tx" -> Text
forall a. ToText a => a -> Text
toText (Tx
tx Tx
-> ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
    -> Tx -> Const (Hash "Tx") Tx)
-> Hash "Tx"
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
^. IsLabel
  "txId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> Tx -> Const (Hash "Tx") Tx)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> Tx -> Const (Hash "Tx") Tx
#txId)
                , Text
". Note that when I withdraw rewards, I "
                , Text
"need to withdraw them fully for the Ledger to accept it. "
                , Text
"There's therefore no point creating another conflicting "
                , Text
"transaction; if, for some reason, you really want a new "
                , Text
"transaction, then cancel the previous one first."
                ]
        ErrSelectAssetsSelectionError (SelectionBalanceErrorOf SelectionBalanceError WalletSelectionContext
e) ->
            SelectionBalanceError WalletSelectionContext -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionBalanceError WalletSelectionContext
e
        ErrSelectAssetsSelectionError (SelectionCollateralErrorOf SelectionCollateralError WalletSelectionContext
e) ->
            SelectionCollateralError WalletSelectionContext -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionCollateralError WalletSelectionContext
e
        ErrSelectAssetsSelectionError (SelectionOutputErrorOf SelectionOutputError WalletSelectionContext
e) ->
            SelectionOutputError WalletSelectionContext -> ServerError
forall e. IsServerError e => e -> ServerError
toServerError SelectionOutputError WalletSelectionContext
e

instance IsServerError (SelectionBalanceError WalletSelectionContext) where
    toServerError :: SelectionBalanceError WalletSelectionContext -> ServerError
toServerError = \case
        BalanceInsufficient BalanceInsufficientError
e ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
NotEnoughMoney (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I can't process this payment as there are not "
                , Text
"enough funds available in the wallet. I am "
                , Text
"missing: ", Flat TokenBundle -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Flat TokenBundle -> Text)
-> (TokenBundle -> Flat TokenBundle) -> TokenBundle -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenBundle -> Flat TokenBundle
forall a. a -> Flat a
Flat (TokenBundle -> Text) -> TokenBundle -> Text
forall a b. (a -> b) -> a -> b
$ BalanceInsufficientError -> TokenBundle
balanceMissing BalanceInsufficientError
e
                ]
        SelectionLimitReached SelectionLimitReachedError WalletSelectionContext
e ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
TransactionIsTooBig (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I am not able to finalize the transaction "
                , Text
"because I need to select additional inputs and "
                , Text
"doing so will make the transaction too big. Try "
                , Text
"sending a smaller amount. I had already selected "
                , Int -> Text
forall a. Show a => a -> Text
showT ([(WalletUTxO, TokenBundle)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(WalletUTxO, TokenBundle)] -> Int)
-> [(WalletUTxO, TokenBundle)] -> Int
forall a b. (a -> b) -> a -> b
$ (([(WalletUTxO, TokenBundle)]
  -> Const [(WalletUTxO, TokenBundle)] [(WalletUTxO, TokenBundle)])
 -> SelectionLimitReachedError WalletSelectionContext
 -> Const
      [(WalletUTxO, TokenBundle)]
      (SelectionLimitReachedError WalletSelectionContext))
-> SelectionLimitReachedError WalletSelectionContext
-> [(WalletUTxO, TokenBundle)]
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputsSelected"
  (([(WalletUTxO, TokenBundle)]
    -> Const [(WalletUTxO, TokenBundle)] [(WalletUTxO, TokenBundle)])
   -> SelectionLimitReachedError WalletSelectionContext
   -> Const
        [(WalletUTxO, TokenBundle)]
        (SelectionLimitReachedError WalletSelectionContext))
([(WalletUTxO, TokenBundle)]
 -> Const [(WalletUTxO, TokenBundle)] [(WalletUTxO, TokenBundle)])
-> SelectionLimitReachedError WalletSelectionContext
-> Const
     [(WalletUTxO, TokenBundle)]
     (SelectionLimitReachedError WalletSelectionContext)
#inputsSelected SelectionLimitReachedError WalletSelectionContext
e), Text
" inputs."
                ]
        UnableToConstructChange UnableToConstructChangeError
e ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
CannotCoverFee (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I am unable to finalize the transaction, as there"
                , Text
"is not enough ada available to pay for the fee and"
                , Text
"also pay for the minimum ada quantities of all"
                , Text
"change outputs. I need approximately"
                , Coin -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (UnableToConstructChangeError -> Coin
shortfall UnableToConstructChangeError
e)
                , Text
"ada to proceed. Try increasing your wallet balance"
                , Text
"or sending a smaller amount."
                ]
        SelectionBalanceError WalletSelectionContext
EmptyUTxO ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
NotEnoughMoney (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"Cannot create a transaction because the wallet"
                , Text
"has no UTxO entries. At least one UTxO entry is"
                , Text
"required in order to create a transaction."
                ]

instance IsServerError (SelectionCollateralError WalletSelectionContext) where
    toServerError :: SelectionCollateralError WalletSelectionContext -> ServerError
toServerError SelectionCollateralError WalletSelectionContext
e =
        ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
InsufficientCollateral (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
            [ Text
"I'm unable to create this transaction because the balance"
            , Text
"of pure ada UTxOs in your wallet is insufficient to cover"
            , Text
"the minimum amount of collateral required."
            , Text
"I need an ada amount of at least:"
            , Coin -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (((Coin -> Const Coin Coin)
 -> SelectionCollateralError WalletSelectionContext
 -> Const Coin (SelectionCollateralError WalletSelectionContext))
-> SelectionCollateralError WalletSelectionContext -> Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "minimumSelectionAmount"
  ((Coin -> Const Coin Coin)
   -> SelectionCollateralError WalletSelectionContext
   -> Const Coin (SelectionCollateralError WalletSelectionContext))
(Coin -> Const Coin Coin)
-> SelectionCollateralError WalletSelectionContext
-> Const Coin (SelectionCollateralError WalletSelectionContext)
#minimumSelectionAmount SelectionCollateralError WalletSelectionContext
e)
            , Text
"The largest combination of pure ada UTxOs I could find is:"
            , Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ [Coin] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF ([Coin] -> Builder) -> [Coin] -> Builder
forall a b. (a -> b) -> a -> b
$ [Coin] -> [Coin]
forall a. Ord a => [a] -> [a]
L.sort ([Coin] -> [Coin]) -> [Coin] -> [Coin]
forall a b. (a -> b) -> a -> b
$ Map WalletUTxO Coin -> [Coin]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Map WalletUTxO Coin -> [Coin]) -> Map WalletUTxO Coin -> [Coin]
forall a b. (a -> b) -> a -> b
$
                ((Map WalletUTxO Coin
  -> Const (Map WalletUTxO Coin) (Map WalletUTxO Coin))
 -> SelectionCollateralError WalletSelectionContext
 -> Const
      (Map WalletUTxO Coin)
      (SelectionCollateralError WalletSelectionContext))
-> SelectionCollateralError WalletSelectionContext
-> Map WalletUTxO Coin
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "largestCombinationAvailable"
  ((Map WalletUTxO Coin
    -> Const (Map WalletUTxO Coin) (Map WalletUTxO Coin))
   -> SelectionCollateralError WalletSelectionContext
   -> Const
        (Map WalletUTxO Coin)
        (SelectionCollateralError WalletSelectionContext))
(Map WalletUTxO Coin
 -> Const (Map WalletUTxO Coin) (Map WalletUTxO Coin))
-> SelectionCollateralError WalletSelectionContext
-> Const
     (Map WalletUTxO Coin)
     (SelectionCollateralError WalletSelectionContext)
#largestCombinationAvailable SelectionCollateralError WalletSelectionContext
e
            , Text
"To fix this, you'll need to add one or more pure ada UTxOs"
            , Text
"to your wallet that can cover the minimum amount required."
            ]

instance IsServerError (ErrInvalidDerivationIndex 'Hardened level) where
    toServerError :: ErrInvalidDerivationIndex 'Hardened level -> ServerError
toServerError = \case
        ErrIndexOutOfBound (Index Word32
minIx) (Index Word32
maxIx) DerivationIndex
_ix ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err403 ApiErrorCode
HardenedDerivationRequired (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"It looks like you've provided a derivation index that is "
                , Text
"out of bound. The index is well-formed, but I require "
                , Text
"indexes valid for hardened derivation only. That is, indexes "
                , Text
"between 0H and ", Index Any Any -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Word32 -> Index Any Any
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Word32 -> Index Any Any) -> Word32 -> Index Any Any
forall a b. (a -> b) -> a -> b
$ Word32
maxIx Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
minIx), Text
"H."
                ]

instance IsServerError ErrUpdateSealedTx where
    toServerError :: ErrUpdateSealedTx -> ServerError
toServerError = \case
        ErrExistingKeyWitnesses{} ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
ExistingKeyWitnesses (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I cannot proceed with the request because there are key"
                , Text
"witnesses defined in the input transaction and, adjusting"
                , Text
"the transaction body will render witnesses invalid!"
                , Text
"Please make sure to remove all key witnesses from the request."
                ]

instance IsServerError ErrAssignRedeemers where
    toServerError :: ErrAssignRedeemers -> ServerError
toServerError = \case
        ErrAssignRedeemersScriptFailure Redeemer
r String
failure ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
RedeemerScriptFailure (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I was unable to assign execution units to one of your"
                , Text
"redeemers:", Redeemer -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Redeemer
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
                , Text
"Its execution is failing with the following error:"
                , String -> Text
T.pack String
failure Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                ]
        ErrAssignRedeemersTargetNotFound Redeemer
r ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
RedeemerTargetNotFound (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"I was unable to resolve one of your redeemers to the location"
                , Text
"indicated in the request payload:", Redeemer -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Redeemer
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
                , Text
"Please double-check both your serialised transaction and"
                , Text
"the provided redeemers."
                ]
        ErrAssignRedeemersInvalidData Redeemer
r String
_ ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
RedeemerInvalidData (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"It looks like you have provided an invalid 'data' payload"
                , Text
"for one of your redeemers since I am unable to decode it"
                , Text
"into a valid Plutus data:", Redeemer -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Redeemer
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                ]
        ErrAssignRedeemersTranslationError (TranslationLogicMissingInput TxIn StandardCrypto
inp) ->
             -- Note that although this error is thrown from
             -- '_assignScriptRedeemers', it's more related to balanceTransaction
             -- in general than to assigning redeemers. Hence we don't mention
             -- redeemers in the message.
             ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
UnresolvedInputs (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                 [ Text
"The transaction I was given contains inputs I don't know"
                 , Text
"about. Please ensure all foreign inputs are specified as "
                 , Text
"part of the API request. The unknown input is:\n\n"
                 , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TxIn StandardCrypto -> String
forall a. Show a => a -> String
show TxIn StandardCrypto
inp
                 ]
        ErrAssignRedeemersTranslationError (TimeTranslationPastHorizon Text
t) ->
            -- We differentiate this from @TranslationError@ for partial API
            -- backwards compatibility.
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
PastHorizon (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"The transaction's validity interval is past the horizon"
                , Text
"of safe slot-to-time conversions."
                , Text
"This may happen when I know about a future era"
                , Text
"which has not yet been confirmed on-chain. Try setting the"
                , Text
"bounds of the validity interval to be earlier.\n\n"
                , Text
"Here are the full details: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                ]
        ErrAssignRedeemersTranslationError TranslationError StandardCrypto
e ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err400 ApiErrorCode
TranslationError (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"The transaction I was given contains bits that cannot be"
                , Text
"translated in the current era. The following is wrong:\n\n"
                , TranslationError StandardCrypto -> Text
forall a. Show a => a -> Text
showT TranslationError StandardCrypto
e
                ]

instance IsServerError (Request, ServerError) where
    toServerError :: (Request, ServerError) -> ServerError
toServerError (Request
req, err :: ServerError
err@(ServerError Int
code String
_ ByteString
body [Header]
_))
      | Bool -> Bool
not (ByteString -> Bool
isJSON ByteString
body) = case Int
code of
        Int
400 | ByteString
"Failed reading" ByteString -> ByteString -> Bool
`BS.isInfixOf` ByteString -> ByteString
BL.toStrict ByteString
body ->
            ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
BadRequest (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Text
"I couldn't understand the content of your message. If your "
                , Text
"message is intended to be in JSON format, please check that "
                , Text
"the JSON is valid."
                ]
        Int
400 -> ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
BadRequest (ByteString -> Text
utf8 ByteString
body)
        Int
404 -> ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
NotFound (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"I couldn't find the requested endpoint. If the endpoint "
            , Text
"contains path parameters, please ensure they are well-formed, "
            , Text
"otherwise I won't be able to route them correctly."
            ]
        Int
405 -> ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
MethodNotAllowed (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"You've reached a known endpoint but I don't know how to handle "
            , Text
"the HTTP method specified. Please double-check both the "
            , Text
"endpoint and the method: one of them is likely to be incorrect "
            , Text
"(for example: POST instead of PUT, or GET instead of POST...)."
            ]
        Int
406 ->
            let cType :: Text
cType =
                    -- FIXME: Ugly and not really scalable nor maintainable.
                    if [Text
"wallets"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Request -> [Text]
pathInfo Request
req
                    Bool -> Bool -> Bool
&& [Text
"signatures"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` Request -> [Text]
pathInfo Request
req
                    then Text
"application/octet-stream"
                    else Text
"application/json"
            in ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
NotAcceptable (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It seems as though you don't accept '", Text
cType,Text
"', but "
            , Text
"unfortunately I only speak '", Text
cType,Text
"'! Please "
            , Text
"double-check your 'Accept' request header and make sure it's "
            , Text
"set to '", Text
cType,Text
"'."
            ]
        Int
415 ->
            let cType :: Text
cType =
                    -- FIXME: Ugly and not really scalable nor maintainable.
                    if [Text
"proxy", Text
"transactions"] [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSubsequenceOf` Request -> [Text]
pathInfo Request
req
                        then Text
"application/octet-stream"
                        else Text
"application/json"
            in ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
UnsupportedMediaType (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"I'm really sorry but I only understand '", Text
cType, Text
"'. I need you "
            , Text
"to tell me what language you're speaking in order for me to "
            , Text
"understand your message. Please double-check your 'Content-Type' "
            , Text
"request header and make sure it's set to '", Text
cType, Text
"'."
            ]
        Int
501 -> ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
NotImplemented
            Text
"I'm really sorry but this endpoint is not implemented yet."
        Int
_ -> ServerError -> ApiErrorCode -> Text -> ServerError
apiError ServerError
err ApiErrorCode
UnexpectedError (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"It looks like something unexpected went wrong. Unfortunately I "
            , Text
"don't yet know how to handle this type of situation. Here's "
            , Text
"some information about what happened: ", ByteString -> Text
utf8 ByteString
body
            ]
      | Bool
otherwise = ServerError
err
      where
        utf8 :: ByteString -> Text
utf8 = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"'" (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
        isJSON :: ByteString -> Bool
isJSON = Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool)
-> (ByteString -> Maybe Value) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromJSON Value => ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode @Aeson.Value

{-------------------------------------------------------------------------------
                               Logging
-------------------------------------------------------------------------------}

-- | The type of log messages coming from the server 'ApiLayer', which may or
-- may not be associated with a particular worker thread.
data WalletEngineLog
    = MsgWalletWorker (WorkerLog WalletId W.WalletWorkerLog)
    | MsgSubmitSealedTx TxSubmitLog
    deriving (Int -> WalletEngineLog -> ShowS
[WalletEngineLog] -> ShowS
WalletEngineLog -> String
(Int -> WalletEngineLog -> ShowS)
-> (WalletEngineLog -> String)
-> ([WalletEngineLog] -> ShowS)
-> Show WalletEngineLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletEngineLog] -> ShowS
$cshowList :: [WalletEngineLog] -> ShowS
show :: WalletEngineLog -> String
$cshow :: WalletEngineLog -> String
showsPrec :: Int -> WalletEngineLog -> ShowS
$cshowsPrec :: Int -> WalletEngineLog -> ShowS
Show, WalletEngineLog -> WalletEngineLog -> Bool
(WalletEngineLog -> WalletEngineLog -> Bool)
-> (WalletEngineLog -> WalletEngineLog -> Bool)
-> Eq WalletEngineLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletEngineLog -> WalletEngineLog -> Bool
$c/= :: WalletEngineLog -> WalletEngineLog -> Bool
== :: WalletEngineLog -> WalletEngineLog -> Bool
$c== :: WalletEngineLog -> WalletEngineLog -> Bool
Eq)

instance ToText WalletEngineLog where
    toText :: WalletEngineLog -> Text
toText = \case
        MsgWalletWorker WorkerLog WalletId WalletWorkerLog
msg -> WorkerLog WalletId WalletWorkerLog -> Text
forall a. ToText a => a -> Text
toText WorkerLog WalletId WalletWorkerLog
msg
        MsgSubmitSealedTx TxSubmitLog
msg -> TxSubmitLog -> Text
forall a. ToText a => a -> Text
toText TxSubmitLog
msg

instance HasPrivacyAnnotation WalletEngineLog where
    getPrivacyAnnotation :: WalletEngineLog -> PrivacyAnnotation
getPrivacyAnnotation = \case
        MsgWalletWorker WorkerLog WalletId WalletWorkerLog
msg -> WorkerLog WalletId WalletWorkerLog -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation WorkerLog WalletId WalletWorkerLog
msg
        MsgSubmitSealedTx TxSubmitLog
msg -> TxSubmitLog -> PrivacyAnnotation
forall a. HasPrivacyAnnotation a => a -> PrivacyAnnotation
getPrivacyAnnotation TxSubmitLog
msg

instance HasSeverityAnnotation WalletEngineLog where
    getSeverityAnnotation :: WalletEngineLog -> Severity
getSeverityAnnotation = \case
        MsgWalletWorker WorkerLog WalletId WalletWorkerLog
msg -> WorkerLog WalletId WalletWorkerLog -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation WorkerLog WalletId WalletWorkerLog
msg
        MsgSubmitSealedTx TxSubmitLog
msg -> TxSubmitLog -> Severity
forall a. HasSeverityAnnotation a => a -> Severity
getSeverityAnnotation TxSubmitLog
msg