{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}

{-|

Mock wallet implementation

-}
module Wallet.API(
    WalletEffect,
    submitTxn,
    ownPaymentPubKeyHash,
    ownPaymentPubKeyHashes,
    ownFirstPaymentPubKeyHash,
    ownAddresses,
    balanceTx,
    yieldUnbalancedTx,
    NodeClientEffect,
    publishTx,
    getClientSlot,
    getClientParams,
    PubKey(..),
    PubKeyHash(..),
    signTxAndSubmit,
    signTxAndSubmit_,
    payToAddress,
    payToAddress_,
    payToPaymentPublicKeyHash,
    payToPaymentPublicKeyHash_,
    Params(..),
    -- * Slot ranges
    Interval(..),
    Slot,
    SlotRange,
    width,
    defaultSlotRange,
    interval,
    singleton,
    isEmpty,
    always,
    member,
    before,
    after,
    contains,
    -- * Error handling
    Wallet.Error.WalletAPIError(..),
    Wallet.Error.throwInsufficientFundsError,
    Wallet.Error.throwOtherError,
    ) where

import Cardano.Node.Emulator.Internal.Node.Params (Params (..))
import Control.Monad (unless, void)
import Control.Monad.Freer (Eff, Member)
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logWarn)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Void (Void)
import Ledger (Address, CardanoTx, Interval (Interval, ivFrom, ivTo), PaymentPubKeyHash (PaymentPubKeyHash),
               PubKey (PubKey, getPubKey), PubKeyHash (PubKeyHash, getPubKeyHash), Slot, SlotRange, after, always,
               before, cardanoPubKeyHash, contains, interval, isEmpty, member, pubKeyHashAddress, singleton, width)
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Tx.Constraints.OffChain (adjustUnbalancedTx)
import Ledger.Tx.Constraints.ValidityInterval qualified as Interval
import Plutus.V1.Ledger.Value (Value)
import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientParams, getClientSlot, ownAddresses,
                       publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx)
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg (AdjustingUnbalancedTx))
import Wallet.Error (WalletAPIError (NoPaymentPubKeyHashError, PaymentMkTxError, ToCardanoError))
import Wallet.Error qualified

{-# DEPRECATED ownPaymentPubKeyHash "Use ownFirstPaymentPubKeyHash, ownPaymentPubKeyHashes or ownAddresses instead" #-}

ownPaymentPubKeyHash ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    )
    => Eff effs PaymentPubKeyHash
ownPaymentPubKeyHash :: Eff effs PaymentPubKeyHash
ownPaymentPubKeyHash = Eff effs PaymentPubKeyHash
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs) =>
Eff effs PaymentPubKeyHash
ownFirstPaymentPubKeyHash

ownPaymentPubKeyHashes ::
    ( Member WalletEffect effs
    )
    => Eff effs [PaymentPubKeyHash]
ownPaymentPubKeyHashes :: Eff effs [PaymentPubKeyHash]
ownPaymentPubKeyHashes = do
    NonEmpty CardanoAddress
addrs <- Eff effs (NonEmpty CardanoAddress)
forall (effs :: [* -> *]).
Member WalletEffect effs =>
Eff effs (NonEmpty CardanoAddress)
ownAddresses
    [PaymentPubKeyHash] -> Eff effs [PaymentPubKeyHash]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PaymentPubKeyHash] -> Eff effs [PaymentPubKeyHash])
