{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DerivingStrategies    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE Rank2Types            #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}

{-# OPTIONS_GHC -Wno-orphans  #-}
{-# OPTIONS_GHC -Wno-deprecations #-} -- TODO Remove once TotalFunds gets removed

module Wallet.Emulator.Wallet where

import Cardano.Api (makeSignedTransaction)
import Cardano.Node.Emulator.Chain (ChainState (_index))
import Cardano.Node.Emulator.Fee qualified as Fee
import Cardano.Node.Emulator.Params (Params (..))
import Cardano.Wallet.Primitive.Types qualified as Cardano.Wallet
import Control.Lens (makeLenses, makePrisms, view)
import Control.Monad (foldM, (<=<))
import Control.Monad.Freer (Eff, Member, Members, interpret, type (~>))
import Control.Monad.Freer.Error (Error, runError, throwError)
import Control.Monad.Freer.Extras.Log (LogMsg, logInfo, logWarn)
import Control.Monad.Freer.State (State, get, gets, put)
import Control.Monad.Freer.TH (makeEffect)
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), ToJSONKey)
import Data.Aeson qualified as Aeson
import Data.Bifunctor (bimap, first)
import Data.Data (Data)
import Data.Default (Default (def))
import Data.Foldable (find, foldl')
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.OpenApi.Schema qualified as OpenApi
import Data.Set qualified as Set
import Data.String (IsString (fromString))
import Data.Text qualified as T
import Data.Text.Class (fromText, toText)
import GHC.Generics (Generic)
import Ledger (CardanoTx, DecoratedTxOut, PubKeyHash, TxOutRef, UtxoIndex (..), Value)
import Ledger qualified
import Ledger.Address (CardanoAddress, PaymentPrivateKey (..), PaymentPubKey, PaymentPubKeyHash (PaymentPubKeyHash),
                       cardanoAddressCredential)
import Ledger.CardanoWallet (MockWallet, WalletNumber)
import Ledger.CardanoWallet qualified as CW
import Ledger.Constraints.OffChain (UnbalancedTx)
import Ledger.Constraints.OffChain qualified as U
import Ledger.Credential (Credential (PubKeyCredential, ScriptCredential))
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (getRequiredSigners)
import Ledger.Tx.CardanoAPI qualified as CardanoAPI
import Plutus.ChainIndex (PageQuery)
import Plutus.ChainIndex qualified as ChainIndex
import Plutus.ChainIndex.Api (UtxosResponse (page))
import Plutus.ChainIndex.Emulator (ChainIndexEmulatorState, ChainIndexQueryEffect)
import Plutus.Contract.Checkpoint (CheckpointLogMsg)
import Plutus.V1.Ledger.Api (ValidatorHash)
import Prettyprinter (Pretty (pretty))
import Servant.API (FromHttpApiData (parseUrlPiece), ToHttpApiData (toUrlPiece))
import Wallet.Effects (NodeClientEffect,
                       WalletEffect (BalanceTx, OwnAddresses, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx),
                       getClientParams, publishTx)
import Wallet.Emulator.Error qualified as WAPI (WalletAPIError (InsufficientFunds, PaymentPrivateKeyNotFound, ToCardanoError, ValidationError))
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg,
                                    TxBalanceMsg (BalancingUnbalancedTx, FinishedBalancing, SigningTx, SubmittingTx, ValidationFailed))
import Wallet.Emulator.NodeClient (NodeClientState, emptyNodeClientState)
import Wallet.Error (WalletAPIError)


newtype SigningProcess = SigningProcess {
    SigningProcess
-> forall (effs :: [* -> *]).
   Member (Error WalletAPIError) effs =>
   [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx
unSigningProcess :: forall effs. (Member (Error WAPI.WalletAPIError) effs) => [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx
}

instance Show SigningProcess where
    show :: SigningProcess -> String
show = String -> SigningProcess -> String
forall a b. a -> b -> a
const String
"SigningProcess <...>"

-- | A wallet identifier
data Wallet = Wallet { Wallet -> Maybe String
prettyWalletName :: Maybe String , Wallet -> WalletId
getWalletId :: WalletId }
    deriving ((forall x. Wallet -> Rep Wallet x)
-> (forall x. Rep Wallet x -> Wallet) -> Generic Wallet
forall x. Rep Wallet x -> Wallet
forall x. Wallet -> Rep Wallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wallet x -> Wallet
$cfrom :: forall x. Wallet -> Rep Wallet x
Generic, Typeable Wallet
DataType
Constr
Typeable Wallet
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Wallet -> c Wallet)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Wallet)
-> (Wallet -> Constr)
-> (Wallet -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Wallet))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wallet))
-> ((forall b. Data b => b -> b) -> Wallet -> Wallet)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Wallet -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Wallet -> r)
-> (forall u. (forall d. Data d => d -> u) -> Wallet -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Wallet -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Wallet -> m Wallet)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Wallet -> m Wallet)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Wallet -> m Wallet)
-> Data Wallet
Wallet -> DataType
Wallet -> Constr
(forall b. Data b => b -> b) -> Wallet -> Wallet
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wallet -> c Wallet
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wallet
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Wallet -> u
forall u. (forall d. Data d => d -> u) -> Wallet -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wallet -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wallet -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wallet -> m Wallet
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wallet -> m Wallet
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wallet
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wallet -> c Wallet
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wallet)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wallet)
$cWallet :: Constr
$tWallet :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Wallet -> m Wallet
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wallet -> m Wallet
gmapMp :: (forall d. Data d => d -> m d) -> Wallet -> m Wallet
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Wallet -> m Wallet
gmapM :: (forall d. Data d => d -> m d) -> Wallet -> m Wallet
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Wallet -> m Wallet
gmapQi :: Int -> (forall d. Data d => d -> u) -> Wallet -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Wallet -> u
gmapQ :: (forall d. Data d => d -> u) -> Wallet -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Wallet -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wallet -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Wallet -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wallet -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Wallet -> r
gmapT :: (forall b. Data b => b -> b) -> Wallet -> Wallet
$cgmapT :: (forall b. Data b => b -> b) -> Wallet -> Wallet
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wallet)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Wallet)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Wallet)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Wallet)
dataTypeOf :: Wallet -> DataType
$cdataTypeOf :: Wallet -> DataType
toConstr :: Wallet -> Constr
$ctoConstr :: Wallet -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wallet
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Wallet
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wallet -> c Wallet
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Wallet -> c Wallet
$cp1Data :: Typeable Wallet
Data)
    deriving anyclass ([Wallet] -> Encoding
[Wallet] -> Value
Wallet -> Encoding
Wallet -> Value
(Wallet -> Value)
-> (Wallet -> Encoding)
-> ([Wallet] -> Value)
-> ([Wallet] -> Encoding)
-> ToJSON Wallet
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Wallet] -> Encoding
$ctoEncodingList :: [Wallet] -> Encoding
toJSONList :: [Wallet] -> Value
$ctoJSONList :: [Wallet] -> Value
toEncoding :: Wallet -> Encoding
$ctoEncoding :: Wallet -> Encoding
toJSON :: Wallet -> Value
$ctoJSON :: Wallet -> Value
ToJSON, Value -> Parser [Wallet]
Value -> Parser Wallet
(Value -> Parser Wallet)
-> (Value -> Parser [Wallet]) -> FromJSON Wallet
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Wallet]
$cparseJSONList :: Value -> Parser [Wallet]
parseJSON :: Value -> Parser Wallet
$cparseJSON :: Value -> Parser Wallet
FromJSON, ToJSONKeyFunction [Wallet]
ToJSONKeyFunction Wallet
ToJSONKeyFunction Wallet
-> ToJSONKeyFunction [Wallet] -> ToJSONKey Wallet
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Wallet]
$ctoJSONKeyList :: ToJSONKeyFunction [Wallet]
toJSONKey :: ToJSONKeyFunction Wallet
$ctoJSONKey :: ToJSONKeyFunction Wallet
ToJSONKey)

instance Eq Wallet where
  Wallet
w == :: Wallet -> Wallet -> Bool
== Wallet
w' = Wallet -> WalletId
getWalletId Wallet
w WalletId -> WalletId -> Bool
forall a. Eq a => a -> a -> Bool
== Wallet -> WalletId
getWalletId Wallet
w'

instance Ord Wallet where
  compare :: Wallet -> Wallet -> Ordering
compare Wallet
w Wallet
w' = WalletId -> WalletId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Wallet -> WalletId
getWalletId Wallet
w) (Wallet -> WalletId
getWalletId Wallet
w')

instance ToHttpApiData Wallet where
  toUrlPiece :: Wallet -> Text
toUrlPiece = WalletId -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece (WalletId -> Text) -> (Wallet -> WalletId) -> Wallet -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId

instance FromHttpApiData Wallet where
  parseUrlPiece :: Text -> Either Text Wallet
parseUrlPiece = Wallet -> Either Text Wallet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wallet -> Either Text Wallet)
-> (WalletId -> Wallet) -> WalletId -> Either Text Wallet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> WalletId -> Wallet
Wallet Maybe String
forall a. Maybe a
Nothing (WalletId -> Either Text Wallet)
-> (Text -> Either Text WalletId) -> Text -> Either Text Wallet
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Either Text WalletId
forall a. FromHttpApiData a => Text -> Either Text a
parseUrlPiece

