content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedLabels #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE TypeOperators #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
  
  {-# HLINT ignore "Use record patterns" #-}
  
  -- TODO: https://cardanofoundation.atlassian.net/browse/ADP-2841
  {-# LANGUAGE CPP #-}
  #if __GLASGOW_HASKELL__ >= 902
  {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
  #endif
  
  -- |
  -- 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.Http.Shelley.Server
      (
  
      -- * Server Setup
      serve
  
      -- * ApiLayer
      , newApiLayer
  
      -- * Handlers
      , delegationFee
      , deleteTransaction
      , deleteWallet
      , derivePublicKey
      , getNetworkClock
      , getNetworkInformation
      , getNetworkParameters
      , getUTxOsStatistics
      , getWalletUtxoSnapshot
      , getWallet
      , joinDRep
      , 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
      , putWalletByron
      , putWalletPassphrase
      , quitStakePool
      , selectCoins
      , selectCoinsForJoin
      , selectCoinsForQuit
      , signMetadata
      , postAccountPublicKey
      , getAccountPublicKey
      , postSharedWallet
      , patchSharedWallet
      , mkSharedWallet
      , balanceTransaction
      , decodeTransaction
      , submitTransaction
      , getPolicyKey
      , postPolicyKey
      , postPolicyId
      , constructSharedTransaction
      , decodeSharedTransaction
      , getBlocksLatestHeader
      , submitSharedTransaction
  
      -- * Server error responses
      , IsServerError(..)
      , liftHandler
      , apiError
  
      -- * Internals
      , mkShelleyWallet
      , mkLegacyWallet
      , withLegacyLayer
      , withLegacyLayer'
      , rndStateChange
      , withWorkerCtx
      , getCurrentEpoch
  
      , MkApiWallet
      -- * Workers
      , manageRewardBalance
      , idleWorker
  
      -- * Logging
      , WalletEngineLog (..)
      )
      where
  
  import Prelude
  
  import Cardano.Address.Derivation
      ( XPrv
      , XPub
      , xpubPublicKey
      , xpubToBytes
      )
  import Cardano.Address.Script
      ( Cosigner (..)
      , KeyHash (KeyHash)
      , KeyRole (..)
      , Script
      , ScriptTemplate (..)
      , ValidationLevel (..)
      , foldScript
      , validateScriptOfTemplate
      )
  import Cardano.Api
      ( SerialiseAsCBOR (..)
      )
  import Cardano.Api.Shelley
      ( StakeAddress (..)
      )
  import Cardano.BM.Tracing
      ( HasPrivacyAnnotation (..)
      , HasSeverityAnnotation (..)
      )
  import Cardano.Mnemonic
      ( SomeMnemonic
      )
  import Cardano.Pool.Types
      ( PoolId
      )
  import Cardano.Wallet
      ( BuiltTx (..)
      , DelegationFee (feePercentiles)
      , ErrConstructSharedWallet (..)
      , ErrConstructTx (..)
      , ErrCreateMigrationPlan (..)
      , ErrDecodeTx (..)
      , ErrGetPolicyId (..)
      , ErrNoSuchWallet (..)
      , ErrReadRewardAccount (..)
      , ErrSignPayment (..)
      , ErrSubmitTransaction (..)
      , ErrSubmitTransactionMissingWitnessCounts (..)
      , ErrUpdatePassphrase (..)
      , ErrWalletAlreadyExists (..)
      , ErrWalletNotResponding (..)
      , ErrWithRootKey (..)
      , ErrWitnessTx (..)
      , Fee (..)
      , HasNetworkLayer
      , InitialState (..)
      , Percentile (..)
      , TxSubmitLog
      , WalletWorkerLog (..)
      , dbLayer
      , dummyChangeAddressGen
      , genesisData
      , getCurrentEpochSlotting
      , logger
      , manageRewardBalance
      , networkLayer
      , readPrivateKey
      , readWalletMeta
      , txWitnessTagForKey
      )
  import Cardano.Wallet.Address.Book
      ( AddressBookIso
      )
  import Cardano.Wallet.Address.Derivation
      ( AccountIxForStaking (..)
      , DelegationAddress (..)
      , Depth (..)
      , DerivationIndex (..)
      , DerivationType (..)
      , HardDerivation (..)
      , Index (..)
      , MkKeyFingerprint
      , RewardAccount (..)
      , Role
      , SoftDerivation (..)
      , delegationAddressS
      , deriveRewardAccount
      , stakeDerivationPath
      )
  import Cardano.Wallet.Address.Derivation.Byron
      ( ByronKey
      , mkByronKeyFromMasterKey
      )
  import Cardano.Wallet.Address.Derivation.Icarus
      ( IcarusKey
      )
  import Cardano.Wallet.Address.Derivation.MintBurn
      ( scriptSlotIntervals
      , withinSlotInterval
      )
  import Cardano.Wallet.Address.Derivation.SharedKey
      ( SharedKey (..)
      , replaceCosignersWithVerKeys
      )
  import Cardano.Wallet.Address.Derivation.Shelley
      ( ShelleyKey
      )
  import Cardano.Wallet.Address.Discovery
      ( ChangeAddressMode (..)
      , CompareDiscovery
      , GenChange (ArgGenChange)
      , GetAccount
      , GetPurpose (..)
      , IsOurs
      , KnownAddresses
      )
  import Cardano.Wallet.Address.Discovery.Random
      ( RndState
      , mkRndState
      )
  import Cardano.Wallet.Address.Discovery.Sequential
      ( DerivationPrefix (..)
      , SeqState (..)
      , defaultAddressPoolGap
      , getGap
      , mkSeqStateFromAccountXPub
      , purposeCIP1852
      )
  import Cardano.Wallet.Address.Discovery.Shared
      ( CredentialType (..)
      , SharedState (..)
      )
  import Cardano.Wallet.Address.HasDelegation
      ( HasDelegation (..)
      )
  import Cardano.Wallet.Address.Keys.MintBurn
      ( replaceCosigner
      , toTokenMapAndScript
      , toTokenPolicyId
      )
  import Cardano.Wallet.Address.Keys.SequentialAny
      ( mkSeqStateFromRootXPrv
      )
  import Cardano.Wallet.Address.Keys.Shared
      ( mkSharedStateFromAccountXPub
      , mkSharedStateFromRootXPrv
      , toSharedWalletId
      , validateScriptTemplates
      )
  import Cardano.Wallet.Address.Keys.WalletKey
      ( AfterByron
      , digest
      , getRawKey
      , publicKey
      )
  import Cardano.Wallet.Address.Keys.WitnessCount
      ( toWitnessCountCtx
      )
  import Cardano.Wallet.Address.MaybeLight
      ( MaybeLight (..)
      )
  import Cardano.Wallet.Address.States.IsOwned
      ( isOwned
      )
  import Cardano.Wallet.Api
      ( ApiLayer (..)
      , HasDBFactory
      , HasTokenMetadataClient
      , HasWorkerRegistry
      , WalletLock (..)
      , dbFactory
      , tokenMetadataClient
      , walletLocks
      , workerRegistry
      )
  import Cardano.Wallet.Api.Http.Server.Error
      ( IsServerError (..)
      , apiError
      , handler
      , liftE
      , liftHandler
      )
  import Cardano.Wallet.Api.Http.Server.Handlers.MintBurn
      ( convertApiAssetMintBurn
      , getTxApiAssetMintBurn
      )
  -- import Cardano.Wallet.Api.Http.Server.Handlers.NetworkInformation
  --     ( getNetworkInformation
  --     , makeApiBlockReference
  --     , makeApiBlockReferenceFromHeader
  --     , makeApiSlotReference
  --     )
  import Cardano.Wallet.Api.Http.Server.Handlers.TxCBOR
      ( ParsedTxCBOR (..)
      , parseTxCBOR
      )
  import Cardano.Wallet.Api.Types
      ( AccountPostData (..)
      , AddressAmount (..)
      , AddressAmountNoAssets (..)
      , ApiAccountPublicKey (..)
      , ApiAccountSharedPublicKey (..)
      , ApiActiveSharedWallet (..)
      , ApiAddressWithPath (..)
      , ApiAnyCertificate (..)
      , ApiAsArray (..)
      , ApiAsset (..)
      , ApiAssetMintBurn (..)
      , ApiBalanceTransactionPostData (..)
      , ApiBlockReference (..)
      , ApiBurnData (..)
      , ApiByronWallet (..)
      , ApiByronWalletBalance (..)
      , ApiBytesT (..)
      , ApiCertificate (..)
      , ApiCoinSelection (..)
      , ApiCoinSelectionChange (..)
      , ApiCoinSelectionCollateral (..)
      , ApiCoinSelectionOutput (..)
      , ApiCoinSelectionWithdrawal (..)
      , ApiConstructTransaction (..)
      , ApiConstructTransactionData (..)
      , ApiDRepSpecifier (..)
      , ApiDecodeTransactionPostData (..)
      , ApiDecodedTransaction (..)
      , ApiExternalInput (..)
      , ApiFee (..)
      , ApiForeignStakeKey (..)
      , ApiIncompleteSharedWallet (..)
      , ApiMintBurnData (..)
      , ApiMintBurnDataFromInput (..)
      , ApiMintBurnDataFromScript (..)
      , ApiMintBurnOperation (..)
      , ApiMintData (..)
      , ApiMnemonicT (..)
      , ApiMultiDelegationAction (..)
      , ApiNetworkClock (..)
      , ApiNetworkParameters (..)
      , ApiNullStakeKey (..)
      , ApiOurStakeKey (..)
      , ApiPaymentDestination (..)
      , ApiPolicyId (..)
      , ApiPolicyKey (..)
      , ApiPoolSpecifier (..)
      , ApiPostAccountKeyDataWithPurpose (..)
      , ApiPostPolicyIdData
      , ApiPostPolicyKeyData (..)
      , ApiPostRandomAddressData (..)
      , ApiPutAddressesData (..)
      , ApiRedeemer (..)
      , ApiScriptTemplate (..)
      , ApiScriptTemplateEntry (..)
      , ApiSealedTxEncoding (..)
      , ApiSelectCoinsPayments
      , ApiSelfWithdrawalPostData (..)
      , ApiSerialisedTransaction (..)
      , ApiSharedWallet (..)
      , ApiSharedWalletPatchData (..)
      , ApiSharedWalletPostData (..)
      , ApiSharedWalletPostDataFromAccountPubX (..)
      , ApiSharedWalletPostDataFromMnemonics (..)
      , ApiSignTransactionPostData (..)
      , ApiStakeKeyIndex (..)
      , ApiStakeKeys (..)
      , ApiT (..)
      , ApiTransaction (..)
      , ApiTxCollateral (..)
      , ApiTxId (..)
      , ApiTxInput (..)
      , ApiTxInputGeneral (..)
      , ApiTxMetadata (..)
      , ApiTxOutputGeneral (..)
      , ApiUtxoStatistics (..)
      , ApiValidityBound (..)
      , ApiValidityInterval (..)
      , ApiWallet (..)
      , ApiWalletAssetsBalance (..)
      , ApiWalletBalance (..)
      , ApiWalletDelegation (..)
      , ApiWalletDelegationNext (..)
      , ApiWalletDelegationStatus (..)
      , ApiWalletInput (..)
      , ApiWalletMigrationBalance (..)
      , ApiWalletMigrationPlan (..)
      , ApiWalletMigrationPlanPostData (..)
      , ApiWalletMigrationPostData (..)
      , ApiWalletOutput (..)
      , ApiWalletPassphrase (..)
      , ApiWalletPassphraseInfo (..)
      , ApiWalletPutData (..)
      , ApiWalletPutDataExtended (..)
      , ApiWalletSignData (..)
      , ApiWalletUtxoSnapshot (..)
      , ApiWalletUtxoSnapshotEntry (..)
      , ApiWithdrawal (..)
      , ApiWithdrawalGeneral (..)
      , ApiWithdrawalPostData (..)
      , ByronWalletFromXPrvPostData
      , ByronWalletPostData (..)
      , ByronWalletPutPassphraseData (..)
      , Iso8601Time (..)
      , KeyFormat (..)
      , KnownDiscovery (..)
      , MinWithdrawal (..)
      , PostTransactionFeeOldData (..)
      , PostTransactionOldData (..)
      , ResourceContext (..)
      , VerificationKeyHashing (..)
      , WalletOrAccountPostData (..)
      , WalletPostData (..)
      , WalletPutPassphraseData (..)
      , XPubOrSelf (..)
      , getApiMnemonicT
      , toApiAsset
      , toApiDecodeTransactionPostData
      , toApiNetworkParameters
      , toApiUtxoStatistics
      )
  import Cardano.Wallet.Api.Types.Amount
      ( ApiAmount (ApiAmount)
      )
  import Cardano.Wallet.Api.Types.BlockHeader
      ( ApiBlockHeader
      , mkApiBlockHeader
      )
  import Cardano.Wallet.Api.Types.Certificate
      ( ApiRewardAccount (..)
      , mkApiAnyCertificate
      )
  import Cardano.Wallet.Api.Types.Error
      ( ApiErrorInfo (..)
      )
  import Cardano.Wallet.Api.Types.Key
      ( computeKeyPayload
      )
  import Cardano.Wallet.Api.Types.MintBurn
      ( noApiAsset
      )
  import Cardano.Wallet.Api.Types.SchemaMetadata
      ( TxMetadataSchema (..)
      , TxMetadataWithSchema (TxMetadataWithSchema)
      )
  import Cardano.Wallet.Api.Types.Transaction
      ( ApiAddress (..)
      , ApiLimit
      , ApiValidityIntervalExplicit (..)
      , fromApiLimit
      , mkApiWitnessCount
      )
  import Cardano.Wallet.Balance.Migration
      ( MigrationPlan (..)
      )
  import Cardano.Wallet.Compat
      ( (^?)
      )
  import Cardano.Wallet.DB
      ( DBFactory (..)
      , DBLayer
      )
  import Cardano.Wallet.Flavor
      ( AllFlavors
      , CredFromOf
      , Excluding
      , FlavorOf
      , Including
      , KeyFlavorS (..)
      , KeyOf
      , NetworkOf
      , WalletFlavor
      , WalletFlavorS (..)
      , WalletFlavors (..)
      , keyFlavorFromState
      , keyOfWallet
      , shelleyOrShared
      , walletFlavor
      )
  import Cardano.Wallet.Network
      ( ErrFetchBlock (..)
      , NetworkLayer (..)
      , fetchRewardAccountBalances
      , timeInterpreter
      )
  import Cardano.Wallet.Network.RestorationMode
      ( RestorationMode (RestoreFromGenesis)
      , RestorationPoint (..)
      , getRestorationPoint
      )
  import Cardano.Wallet.Pools
      ( toEpochInfo
      )
  import Cardano.Wallet.Primitive.Delegation.UTxO
      ( stakeKeyCoinDistr
      )
  import Cardano.Wallet.Primitive.Ledger.Convert
      ( toLedger
      )
  import Cardano.Wallet.Primitive.Model
      ( Wallet
      , availableBalance
      , availableUTxO
      , currentTip
      , getState
      , totalBalance
      , totalUTxO
      )
  import Cardano.Wallet.Primitive.NetworkId
      ( HasSNetworkId (..)
      , NetworkDiscriminantCheck
      )
  import Cardano.Wallet.Primitive.Passphrase
      ( Passphrase (..)
      , PassphraseScheme (..)
      , WalletPassphraseInfo (..)
      , currentPassphraseScheme
      , preparePassphrase
      )
  import Cardano.Wallet.Primitive.Slotting
      ( PastHorizonException
      , TimeInterpreter
      , currentEpoch
      , expectAndThrowFailures
      , interpretQuery
      , neverFails
      , unsafeExtendSafeZone
      )
  import Cardano.Wallet.Primitive.SyncProgress
      ( SyncProgress (..)
      )
  import Cardano.Wallet.Primitive.Types
      ( Block
      , NetworkParameters (..)
      , PoolLifeCycleStatus
      , Signature (..)
      , SlotNo (..)
      , SortOrder (..)
      , WalletDelegation
      , WalletId (..)
      , WalletMetadata (..)
      )
  import Cardano.Wallet.Primitive.Types.Address
      ( Address (..)
      , AddressState (..)
      )
  import Cardano.Wallet.Primitive.Types.AssetId
      ( AssetId (..)
      )
  import Cardano.Wallet.Primitive.Types.AssetName
      ( AssetName (..)
      )
  import Cardano.Wallet.Primitive.Types.Coin
      ( Coin (..)
      )
  import Cardano.Wallet.Primitive.Types.Credentials
      ( ClearCredentials
      , RootCredentials (..)
      )
  import Cardano.Wallet.Primitive.Types.DRep
      ( DRep
      )
  import Cardano.Wallet.Primitive.Types.Hash
      ( Hash (..)
      )
  import Cardano.Wallet.Primitive.Types.MetadataEncryption
      ( fromMetadataEncrypted
      , toMetadataEncrypted
      )
  import Cardano.Wallet.Primitive.Types.TokenBundle
      ( TokenBundle (..)
      )
  import Cardano.Wallet.Primitive.Types.TokenMap
      ( TokenMap
      , fromFlatList
      )
  import Cardano.Wallet.Primitive.Types.TokenPolicyId
      ( TokenPolicyId (..)
      )
  import Cardano.Wallet.Primitive.Types.TokenQuantity
      ( TokenQuantity (..)
      )
  import Cardano.Wallet.Primitive.Types.Tx
      ( Tx (..)
      , TxChange (..)
      , UnsignedTx (..)
      , cardanoTxInExactEra
      , getSealedTxWitnesses
      )
  import Cardano.Wallet.Primitive.Types.Tx.Constraints
      ( txMintBurnMaxTokenQuantity
      )
  import Cardano.Wallet.Primitive.Types.Tx.TransactionInfo
      ( TransactionInfo
      )
  import Cardano.Wallet.Primitive.Types.Tx.TxExtended
      ( TxExtended (..)
      )
  import Cardano.Wallet.Primitive.Types.Tx.TxIn
      ( TxIn (..)
      )
  import Cardano.Wallet.Primitive.Types.Tx.TxMeta
      ( TxStatus (..)
      )
  import Cardano.Wallet.Primitive.Types.Tx.TxOut
      ( TxOut (..)
      )
  import Cardano.Wallet.Read.Tx.CBOR
      ( TxCBOR
      )
  import Cardano.Wallet.Registry
      ( HasWorkerCtx (..)
      , MkWorker (..)
      , WorkerLog (..)
      , defaultWorkerAfter
      , workerResource
      )
  import Cardano.Wallet.Shelley.Transaction
      ( TxWitnessTag
      )
  import Cardano.Wallet.TokenMetadata
      ( TokenMetadataClient
      , fillMetadata
      )
  import Cardano.Wallet.Transaction
      ( AnyExplicitScript (..)
      , DelegationAction (..)
      , PreSelection (..)
      , SelectionOf (..)
      , TransactionCtx (..)
      , TransactionLayer (..)
      , VotingAction (..)
      , Withdrawal (..)
      , WitnessCount (..)
      , WitnessCountCtx (..)
      , containsSelfWithdrawal
      , defaultTransactionCtx
      )
  import Cardano.Wallet.Unsafe
      ( unsafeRunExceptT
      )
  import Cardano.Write.Eras
      ( AnyRecentEra (..)
      )
  import Control.Arrow
      ( second
      , (&&&)
      )
  import Control.DeepSeq
      ( NFData
      )
  import Control.Error.Util
      ( failWith
      )
  import Control.Monad
      ( forM
      , forever
      , join
      , void
      , when
      )
  import Control.Monad.Error.Class
      ( throwError
      )
  import Control.Monad.IO.Class
      ( MonadIO
      , liftIO
      )
  import Control.Monad.Trans.Class
      ( lift
      )
  import Control.Monad.Trans.Except
      ( ExceptT (..)
      , except
      , runExceptT
      , throwE
      , withExceptT
      )
  import Control.Tracer
      ( Tracer
      , contramap
      )
  import Cryptography.Core
      ( genSalt
      )
  import Data.Bifunctor
      ( first
      )
  import Data.ByteString
      ( ByteString
      )
  import Data.Coerce
      ( coerce
      )
  import Data.Either
      ( isLeft
      , isRight
      )
  import Data.Either.Combinators
      ( whenLeft
      )
  import Data.Either.Extra
      ( eitherToMaybe
      )
  import Data.Function
      ( (&)
      )
  import Data.Functor
      ( (<&>)
      )
  import Data.Functor.Identity
      ( Identity (..)
      )
  import Data.Generics.Internal.VL.Lens
      ( Lens'
      , set
      , view
      , (.~)
      , (^.)
      )
  import Data.Generics.Labels
      ()
  import Data.Generics.Product
      ( HasField'
      , typed
      )
  import Data.IntCast
      ( intCastMaybe
      )
  import Data.List
      ( 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.Text.Class
      ( FromText (..)
      , ToText (..)
      )
  import Data.Time
      ( UTCTime
      )
  import Data.Traversable
      ( for
      )
  import Data.Word
      ( Word32
      )
  import Fmt
      ( pretty
      )
  import GHC.Generics
      ( Generic
      )
  import Network.Ntp
      ( NtpClient
      , getNtpStatus
      )
  import Numeric.Natural
      ( Natural
      )
  import Safe
      ( fromJustNote
      )
  import Servant
      ( NoContent (..)
      , err400
      , err404
      , err500
      , serve
      )
  import Servant.Server
      ( Handler (..)
      , runHandler
      )
  import System.Random
      ( getStdRandom
      , random
      )
  import UnliftIO.Async
      ( race_
      )
  import UnliftIO.Concurrent
      ( threadDelay
      )
  import UnliftIO.Exception
      ( tryAnyDeep
      )
  
  import qualified Cardano.Address.Script as CA
  import qualified Cardano.Address.Style.Shelley as CA
  import qualified Cardano.Api as Cardano
  import qualified Cardano.Ledger.Address as Ledger
  import qualified Cardano.Wallet as W
  import qualified Cardano.Wallet.Address.Derivation.Byron as Byron
  import qualified Cardano.Wallet.Address.Derivation.Icarus as Icarus
  import qualified Cardano.Wallet.Address.Discovery.Sequential as Seq
  import qualified Cardano.Wallet.Address.Discovery.Shared as Shared
  import Cardano.Wallet.Api.Http.Server.Handlers.NetworkInformation
  import qualified Cardano.Wallet.Api.Types as Api
  import qualified Cardano.Wallet.Api.Types.Amount as ApiAmount
  import qualified Cardano.Wallet.Api.Types.WalletAssets as ApiWalletAssets
  import qualified Cardano.Wallet.DB as W
  import qualified Cardano.Wallet.Delegation as WD
  import qualified Cardano.Wallet.IO.Delegation as IODeleg
  import qualified Cardano.Wallet.Network as NW
  import qualified Cardano.Wallet.Primitive.Ledger.Convert as Convert
  import qualified Cardano.Wallet.Primitive.Types as W
  import qualified Cardano.Wallet.Primitive.Types.AssetName as AssetName
  import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
  import qualified Cardano.Wallet.Primitive.Types.Tx.SealedTx as W
      ( SealedTx
      , sealedTxFromCardano
      )
  import qualified Cardano.Wallet.Primitive.Types.Tx.Tx as W
      ( TxMetadata
      , TxScriptValidity
      )
  import qualified Cardano.Wallet.Primitive.Types.Tx.TxMeta as W
      ( Direction (Incoming, Outgoing)
      , TxMeta
      )
  import qualified Cardano.Wallet.Primitive.Types.Tx.TxOut as TxOut
  import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO
  import qualified Cardano.Wallet.Read as Read
  import qualified Cardano.Wallet.Read.Hash as Hash
  import qualified Cardano.Wallet.Registry as Registry
  import qualified Cardano.Write.Eras as Write
      ( IsRecentEra (recentEra)
      , RecentEra
      , cardanoEraFromRecentEra
      )
  import qualified Cardano.Write.Tx as Write
      ( PartialTx (..)
      , Redeemer (..)
      , StakeKeyDepositLookup (..)
      , TimelockKeyWitnessCounts (..)
      )
  import qualified Control.Concurrent.Concierge as Concierge
  import qualified Data.ByteArray as BA
  import qualified Data.ByteString as BS
  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 Internal.Cardano.Write.Tx as Write
      ( Datum (DatumHash, NoDatum)
      , PParamsInAnyRecentEra (PParamsInAnyRecentEra)
      , Tx
      , TxIn
      , TxOutInRecentEra (TxOutInRecentEra)
      , fromCardanoApiTx
      , getFeePerByte
      , pattern PolicyId
      , toCardanoApiTx
      , utxoFromTxOutsInRecentEra
      )
  import qualified Internal.Cardano.Write.Tx.Sign as Write
      ( estimateMinWitnessRequiredPerInput
      )
  import qualified Network.Ntp as Ntp
  
  {-------------------------------------------------------------------------------
                                Wallet Constructors
  -------------------------------------------------------------------------------}
  
  type MkApiWallet ctx s w
      =  ctx
      -> WalletId
      -> Wallet s
      -> WalletMetadata
      -> WalletDelegation
      -> Set Tx
      -> SyncProgress
      -> Handler w
  
  --------------------- Shelley
  postWallet
      :: forall ctx s k n.
          ( s ~ SeqState n k
          , k ~ ShelleyKey
          , ctx ~ ApiLayer s
          , Seq.SupportsDiscovery n k
          , HasDBFactory s ctx
          , HasWorkerRegistry s ctx
          , AddressBookIso s
          , MaybeLight s
          )
      => ctx
      -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
      -> (XPub -> k 'AccountK XPub)
      -> WalletOrAccountPostData
      -> Handler ApiWallet
  postWallet ctx generateKey liftKey (WalletOrAccountPostData body) = case body of
      Left body' -> postShelleyWallet ctx generateKey body'
      Right body' ->
          let action workerCtx _ =
                  W.manageRewardBalance
                      (workerCtx ^. typed @(Tracer IO WalletWorkerLog))
                      (workerCtx ^. networkLayer)
                      (workerCtx ^. typed @(DBLayer IO (SeqState n ShelleyKey)))
  
          in postAccountWallet ctx mkShelleyWallet liftKey action body'
  
  computeRestorationPoint
      :: forall ctx s body
       . ( ctx ~ ApiLayer s
         , HasField' "restorationMode" body (Maybe (ApiT RestorationMode))
         )
      => ctx
      -> NetworkParameters
      -> body
      -> Handler RestorationPoint
  computeRestorationPoint ctx networkParams body =
      liftHandler
          $ withExceptT ErrCreateWalletRestorationFromABlockFailed
          $ ExceptT
          $ getRestorationPoint
              (genesisParameters networkParams)
              (maybe RestoreFromGenesis getApiT $ body ^. #restorationMode)
              (ctx ^. networkLayer)
  
  postShelleyWallet
      :: forall ctx s k n.
          ( s ~ SeqState n k
          , k ~ ShelleyKey
          , ctx ~ ApiLayer s
          , Seq.SupportsDiscovery n k
          , HasDBFactory s ctx
          , HasWorkerRegistry s ctx
          , IsOurs s RewardAccount
          , MaybeLight s
          , AddressBookIso s
          )
      => ctx
      -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
      -> WalletPostData
      -> Handler ApiWallet
  postShelleyWallet ctx generateKey body = do
      let state = mkSeqStateFromRootXPrv
              (keyFlavorFromState @s) (RootCredentials rootXPrv pwdP)
              purposeCIP1852 g changeAddrMode
      restorationPoint <- computeRestorationPoint ctx networkParams body
      let initialState = InitialState state genesisBlock restorationPoint
      void $ liftHandler $ createWalletWorker @_ @s ctx wid
          (W.createWallet @s networkParams wid wName initialState)
          (\workerCtx _ -> W.manageRewardBalance
              (workerCtx ^. typed)
              (workerCtx ^. networkLayer)
              (workerCtx ^. typed @(DBLayer IO (SeqState n ShelleyKey)))
          )
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> handler $
          W.attachPrivateKeyFromPwd wrk (rootXPrv, pwd)
      fst <$> getWallet ctx (mkShelleyWallet @_ @s) (ApiT wid)
    where
      seed = getApiMnemonicT (body ^. #mnemonicSentence)
      secondFactor = getApiMnemonicT <$> (body ^. #mnemonicSecondFactor)
      pwd = getApiT (body ^. #passphrase)
      pwdP = preparePassphrase currentPassphraseScheme pwd
      rootXPrv = generateKey (seed, secondFactor) pwdP
      g = maybe defaultAddressPoolGap getApiT (body ^. #addressPoolGap)
      wid = WalletId $ digest ShelleyKeyS $ publicKey ShelleyKeyS rootXPrv
      wName = getApiT (body ^. #name)
      (genesisBlock, networkParams) = ctx ^. #netParams
      changeAddrMode = case body ^. #oneChangeAddressMode of
          Just True -> SingleChangeAddress
          _         -> IncreasingChangeAddresses
  
  postAccountWallet
      :: forall ctx s k n w.
          ( s ~ SeqState n k
          , ctx ~ ApiLayer s
          , Seq.SupportsDiscovery n k
          , HasWorkerRegistry s ctx
          , IsOurs s RewardAccount
          , MaybeLight s
          , AddressBookIso s
          , WalletFlavor 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 mkWallet liftKey coworker body = do
      restorationPoint <- computeRestorationPoint ctx networkParams body
      let state = mkSeqStateFromAccountXPub
              (liftKey accXPub) Nothing purposeCIP1852 g IncreasingChangeAddresses
          initialState = InitialState state genesisBlock restorationPoint
      void $ liftHandler $ createWalletWorker @_ @s ctx wid
          (W.createWallet @s networkParams wid wName initialState)
          coworker
      fst <$> getWallet ctx mkWallet (ApiT wid)
    where
      g = maybe defaultAddressPoolGap getApiT (body ^. #addressPoolGap)
      wName = getApiT (body ^. #name)
      (ApiAccountPublicKey accXPubApiT) =  body ^. #accountPublicKey
      accXPub = getApiT accXPubApiT
      wid = WalletId $ digest (keyFlavorFromState @s) (liftKey accXPub)
      (genesisBlock, networkParams) = netParams ctx
  
  mkShelleyWallet
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ SeqState n k
          , IsOurs s Address
          , IsOurs s RewardAccount
          , HasWorkerRegistry s ctx
          )
      => MkApiWallet ctx s ApiWallet
  mkShelleyWallet ctx@ApiLayer{..} wid cp meta delegation pending progress = do
      reward <- withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk ->
          -- never fails - returns zero if balance not found
          liftIO $ W.fetchRewardBalance @s $ wrk ^. dbLayer
  
      let ti = timeInterpreter netLayer
  
      -- 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
      apiDelegation <- liftIO $ toApiWalletDelegation delegation
          (unsafeExtendSafeZone ti)
  
      tip <- liftIO $ getWalletTip
          (neverFails "getWalletTip wallet tip should be behind node tip" ti)
          cp
      let available = availableBalance pending cp
      let total = totalBalance pending reward cp
      pure ApiWallet
          { addressPoolGap = ApiT $ getGap $ getState cp ^. #externalPool
          , balance = ApiWalletBalance
              { available = ApiAmount.fromCoin (available ^. #coin)
              , total = ApiAmount.fromCoin (total ^. #coin)
              , reward = ApiAmount.fromCoin reward
              }
          , assets = ApiWalletAssetsBalance
              { available =
                  ApiWalletAssets.fromTokenMap (available ^. #tokens)
              , total =
                  ApiWalletAssets.fromTokenMap (total ^. #tokens)
              }
          , delegation = apiDelegation
          , id = ApiT wid
          , name = ApiT $ meta ^. #name
          , passphrase = ApiWalletPassphraseInfo
              <$> fmap (view #lastUpdatedAt) (meta ^. #passphraseInfo)
          , state = ApiT progress
          , tip
          }
  
  toApiWalletDelegation
      :: W.WalletDelegation -> TimeInterpreter IO -> IO ApiWalletDelegation
  toApiWalletDelegation W.WalletDelegation{active,next} ti = do
      apiNext <- forM next $ \W.WalletDelegationNext{status,changesAt} -> do
          info <- interpretQuery ti $ toEpochInfo changesAt
          return $ toApiWalletDelegationNext (Just info) status
  
      return $ ApiWalletDelegation
          { active = toApiWalletDelegationNext Nothing active
          , next = apiNext
          }
    where
      toApiWalletDelegationNext mepochInfo = \case
          W.Delegating pid -> ApiWalletDelegationNext
              { status = Delegating
              , target = Just (ApiT pid)
              , voting = Nothing
              , changesAt = mepochInfo
              }
  
          W.NotDelegating -> ApiWalletDelegationNext
              { status = NotDelegating
              , target = Nothing
              , voting = Nothing
              , changesAt = mepochInfo
              }
  
          W.Voting voting -> ApiWalletDelegationNext
              { status = Voting
              , target = Nothing
              , voting =  Just (ApiT voting)
              , changesAt = mepochInfo
              }
  
          W.DelegatingVoting pid voting -> ApiWalletDelegationNext
              { status = VotingAndDelegating
              , target = Just (ApiT pid)
              , voting =  Just (ApiT voting)
              , changesAt = mepochInfo
              }
  
  --------------------- Shared Wallet
  
  postSharedWallet
      :: forall ctx s k n.
          ( s ~ SharedState n k
          , k ~ SharedKey
          , ctx ~ ApiLayer s
          , Shared.SupportsDiscovery n k
          , HasDBFactory s ctx
          , HasWorkerRegistry s ctx
          )
      => ctx
      ->  ( (SomeMnemonic, Maybe SomeMnemonic)
            -> Passphrase "encryption"
            -> k 'RootK XPrv
          )
      -> (XPub -> k 'AccountK XPub)
      -> ApiSharedWalletPostData
      -> Handler ApiSharedWallet
  postSharedWallet ctx generateKey liftKey postData =
      case postData of
          ApiSharedWalletPostData (Left body) ->
              postSharedWalletFromRootXPrv ctx generateKey body
          ApiSharedWalletPostData (Right body) ->
              postSharedWalletFromAccountXPub ctx liftKey body
  
  postSharedWalletFromRootXPrv
      :: forall ctx s k n.
          ( s ~ SharedState n k
          , k ~ SharedKey
          , ctx ~ ApiLayer s
          , Shared.SupportsDiscovery n k
          , HasDBFactory s ctx
          , HasWorkerRegistry s ctx
          )
      => ctx
      ->  ( (SomeMnemonic, Maybe SomeMnemonic)
            -> Passphrase "encryption"
            -> k 'RootK XPrv
          )
      -> ApiSharedWalletPostDataFromMnemonics
      -> Handler ApiSharedWallet
  postSharedWalletFromRootXPrv ctx generateKey body = do
      let wid = WalletId $ toSharedWalletId kF accXPub pTemplate dTemplateM
      validateScriptTemplates kF accXPub scriptValidation pTemplate dTemplateM
          & \case
              Left err -> liftHandler
                  $ throwE
                  $ ErrConstructSharedWalletWrongScriptTemplate err
              Right _ -> pure ()
      ix' <- liftHandler $ withExceptT ErrConstructSharedWalletInvalidIndex $
          W.guardHardIndex ix
      let state = mkSharedStateFromRootXPrv kF
              (RootCredentials rootXPrv pwdP) ix' changeAddrMode
              g pTemplate dTemplateM
      let stateReadiness = state ^. #ready
          initialState = InitialState state genesisBlock RestorationPointAtGenesis
          create = W.createWallet @s networkParams wid wName initialState
      if stateReadiness == Shared.Pending
      then void $ liftHandler $ createNonRestoringWalletWorker @_ @s ctx wid
          create
      else if isNothing dTemplateM then
          void $ liftHandler $ createWalletWorker @_ @s ctx wid
          create
          idleWorker
      else void $ liftHandler $ createWalletWorker @_ @s ctx wid
          create
          (\workerCtx _ -> W.manageSharedRewardBalance
              (workerCtx ^. typed)
              (workerCtx ^. networkLayer)
              (workerCtx ^. typed @(DBLayer IO (SharedState n SharedKey)))
          )
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> handler $
          W.attachPrivateKeyFromPwd wrk (rootXPrv, pwd)
      fst <$> getWallet ctx (mkSharedWallet @_ @s) (ApiT wid)
    where
      kF = keyOfWallet wF
      wF = walletFlavor @s
      seed = body ^. #mnemonicSentence . #getApiMnemonicT
      secondFactor = getApiMnemonicT <$> body ^. #mnemonicSecondFactor
      pwdP = preparePassphrase currentPassphraseScheme pwd
      pwd = body ^. #passphrase . #getApiT
      rootXPrv = generateKey (seed, secondFactor) pwdP
      g = defaultAddressPoolGap
      ix = getApiT (body ^. #accountIndex)
      pTemplate = scriptTemplateFromSelf (getRawKey SharedKeyS accXPub)
          $ body ^. #paymentScriptTemplate
      dTemplateM = scriptTemplateFromSelf (getRawKey SharedKeyS accXPub)
          <$> body ^. #delegationScriptTemplate
      wName = getApiT (body ^. #name)
      accXPub = publicKey SharedKeyS
          $ deriveAccountPrivateKey pwdP rootXPrv (Index $ getDerivationIndex ix)
      scriptValidation =
          maybe RecommendedValidation getApiT (body ^. #scriptValidation)
      (genesisBlock, networkParams) = ctx ^. #netParams
      changeAddrMode = case body ^. #oneChangeAddressMode of
          Just True -> SingleChangeAddress
          _         -> IncreasingChangeAddresses
  
  postSharedWalletFromAccountXPub
      :: forall ctx s k n.
          ( s ~ SharedState n k
          , k ~ SharedKey
          , ctx ~ ApiLayer s
          , Shared.SupportsDiscovery n k
          , HasDBFactory s ctx
          , HasWorkerRegistry s ctx
          )
      => ctx
      -> (XPub -> k 'AccountK XPub)
      -> ApiSharedWalletPostDataFromAccountPubX
      -> Handler ApiSharedWallet
  postSharedWalletFromAccountXPub ctx liftKey body = do
      let kF = keyFlavorFromState @s
          wid = WalletId $ toSharedWalletId kF
                  (liftKey accXPub) pTemplate dTemplateM
      validateScriptTemplates kF
          (liftKey accXPub)
          scriptValidation
          pTemplate
          dTemplateM
          & \case
              Left err -> liftHandler
                  $ throwE
                  $ ErrConstructSharedWalletWrongScriptTemplate err
              Right _ -> pure ()
      acctIx <- liftHandler $ withExceptT ErrConstructSharedWalletInvalidIndex $
          W.guardHardIndex ix
      let state = mkSharedStateFromAccountXPub kF
              (liftKey accXPub) acctIx IncreasingChangeAddresses g pTemplate dTemplateM
      let stateReadiness = state ^. #ready
          initialState = InitialState state genesisBlock RestorationPointAtGenesis
          create = W.createWallet @s networkParams wid wName initialState
      if stateReadiness == Shared.Pending
      then void $ liftHandler $ createNonRestoringWalletWorker @_ @s ctx wid
          create
      else if isNothing dTemplateM then
          void $ liftHandler $ createWalletWorker @_ @s ctx wid
          create
          idleWorker
      else void $ liftHandler $ createWalletWorker @_ @s ctx wid
          create
          (\workerCtx _ -> W.manageSharedRewardBalance
              (workerCtx ^. typed)
              (workerCtx ^. networkLayer)
              (workerCtx ^. typed @(DBLayer IO (SharedState n SharedKey)))
          )
      fst <$> getWallet ctx (mkSharedWallet @_ @s) (ApiT wid)
    where
      g = defaultAddressPoolGap
      ix = getApiT (body ^. #accountIndex)
      pTemplate = scriptTemplateFromSelf accXPub
          $ body ^. #paymentScriptTemplate
      dTemplateM = scriptTemplateFromSelf accXPub
          <$> body ^. #delegationScriptTemplate
      wName = getApiT (body ^. #name)
      (ApiAccountSharedPublicKey accXPubApiT) =  body ^. #accountPublicKey
      accXPub = getApiT accXPubApiT
      scriptValidation =
          maybe RecommendedValidation getApiT (body ^. #scriptValidation)
      (genesisBlock, networkParams) = ctx ^. #netParams
  
  scriptTemplateFromSelf :: XPub -> ApiScriptTemplateEntry -> ScriptTemplate
  scriptTemplateFromSelf xpub (ApiScriptTemplateEntry cosigners' template') =
      ScriptTemplate cosignersWithoutSelf template'
    where
      unSelf (SomeAccountKey xpub') = xpub'
      unSelf Self = xpub
      cosignersWithoutSelf = Map.map unSelf cosigners'
  
  mkSharedWallet
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ SharedState n k
          , HasWorkerRegistry s ctx
          , Shared.SupportsDiscovery n k
          )
      => MkApiWallet ctx s ApiSharedWallet
  mkSharedWallet ctx wid cp meta delegation pending progress =
      case Shared.ready st of
      Shared.Pending -> pure $ ApiSharedWallet $ Left $ ApiIncompleteSharedWallet
          { id = ApiT wid
          , name = ApiT $ meta ^. #name
          , accountIndex = ApiT $ DerivationIndex $ getIndex accIx
          , addressPoolGap = ApiT $ Shared.poolGap st
          , paymentScriptTemplate = ApiScriptTemplate $ Shared.paymentTemplate st
          , delegationScriptTemplate =
              ApiScriptTemplate <$> Shared.delegationTemplate st
          }
      Shared.Active _ -> do
          reward <- withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk ->
              -- never fails - returns zero if balance not found
              liftIO $ W.fetchRewardBalance @s $ wrk ^. dbLayer
  
          let ti = timeInterpreter $ ctx ^. networkLayer
          apiDelegation <- liftIO $ toApiWalletDelegation delegation
              (unsafeExtendSafeZone ti)
  
          tip' <- liftIO $ getWalletTip
              (neverFails "getWalletTip wallet tip should be behind node tip" ti)
              cp
          let available = availableBalance pending cp
          let total = totalBalance pending reward cp
          pure $ ApiSharedWallet $ Right $ ApiActiveSharedWallet
              { id = ApiT wid
              , name = ApiT $ meta ^. #name
              , accountIndex = ApiT $ DerivationIndex $ getIndex accIx
              , addressPoolGap = ApiT $ Shared.poolGap st
              , passphrase = ApiWalletPassphraseInfo
                  <$> fmap (view #lastUpdatedAt) (meta ^. #passphraseInfo)
              , paymentScriptTemplate = ApiScriptTemplate
                  $ Shared.paymentTemplate st
              , delegationScriptTemplate = ApiScriptTemplate
                  <$> Shared.delegationTemplate st
              , delegation = apiDelegation
              , balance = ApiWalletBalance
                  { available = ApiAmount.fromCoin (available ^. #coin)
                  , total = ApiAmount.fromCoin (total ^. #coin)
                  , reward = ApiAmount.fromCoin reward
                  }
              , assets = ApiWalletAssetsBalance
                  { available =
                      ApiWalletAssets.fromTokenMap (available ^. #tokens)
                  , total =
                      ApiWalletAssets.fromTokenMap (total ^. #tokens)
                  }
              , state = ApiT progress
              , tip = tip'
              }
    where
      st = getState cp
      DerivationPrefix (_,_,accIx) = Shared.derivationPrefix st
  
  patchSharedWallet
      :: forall ctx s k n.
          ( s ~ SharedState n k
          , k ~ SharedKey
          , ctx ~ ApiLayer s
          , Shared.SupportsDiscovery n k
          )
      => ctx
      -> (XPub -> k 'AccountK XPub)
      -> CredentialType
      -> ApiT WalletId
      -> ApiSharedWalletPatchData
      -> Handler ApiSharedWallet
  patchSharedWallet ctx liftKey cred (ApiT wid) body = do
      wal <- fst <$> getWallet ctx (mkSharedWallet @_ @s) (ApiT wid)
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          liftHandler $ W.updateCosigner wrk (liftKey accXPub) cosigner cred
      wal' <- fst <$> getWallet ctx (mkSharedWallet @_ @s) (ApiT wid)
      -- we switch on restoring only after incomplete -> active transition
      -- active -> active when transition of updating cosigner keys takes place
      -- should not trigger this
  
      when (isRight (wal' ^. #wallet) && isLeft (wal ^. #wallet)) $ do
          (state, prvKeyM, meta) <- withWorkerCtx ctx wid liftE liftE
              $ \wrk -> handler $ do
                  let db = wrk ^. W.dbLayer @IO @s
                  db & \W.DBLayer
                      { atomically
                      , readCheckpoint
                      , walletState
                      } -> do
                          cp <- atomically readCheckpoint
                          let state = getState cp
                          --could be for account and root key wallets
                          prvKeyM <- atomically $ readPrivateKey walletState
                          meta <- atomically (readWalletMeta walletState)
                          pure (state, prvKeyM, meta)
  
          void $ deleteWallet ctx (ApiT wid)
          let wName = meta ^. #name
              initialState
                  = InitialState state genesisBlock RestorationPointAtGenesis
          void $ liftHandler $ createWalletWorker @_ @s ctx wid
              (W.createWallet @s networkParams wid wName initialState)
              idleWorker
          withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk ->
              handler $ W.updateWallet wrk (const meta)
          when (isJust prvKeyM)
              $ withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> handler
              $ W.attachPrivateKeyFromPwdHashShelley wrk (fromJust prvKeyM)
  
      fst <$> getWallet ctx (mkSharedWallet @_ @s) (ApiT wid)
    where
      cosigner = getApiT (body ^. #cosigner)
      (ApiAccountSharedPublicKey accXPubApiT) = (body ^. #accountPublicKey)
      accXPub = getApiT accXPubApiT
      (genesisBlock, networkParams) = ctx ^. #netParams
  
  --------------------- Legacy
  
  postLegacyWallet
      :: forall ctx s k.
          ( ctx ~ ApiLayer s
          , KnownDiscovery s
          , IsOurs s RewardAccount
          , IsOurs s Address
          , MaybeLight s
          , HasNetworkLayer IO ctx
          , k ~ KeyOf s
          , AddressBookIso s
          , WalletFlavor s
          )
      => ctx
          -- ^ Surrounding Context
      -> (k 'RootK XPrv, Passphrase "user")
          -- ^ Root key
      -> ( WalletId -> IO (W.DBLayerParams s) )
          -- ^ How to create this legacy wallet
      -> Handler ApiByronWallet
  postLegacyWallet ctx (rootXPrv, pwd) createWallet = do
      void $ liftHandler $ createWalletWorker @_ @s ctx wid
          (createWallet wid)
          idleWorker
      withWorkerCtx ctx wid liftE liftE $ \wrk -> handler $
          W.attachPrivateKeyFromPwd wrk (rootXPrv, pwd)
      fst <$> getWallet ctx mkLegacyWallet (ApiT wid)
    where
      kF = keyOfWallet wF
      wF = walletFlavor @s
      wid = WalletId
          $ digest kF
          $ publicKey kF rootXPrv
  
  mkLegacyWallet
      :: forall ctx s .
          ( HasWorkerRegistry s ctx
          , HasDBFactory s ctx
          , KnownDiscovery s
          , HasNetworkLayer IO ctx
          , IsOurs s Address
          , IsOurs s RewardAccount
          )
      => ctx
      -> WalletId
      -> Wallet s
      -> WalletMetadata
      -> WalletDelegation
      -> Set Tx
      -> SyncProgress
      -> Handler ApiByronWallet
  mkLegacyWallet ctx wid cp meta _ pending 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.
      pwdInfo <- case meta ^. #passphraseInfo of
          Nothing ->
              pure Nothing
          Just (WalletPassphraseInfo time EncryptWithPBKDF2) ->
              pure $ Just $ ApiWalletPassphraseInfo time
          Just (WalletPassphraseInfo time EncryptWithScrypt) ->
              withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk ->
                  matchEmptyPassphrase (wrk ^. typed) <&> \case
                      Right{} -> Nothing
                      Left{} -> Just $ ApiWalletPassphraseInfo time
  
      tip' <- liftIO $ getWalletTip (expectAndThrowFailures ti) cp
      let available = availableBalance pending cp
      let total = totalBalance pending (Coin 0) cp
      pure ApiByronWallet
          { balance = ApiByronWalletBalance
              { available = ApiAmount.fromCoin $ TokenBundle.getCoin available
              , total = ApiAmount.fromCoin $ TokenBundle.getCoin total
              }
          , assets = ApiWalletAssetsBalance
              { available =
                  ApiWalletAssets.fromTokenMap (available ^. #tokens)
              , total =
                  ApiWalletAssets.fromTokenMap (total ^. #tokens)
              }
          , id = ApiT wid
          , name = ApiT $ meta ^. #name
          , passphrase = pwdInfo
          , state = ApiT progress
          , tip = tip'
          , discovery = knownDiscovery @s
          }
    where
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter $ ctx ^. networkLayer
  
      matchEmptyPassphrase :: DBLayer IO s -> Handler (Either ErrWithRootKey ())
      matchEmptyPassphrase db = liftIO $ runExceptT $
          W.withRootKey @s db wid mempty Prelude.id (\_ _ -> pure ())
  
  postRandomWallet
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ RndState n
          , k ~ ByronKey
          )
      => ctx
      -> ByronWalletPostData '[12,15,18,21,24]
      -> Handler ApiByronWallet
  postRandomWallet ctx body = do
      s <- liftIO $ mkRndState rootXPrv <$> getStdRandom random
      let initialState = InitialState s genesisBlock RestorationPointAtGenesis
      postLegacyWallet ctx (rootXPrv, pwd) $ \wid ->
          W.createWallet @s networkParams wid wName initialState
    where
      wName    = body ^. #name . #getApiT
      seed     = body ^. #mnemonicSentence . #getApiMnemonicT
      pwd      = body ^. #passphrase . #getApiT
      pwdP     = preparePassphrase currentPassphraseScheme pwd
      rootXPrv = Byron.generateKeyFromSeed seed pwdP
      (genesisBlock, networkParams) = ctx ^. #netParams
  
  postRandomWalletFromXPrv
      :: forall ctx s n.
          ( ctx ~ ApiLayer s
          , s ~ RndState n
          , HasNetworkLayer IO ctx
          )
      => ctx
      -> ByronWalletFromXPrvPostData
      -> Handler ApiByronWallet
  postRandomWalletFromXPrv ctx body = do
      s <- liftIO $ mkRndState byronKey <$> getStdRandom random
      let initialState = InitialState s genesisBlock RestorationPointAtGenesis
      void $ liftHandler $ createWalletWorker @_ @s ctx wid
          (W.createWallet @s networkParams wid wName initialState)
          idleWorker
      withWorkerCtx ctx wid liftE liftE $ \wrk -> handler $
          W.attachPrivateKeyFromPwdHashByron wrk (byronKey, pwd)
      fst <$> getWallet ctx mkLegacyWallet (ApiT wid)
    where
      wName = getApiT (body ^. #name)
      pwd   = getApiT (body ^. #passphraseHash)
      masterKey = getApiT (body ^. #encryptedRootPrivateKey)
      byronKey = mkByronKeyFromMasterKey masterKey
      wid = WalletId $ digest ByronKeyS $ publicKey ByronKeyS byronKey
      (genesisBlock, networkParams) = ctx ^. #netParams
  
  postIcarusWallet
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ SeqState n k
          , k ~ IcarusKey
          , HasSNetworkId n
          )
      => ctx
      -> ByronWalletPostData '[12,15,18,21,24]
      -> Handler ApiByronWallet
  postIcarusWallet ctx body = do
      postLegacyWallet ctx (rootXPrv, pwd) $ \wid ->
          W.createIcarusWallet @s genesisParams wid wName
              (RootCredentials rootXPrv pwdP)
    where
      wName    = body ^. #name . #getApiT
      seed     = body ^. #mnemonicSentence . #getApiMnemonicT
      pwd      = body ^. #passphrase . #getApiT
      pwdP     = preparePassphrase currentPassphraseScheme pwd
      rootXPrv = Icarus.generateKeyFromSeed seed pwdP
      genesisParams = ctx ^. #netParams
  
  postTrezorWallet
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ SeqState n k
          , k ~ IcarusKey
          , HasSNetworkId n
          )
      => ctx
      -> ByronWalletPostData '[12,15,18,21,24]
      -> Handler ApiByronWallet
  postTrezorWallet = postIcarusWallet
  
  postLedgerWallet
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ SeqState n k
          , k ~ IcarusKey
          , HasSNetworkId n
          )
      => ctx
      -> ByronWalletPostData '[12,15,18,21,24]
      -> Handler ApiByronWallet
  postLedgerWallet ctx body = do
      postLegacyWallet ctx (rootXPrv, pwd) $ \wid ->
          W.createIcarusWallet @s genesisParams wid wName
              (RootCredentials rootXPrv pwdP)
    where
      wName    = body ^. #name . #getApiT
      mw       = body ^. #mnemonicSentence . #getApiMnemonicT
      pwd      = body ^. #passphrase . #getApiT
      pwdP     = preparePassphrase currentPassphraseScheme pwd
      rootXPrv = Icarus.generateKeyFromHardwareLedger mw pwdP
      genesisParams = ctx ^. #netParams
  
  {-------------------------------------------------------------------------------
                               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)
          , icarus ~ ApiLayer (SeqState n IcarusKey)
          )
      => ApiT WalletId
      -> (byron, Handler a)
      -> (icarus, Handler a)
      -> Handler a
  withLegacyLayer (ApiT wid) (byron, withByron) (icarus, withIcarus) =
      withLegacyLayer' (ApiT wid)
          (byron, withByron, liftE)
          (icarus, withIcarus, liftE)
  
  -- | Like 'withLegacyLayer' but allow passing a custom handler for handling dead
  -- workers.
  withLegacyLayer'
      :: forall byron icarus n a.
          ( byron ~ ApiLayer (RndState n)
          , icarus ~ ApiLayer (SeqState n IcarusKey)
          )
      => ApiT WalletId
      -> (byron, Handler a, ErrWalletNotResponding -> Handler a)
      -> (icarus, Handler a, ErrWalletNotResponding -> Handler a)
      -> Handler a
  withLegacyLayer' (ApiT wid)
    (byron, withByron, deadByron)
    (icarus, withIcarus, deadIcarus)
      = tryByron (const $ tryIcarus liftE deadIcarus) deadByron
    where
      tryIcarus onMissing onNotResponding = withWorkerCtx @_
          @(SeqState n IcarusKey)
          icarus
          wid
          onMissing
          onNotResponding
          (const withIcarus)
  
      tryByron onMissing onNotResponding = withWorkerCtx @_
          @(RndState n)
          byron
          wid
          onMissing
          onNotResponding
          (const withByron)
  
  {-------------------------------------------------------------------------------
                                     Wallets
  -------------------------------------------------------------------------------}
  
  deleteWallet
      :: forall ctx s
       . ctx ~ ApiLayer s
      => ctx
      -> ApiT WalletId
      -> Handler NoContent
  deleteWallet ctx (ApiT wid) = do
      -- Start a context so that an error is throw if the wallet doesn't exist.
      withWorkerCtx @_ @s ctx wid liftE
          (const $ pure ()) (const $ pure ())
  
      liftIO $ Registry.unregister re wid
      liftIO $ removeDatabase df wid
  
      return NoContent
    where
      re = ctx ^. workerRegistry @s
      df = ctx ^. dbFactory @s
  
  getWallet
      :: forall ctx s apiWallet.
          ( ctx ~ ApiLayer s
          , HasWorkerRegistry s ctx
          , HasDBFactory s ctx
          )
      => ctx
      -> MkApiWallet ctx s apiWallet
      -> ApiT WalletId
      -> Handler (apiWallet, UTCTime)
  getWallet ctx mkApiWallet (ApiT wid) = do
      withWorkerCtx @_ @s ctx wid liftE whenNotResponding whenAlive
    where
      dbfa = ctx ^. dbFactory @s
  
      whenAlive wrk = do
          (cp, (meta, delegation), pending)
              <- handler $ W.readWallet wrk
          progress <- liftIO $ W.walletSyncProgress @_ @_ ctx cp
          (, meta ^. #creationTime)
              <$> mkApiWallet ctx wid cp meta delegation pending progress
  
      whenNotResponding _ = Handler $ ExceptT
          $ withDatabaseLoad dbfa wid
          $ \db -> runHandler $ do
              let wrk = hoistResource db (MsgFromWorker wid) ctx
              (cp, (meta, delegation), pending)
                  <- handler $ W.readWallet wrk
              (, meta ^. #creationTime)
                  <$> mkApiWallet ctx wid cp meta delegation pending NotResponding
  
  listWallets
      :: forall ctx s apiWallet
       . ( ctx ~ ApiLayer s
         , NFData apiWallet
         )
      => ctx
      -> MkApiWallet ctx s apiWallet
      -> Handler [(apiWallet, UTCTime)]
  listWallets ctx mkApiWallet = do
      wids <- liftIO $ listDatabases df
      liftIO $ sortOn snd . catMaybes <$> mapM maybeGetWallet (ApiT <$> wids)
    where
      df = ctx ^. dbFactory @s
  
      -- 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 =
          fmap (join . eitherToMaybe)
          . tryAnyDeep
          . fmap eitherToMaybe
          . runHandler
          . getWallet ctx mkApiWallet
  
  putWalletByron
      :: forall ctx s apiWallet . ctx ~ ApiLayer s
      => ctx
      -> MkApiWallet ctx s apiWallet
      -> ApiT WalletId
      -> ApiWalletPutData
      -> Handler apiWallet
  putWalletByron ctx mkApiWallet (ApiT wid) body = do
      case body ^. #name of
          Nothing ->
              return ()
          Just (ApiT wName) -> withWorkerCtx ctx wid liftE liftE $ \wrk -> do
              handler $ W.updateWallet wrk (modify wName)
      fst <$> getWallet ctx mkApiWallet (ApiT wid)
  
  modify :: W.WalletName -> WalletMetadata -> WalletMetadata
  modify wName meta = meta { name = wName }
  
  putWallet
      :: forall ctx s apiWallet
       . ( WalletFlavor s
         , ctx ~ ApiLayer s
         )
      => ctx
      -> MkApiWallet ctx s apiWallet
      -> ApiT WalletId
      -> ApiWalletPutDataExtended
      -> Handler apiWallet
  putWallet ctx mkApiWallet (ApiT wid) body = do
      case body ^. #name of
          Nothing ->
              return ()
          Just (ApiT wName) -> withWorkerCtx ctx wid liftE liftE $ \wrk -> do
              handler $ W.updateWallet wrk (modify wName)
      case walletFlavor @s of
          ShelleyWallet ->
              case body ^. #oneChangeAddressMode of
                  Just modeOnOff -> withWorkerCtx ctx wid liftE liftE $ \wrk -> do
                      handler $ W.setChangeAddressMode wrk (toOneAddrMode modeOnOff)
                  _ ->
                      return ()
          SharedWallet ->
              case body ^. #oneChangeAddressMode of
                  Just modeOnOff -> withWorkerCtx ctx wid liftE liftE $ \wrk -> do
                      handler $ W.setChangeAddressModeShared wrk (toOneAddrMode modeOnOff)
                  _ ->
                      return ()
          _ ->
              return ()
      fst <$> getWallet ctx mkApiWallet (ApiT wid)
    where
      toOneAddrMode = \case
          True  -> SingleChangeAddress
          False -> IncreasingChangeAddresses
  
  putWalletPassphrase
      :: forall ctx s k .
          ( ctx ~ ApiLayer s
          , GetAccount s k
          , WalletFlavor s
          , KeyOf s ~ k
          , HardDerivation k
          )
      => ctx
      -> ((SomeMnemonic, Maybe SomeMnemonic)
              -> Passphrase "encryption"
              -> k 'RootK XPrv
          )
      -> (k 'AccountK XPub -> XPub)
      -> ApiT WalletId
      -> WalletPutPassphraseData
      -> Handler NoContent
  putWalletPassphrase ctx createKey getKey (ApiT wid)
      (WalletPutPassphraseData method) = withWrk $ \wrk ->
          NoContent <$ case method of
          Left
              (Api.WalletPutPassphraseOldPassphraseData
                  (ApiT old)
                  (ApiT new)
              ) -> liftHandler
                  $ W.updateWalletPassphraseWithOldPassphrase
                      (walletFlavor @s) wrk wid (old, new)
          Right
              (Api.WalletPutPassphraseMnemonicData
                      (ApiMnemonicT mnemonic) sndFactor (ApiT new)
              ) -> do
              let encrPass = preparePassphrase currentPassphraseScheme new
                  challengeKey = createKey
                      (mnemonic, getApiMnemonicT <$> sndFactor) encrPass
                  challengPubKey = publicKey (keyFlavorFromState @s)
                      $ deriveAccountPrivateKey encrPass challengeKey minBound
              storedPubKey <- handler $ W.readAccountPublicKey wrk
              if getKey challengPubKey == getKey storedPubKey
                  then handler $ W.updateWalletPassphraseWithMnemonic wrk
                          (challengeKey, new)
                  else liftHandler
                      $ throwE
                      $ ErrUpdatePassphraseWithRootKey
                      $ ErrWithRootKeyWrongMnemonic wid
    where
      withWrk :: (WorkerCtx (ApiLayer s) -> Handler a) -> Handler a
      withWrk = withWorkerCtx ctx wid liftE liftE
  
  putByronWalletPassphrase
      :: forall ctx s
       . ( WalletFlavor s
         , ctx ~ ApiLayer s
         )
      => ctx
      -> ApiT WalletId
      -> ByronWalletPutPassphraseData
      -> Handler NoContent
  putByronWalletPassphrase ctx (ApiT wid) body = do
      let (ByronWalletPutPassphraseData oldM (ApiT new)) = body
      withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ do
          let old = maybe mempty (coerce . getApiT) oldM
          W.updateWalletPassphraseWithOldPassphrase
              (walletFlavor @s) wrk wid (old, new)
      return NoContent
  
  getUTxOsStatistics
      :: forall ctx s
       . ctx ~ ApiLayer s
      => ctx
      -> ApiT WalletId
      -> Handler ApiUtxoStatistics
  getUTxOsStatistics ctx (ApiT wid) = do
      stats <- withWorkerCtx ctx wid liftE liftE $ \wrk -> handler $
          W.listUtxoStatistics wrk
      return $ toApiUtxoStatistics stats
  
  getWalletUtxoSnapshot
      :: ApiLayer s
      -> ApiT WalletId
      -> Handler ApiWalletUtxoSnapshot
  getWalletUtxoSnapshot ctx (ApiT wid) = do
      entries <- withWorkerCtx ctx wid liftE liftE $ \wrk -> handler $
          W.getWalletUtxoSnapshot wrk
      return $ mkApiWalletUtxoSnapshot entries
    where
      mkApiWalletUtxoSnapshot :: [TokenBundle] -> ApiWalletUtxoSnapshot
      mkApiWalletUtxoSnapshot bundleMinCoins = ApiWalletUtxoSnapshot
          { entries = mkApiWalletUtxoSnapshotEntry <$> bundleMinCoins }
  
      mkApiWalletUtxoSnapshotEntry
          :: TokenBundle -> ApiWalletUtxoSnapshotEntry
      mkApiWalletUtxoSnapshotEntry bundle = ApiWalletUtxoSnapshotEntry
          { ada = ApiAmount.fromCoin $ view #coin bundle
          , assets = ApiWalletAssets.fromTokenMap $ view #tokens bundle
          }
  
  {-------------------------------------------------------------------------------
                                    Coin Selections
  -------------------------------------------------------------------------------}
  
  selectCoins
      :: forall s n k.
          ( IsOurs s Address
          , WalletFlavor s
          , Excluding '[SharedKey] k
          , s ~ SeqState n k
          , HasSNetworkId (NetworkOf s)
          , AddressBookIso s
          , GenChange s
          )
      => ApiLayer s
      -> ArgGenChange s
      -> ApiT WalletId
      -> ApiSelectCoinsPayments n
      -> Handler (ApiCoinSelection n)
  selectCoins ctx@ApiLayer {..} argGenChange (ApiT walletId) body = do
      withWorkerCtx ctx walletId liftE liftE $ \workerCtx -> do
          let db = workerCtx ^. dbLayer
  
          (Write.PParamsInAnyRecentEra era pp, timeTranslation)
              <- liftIO $ W.readNodeTipStateForTxWrite netLayer
  
          withdrawal <-
              body ^. #withdrawal
                  & maybe (pure NoWithdrawal)
                      (shelleyOnlyMkWithdrawal
                          netLayer
                          (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
                          db)
          let genChange = W.defaultChangeAddressGen argGenChange
          let paymentOuts = NE.toList $ addressAmountToTxOut <$> body ^. #payments
          let txCtx = defaultTransactionCtx
                  { txWithdrawal = withdrawal
                  , txMetadata = getApiT <$> body ^. #metadata
                  , txDeposit = Just $ W.getStakeKeyDeposit pp
                  }
  
          (tx, walletState) <-
              liftIO $
              W.buildTransaction @s era
              db timeTranslation genChange pp txCtx paymentOuts
  
          let W.CoinSelection{..} =
                  W.buildCoinSelectionForTransaction @s @n
                      walletState
                      paymentOuts
                      (W.getStakeKeyDeposit pp)
                      Nothing -- delegation action
                      tx
  
          pure ApiCoinSelection
              { inputs = mkApiCoinSelectionInput <$> inputs
              , outputs = mkApiCoinSelectionOutput <$> outputs
              , change = mkApiCoinSelectionChange <$> change
              , collateral = mkApiCoinSelectionCollateral <$> collateral
              , certificates = uncurry mkApiCoinSelectionDelCerts <$>
                  delegationAction
              , withdrawals = mkApiCoinSelectionWithdrawal <$> withdrawals
              , depositsTaken = maybeToList $ ApiAmount.fromCoin <$> deposit
              , depositsReturned = maybeToList $ ApiAmount.fromCoin <$> refund
              , metadata = ApiBytesT. serialiseToCBOR
                  <$> body ^? #metadata . traverse . #getApiT
              }
  
  selectCoinsForJoin
      :: forall s n k.
          ( s ~ SeqState n k
          , WalletFlavor s
          , Excluding '[SharedKey] k
          , AddressBookIso s
          , Seq.SupportsDiscovery n k
          , DelegationAddress k 'CredFromKeyK
          )
      => ApiLayer s
      -> 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 knownPools getPoolStatus poolId walletId = do
      poolStatus <- liftIO $ getPoolStatus poolId
      pools <- liftIO knownPools
      withWorkerCtx ctx walletId liftE liftE $ \workerCtx -> liftIO $ do
          W.CoinSelection{..} <- IODeleg.selectCoinsForJoin
              workerCtx
              pools
              poolId
              poolStatus
          pure ApiCoinSelection
              { inputs = mkApiCoinSelectionInput <$> inputs
              , outputs = mkApiCoinSelectionOutput <$> outputs
              , change = mkApiCoinSelectionChange <$> change
              , collateral = mkApiCoinSelectionCollateral <$> collateral
              , certificates = uncurry mkApiCoinSelectionDelCerts <$>
                  delegationAction
              , withdrawals = mkApiCoinSelectionWithdrawal <$> withdrawals
              , depositsTaken = maybeToList $ ApiAmount.fromCoin <$> deposit
              , depositsReturned = maybeToList $ ApiAmount.fromCoin <$> refund
              , metadata = Nothing
              }
  
  selectCoinsForQuit
      :: forall s n k.
          ( s ~ SeqState n k
          , WalletFlavor s
          , Excluding '[SharedKey] k
          , AddressBookIso s
          , Seq.SupportsDiscovery n k
          , DelegationAddress k 'CredFromKeyK
          )
      => ApiLayer (SeqState n k)
      -> ApiT WalletId
      -> Handler (ApiCoinSelection n)
  selectCoinsForQuit ctx (ApiT walletId) = do
      withWorkerCtx ctx walletId liftE liftE $ \workerCtx -> liftIO $ do
          W.CoinSelection{..} <-
              IODeleg.selectCoinsForQuit workerCtx
          pure ApiCoinSelection
              { inputs = mkApiCoinSelectionInput <$> inputs
              , outputs = mkApiCoinSelectionOutput <$> outputs
              , change = mkApiCoinSelectionChange <$> change
              , collateral = mkApiCoinSelectionCollateral <$> collateral
              , certificates = uncurry mkApiCoinSelectionDelCerts <$>
                  delegationAction
              , withdrawals = mkApiCoinSelectionWithdrawal <$> withdrawals
              , depositsTaken = maybeToList $ ApiAmount.fromCoin <$> deposit
              , depositsReturned = maybeToList $ ApiAmount.fromCoin <$> refund
              , metadata = Nothing
              }
  
  {-------------------------------------------------------------------------------
                                       Assets
  -------------------------------------------------------------------------------}
  
  data ErrGetAsset
       = ErrGetAssetNotPresent
      deriving (Eq, 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
       . ( ctx ~ ApiLayer s
         , IsOurs s Address
         , HasTokenMetadataClient ctx
         )
      => ctx
      -> ApiT WalletId
      -> Handler [ApiAsset]
  listAssets ctx wid = do
      assets <- listAssetsBase ctx wid
      liftIO $ fillMetadata client (Set.toList assets) toApiAsset
    where
      client = ctx ^. tokenMetadataClient
  
  -- | Return a list of all AssetIds involved in the transaction history of this
  -- wallet.
  listAssetsBase
      :: forall s k . (IsOurs s Address, k ~ KeyOf s) =>
      ApiLayer s -> ApiT WalletId -> Handler (Set AssetId)
  listAssetsBase ctx (ApiT wallet) =
      withWorkerCtx ctx wallet liftE liftE $ \wctx ->
          handler $ W.listAssets wctx
  
  -- | 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 .
          ( ctx ~ ApiLayer s
          , IsOurs s Address
          , HasTokenMetadataClient ctx
          )
      => ctx
      -> ApiT WalletId
      -> ApiT TokenPolicyId
      -> ApiT AssetName
      -> Handler ApiAsset
  getAsset ctx wid (ApiT policyId) (ApiT assetName) = do
      assetId <- liftHandler . findAsset =<< listAssetsBase ctx wid
      liftIO $ runIdentity <$> fillMetadata client (Identity assetId) toApiAsset
    where
      findAsset = maybe (throwE ErrGetAssetNotPresent) pure
          . F.find (== (AssetId policyId assetName))
      client = ctx ^. tokenMetadataClient
  
  -- | The handler for 'getAsset' when 'AssetName' is empty.
  getAssetDefault
      :: forall ctx s .
          ( ctx ~ ApiLayer s
          , IsOurs s Address
          , HasTokenMetadataClient ctx
          )
      => ctx
      -> ApiT WalletId
      -> ApiT TokenPolicyId
      -> Handler ApiAsset
  getAssetDefault ctx wid pid = getAsset ctx wid pid (ApiT AssetName.empty)
  
  {-------------------------------------------------------------------------------
                                      Addresses
  -------------------------------------------------------------------------------}
  
  postRandomAddress
      :: forall ctx s n.
          ( s ~ RndState n
          , ctx ~ ApiLayer s
          , HasSNetworkId n
          )
      => ctx
      -> ApiT WalletId
      -> ApiPostRandomAddressData
      -> Handler (ApiAddressWithPath n)
  postRandomAddress ctx (ApiT wid) body = do
      let pwd = coerce $ getApiT $ body ^. #passphrase
      let mix = getApiT <$> (body ^. #addressIndex)
      (addr, path) <- withWorkerCtx ctx wid liftE liftE
          $ \wrk -> liftHandler $ W.createRandomAddress @_ @n wrk wid pwd mix
      pure $ coerceAddress (addr, Unused, path)
    where
      coerceAddress (a, s, p) =
          ApiAddressWithPath (ApiAddress @n a) (ApiT s) (NE.map ApiT p)
  
  putRandomAddress
      :: forall ctx s n.
          ( s ~ RndState n
          , ctx ~ ApiLayer s
          )
      => ctx
      -> ApiT WalletId
      -> ApiAddress n
      -> Handler NoContent
  putRandomAddress ctx (ApiT wid) (ApiAddress addr)  = do
      withWorkerCtx ctx wid liftE liftE
          $ \wrk -> liftHandler $ W.importRandomAddresses wrk [addr]
      pure NoContent
  
  putRandomAddresses
      :: forall ctx s n
       . ( s ~ RndState n
         , ctx ~ ApiLayer s
         )
      => ctx
      -> ApiT WalletId
      -> ApiPutAddressesData n
      -> Handler NoContent
  putRandomAddresses ctx (ApiT wid) (ApiPutAddressesData addrs)  = do
      withWorkerCtx ctx wid liftE liftE
          $ \wrk -> liftHandler $ W.importRandomAddresses wrk addrs'
      pure NoContent
    where
      addrs' = apiAddress <$> addrs
  
  listAddresses
      :: forall ctx s n.
          ( ctx ~ ApiLayer s
          , CompareDiscovery s
          , KnownAddresses s
          )
      => ctx
      -> (s -> Address -> Maybe Address)
      -> ApiT WalletId
      -> Maybe (ApiT AddressState)
      -> Handler [ApiAddressWithPath n]
  listAddresses ctx normalize (ApiT wid) stateFilter = do
      addrs <- withWorkerCtx ctx wid liftE liftE $ \wrk -> handler $
          W.listAddresses wrk normalize
      return $ coerceAddress <$> filter filterCondition addrs
    where
      filterCondition :: (Address, AddressState, NonEmpty DerivationIndex) -> Bool
      filterCondition = case stateFilter of
          Nothing -> const True
          Just (ApiT s) -> \(_,state,_) -> (state == s)
      coerceAddress (a, s, p) =
          ApiAddressWithPath (ApiAddress @n a) (ApiT s) (NE.map ApiT p)
  
  {-------------------------------------------------------------------------------
                                      Transactions
  -------------------------------------------------------------------------------}
  
  signTransaction
      :: forall s k
       .  ( Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
          , HardDerivation k
          , WalletFlavor s
          , KeyOf s ~ k
          , AccountIxForStaking s
          , IsOurs s Address
          , HasSNetworkId (NetworkOf s)
          )
      => ApiLayer s
      -> ApiT WalletId
      -> ApiSignTransactionPostData
      -> Handler ApiSerialisedTransaction
  signTransaction ctx (ApiT wid) body = do
      let pwd = coerce $ body ^. #passphrase . #getApiT
          wF = walletFlavor @s
      sealedTx' <- withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ do
          let
              db = wrk ^. W.dbLayer @IO @s
              tl = wrk ^. W.transactionLayer @k
              nl = wrk ^. W.networkLayer
          db & \W.DBLayer{atomically, readCheckpoint} ->
              W.withRootKey @s db wid pwd ErrWitnessTxWithRootKey
                  $ \rootK scheme -> lift $ do
                      cp <- atomically readCheckpoint
                      let
                          pwdP :: Passphrase "encryption"
                          pwdP = preparePassphrase scheme pwd
  
                          utxo :: UTxO.UTxO
                          utxo = totalUTxO mempty cp
  
                          keyLookup = isOwned wF (getState cp) (rootK, pwdP)
  
                          accIxForStakingM :: Maybe (Index 'Hardened 'AccountK)
                          accIxForStakingM = getAccountIx @s (getState cp)
  
                          witCountCtx = shelleyOrShared wF
                              AnyWitnessCountCtx $ \flavor ->
                                  toWitnessCountCtx flavor (getState cp)
  
                      era <- liftIO $ NW.currentNodeEra nl
                      let sealedTx = body ^. #transaction . #getApiT
                      pure $ W.signTransaction
                          (keyFlavorFromState @s)
                          tl era witCountCtx keyLookup
                          Nothing (RootCredentials rootK pwdP) utxo accIxForStakingM 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.
      pure $ ApiSerialisedTransaction (ApiT sealedTx') $
          case body ^. #encoding of
              Just HexEncoded -> HexEncoded
              _otherEncodings -> Base64Encoded
  
  postTransactionOld
      :: forall ctx s n k.
          ( ctx ~ ApiLayer s
          , GenChange s
          , HardDerivation k
          , HasNetworkLayer IO ctx
          , Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
          , AddressBookIso s
          , HasDelegation s
          , IsOurs s Address
          , IsOurs s RewardAccount
          , WalletFlavor s
          , Excluding '[SharedKey] k
          , KeyOf s ~ k
          , CredFromOf s ~ 'CredFromKeyK
          , HasSNetworkId (NetworkOf s)
          , n ~ NetworkOf s
          )
      => ctx
      -> ArgGenChange s
      -> ApiT WalletId
      -> PostTransactionOldData n
      -> Handler (ApiTransaction n)
  postTransactionOld ctx@ApiLayer{..} argGenChange (ApiT wid) body = do
      let outs = addressAmountToTxOut <$> body ^. #payments
      let md = body ^? #metadata . traverse . #txMetadataWithSchema_metadata
      let mTTL = body ^? #timeToLive . traverse . #getQuantity
      (Write.PParamsInAnyRecentEra era _, _)
          <- liftIO $ W.readNodeTipStateForTxWrite netLayer
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          let db = wrk ^. dbLayer
          ttl <- liftIO $ W.transactionExpirySlot ti mTTL
          wdrl <- case body ^. #withdrawal of
              Nothing -> pure NoWithdrawal
              Just apiWdrl ->
                  shelleyOnlyMkWithdrawal
                      netLayer
                      (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
                      db
                      apiWdrl
          when (containsSelfWithdrawal wdrl) $
              liftHandler $ W.assertIsVoting db era
          let txCtx = defaultTransactionCtx
                  { txWithdrawal = wdrl
                  , txMetadata = md
                  , txValidityInterval = (Nothing, ttl)
                  }
          (BuiltTx{..}, txTime) <- atomicallyWithHandler
              (ctx ^. walletLocks) (PostTransactionOld wid) $ liftIO $
                  W.buildSignSubmitTransaction @s
                      db
                      netLayer
                      txLayer
                      (coerce $ getApiT $ body ^. #passphrase)
                      wid
                      (W.defaultChangeAddressGen argGenChange)
                      (PreSelection $ NE.toList outs)
                      txCtx
  
          pp <- liftIO $ NW.currentProtocolParameters netLayer
          mkApiTransaction
              (timeInterpreter netLayer)
              wrk
              #pendingSince
              MkApiTransactionParams
                  { txId = builtTx ^. #txId
                  , txFee = builtTx ^. #fee
                  , txInputs = builtTx ^. #resolvedInputs
                  , txCollateralInputs = []
                  , txOutputs = builtTx ^. #outputs
                  , txCollateralOutput = builtTx ^. #collateralOutput
                  , txWithdrawals = builtTx ^. #withdrawals
                  , txMeta = builtTxMeta
                  , txMetadata = builtTx ^. #metadata
                  , txTime
                  , txScriptValidity = builtTx ^. #scriptValidity
                  , txDeposit = W.stakeKeyDeposit pp
                  , txMetadataSchema = TxMetadataDetailedSchema
                  , txCBOR = builtTx ^. #txCBOR
                  }
    where
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter (ctx ^. networkLayer)
  
  deleteTransaction
      :: forall ctx s
       . ctx ~ ApiLayer s
      => ctx
      -> ApiT WalletId
      -> ApiTxId
      -> Handler NoContent
  deleteTransaction ctx (ApiT wid) (ApiTxId (ApiT (tid))) = do
      withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $
          W.forgetTx wrk tid
      return NoContent
  
  listTransactions
      :: forall s n
       . ( HasDelegation s
         , WalletFlavor s
         )
      => ApiLayer s
      -> ApiT WalletId
      -> Maybe MinWithdrawal
      -> Maybe Iso8601Time
      -> Maybe Iso8601Time
      -> Maybe (ApiT SortOrder)
      -> Maybe ApiLimit
      -> Maybe (ApiAddress n)
      -> TxMetadataSchema
      -> Handler [ApiTransaction n]
  listTransactions
      ctx (ApiT wid) mMinWithdrawal mStart mEnd mOrder mLimit mAddress metadataSchema =
          withWorkerCtx ctx wid liftE liftE $ \wrk -> do
              txs <- liftHandler $
                  W.listTransactions wrk
                  (Coin . fromIntegral . getMinWithdrawal <$> mMinWithdrawal)
                  (getIso8601Time <$> mStart)
                  (getIso8601Time <$> mEnd)
                  (maybe defaultSortOrder getApiT mOrder)
                  (fromApiLimit <$> mLimit)
                  (apiAddress <$> mAddress)
              depo <- liftIO $ W.stakeKeyDeposit <$>
                  NW.currentProtocolParameters (wrk ^. networkLayer)
              forM txs $ \tx ->
                  mkApiTransactionFromInfo
                      (timeInterpreter (ctx ^. networkLayer))
                      wrk
                      depo
                      tx
                      metadataSchema
    where
      defaultSortOrder :: SortOrder
      defaultSortOrder = Descending
  
  getTransaction
      :: forall s n
       . ( HasDelegation s
         , WalletFlavor s
         )
      => ApiLayer s
      -> ApiT WalletId
      -> ApiTxId
      -> TxMetadataSchema
      -> Handler (ApiTransaction n)
  getTransaction ctx (ApiT wid) (ApiTxId (ApiT (tid))) metadataSchema =
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          tx <- liftHandler $ W.getTransaction wrk tid
          depo <- liftIO $ W.stakeKeyDeposit <$>
              NW.currentProtocolParameters (wrk ^. networkLayer)
          mkApiTransactionFromInfo
                  (timeInterpreter (ctx ^. networkLayer)) wrk depo tx
                  metadataSchema
  
  -- Populate an API transaction record with 'TransactionInfo' from the wallet
  -- layer.
  mkApiTransactionFromInfo
      :: ( HasDelegation s
         , WalletFlavor s
         )
      => TimeInterpreter (ExceptT PastHorizonException IO)
      -> W.WalletLayer IO s
      -> Coin
      -> TransactionInfo
      -> TxMetadataSchema
      -> Handler (ApiTransaction n)
  mkApiTransactionFromInfo ti wrk deposit info metadataSchema = do
      apiTx <- mkApiTransaction
          ti wrk status
          MkApiTransactionParams
              { txId = info ^. #txInfoId
              , txFee = info ^. #txInfoFee
              , txInputs = info ^. #txInfoInputs
              , txCollateralInputs = info ^. #txInfoCollateralInputs
              , txOutputs = info ^. #txInfoOutputs
              , txCollateralOutput = info ^. #txInfoCollateralOutput
              , txWithdrawals = info ^. #txInfoWithdrawals
              , txMeta = info ^. #txInfoMeta
              , txMetadata = info ^. #txInfoMetadata
              , txTime = info ^. #txInfoTime
              , txScriptValidity = info ^. #txInfoScriptValidity
              , txDeposit = deposit
              , txMetadataSchema = metadataSchema
              , txCBOR = info ^. #txInfoCBOR
              }
      return $ case info ^. (#txInfoMeta . #status) of
          Pending  -> apiTx
          InLedger -> apiTx {depth = Just $ info ^. #txInfoDepth}
          Expired  -> apiTx
    where
      status :: Lens' (ApiTransaction n) (Maybe ApiBlockReference)
      status = case info ^. #txInfoMeta . #status of
          Pending  -> #pendingSince
          InLedger -> #insertedAt
          Expired  -> #pendingSince
  
  postTransactionFeeOld
      :: forall s n k
       . ( WalletFlavor s
         , Excluding '[SharedKey] k
         , AddressBookIso s
         , k ~ KeyOf s
         , CredFromOf s ~ 'CredFromKeyK
         , HasSNetworkId (NetworkOf s)
         )
      => ApiLayer s
      -> ApiT WalletId
      -> PostTransactionFeeOldData n
      -> Handler ApiFee
  postTransactionFeeOld ctx@ApiLayer{..} (ApiT walletId) body = do
      (Write.PParamsInAnyRecentEra _era pp, timeTranslation)
          <- liftIO $ W.readNodeTipStateForTxWrite netLayer
  
      let mTTL = body ^? #timeToLive . traverse . #getQuantity
      withWorkerCtx ctx walletId liftE liftE $ \workerCtx -> do
          let db = workerCtx ^. dbLayer
          ttl <- liftIO $ W.transactionExpirySlot (timeInterpreter netLayer) mTTL
          wdrl <- case body ^. #withdrawal of
              Nothing -> pure NoWithdrawal
              Just apiWdrl ->
                  shelleyOnlyMkWithdrawal
                      netLayer
                      (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
                      db
                      apiWdrl
          let outputs = F.toList $ addressAmountToTxOut <$> body ^. #payments
              minCoins = W.calcMinimumCoinValues pp txLayer
                  <$> outputs
          feePercentiles <- liftIO $ W.transactionFee @s
              db
              pp
              timeTranslation
              dummyChangeAddressGen
              defaultTransactionCtx
                  { txWithdrawal = wdrl
                  , txMetadata = body
                      ^? #metadata . traverse . #txMetadataWithSchema_metadata
                  , txValidityInterval = (Nothing, ttl)
                  }
              PreSelection{outputs}
          pure
              $ mkApiFee Nothing minCoins
              $ W.padFeePercentiles
                  (Write.getFeePerByte pp)
                  padding
                  feePercentiles
    where
      -- Padding to make the fee percentiles more imprecise, for the following
      -- reasons:
      --
      -- 1. dummyChangeAddressGen uses the longest possbile addresses. For byron
      -- wallets they are 83 bytes long, which is longer than what we'd
      -- expect in reality, and longer than the shortest Byron address we'd expect
      -- of 66 bytes. I.e. we could be off by up to 17 bytes.
      --
      -- 2. Our integration tests often assume that transaction fees are bounded
      -- absolutely by the estimate intervals provided by postTransactionFee.
      -- This assumption is flawed, since each estimate interval is merely a pair
      -- of 10- and 90-th percentile values: these are not absolute bounds.
      --
      -- But for the moment, it's still useful for integration tests to expect
      -- that eventual fees are bounded by prior fee estimates: during the risky
      -- transition to balanceTx they will compare the result of a rewritten
      -- version of postTransactionFee with the result of an unmodified version
      -- of postTransaction. They may also act as golden tests in lieu of
      -- better/more tests on the unit level. A small amount of padding is a
      -- cheap way to keep these checks.
      --
      -- In the context of a mainnet `minfeeA` value of 44 lovelace/byte the
      -- padding is negligible - less than 1/1000 ada.
      padding :: Quantity "byte" Word
      padding = Quantity 20
  
  constructTransaction
      :: forall s n
       . (HasSNetworkId n, s ~ SeqState n ShelleyKey)
      => ApiLayer s
      -> IO (Set PoolId)
      -> (PoolId -> IO PoolLifeCycleStatus)
      -> ApiT WalletId
      -> ApiConstructTransactionData n
      -> Handler (ApiConstructTransaction n)
  constructTransaction api knownPools poolStatus apiWalletId body = do
      body & \(ApiConstructTransactionData _ _ _ _ _ _ _ _ _ _) ->
      -- Above is the way to get a compiler error when number of fields changes,
      -- in order not to forget to update the pattern below:
          case body of
              ApiConstructTransactionData
                  { payments = Nothing
                  , withdrawal = Nothing
                  , metadata = Nothing
                  , encryptMetadata = Nothing
                  , mintBurn = Nothing
                  , delegations = Nothing
                  , vote = Nothing
                  } -> liftHandler $ throwE ErrConstructTxWrongPayload
              _ -> pure ()
  
      when (isJust (body ^. #encryptMetadata) && isNothing (body ^. #metadata) ) $
           liftHandler $ throwE ErrConstructTxWrongPayload
  
      metadata <- case (body ^. #encryptMetadata, body ^. #metadata) of
          (Just apiEncrypt, Just metadataWithSchema) -> do
              salt <- liftIO $ genSalt 8
              let pwd :: ByteString
                  pwd = BA.convert $ unPassphrase $ getApiT $
                        apiEncrypt ^. #passphrase
                  meta = metadataWithSchema ^. #txMetadataWithSchema_metadata
              toMetadataEncrypted pwd meta (Just salt)
                  & \case
                      Left err ->
                          liftHandler $ throwE $ ErrConstructTxFromMetadataEncryption err
                      Right meta' ->
                          pure $ Just meta'
          _ ->
              pure $ body ^? #metadata . traverse . #txMetadataWithSchema_metadata
  
      validityInterval <-
          liftHandler $ parseValidityInterval ti $ body ^. #validityInterval
  
      mintBurnDatum <-
          liftHandler $ except $ parseMintBurnData body validityInterval
  
      mintBurnReferenceScriptTemplate <-
          liftHandler $ except $ parseReferenceScript body
  
      delegationRequest <-
          liftHandler $ traverse parseDelegationRequest $ body ^. #delegations
  
      withWorkerCtx api walletId liftE liftE $ \wrk -> do
          let db = wrk ^. dbLayer
              netLayer = wrk ^. networkLayer
  
          (Write.PParamsInAnyRecentEra era pp, timeTranslation)
              <- liftIO $ W.readNodeTipStateForTxWrite netLayer
  
          withdrawal <- case body ^. #withdrawal of
              Just SelfWithdraw -> liftIO $
                  W.shelleyOnlyMkSelfWithdrawal
                      netLayer
                      (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
                      db
              _ -> pure NoWithdrawal
  
          currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer
          (optionalDelegationAction, optionalVoteAction) <- liftIO $
              IODeleg.handleDelegationVoteRequest wrk
              currentEpochSlotting knownPools
              poolStatus withdrawal delegationRequest
              (getApiT <$> body ^. #vote)
  
          when (isJust (body ^. #vote)) $ do
              whenLeft (W.votingEnabledInEra era) (liftHandler .throwE)
              liftHandler $ W.assertDifferentVoting db optionalVoteAction era
  
          let transactionCtx0 = defaultTransactionCtx
                  { txWithdrawal = withdrawal
                  , txVotingAction = optionalVoteAction
                  , txDeposit = Just $ W.getStakeKeyDeposit pp
                  , txMetadata = metadata
                  , txValidityInterval = first Just validityInterval
                  }
  
          let transactionCtx1 =
                  case optionalDelegationAction of
                      Nothing -> transactionCtx0
                      Just action ->
                          transactionCtx0 { txDelegationAction = Just action }
  
          policyXPubM <-
              fmap fst . eitherToMaybe <$> liftIO (W.readPolicyPublicKey wrk)
  
          transactionCtx2 <-
              if isJust mintBurnDatum then do
                  policyXPub <- case policyXPubM of
                      Just val -> pure val
                      Nothing -> liftHandler $ throwE W.ErrReadPolicyPublicKeyAbsent
                  let isMinting mb = case mb ^. #mintBurnData of
                          Left (ApiMintBurnDataFromScript _ _ (ApiMint _)) -> True
                          Right (ApiMintBurnDataFromInput _ _ _ (ApiMint _)) -> True
                          _ -> False
  
                      makeLeft (a,t,s) = (a,t, Left s)
                      getMinting mb = case mb ^. #mintBurnData of
                          Left (ApiMintBurnDataFromScript
                              (ApiT scriptT)
                              (Just (ApiT tName))
                              (ApiMint (ApiMintData _ amt))) ->
                              makeLeft $
                              toTokenMapAndScript ShelleyKeyS
                                  scriptT
                                  (Map.singleton (Cosigner 0) policyXPub)
                                  tName
                                  amt
                          Right (ApiMintBurnDataFromInput
                              refInp
                              (ApiT policyId)
                              (Just (ApiT tName))
                              (ApiMint (ApiMintData _ amt))) ->
                              (AssetId policyId tName, TokenQuantity amt, Right refInp)
                          _ -> error "getMinting should not be used in this way"
                      getBurning mb = case mb ^. #mintBurnData of
                          Left (ApiMintBurnDataFromScript
                              (ApiT scriptT)
                              (Just (ApiT tName))
                              (ApiBurn (ApiBurnData amt))) ->
                              makeLeft $
                              toTokenMapAndScript ShelleyKeyS
                                  scriptT
                                  (Map.singleton (Cosigner 0) policyXPub)
                                  tName
                                  amt
                          Right (ApiMintBurnDataFromInput
                              refInp
                              (ApiT policyId)
                              (Just (ApiT tName))
                              (ApiBurn (ApiBurnData amt))) ->
                              (AssetId policyId tName, TokenQuantity amt, Right refInp)
                          _ -> error "getBurning should not be used in this way"
                      toTokenMap =
                          fromFlatList .
                          map (\(a,q,_) -> (a,q))
                      toScriptTemplateMap =
                          Map.fromList .
                          map (\(a,_,s) -> (a,s))
                      mintingData =
                          toTokenMap &&& toScriptTemplateMap $
                          map getMinting $
                          filter isMinting $
                          NE.toList $ fromJust mintBurnDatum
                      burningData =
                          toTokenMap &&& toScriptTemplateMap $
                          map getBurning $
                          filter (not . isMinting) $
                          NE.toList $ fromJust mintBurnDatum
                  pure transactionCtx1
                      { txAssetsToMint = mintingData
                      , txAssetsToBurn = burningData
                      }
              else
                  pure transactionCtx1
  
          referenceScriptM <- case policyXPubM of
              Just policyXPub ->
                  pure $
                  replaceCosigner
                  ShelleyKeyS
                  (Map.singleton (Cosigner 0) policyXPub)
                  <$> mintBurnReferenceScriptTemplate
              Nothing ->
                  if isJust mintBurnReferenceScriptTemplate then
                      liftHandler $ throwE W.ErrReadPolicyPublicKeyAbsent
                  else
                      pure Nothing
  
          let transactionCtx3 = transactionCtx2
                  { txReferenceScript = referenceScriptM
                  }
  
          outs <- case body ^. #payments of
              Nothing -> pure []
              Just (ApiPaymentAddresses content) ->
                  pure $ F.toList (addressAmountToTxOut <$> content)
  
          let mintWithAddress mb = case mb ^. #mintBurnData of
                  Left (ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData (Just _) _))) ->
                      True
                  Right (ApiMintBurnDataFromInput _ _ _ (ApiMint (ApiMintData (Just _) _))) ->
                      True
                  _ -> False
  
          let mintingOuts :: [TxOut]
              mintingOuts = case mintBurnDatum of
                  Just mintBurns ->
                      coalesceTokensPerAddr $
                      map (toMintTxOut (fromJust policyXPubM)) $
                      filter mintWithAddress $
                      NE.toList mintBurns
                  Nothing -> []
  
          unbalancedTx <- liftHandler $
              W.constructTransaction @n era
                  db transactionCtx3
                      PreSelection { outputs = outs <> mintingOuts }
  
          -- We need to assume that mint/burn scripts in reference inputs require
          -- 1 key witness each, and we need to tell 'balanceTransaction' about
          -- this assumption.
          let timelockKeyWitCountsForMintBurn
                  :: ApiMintBurnData n -> Write.TimelockKeyWitnessCounts
              timelockKeyWitCountsForMintBurn mb = case mb ^. #mintBurnData of
                  Left ApiMintBurnDataFromScript{} -> mempty
                  Right (ApiMintBurnDataFromInput _ (ApiT policyId) _ _) ->
                      let
                          Write.PolicyId policyId' =
                              Convert.toLedgerTokenPolicyId policyId
                      in
                          Write.TimelockKeyWitnessCounts
                              $ Map.singleton policyId' 1
          let mintBurnTimelockKeyWitCounts =
                  foldMap timelockKeyWitCountsForMintBurn
                  $ maybe [] NE.toList mintBurnDatum
  
          balancedTx <-
              fmap (toApiSerialisedTransaction (body ^. #encoding))
              . liftIO $ W.balanceTx
                  wrk
                  pp
                  timeTranslation
                  Write.PartialTx
                      { tx = Write.fromCardanoApiTx $ Cardano.Tx unbalancedTx []
                      , extraUTxO = mempty
                      , redeemers = mempty
                      , stakeKeyDeposits = Write.StakeKeyDepositMap mempty
                      -- Stake key deposits will be queried by W.balanceTx
                      , timelockKeyWitnessCounts = mintBurnTimelockKeyWitCounts
                      }
  
          apiDecoded <- decodeTransaction @_ @n api apiWalletId
                        (toApiDecodeTransactionPostData balancedTx)
  
          (_, _, rewardPath) <- handler $ W.readRewardAccount @s db
  
          let deposits = case (txDelegationAction transactionCtx3, txVotingAction transactionCtx3) of
                  (Just (JoinRegisteringKey _poolId), _) -> [W.getStakeKeyDeposit pp]
                  (_, Just (VoteRegisteringKey _vote)) -> [W.getStakeKeyDeposit pp]
                  _ -> []
  
          let refunds = case txDelegationAction transactionCtx3 of
                  Just Quit -> [W.getStakeKeyDeposit pp]
                  _ -> []
  
          pure ApiConstructTransaction
              { transaction = balancedTx
              , coinSelection = mkApiCoinSelection
                  deposits
                  refunds
                  ((,rewardPath) <$> transactionCtx3 ^. #txDelegationAction)
                  ((,rewardPath) <$> transactionCtx3 ^. #txVotingAction)
                  metadata
                  (unsignedTx rewardPath (outs ++ mintingOuts) apiDecoded)
              , fee = apiDecoded ^. #fee
              }
    where
      nl = api ^. networkLayer @IO
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter nl
  
      walletId = getApiT apiWalletId
  
      parseReferenceScript
          :: ApiConstructTransactionData n
          -> Either ErrConstructTx (Maybe (Script Cosigner))
      parseReferenceScript tx = do
          let mbRefScript = tx ^. #referencePolicyScriptTemplate
          for mbRefScript $ \(ApiT refScript) -> do
              guardWrongScriptTemplate refScript
              Right refScript
        where
          guardWrongScriptTemplate
              :: Script Cosigner -> Either ErrConstructTx ()
          guardWrongScriptTemplate apiScript =
              when (wrongMintingTemplate apiScript)
                  $ Left ErrConstructTxWrongMintingBurningTemplate
            where
              wrongMintingTemplate script =
                  isLeft (validateScriptOfTemplate RecommendedValidation script)
                  || countCosigners script /= (1 :: Int)
                  || existsNonZeroCosigner script
              countCosigners = foldScript (const (+ 1)) 0
              existsNonZeroCosigner =
                  foldScript (\cosigner a -> a || cosigner /= Cosigner 0) False
  
      parseMintBurnData
          :: ApiConstructTransactionData n
          -> (SlotNo, SlotNo)
          -> Either ErrConstructTx (Maybe (NonEmpty (ApiMintBurnData n)))
      parseMintBurnData tx validity = do
          let mbMintingBurning :: Maybe (NonEmpty (ApiMintBurnData n))
              mbMintingBurning =
                  fmap handleMissingAssetName <$> tx ^. #mintBurn
          for mbMintingBurning $ \mintBurnData -> do
              guardWrongMintingTemplate mintBurnData
              guardAssetNameTooLong mintBurnData
              guardAssetQuantityOutOfBounds mintBurnData
              guardOutsideValidityInterval validity mintBurnData
              Right mintBurnData
        where
          handleMissingAssetName :: ApiMintBurnData n -> ApiMintBurnData n
          handleMissingAssetName mb = case mb ^. #mintBurnData of
              Left fromScript -> ApiMintBurnData $ Left $
                      updateFromScript fromScript
              Right fromInp -> ApiMintBurnData $ Right $
                      updateFromInp fromInp
            where
              updateFromScript :: ApiMintBurnDataFromScript n -> ApiMintBurnDataFromScript n
              updateFromScript mbd = case mbd ^. #assetName of
                  Nothing -> mbd {assetName = Just (ApiT AssetName.empty)}
                  Just _ -> mbd
              updateFromInp :: ApiMintBurnDataFromInput n -> ApiMintBurnDataFromInput n
              updateFromInp mbd = case mbd ^. #assetName of
                  Nothing -> mbd {assetName = Just (ApiT AssetName.empty)}
                  Just _ -> mbd
  
          guardWrongMintingTemplate
              :: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
          guardWrongMintingTemplate mbs =
              when (any wrongMintingTemplate mbs)
                  $ Left ErrConstructTxWrongMintingBurningTemplate
            where
              wrongMintingTemplate mb = case mb ^. #mintBurnData of
                  Left (ApiMintBurnDataFromScript (ApiT script) _ _) ->
                      isLeft (validateScriptOfTemplate RecommendedValidation script)
                      || countCosigners script /= (1 :: Int)
                      || existsNonZeroCosigner script
                  Right (ApiMintBurnDataFromInput _ _ _ _) -> False
              countCosigners = foldScript (const (+ 1)) 0
              existsNonZeroCosigner =
                  foldScript (\cosigner a -> a || cosigner /= Cosigner 0) False
  
          guardAssetNameTooLong
              :: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
          guardAssetNameTooLong mbs =
              when (any assetNameTooLong mbs)$ Left ErrConstructTxAssetNameTooLong
            where
              assetNameTooLong mb = case mb ^. #mintBurnData of
                  Left (ApiMintBurnDataFromScript _ (Just (ApiT (UnsafeAssetName bs))) _) ->
                      BS.length bs > AssetName.maxLength
                  Right (ApiMintBurnDataFromInput _ _ (Just (ApiT (UnsafeAssetName bs))) _) ->
                      BS.length bs > AssetName.maxLength
                  _ -> error "at this moment there should be asset name attributed"
  
          guardAssetQuantityOutOfBounds
              :: NonEmpty (ApiMintBurnData n) -> Either ErrConstructTx ()
          guardAssetQuantityOutOfBounds mbs =
              when (any assetQuantityOutOfBounds mbs)
                  $ Left ErrConstructTxMintOrBurnAssetQuantityOutOfBounds
            where
              checkAmt amt =
                  amt <= 0 || amt > unTokenQuantity txMintBurnMaxTokenQuantity
              assetQuantityOutOfBounds mb = case mb ^. #mintBurnData of
                  Left (ApiMintBurnDataFromScript _ _ (ApiMint (ApiMintData _ amt))) ->
                      checkAmt amt
                  Left (ApiMintBurnDataFromScript _ _ (ApiBurn (ApiBurnData amt))) ->
                      checkAmt amt
                  Right (ApiMintBurnDataFromInput _ _ _ (ApiMint (ApiMintData _ amt))) ->
                      checkAmt amt
                  Right (ApiMintBurnDataFromInput _ _ _ (ApiBurn (ApiBurnData amt))) ->
                      checkAmt amt
  
          guardOutsideValidityInterval
              :: (SlotNo, SlotNo)
              -> NonEmpty (ApiMintBurnData n)
              -> Either ErrConstructTx ()
          guardOutsideValidityInterval (before, hereafter) mbs =
              when (any notWithinValidityInterval mbs) $
                  Left ErrConstructTxValidityIntervalNotWithinScriptTimelock
            where
              notWithinValidityInterval mb = case mb ^. #mintBurnData of
                  Left (ApiMintBurnDataFromScript (ApiT script) _ _) ->
                      not $ withinSlotInterval before hereafter $
                      scriptSlotIntervals script
                  Right _ -> False
  
      unsignedTx path initialOuts decodedTx = UnsignedTx
          { unsignedCollateral =
              mapMaybe toUnsignedTxInp (decodedTx ^. #collateral)
          , unsignedInputs =
              mapMaybe toUnsignedTxInp (decodedTx ^. #inputs)
          , unsignedOutputs =
              -- HACK: we leverage that balanceTx will append change outputs after
              -- the initial outputs to tell them apart. 'List.\\' does not work
              -- when balanceTx may change ada-quantities of initial inputs.
              take (length initialOuts)
                  $ map toUnsignedTxOut (decodedTx ^. #outputs)
          , unsignedChange =
              -- HACK: we leverage that balanceTx will append change outputs after
              -- the initial outputs to tell them apart. 'List.\\' does not work
              -- when balanceTx may change ada-quantities of initial inputs.
              drop (length initialOuts)
                  $ map toUnsignedTxChange (decodedTx ^. #outputs)
          , unsignedWithdrawals =
              mapMaybe (toUsignedTxWdrl path) (decodedTx ^. #withdrawals)
          }
  
      toMintTxOut :: XPub -> ApiMintBurnData n -> (ApiAddress n, TokenMap)
      toMintTxOut policyXPub mb = case mb ^. #mintBurnData of
          Left (ApiMintBurnDataFromScript (ApiT scriptT) (Just (ApiT tName))
              (ApiMint (ApiMintData (Just addr) amt))) ->
                  let (assetId, tokenQuantity, _) =
                          toTokenMapAndScript ShelleyKeyS
                              scriptT (Map.singleton (Cosigner 0) policyXPub)
                              tName amt
                      assets = fromFlatList [(assetId, tokenQuantity)]
                  in
                  (addr, assets)
          Right (ApiMintBurnDataFromInput _ (ApiT policyId) (Just (ApiT tName))
              (ApiMint (ApiMintData (Just addr) amt))) ->
                  let assetId = AssetId policyId tName
                      tokenQuantity = TokenQuantity amt
                      assets = fromFlatList [(assetId, tokenQuantity)]
                  in
                  (addr, assets)
          _ -> error $ unwords
              [ "toMintTxOut can only be used in the minting context with addr"
              , "specified"
              ]
  
      coalesceTokensPerAddr :: [(ApiAddress n, TokenMap)] -> [TxOut]
      coalesceTokensPerAddr =
          let toTxOut (addr, assets) =
                  addressAmountToTxOut $
                  AddressAmount addr mempty $
                  ApiWalletAssets.fromTokenMap assets
          in
          map toTxOut
              . Map.toList
              . foldr (uncurry (Map.insertWith (<>))) Map.empty
  
  toUsignedTxWdrl
      :: c -> ApiWithdrawalGeneral n -> Maybe (RewardAccount, Coin, c)
  toUsignedTxWdrl p = \case
      ApiWithdrawalGeneral (ApiRewardAccount rewardAcc) amount Our ->
          Just (rewardAcc, ApiAmount.toCoin amount, p)
      ApiWithdrawalGeneral _ _ External ->
          Nothing
  
  toUnsignedTxOut :: ApiTxOutputGeneral n -> TxOut
  toUnsignedTxOut = \case
      WalletOutput o ->
          let address = apiAddress (o ^. #address)
              coin = ApiAmount.toCoin (o ^. #amount)
              assets = ApiWalletAssets.toTokenMap (o ^. #assets)
          in
              TxOut address (TokenBundle coin assets)
      ExternalOutput o ->
          let address = apiAddress (o ^. #address)
              coin = ApiAmount.toCoin (o ^. #amount)
              assets = ApiWalletAssets.toTokenMap (o ^. #assets)
          in
              TxOut address (TokenBundle coin assets)
  
  toUnsignedTxInp
      :: ApiTxInputGeneral n
      -> Maybe (TxIn, TxOut, NonEmpty DerivationIndex)
  toUnsignedTxInp = \case
      WalletInput i ->
          let txId = getApiT (i ^. #id)
              index = i ^. #index
              address = apiAddress (i ^. #address)
              derivationPath = fmap getApiT (i ^. #derivationPath)
              coin = ApiAmount.toCoin (i ^. #amount)
              assets = ApiWalletAssets.toTokenMap (i ^. #assets)
              txIn = TxIn txId index
              txOut = TxOut address (TokenBundle coin assets)
          in
          Just (txIn, txOut, derivationPath)
      ExternalInput _ ->
          Nothing
  
  toUnsignedTxChange
      :: ApiTxOutputGeneral n
      -> TxChange (NonEmpty DerivationIndex)
  toUnsignedTxChange = \case
      WalletOutput o ->
          let address = apiAddress (o ^. #address)
              derivationPath = fmap getApiT (o ^. #derivationPath)
              coin = ApiAmount.toCoin (o ^. #amount)
              assets = ApiWalletAssets.toTokenMap (o ^. #assets)
          in
              TxChange address coin assets derivationPath
      ExternalOutput _ ->
          error "constructTx.toUnsignedTxChange: change should always be ours"
  
  parseDelegationRequest
      :: NonEmpty ApiMultiDelegationAction
      -> ExceptT ErrConstructTx IO WD.DelegationRequest
  parseDelegationRequest (action :| otherActions) = except $
      case otherActions of
          [] -> case action of
             Joining (ApiT pool) stakeKeyIdx | isValidKeyIdx stakeKeyIdx ->
                  Right $ WD.Join pool
             Leaving stakeKeyIdx | isValidKeyIdx stakeKeyIdx ->
                  Right WD.Quit
             _ -> Left ErrConstructTxMultiaccountNotSupported
          -- 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
          _ -> Left ErrConstructTxMultidelegationNotSupported
    where
      isValidKeyIdx (ApiStakeKeyIndex (ApiT derIndex)) =
          derIndex == DerivationIndex (getIndex @'Hardened minBound)
  
  parseValidityInterval
      :: TimeInterpreter (ExceptT PastHorizonException IO)
      -> Maybe ApiValidityInterval
      -> ExceptT ErrConstructTx IO (SlotNo, SlotNo)
  parseValidityInterval ti validityInterval = do
      let isValidityBoundTimeNegative
              (ApiValidityBoundAsTimeFromNow (Quantity sec)) = sec < 0
          isValidityBoundTimeNegative _ = False
  
      let isThereNegativeTime = case validityInterval of
              Just (ApiValidityInterval (Just before') Nothing) ->
                  isValidityBoundTimeNegative before'
              Just (ApiValidityInterval Nothing (Just hereafter')) ->
                  isValidityBoundTimeNegative hereafter'
              Just (ApiValidityInterval (Just before') (Just hereafter')) ->
                  isValidityBoundTimeNegative before' ||
                  isValidityBoundTimeNegative hereafter'
              Just (ApiValidityInterval Nothing Nothing) -> False
              Nothing -> False
  
      let fromValidityBound = liftIO . \case
              Left ApiValidityBoundUnspecified ->
                  pure $ SlotNo 0
              Right ApiValidityBoundUnspecified ->
                  W.transactionExpirySlot ti Nothing
              Right (ApiValidityBoundAsTimeFromNow (Quantity sec)) ->
                  W.transactionExpirySlot ti (Just sec)
              Left (ApiValidityBoundAsTimeFromNow (Quantity sec)) ->
                  W.transactionExpirySlot ti (Just sec)
              Right (ApiValidityBoundAsSlot (Quantity slot)) ->
                  pure $ SlotNo slot
              Left (ApiValidityBoundAsSlot (Quantity slot)) ->
                  pure $ SlotNo slot
  
      (before, hereafter) <- case validityInterval of
          Nothing -> do
              before' <- fromValidityBound (Left ApiValidityBoundUnspecified)
              hereafter' <- fromValidityBound (Right ApiValidityBoundUnspecified)
              pure (before', hereafter')
          Just (ApiValidityInterval before' hereafter') -> do
              before'' <- case before' of
                  Nothing -> fromValidityBound (Left ApiValidityBoundUnspecified)
                  Just val -> fromValidityBound (Left val)
              hereafter'' <- case hereafter' of
                  Nothing -> fromValidityBound (Right ApiValidityBoundUnspecified)
                  Just val -> fromValidityBound (Right val)
              pure (before'', hereafter'')
  
      when (hereafter < before || isThereNegativeTime) $
          throwE ErrConstructTxWrongValidityBounds
  
      pure (before, hereafter)
  
  -- TO-DO minting/burning
  -- TO-DO reference scripts
  constructSharedTransaction
      :: forall n . HasSNetworkId n
      => ApiLayer (SharedState n SharedKey)
      -> IO (Set PoolId)
      -> (PoolId -> IO PoolLifeCycleStatus)
      -> ApiT WalletId
      -> ApiConstructTransactionData n
      -> Handler (ApiConstructTransaction n)
  constructSharedTransaction
      api knownPools getPoolStatus (ApiT wid) body = do
      let isNoPayload =
              isNothing (body ^. #payments) &&
              isNothing (body ^. #withdrawal) &&
              isNothing (body ^. #metadata) &&
              isNothing (body ^. #mintBurn) &&
              isNothing (body ^. #delegations)
      when isNoPayload $
          liftHandler $ throwE ErrConstructTxWrongPayload
  
      let md = body ^? #metadata . traverse . #txMetadataWithSchema_metadata
  
      (before, hereafter) <- liftHandler $
          parseValidityInterval ti (body ^. #validityInterval)
  
      delegationRequest <-
          liftHandler $ traverse parseDelegationRequest $ body ^. #delegations
  
      withWorkerCtx @_ @_ @Handler api wid liftE liftE $ \wrk -> do
          let db = wrk ^. dbLayer
              netLayer = wrk ^. networkLayer
  
          currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer
          (Write.PParamsInAnyRecentEra era pp, timeTranslation)
              <- liftIO $ W.readNodeTipStateForTxWrite netLayer
          (cp, _, _) <- handler $ W.readWallet wrk
  
          when (isJust (body ^. #vote)) $
              whenLeft (W.votingEnabledInEra era) (liftHandler .throwE)
  
          let delegationTemplateM = Shared.delegationTemplate $ getState cp
          withdrawal <- case body ^. #withdrawal of
              Just SelfWithdraw -> liftIO $
                  W.mkSelfWithdrawalShared @n
                      netLayer
                      (txWitnessTagForKey SharedKeyS)
                      delegationTemplateM
                      db
              _ -> pure NoWithdrawal
  
          when (isNothing delegationTemplateM && isJust delegationRequest) $
              liftHandler $ throwE ErrConstructTxDelegationInvalid
  
          (optionalDelegationAction, optionalVoteAction) <- liftIO $
              IODeleg.handleDelegationVoteRequest wrk
              currentEpochSlotting knownPools
              getPoolStatus NoWithdrawal delegationRequest
              (getApiT <$> body ^. #vote)
  
          let txCtx = defaultTransactionCtx
                  { txWithdrawal = withdrawal
                  , txDeposit = Just $ W.getStakeKeyDeposit pp
                  , txMetadata = md
                  , txValidityInterval = (Just before, hereafter)
                  , txDelegationAction = optionalDelegationAction
                  , txVotingAction = optionalVoteAction
                  , txPaymentCredentialScriptTemplate =
                          Just (Shared.paymentTemplate $ getState cp)
                  , txStakingCredentialScriptTemplate = delegationTemplateM
                  }
          case Shared.ready (getState cp) of
              Shared.Pending ->
                  liftHandler $ throwE ErrConstructTxSharedWalletIncomplete
              Shared.Active _ -> do
                  let outs = case (body ^. #payments) of
                          Nothing ->
                              []
                          Just (ApiPaymentAddresses content) ->
                              F.toList (addressAmountToTxOut <$> content)
                  unbalancedTx <- liftHandler $
                      W.constructUnbalancedSharedTransaction @n era
                      db txCtx PreSelection {outputs = outs}
  
                  balancedTx <- liftIO $ W.balanceTx
                      wrk
                      pp
                      timeTranslation
                      Write.PartialTx
                          { tx = Write.fromCardanoApiTx
                               $ Cardano.Tx unbalancedTx []
                          , extraUTxO = mempty
                          , redeemers = mempty
                          , stakeKeyDeposits = Write.StakeKeyDepositMap mempty
                          -- Stake key deposits will be queried by W.balanceTx
                          , timelockKeyWitnessCounts = mempty
                          }
  
                  apiDecoded <- decodeSharedTransaction api (ApiT wid) $
                      ApiDecodeTransactionPostData
                          { transaction = ApiT (sealWriteTx balancedTx)
                          , decrypt_metadata = Nothing
                          }
                  let deposits = case optionalDelegationAction of
                          Just (JoinRegisteringKey _poolId) ->
                              [W.getStakeKeyDeposit pp]
                          _ -> []
                  let refunds = case optionalDelegationAction of
                          Just Quit -> [W.getStakeKeyDeposit pp]
                          _ -> []
                  delCertsWithPath <- case optionalDelegationAction of
                      Nothing -> pure Nothing
                      Just action -> do
                          (_, _, path) <-
                              handler $ W.readRewardAccount @((SharedState n SharedKey)) db
                          pure $ Just (action, path)
  
                  pathForWithdrawal <- case withdrawal of
                      WithdrawalSelf _ _ _ -> do
                          (_, _, path) <-
                              handler $ W.readRewardAccount @((SharedState n SharedKey)) db
                          pure $ Just path
                      _ ->
                          pure Nothing
  
                  pure $ ApiConstructTransaction
                      { transaction = toApiSerialisedTransaction
                          (body ^. #encoding)
                          balancedTx
                      , coinSelection =
                          mkApiCoinSelection deposits refunds
                          delCertsWithPath Nothing md
                          (unsignedTx outs apiDecoded pathForWithdrawal)
                      , fee = apiDecoded ^. #fee
                      }
    where
      nl = api ^. networkLayer @IO
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter nl
  
      unsignedTx initialOuts decodedTx pathM = UnsignedTx
          { unsignedCollateral =
              mapMaybe toUnsignedTxInp (decodedTx ^. #collateral)
          , unsignedInputs =
              mapMaybe toUnsignedTxInp (decodedTx ^. #inputs)
          , unsignedOutputs =
              take (length initialOuts)
                  $ map toUnsignedTxOut (decodedTx ^. #outputs)
          , unsignedChange =
              drop (length initialOuts)
                  $ map toUnsignedTxChange (decodedTx ^. #outputs)
          , unsignedWithdrawals = case pathM of
                  Nothing -> []
                  Just path ->
                      mapMaybe (toUsignedTxWdrl path) (decodedTx ^. #withdrawals)
          }
  
  decodeSharedTransaction
      :: forall n . HasSNetworkId n
      => ApiLayer (SharedState n SharedKey)
      -> ApiT WalletId
      -> ApiDecodeTransactionPostData
      -> Handler (ApiDecodedTransaction n)
  decodeSharedTransaction ctx (ApiT wid) postData = do
      let ApiDecodeTransactionPostData (ApiT sealed) decryptMetadata = postData
      when (isJust decryptMetadata) $ error "not implemented"
      era <- liftIO $ NW.currentNodeEra nl
      (txinsOutsPaths, collateralInsOutsPaths, outsPath, pp, certs, txId, fee
          , metadata, scriptValidity, interval, witsCount, withdrawals, rewardAcctM)
          <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          (cp, _, _) <- handler $ W.readWallet wrk
          let witCountCtx = toWitnessCountCtx SharedWallet (getState cp)
          let TxExtended{..} = decodeTx tl era sealed
          let (Tx { txId
                  , fee
                  , resolvedInputs
                  , resolvedCollateralInputs
                  , outputs
                  , withdrawals
                  , metadata
                  , scriptValidity
                  }) = walletTx
          inputPaths <-
              handler $ W.lookupTxIns @_ wrk $ fst <$> resolvedInputs
          collateralInputPaths <-
              handler $ W.lookupTxIns @_ wrk $ fst <$> resolvedCollateralInputs
          outputPaths <-
              handler $ W.lookupTxOuts @_ wrk outputs
          pp <- liftIO $ NW.currentProtocolParameters (wrk ^. networkLayer)
          let delegationTemplateM = (getState cp) ^. #delegationTemplate
          let scriptM =
                  flip (replaceCosignersWithVerKeys CA.Stake) minBound <$>
                  delegationTemplateM
          let rewardAcctPath =
                  stakeDerivationPath $ Shared.derivationPrefix $ getState cp
          let rewardAcctM = case scriptM of
                  Just script ->
                      let scriptHash =
                              CA.unScriptHash $
                              CA.toScriptHash script
                      in Just $ FromScriptHash scriptHash
                  Nothing -> Nothing
          let certs = mkApiAnyCertificate rewardAcctM rewardAcctPath
                  <$> certificates
          pure
              ( inputPaths
              , collateralInputPaths
              , outputPaths
              , pp
              , certs
              , txId
              , fee
              , metadata
              , scriptValidity
              , validity
              , witnessCount witCountCtx
              , withdrawals
              , rewardAcctM
              )
      pure $ ApiDecodedTransaction
          { id = ApiT txId
          , fee = maybe mempty ApiAmount.fromCoin fee
          , inputs = map toInp txinsOutsPaths
          , outputs = map toOut outsPath
          , collateral = map toInp collateralInsOutsPaths
          -- TODO: [ADP-1670]
          , collateralOutputs = ApiAsArray Nothing
          , withdrawals = case rewardAcctM of
                  Nothing -> []
                  Just acct -> map (toWrdl acct) $ Map.assocs withdrawals
          -- TODO minting/burning multisig
          , mint = emptyApiAssetMntBurn
          , burn = emptyApiAssetMntBurn
          , certificates = certs
          , depositsTaken =
              (ApiAmount.fromCoin . W.stakeKeyDeposit $ pp)
                  <$ filter ourRewardAccountRegistration certs
          , depositsReturned =
              (ApiAmount.fromCoin . W.stakeKeyDeposit $ pp)
                  <$ filter ourRewardAccountDeregistration certs
          , metadata = ApiTxMetadata $ ApiT <$> metadata
          , scriptValidity = ApiT <$> scriptValidity
          , validityInterval = ApiValidityIntervalExplicit <$> interval
          , witnessCount = mkApiWitnessCount witsCount
          }
    where
      tl = ctx ^. W.transactionLayer @SharedKey @'CredFromScriptK
      nl = ctx ^. W.networkLayer @IO
  
      emptyApiAssetMntBurn = ApiAssetMintBurn
          { tokens = []
          , walletPolicyKeyHash = Nothing
          , walletPolicyKeyIndex = Nothing
          }
  
  balanceTransaction
      :: forall s.
          ( GenChange s
          , WalletFlavor s
          , Including AllFlavors '[ 'ShelleyF, 'SharedF] (FlavorOf s)
          , HasSNetworkId (NetworkOf s)
          )
      => ApiLayer s
      -> ApiT WalletId
      -> ApiBalanceTransactionPostData (NetworkOf s)
      -> Handler ApiSerialisedTransaction
  balanceTransaction ctx (ApiT wid) body = do
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          (Write.PParamsInAnyRecentEra era pp, timeTranslation)
              <- liftIO $ W.readNodeTipStateForTxWrite (wrk ^. networkLayer)
          partialTx <- parsePartialTx era
          balancedTx <- liftIO $ W.balanceTx
                  wrk
                  pp
                  timeTranslation
                  partialTx
          return $ toApiSerialisedTransaction (body ^. #encoding) balancedTx
    where
      parsePartialTx
          :: Write.IsRecentEra era
          => Write.RecentEra era
          -> Handler (Write.PartialTx era)
      parsePartialTx era = do
          let mExternalUTxO
                  = Write.utxoFromTxOutsInRecentEra
                  $ map fromExternalInput
                  $ body ^. #inputs
  
          tx <- maybe
                  (liftHandler
                      . throwE
                      . W.ErrPartialTxNotInNodeEra
                      $ AnyRecentEra era)
                  pure
              . cardanoTxInExactEra (Write.cardanoEraFromRecentEra era)
              . getApiT
              $ body ^. #transaction
  
          case mExternalUTxO of
              Right externalUTxO -> pure $ Write.PartialTx
                  (Write.fromCardanoApiTx tx)
                  externalUTxO
                  (fromApiRedeemer <$> body ^. #redeemers)
                  (Write.StakeKeyDepositMap mempty)
                  -- Stake key deposits will be queried by W.balanceTx
                  (mempty :: Write.TimelockKeyWitnessCounts)
              Left e -> liftHandler $ throwE e
  
  decodeTransaction
      :: forall s n
       . ( IsOurs s Address
         , WalletFlavor s
         , CredFromOf s ~ 'CredFromKeyK
         )
      => ApiLayer s
      -> ApiT WalletId
      -> ApiDecodeTransactionPostData
      -> Handler (ApiDecodedTransaction n)
  decodeTransaction
      ctx@ApiLayer{..} (ApiT wid) postData = do
      let ApiDecodeTransactionPostData (ApiT sealed) decryptMetadata = postData
      era <- liftIO $ NW.currentNodeEra netLayer
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          policyKeyM <-
                  fmap fst . eitherToMaybe <$> liftIO (W.readPolicyPublicKey wrk)
          let txWitnessCount =
                      mkApiWitnessCount
                          . witnessCount
                          $ maybe
                              AnyWitnessCountCtx
                              ( ShelleyWalletCtx
                                  . KeyHash Policy
                                  . xpubToBytes
                              )
                              policyKeyM
              TxExtended{..} = decodeTx tl era sealed
              Tx { txId
                 , fee
                 , resolvedInputs
                 , resolvedCollateralInputs
                 , outputs
                 , withdrawals
                 , metadata
                 , scriptValidity
                 } = walletTx
              db = wrk ^. dbLayer
          metadata' <- case (decryptMetadata, metadata) of
              (Just apiDecrypt, Just meta) -> do
                  let pwd = BA.convert $ unPassphrase $
                            getApiT $ apiDecrypt ^. #passphrase
                  case fromMetadataEncrypted pwd meta of
                      Left err ->
                          liftHandler $ throwE $ ErrDecodeTxFromMetadataDecryption err
                      Right txmetadata ->
                          pure . Just . ApiT $ txmetadata
              _ -> pure $ ApiT <$> metadata
          (acct, _, acctPath) <-
              liftHandler $ W.shelleyOnlyReadRewardAccount @s db
          inputPaths <-
              handler $ W.lookupTxIns wrk $
              fst <$> resolvedInputs
          collateralInputPaths <-
              handler $ W.lookupTxIns wrk $
              fst <$> resolvedCollateralInputs
          outputPaths <-
              handler $ W.lookupTxOuts wrk outputs
          pp <- liftIO $ NW.currentProtocolParameters (wrk ^. networkLayer)
          (minted, burned) <-
              convertApiAssetMintBurn wrk (toMint, toBurn)
          let certs = mkApiAnyCertificate (Just acct) acctPath <$> certificates
          pure $ ApiDecodedTransaction
              { id = ApiT txId
              , fee = maybe mempty ApiAmount.fromCoin fee
              , inputs = map toInp inputPaths
              , outputs = map toOut outputPaths
              , collateral = map toInp collateralInputPaths
              -- TODO: [ADP-1670]
              , collateralOutputs = ApiAsArray Nothing
              , withdrawals = map (toWrdl acct) $ Map.assocs withdrawals
              , mint = minted
              , burn = burned
              , certificates = certs
              , depositsTaken =
                  (ApiAmount.fromCoin . W.stakeKeyDeposit $ pp)
                      <$ filter ourRewardAccountRegistration certs
              , depositsReturned =
                  (ApiAmount.fromCoin . W.stakeKeyDeposit $ pp)
                      <$ filter ourRewardAccountDeregistration certs
              , metadata = ApiTxMetadata metadata'
              , scriptValidity = ApiT <$> scriptValidity
              , validityInterval = ApiValidityIntervalExplicit <$> validity
              , witnessCount = txWitnessCount
              }
    where
      tl = ctx ^. W.transactionLayer @(KeyOf s) @'CredFromKeyK
  
  toWrdl
      :: RewardAccount
      -> (RewardAccount, Coin)
      -> ApiWithdrawalGeneral n
  toWrdl acct (rewardKey, c) =
      if rewardKey == acct then
          ApiWithdrawalGeneral (ApiRewardAccount rewardKey)
              (ApiAmount.fromCoin c) Our
      else
          ApiWithdrawalGeneral (ApiRewardAccount rewardKey)
              (ApiAmount.fromCoin c) External
  
  ourRewardAccountRegistration :: ApiAnyCertificate n -> Bool
  ourRewardAccountRegistration = \case
      WalletDelegationCertificate (RegisterRewardAccount _) -> True
      _ -> False
  
  ourRewardAccountDeregistration :: ApiAnyCertificate n -> Bool
  ourRewardAccountDeregistration = \case
      WalletDelegationCertificate (QuitPool _) -> True
      _ -> False
  
  toInp
      :: forall n. (TxIn, Maybe (TxOut, NonEmpty DerivationIndex))
      -> ApiTxInputGeneral n
  toInp (txin@(TxIn txid ix), txoutPathM) =
      case txoutPathM of
          Nothing ->
              ExternalInput (ApiT txin)
          Just (TxOut addr (TokenBundle c tmap), path) ->
              WalletInput $ ApiWalletInput
                  { id = ApiT txid
                  , index = ix
                  , address = ApiAddress addr
                  , derivationPath = NE.map ApiT path
                  , amount = ApiAmount.fromCoin c
                  , assets = ApiWalletAssets.fromTokenMap tmap
                  }
  
  toOut
      :: forall n. (TxOut, Maybe (NonEmpty DerivationIndex))
      -> ApiTxOutputGeneral n
  toOut (txoutIncoming, Nothing) =
      ExternalOutput $ toAddressAmount @n txoutIncoming
  toOut ((TxOut addr (TokenBundle c tmap)), (Just path)) =
          WalletOutput $ ApiWalletOutput
              { address = ApiAddress addr
              , amount = ApiAmount.fromCoin c
              , assets = ApiWalletAssets.fromTokenMap tmap
              , derivationPath = NE.map ApiT path
              }
  
  validateWitnessCounts
      :: Monad m
      => Int
      -- ^ expected number of key witnesses
      -> Int
      -- ^ detected number of key witnesses
      -> ExceptT ErrSubmitTransaction m ()
  validateWitnessCounts expected detected =
      when (expected > detected) $ throwE $
          ErrSubmitTransactionMissingWitnesses $
          ErrSubmitTransactionMissingWitnessCounts
              { expectedNumberOfKeyWits = toNatural expected
              , detectedNumberOfKeyWits = toNatural detected
              }
    where
      toNatural :: Int -> Natural
      toNatural = fromJustNote "validateWitnessCounts.toNatural" . intCastMaybe
  
  submitTransaction
      :: forall ctx s k n
       . ( ctx ~ ApiLayer s
         , s ~ SeqState n k
         , WalletFlavor s
         , HasNetworkLayer IO ctx
         , MkKeyFingerprint k (Proxy n, k 'CredFromKeyK XPub)
         , MkKeyFingerprint k Address
         , SoftDerivation k
         , HasSNetworkId (NetworkOf s)
         , NetworkDiscriminantCheck k
         , AddressCredential k ~ 'CredFromKeyK
         )
      => ctx
      -> ApiT WalletId
      -> ApiSerialisedTransaction
      -> Handler ApiTxId
  submitTransaction ctx apiw@(ApiT wid) apitx = do
      --TODO: revisit/possibly set proper ttls in ADP-1193
      ttl <- liftIO $ W.transactionExpirySlot ti Nothing
      era <- liftIO $ NW.currentNodeEra nl
  
      let sealedTx = getApiT . (view #serialisedTxSealed) $ apitx
  
      apiDecoded <- decodeTransaction @s @n ctx apiw
                    (toApiDecodeTransactionPostData apitx)
      when (isForeign apiDecoded) $
          liftHandler $ throwE ErrSubmitTransactionForeignWallet
      let ourOuts = getOurOuts apiDecoded
      let ourInps = getOurInps 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 = length $ L.nubBy samePaymentKey $
              filter isInpOurs $
              (apiDecoded ^. #inputs) ++ (apiDecoded ^. #collateral)
      let totalNumberOfWits = length $ getSealedTxWitnesses sealedTx
  
      when (countJoinsQuits (apiDecoded ^. #certificates) > 1) $
          liftHandler $ throwE ErrSubmitTransactionMultidelegationNotSupported
  
      liftHandler $ validateWitnessCounts witsRequiredForInputs totalNumberOfWits
  
      void $ withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          let tx = walletTx $ decodeTx tl era sealedTx
          let db = wrk ^. dbLayer
          (acct, _, path) <- liftHandler
              $ W.shelleyOnlyReadRewardAccount @s db
          let wdrl = getOurWdrl acct path apiDecoded
          let txCtx = defaultTransactionCtx
                  { -- TODO: [ADP-1193]
                    -- Get this from decodeTx:
                    txValidityInterval = (Nothing, ttl)
                  , txWithdrawal = wdrl
                  }
          txMeta <- handler $ W.constructTxMeta db txCtx ourInps ourOuts
          liftHandler $ W.submitTx (wrk ^. logger) db nl
              BuiltTx
                  { builtTx = tx
                  , builtTxMeta = txMeta
                  , builtSealedTx = sealedTx
                  }
      pure $ ApiTxId (apiDecoded ^. #id)
    where
      tl = ctx ^. W.transactionLayer @k @'CredFromKeyK
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      nl = ctx ^. networkLayer
      ti = timeInterpreter nl
  
      getOurWdrl rewardAcct path apiDecodedTx =
          let generalWdrls = apiDecodedTx ^. #withdrawals
              isWdrlOurs (ApiWithdrawalGeneral _ _ context) = context == Our
          in case filter isWdrlOurs generalWdrls of
              [ApiWithdrawalGeneral (ApiRewardAccount acct) amt _] ->
                  WithdrawalSelf
                      ( if rewardAcct == acct
                          then acct
                          else error "reward account should be the same"
                      )
                      path
                      (ApiAmount.toCoin amt)
              _ -> NoWithdrawal
  
      countJoinsQuits :: [ApiAnyCertificate n] -> Int
      countJoinsQuits = sum . fmap ( \case
              WalletDelegationCertificate (JoinPool _ _) -> 1
              WalletDelegationCertificate (QuitPool _) -> 1
              _ -> 0
          )
  
  samePaymentKey :: ApiTxInputGeneral n -> ApiTxInputGeneral n -> Bool
  samePaymentKey inp1 inp2 =
      case (inp1, inp2) of
          ( WalletInput (ApiWalletInput _ _ _ derPath1 _ _)
              , WalletInput (ApiWalletInput _ _ _ derPath2 _ _)
              ) -> derPath1 == derPath2
          _ -> False
  
  getOurOuts :: ApiDecodedTransaction n -> [TxOut]
  getOurOuts apiDecodedTx =
      map toTxOut $ filter isOutOurs generalOuts
    where
      generalOuts = apiDecodedTx ^. #outputs
      isOutOurs (WalletOutput _) = True
      isOutOurs _ = False
      toTxOut
          (WalletOutput
              (ApiWalletOutput (ApiAddress addr) amt assets _)
          ) =
          TxOut addr $ TokenBundle
              (ApiAmount.toCoin amt)
              (ApiWalletAssets.toTokenMap assets)
      toTxOut _ = error "we should have only our outputs at this point"
  
  isInpOurs :: ApiTxInputGeneral n -> Bool
  isInpOurs (WalletInput _) = True
  isInpOurs _ = False
  
  getOurInps :: ApiDecodedTransaction n -> [(TxIn,Coin)]
  getOurInps apiDecodedTx =
      map toTxInp $ filter isInpOurs generalInps
    where
      generalInps = apiDecodedTx ^. #inputs
      toTxInp (WalletInput (ApiWalletInput (ApiT txid) ix _ _ amt _)) =
          (TxIn txid ix, ApiAmount.toCoin amt)
      toTxInp _ = error "we should have only our inputs at this point"
  
  isForeign :: ApiDecodedTransaction n -> Bool
  isForeign apiDecodedTx =
      let generalInps = apiDecodedTx ^. #inputs
          generalWdrls = apiDecodedTx ^. #withdrawals
          isInpForeign (WalletInput _) = False
          isInpForeign _ = True
          isWdrlForeign (ApiWithdrawalGeneral _ _ context) = context == External
      in
          all isInpForeign generalInps &&
          all isWdrlForeign generalWdrls
  
  submitSharedTransaction
      :: forall n . HasSNetworkId n
      => ApiLayer (SharedState n SharedKey)
      -> ApiT WalletId
      -> ApiSerialisedTransaction
      -> Handler ApiTxId
  submitSharedTransaction ctx apiw@(ApiT wid) apitx = do
      ttl <- liftIO $ W.transactionExpirySlot ti Nothing
      era <- liftIO $ NW.currentNodeEra nl
  
      let sealedTx = getApiT . (view #serialisedTxSealed) $ apitx
  
      apiDecoded <- decodeSharedTransaction @n ctx apiw
                    (toApiDecodeTransactionPostData apitx)
      when (isForeign apiDecoded) $
          liftHandler $ throwE ErrSubmitTransactionForeignWallet
      let ourOuts = getOurOuts apiDecoded
      let ourInps = getOurInps apiDecoded
  
      void $ withWorkerCtx ctx wid liftE liftE $ \wrk -> do
  
          (cp, _, _) <- handler $ W.readWallet @_ wrk
          let witCountCtx = toWitnessCountCtx SharedWallet (getState cp)
          let TxExtended{..} = decodeTx tl era sealedTx
              WitnessCount _ nativeScripts _ = witnessCount witCountCtx
  
          let numberStakingNativeScripts =
                  length $ filter hasDelegationKeyHash nativeScripts
          let delegationScriptTemplateM = Shared.delegationTemplate $ getState cp
          let delegationWitsRequired = case delegationScriptTemplateM of
                  Nothing -> 0
                  Just (ScriptTemplate _ scriptD) ->
                      if numberStakingNativeScripts == 0 then
                          0
                      else if numberStakingNativeScripts == 1 then
                          Write.estimateMinWitnessRequiredPerInput scriptD
                      else
                          error "wallet supports transactions with 0 or 1 staking script"
  
          let (ScriptTemplate _ scriptP) = Shared.paymentTemplate $ getState cp
          let pWitsPerInput = Write.estimateMinWitnessRequiredPerInput scriptP
          let witsRequiredForInputs =
                  length $ L.nubBy samePaymentKey $
                  filter isInpOurs $
                  (apiDecoded ^. #inputs) ++ (apiDecoded ^. #collateral)
          let totalNumberOfWits = length $ getSealedTxWitnesses sealedTx
          let paymentWitsRequired =
                  fromIntegral pWitsPerInput * witsRequiredForInputs
          let allWitsRequired =
                  paymentWitsRequired + fromIntegral delegationWitsRequired
          liftHandler $ validateWitnessCounts allWitsRequired totalNumberOfWits
  
          let txCtx = defaultTransactionCtx
                  { txValidityInterval = (Nothing, ttl)
                  }
          let db = wrk ^. dbLayer
          txMeta <- handler $ W.constructTxMeta db txCtx ourInps ourOuts
          liftHandler $ W.submitTx (wrk ^. logger) db nl
              BuiltTx
                  { builtTx = walletTx
                  , builtTxMeta = txMeta
                  , builtSealedTx = sealedTx
                  }
      pure $ ApiTxId (apiDecoded ^. #id)
    where
      nl = ctx ^. networkLayer
      tl = ctx ^. W.transactionLayer @SharedKey @'CredFromScriptK
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter nl
  
      retrieveAllKeyHashes (NativeExplicitScript s _) = foldScript (:) [] s
      retrieveAllKeyHashes _ = []
  
      isTimelock (NativeExplicitScript _ _) = True
      isTimelock _ = False
  
      isDelegationKeyHash (KeyHash CA.Delegation _) = True
      isDelegationKeyHash (KeyHash _ _) = False
  
      hasDelegationKeyHash s =
          isTimelock s && all isDelegationKeyHash (retrieveAllKeyHashes s)
  
  {-------------------------------------------------------------------------------
      Delegation
  -------------------------------------------------------------------------------}
  
  joinStakePool
      :: forall s n k.
          ( s ~ SeqState n k
          , WalletFlavor s
          , Excluding '[SharedKey] k
          , AddressIndexDerivationType k ~ 'Soft
          , GenChange s
          , IsOurs (SeqState n k) RewardAccount
          , SoftDerivation k
          , AddressBookIso s
          , MkKeyFingerprint k (Proxy n, k 'CredFromKeyK XPub)
          , HasDelegation s
          , NetworkDiscriminantCheck k
          , AddressCredential k ~ 'CredFromKeyK
          , HasSNetworkId n
          , DelegationAddress k 'CredFromKeyK
          )
      => ApiLayer s
      -> IO (Set PoolId)
         -- ^ Known pools
         -- We could maybe replace this with a @IO (PoolId -> Bool)@
      -> (PoolId -> IO PoolLifeCycleStatus)
      -> ApiPoolSpecifier
      -> ApiT WalletId
      -> ApiWalletPassphrase
      -> Handler (ApiTransaction n)
  joinStakePool
      ctx@ApiLayer{..} knownPools
      getPoolStatus apiPool (ApiT walletId) body = do
      poolId <- case apiPool of
          AllPools -> liftE ErrUnexpectedPoolIdPlaceholder
          SpecificPool pool -> pure pool
      poolStatus <- liftIO (getPoolStatus poolId)
      pools <- liftIO knownPools
      pp <- liftIO $ NW.currentProtocolParameters netLayer
      let ti = timeInterpreter netLayer
  
      withWorkerCtx ctx walletId liftE liftE $ \wrk -> do
          (BuiltTx{..}, txTime) <- liftIO
              $ IODeleg.joinStakePool
                  wrk
                  walletId
                  pools
                  poolId
                  poolStatus
                  (coerce $ getApiT $ body ^. #passphrase)
          mkApiTransaction ti wrk #pendingSince
              MkApiTransactionParams
                  { txId = builtTx ^. #txId
                  , txFee = builtTx ^. #fee
                  , txInputs = builtTx ^. #resolvedInputs
                  -- Joining a stake pool does not require collateral:
                  , txCollateralInputs = []
                  , txOutputs = builtTx ^. #outputs
                  , txCollateralOutput = builtTx ^. #collateralOutput
                  , txWithdrawals = builtTx ^. #withdrawals
                  , txMeta = builtTxMeta
                  , txMetadata = Nothing
                  , txTime
                  , txScriptValidity = builtTx ^. #scriptValidity
                  , txDeposit = W.stakeKeyDeposit pp
                  , txMetadataSchema = TxMetadataDetailedSchema
                  , txCBOR = builtTx ^. #txCBOR
                  }
  
  joinDRep
      :: forall s n k.
          ( s ~ SeqState n k
          , WalletFlavor s
          , Excluding '[SharedKey] k
          , AddressIndexDerivationType k ~ 'Soft
          , GenChange s
          , IsOurs (SeqState n k) RewardAccount
          , SoftDerivation k
          , AddressBookIso s
          , MkKeyFingerprint k (Proxy n, k 'CredFromKeyK XPub)
          , HasDelegation s
          , NetworkDiscriminantCheck k
          , AddressCredential k ~ 'CredFromKeyK
          , HasSNetworkId n
          , DelegationAddress k 'CredFromKeyK
          )
      => ApiLayer s
      -> ApiDRepSpecifier
      -> ApiT WalletId
      -> ApiWalletPassphrase
      -> Handler (ApiTransaction n)
  joinDRep
      ctx@ApiLayer{..} apiDRep (ApiT walletId) body = do
      pp <- liftIO $ NW.currentProtocolParameters netLayer
      let ti = timeInterpreter netLayer
      drep <- case apiDRep of
          AllDReps -> liftE ErrUnexpectedPoolIdPlaceholder
          SpecificDRep drep -> pure drep
  
      withWorkerCtx ctx walletId liftE liftE $ \wrk -> do
          (BuiltTx{..}, txTime) <- liftIO
              $ IODeleg.joinDRep
                  wrk
                  walletId
                  drep
                  (coerce $ getApiT $ body ^. #passphrase)
          mkApiTransaction ti wrk #pendingSince
              MkApiTransactionParams
                  { txId = builtTx ^. #txId
                  , txFee = builtTx ^. #fee
                  , txInputs = builtTx ^. #resolvedInputs
                  , txCollateralInputs = []
                  , txOutputs = builtTx ^. #outputs
                  , txCollateralOutput = builtTx ^. #collateralOutput
                  , txWithdrawals = builtTx ^. #withdrawals
                  , txMeta = builtTxMeta
                  , txMetadata = Nothing
                  , txTime
                  , txScriptValidity = builtTx ^. #scriptValidity
                  , txDeposit = W.stakeKeyDeposit pp
                  , txMetadataSchema = TxMetadataDetailedSchema
                  , txCBOR = builtTx ^. #txCBOR
                  }
  
  delegationFee
      :: forall s n k
       . ( GenChange s
         , k ~ ShelleyKey
         , AddressBookIso s
         , s ~ SeqState n k
         , HasSNetworkId n
         )
      => ApiLayer s
      -> ApiT WalletId
      -> Handler ApiFee
  delegationFee ctx@ApiLayer{..} (ApiT walletId) = do
      withWorkerCtx ctx walletId liftE liftE $ \workerCtx -> liftIO $ do
          W.DelegationFee {feePercentiles, deposit} <-
              W.delegationFee @s
                  (workerCtx ^. dbLayer)
                  netLayer
                  (W.defaultChangeAddressGen (delegationAddressS @n))
          pure $ mkApiFee (Just deposit) [] feePercentiles
  
  quitStakePool
      :: forall s n k.
          ( s ~ SeqState n k
          , k ~ ShelleyKey
          , GenChange s
          , AddressBookIso s
          , HasSNetworkId n
          )
      => ApiLayer s
      -> ApiT WalletId
      -> ApiWalletPassphrase
      -> Handler (ApiTransaction n)
  quitStakePool ctx@ApiLayer{..} (ApiT walletId) body = do
      pp <- liftIO $ NW.currentProtocolParameters netLayer
      let ti = timeInterpreter netLayer
  
      withWorkerCtx ctx walletId liftE liftE $ \wrk -> do
          (BuiltTx{..}, txTime) <- liftIO
              $ IODeleg.quitStakePool
                  wrk
                  walletId
                  (coerce $ getApiT $ body ^. #passphrase)
  
          mkApiTransaction ti wrk #pendingSince
              MkApiTransactionParams
                  { txId = builtTx ^. #txId
                  , txFee = builtTx ^. #fee
                  , txInputs = builtTx ^. #resolvedInputs
                  -- Quitting a stake pool does not require collateral:
                  , txCollateralInputs = []
                  , txOutputs = builtTx ^. #outputs
                  , txCollateralOutput = builtTx ^. #collateralOutput
                  , txWithdrawals = builtTx ^. #withdrawals
                  , txMeta = builtTxMeta
                  , txMetadata = Nothing
                  , txTime
                  , txScriptValidity = builtTx ^. #scriptValidity
                  , txDeposit = W.stakeKeyDeposit pp
                  , txMetadataSchema = TxMetadataDetailedSchema
                  , txCBOR = builtTx ^. #txCBOR
                  }
  
  -- 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 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 lookupStakeRef fetchRewards ourKeysWithInfo = do
          let distr = stakeKeyCoinDistr lookupStakeRef utxo
          let stakeKeysInUTxO = catMaybes $ Map.keys distr
          let stake acc = fromMaybe (Coin 0) $ Map.lookup acc distr
  
          let ourKeys = map (\(acc,_,_) -> acc) ourKeysWithInfo
  
          let allKeys = ourKeys <> 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.
          rewardsMap <- fetchRewards $ Set.fromList allKeys
  
          let rewards acc = fromMaybe (Coin 0) $ Map.lookup acc rewardsMap
  
          let mkOurs (acc, ix, deleg) = ApiOurStakeKey
                  { _index = ix
                  , _key = ApiRewardAccount acc
                  , _rewardBalance = ApiAmount.fromCoin $
                      rewards acc
                  , _delegation = deleg
                  , _stake = ApiAmount.fromCoin $
                      stake (Just acc) <> rewards acc
                  }
  
          let mkForeign acc = ApiForeignStakeKey
                  { _key = ApiRewardAccount acc
                  , _rewardBalance = ApiAmount.fromCoin $
                      rewards acc
                  , _stake = ApiAmount.fromCoin $
                      stake (Just acc) <> rewards acc
                  }
  
          let foreignKeys = stakeKeysInUTxO \\ ourKeys
  
          let nullKey = ApiNullStakeKey
                  { _stake = ApiAmount.fromCoin $ stake Nothing
                  }
  
          return $ ApiStakeKeys
              { _ours = map mkOurs ourKeysWithInfo
              , _foreign = map mkForeign foreignKeys
              , _none = nullKey
              }
  
  listStakeKeys
      :: forall s n
       . (s ~ SeqState n ShelleyKey)
      => (Address -> Maybe RewardAccount)
      -> ApiLayer s
      -> ApiT WalletId
      -> Handler (ApiStakeKeys n)
  listStakeKeys lookupStakeRef ctx@ApiLayer{..} (ApiT wid) =
      withWorkerCtx ctx wid liftE liftE $ \wrk -> handler $ do
          let db = wrk ^. typed @(DBLayer IO s)
          (wal, (_, delegation) ,pending) <- W.readWallet wrk
          let utxo = availableUTxO @s pending wal
          let takeFst (a,_,_) = a
          ourAccount <- takeFst <$> liftIO (W.readRewardAccount @s db)
          ourApiDelegation <- liftIO $ toApiWalletDelegation delegation
              (unsafeExtendSafeZone (timeInterpreter $ ctx ^. networkLayer))
          let ourKeys = [(ourAccount, 0, ourApiDelegation)]
          liftIO $ listStakeKeys' @n
              utxo
              lookupStakeRef
              (fetchRewardAccountBalances netLayer)
              ourKeys
  
  {-------------------------------------------------------------------------------
                                  Migrations
  -------------------------------------------------------------------------------}
  
  createMigrationPlan
      :: forall s n k
       . ( WalletFlavor s
         , k ~ KeyOf s
         , CredFromOf s ~ 'CredFromKeyK
         , IsOurs s Address
         )
      => ApiLayer s
      -> Maybe ApiWithdrawalPostData
      -- ^ What type of reward withdrawal to attempt
      -> ApiT WalletId
      -- ^ Source wallet
      -> ApiWalletMigrationPlanPostData n
      -- ^ Target addresses
      -> Handler (ApiWalletMigrationPlan n)
  createMigrationPlan ctx@ApiLayer{..} withdrawalType (ApiT wid) postData =
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          let db = wrk ^. dbLayer
          rewardWithdrawal <- case withdrawalType of
              Nothing -> pure NoWithdrawal
              Just pd ->
                  shelleyOnlyMkWithdrawal
                      netLayer
                      (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
                      db
                      pd
          (wallet, _, _) <- handler $ W.readWallet wrk
          plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal
          liftHandler
              $ failWith ErrCreateMigrationPlanEmpty
              $ mkApiWalletMigrationPlan
                  (getState wallet)
                  (view #addresses postData)
                  rewardWithdrawal
                  plan
  
  mkApiWalletMigrationPlan
      :: forall n s. IsOurs s Address
      => s
      -> NonEmpty (ApiAddress n)
      -> Withdrawal
      -> MigrationPlan
      -> Maybe (ApiWalletMigrationPlan n)
  mkApiWalletMigrationPlan s addresses rewardWithdrawal plan =
      mkApiPlan <$> maybeSelections
    where
      mkApiPlan :: NonEmpty (ApiCoinSelection n) -> ApiWalletMigrationPlan n
      mkApiPlan selections = ApiWalletMigrationPlan
          { selections
          , totalFee
          , balanceLeftover
          , balanceSelected
          }
  
      maybeSelections :: Maybe (NonEmpty (ApiCoinSelection n))
      maybeSelections = fmap mkApiCoinSelectionForMigration <$> maybeUnsignedTxs
  
      maybeSelectionWithdrawals
          :: Maybe (NonEmpty (W.SelectionWithoutChange, Withdrawal))
      maybeSelectionWithdrawals
          = W.migrationPlanToSelectionWithdrawals plan rewardWithdrawal
          $ apiAddress <$> addresses
  
      maybeUnsignedTxs = fmap mkUnsignedTx <$> maybeSelectionWithdrawals
        where
          mkUnsignedTx (selection, withdrawal) = W.selectionToUnsignedTx
              withdrawal (selection {change = []}) s
  
      totalFee :: ApiAmount
      totalFee = ApiAmount.fromCoin $ view #totalFee plan
  
      balanceLeftover :: ApiWalletMigrationBalance
      balanceLeftover = plan
          & view #unselected
          & UTxO.balance
          & mkApiWalletMigrationBalance
  
      balanceSelected :: ApiWalletMigrationBalance
      balanceSelected = mkApiWalletMigrationBalance $
          TokenBundle.fromCoin balanceRewardWithdrawal <> balanceUTxO
        where
          balanceUTxO = plan
              & view #selections
              & F.foldMap (view #inputBalance)
          balanceRewardWithdrawal = plan
              & view #selections
              & F.foldMap (view #rewardWithdrawal)
  
      mkApiCoinSelectionForMigration = mkApiCoinSelection [] [] Nothing Nothing Nothing
  
      mkApiWalletMigrationBalance :: TokenBundle -> ApiWalletMigrationBalance
      mkApiWalletMigrationBalance b = ApiWalletMigrationBalance
          { ada = ApiAmount.fromCoin $ view #coin b
          , assets = ApiWalletAssets.fromTokenMap $ view #tokens b
          }
  
  migrateWallet
      :: forall s p k n.
          ( Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
          , HardDerivation k
          , WalletFlavor s
          , HasDelegation s
          , k ~ KeyOf s
          , CredFromOf s ~ 'CredFromKeyK
          , HasSNetworkId n
          , n ~ NetworkOf s
          , IsOurs s Address
          )
      => ApiLayer s
      -> Maybe ApiWithdrawalPostData
          -- ^ What type of reward withdrawal to attempt
      -> ApiT WalletId
      -> ApiWalletMigrationPostData n p
      -> Handler (NonEmpty (ApiTransaction n))
  migrateWallet ctx@ApiLayer{..} withdrawalType (ApiT wid) postData = do
      mkRewardAccount <-
          case withdrawalType of
              Nothing -> pure $ selfRewardAccountBuilder (keyFlavorFromState @s)
              Just w -> either liftE pure
                  $ shelleyOnlyRewardAccountBuilder (walletFlavor @s) w
      withWorkerCtx ctx wid liftE liftE $ \wrk -> do
          let db = wrk ^. dbLayer
              tr = wrk ^. logger
          rewardWithdrawal <- case withdrawalType of
              Nothing -> pure NoWithdrawal
              Just pd ->
                  shelleyOnlyMkWithdrawal
                      netLayer
                      (txWitnessTagForKey $ keyOfWallet $ walletFlavor @s)
                      db
                      pd
          plan <- handler $ W.createMigrationPlan @_ wrk rewardWithdrawal
          ttl <- liftIO $ W.transactionExpirySlot ti Nothing
          pp <- liftIO $ NW.currentProtocolParameters netLayer
          selectionWithdrawals <- liftHandler
              $ failWith ErrCreateMigrationPlanEmpty
              $ W.migrationPlanToSelectionWithdrawals
                  plan rewardWithdrawal addresses
          forM selectionWithdrawals $ \(selection, txWithdrawal) -> do
              let txContext = defaultTransactionCtx
                      { txWithdrawal
                      , txValidityInterval = (Nothing, ttl)
                      , txDelegationAction = Nothing
                      }
              (tx, txMeta, txTime, sealedTx) <- liftHandler $
                  W.buildAndSignTransaction
                      wrk
                      wid
                      mkRewardAccount
                      pwd
                      txContext
                      (selection {change = []})
  
              liftHandler $ W.submitTx tr db netLayer
                  BuiltTx
                      { builtTx = tx
                      , builtTxMeta = txMeta
                      , builtSealedTx = sealedTx
                      }
              mkApiTransaction ti wrk #pendingSince
                  MkApiTransactionParams
                      { txId = tx ^. #txId
                      , txFee = tx ^. #fee
                      , txInputs =
                          NE.toList $ second Just <$> selection ^. #inputs
                        -- Migrations never require collateral:
                      , txCollateralInputs = []
                      , txOutputs = tx ^. #outputs
                      , txCollateralOutput = tx ^. #collateralOutput
                      , txWithdrawals = tx ^. #withdrawals
                      , txMeta
                      , txMetadata = Nothing
                      , txTime
                      , txScriptValidity = tx ^. #scriptValidity
                      , txDeposit = W.stakeKeyDeposit pp
                      , txMetadataSchema = TxMetadataDetailedSchema
                      , txCBOR = tx ^. #txCBOR
                      }
    where
      addresses = apiAddress <$> view #addresses postData
      pwd = coerce $ getApiT $ postData ^. #passphrase
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter (ctx ^. networkLayer)
  
  {-------------------------------------------------------------------------------
                                      Network
  -------------------------------------------------------------------------------}
  
  data ErrCurrentEpoch
      = ErrUnableToDetermineCurrentEpoch  -- fixme: unused
      | ErrCurrentEpochPastHorizonException PastHorizonException
  
  getCurrentEpoch
      :: forall ctx s . (ctx ~ ApiLayer s)
      => ctx
      -> Handler W.EpochNo
  getCurrentEpoch ctx = liftIO (runExceptT (currentEpoch ti)) >>= \case
      Left e -> liftE $ ErrCurrentEpochPastHorizonException e
      Right x -> pure x
    where
      ti :: TimeInterpreter (ExceptT PastHorizonException IO)
      ti = timeInterpreter (ctx ^. networkLayer)
  
  getNetworkParameters
      :: (Block, NetworkParameters)
      -> NetworkLayer IO block
      -> Handler ApiNetworkParameters
  getNetworkParameters (_block0, genesisNp) nl = do
      pp <- liftIO $ NW.currentProtocolParameters nl
      sp <- liftIO $ NW.currentSlottingParameters nl
      let np = genesisNp { protocolParameters = pp, slottingParameters = sp }
      liftIO $ toApiNetworkParameters np (interpretQuery ti . toEpochInfo)
    where
      ti :: TimeInterpreter IO
      ti = neverFails
          "PastHorizonException should never happen in getNetworkParameters         \because the ledger is being queried for slotting info about its own         \tip."
  
          (timeInterpreter nl)
  
  getNetworkClock :: NtpClient -> Bool -> Handler ApiNetworkClock
  getNetworkClock client force =
      liftIO $ ApiNetworkClock <$> getNtpStatus client forceCheck
    where
      forceCheck =
          if force
              then Ntp.ForceBlockingRequest
              else Ntp.CanUseCachedResults
  
  getBlocksLatestHeader :: NetworkLayer IO block -> Handler ApiBlockHeader
  getBlocksLatestHeader nl = liftIO $ mkApiBlockHeader <$> NW.currentNodeTip nl
  
  {-------------------------------------------------------------------------------
                                 Miscellaneous
  -------------------------------------------------------------------------------}
  
  postExternalTransaction
      :: forall s
       . ApiLayer s
      -> ApiT W.SealedTx
      -> Handler ApiTxId
  postExternalTransaction ctx (ApiT sealed) = do
      txid <- liftHandler $ W.submitExternalTx
              (tracerTxSubmit ctx) (ctx ^. #netLayer) (ctx ^. #txLayer) sealed
      return $ ApiTxId (ApiT txid)
  
  signMetadata
      :: forall ctx s k n.
          ( ctx ~ ApiLayer s
          , s ~ SeqState n k
          , HardDerivation k
          , AddressIndexDerivationType k ~ 'Soft
          , WalletFlavor s
          )
      => ctx
      -> ApiT WalletId
      -> ApiT Role
      -> ApiT DerivationIndex
      -> ApiWalletSignData
      -> Handler ByteString
  signMetadata ctx (ApiT wid) (ApiT role_) (ApiT ix) body = do
      let meta = body ^. #metadata . #getApiT
      let pwd  = body ^. #passphrase . #getApiT
  
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> liftHandler $ do
          getSignature <$> W.signMetadataWith
              wrk wid (coerce pwd) (role_, ix) meta
  
  derivePublicKey
      :: forall s k ver.
          ( SoftDerivation k
          , GetAccount s k
          , k ~ KeyOf s
          , WalletFlavor s
          )
      => ApiLayer s
      -> ((ByteString, Role) -> VerificationKeyHashing -> ver)
      -> ApiT WalletId
      -> ApiT Role
      -> ApiT DerivationIndex
      -> Maybe Bool
      -> Handler ver
  derivePublicKey ctx mkVer (ApiT wid) (ApiT role_) (ApiT ix) hashed = do
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
          k <- liftHandler $ W.derivePublicKey wrk role_ ix
          let (payload, hashing) = computeKeyPayload hashed
                  $ getRawKey (keyFlavorFromState @s) k
          pure $ mkVer (payload, role_) hashing
  
  postAccountPublicKey
      :: forall ctx s k account.
          ( ctx ~ ApiLayer s
          , GetPurpose k
          , k ~ KeyOf s
          , AfterByron k
          , WalletFlavor s
          )
      => ctx
      -> (ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account)
      -> ApiT WalletId
      -> ApiT DerivationIndex
      -> ApiPostAccountKeyDataWithPurpose
      -> Handler account
  postAccountPublicKey ctx mkAccount (ApiT wid) (ApiT ix)
      (ApiPostAccountKeyDataWithPurpose (ApiT pwd) extd purposeM) = do
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
          k <- liftHandler $ W.getAccountPublicKeyAtIndex
              wrk wid pwd ix (getApiT <$> purposeM)
          pure $ mkAccount
              (publicKeyToBytes' extd $ getRawKey (keyFlavorFromState @s) k)
              extd
              ixPurpose'
    where
      ixPurpose' =
          maybe (getPurpose @k) (Index . getDerivationIndex . getApiT) purposeM
  
  publicKeyToBytes' :: KeyFormat -> XPub -> ByteString
  publicKeyToBytes' = \case
      Extended -> xpubToBytes
      NonExtended -> xpubPublicKey
  
  getAccountPublicKey
      :: forall s k account.
          ( GetAccount s k
          , GetPurpose k
          , k ~ KeyOf s
          , WalletFlavor s
          )
      => ApiLayer s
      -> (ByteString -> KeyFormat -> Index 'Hardened 'PurposeK -> account)
      -> ApiT WalletId
      -> Maybe KeyFormat
      -> Handler account
  getAccountPublicKey ctx mkAccount (ApiT wid) extended = do
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
          k <- handler $ W.readAccountPublicKey wrk
          pure $ mkAccount
              (publicKeyToBytes' extd $ getRawKey (keyFlavorFromState @s) k)
              extd
              (getPurpose @k)
    where
        extd = case extended of
            Just Extended -> Extended
            _ -> NonExtended
  
  getPolicyKey
      :: forall ctx s
       . ( ctx ~ ApiLayer s
         , WalletFlavor s
         )
      => ctx
      -> ApiT WalletId
      -> Maybe Bool
      -> Handler ApiPolicyKey
  getPolicyKey ctx (ApiT wid) hashed = do
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
          (k, _) <- liftHandler $ ExceptT $ W.readPolicyPublicKey wrk
          pure $ uncurry ApiPolicyKey (computeKeyPayload hashed k)
  
  postPolicyKey
      :: forall ctx s n
       . ( ctx ~ ApiLayer s
         , s ~ SeqState n ShelleyKey
         )
      => ctx
      -> ApiT WalletId
      -> Maybe Bool
      -> ApiPostPolicyKeyData
      -> Handler ApiPolicyKey
  postPolicyKey ctx (ApiT wid) hashed apiPassphrase =
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
          k <- liftHandler $ W.writePolicyPublicKey wrk wid pwd
          pure
              $ uncurry ApiPolicyKey
              $ computeKeyPayload hashed
              $ getRawKey (keyFlavorFromState @s) k
    where
      pwd = getApiT (apiPassphrase ^. #passphrase)
  
  postPolicyId
      :: forall s k
       . ( WalletFlavor s
         , KeyOf s ~ k
         , AfterByron k
         )
      => ApiLayer s
      -> ApiT WalletId
      -> ApiPostPolicyIdData
      -> Handler ApiPolicyId
  postPolicyId ctx (ApiT wid) payload = do
      let retrieveAllCosigners = foldScript (:) []
      let wrongMintingTemplate templ =
              isLeft (validateScriptOfTemplate RecommendedValidation templ)
              || length (retrieveAllCosigners templ) > 1
              || (L.any (/= Cosigner 0)) (retrieveAllCosigners templ)
      when ( wrongMintingTemplate scriptTempl ) $
          liftHandler $ throwE ErrGetPolicyIdWrongMintingBurningTemplate
  
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> do
          (xpub, _) <- liftHandler $ ExceptT $ W.readPolicyPublicKey wrk
          pure $ ApiPolicyId $ ApiT $
              toTokenPolicyId (keyFlavorFromState @s)
                  scriptTempl (Map.singleton (Cosigner 0) xpub)
    where
      scriptTempl = getApiT (payload ^. #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 n.
          ( ctx ~ ApiLayer s
          , s ~ RndState n
          )
      => ctx
      -> ApiT WalletId
      -> Passphrase "user"
      -> Handler (ArgGenChange s)
  rndStateChange ctx (ApiT wid) pwd =
      withWorkerCtx @_ @s ctx wid liftE liftE $ \wrk -> liftHandler $
          W.withRootKey (wrk ^. dbLayer) wid pwd ErrSignPaymentWithRootKey $
              \xprv scheme -> pure (xprv, preparePassphrase scheme pwd)
  
  type RewardAccountBuilder k
      =  ClearCredentials k
      -> (XPrv, Passphrase "encryption")
  
  mkWithdrawal
      :: forall n block
       . NetworkLayer IO block
      -> TxWitnessTag
      -> DBLayer IO (SeqState n ShelleyKey)
      -> ApiWithdrawalPostData
      -> Handler Withdrawal
  mkWithdrawal netLayer txWitnessTag db = \case
      SelfWithdrawal ->
          liftIO $ W.mkSelfWithdrawal netLayer txWitnessTag db
      ExternalWithdrawal (ApiMnemonicT mnemonic) ->
          liftHandler . ExceptT
              $ W.mkExternalWithdrawal netLayer txWitnessTag mnemonic
  
  -- | Unsafe version of `mkWithdrawal` that throws runtime error
  -- when applied to a non-shelley or non-sequential wallet state.
  shelleyOnlyMkWithdrawal
      :: forall s block
       . WalletFlavor s
      => NetworkLayer IO block
      -> TxWitnessTag
      -> DBLayer IO s
      -> ApiWithdrawalPostData
      -> Handler Withdrawal
  shelleyOnlyMkWithdrawal netLayer txWitnessTag db postData =
      case walletFlavor @s of
          ShelleyWallet ->
              mkWithdrawal netLayer txWitnessTag db postData
          _ -> notShelleyWallet
    where
      notShelleyWallet =
          liftHandler $ throwE ErrReadRewardAccountNotAShelleyWallet
  
  shelleyOnlyRewardAccountBuilder
      :: forall s k
       . ( Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
         , k ~ KeyOf s
         )
      => WalletFlavorS s
      -> ApiWithdrawalPostData
      -> Either ErrReadRewardAccount (RewardAccountBuilder k)
  shelleyOnlyRewardAccountBuilder wF w =
      case wF of
          ShelleyWallet -> case w of
              SelfWithdrawal -> pure
                  $ selfRewardAccountBuilder ShelleyKeyS
              ExternalWithdrawal (ApiMnemonicT m) -> do
                  let (xprv, _acct, _path) = W.someRewardAccount @ShelleyKey m
                  pure (const (xprv, mempty))
          _ -> throwError ErrReadRewardAccountNotAShelleyWallet
  
  selfRewardAccountBuilder
      :: forall k
       . ( HardDerivation k
         , Bounded (Index (AddressIndexDerivationType k) (AddressCredential k))
         )
      => KeyFlavorS k
      -> RewardAccountBuilder k
  selfRewardAccountBuilder keyF (RootCredentials rootK pwdP) =
      (getRawKey keyF (deriveRewardAccount pwdP rootK minBound), pwdP)
  
  -- | 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 (VotingAction, NonEmpty DerivationIndex)
      -> Maybe W.TxMetadata
      -> UnsignedTx input output change withdrawal
      -> ApiCoinSelection n
  mkApiCoinSelection deps refunds mDelCerts mVotingCerts metadata unsignedTx =
      ApiCoinSelection
          { inputs = mkApiCoinSelectionInput
              <$> unsignedTx ^. #unsignedInputs
          , outputs = mkApiCoinSelectionOutput
              <$> unsignedTx ^. #unsignedOutputs
          , change = mkApiCoinSelectionChange
              <$> unsignedTx ^. #unsignedChange
          , collateral = mkApiCoinSelectionCollateral
              <$> unsignedTx ^. #unsignedCollateral
          , withdrawals = mkApiCoinSelectionWithdrawal
              <$> unsignedTx ^. #unsignedWithdrawals
          , certificates =
              mergeCerts delCertsM votingCertsM
          , depositsTaken = ApiAmount.fromCoin
              <$> deps
          , depositsReturned = ApiAmount.fromCoin
              <$> refunds
          , metadata = ApiBytesT. serialiseToCBOR
              <$> metadata
          }
    where
      delCertsM = uncurry mkApiCoinSelectionDelCerts <$> mDelCerts
      votingCertsM = uncurry mkApiCoinSelectionVotingCerts <$> mVotingCerts
      mergeCerts del vote = case (del, vote) of
          ((Just dels), (Just votes)) -> Just $ NE.nub $ dels <> votes
          (delM@(Just _), Nothing) -> delM
          (Nothing, voteM@(Just _)) -> voteM
          (Nothing, Nothing) -> Nothing
  
  mkApiCoinSelectionDelCerts
      :: DelegationAction
      -> NonEmpty DerivationIndex
      -> NonEmpty Api.ApiCertificate
  mkApiCoinSelectionDelCerts action ixs =
      case action of
          Join pid -> pure $ Api.JoinPool apiStakePath (ApiT pid)
          Quit -> pure $ Api.QuitPool apiStakePath
          JoinRegisteringKey pid -> NE.fromList
              [ Api.RegisterRewardAccount apiStakePath
              , Api.JoinPool apiStakePath (ApiT pid)
              ]
    where
      apiStakePath = ApiT <$> ixs
  
  mkApiCoinSelectionVotingCerts
      :: VotingAction
      -> NonEmpty DerivationIndex
      -> NonEmpty Api.ApiCertificate
  mkApiCoinSelectionVotingCerts action ixs =
      case action of
          Vote drep -> pure $ Api.CastVote apiStakePath (ApiT drep)
          VoteRegisteringKey drep -> NE.fromList
              [ Api.RegisterRewardAccount apiStakePath
              , Api.CastVote apiStakePath (ApiT drep)
              ]
    where
      apiStakePath = ApiT <$> ixs
  
  mkApiCoinSelectionInput
      :: forall n
       . (TxIn, TxOut, NonEmpty DerivationIndex)
       -> ApiWalletInput n
  mkApiCoinSelectionInput
      (TxIn txid index, TxOut addr (TokenBundle amount assets), path) =
      ApiWalletInput
          { id = ApiT txid
          , index = index
          , address = ApiAddress addr
          , amount = ApiAmount.fromCoin amount
          , assets = ApiWalletAssets.fromTokenMap assets
          , derivationPath = ApiT <$> path
          }
  
  mkApiCoinSelectionOutput :: forall n. TxOut -> ApiCoinSelectionOutput n
  mkApiCoinSelectionOutput (TxOut addr (TokenBundle amount assets)) =
      ApiCoinSelectionOutput (ApiAddress addr)
      (ApiAmount.fromCoin amount)
      (ApiWalletAssets.fromTokenMap assets)
  
  mkApiCoinSelectionChange
      :: forall n
       . TxChange (NonEmpty DerivationIndex)
      -> ApiCoinSelectionChange n
  mkApiCoinSelectionChange txChange =
      ApiCoinSelectionChange
          { address = (ApiAddress $ view #address txChange)
          , amount = ApiAmount.fromCoin $ view #amount txChange
          , assets = ApiWalletAssets.fromTokenMap $ view #assets txChange
          , derivationPath = ApiT <$> view #derivationPath txChange
          }
  
  mkApiCoinSelectionCollateral
      :: forall n
       . (TxIn, TxOut, NonEmpty DerivationIndex)
      -> ApiCoinSelectionCollateral n
  mkApiCoinSelectionCollateral
      (TxIn txid index, TxOut addr (TokenBundle amount _), path) =
      ApiCoinSelectionCollateral
          { id = ApiT txid
          , index = index
          , address = ApiAddress addr
          , amount = ApiAmount.fromCoin amount
          , derivationPath = ApiT <$> path
          }
  
  mkApiCoinSelectionWithdrawal
      :: forall n
       . (RewardAccount, Coin, NonEmpty DerivationIndex)
      -> ApiCoinSelectionWithdrawal n
  mkApiCoinSelectionWithdrawal (rewardAcct, wdrl, path) =
      ApiCoinSelectionWithdrawal
          { stakeAddress = ApiRewardAccount rewardAcct
          , amount = ApiAmount.fromCoin wdrl
          , derivationPath = ApiT <$> path
          }
  
  data MkApiTransactionParams = MkApiTransactionParams
      { txId :: Hash "Tx"
      , txFee :: Maybe Coin
      , txInputs :: [(TxIn, Maybe TxOut)]
      , txCollateralInputs :: [(TxIn, Maybe TxOut)]
      , txOutputs :: [TxOut]
      , txCollateralOutput :: Maybe TxOut
      , txWithdrawals :: Map RewardAccount Coin
      , txMeta :: W.TxMeta
      , txMetadata :: Maybe W.TxMetadata
      , txTime :: UTCTime
      , txScriptValidity :: Maybe W.TxScriptValidity
      , txDeposit :: Coin
      , txMetadataSchema :: TxMetadataSchema
      , txCBOR :: Maybe TxCBOR
      }
      deriving (Eq, Generic, Show)
  
  mkApiTransaction
      :: forall n s
       . ( HasDelegation s
         , WalletFlavor s
         )
      => TimeInterpreter (ExceptT PastHorizonException IO)
      -> W.WalletLayer IO s
      -> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
      -> MkApiTransactionParams
      -> Handler (ApiTransaction n)
  mkApiTransaction timeInterpreter wrk timeRefLens tx = do
      let db = wrk ^. typed @(DBLayer IO s)
      timeRef <- liftIO $ (#time .~ tx ^. #txTime) <$> makeApiBlockReference
          (neverFails
              "makeApiBlockReference shouldn't fail getting the time of             \transactions with slots in the past" timeInterpreter)
  
          (tx ^. #txMeta . #slotNo)
          (natural (tx ^. #txMeta . #blockHeight))
      expRef <- liftIO $ traverse makeApiSlotReference' (tx ^. #txMeta . #expiry)
      parsedValues <- traverse parseTxCBOR $ tx ^. #txCBOR
      parsedCertificates <-
          if hasDelegation (Proxy @s)
              then traverse (getApiAnyCertificates db (keyFlavorFromState @s)) parsedValues
              else pure Nothing
      parsedMintBurn <- forM parsedValues
          $ getTxApiAssetMintBurn wrk
  
      pure $ set timeRefLens (Just timeRef) $ ApiTransaction
          { id = ApiT $ tx ^. #txId
          , amount = ApiAmount.fromCoin $ tx ^. #txMeta . #amount
          , fee = maybe mempty ApiAmount.fromCoin (tx ^. #txFee)
          , depositTaken = ApiAmount depositIfAny
          , depositReturned = ApiAmount reclaimIfAny
          , insertedAt = Nothing
          , pendingSince = Nothing
          , expiresAt = expRef
          , depth = Nothing
          , direction = ApiT (tx ^. #txMeta . #direction)
          , inputs =
              [ ApiTxInput (toAddressAmount @n <$> o) (ApiT i)
              | (i, o) <- tx ^. #txInputs
              ]
          , collateral =
              [ ApiTxCollateral (fmap toAddressAmountNoAssets o) (ApiT i)
              | (i, o) <- tx ^. #txCollateralInputs
              ]
          , outputs = toAddressAmount @n <$> tx ^. #txOutputs
          , collateralOutputs = ApiAsArray $
              toAddressAmount @n <$> tx ^. #txCollateralOutput
          , withdrawals = mkApiWithdrawal @n <$> Map.toList (tx ^. #txWithdrawals)
          , status = ApiT (tx ^. #txMeta . #status)
          , metadata =
              TxMetadataWithSchema (tx ^. #txMetadataSchema) <$> tx ^. #txMetadata
          , scriptValidity = ApiT <$> tx ^. #txScriptValidity
          , certificates = fromMaybe [] parsedCertificates
          , mint = maybe noApiAsset fst parsedMintBurn
          , burn = maybe noApiAsset snd parsedMintBurn
          , validityInterval =
              ApiValidityIntervalExplicit
                  <$> (view #validityInterval =<< parsedValues)
          , scriptIntegrity =
              ApiT <$> (view #scriptIntegrity =<< parsedValues)
          , extraSignatures =
              ApiT <$> (view #extraSignatures =<< maybe [] pure parsedValues)
          }
    where
      -- Since tx expiry can be far in the future, we use unsafeExtendSafeZone for
      -- now.
      makeApiSlotReference' = makeApiSlotReference
          $ unsafeExtendSafeZone timeInterpreter
  
      -- | Promote certificates of a transaction to API type,
      -- using additional context from the 'WorkerCtx'.
      getApiAnyCertificates db flavor ParsedTxCBOR{certificates} = case flavor of
          ShelleyKeyS -> do
              (rewardAcct, _, path) <- liftHandler
                  $ W.shelleyOnlyReadRewardAccount @s db
              pure $ mkApiAnyCertificate (Just rewardAcct) path <$> certificates
          SharedKeyS -> do
              infoM <- liftHandler
                  $ W.sharedOnlyReadRewardAccount @s db
              case infoM of
                  Just (rewardAcct, path) ->
                      pure $ mkApiAnyCertificate (Just rewardAcct) path <$> certificates
                  _ -> pure []
          _ ->
              pure []
  
      depositIfAny :: Natural
      depositIfAny
          | tx ^. (#txMeta . #direction) == W.Outgoing =
              if totalIn < totalOut
              then 0
              else totalIn - totalOut
          | otherwise = 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 = fromIntegral . unCoin $ tx ^. #txDeposit
  
      reclaimIfAny :: Natural
      reclaimIfAny
          | tx ^. (#txMeta . #direction) == W.Incoming =
                if ( totalIn > 0 && totalOut > 0 && totalOut > totalIn)
                   && (totalOut - totalIn <= depositValue) then
                    depositValue
                else
                    0
          | otherwise = 0
  
      totalIn :: Natural
      totalIn
          = sum (txOutValue <$> mapMaybe snd (tx ^. #txInputs))
          + sum (fromIntegral . unCoin <$> Map.elems (tx ^. #txWithdrawals))
  
      totalOut :: Natural
      totalOut
          = sum (txOutValue <$> tx ^. #txOutputs)
          + maybe 0 (fromIntegral . unCoin) (tx ^. #txFee)
  
      txOutValue :: TxOut -> Natural
      txOutValue = fromIntegral . unCoin . TxOut.coin
  
      toAddressAmountNoAssets
          :: TxOut
          -> AddressAmountNoAssets (ApiAddress n)
      toAddressAmountNoAssets (TxOut addr (TokenBundle.TokenBundle coin _)) =
          AddressAmountNoAssets (ApiAddress addr) (ApiAmount.fromCoin coin)
  
  toAddressAmount
      :: forall n
       . TxOut
      -> AddressAmount (ApiAddress n)
  toAddressAmount (TxOut addr (TokenBundle.TokenBundle coin assets)) =
      AddressAmount
          (ApiAddress addr)
          (ApiAmount.fromCoin coin)
          (ApiWalletAssets.fromTokenMap assets)
  
  mkApiFee
      :: Maybe Coin
      -> [Coin]
      -> (Percentile 10 Fee, Percentile 90 Fee)
      -> ApiFee
  mkApiFee mDeposit minCoins (Percentile estMin, Percentile estMax) = ApiFee
      { estimatedMin = ApiAmount.fromCoin (feeToCoin estMin)
      , estimatedMax = ApiAmount.fromCoin (feeToCoin estMax)
      , minimumCoins = ApiAmount.fromCoin <$> minCoins
      , deposit = maybe mempty ApiAmount.fromCoin mDeposit
      }
  
  mkApiWithdrawal
      :: (RewardAccount, Coin)
      -> ApiWithdrawal n
  mkApiWithdrawal (acct, c) =
      ApiWithdrawal (ApiRewardAccount acct) (ApiAmount.fromCoin c)
  
  addressAmountToTxOut
      :: AddressAmount (ApiAddress n)
      -> TxOut
  addressAmountToTxOut (AddressAmount (ApiAddress addr) c assets) =
      TxOut addr $ TokenBundle.TokenBundle
          (ApiAmount.toCoin c)
          (ApiWalletAssets.toTokenMap assets)
  
  natural :: Quantity q Word32 -> Quantity q Natural
  natural = Quantity . fromIntegral . getQuantity
  
  getWalletTip
      :: Monad m
      => TimeInterpreter m
      -> Wallet s
      -> m ApiBlockReference
  getWalletTip ti = makeApiBlockReferenceFromHeader ti . currentTip
  
  fromExternalInput
      :: ApiExternalInput n
      -> (Write.TxIn, Write.TxOutInRecentEra)
  fromExternalInput ApiExternalInput
      { id = ApiT tid
      , index = ix
      , address = ApiAddress addr
      , amount
      , assets
      , datum
      }
    =
      let
          inp = toLedger $ TxIn tid ix
          script = Nothing
          addr' = toLedger addr
          val = toLedger $ TokenBundle
              (ApiAmount.toCoin amount)
              (ApiWalletAssets.toTokenMap assets)
          datum' = maybe Write.NoDatum (Write.DatumHash . getApiT) datum
          out = Write.TxOutInRecentEra addr' val datum' script
      in
          (inp, out)
  
  fromApiRedeemer :: ApiRedeemer n -> Write.Redeemer
  fromApiRedeemer = \case
      ApiRedeemerSpending (ApiBytesT bytes) (ApiT i) ->
          Write.RedeemerSpending bytes (toLedger i)
      ApiRedeemerMinting (ApiBytesT bytes) (ApiT p) ->
          Write.RedeemerMinting bytes (toLedger p)
      ApiRedeemerRewarding (ApiBytesT bytes) (StakeAddress x y) ->
          Write.RedeemerRewarding bytes (Ledger.RewardAccount x y)
  
  sealWriteTx :: forall era. Write.IsRecentEra era => Write.Tx era -> W.SealedTx
  sealWriteTx = W.sealedTxFromCardano
      . Cardano.InAnyCardanoEra cardanoEra
      . Write.toCardanoApiTx
    where
      cardanoEra =
          Write.cardanoEraFromRecentEra (Write.recentEra :: Write.RecentEra era)
  
  toApiSerialisedTransaction
      :: Write.IsRecentEra era
      => Maybe ApiSealedTxEncoding
      -> Write.Tx era
      -> ApiSerialisedTransaction
  toApiSerialisedTransaction maybeEncoding tx =
      let
          encoding = fromMaybe Base64Encoded maybeEncoding
      in
          ApiSerialisedTransaction (ApiT $ sealWriteTx tx) encoding
  
  {-------------------------------------------------------------------------------
                                  Api Layer
  -------------------------------------------------------------------------------}
  
  -- | Create a new instance of the wallet layer.
  newApiLayer
      :: forall ctx s k.
          ( ctx ~ ApiLayer s
          , IsOurs s RewardAccount
          , IsOurs s Address
          , AddressBookIso s
          , MaybeLight s
          , k ~ KeyOf s
          )
      => Tracer IO WalletEngineLog
      -> (Block, NetworkParameters)
      -> NetworkLayer IO Read.ConsensusBlock
      -> TransactionLayer k (CredFromOf s) W.SealedTx
      -> DBFactory IO s
      -> TokenMetadataClient IO
      -> (WorkerCtx ctx -> WalletId -> IO ())
          -- ^ Action to run concurrently with wallet restore
      -> IO ctx
  newApiLayer tr g0 nw tl df tokenMeta coworker = do
      re <- Registry.empty
      let trTx = contramap MsgSubmitSealedTx tr
      let trW = contramap MsgWalletWorker tr
      locks <- Concierge.newConcierge
      let ctx = ApiLayer trTx trW g0 nw tl df re locks tokenMeta
      listDatabases df >>= mapM_ (startWalletWorker ctx coworker)
      return ctx
  
  -- | Register a wallet restoration thread with the worker registry.
  startWalletWorker
      :: forall ctx s .
          ( ctx ~ ApiLayer s
          , 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 coworker wid =
      void $ registerWorker ctx acquire coworker wid
    where
      acquire :: forall a. (DBLayer IO s -> IO a) -> IO a
      acquire action =
          withDatabaseLoad (ctx ^. dbFactory) wid
              $ \dblayer -> do
                  W.checkWalletIntegrity dblayer gp
                  action dblayer
      (_, NetworkParameters gp _ _) = ctx ^. genesisData
  
  -- | Register a wallet create and restore thread with the worker registry.
  -- See 'Cardano.Wallet#createWallet'
  createWalletWorker
      :: forall ctx s .
          ( ctx ~ ApiLayer s
          , IsOurs s RewardAccount
          , IsOurs s Address
          , AddressBookIso s
          , MaybeLight s
          )
      => ctx
          -- ^ Surrounding API context
      -> WalletId
          -- ^ Wallet Id
      -> (IO (W.DBLayerParams s))
          -- ^ Action for setting up initial wallet parameters.
      -> (WorkerCtx ctx -> WalletId -> IO ())
          -- ^ Action to run concurrently with restore
      -> ExceptT ErrCreateWallet IO WalletId
  createWalletWorker ctx wid createWallet coworker =
      liftIO (Registry.lookup re wid) >>= \case
          Just _ ->
              throwE $ ErrCreateWalletAlreadyExists $ ErrWalletAlreadyExists wid
          Nothing ->
              liftIO (registerWorker ctx acquire coworker wid) >>= \case
                  Nothing -> throwE ErrCreateWalletFailedToCreateWorker
                  Just _ -> pure wid
    where
      acquire :: forall a. (DBLayer IO s -> IO a) -> IO a
      acquire action = do
          params <- createWallet
          withDatabaseBoot (ctx ^. dbFactory) wid params action
      re = ctx ^. workerRegistry @s
  
  createNonRestoringWalletWorker
      :: forall ctx s .  ( ctx ~ ApiLayer s)
      => ctx
          -- ^ Surrounding API context
      -> WalletId
          -- ^ Wallet Id
      -> (IO (W.DBLayerParams s))
          -- ^ Action for setting up initial wallet parameters.
      -> ExceptT ErrCreateWallet IO WalletId
  createNonRestoringWalletWorker ctx wid createWallet =
      liftIO (Registry.lookup re wid) >>= \case
          Just _ ->
              throwE $ ErrCreateWalletAlreadyExists $ ErrWalletAlreadyExists wid
          Nothing ->
              liftIO registerIdleWorker >>= \case
                  Nothing -> throwE ErrCreateWalletFailedToCreateWorker
                  Just _ -> pure wid
    where
      re = ctx ^. workerRegistry @s
  
      acquire :: forall a. (DBLayer IO s -> IO a) -> IO a
      acquire action = do
          params <- createWallet
          withDatabaseBoot (ctx ^. dbFactory) wid params action
  
      config = MkWorker
          { workerAcquire = acquire
          , workerBefore = \_ _ -> pure ()
          , workerAfter = defaultWorkerAfter
          , workerMain = idleWorker
          }
      registerIdleWorker =
          fmap (const ctx) <$> Registry.register @_ @ctx re ctx wid config
  
  -- | 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 .
          ( ctx ~ ApiLayer s
          , IsOurs s RewardAccount
          , IsOurs s Address
          , AddressBookIso s
          , MaybeLight s
          )
      => ctx
      -> (forall a. (DBLayer IO s -> IO a) -> IO a)
          -- ^ Method to acquire a 'DBLayer'.
      -> (WorkerCtx ctx -> WalletId -> IO ())
          -- ^ Action to run concurrently with restore.
      -> WalletId
      -> IO (Maybe ctx)
  registerWorker ctx acquire coworker wid =
      fmap (const ctx) <$> Registry.register @_ @ctx re ctx wid config
    where
      re = ctx ^. workerRegistry @s
      config = MkWorker
          { workerAcquire = acquire
          , workerBefore = \_ _ -> pure ()
          , workerAfter = defaultWorkerAfter
          -- fixme: ADP-641 Review error handling here
          , workerMain = \ctx' _ -> race_
              (unsafeRunExceptT $ W.restoreWallet ctx')
              (race_
                  (forever $ W.runLocalTxSubmissionPool txCfg ctx')
                  (coworker ctx' wid))
          }
      txCfg = W.defaultLocalTxSubmissionConfig
  
  -- | Something to pass as the coworker action to 'newApiLayer', which does
  -- nothing, and never exits.
  idleWorker :: ctx -> wid -> IO a
  idleWorker _ _ = forever $ threadDelay maxBound
  
  -- | Run an action in a particular worker context. Fails if there's no worker
  -- for a given id.
  withWorkerCtx
      :: forall ctx s m a.
          ( HasWorkerRegistry s ctx
          , HasDBFactory s 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 wid onMissing onNotResponding action =
      Registry.lookup (ctx ^. workerRegistry @s) wid >>= \case
          Nothing -> do
              wids <- liftIO $ listDatabases $ ctx ^. dbFactory @s
              if wid `elem` wids
                  then onNotResponding (ErrWalletNotResponding wid)
                  else onMissing (ErrNoSuchWallet wid)
          Just wrk ->
              action $ hoistResource (workerResource wrk) (MsgFromWorker wid) ctx
  
  {-------------------------------------------------------------------------------
      Atomic handler operations
  -------------------------------------------------------------------------------}
  atomicallyWithHandler
      :: Ord lock
      => Concierge.Concierge IO lock -> lock -> Handler a -> Handler a
  atomicallyWithHandler c l = Handler . Concierge.atomicallyWith c l . runHandler'
  
  {-------------------------------------------------------------------------------
                                  Locally defined server errors
  -------------------------------------------------------------------------------}
  
  data ErrUnexpectedPoolIdPlaceholder = ErrUnexpectedPoolIdPlaceholder
      deriving (Eq, Show)
  
  data ErrUnexpectedDRepPlaceholder = ErrUnexpectedDRepPlaceholder
      deriving (Eq, Show)
  
  data ErrCreateWallet
      = ErrCreateWalletAlreadyExists !ErrWalletAlreadyExists
          -- ^ Wallet already exists
      | ErrCreateWalletFailedToCreateWorker
          -- ^ Somehow, we couldn't create a worker or open a db connection
      | ErrCreateWalletRestorationFromABlockFailed ErrFetchBlock
          -- ^ Restoration from a given block failed
      deriving (Eq, Show)
  
  data ErrTemporarilyDisabled = ErrTemporarilyDisabled
      deriving (Eq, Show)
  
  instance IsServerError ErrCurrentEpoch where
      toServerError = \case
          ErrUnableToDetermineCurrentEpoch ->
              apiError err500 UnableToDetermineCurrentEpoch $ mconcat
                  [ "I'm unable to determine the current epoch. "
                  , "Please wait a while for the node to sync and try again."
                  ]
          ErrCurrentEpochPastHorizonException e -> toServerError e
  
  instance IsServerError ErrUnexpectedPoolIdPlaceholder where
      toServerError = \case
          ErrUnexpectedPoolIdPlaceholder ->
              apiError err400 BadRequest $
                  case fromText @PoolId "INVALID" of
                      Left msg -> pretty msg
                      Right _ -> "Invalid pool id placeholder"
  
  instance IsServerError ErrUnexpectedDRepPlaceholder where
      toServerError = \case
          ErrUnexpectedDRepPlaceholder ->
              apiError err400 BadRequest $
                  case fromText @DRep "INVALID" of
                      Left msg -> pretty msg
                      Right _ -> "Invalid DRep placeholder"
  
  instance IsServerError ErrCreateWallet where
      toServerError = \case
          ErrCreateWalletAlreadyExists e -> toServerError e
          ErrCreateWalletFailedToCreateWorker ->
              apiError err500 UnexpectedError $ mconcat
                  [ "That's embarrassing. Your wallet looks good, but I couldn't "
                  , "open a new database to store its data. This is unexpected "
                  , "and likely not your fault. Perhaps, check your filesystem's "
                  , "permissions or available space?"
                  ]
          ErrCreateWalletRestorationFromABlockFailed
              (ErrNoBlockAt (Read.BlockPoint (Read.SlotNo slot) block))
              -> apiError err404 UnexpectedError $ mconcat
              [
              "Restoration from a given block failed. "
              , "The block at slot number "
                  <> T.pack (show slot)
                  <> " and hash "
                  <> Hash.hashToTextAsHex block
                  <> " does not exist."
              ]
          ErrCreateWalletRestorationFromABlockFailed
              (ErrNoBlockAt (Read.GenesisPoint))
              -> apiError err404 UnexpectedError $ mconcat
              [
              "Restoration from a given block failed. "
              , "The block at genesis does not exist."
              ]
  
  instance IsServerError ErrGetAsset where
      toServerError = \case
          ErrGetAssetNotPresent ->
              apiError err404 AssetNotPresent $ mconcat
                  [ "The requested asset is not associated with this wallet."
                  ]
  
  {-------------------------------------------------------------------------------
                                 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 (Show, Eq)
  
  instance ToText WalletEngineLog where
      toText = \case
          MsgWalletWorker msg -> toText msg
          MsgSubmitSealedTx msg -> toText msg
  
  instance HasPrivacyAnnotation WalletEngineLog where
      getPrivacyAnnotation = \case
          MsgWalletWorker msg -> getPrivacyAnnotation msg
          MsgSubmitSealedTx msg -> getPrivacyAnnotation msg
  
  instance HasSeverityAnnotation WalletEngineLog where
      getSeverityAnnotation = \case
          MsgWalletWorker msg -> getSeverityAnnotation msg
          MsgSubmitSealedTx msg -> getSeverityAnnotation msg
  