{-# 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 qualified as C
import Cardano.Node.Emulator.Internal.Node (BalancingError (CardanoLedgerError, InsufficientFunds), ChainState,
                                            Params (..), index, makeAutoBalancedTransactionWithUtxoProvider,
                                            utxoProviderFromWalletOutputs)
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 Crypto.Hash qualified as Crypto
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), ToJSONKey)
import Data.Aeson qualified as Aeson
import Data.Bifunctor (first)
import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase)
import Data.ByteString (ByteString)
import Data.Data (Data)
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 (fromMaybe)
import Data.String (IsString (fromString))
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import GHC.Generics (Generic)
import Ledger (CardanoTx, PubKeyHash, UtxoIndex)
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.Credential (Credential (PubKeyCredential, ScriptCredential))
import Ledger.Tx qualified as Tx
import Ledger.Tx.CardanoAPI (fromCardanoValue, getRequiredSigners)
import Ledger.Tx.CardanoAPI qualified as CardanoAPI
import Ledger.Tx.Constraints.OffChain (UnbalancedTx)
import Ledger.Tx.Constraints.OffChain qualified as U
import Plutus.ChainIndex qualified as ChainIndex
import Plutus.ChainIndex.Api (collectQueryResponse)
import Plutus.ChainIndex.Emulator (ChainIndexEmulatorState, ChainIndexQueryEffect)
import Plutus.Contract.Checkpoint (CheckpointLogMsg)
import Plutus.V1.Ledger.Api (ValidatorHash, Value)
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
. Digest Blake2b_160 -> WalletId
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
"]"

newtype WalletId = WalletId { WalletId -> Digest Blake2b_160
unWalletId :: Crypto.Digest Crypto.Blake2b_160 }
    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)
$cWalletId :: Constr
$tWalletId :: 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

toBase16 :: WalletId -> T.Text
toBase16 :: WalletId -> Text
toBase16 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (WalletId -> ByteString) -> WalletId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> Digest Blake2b_160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16 (Digest Blake2b_160 -> ByteString)
-> (WalletId -> Digest Blake2b_160) -> WalletId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletId -> Digest Blake2b_160
unWalletId

fromBase16 :: T.Text -> Either String WalletId
fromBase16 :: Text -> Either String WalletId
fromBase16 Text
s = Either String WalletId
-> (Digest Blake2b_160 -> Either String WalletId)
-> Maybe (Digest Blake2b_160)
-> Either String WalletId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String WalletId
forall a b. a -> Either a b
Left (String -> Either String WalletId)
-> String -> Either String WalletId
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
s) (WalletId -> Either String WalletId
forall a b. b -> Either a b
Right (WalletId -> Either String WalletId)
-> (Digest Blake2b_160 -> WalletId)
-> Digest Blake2b_160
-> Either String WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest Blake2b_160 -> WalletId
WalletId)
    (Text -> Maybe ByteString
decodeHex Text
s Maybe ByteString
-> (ByteString -> Maybe (Digest Blake2b_160))
-> Maybe (Digest Blake2b_160)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HashAlgorithm Blake2b_160, ByteArrayAccess ByteString) =>
ByteString -> Maybe (Digest Blake2b_160)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
Crypto.digestFromByteString @_ @ByteString)
    where
    decodeHex :: Text -> Maybe ByteString
decodeHex = (String -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either String ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> String -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either String ByteString -> Maybe ByteString)
-> (Text -> Either String ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16 (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

-- | 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
. Digest Blake2b_160 -> WalletId
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,
 Member (Error WalletAPIError) effs,
 Member NodeClientEffect 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 utx :: UnbalancedTx
utx@(U.UnbalancedCardanoTx CardanoBuildTx
tx UtxoIndex
utxo) = 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
$ CardanoBuildTx -> UtxoIndex -> TxBalanceMsg
BalancingUnbalancedTx CardanoBuildTx
tx UtxoIndex
utxo
        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
        , Member (Error WalletAPIError) effs
        , Member NodeClientEffect effs
        )
        => Eff effs Value
    totalFundsH :: Eff effs Value
totalFundsH = Value -> Value
fromCardanoValue (Value -> Value) -> (UtxoIndex -> Value) -> UtxoIndex -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxUTxO BabbageEra -> Value)
-> Map TxIn (TxOut CtxUTxO BabbageEra) -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxUTxO BabbageEra -> Value
forall ctx era. TxOut ctx era -> Value
Tx.cardanoTxOutValue (Map TxIn (TxOut CtxUTxO BabbageEra) -> Value)
-> (UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra))
-> UtxoIndex
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
C.unUTxO (UtxoIndex -> Value) -> Eff effs UtxoIndex -> Eff effs Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff effs UtxoIndex
forall (effs :: [* -> *]).
(Member ChainIndexQueryEffect effs,
 Member (State WalletState) effs, Member NodeClientEffect effs,
 Member (Error WalletAPIError) effs) =>