toMockWallet :: MockWallet -> Wallet
toMockWallet :: MockWallet -> Wallet
toMockWallet MockWallet
mw =
  Maybe String -> WalletId -> Wallet
Wallet (MockWallet -> Maybe String
CW.mwPrintAs MockWallet
mw)
  (WalletId -> Wallet)
-> (MockWallet -> WalletId) -> MockWallet -> Wallet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> WalletId
WalletId
  (WalletId -> WalletId)
-> (MockWallet -> WalletId) -> MockWallet -> WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest Blake2b_160 -> WalletId
Cardano.Wallet.WalletId
  (Digest Blake2b_160 -> WalletId)
-> (MockWallet -> Digest Blake2b_160) -> MockWallet -> WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockWallet -> Digest Blake2b_160
CW.mwWalletId (MockWallet -> Wallet) -> MockWallet -> Wallet
forall a b. (a -> b) -> a -> b
$ MockWallet
mw

knownWallets :: [Wallet]
knownWallets :: [Wallet]
knownWallets = MockWallet -> Wallet
toMockWallet (MockWallet -> Wallet) -> [MockWallet] -> [Wallet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MockWallet]
CW.knownMockWallets

knownWallet :: Integer -> Wallet
knownWallet :: Integer -> Wallet
knownWallet = WalletNumber -> Wallet
fromWalletNumber (WalletNumber -> Wallet)
-> (Integer -> WalletNumber) -> Integer -> Wallet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> WalletNumber
CW.WalletNumber

fromWalletNumber :: WalletNumber -> Wallet
fromWalletNumber :: WalletNumber -> Wallet
fromWalletNumber = MockWallet -> Wallet
toMockWallet (MockWallet -> Wallet)
-> (WalletNumber -> MockWallet) -> WalletNumber -> Wallet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletNumber -> MockWallet
CW.fromWalletNumber

instance Show Wallet where
    showsPrec :: Int -> Wallet -> ShowS
showsPrec Int
p (Wallet Maybe String
Nothing WalletId
i)  = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Wallet " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> ShowS
forall a. Show a => a -> ShowS
shows WalletId
i
    showsPrec Int
p (Wallet (Just String
s) WalletId
_) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String
"Wallet " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s)

instance Pretty Wallet where
    pretty :: Wallet -> Doc ann
pretty (Wallet Maybe String
Nothing WalletId
i)  = Doc ann
"W" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> Text -> Text
T.take Int
7 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ WalletId -> Text
toBase16 WalletId
i)
    pretty (Wallet (Just String
s) WalletId
_) = Doc ann
"W[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a. IsString a => String -> a
fromString String
s Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]"

deriving anyclass instance OpenApi.ToSchema Wallet
deriving anyclass instance OpenApi.ToSchema Cardano.Wallet.WalletId
deriving instance Data Cardano.Wallet.WalletId

newtype WalletId = WalletId { WalletId -> WalletId
unWalletId :: Cardano.Wallet.WalletId }
    deriving (WalletId -> WalletId -> Bool
(WalletId -> WalletId -> Bool)
-> (WalletId -> WalletId -> Bool) -> Eq WalletId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletId -> WalletId -> Bool
$c/= :: WalletId -> WalletId -> Bool
== :: WalletId -> WalletId -> Bool
$c== :: WalletId -> WalletId -> Bool
Eq, Eq WalletId
Eq WalletId
-> (WalletId -> WalletId -> Ordering)
-> (WalletId -> WalletId -> Bool)
-> (WalletId -> WalletId -> Bool)
-> (WalletId -> WalletId -> Bool)
-> (WalletId -> WalletId -> Bool)
-> (WalletId -> WalletId -> WalletId)
-> (WalletId -> WalletId -> WalletId)
-> Ord WalletId
WalletId -> WalletId -> Bool
WalletId -> WalletId -> Ordering
WalletId -> WalletId -> WalletId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WalletId -> WalletId -> WalletId
$cmin :: WalletId -> WalletId -> WalletId
max :: WalletId -> WalletId -> WalletId
$cmax :: WalletId -> WalletId -> WalletId
>= :: WalletId -> WalletId -> Bool
$c>= :: WalletId -> WalletId -> Bool
> :: WalletId -> WalletId -> Bool
$c> :: WalletId -> WalletId -> Bool
<= :: WalletId -> WalletId -> Bool
$c<= :: WalletId -> WalletId -> Bool
< :: WalletId -> WalletId -> Bool
$c< :: WalletId -> WalletId -> Bool
compare :: WalletId -> WalletId -> Ordering
$ccompare :: WalletId -> WalletId -> Ordering
$cp1Ord :: Eq WalletId
Ord, (forall x. WalletId -> Rep WalletId x)
-> (forall x. Rep WalletId x -> WalletId) -> Generic WalletId
forall x. Rep WalletId x -> WalletId
forall x. WalletId -> Rep WalletId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletId x -> WalletId
$cfrom :: forall x. WalletId -> Rep WalletId x
Generic, Typeable WalletId
DataType
Constr
Typeable WalletId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> WalletId -> c WalletId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WalletId)
-> (WalletId -> Constr)
-> (WalletId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WalletId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WalletId))
-> ((forall b. Data b => b -> b) -> WalletId -> WalletId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WalletId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WalletId -> r)
-> (forall u. (forall d. Data d => d -> u) -> WalletId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> WalletId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WalletId -> m WalletId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WalletId -> m WalletId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WalletId -> m WalletId)
-> Data WalletId
WalletId -> DataType
WalletId -> Constr
(forall b. Data b => b -> b) -> WalletId -> WalletId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WalletId -> c WalletId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WalletId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> WalletId -> u
forall u. (forall d. Data d => d -> u) -> WalletId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WalletId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WalletId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WalletId -> m WalletId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WalletId -> m WalletId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WalletId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WalletId -> c WalletId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WalletId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WalletId)
$cWalletId0 :: Constr
$tWalletId0 :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WalletId -> m WalletId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WalletId -> m WalletId
gmapMp :: (forall d. Data d => d -> m d) -> WalletId -> m WalletId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WalletId -> m WalletId
gmapM :: (forall d. Data d => d -> m d) -> WalletId -> m WalletId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WalletId -> m WalletId
gmapQi :: Int -> (forall d. Data d => d -> u) -> WalletId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WalletId -> u
gmapQ :: (forall d. Data d => d -> u) -> WalletId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WalletId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WalletId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WalletId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WalletId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WalletId -> r
gmapT :: (forall b. Data b => b -> b) -> WalletId -> WalletId
$cgmapT :: (forall b. Data b => b -> b) -> WalletId -> WalletId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WalletId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WalletId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WalletId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WalletId)
dataTypeOf :: WalletId -> DataType
$cdataTypeOf :: WalletId -> DataType
toConstr :: WalletId -> Constr
$ctoConstr :: WalletId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WalletId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WalletId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WalletId -> c WalletId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WalletId -> c WalletId
$cp1Data :: Typeable WalletId
Data)
    deriving anyclass (ToJSONKeyFunction [WalletId]
ToJSONKeyFunction WalletId
ToJSONKeyFunction WalletId
-> ToJSONKeyFunction [WalletId] -> ToJSONKey WalletId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [WalletId]
$ctoJSONKeyList :: ToJSONKeyFunction [WalletId]
toJSONKey :: ToJSONKeyFunction WalletId
$ctoJSONKey :: ToJSONKeyFunction WalletId
ToJSONKey)

instance Show WalletId where
    show :: WalletId -> String
show = Text -> String
T.unpack (Text -> String) -> (WalletId -> Text) -> WalletId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> Text
toBase16
instance ToJSON WalletId where
    toJSON :: WalletId -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (WalletId -> Text) -> WalletId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> Text
toBase16
instance FromJSON WalletId where
    parseJSON :: Value -> Parser WalletId
parseJSON = String -> (Text -> Parser WalletId) -> Value -> Parser WalletId
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"WalletId" ((String -> Parser WalletId)
-> (WalletId -> Parser WalletId)
-> Either String WalletId
-> Parser WalletId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser WalletId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail WalletId -> Parser WalletId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String WalletId -> Parser WalletId)
-> (Text -> Either String WalletId) -> Text -> Parser WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String WalletId
fromBase16)
instance ToHttpApiData WalletId where
    toUrlPiece :: WalletId -> Text
toUrlPiece = WalletId -> Text
toBase16
instance FromHttpApiData WalletId where
    parseUrlPiece :: Text -> Either Text WalletId
parseUrlPiece = (String -> Text) -> Either String WalletId -> Either Text WalletId
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
T.pack (Either String WalletId -> Either Text WalletId)
-> (Text -> Either String WalletId) -> Text -> Either Text WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String WalletId
fromBase16
deriving anyclass instance OpenApi.ToSchema WalletId