-> [PaymentPubKeyHash] -> Eff effs [PaymentPubKeyHash]
forall a b. (a -> b) -> a -> b
$ (PubKeyHash -> PaymentPubKeyHash)
-> [PubKeyHash] -> [PaymentPubKeyHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PubKeyHash -> PaymentPubKeyHash
PaymentPubKeyHash ([PubKeyHash] -> [PaymentPubKeyHash])
-> [PubKeyHash] -> [PaymentPubKeyHash]
forall a b. (a -> b) -> a -> b
$ (CardanoAddress -> Maybe PubKeyHash)
-> [CardanoAddress] -> [PubKeyHash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CardanoAddress -> Maybe PubKeyHash
forall era. AddressInEra era -> Maybe PubKeyHash
cardanoPubKeyHash ([CardanoAddress] -> [PubKeyHash])
-> [CardanoAddress] -> [PubKeyHash]
forall a b. (a -> b) -> a -> b
$ NonEmpty CardanoAddress -> [CardanoAddress]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty CardanoAddress
addrs

ownFirstPaymentPubKeyHash ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    )
    => Eff effs PaymentPubKeyHash
ownFirstPaymentPubKeyHash :: Eff effs PaymentPubKeyHash
ownFirstPaymentPubKeyHash = do
    [PaymentPubKeyHash]
pkhs <- Eff effs [PaymentPubKeyHash]
forall (effs :: [* -> *]).
Member WalletEffect effs =>
Eff effs [PaymentPubKeyHash]
ownPaymentPubKeyHashes
    case [PaymentPubKeyHash]
pkhs of
      []      -> WalletAPIError -> Eff effs PaymentPubKeyHash
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError WalletAPIError
NoPaymentPubKeyHashError
      (PaymentPubKeyHash
pkh:[PaymentPubKeyHash]
_) -> PaymentPubKeyHash -> Eff effs PaymentPubKeyHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure PaymentPubKeyHash
pkh

-- | Transfer some funds to an address, returning the transaction that was submitted.
--
--  Note: Due to a constraint in the Cardano ledger, each tx output must have a
--  minimum amount of Ada. Therefore, the funds to transfer will be adjusted
--  to satisfy that constraint. See 'adjustUnbalancedTx'.
payToAddress ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    , Member (LogMsg Text) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx
payToAddress :: Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx
payToAddress Params
params SlotRange
range Value
v Address
addr = do
    PaymentPubKeyHash
pkh <- Eff effs PaymentPubKeyHash
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs) =>
Eff effs PaymentPubKeyHash
ownFirstPaymentPubKeyHash
    let constraints :: TxConstraints Void Void
constraints = Address -> Value -> TxConstraints Void Void
forall i o. Address -> Value -> TxConstraints i o
Constraints.mustPayToAddress Address
addr Value
v
                   TxConstraints Void Void
-> TxConstraints Void Void -> TxConstraints Void Void
forall a. Semigroup a => a -> a -> a
<> ValidityInterval Slot -> TxConstraints Void Void
forall i o. ValidityInterval Slot -> TxConstraints i o
Constraints.mustValidateInSlotRange (SlotRange -> ValidityInterval Slot
forall a. Enum a => Interval a -> ValidityInterval a
Interval.fromPlutusInterval SlotRange
range)
                   TxConstraints Void Void
-> TxConstraints Void Void -> TxConstraints Void Void
forall a. Semigroup a => a -> a -> a
<> PaymentPubKeyHash -> TxConstraints Void Void
forall i o. PaymentPubKeyHash -> TxConstraints i o
Constraints.mustBeSignedBy PaymentPubKeyHash
pkh
    UnbalancedTx
utx <- (MkTxError -> Eff effs UnbalancedTx)
-> (UnbalancedTx -> Eff effs UnbalancedTx)
-> Either MkTxError UnbalancedTx
-> Eff effs UnbalancedTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (WalletAPIError -> Eff effs UnbalancedTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs UnbalancedTx)
-> (MkTxError -> WalletAPIError)
-> MkTxError
-> Eff effs UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MkTxError -> WalletAPIError
PaymentMkTxError)
                  UnbalancedTx -> Eff effs UnbalancedTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  (Params
-> ScriptLookups Void
-> TxConstraints (RedeemerType Void) (DatumType Void)
-> Either MkTxError UnbalancedTx
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
Params
-> ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Either MkTxError UnbalancedTx
Constraints.mkTxWithParams @Void Params
params ScriptLookups Void
forall a. Monoid a => a
mempty TxConstraints Void Void
TxConstraints (RedeemerType Void) (DatumType Void)
constraints)
    let ([Lovelace]
missingAdaCosts, UnbalancedTx
adjustedUtx) = PParams -> UnbalancedTx -> ([Lovelace], UnbalancedTx)
adjustUnbalancedTx (Params -> PParams
emulatorPParams Params
params) UnbalancedTx
utx
    RequestHandlerLogMsg -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug (RequestHandlerLogMsg -> Eff effs ())
-> RequestHandlerLogMsg -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Lovelace] -> RequestHandlerLogMsg
AdjustingUnbalancedTx [Lovelace]
missingAdaCosts
    Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UnbalancedTx
utx UnbalancedTx -> UnbalancedTx -> Bool
forall a. Eq a => a -> a -> Bool
== UnbalancedTx
adjustedUtx) (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$
      forall (effs :: [* -> *]).
Member (LogMsg Text) effs =>
Text -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn @Text (Text -> Eff effs ()) -> Text -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Text
"Wallet.API.payToPublicKeyHash: "
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Adjusted a transaction output value which has less than the minimum amount of Ada."
    Either WalletAPIError CardanoTx
balancedTx <- UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
Member WalletEffect effs =>
UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTx UnbalancedTx
adjustedUtx
    (WalletAPIError -> Eff effs CardanoTx)
-> (CardanoTx -> Eff effs CardanoTx)
-> Either WalletAPIError 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 CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
Member WalletEffect effs =>
CardanoTx -> Eff effs CardanoTx
signTxAndSubmit Either WalletAPIError CardanoTx
balancedTx

-- | Transfer some funds to an address.
payToAddress_ ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    , Member (LogMsg Text) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => Params -> SlotRange -> Value -> Address -> Eff effs ()
payToAddress_ :: Params -> SlotRange -> Value -> Address -> Eff effs ()
payToAddress_ Params
params SlotRange
range Value
v Address
addr = Eff effs CardanoTx -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs CardanoTx -> Eff effs ())
-> Eff effs CardanoTx -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx
payToAddress Params
params SlotRange
range Value
v Address
addr

-- | Transfer some funds to an address locked by a public key, returning the
--   transaction that was submitted.
--
--  Note: Due to a constraint in the Cardano ledger, each tx output must have a
--  minimum amount of Ada. Therefore, the funds to transfer will be adjusted
--  to satisfy that constraint. See 'adjustUnbalancedTx'.
payToPaymentPublicKeyHash ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    , Member (LogMsg Text) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => Params -> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
payToPaymentPublicKeyHash :: Params
-> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
payToPaymentPublicKeyHash Params
params SlotRange
range Value
v PaymentPubKeyHash
pkh = Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx
payToAddress Params
params SlotRange
range Value
v (PaymentPubKeyHash -> Maybe StakingCredential -> Address
pubKeyHashAddress PaymentPubKeyHash
pkh Maybe StakingCredential
forall a. Maybe a
Nothing)

-- | Transfer some funds to an address locked by a public key.
payToPaymentPublicKeyHash_ ::
    ( Member WalletEffect effs
    , Member (Error WalletAPIError) effs
    , Member (LogMsg Text) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => Params -> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs ()
payToPaymentPublicKeyHash_ :: Params -> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs ()
payToPaymentPublicKeyHash_ Params
params SlotRange
r Value
v = Eff effs CardanoTx -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs CardanoTx -> Eff effs ())
-> (PaymentPubKeyHash -> Eff effs CardanoTx)
-> PaymentPubKeyHash
-> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params
-> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params
-> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
payToPaymentPublicKeyHash Params
params SlotRange
r Value
v

-- | Add the wallet's signature to the transaction and submit it. Returns
--   the transaction with the wallet's signature.
signTxAndSubmit ::
    ( Member WalletEffect effs
    )
    => CardanoTx -> Eff effs CardanoTx
signTxAndSubmit :: CardanoTx -> Eff effs CardanoTx
signTxAndSubmit CardanoTx
t = do
    CardanoTx
tx' <- CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
Member WalletEffect effs =>
CardanoTx -> Eff effs CardanoTx
walletAddSignature CardanoTx
t
    CardanoTx -> Eff effs ()
forall (effs :: [* -> *]).
Member WalletEffect effs =>
CardanoTx -> Eff effs ()
submitTxn CardanoTx
tx'
    CardanoTx -> Eff effs CardanoTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure CardanoTx
tx'

-- | A version of 'signTxAndSubmit' that discards the result.
signTxAndSubmit_ ::
    ( Member WalletEffect effs
    )
    => CardanoTx -> Eff effs ()
signTxAndSubmit_ :: CardanoTx -> Eff effs ()
signTxAndSubmit_ = Eff effs CardanoTx -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs CardanoTx -> Eff effs ())
-> (CardanoTx -> Eff effs CardanoTx) -> CardanoTx -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> Eff effs CardanoTx
forall (effs :: [* -> *]).
Member WalletEffect effs =>
CardanoTx -> Eff effs CardanoTx
signTxAndSubmit

-- | The default slot validity range for transactions.
defaultSlotRange :: SlotRange
defaultSlotRange :: SlotRange
defaultSlotRange = SlotRange
forall a. Interval a
always