Eff effs UtxoIndex
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 <- Eff effs Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
    UtxoIndex
utxo <- Eff effs UtxoIndex
forall (effs :: [* -> *]).
(Member ChainIndexQueryEffect effs,
 Member (State WalletState) effs, Member NodeClientEffect effs,
 Member (Error WalletAPIError) effs) =>
Eff effs UtxoIndex
ownOutputs
    let unbalancedBodyContent :: CardanoBuildTx
unbalancedBodyContent = UnbalancedTx -> CardanoBuildTx
U.unBalancedCardanoBuildTx UnbalancedTx
utx
    CardanoAddress
ownAddr <- (WalletState -> CardanoAddress) -> Eff effs CardanoAddress
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets WalletState -> CardanoAddress
ownAddress
    Tx BabbageEra
cTx <- Params
-> UtxoIndex
-> CardanoAddress
-> UtxoProvider (Eff effs)
-> (forall a. CardanoLedgerError -> Eff effs a)
-> CardanoBuildTx
-> Eff effs (Tx BabbageEra)
forall (m :: * -> *).
Monad m =>
Params
-> UtxoIndex
-> CardanoAddress
-> UtxoProvider m
-> (forall a. CardanoLedgerError -> m a)
-> CardanoBuildTx
-> m (Tx BabbageEra)
makeAutoBalancedTransactionWithUtxoProvider
        Params
params
        (UnbalancedTx -> UtxoIndex
U.unBalancedTxUtxoIndex UnbalancedTx
utx)
        CardanoAddress
ownAddr
        (UnbalancedTx
-> Either BalancingError (UtxoIndex, Value)
-> Eff effs (UtxoIndex, Value)
forall (effs :: [* -> *]) a.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
UnbalancedTx -> Either BalancingError a -> Eff effs a
handleBalancingError UnbalancedTx
utx (Either BalancingError (UtxoIndex, Value)
 -> Eff effs (UtxoIndex, Value))
-> (Value -> Either BalancingError (UtxoIndex, Value))
-> UtxoProvider (Eff effs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex
-> CardanoBuildTx
-> Value
-> Either BalancingError (UtxoIndex, Value)
utxoProviderFromWalletOutputs UtxoIndex
utxo CardanoBuildTx
unbalancedBodyContent)
        (UnbalancedTx -> Either CardanoLedgerError a -> Eff effs a
forall (effs :: [* -> *]) b.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
UnbalancedTx -> Either CardanoLedgerError b -> Eff effs b
handleError UnbalancedTx
utx (Either CardanoLedgerError a -> Eff effs a)
-> (CardanoLedgerError -> Either CardanoLedgerError a)
-> CardanoLedgerError
-> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoLedgerError -> Either CardanoLedgerError 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
$ Tx BabbageEra -> CardanoTx
Tx.CardanoEmulatorEraTx Tx BabbageEra
cTx
    where
        handleError :: UnbalancedTx -> Either CardanoLedgerError b -> Eff effs b
handleError UnbalancedTx
utx' (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
$ (TxBody BabbageEra -> CardanoTx)
-> Either ToCardanoError (TxBody BabbageEra)
-> Either ToCardanoError CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Tx BabbageEra -> CardanoTx
Tx.CardanoEmulatorEraTx (Tx BabbageEra -> CardanoTx)
-> (TxBody BabbageEra -> Tx BabbageEra)
-> TxBody BabbageEra
-> CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyWitness BabbageEra] -> TxBody BabbageEra -> Tx BabbageEra
forall era. [KeyWitness era] -> TxBody era -> Tx era
C.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 (BabbageEra StandardCrypto))
-> Map RdmrPtr ExUnits
-> CardanoBuildTx
-> Either ToCardanoError (TxBody BabbageEra)
CardanoAPI.makeTransactionBody Maybe (PParams (BabbageEra StandardCrypto))
forall a. Maybe a
Nothing Map RdmrPtr ExUnits
forall a. Monoid a => a
mempty
                 (CardanoBuildTx -> Either ToCardanoError CardanoTx)
-> CardanoBuildTx -> Either ToCardanoError CardanoTx
forall a b. (a -> b) -> a -> b
$ UnbalancedTx -> CardanoBuildTx
U.unBalancedCardanoBuildTx UnbalancedTx
utx'
            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
-> CardanoTx -> ValidationError -> Value -> TxBalanceMsg
ValidationFailed ValidationPhase
ph 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 UnbalancedTx
_ (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 UnbalancedTx
_ (Right b
v) = b -> Eff effs b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
        handleBalancingError :: UnbalancedTx -> Either BalancingError a -> Eff effs a
handleBalancingError UnbalancedTx
_ (Left (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 UnbalancedTx
utx' (Left (CardanoLedgerError CardanoLedgerError
e)) = UnbalancedTx -> Either CardanoLedgerError a -> Eff effs a
forall (effs :: [* -> *]) b.
(FindElem (Error WalletAPIError) effs,
 FindElem (LogMsg TxBalanceMsg) effs) =>
UnbalancedTx -> Either CardanoLedgerError b -> Eff effs b
handleError UnbalancedTx
utx' (CardanoLedgerError -> Either CardanoLedgerError a
forall a b. a -> Either a b
Left CardanoLedgerError
e)
        handleBalancingError UnbalancedTx