toBase16 :: WalletId -> T.Text
toBase16 :: WalletId -> Text
toBase16 = WalletId -> Text
forall a. ToText a => a -> Text
toText (WalletId -> Text) -> (WalletId -> WalletId) -> WalletId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> WalletId
unWalletId

fromBase16 :: T.Text -> Either String WalletId
fromBase16 :: Text -> Either String WalletId
fromBase16 Text
s = (TextDecodingError -> String)
-> (WalletId -> WalletId)
-> Either TextDecodingError WalletId
-> Either String WalletId
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap TextDecodingError -> String
forall a. Show a => a -> String
show WalletId -> WalletId
WalletId (Text -> Either TextDecodingError WalletId
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
s)

-- | The 'MockWallet' whose ID is the given wallet ID (if it exists)
walletToMockWallet :: Wallet -> Maybe MockWallet
walletToMockWallet :: Wallet -> Maybe MockWallet
walletToMockWallet (Wallet Maybe String
_ WalletId
wid) =
  (MockWallet -> Bool) -> [MockWallet] -> Maybe MockWallet
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (WalletId -> WalletId -> Bool
forall a. Eq a => a -> a -> Bool
(==) WalletId
wid (WalletId -> Bool)
-> (MockWallet -> WalletId) -> MockWallet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> WalletId
WalletId (WalletId -> WalletId)
-> (MockWallet -> WalletId) -> MockWallet -> WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest Blake2b_160 -> WalletId
Cardano.Wallet.WalletId (Digest Blake2b_160 -> WalletId)
-> (MockWallet -> Digest Blake2b_160) -> MockWallet -> WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockWallet -> Digest Blake2b_160
CW.mwWalletId) [MockWallet]
CW.knownMockWallets

-- | The same as @walletToMockWallet@ but fails with an error instead of returning @Nothing@.
walletToMockWallet' :: Wallet -> MockWallet
walletToMockWallet' :: Wallet -> MockWallet
walletToMockWallet' Wallet
w =
    MockWallet -> Maybe MockWallet -> MockWallet
forall a. a -> Maybe a -> a
fromMaybe (String -> MockWallet
forall a. HasCallStack => String -> a
error (String -> MockWallet) -> String -> MockWallet
forall a b. (a -> b) -> a -> b
$ String
"Wallet.Emulator.Wallet.walletToMockWallet': Wallet "
                          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Wallet -> String
forall a. Show a => a -> String
show Wallet
w
                          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a mock wallet")
    (Maybe MockWallet -> MockWallet) -> Maybe MockWallet -> MockWallet
forall a b. (a -> b) -> a -> b
$ Wallet -> Maybe MockWallet
walletToMockWallet Wallet
w

-- | The public key of a mock wallet.  (Fails if the wallet is not a mock wallet).
mockWalletPaymentPubKey :: Wallet -> PaymentPubKey
mockWalletPaymentPubKey :: Wallet -> PaymentPubKey
mockWalletPaymentPubKey = MockWallet -> PaymentPubKey
CW.paymentPubKey (MockWallet -> PaymentPubKey)
-> (Wallet -> MockWallet) -> Wallet -> PaymentPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> MockWallet
walletToMockWallet'

-- | The payment public key hash of a mock wallet.  (Fails if the wallet is not a mock wallet).
mockWalletPaymentPubKeyHash :: Wallet -> PaymentPubKeyHash
mockWalletPaymentPubKeyHash :: Wallet -> PaymentPubKeyHash
mockWalletPaymentPubKeyHash = MockWallet -> PaymentPubKeyHash
CW.paymentPubKeyHash (MockWallet -> PaymentPubKeyHash)
-> (Wallet -> MockWallet) -> Wallet -> PaymentPubKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> MockWallet
walletToMockWallet'

-- | Get the cardano address of a mock wallet. (Fails if the wallet is not a mock wallet).
mockWalletAddress :: Wallet -> CardanoAddress
mockWalletAddress :: Wallet -> CardanoAddress
mockWalletAddress = MockWallet -> CardanoAddress
CW.mockWalletAddress (MockWallet -> CardanoAddress)
-> (Wallet -> MockWallet) -> Wallet -> CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> MockWallet
walletToMockWallet'

data WalletEvent =
    GenericLog T.Text
    | CheckpointLog CheckpointLogMsg
    | RequestHandlerLog RequestHandlerLogMsg
    | TxBalanceLog TxBalanceMsg
    deriving stock (Int -> WalletEvent -> ShowS
[WalletEvent] -> ShowS
WalletEvent -> String
(Int -> WalletEvent -> ShowS)
-> (WalletEvent -> String)
-> ([WalletEvent] -> ShowS)
-> Show WalletEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletEvent] -> ShowS
$cshowList :: [WalletEvent] -> ShowS
show :: WalletEvent -> String
$cshow :: WalletEvent -> String
showsPrec :: Int -> WalletEvent -> ShowS
$cshowsPrec :: Int -> WalletEvent -> ShowS
Show, WalletEvent -> WalletEvent -> Bool
(WalletEvent -> WalletEvent -> Bool)
-> (WalletEvent -> WalletEvent -> Bool) -> Eq WalletEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletEvent -> WalletEvent -> Bool
$c/= :: WalletEvent -> WalletEvent -> Bool
== :: WalletEvent -> WalletEvent -> Bool
$c== :: WalletEvent -> WalletEvent -> Bool
Eq, (forall x. WalletEvent -> Rep WalletEvent x)
-> (forall x. Rep WalletEvent x -> WalletEvent)
-> Generic WalletEvent
forall x. Rep WalletEvent x -> WalletEvent
forall x. WalletEvent -> Rep WalletEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletEvent x -> WalletEvent
$cfrom :: forall x. WalletEvent -> Rep WalletEvent x
Generic)
    deriving anyclass ([WalletEvent] -> Encoding
[WalletEvent] -> Value
WalletEvent -> Encoding
WalletEvent -> Value
(WalletEvent -> Value)
-> (WalletEvent -> Encoding)
-> ([WalletEvent] -> Value)
-> ([WalletEvent] -> Encoding)
-> ToJSON WalletEvent
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WalletEvent] -> Encoding
$ctoEncodingList :: [WalletEvent] -> Encoding
toJSONList :: [WalletEvent] -> Value
$ctoJSONList :: [WalletEvent] -> Value
toEncoding :: WalletEvent -> Encoding
$ctoEncoding :: WalletEvent -> Encoding
toJSON :: WalletEvent -> Value
$ctoJSON :: WalletEvent -> Value
ToJSON, Value -> Parser [WalletEvent]
Value -> Parser WalletEvent
(Value -> Parser WalletEvent)
-> (Value -> Parser [WalletEvent]) -> FromJSON WalletEvent
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WalletEvent]
$cparseJSONList :: Value -> Parser [WalletEvent]
parseJSON :: Value -> Parser WalletEvent
$cparseJSON :: Value -> Parser WalletEvent
FromJSON)

instance Pretty WalletEvent where
    pretty :: WalletEvent -> Doc ann
pretty = \case
        GenericLog Text
msg        -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
msg
        CheckpointLog CheckpointLogMsg
msg     -> CheckpointLogMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty CheckpointLogMsg
msg
        RequestHandlerLog RequestHandlerLogMsg
msg -> RequestHandlerLogMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty RequestHandlerLogMsg
msg
        TxBalanceLog TxBalanceMsg
msg      -> TxBalanceMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxBalanceMsg
msg

makePrisms ''WalletEvent

-- | The state used by the mock wallet environment.
data WalletState = WalletState {
    WalletState -> MockWallet
_mockWallet              :: MockWallet, -- ^ Mock wallet with the user's private key.
    WalletState -> NodeClientState
_nodeClient              :: NodeClientState, -- ^ The representation of the node, as known by the wallet
    WalletState -> ChainIndexEmulatorState
_chainIndexEmulatorState :: ChainIndexEmulatorState, -- ^ the chain index info known by the wallet
    WalletState -> Maybe SigningProcess
_signingProcess          :: Maybe SigningProcess
                                -- ^ Override the signing process.
                                -- Used for testing multi-agent use cases.
    } deriving Int -> WalletState -> ShowS
[WalletState] -> ShowS
WalletState -> String
(Int -> WalletState -> ShowS)
-> (WalletState -> String)
-> ([WalletState] -> ShowS)
-> Show WalletState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletState] -> ShowS
$cshowList :: [WalletState] -> ShowS
show :: WalletState -> String
$cshow :: WalletState -> String
showsPrec :: Int -> WalletState -> ShowS
$cshowsPrec :: Int -> WalletState -> ShowS
Show

makeLenses ''WalletState

ownPaymentPrivateKey :: WalletState -> PaymentPrivateKey
ownPaymentPrivateKey :: WalletState -> PaymentPrivateKey
ownPaymentPrivateKey = MockWallet -> PaymentPrivateKey
CW.paymentPrivateKey (MockWallet -> PaymentPrivateKey)
-> (WalletState -> MockWallet) -> WalletState -> PaymentPrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletState -> MockWallet
_mockWallet

ownPaymentPublicKey :: WalletState -> PaymentPubKey
ownPaymentPublicKey :: WalletState -> PaymentPubKey
ownPaymentPublicKey = MockWallet -> PaymentPubKey
CW.paymentPubKey (MockWallet -> PaymentPubKey)
-> (WalletState -> MockWallet) -> WalletState -> PaymentPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletState -> MockWallet
_mockWallet

-- | Get the user's own payment public-key address.
ownAddress :: WalletState -> CardanoAddress
ownAddress :: WalletState -> CardanoAddress
ownAddress = MockWallet -> CardanoAddress
CW.mockWalletAddress (MockWallet -> CardanoAddress)
-> (WalletState -> MockWallet) -> WalletState -> CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletState -> MockWallet
_mockWallet

-- | An empty wallet using the given private key.
-- for that wallet as the sole watched address.
fromMockWallet :: MockWallet -> WalletState
fromMockWallet :: MockWallet -> WalletState
fromMockWallet MockWallet
mw = MockWallet
-> NodeClientState
-> ChainIndexEmulatorState
-> Maybe SigningProcess
-> WalletState
WalletState MockWallet
mw NodeClientState
emptyNodeClientState ChainIndexEmulatorState
forall a. Monoid a => a
mempty Maybe SigningProcess
forall a. Maybe a
Nothing

-- | Empty wallet state for an emulator 'Wallet'. Returns 'Nothing' if the wallet
--   is not known in the emulator.
emptyWalletState :: Wallet -> Maybe WalletState
emptyWalletState :: Wallet -> Maybe WalletState
emptyWalletState = (MockWallet -> WalletState)
-> Maybe MockWallet -> Maybe WalletState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MockWallet -> WalletState
fromMockWallet (Maybe MockWallet -> Maybe WalletState)
-> (Wallet -> Maybe MockWallet) -> Wallet -> Maybe WalletState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> Maybe MockWallet
walletToMockWallet

handleWallet ::
    ( Member (Error WalletAPIError) effs
    , Member NodeClientEffect effs
    , Member ChainIndexQueryEffect effs
    , Member (State WalletState) effs
    , Member (LogMsg TxBalanceMsg) effs
    )
    => WalletEffect ~> Eff effs
handleWallet :: WalletEffect ~> Eff effs
handleWallet = \case
    SubmitTxn CardanoTx
tx          -> CardanoTx -> Eff effs ()
forall (effs :: [* -> *]).
(Member NodeClientEffect effs,
 Member (LogMsg TxBalanceMsg) effs) =>
CardanoTx -> Eff effs ()
submitTxnH CardanoTx
tx
    WalletEffect x
OwnAddresses          -> Eff effs x
forall (effs :: [* -> *]).
Member (State WalletState) effs =>
Eff effs (NonEmpty CardanoAddress)
ownAddressesH
    BalanceTx UnbalancedTx
utx         -> UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
(Member NodeClientEffect effs, Member ChainIndexQueryEffect effs,
 Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs) =>
UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx
    WalletAddSignature CardanoTx
tx -> CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs,
 Member (Error WalletAPIError) effs) =>
CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
tx
    WalletEffect x
TotalFunds            -> Eff effs x
forall (effs :: [* -> *]).
(Member (State WalletState) effs,
 Member ChainIndexQueryEffect effs) =>
Eff effs Value
totalFundsH
    YieldUnbalancedTx UnbalancedTx
utx -> UnbalancedTx -> Eff effs ()
forall (effs :: [* -> *]).
(Member (Error WalletAPIError) effs, Member NodeClientEffect effs,
 Member ChainIndexQueryEffect effs, Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs) =>
UnbalancedTx -> Eff effs ()
yieldUnbalancedTxH UnbalancedTx
utx

  where
    submitTxnH :: (Member NodeClientEffect effs, Member (LogMsg TxBalanceMsg) effs) => CardanoTx -> Eff effs ()
    submitTxnH :: CardanoTx -> Eff effs ()
submitTxnH CardanoTx
tx = do
        TxBalanceMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo (TxBalanceMsg -> Eff effs ()) -> TxBalanceMsg -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxBalanceMsg
SubmittingTx CardanoTx
tx
        CardanoTx -> Eff effs ()
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
CardanoTx -> Eff effs ()
publishTx CardanoTx
tx

    ownAddressesH :: (Member (State WalletState) effs) => Eff effs (NonEmpty CardanoAddress)
    ownAddressesH :: Eff effs (NonEmpty CardanoAddress)
ownAddressesH = do
        MockWallet
mw <- (WalletState -> MockWallet) -> Eff effs MockWallet
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets WalletState -> MockWallet
_mockWallet
        NonEmpty CardanoAddress -> Eff effs (NonEmpty CardanoAddress)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty CardanoAddress -> Eff effs (NonEmpty CardanoAddress))
-> NonEmpty CardanoAddress -> Eff effs (NonEmpty CardanoAddress)
forall a b. (a -> b) -> a -> b
$ [CardanoAddress] -> NonEmpty CardanoAddress
forall a. [a] -> NonEmpty a
NonEmpty.fromList [MockWallet -> CardanoAddress
CW.mockWalletAddress MockWallet
mw]

    balanceTxH ::
        ( Member NodeClientEffect effs
        , Member ChainIndexQueryEffect effs
        , Member (State WalletState) effs
        , Member (LogMsg TxBalanceMsg) effs
        )
        => UnbalancedTx
        -> Eff effs (Either WalletAPIError CardanoTx)
    balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx = Eff (Error WalletAPIError : effs) CardanoTx
-> Eff effs (Either WalletAPIError CardanoTx)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError (Eff (Error WalletAPIError : effs) CardanoTx
 -> Eff effs (Either WalletAPIError CardanoTx))
-> Eff (Error WalletAPIError : effs) CardanoTx
-> Eff effs (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ do
        TxBalanceMsg -> Eff (Error WalletAPIError : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo (TxBalanceMsg -> Eff (Error WalletAPIError : effs) ())
-> TxBalanceMsg -> Eff (Error WalletAPIError : effs) ()
forall a b. (a -> b) -> a -> b
$ UnbalancedTx -> TxBalanceMsg
BalancingUnbalancedTx UnbalancedTx
utx
        CardanoTx
txCTx <- UnbalancedTx -> Eff (Error WalletAPIError : effs) CardanoTx
forall (effs :: [* -> *]).
(Member NodeClientEffect effs, Member ChainIndexQueryEffect effs,
 Member (State WalletState) effs, Member (LogMsg TxBalanceMsg) effs,
 Member (Error WalletAPIError) effs) =>
UnbalancedTx -> Eff effs CardanoTx
handleBalance UnbalancedTx
utx
        TxBalanceMsg -> Eff (Error WalletAPIError : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo (TxBalanceMsg -> Eff (Error WalletAPIError : effs) ())
-> TxBalanceMsg -> Eff (Error WalletAPIError : effs) ()
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxBalanceMsg
FinishedBalancing CardanoTx
txCTx
        CardanoTx -> Eff (Error WalletAPIError : effs) CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure CardanoTx
txCTx

    walletAddSignatureH ::
        ( Member (State WalletState) effs
        , Member (LogMsg TxBalanceMsg) effs
        , Member (Error WalletAPIError) effs
        )
        => CardanoTx -> Eff effs CardanoTx
    walletAddSignatureH :: CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
txCTx = do
        TxBalanceMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo (TxBalanceMsg -> Eff effs ()) -> TxBalanceMsg -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxBalanceMsg
SigningTx CardanoTx
txCTx
        CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member (State WalletState) effs,
 Member (Error WalletAPIError) effs) =>
CardanoTx -> Eff effs CardanoTx
handleAddSignature CardanoTx
txCTx

    totalFundsH :: (Member (State WalletState) effs, Member ChainIndexQueryEffect effs) => Eff effs Value
    totalFundsH :: Eff effs Value
totalFundsH = (DecoratedTxOut -> Value) -> Map TxOutRef DecoratedTxOut -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Getting Value DecoratedTxOut Value -> DecoratedTxOut -> Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Value DecoratedTxOut Value
Lens' DecoratedTxOut Value
Ledger.decoratedTxOutValue) (Map TxOutRef DecoratedTxOut -> Value)
-> Eff effs (Map TxOutRef DecoratedTxOut) -> Eff effs Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Eff effs WalletState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get Eff effs WalletState
-> (WalletState -> Eff effs (Map TxOutRef DecoratedTxOut))
-> Eff effs (Map TxOutRef DecoratedTxOut)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WalletState -> Eff effs (Map TxOutRef DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
WalletState -> Eff effs (Map TxOutRef DecoratedTxOut)
ownOutputs)

    yieldUnbalancedTxH ::
        ( Member (Error WalletAPIError) effs
        , Member NodeClientEffect effs
        , Member ChainIndexQueryEffect effs
        , Member (State WalletState) effs
        , Member (LogMsg TxBalanceMsg) effs
        )
        => UnbalancedTx
        -> Eff effs ()
    yieldUnbalancedTxH :: UnbalancedTx -> Eff effs ()
yieldUnbalancedTxH UnbalancedTx
utx = do
        Either WalletAPIError CardanoTx
balancedTxM <- UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
(Member NodeClientEffect effs, Member ChainIndexQueryEffect effs,
 Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs) =>
UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH UnbalancedTx
utx
        case Either WalletAPIError CardanoTx
balancedTxM of
            Left WalletAPIError
err         -> WalletAPIError -> Eff effs ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError WalletAPIError
err
            Right CardanoTx
balancedTx -> CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs,
 Member (Error WalletAPIError) effs) =>