_ (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 tx :: CardanoTx
tx@(Tx.CardanoEmulatorEraTx Tx BabbageEra
ctx) = 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 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
    , Member (State WalletState) effs
    , Member NodeClientEffect effs
    , Member (Error WalletAPIError) effs
    )
    => Eff effs UtxoIndex
ownOutputs :: Eff effs UtxoIndex
ownOutputs = do
    WalletState{MockWallet
_mockWallet :: MockWallet
_mockWallet :: WalletState -> MockWallet
_mockWallet} <- Eff effs WalletState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
    Params { NetworkId
pNetworkId :: Params -> NetworkId
pNetworkId :: NetworkId
pNetworkId } <- Eff effs Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
    [(TxOutRef, DecoratedTxOut)]
pairs <- [[(TxOutRef, DecoratedTxOut)]] -> [(TxOutRef, DecoratedTxOut)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(TxOutRef, DecoratedTxOut)]] -> [(TxOutRef, DecoratedTxOut)])
-> Eff effs [[(TxOutRef, DecoratedTxOut)]]
-> Eff effs [(TxOutRef, DecoratedTxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PageQuery TxOutRef
 -> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)]))
-> Eff effs [[(TxOutRef, DecoratedTxOut)]]
forall (m :: * -> *) a.
Monad m =>
(PageQuery TxOutRef -> m (QueryResponse a)) -> m [a]
collectQueryResponse (\PageQuery TxOutRef
pq -> PageQuery TxOutRef
-> CardanoAddress
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef
-> CardanoAddress
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
ChainIndex.unspentTxOutSetAtAddress PageQuery TxOutRef
pq (CardanoAddress
 -> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)]))
-> CardanoAddress
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall a b. (a -> b) -> a -> b
$ MockWallet -> CardanoAddress
CW.mockWalletAddress MockWallet
_mockWallet)
    (ToCardanoError -> Eff effs UtxoIndex)
-> (UtxoIndex -> Eff effs UtxoIndex)
-> Either ToCardanoError UtxoIndex
-> Eff effs UtxoIndex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WalletAPIError -> Eff effs UtxoIndex
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs UtxoIndex)
-> (ToCardanoError -> WalletAPIError)
-> ToCardanoError
-> Eff effs UtxoIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> WalletAPIError
WAPI.ToCardanoError) UtxoIndex -> Eff effs UtxoIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError UtxoIndex -> Eff effs UtxoIndex)
-> Either ToCardanoError UtxoIndex -> Eff effs UtxoIndex
forall a b. (a -> b) -> a -> b
$ NetworkId
-> Map TxOutRef DecoratedTxOut -> Either ToCardanoError UtxoIndex
Tx.fromDecoratedIndex NetworkId
pNetworkId ([(TxOutRef, DecoratedTxOut)] -> Map TxOutRef DecoratedTxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TxOutRef, DecoratedTxOut)]
pairs)


-- | 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 C.Value
balances :: ChainState -> WalletSet -> Map Entity Value
balances ChainState
state WalletSet
wallets = (Map Entity Value -> TxOut CtxUTxO BabbageEra -> Map Entity Value)
-> Map Entity Value
-> Map TxIn (TxOut CtxUTxO BabbageEra)
-> Map Entity Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Entity Value -> TxOut CtxUTxO BabbageEra -> Map Entity Value
forall ctx.
Map Entity Value -> TxOut ctx BabbageEra -> Map Entity Value
f Map Entity Value
forall k a. Map k a
Map.empty (Map TxIn (TxOut CtxUTxO BabbageEra) -> Map Entity Value)
-> (ChainState -> Map TxIn (TxOut CtxUTxO BabbageEra))
-> ChainState
-> Map Entity Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
C.unUTxO (UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra))
-> (ChainState -> UtxoIndex)
-> ChainState
-> Map TxIn (TxOut CtxUTxO BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UtxoIndex ChainState UtxoIndex -> ChainState -> UtxoIndex
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UtxoIndex ChainState UtxoIndex
Lens' 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 ctx BabbageEra -> Map Entity Value
f Map Entity Value
m (C.TxOut CardanoAddress
aie TxOutValue BabbageEra
tov TxOutDatum ctx BabbageEra
_tod ReferenceScript BabbageEra
_rs) = (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
aie) (TxOutValue BabbageEra -> Value
forall era. TxOutValue era -> Value
C.txOutValueToValue TxOutValue BabbageEra
tov) Map Entity Value
m