CardanoTx -> Eff effs CardanoTx
walletAddSignatureH CardanoTx
balancedTx Eff effs CardanoTx -> (CardanoTx -> Eff effs ()) -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CardanoTx -> Eff effs ()
forall (effs :: [* -> *]).
(Member NodeClientEffect effs,
 Member (LogMsg TxBalanceMsg) effs) =>
CardanoTx -> Eff effs ()
submitTxnH

handleBalance ::
    ( Member NodeClientEffect effs
    , Member ChainIndexQueryEffect effs
    , Member (State WalletState) effs
    , Member (LogMsg TxBalanceMsg) effs
    , Member (Error WalletAPIError) effs
    )
    => UnbalancedTx
    -> Eff effs CardanoTx
handleBalance :: UnbalancedTx -> Eff effs CardanoTx
handleBalance UnbalancedTx
utx = do
    params :: Params
params@Params { NetworkId
pNetworkId :: Params -> NetworkId
pNetworkId :: NetworkId
pNetworkId, PParams
emulatorPParams :: Params -> PParams
emulatorPParams :: PParams
emulatorPParams } <- Eff effs Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
    Map TxOutRef DecoratedTxOut
utxo <- Eff effs WalletState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get Eff effs WalletState
-> (WalletState -> Eff effs (Map TxOutRef DecoratedTxOut))
-> Eff effs (Map TxOutRef DecoratedTxOut)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WalletState -> Eff effs (Map TxOutRef DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
WalletState -> Eff effs (Map TxOutRef DecoratedTxOut)
ownOutputs
    Map TxOutRef TxOut
mappedUtxo <- (ToCardanoError -> Eff effs (Map TxOutRef TxOut))
-> (Map TxOutRef TxOut -> Eff effs (Map TxOutRef TxOut))
-> Either ToCardanoError (Map TxOutRef TxOut)
-> Eff effs (Map TxOutRef TxOut)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WalletAPIError -> Eff effs (Map TxOutRef TxOut)
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs (Map TxOutRef TxOut))
-> (ToCardanoError -> WalletAPIError)
-> ToCardanoError
-> Eff effs (Map TxOutRef TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> WalletAPIError
WAPI.ToCardanoError) Map TxOutRef TxOut -> Eff effs (Map TxOutRef TxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError (Map TxOutRef TxOut)
 -> Eff effs (Map TxOutRef TxOut))
-> Either ToCardanoError (Map TxOutRef TxOut)
-> Eff effs (Map TxOutRef TxOut)
forall a b. (a -> b) -> a -> b
$ (DecoratedTxOut -> Either ToCardanoError TxOut)
-> Map TxOutRef DecoratedTxOut
-> Either ToCardanoError (Map TxOutRef TxOut)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NetworkId -> DecoratedTxOut -> Either ToCardanoError TxOut
Tx.toTxOut NetworkId
pNetworkId) Map TxOutRef DecoratedTxOut
utxo
    let eitherTx :: Either CardanoBuildTx Tx
eitherTx = UnbalancedTx -> Either CardanoBuildTx Tx
U.unBalancedTxTx UnbalancedTx
utx
        requiredSigners :: [PaymentPubKeyHash]
requiredSigners = Set PaymentPubKeyHash -> [PaymentPubKeyHash]
forall a. Set a -> [a]
Set.toList (UnbalancedTx -> Set PaymentPubKeyHash
U.unBalancedTxRequiredSignatories UnbalancedTx
utx)
    CardanoBuildTx
unbalancedBodyContent <- (CardanoBuildTx -> Eff effs CardanoBuildTx)
-> (Tx -> Eff effs CardanoBuildTx)
-> Either CardanoBuildTx Tx
-> Eff effs CardanoBuildTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CardanoBuildTx -> Eff effs CardanoBuildTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError)
     CardanoBuildTx
-> Eff effs CardanoBuildTx
forall (effs :: [* -> *]) b.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) b
-> Eff effs b
handleError Either CardanoBuildTx Tx
eitherTx (Either
   (Either (ValidationPhase, ValidationError) ToCardanoError)
   CardanoBuildTx
 -> Eff effs CardanoBuildTx)
-> (Tx
    -> Either
         (Either (ValidationPhase, ValidationError) ToCardanoError)
         CardanoBuildTx)
-> Tx
-> Eff effs CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ToCardanoError
 -> Either (ValidationPhase, ValidationError) ToCardanoError)
-> Either ToCardanoError CardanoBuildTx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError)
     CardanoBuildTx
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ToCardanoError
-> Either (ValidationPhase, ValidationError) ToCardanoError
forall a b. b -> Either a b
Right (Either ToCardanoError CardanoBuildTx
 -> Either
      (Either (ValidationPhase, ValidationError) ToCardanoError)
      CardanoBuildTx)
-> (Tx -> Either ToCardanoError CardanoBuildTx)
-> Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError)
     CardanoBuildTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetworkId
-> PParams
-> [PaymentPubKeyHash]
-> Tx
-> Either ToCardanoError CardanoBuildTx
CardanoAPI.toCardanoTxBodyContent NetworkId
pNetworkId PParams
emulatorPParams [PaymentPubKeyHash]
requiredSigners) Either CardanoBuildTx Tx
eitherTx
    CardanoAddress
ownAddr <- (WalletState -> CardanoAddress) -> Eff effs CardanoAddress
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets WalletState -> CardanoAddress
ownAddress
    -- filter out inputs from utxo that are already in unBalancedTx
    let inputsOutRefs :: [TxOutRef]
inputsOutRefs = (TxIn -> TxOutRef) -> [TxIn] -> [TxOutRef]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> TxOutRef
Tx.txInRef ([TxIn] -> [TxOutRef]) -> [TxIn] -> [TxOutRef]
forall a b. (a -> b) -> a -> b
$ TxBodyContent BuildTx BabbageEra -> [TxIn]
forall ctx era. TxBodyContent ctx era -> [TxIn]
Tx.getTxBodyContentInputs (TxBodyContent BuildTx BabbageEra -> [TxIn])
-> TxBodyContent BuildTx BabbageEra -> [TxIn]
forall a b. (a -> b) -> a -> b
$ CardanoBuildTx -> TxBodyContent BuildTx BabbageEra
CardanoAPI.getCardanoBuildTx CardanoBuildTx
unbalancedBodyContent
        filteredUtxo :: Map TxOutRef TxOut
filteredUtxo = ((TxOutRef -> TxOut -> Bool)
 -> Map TxOutRef TxOut -> Map TxOutRef TxOut)
-> Map TxOutRef TxOut
-> (TxOutRef -> TxOut -> Bool)
-> Map TxOutRef TxOut
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TxOutRef -> TxOut -> Bool)
-> Map TxOutRef TxOut -> Map TxOutRef TxOut
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Map TxOutRef TxOut
mappedUtxo ((TxOutRef -> TxOut -> Bool) -> Map TxOutRef TxOut)
-> (TxOutRef -> TxOut -> Bool) -> Map TxOutRef TxOut
forall a b. (a -> b) -> a -> b
$ \TxOutRef
txOutRef TxOut
_ ->
            TxOutRef
txOutRef TxOutRef -> [TxOutRef] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [TxOutRef]
inputsOutRefs
    Tx BabbageEra
cTx <- Params
-> UtxoIndex
-> CardanoAddress
-> (Value -> Eff effs ([(TxOutRef, TxOut)], Value))
-> (forall a.
    Either (ValidationPhase, ValidationError) ToCardanoError
    -> Eff effs a)
-> CardanoBuildTx
-> Eff effs (Tx BabbageEra)
forall (m :: * -> *).
Monad m =>
Params
-> UtxoIndex
-> CardanoAddress
-> (Value -> m ([(TxOutRef, TxOut)], Value))
-> (forall a.
    Either (ValidationPhase, ValidationError) ToCardanoError -> m a)
-> CardanoBuildTx
-> m (Tx BabbageEra)
Fee.makeAutoBalancedTransactionWithUtxoProvider
        Params
params
        (Map TxOutRef TxOut -> UtxoIndex
UtxoIndex (Map TxOutRef TxOut -> UtxoIndex)
-> Map TxOutRef TxOut -> UtxoIndex
forall a b. (a -> b) -> a -> b
$ UnbalancedTx -> Map TxOutRef TxOut
U.unBalancedTxUtxoIndex UnbalancedTx
utx)
        CardanoAddress
ownAddr
        (Either CardanoBuildTx Tx
-> Either BalancingError ([(TxOutRef, TxOut)], Value)
-> Eff effs ([(TxOutRef, TxOut)], Value)
forall (effs :: [* -> *]) a.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
Either CardanoBuildTx Tx -> Either BalancingError a -> Eff effs a
handleBalancingError Either CardanoBuildTx Tx
eitherTx (Either BalancingError ([(TxOutRef, TxOut)], Value)
 -> Eff effs ([(TxOutRef, TxOut)], Value))
-> (Value -> Either BalancingError ([(TxOutRef, TxOut)], Value))
-> Value
-> Eff effs ([(TxOutRef, TxOut)], Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxOut
-> Value -> Either BalancingError ([(TxOutRef, TxOut)], Value)
Fee.utxoProviderFromWalletOutputs Map TxOutRef TxOut
filteredUtxo)
        (Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) a
-> Eff effs a
forall (effs :: [* -> *]) b.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) b
-> Eff effs b
handleError Either CardanoBuildTx Tx
eitherTx (Either
   (Either (ValidationPhase, ValidationError) ToCardanoError) a
 -> Eff effs a)
-> (Either (ValidationPhase, ValidationError) ToCardanoError
    -> Either
         (Either (ValidationPhase, ValidationError) ToCardanoError) a)
-> Either (ValidationPhase, ValidationError) ToCardanoError
-> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ValidationPhase, ValidationError) ToCardanoError
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) a
forall a b. a -> Either a b
Left)
        CardanoBuildTx
unbalancedBodyContent
    CardanoTx -> Eff effs CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx -> Eff effs CardanoTx)
-> CardanoTx -> Eff effs CardanoTx
forall a b. (a -> b) -> a -> b
$ SomeCardanoApiTx -> CardanoTx
Tx.CardanoApiTx (Tx BabbageEra -> SomeCardanoApiTx
Tx.CardanoApiEmulatorEraTx Tx BabbageEra
cTx)
    where
        handleError :: Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) b
-> Eff effs b
handleError Either CardanoBuildTx Tx
tx (Left (Left (ValidationPhase
ph, ValidationError
ve))) = do
            CardanoTx
tx' <- (ToCardanoError -> Eff effs CardanoTx)
-> (CardanoTx -> Eff effs CardanoTx)
-> Either ToCardanoError CardanoTx
-> Eff effs CardanoTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WalletAPIError -> Eff effs CardanoTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs CardanoTx)
-> (ToCardanoError -> WalletAPIError)
-> ToCardanoError
-> Eff effs CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> WalletAPIError
WAPI.ToCardanoError)
                           CardanoTx -> Eff effs CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                 (Either ToCardanoError CardanoTx -> Eff effs CardanoTx)
-> Either ToCardanoError CardanoTx -> Eff effs CardanoTx
forall a b. (a -> b) -> a -> b
$ (CardanoBuildTx -> Either ToCardanoError CardanoTx)
-> (Tx -> Either ToCardanoError CardanoTx)
-> Either CardanoBuildTx Tx
-> Either ToCardanoError CardanoTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((TxBody BabbageEra -> CardanoTx)
-> Either ToCardanoError (TxBody BabbageEra)
-> Either ToCardanoError CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SomeCardanoApiTx -> CardanoTx
Tx.CardanoApiTx (SomeCardanoApiTx -> CardanoTx)
-> (TxBody BabbageEra -> SomeCardanoApiTx)
-> TxBody BabbageEra
-> CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx BabbageEra -> SomeCardanoApiTx
Tx.CardanoApiEmulatorEraTx (Tx BabbageEra -> SomeCardanoApiTx)
-> (TxBody BabbageEra -> Tx BabbageEra)
-> TxBody BabbageEra
-> SomeCardanoApiTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
makeSignedTransaction [])
                          (Either ToCardanoError (TxBody BabbageEra)
 -> Either ToCardanoError CardanoTx)
-> (CardanoBuildTx -> Either ToCardanoError (TxBody BabbageEra))
-> CardanoBuildTx
-> Either ToCardanoError CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PParams
-> Map RdmrPtr ExUnits
-> CardanoBuildTx
-> Either ToCardanoError (TxBody BabbageEra)
CardanoAPI.makeTransactionBody Maybe PParams
forall a. Maybe a
Nothing Map RdmrPtr ExUnits
forall a. Monoid a => a
mempty)
                          (CardanoTx -> Either ToCardanoError CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx -> Either ToCardanoError CardanoTx)
-> (Tx -> CardanoTx) -> Tx -> Either ToCardanoError CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> CardanoTx
Tx.EmulatorTx)
                 (Either CardanoBuildTx Tx -> Either ToCardanoError CardanoTx)
-> Either CardanoBuildTx Tx -> Either ToCardanoError CardanoTx
forall a b. (a -> b) -> a -> b
$ Either CardanoBuildTx Tx
tx
            TxBalanceMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (TxBalanceMsg -> Eff effs ()) -> TxBalanceMsg -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ValidationPhase
-> TxId
-> CardanoTx
-> ValidationError
-> Value
-> [Text]
-> TxBalanceMsg
ValidationFailed ValidationPhase
ph (CardanoTx -> TxId
Ledger.getCardanoTxId CardanoTx
tx') CardanoTx
tx' ValidationError
ve Value
forall a. Monoid a => a
mempty []
            WalletAPIError -> Eff effs b
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs b) -> WalletAPIError -> Eff effs b
forall a b. (a -> b) -> a -> b
$ ValidationError -> WalletAPIError
WAPI.ValidationError ValidationError
ve
        handleError Either CardanoBuildTx Tx
_ (Left (Right ToCardanoError
ce)) = WalletAPIError -> Eff effs b
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs b) -> WalletAPIError -> Eff effs b
forall a b. (a -> b) -> a -> b
$ ToCardanoError -> WalletAPIError
WAPI.ToCardanoError ToCardanoError
ce
        handleError Either CardanoBuildTx Tx
_ (Right b
v) = b -> Eff effs b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
        handleBalancingError :: Either CardanoBuildTx Tx -> Either BalancingError a -> Eff effs a
handleBalancingError Either CardanoBuildTx Tx
_ (Left (Fee.InsufficientFunds Value
total Value
expected)) = WalletAPIError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs a) -> WalletAPIError -> Eff effs a
forall a b. (a -> b) -> a -> b
$ Text -> WalletAPIError
WAPI.InsufficientFunds
            (Text -> WalletAPIError) -> Text -> WalletAPIError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords
                [ Text
"Total:", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
total
                , Text
"expected:", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
expected ]
        handleBalancingError Either CardanoBuildTx Tx
tx (Left (Fee.CardanoLedgerError Either (ValidationPhase, ValidationError) ToCardanoError
e)) = Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) a
-> Eff effs a
forall (effs :: [* -> *]) b.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
Either CardanoBuildTx Tx
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) b
-> Eff effs b
handleError Either CardanoBuildTx Tx
tx (Either (ValidationPhase, ValidationError) ToCardanoError
-> Either
     (Either (ValidationPhase, ValidationError) ToCardanoError) a
forall a b. a -> Either a b
Left Either (ValidationPhase, ValidationError) ToCardanoError
e)
        handleBalancingError Either CardanoBuildTx Tx
_ (Right a
v) = a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v

handleAddSignature ::
    ( Member (State WalletState) effs
    , Member (Error WalletAPIError) effs
    )
    => CardanoTx
    -> Eff effs CardanoTx
handleAddSignature :: CardanoTx -> Eff effs CardanoTx
handleAddSignature CardanoTx
tx = do
    Maybe SigningProcess
msp <- (WalletState -> Maybe SigningProcess)
-> Eff effs (Maybe SigningProcess)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets WalletState -> Maybe SigningProcess
_signingProcess
    case Maybe SigningProcess
msp of
        Maybe SigningProcess
Nothing -> do
            PaymentPrivateKey XPrv
privKey <- (WalletState -> PaymentPrivateKey) -> Eff effs PaymentPrivateKey
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets WalletState -> PaymentPrivateKey
ownPaymentPrivateKey
            CardanoTx -> Eff effs CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CardanoTx -> Eff effs CardanoTx)
-> CardanoTx -> Eff effs CardanoTx
forall a b. (a -> b) -> a -> b
$ XPrv -> CardanoTx -> CardanoTx
Tx.addCardanoTxSignature XPrv
privKey CardanoTx
tx
        Just (SigningProcess forall (effs :: [* -> *]).
Member (Error WalletAPIError) effs =>
[PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx
sp) -> do
            let ctx :: Tx BabbageEra
ctx = case CardanoTx
tx of
                    Tx.CardanoApiTx (Tx.CardanoApiEmulatorEraTx Tx BabbageEra
ctx') -> Tx BabbageEra
ctx'
                    CardanoTx
_ -> String -> Tx BabbageEra
forall a. HasCallStack => String -> a
error String
"handleAddSignature: Need a Cardano API Tx from the Alonzo era to get the required signers"
                reqSigners :: [PaymentPubKeyHash]
reqSigners = Tx BabbageEra -> [PaymentPubKeyHash]
getRequiredSigners Tx BabbageEra
ctx
            [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
Member (Error WalletAPIError) effs =>
[PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx
sp [PaymentPubKeyHash]
reqSigners CardanoTx
tx

ownOutputs :: forall effs.
    ( Member ChainIndexQueryEffect effs
    )
    => WalletState
    -> Eff effs (Map.Map TxOutRef DecoratedTxOut)
ownOutputs :: WalletState -> Eff effs (Map TxOutRef DecoratedTxOut)
ownOutputs WalletState{MockWallet
_mockWallet :: MockWallet
_mockWallet :: WalletState -> MockWallet
_mockWallet} = do
    [TxOutRef]
refs <- Maybe (PageQuery TxOutRef) -> Eff effs [TxOutRef]
allUtxoSet (PageQuery TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. a -> Maybe a
Just PageQuery TxOutRef
forall a. Default a => a
def)
    [(TxOutRef, DecoratedTxOut)] -> Map TxOutRef DecoratedTxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, DecoratedTxOut)] -> Map TxOutRef DecoratedTxOut)
-> ([Maybe (TxOutRef, DecoratedTxOut)]
    -> [(TxOutRef, DecoratedTxOut)])
-> [Maybe (TxOutRef, DecoratedTxOut)]
-> Map TxOutRef DecoratedTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (TxOutRef, DecoratedTxOut)] -> [(TxOutRef, DecoratedTxOut)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (TxOutRef, DecoratedTxOut)] -> Map TxOutRef DecoratedTxOut)
-> Eff effs [Maybe (TxOutRef, DecoratedTxOut)]
-> Eff effs (Map TxOutRef DecoratedTxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxOutRef -> Eff effs (Maybe (TxOutRef, DecoratedTxOut)))
-> [TxOutRef] -> Eff effs [Maybe (TxOutRef, DecoratedTxOut)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TxOutRef -> Eff effs (Maybe (TxOutRef, DecoratedTxOut))
txOutRefTxOutFromRef [TxOutRef]
refs
  where
    addr :: CardanoAddress
    addr :: CardanoAddress
addr = MockWallet -> CardanoAddress
CW.mockWalletAddress MockWallet
_mockWallet

    -- Accumulate all unspent 'TxOutRef's from the resulting pages.
    allUtxoSet :: Maybe (PageQuery TxOutRef) -> Eff effs [TxOutRef]
    allUtxoSet :: Maybe (PageQuery TxOutRef) -> Eff effs [TxOutRef]
allUtxoSet Maybe (PageQuery TxOutRef)
Nothing = [TxOutRef] -> Eff effs [TxOutRef]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    allUtxoSet (Just PageQuery TxOutRef
pq) = do
      Page TxOutRef
refPage <- UtxosResponse -> Page TxOutRef
page (UtxosResponse -> Page TxOutRef)
-> Eff effs UtxosResponse -> Eff effs (Page TxOutRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
ChainIndex.utxoSetAtAddress PageQuery TxOutRef
pq (CardanoAddress -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential CardanoAddress
addr)
      [TxOutRef]
nextItems <- Maybe (PageQuery TxOutRef) -> Eff effs [TxOutRef]
allUtxoSet (Page TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. Page a -> Maybe (PageQuery a)
ChainIndex.nextPageQuery Page TxOutRef
refPage)
      [TxOutRef] -> Eff effs [TxOutRef]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TxOutRef] -> Eff effs [TxOutRef])
-> [TxOutRef] -> Eff effs [TxOutRef]
forall a b. (a -> b) -> a -> b
$ Page TxOutRef -> [TxOutRef]
forall a. Page a -> [a]
ChainIndex.pageItems Page TxOutRef
refPage [TxOutRef] -> [TxOutRef] -> [TxOutRef]
forall a. [a] -> [a] -> [a]
++ [TxOutRef]
nextItems

    txOutRefTxOutFromRef :: TxOutRef -> Eff effs (Maybe (TxOutRef, DecoratedTxOut))
    txOutRefTxOutFromRef :: TxOutRef -> Eff effs (Maybe (TxOutRef, DecoratedTxOut))
txOutRefTxOutFromRef TxOutRef
ref = (DecoratedTxOut -> (TxOutRef, DecoratedTxOut))
-> Maybe DecoratedTxOut -> Maybe (TxOutRef, DecoratedTxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutRef
ref,) (Maybe DecoratedTxOut -> Maybe (TxOutRef, DecoratedTxOut))
-> Eff effs (Maybe DecoratedTxOut)
-> Eff effs (Maybe (TxOutRef, DecoratedTxOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
ChainIndex.unspentTxOutFromRef TxOutRef
ref

-- | The default signing process is 'signWallet'
defaultSigningProcess :: MockWallet -> SigningProcess
defaultSigningProcess :: MockWallet -> SigningProcess
defaultSigningProcess = MockWallet -> SigningProcess
signWallet

signWithPrivateKey :: PaymentPrivateKey -> SigningProcess
signWithPrivateKey :: PaymentPrivateKey -> SigningProcess
signWithPrivateKey PaymentPrivateKey
pk = (forall (effs :: [* -> *]).
 Member (Error WalletAPIError) effs =>
 [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
-> SigningProcess
SigningProcess ((forall (effs :: [* -> *]).
  Member (Error WalletAPIError) effs =>
  [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
 -> SigningProcess)
-> (forall (effs :: [* -> *]).
    Member (Error WalletAPIError) effs =>
    [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
-> SigningProcess
forall a b. (a -> b) -> a -> b
$
    \[PaymentPubKeyHash]
pks CardanoTx
tx -> (CardanoTx -> PaymentPubKeyHash -> Eff effs CardanoTx)
-> CardanoTx -> [PaymentPubKeyHash] -> Eff effs CardanoTx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (PaymentPrivateKey
-> CardanoTx -> PaymentPubKeyHash -> Eff effs CardanoTx
forall (r :: [* -> *]).
Member (Error WalletAPIError) r =>
PaymentPrivateKey
-> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
signTxWithPrivateKey PaymentPrivateKey
pk) CardanoTx
tx [PaymentPubKeyHash]
pks

-- | Sign the transaction by calling 'WAPI.signTxnWithKey' (throwing a
--   'PrivateKeyNotFound' error if called with a key other than the
--   wallet's private key)
signWallet :: MockWallet -> SigningProcess
signWallet :: MockWallet -> SigningProcess
signWallet MockWallet
wllt = (forall (effs :: [* -> *]).
 Member (Error WalletAPIError) effs =>
 [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
-> SigningProcess
SigningProcess ((forall (effs :: [* -> *]).
  Member (Error WalletAPIError) effs =>
  [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
 -> SigningProcess)
-> (forall (effs :: [* -> *]).
    Member (Error WalletAPIError) effs =>
    [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
-> SigningProcess
forall a b. (a -> b) -> a -> b
$
    \[PaymentPubKeyHash]
pks CardanoTx
tx -> (CardanoTx -> PaymentPubKeyHash -> Eff effs CardanoTx)
-> CardanoTx -> [PaymentPubKeyHash] -> Eff effs CardanoTx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (MockWallet -> CardanoTx -> PaymentPubKeyHash -> Eff effs CardanoTx
forall (r :: [* -> *]).
Member (Error WalletAPIError) r =>
MockWallet -> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
signTxnWithKey MockWallet
wllt) CardanoTx
tx [PaymentPubKeyHash]
pks

-- | Sign the transaction with the private key of the mock wallet.
signTxnWithKey
    :: (Member (Error WAPI.WalletAPIError) r)
    => MockWallet
    -> CardanoTx
    -> PaymentPubKeyHash
    -> Eff r CardanoTx
signTxnWithKey :: MockWallet -> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
signTxnWithKey MockWallet
mw = PaymentPrivateKey
-> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
forall (r :: [* -> *]).
Member (Error WalletAPIError) r =>
PaymentPrivateKey
-> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
signTxWithPrivateKey (MockWallet -> PaymentPrivateKey
CW.paymentPrivateKey MockWallet
mw)

-- | Sign the transaction with the private key, if the hash is that of the
--   private key.
signTxWithPrivateKey
    :: (Member (Error WAPI.WalletAPIError) r)
    => PaymentPrivateKey
    -> CardanoTx
    -> PaymentPubKeyHash
    -> Eff r CardanoTx
signTxWithPrivateKey :: PaymentPrivateKey
-> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
signTxWithPrivateKey (PaymentPrivateKey XPrv
pk) CardanoTx
tx pkh :: PaymentPubKeyHash
pkh@(PaymentPubKeyHash PubKeyHash
pubK) = do
    let ownPaymentPubKey :: PubKey
ownPaymentPubKey = XPrv -> PubKey
Ledger.toPublicKey XPrv
pk
    if PubKey -> PubKeyHash
Ledger.pubKeyHash PubKey
ownPaymentPubKey PubKeyHash -> PubKeyHash -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyHash
pubK
    then CardanoTx -> Eff r CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> CardanoTx -> CardanoTx
Tx.addCardanoTxSignature XPrv
pk CardanoTx
tx)
    else WalletAPIError -> Eff r CardanoTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (PaymentPubKeyHash -> WalletAPIError
WAPI.PaymentPrivateKeyNotFound PaymentPubKeyHash
pkh)

-- | Sign the transaction with the given private keys,
--   ignoring the list of public keys that the 'SigningProcess' is passed.
signPrivateKeys :: [PaymentPrivateKey] -> SigningProcess
signPrivateKeys :: [PaymentPrivateKey] -> SigningProcess
signPrivateKeys [PaymentPrivateKey]
signingKeys = (forall (effs :: [* -> *]).
 Member (Error WalletAPIError) effs =>
 [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
-> SigningProcess
SigningProcess ((forall (effs :: [* -> *]).
  Member (Error WalletAPIError) effs =>
  [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
 -> SigningProcess)
-> (forall (effs :: [* -> *]).
    Member (Error WalletAPIError) effs =>
    [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx)
-> SigningProcess
forall a b. (a -> b) -> a -> b
$ \[PaymentPubKeyHash]
_ CardanoTx
tx ->
    CardanoTx -> Eff effs CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PaymentPrivateKey -> CardanoTx -> CardanoTx)
-> CardanoTx -> [PaymentPrivateKey] -> CardanoTx
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (XPrv -> CardanoTx -> CardanoTx
Tx.addCardanoTxSignature (XPrv -> CardanoTx -> CardanoTx)
-> (PaymentPrivateKey -> XPrv)
-> PaymentPrivateKey
-> CardanoTx
-> CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaymentPrivateKey -> XPrv
unPaymentPrivateKey) CardanoTx
tx [PaymentPrivateKey]
signingKeys)

data SigningProcessControlEffect r where
    SetSigningProcess :: Maybe SigningProcess -> SigningProcessControlEffect ()
makeEffect ''SigningProcessControlEffect

type SigningProcessEffs = '[State (Maybe SigningProcess), Error WAPI.WalletAPIError]

handleSigningProcessControl :: (Members SigningProcessEffs effs) => Eff (SigningProcessControlEffect ': effs) ~> Eff effs
handleSigningProcessControl :: Eff (SigningProcessControlEffect : effs) ~> Eff effs
handleSigningProcessControl = (SigningProcessControlEffect ~> Eff effs)
-> Eff (SigningProcessControlEffect : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((SigningProcessControlEffect ~> Eff effs)
 -> Eff (SigningProcessControlEffect : effs) ~> Eff effs)
-> (SigningProcessControlEffect ~> Eff effs)
-> Eff (SigningProcessControlEffect : effs) ~> Eff effs
forall a b. (a -> b) -> a -> b
$ \case
    SetSigningProcess proc -> Maybe SigningProcess -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put Maybe SigningProcess
proc

-- | An Entity is a thing that can hold 'Value'. Used in the 'balances'
-- function to compute who holds for a given chain state and set of wallets.
data Entity
  = WalletEntity Wallet
  | PubKeyHashEntity PubKeyHash
  | ScriptEntity ValidatorHash
  deriving (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity
-> (Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmax :: Entity -> Entity -> Entity
>= :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c< :: Entity -> Entity -> Bool
compare :: Entity -> Entity -> Ordering
$ccompare :: Entity -> Entity -> Ordering
$cp1Ord :: Eq Entity
Ord)

instance Show Entity where
  show :: Entity -> String
show (WalletEntity Wallet
w)     = Wallet -> String
forall a. Show a => a -> String
show Wallet
w
  show (ScriptEntity ValidatorHash
h)     = String
"Script " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ValidatorHash -> String
forall a. Show a => a -> String
show ValidatorHash
h
  show (PubKeyHashEntity PubKeyHash
h) = String
"PubKeyHash " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PubKeyHash -> String
forall a. Show a => a -> String
show PubKeyHash
h

type WalletSet = Map.Map Wallet WalletState

-- | Pick out all the public keys from the set of wallets and map them back to
-- their corresponding wallets.
walletPaymentPubKeyHashes :: WalletSet -> Map.Map PaymentPubKeyHash Wallet
walletPaymentPubKeyHashes :: WalletSet -> Map PaymentPubKeyHash Wallet
walletPaymentPubKeyHashes = (Map PaymentPubKeyHash Wallet
 -> (Wallet, WalletState) -> Map PaymentPubKeyHash Wallet)
-> Map PaymentPubKeyHash Wallet
-> [(Wallet, WalletState)]
-> Map PaymentPubKeyHash Wallet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map PaymentPubKeyHash Wallet
-> (Wallet, WalletState) -> Map PaymentPubKeyHash Wallet
forall a.
Map PaymentPubKeyHash a
-> (a, WalletState) -> Map PaymentPubKeyHash a
f Map PaymentPubKeyHash Wallet
forall k a. Map k a
Map.empty ([(Wallet, WalletState)] -> Map PaymentPubKeyHash Wallet)
-> (WalletSet -> [(Wallet, WalletState)])
-> WalletSet
-> Map PaymentPubKeyHash Wallet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletSet -> [(Wallet, WalletState)]
forall k a. Map k a -> [(k, a)]
Map.toList
  where
    f :: Map PaymentPubKeyHash a
-> (a, WalletState) -> Map PaymentPubKeyHash a
f Map PaymentPubKeyHash a
m (a
w, WalletState
ws) = PaymentPubKeyHash
-> a -> Map PaymentPubKeyHash a -> Map PaymentPubKeyHash a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (MockWallet -> PaymentPubKeyHash
CW.paymentPubKeyHash (MockWallet -> PaymentPubKeyHash)
-> MockWallet -> PaymentPubKeyHash
forall a b. (a -> b) -> a -> b
$ WalletState -> MockWallet
_mockWallet WalletState
ws) a
w Map PaymentPubKeyHash a
m

-- | For a set of wallets, convert them into a map of value: entity,
-- where entity is one of 'Entity'.
balances :: ChainState -> WalletSet -> Map.Map Entity Value
balances :: ChainState -> WalletSet -> Map Entity Value
balances ChainState
state WalletSet
wallets = (Map Entity Value -> TxOut -> Map Entity Value)
-> Map Entity Value -> Map TxOutRef TxOut -> Map Entity Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Entity Value -> TxOut -> Map Entity Value
f Map Entity Value
forall k a. Map k a
Map.empty (Map TxOutRef TxOut -> Map Entity Value)
-> (ChainState -> Map TxOutRef TxOut)
-> ChainState
-> Map Entity Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxOutRef TxOut
getIndex (UtxoIndex -> Map TxOutRef TxOut)
-> (ChainState -> UtxoIndex) -> ChainState -> Map TxOutRef TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainState -> UtxoIndex
_index (ChainState -> Map Entity Value) -> ChainState -> Map Entity Value
forall a b. (a -> b) -> a -> b
$ ChainState
state
  where
    toEntity :: CardanoAddress -> Entity
    toEntity :: CardanoAddress -> Entity
toEntity CardanoAddress
a =
        case CardanoAddress -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential CardanoAddress
a of
            PubKeyCredential PubKeyHash
h ->
                case PaymentPubKeyHash -> Map PaymentPubKeyHash Wallet -> Maybe Wallet
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PubKeyHash -> PaymentPubKeyHash
PaymentPubKeyHash PubKeyHash
h) Map PaymentPubKeyHash Wallet
ws of
                    Maybe Wallet
Nothing -> PubKeyHash -> Entity
PubKeyHashEntity PubKeyHash
h
                    Just Wallet
w  -> Wallet -> Entity
WalletEntity Wallet
w
            ScriptCredential ValidatorHash
h -> ValidatorHash -> Entity
ScriptEntity ValidatorHash
h

    ws :: Map.Map PaymentPubKeyHash Wallet
    ws :: Map PaymentPubKeyHash Wallet
ws = WalletSet -> Map PaymentPubKeyHash Wallet
walletPaymentPubKeyHashes WalletSet
wallets

    f :: Map Entity Value -> TxOut -> Map Entity Value
f Map Entity Value
m TxOut
o = (Value -> Value -> Value)
-> Entity -> Value -> Map Entity Value -> Map Entity Value
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
(<>) (CardanoAddress -> Entity
toEntity (CardanoAddress -> Entity) -> CardanoAddress -> Entity
forall a b. (a -> b) -> a -> b
$ TxOut -> CardanoAddress
Ledger.txOutAddress TxOut
o) (TxOut -> Value
Ledger.txOutValue TxOut
o) Map Entity Value
m