{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE MonoLocalBinds    #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}
module Plutus.Contract.Trace.RequestHandler(
    RequestHandler(..)
    , RequestHandlerLogMsg(..)
    , tryHandler
    , tryHandler'
    , wrapHandler
    , extract
    , maybeToHandler
    , generalise
    -- * handlers for common requests
    , handleAdjustUnbalancedTx
    , handleOwnAddresses
    , handleSlotNotifications
    , handleCurrentNodeClientSlot
    , handleCurrentChainIndexSlot
    , handleTimeNotifications
    , handleCurrentTime
    , handleCurrentNodeClientTimeRange
    , handleTimeToSlotConversions
    , handleUnbalancedTransactions
    , handlePendingTransactions
    , handleChainIndexQueries
    , handleOwnInstanceIdQueries
    , handleYieldedUnbalancedTx
    , handleGetParams
    ) where

import Control.Applicative (Alternative (empty, (<|>)))
import Control.Arrow (Arrow, Kleisli (Kleisli))
import Control.Category (Category)
import Control.Lens (Prism', Profunctor, preview)
import Control.Monad (foldM, guard, join)
import Control.Monad.Freer (Eff, Member)
import Control.Monad.Freer.Error qualified as Eff
import Control.Monad.Freer.NonDet (NonDet)
import Control.Monad.Freer.NonDet qualified as NonDet
import Control.Monad.Freer.Reader (Reader, ask)
import Data.Monoid (Alt (Alt), Ap (Ap))
import Data.Text (Text)
import Plutus.Contract.Resumable (Request (Request, itID, rqID, rqRequest),
                                  Response (Response, rspItID, rspResponse, rspRqID))

import Cardano.Node.Emulator.Internal.Node (Params (..), posixTimeRangeToContainedSlotRange, posixTimeToEnclosingSlot,
                                            slotToBeginPOSIXTime, slotToEndPOSIXTime)
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, logDebug, logWarn, surroundDebug)
import Data.List.NonEmpty (NonEmpty)
import Ledger (CardanoAddress, POSIXTime, POSIXTimeRange, Slot (..), SlotRange)
import Ledger.Tx (CardanoTx)
import Ledger.Tx.Constraints (UnbalancedTx)
import Ledger.Tx.Constraints qualified as Constraints
import Plutus.ChainIndex (ChainIndexQueryEffect)
import Plutus.ChainIndex.Effects qualified as ChainIndexEff
import Plutus.ChainIndex.Types (Tip (..))
import Plutus.Contract.Effects (ChainIndexQuery (..), ChainIndexResponse (..))
import Wallet.API (WalletAPIError, signTxAndSubmit)
import Wallet.Effects (NodeClientEffect, WalletEffect, getClientParams, getClientSlot)
import Wallet.Effects qualified
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg (AdjustingUnbalancedTx, HandleTxFailed, SlotNoticationTargetVsCurrent))
import Wallet.Types (ContractInstanceId)

-- | Request handlers that can choose whether to handle an effect (using
--   'Alternative'). This is useful if 'req' is a sum type.
newtype RequestHandler effs req resp = RequestHandler { RequestHandler effs req resp -> req -> Eff (NonDet : effs) resp
unRequestHandler :: req -> Eff (NonDet ': effs) resp }
    deriving stock (a -> RequestHandler effs req b -> RequestHandler effs req a
(a -> b) -> RequestHandler effs req a -> RequestHandler effs req b
(forall a b.
 (a -> b) -> RequestHandler effs req a -> RequestHandler effs req b)
-> (forall a b.
    a -> RequestHandler effs req b -> RequestHandler effs req a)
-> Functor (RequestHandler effs req)
forall (effs :: [* -> *]) req a b.
a -> RequestHandler effs req b -> RequestHandler effs req a
forall (effs :: [* -> *]) req a b.
(a -> b) -> RequestHandler effs req a -> RequestHandler effs req b
forall a b.
a -> RequestHandler effs req b -> RequestHandler effs req a
forall a b.
(a -> b) -> RequestHandler effs req a -> RequestHandler effs req b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RequestHandler effs req b -> RequestHandler effs req a
$c<$ :: forall (effs :: [* -> *]) req a b.
a -> RequestHandler effs req b -> RequestHandler effs req a
fmap :: (a -> b) -> RequestHandler effs req a -> RequestHandler effs req b
$cfmap :: forall (effs :: [* -> *]) req a b.
(a -> b) -> RequestHandler effs req a -> RequestHandler effs req b
Functor)
    deriving (q b c -> RequestHandler effs a b -> RequestHandler effs a c
RequestHandler effs b c -> q a b -> RequestHandler effs a c
(a -> b)
-> (c -> d) -> RequestHandler effs b c -> RequestHandler effs a d
(a -> b) -> RequestHandler effs b c -> RequestHandler effs a c
(b -> c) -> RequestHandler effs a b -> RequestHandler effs a c
(forall a b c d.
 (a -> b)
 -> (c -> d) -> RequestHandler effs b c -> RequestHandler effs a d)
-> (forall a b c.
    (a -> b) -> RequestHandler effs b c -> RequestHandler effs a c)
-> (forall b c a.
    (b -> c) -> RequestHandler effs a b -> RequestHandler effs a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> RequestHandler effs a b -> RequestHandler effs a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    RequestHandler effs b c -> q a b -> RequestHandler effs a c)
-> Profunctor (RequestHandler effs)
forall (effs :: [* -> *]) a b c.
(a -> b) -> RequestHandler effs b c -> RequestHandler effs a c
forall (effs :: [* -> *]) b c a.
(b -> c) -> RequestHandler effs a b -> RequestHandler effs a c
forall (effs :: [* -> *]) a b c d.
(a -> b)
-> (c -> d) -> RequestHandler effs b c -> RequestHandler effs a d
forall (effs :: [* -> *]) a b c (q :: * -> * -> *).
Coercible b a =>
RequestHandler effs b c -> q a b -> RequestHandler effs a c
forall (effs :: [* -> *]) a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> RequestHandler effs a b -> RequestHandler effs a c
forall a b c.
(a -> b) -> RequestHandler effs b c -> RequestHandler effs a c
forall b c a.
(b -> c) -> RequestHandler effs a b -> RequestHandler effs a c
forall a b c d.
(a -> b)
-> (c -> d) -> RequestHandler effs b c -> RequestHandler effs a d
forall a b c (q :: * -> * -> *).
Coercible b a =>
RequestHandler effs b c -> q a b -> RequestHandler effs a c
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> RequestHandler effs a b -> RequestHandler effs a c
forall (p :: * -> * -> *).
(forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d)
-> (forall a b c. (a -> b) -> p b c -> p a c)
-> (forall b c a. (b -> c) -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    p b c -> q a b -> p a c)
-> Profunctor p
.# :: RequestHandler effs b c -> q a b -> RequestHandler effs a c
$c.# :: forall (effs :: [* -> *]) a b c (q :: * -> * -> *).
Coercible b a =>
RequestHandler effs b c -> q a b -> RequestHandler effs a c
#. :: q b c -> RequestHandler effs a b -> RequestHandler effs a c
$c#. :: forall (effs :: [* -> *]) a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> RequestHandler effs a b -> RequestHandler effs a c
rmap :: (b -> c) -> RequestHandler effs a b -> RequestHandler effs a c
$crmap :: forall (effs :: [* -> *]) b c a.
(b -> c) -> RequestHandler effs a b -> RequestHandler effs a c
lmap :: (a -> b) -> RequestHandler effs b c -> RequestHandler effs a c
$clmap :: forall (effs :: [* -> *]) a b c.
(a -> b) -> RequestHandler effs b c -> RequestHandler effs a c
dimap :: (a -> b)
-> (c -> d) -> RequestHandler effs b c -> RequestHandler effs a d
$cdimap :: forall (effs :: [* -> *]) a b c d.
(a -> b)
-> (c -> d) -> RequestHandler effs b c -> RequestHandler effs a d
Profunctor, RequestHandler effs a a
RequestHandler effs b c
-> RequestHandler effs a b -> RequestHandler effs a c
(forall a. RequestHandler effs a a)
-> (forall b c a.
    RequestHandler effs b c
    -> RequestHandler effs a b -> RequestHandler effs a c)
-> Category (RequestHandler effs)
forall (effs :: [* -> *]) a. RequestHandler effs a a
forall (effs :: [* -> *]) b c a.
RequestHandler effs b c
-> RequestHandler effs a b -> RequestHandler effs a c
forall a. RequestHandler effs a a
forall b c a.
RequestHandler effs b c
-> RequestHandler effs a b -> RequestHandler effs a c
forall k (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
    cat b c -> cat a b -> cat a c)
-> Category cat
. :: RequestHandler effs b c
-> RequestHandler effs a b -> RequestHandler effs a c
$c. :: forall (effs :: [* -> *]) b c a.
RequestHandler effs b c
-> RequestHandler effs a b -> RequestHandler effs a c
id :: RequestHandler effs a a
$cid :: forall (effs :: [* -> *]) a. RequestHandler effs a a
Category, Category (RequestHandler effs)
Category (RequestHandler effs)
-> (forall b c. (b -> c) -> RequestHandler effs b c)
-> (forall b c d.
    RequestHandler effs b c -> RequestHandler effs (b, d) (c, d))
-> (forall b c d.
    RequestHandler effs b c -> RequestHandler effs (d, b) (d, c))
-> (forall b c b' c'.
    RequestHandler effs b c
    -> RequestHandler effs b' c'
    -> RequestHandler effs (b, b') (c, c'))
-> (forall b c c'.
    RequestHandler effs b c
    -> RequestHandler effs b c' -> RequestHandler effs b (c, c'))
-> Arrow (RequestHandler effs)
RequestHandler effs b c -> RequestHandler effs (b, d) (c, d)
RequestHandler effs b c -> RequestHandler effs (d, b) (d, c)
RequestHandler effs b c
-> RequestHandler effs b' c' -> RequestHandler effs (b, b') (c, c')
RequestHandler effs b c
-> RequestHandler effs b c' -> RequestHandler effs b (c, c')
(b -> c) -> RequestHandler effs b c
forall (effs :: [* -> *]). Category (RequestHandler effs)
forall (effs :: [* -> *]) b c. (b -> c) -> RequestHandler effs b c
forall (effs :: [* -> *]) b c d.
RequestHandler effs b c -> RequestHandler effs (b, d) (c, d)
forall (effs :: [* -> *]) b c d.
RequestHandler effs b c -> RequestHandler effs (d, b) (d, c)
forall (effs :: [* -> *]) b c c'.
RequestHandler effs b c
-> RequestHandler effs b c' -> RequestHandler effs b (c, c')
forall (effs :: [* -> *]) b c b' c'.
RequestHandler effs b c
-> RequestHandler effs b' c' -> RequestHandler effs (b, b') (c, c')
forall b c. (b -> c) -> RequestHandler effs b c
forall b c d.
RequestHandler effs b c -> RequestHandler effs (b, d) (c, d)
forall b c d.
RequestHandler effs b c -> RequestHandler effs (d, b) (d, c)
forall b c c'.
RequestHandler effs b c
-> RequestHandler effs b c' -> RequestHandler effs b (c, c')
forall b c b' c'.
RequestHandler effs b c
-> RequestHandler effs b' c' -> RequestHandler effs (b, b') (c, c')
forall (a :: * -> * -> *).
Category a
-> (forall b c. (b -> c) -> a b c)
-> (forall b c d. a b c -> a (b, d) (c, d))
-> (forall b c d. a b c -> a (d, b) (d, c))
-> (forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c'))
-> (forall b c c'. a b c -> a b c' -> a b (c, c'))
-> Arrow a
&&& :: RequestHandler effs b c
-> RequestHandler effs b c' -> RequestHandler effs b (c, c')
$c&&& :: forall (effs :: [* -> *]) b c c'.
RequestHandler effs b c
-> RequestHandler effs b c' -> RequestHandler effs b (c, c')
*** :: RequestHandler effs b c
-> RequestHandler effs b' c' -> RequestHandler effs (b, b') (c, c')
$c*** :: forall (effs :: [* -> *]) b c b' c'.
RequestHandler effs b c
-> RequestHandler effs b' c' -> RequestHandler effs (b, b') (c, c')
second :: RequestHandler effs b c -> RequestHandler effs (d, b) (d, c)
$csecond :: forall (effs :: [* -> *]) b c d.
RequestHandler effs b c -> RequestHandler effs (d, b) (d, c)
first :: RequestHandler effs b c -> RequestHandler effs (b, d) (c, d)
$cfirst :: forall (effs :: [* -> *]) b c d.
RequestHandler effs b c -> RequestHandler effs (b, d) (c, d)
arr :: (b -> c) -> RequestHandler effs b c
$carr :: forall (effs :: [* -> *]) b c. (b -> c) -> RequestHandler effs b c
$cp1Arrow :: forall (effs :: [* -> *]). Category (RequestHandler effs)
Arrow) via (Kleisli (Eff (NonDet ': effs)))
    deriving (b -> RequestHandler effs req resp -> RequestHandler effs req resp
NonEmpty (RequestHandler effs req resp)
-> RequestHandler effs req resp
RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
(RequestHandler effs req resp
 -> RequestHandler effs req resp -> RequestHandler effs req resp)
-> (NonEmpty (RequestHandler effs req resp)
    -> RequestHandler effs req resp)
-> (forall b.
    Integral b =>
    b -> RequestHandler effs req resp -> RequestHandler effs req resp)
-> Semigroup (RequestHandler effs req resp)
forall b.
Integral b =>
b -> RequestHandler effs req resp -> RequestHandler effs req resp
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall req (effs :: [* -> *]) resp.
NonEmpty (RequestHandler effs req resp)
-> RequestHandler effs req resp
forall req (effs :: [* -> *]) resp.
RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
forall req (effs :: [* -> *]) resp b.
Integral b =>
b -> RequestHandler effs req resp -> RequestHandler effs req resp
stimes :: b -> RequestHandler effs req resp -> RequestHandler effs req resp
$cstimes :: forall req (effs :: [* -> *]) resp b.
Integral b =>
b -> RequestHandler effs req resp -> RequestHandler effs req resp
sconcat :: NonEmpty (RequestHandler effs req resp)
-> RequestHandler effs req resp
$csconcat :: forall req (effs :: [* -> *]) resp.
NonEmpty (RequestHandler effs req resp)
-> RequestHandler effs req resp
<> :: RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
$c<> :: forall req (effs :: [* -> *]) resp.
RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
Semigroup, Semigroup (RequestHandler effs req resp)
RequestHandler effs req resp
Semigroup (RequestHandler effs req resp)
-> RequestHandler effs req resp
-> (RequestHandler effs req resp
    -> RequestHandler effs req resp -> RequestHandler effs req resp)
-> ([RequestHandler effs req resp] -> RequestHandler effs req resp)
-> Monoid (RequestHandler effs req resp)
[RequestHandler effs req resp] -> RequestHandler effs req resp
RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall req (effs :: [* -> *]) resp.
Semigroup (RequestHandler effs req resp)
forall req (effs :: [* -> *]) resp. RequestHandler effs req resp
forall req (effs :: [* -> *]) resp.
[RequestHandler effs req resp] -> RequestHandler effs req resp
forall req (effs :: [* -> *]) resp.
RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
mconcat :: [RequestHandler effs req resp] -> RequestHandler effs req resp
$cmconcat :: forall req (effs :: [* -> *]) resp.
[RequestHandler effs req resp] -> RequestHandler effs req resp
mappend :: RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
$cmappend :: forall req (effs :: [* -> *]) resp.
RequestHandler effs req resp
-> RequestHandler effs req resp -> RequestHandler effs req resp
mempty :: RequestHandler effs req resp
$cmempty :: forall req (effs :: [* -> *]) resp. RequestHandler effs req resp
$cp1Monoid :: forall req (effs :: [* -> *]) resp.
Semigroup (RequestHandler effs req resp)
Monoid) via (Ap ((->) req) (Alt (Eff (NonDet ': effs)) resp))

-- Try the handler on the requests until it succeeds for the first time, then stop.
tryHandler ::
    forall effs req resp
    . RequestHandler effs req resp
    -> [req]
    -> Eff effs (Maybe resp)
tryHandler :: RequestHandler effs req resp -> [req] -> Eff effs (Maybe resp)
tryHandler RequestHandler effs req resp
handler = RequestHandler effs req (Maybe resp)
-> [req] -> Eff effs (Maybe resp)
forall (f :: * -> *) (effs :: [* -> *]) req resp.
(Alternative f, Monad f) =>
RequestHandler effs req (f resp) -> [req] -> Eff effs (f resp)
tryHandler' (resp -> Maybe resp
forall a. a -> Maybe a
Just (resp -> Maybe resp)
-> RequestHandler effs req resp
-> RequestHandler effs req (Maybe resp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHandler effs req resp
handler)

-- Try the handler on the requests, using the 'Alternative' instance of @f@
tryHandler' ::
    forall f effs req resp
    . (Alternative f, Monad f)
    => RequestHandler effs req (f resp)
    -> [req]
    -> Eff effs (f resp)
tryHandler' :: RequestHandler effs req (f resp) -> [req] -> Eff effs (f resp)
tryHandler' (RequestHandler req -> Eff (NonDet : effs) (f resp)
h) =
    (f resp -> req -> Eff effs (f resp))
-> f resp -> [req] -> Eff effs (f resp)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\f resp
e req
i -> (f (f resp) -> f resp)
-> Eff effs (f (f resp)) -> Eff effs (f resp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f resp
e f resp -> f resp -> f resp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) (f resp -> f resp)
-> (f (f resp) -> f resp) -> f (f resp) -> f resp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f resp) -> f resp
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join) (Eff effs (f (f resp)) -> Eff effs (f resp))
-> Eff effs (f (f resp)) -> Eff effs (f resp)
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]) a.
Alternative f =>
Eff (NonDet : effs) a -> Eff effs (f a)
forall (f :: * -> *) (effs :: [* -> *]) a.
Alternative f =>
Eff (NonDet : effs) a -> Eff effs (f a)
NonDet.makeChoiceA @f (Eff (NonDet : effs) (f resp) -> Eff effs (f (f resp)))
-> Eff (NonDet : effs) (f resp) -> Eff effs (f (f resp))
forall a b. (a -> b) -> a -> b
$ req -> Eff (NonDet : effs) (f resp)
h req
i) f resp
forall (f :: * -> *) a. Alternative f => f a
empty

extract :: Alternative f => Prism' a b -> a -> f b
extract :: Prism' a b -> a -> f b
extract Prism' a b
p = f b -> (b -> f b) -> Maybe b -> f b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f b
forall (f :: * -> *) a. Alternative f => f a
empty b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f b) -> (a -> Maybe b) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First b) a b -> a -> Maybe b
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First b) a b
Prism' a b
p

-- | Generalise a request handler
generalise ::
    forall effs req req' resp resp'
    . (req' -> Maybe req)
    -> (resp -> resp')
    -> RequestHandler effs req resp
    -> RequestHandler effs req' resp'
generalise :: (req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise req' -> Maybe req
rq resp -> resp'
rsp (RequestHandler req -> Eff (NonDet : effs) resp
h) = (req' -> Eff (NonDet : effs) resp')
-> RequestHandler effs req' resp'
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((req' -> Eff (NonDet : effs) resp')
 -> RequestHandler effs req' resp')
-> (req' -> Eff (NonDet : effs) resp')
-> RequestHandler effs req' resp'
forall a b. (a -> b) -> a -> b
$ \req'
k -> do
    case req' -> Maybe req
rq req'
k of
        Maybe req
Nothing -> Eff (NonDet : effs) resp'
forall (f :: * -> *) a. Alternative f => f a
empty
        Just req
k' -> resp -> resp'
rsp (resp -> resp')
-> Eff (NonDet : effs) resp -> Eff (NonDet : effs) resp'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> req -> Eff (NonDet : effs) resp
h req
k'

wrapHandler :: RequestHandler effs req resp -> RequestHandler effs (Request req) (Response resp)
wrapHandler :: RequestHandler effs req resp
-> RequestHandler effs (Request req) (Response resp)
wrapHandler (RequestHandler req -> Eff (NonDet : effs) resp
h) = (Request req -> Eff (NonDet : effs) (Response resp))
-> RequestHandler effs (Request req) (Response resp)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((Request req -> Eff (NonDet : effs) (Response resp))
 -> RequestHandler effs (Request req) (Response resp))
-> (Request req -> Eff (NonDet : effs) (Response resp))
-> RequestHandler effs (Request req) (Response resp)
forall a b. (a -> b) -> a -> b
$ \Request{RequestID
rqID :: RequestID
rqID :: forall o. Request o -> RequestID
rqID, IterationID
itID :: IterationID
itID :: forall o. Request o -> IterationID
itID, req
rqRequest :: req
rqRequest :: forall o. Request o -> o
rqRequest} -> do
    resp
r <- req -> Eff (NonDet : effs) resp
h req
rqRequest
    Response resp -> Eff (NonDet : effs) (Response resp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response resp -> Eff (NonDet : effs) (Response resp))
-> Response resp -> Eff (NonDet : effs) (Response resp)
forall a b. (a -> b) -> a -> b
$ Response :: forall i. RequestID -> IterationID -> i -> Response i
Response{rspRqID :: RequestID
rspRqID = RequestID
rqID, rspResponse :: resp
rspResponse = resp
r, rspItID :: IterationID
rspItID = IterationID
itID }

maybeToHandler :: (req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler :: (req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler req -> Maybe resp
f = (req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp)
-> (req -> Eff (NonDet : effs) resp)
-> RequestHandler effs req resp
forall a b. (a -> b) -> a -> b
$ Eff (NonDet : effs) resp
-> (resp -> Eff (NonDet : effs) resp)
-> Maybe resp
-> Eff (NonDet : effs) resp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Eff (NonDet : effs) resp
forall (f :: * -> *) a. Alternative f => f a
empty resp -> Eff (NonDet : effs) resp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe resp -> Eff (NonDet : effs) resp)
-> (req -> Maybe resp) -> req -> Eff (NonDet : effs) resp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. req -> Maybe resp
f

-- handlers for common requests

handleOwnAddresses ::
    forall a effs.
    ( Member WalletEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    )
    => RequestHandler effs a (NonEmpty CardanoAddress)
handleOwnAddresses :: RequestHandler effs a (NonEmpty CardanoAddress)
handleOwnAddresses =
    (a -> Eff (NonDet : effs) (NonEmpty CardanoAddress))
-> RequestHandler effs a (NonEmpty CardanoAddress)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((a -> Eff (NonDet : effs) (NonEmpty CardanoAddress))
 -> RequestHandler effs a (NonEmpty CardanoAddress))
-> (a -> Eff (NonDet : effs) (NonEmpty CardanoAddress))
-> RequestHandler effs a (NonEmpty CardanoAddress)
forall a b. (a -> b) -> a -> b
$ \a
_ ->
        Text
-> Eff (NonDet : effs) (NonEmpty CardanoAddress)
-> Eff (NonDet : effs) (NonEmpty CardanoAddress)
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleOwnAddresses" Eff (NonDet : effs) (NonEmpty CardanoAddress)
forall (effs :: [* -> *]).
Member WalletEffect effs =>
Eff effs (NonEmpty CardanoAddress)
Wallet.Effects.ownAddresses

handleSlotNotifications ::
    forall effs.
    ( Member NodeClientEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => RequestHandler effs Slot Slot
handleSlotNotifications :: RequestHandler effs Slot Slot
handleSlotNotifications =
    (Slot -> Eff (NonDet : effs) Slot) -> RequestHandler effs Slot Slot
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((Slot -> Eff (NonDet : effs) Slot)
 -> RequestHandler effs Slot Slot)
-> (Slot -> Eff (NonDet : effs) Slot)
-> RequestHandler effs Slot Slot
forall a b. (a -> b) -> a -> b
$ \Slot
targetSlot_ ->
        Text -> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleSlotNotifications" (Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot)
-> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot
forall a b. (a -> b) -> a -> b
$ do
            Slot
currentSlot <- Eff (NonDet : effs) Slot
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Slot
getClientSlot
            RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug (RequestHandlerLogMsg -> Eff (NonDet : effs) ())
-> RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a b. (a -> b) -> a -> b
$ Slot -> Slot -> RequestHandlerLogMsg
SlotNoticationTargetVsCurrent Slot
targetSlot_ Slot
currentSlot
            Bool -> Eff (NonDet : effs) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Slot
currentSlot Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
>= Slot
targetSlot_)
            Slot -> Eff (NonDet : effs) Slot
forall (f :: * -> *) a. Applicative f => a -> f a
pure Slot
currentSlot

handleTimeNotifications ::
    forall effs.
    ( Member NodeClientEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => RequestHandler effs POSIXTime POSIXTime
handleTimeNotifications :: RequestHandler effs POSIXTime POSIXTime
handleTimeNotifications =
    (POSIXTime -> Eff (NonDet : effs) POSIXTime)
-> RequestHandler effs POSIXTime POSIXTime
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((POSIXTime -> Eff (NonDet : effs) POSIXTime)
 -> RequestHandler effs POSIXTime POSIXTime)
-> (POSIXTime -> Eff (NonDet : effs) POSIXTime)
-> RequestHandler effs POSIXTime POSIXTime
forall a b. (a -> b) -> a -> b
$ \POSIXTime
targetTime_ ->
        Text
-> Eff (NonDet : effs) POSIXTime -> Eff (NonDet : effs) POSIXTime
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleTimeNotifications" (Eff (NonDet : effs) POSIXTime -> Eff (NonDet : effs) POSIXTime)
-> Eff (NonDet : effs) POSIXTime -> Eff (NonDet : effs) POSIXTime
forall a b. (a -> b) -> a -> b
$ do
            Slot
currentSlot <- Eff (NonDet : effs) Slot
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Slot
getClientSlot
            Params { SlotConfig
pSlotConfig :: Params -> SlotConfig
pSlotConfig :: SlotConfig
pSlotConfig } <- Eff (NonDet : effs) Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
            let targetSlot_ :: Slot
targetSlot_ = SlotConfig -> POSIXTime -> Slot
posixTimeToEnclosingSlot SlotConfig
pSlotConfig POSIXTime
targetTime_
            RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug (RequestHandlerLogMsg -> Eff (NonDet : effs) ())
-> RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a b. (a -> b) -> a -> b
$ Slot -> Slot -> RequestHandlerLogMsg
SlotNoticationTargetVsCurrent Slot
targetSlot_ Slot
currentSlot
            Bool -> Eff (NonDet : effs) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Slot
currentSlot Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
>= Slot
targetSlot_)
            POSIXTime -> Eff (NonDet : effs) POSIXTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXTime -> Eff (NonDet : effs) POSIXTime)
-> POSIXTime -> Eff (NonDet : effs) POSIXTime
forall a b. (a -> b) -> a -> b
$ SlotConfig -> Slot -> POSIXTime
slotToEndPOSIXTime SlotConfig
pSlotConfig Slot
currentSlot

handleCurrentNodeClientSlot ::
    forall effs a.
    ( Member NodeClientEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    )
    => RequestHandler effs a Slot
handleCurrentNodeClientSlot :: RequestHandler effs a Slot
handleCurrentNodeClientSlot =
    (a -> Eff (NonDet : effs) Slot) -> RequestHandler effs a Slot
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((a -> Eff (NonDet : effs) Slot) -> RequestHandler effs a Slot)
-> (a -> Eff (NonDet : effs) Slot) -> RequestHandler effs a Slot
forall a b. (a -> b) -> a -> b
$ \a
_ ->
        Text -> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleCurrentNodeClientSlot" (Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot)
-> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot
forall a b. (a -> b) -> a -> b
$ do
            Eff (NonDet : effs) Slot
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Slot
getClientSlot

handleCurrentChainIndexSlot ::
    forall effs a.
    ( Member (LogObserve (LogMessage Text)) effs
    , Member ChainIndexQueryEffect effs
    )
    => RequestHandler effs a Slot
handleCurrentChainIndexSlot :: RequestHandler effs a Slot
handleCurrentChainIndexSlot =
    (a -> Eff (NonDet : effs) Slot) -> RequestHandler effs a Slot
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((a -> Eff (NonDet : effs) Slot) -> RequestHandler effs a Slot)
-> (a -> Eff (NonDet : effs) Slot) -> RequestHandler effs a Slot
forall a b. (a -> b) -> a -> b
$ \a
_ ->
        Text -> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleCurrentChainIndexSlot" (Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot)
-> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) Slot
forall a b. (a -> b) -> a -> b
$ do
            Tip
t <- Eff (NonDet : effs) Tip
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
Eff effs Tip
ChainIndexEff.getTip
            case Tip
t of
                Tip
TipAtGenesis   -> Slot -> Eff (NonDet : effs) Slot
forall (m :: * -> *) a. Monad m => a -> m a
return (Slot -> Eff (NonDet : effs) Slot)
-> Slot -> Eff (NonDet : effs) Slot
forall a b. (a -> b) -> a -> b
$ Integer -> Slot
Slot Integer
0
                (Tip Slot
slot BlockId
_ BlockNumber
_) -> Slot -> Eff (NonDet : effs) Slot
forall (m :: * -> *) a. Monad m => a -> m a
return Slot
slot

handleCurrentTime ::
    forall effs a.
    ( Member NodeClientEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    )
    => RequestHandler effs a POSIXTime
handleCurrentTime :: RequestHandler effs a POSIXTime
handleCurrentTime =
    (a -> Eff (NonDet : effs) POSIXTime)
-> RequestHandler effs a POSIXTime
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((a -> Eff (NonDet : effs) POSIXTime)
 -> RequestHandler effs a POSIXTime)
-> (a -> Eff (NonDet : effs) POSIXTime)
-> RequestHandler effs a POSIXTime
forall a b. (a -> b) -> a -> b
$ \a
_ ->
        Text
-> Eff (NonDet : effs) POSIXTime -> Eff (NonDet : effs) POSIXTime
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleCurrentTime" (Eff (NonDet : effs) POSIXTime -> Eff (NonDet : effs) POSIXTime)
-> Eff (NonDet : effs) POSIXTime -> Eff (NonDet : effs) POSIXTime
forall a b. (a -> b) -> a -> b
$ do
            Params { SlotConfig
pSlotConfig :: SlotConfig
pSlotConfig :: Params -> SlotConfig
pSlotConfig }  <- Eff (NonDet : effs) Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
            SlotConfig -> Slot -> POSIXTime
slotToEndPOSIXTime SlotConfig
pSlotConfig (Slot -> POSIXTime)
-> Eff (NonDet : effs) Slot -> Eff (NonDet : effs) POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (NonDet : effs) Slot
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Slot
getClientSlot

handleCurrentNodeClientTimeRange ::
    forall effs a.
    ( Member NodeClientEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    )
    => RequestHandler effs a (POSIXTime, POSIXTime)
handleCurrentNodeClientTimeRange :: RequestHandler effs a (POSIXTime, POSIXTime)
handleCurrentNodeClientTimeRange =
    (a -> Eff (NonDet : effs) (POSIXTime, POSIXTime))
-> RequestHandler effs a (POSIXTime, POSIXTime)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((a -> Eff (NonDet : effs) (POSIXTime, POSIXTime))
 -> RequestHandler effs a (POSIXTime, POSIXTime))
-> (a -> Eff (NonDet : effs) (POSIXTime, POSIXTime))
-> RequestHandler effs a (POSIXTime, POSIXTime)
forall a b. (a -> b) -> a -> b
$ \a
_ ->
        Text
-> Eff (NonDet : effs) (POSIXTime, POSIXTime)
-> Eff (NonDet : effs) (POSIXTime, POSIXTime)
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleCurrentNodeClientTimeRange" (Eff (NonDet : effs) (POSIXTime, POSIXTime)
 -> Eff (NonDet : effs) (POSIXTime, POSIXTime))
-> Eff (NonDet : effs) (POSIXTime, POSIXTime)
-> Eff (NonDet : effs) (POSIXTime, POSIXTime)
forall a b. (a -> b) -> a -> b
$ do
            Params { SlotConfig
pSlotConfig :: SlotConfig
pSlotConfig :: Params -> SlotConfig
pSlotConfig }  <- Eff (NonDet : effs) Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
            Slot
nodeClientSlot <- Eff (NonDet : effs) Slot
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Slot
getClientSlot
            (POSIXTime, POSIXTime)
-> Eff (NonDet : effs) (POSIXTime, POSIXTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( SlotConfig -> Slot -> POSIXTime
slotToBeginPOSIXTime SlotConfig
pSlotConfig Slot
nodeClientSlot
                 , SlotConfig -> Slot -> POSIXTime
slotToEndPOSIXTime SlotConfig
pSlotConfig Slot
nodeClientSlot
                 )

handleTimeToSlotConversions ::
    forall effs.
    ( Member NodeClientEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    )
    => RequestHandler effs POSIXTimeRange SlotRange
handleTimeToSlotConversions :: RequestHandler effs POSIXTimeRange SlotRange
handleTimeToSlotConversions =
    (POSIXTimeRange -> Eff (NonDet : effs) SlotRange)
-> RequestHandler effs POSIXTimeRange SlotRange
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((POSIXTimeRange -> Eff (NonDet : effs) SlotRange)
 -> RequestHandler effs POSIXTimeRange SlotRange)
-> (POSIXTimeRange -> Eff (NonDet : effs) SlotRange)
-> RequestHandler effs POSIXTimeRange SlotRange
forall a b. (a -> b) -> a -> b
$ \POSIXTimeRange
poxisTimeRange ->
        Text
-> Eff (NonDet : effs) SlotRange -> Eff (NonDet : effs) SlotRange
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleTimeToSlotConversions" (Eff (NonDet : effs) SlotRange -> Eff (NonDet : effs) SlotRange)
-> Eff (NonDet : effs) SlotRange -> Eff (NonDet : effs) SlotRange
forall a b. (a -> b) -> a -> b
$ do
            Params { SlotConfig
pSlotConfig :: SlotConfig
pSlotConfig :: Params -> SlotConfig
pSlotConfig }  <- Eff (NonDet : effs) Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
            SlotRange -> Eff (NonDet : effs) SlotRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotRange -> Eff (NonDet : effs) SlotRange)
-> SlotRange -> Eff (NonDet : effs) SlotRange
forall a b. (a -> b) -> a -> b
$ SlotConfig -> POSIXTimeRange -> SlotRange
posixTimeRangeToContainedSlotRange SlotConfig
pSlotConfig POSIXTimeRange
poxisTimeRange

handleUnbalancedTransactions ::
    forall effs.
    ( Member WalletEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => RequestHandler effs UnbalancedTx (Either WalletAPIError CardanoTx)
handleUnbalancedTransactions :: RequestHandler effs UnbalancedTx (Either WalletAPIError CardanoTx)
handleUnbalancedTransactions =
    (UnbalancedTx
 -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> RequestHandler
     effs UnbalancedTx (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((UnbalancedTx
  -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
 -> RequestHandler
      effs UnbalancedTx (Either WalletAPIError CardanoTx))
-> (UnbalancedTx
    -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> RequestHandler
     effs UnbalancedTx (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ \UnbalancedTx
unbalancedTx ->
        Text
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleUnbalancedTransactions" (Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
 -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ do
        UnbalancedTx
-> Eff
     (Error WalletAPIError : NonDet : effs)
     (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
Member WalletEffect effs =>
UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
Wallet.Effects.balanceTx UnbalancedTx
unbalancedTx Eff
  (Error WalletAPIError : NonDet : effs)
  (Either WalletAPIError CardanoTx)
-> (WalletAPIError
    -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
`Eff.handleError`
          (\WalletAPIError
err -> RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (WalletAPIError -> RequestHandlerLogMsg
HandleTxFailed WalletAPIError
err) Eff (NonDet : effs) ()
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either WalletAPIError CardanoTx
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletAPIError -> Either WalletAPIError CardanoTx
forall a b. a -> Either a b
Left WalletAPIError
err))

handlePendingTransactions ::
    forall effs.
    ( Member WalletEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    )
    => RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
handlePendingTransactions :: RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
handlePendingTransactions =
    (CardanoTx
 -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((CardanoTx
  -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
 -> RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx))
-> (CardanoTx
    -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ \CardanoTx
tx ->
        Text
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handlePendingTransactions" (Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
 -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall a b. (a -> b) -> a -> b
$ do
        Eff
  (Error WalletAPIError : NonDet : effs)
  (Either WalletAPIError CardanoTx)
-> (WalletAPIError
    -> Eff (NonDet : effs) (Either WalletAPIError CardanoTx))
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
Eff.handleError (CardanoTx -> Either WalletAPIError CardanoTx
forall a b. b -> Either a b
Right (CardanoTx -> Either WalletAPIError CardanoTx)
-> Eff (Error WalletAPIError : NonDet : effs) CardanoTx
-> Eff
     (Error WalletAPIError : NonDet : effs)
     (Either WalletAPIError CardanoTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> Eff (Error WalletAPIError : NonDet : effs) CardanoTx
forall (effs :: [* -> *]).
Member WalletEffect effs =>
CardanoTx -> Eff effs CardanoTx
signTxAndSubmit CardanoTx
tx)
                        (\WalletAPIError
err -> RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (WalletAPIError -> RequestHandlerLogMsg
HandleTxFailed WalletAPIError
err) Eff (NonDet : effs) ()
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either WalletAPIError CardanoTx
-> Eff (NonDet : effs) (Either WalletAPIError CardanoTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WalletAPIError -> Either WalletAPIError CardanoTx
forall a b. a -> Either a b
Left WalletAPIError
err))

handleChainIndexQueries ::
    forall effs.
    ( Member (LogObserve (LogMessage Text)) effs
    , Member ChainIndexQueryEffect effs
    )
    => RequestHandler effs ChainIndexQuery ChainIndexResponse
handleChainIndexQueries :: RequestHandler effs ChainIndexQuery ChainIndexResponse
handleChainIndexQueries = (ChainIndexQuery -> Eff (NonDet : effs) ChainIndexResponse)
-> RequestHandler effs ChainIndexQuery ChainIndexResponse
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((ChainIndexQuery -> Eff (NonDet : effs) ChainIndexResponse)
 -> RequestHandler effs ChainIndexQuery ChainIndexResponse)
-> (ChainIndexQuery -> Eff (NonDet : effs) ChainIndexResponse)
-> RequestHandler effs ChainIndexQuery ChainIndexResponse
forall a b. (a -> b) -> a -> b
$ \ChainIndexQuery
chainIndexQuery ->
    Text
-> Eff (NonDet : effs) ChainIndexResponse
-> Eff (NonDet : effs) ChainIndexResponse
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleChainIndexQueries" (Eff (NonDet : effs) ChainIndexResponse
 -> Eff (NonDet : effs) ChainIndexResponse)
-> Eff (NonDet : effs) ChainIndexResponse
-> Eff (NonDet : effs) ChainIndexResponse
forall a b. (a -> b) -> a -> b
$ do
      case ChainIndexQuery
chainIndexQuery of
        DatumFromHash DatumHash
h               -> Maybe Datum -> ChainIndexResponse
DatumHashResponse (Maybe Datum -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe Datum)
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatumHash -> Eff (NonDet : effs) (Maybe Datum)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
DatumHash -> Eff effs (Maybe Datum)
ChainIndexEff.datumFromHash DatumHash
h
        ValidatorFromHash ValidatorHash
h           -> Maybe (Versioned Validator) -> ChainIndexResponse
ValidatorHashResponse (Maybe (Versioned Validator) -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe (Versioned Validator))
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidatorHash -> Eff (NonDet : effs) (Maybe (Versioned Validator))
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
ValidatorHash -> Eff effs (Maybe (Versioned Validator))
ChainIndexEff.validatorFromHash ValidatorHash
h
        MintingPolicyFromHash MintingPolicyHash
h       -> Maybe (Versioned MintingPolicy) -> ChainIndexResponse
MintingPolicyHashResponse (Maybe (Versioned MintingPolicy) -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe (Versioned MintingPolicy))
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MintingPolicyHash
-> Eff (NonDet : effs) (Maybe (Versioned MintingPolicy))
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
MintingPolicyHash -> Eff effs (Maybe (Versioned MintingPolicy))
ChainIndexEff.mintingPolicyFromHash MintingPolicyHash
h
        StakeValidatorFromHash StakeValidatorHash
h      -> Maybe (Versioned StakeValidator) -> ChainIndexResponse
StakeValidatorHashResponse (Maybe (Versioned StakeValidator) -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe (Versioned StakeValidator))
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StakeValidatorHash
-> Eff (NonDet : effs) (Maybe (Versioned StakeValidator))
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
StakeValidatorHash -> Eff effs (Maybe (Versioned StakeValidator))
ChainIndexEff.stakeValidatorFromHash StakeValidatorHash
h
        RedeemerFromHash RedeemerHash
h            -> Maybe Redeemer -> ChainIndexResponse
RedeemerHashResponse (Maybe Redeemer -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe Redeemer)
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedeemerHash -> Eff (NonDet : effs) (Maybe Redeemer)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
RedeemerHash -> Eff effs (Maybe Redeemer)
ChainIndexEff.redeemerFromHash RedeemerHash
h
        TxOutFromRef TxOutRef
txOutRef         -> Maybe DecoratedTxOut -> ChainIndexResponse
TxOutRefResponse (Maybe DecoratedTxOut -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe DecoratedTxOut)
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutRef -> Eff (NonDet : effs) (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
ChainIndexEff.txOutFromRef TxOutRef
txOutRef
        TxFromTxId TxId
txid               -> Maybe ChainIndexTx -> ChainIndexResponse
TxIdResponse (Maybe ChainIndexTx -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe ChainIndexTx)
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxId -> Eff (NonDet : effs) (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxId -> Eff effs (Maybe ChainIndexTx)
ChainIndexEff.txFromTxId TxId
txid
        UnspentTxOutFromRef TxOutRef
ref       -> Maybe DecoratedTxOut -> ChainIndexResponse
UnspentTxOutResponse (Maybe DecoratedTxOut -> ChainIndexResponse)
-> Eff (NonDet : effs) (Maybe DecoratedTxOut)
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutRef -> Eff (NonDet : effs) (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
ChainIndexEff.unspentTxOutFromRef TxOutRef
ref
        UtxoSetMembership TxOutRef
txOutRef    -> IsUtxoResponse -> ChainIndexResponse
UtxoSetMembershipResponse (IsUtxoResponse -> ChainIndexResponse)
-> Eff (NonDet : effs) IsUtxoResponse
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutRef -> Eff (NonDet : effs) IsUtxoResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs IsUtxoResponse
ChainIndexEff.utxoSetMembership TxOutRef
txOutRef
        UtxoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
c         -> UtxosResponse -> ChainIndexResponse
UtxoSetAtResponse (UtxosResponse -> ChainIndexResponse)
-> Eff (NonDet : effs) UtxosResponse
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef
-> CardanoAddress -> Eff (NonDet : effs) UtxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> CardanoAddress -> Eff effs UtxosResponse
ChainIndexEff.utxoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
c
        UnspentTxOutSetAtAddress PageQuery TxOutRef
pq CardanoAddress
c -> QueryResponse [(TxOutRef, DecoratedTxOut)] -> ChainIndexResponse
UnspentTxOutsAtResponse (QueryResponse [(TxOutRef, DecoratedTxOut)] -> ChainIndexResponse)
-> Eff (NonDet : effs) (QueryResponse [(TxOutRef, DecoratedTxOut)])
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef
-> CardanoAddress
-> Eff (NonDet : effs) (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef
-> CardanoAddress
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
ChainIndexEff.unspentTxOutSetAtAddress PageQuery TxOutRef
pq CardanoAddress
c
        DatumsAtAddress PageQuery TxOutRef
pq CardanoAddress
c          -> QueryResponse [Datum] -> ChainIndexResponse
DatumsAtResponse (QueryResponse [Datum] -> ChainIndexResponse)
-> Eff (NonDet : effs) (QueryResponse [Datum])
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef
-> CardanoAddress -> Eff (NonDet : effs) (QueryResponse [Datum])
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef
-> CardanoAddress -> Eff effs (QueryResponse [Datum])
ChainIndexEff.datumsAtAddress PageQuery TxOutRef
pq CardanoAddress
c
        UtxoSetWithCurrency PageQuery TxOutRef
pq AssetClass
ac     -> UtxosResponse -> ChainIndexResponse
UtxoSetWithCurrencyResponse (UtxosResponse -> ChainIndexResponse)
-> Eff (NonDet : effs) UtxosResponse
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef
-> AssetClass -> Eff (NonDet : effs) UtxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse
ChainIndexEff.utxoSetWithCurrency PageQuery TxOutRef
pq AssetClass
ac
        TxoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
a          -> TxosResponse -> ChainIndexResponse
TxoSetAtResponse (TxosResponse -> ChainIndexResponse)
-> Eff (NonDet : effs) TxosResponse
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PageQuery TxOutRef
-> CardanoAddress -> Eff (NonDet : effs) TxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> CardanoAddress -> Eff effs TxosResponse
ChainIndexEff.txoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
a
        TxsFromTxIds [TxId]
txids            -> [ChainIndexTx] -> ChainIndexResponse
TxIdsResponse ([ChainIndexTx] -> ChainIndexResponse)
-> Eff (NonDet : effs) [ChainIndexTx]
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxId] -> Eff (NonDet : effs) [ChainIndexTx]
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
[TxId] -> Eff effs [ChainIndexTx]
ChainIndexEff.txsFromTxIds [TxId]
txids
        ChainIndexQuery
GetTip                        -> Tip -> ChainIndexResponse
GetTipResponse (Tip -> ChainIndexResponse)
-> Eff (NonDet : effs) Tip
-> Eff (NonDet : effs) ChainIndexResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (NonDet : effs) Tip
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
Eff effs Tip
ChainIndexEff.getTip

handleOwnInstanceIdQueries ::
    forall effs a.
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (Reader ContractInstanceId) effs
    )
    => RequestHandler effs a ContractInstanceId
handleOwnInstanceIdQueries :: RequestHandler effs a ContractInstanceId
handleOwnInstanceIdQueries = (a -> Eff (NonDet : effs) ContractInstanceId)
-> RequestHandler effs a ContractInstanceId
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((a -> Eff (NonDet : effs) ContractInstanceId)
 -> RequestHandler effs a ContractInstanceId)
-> (a -> Eff (NonDet : effs) ContractInstanceId)
-> RequestHandler effs a ContractInstanceId
forall a b. (a -> b) -> a -> b
$ \a
_ ->
    Text
-> Eff (NonDet : effs) ContractInstanceId
-> Eff (NonDet : effs) ContractInstanceId
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleOwnInstanceIdQueries" Eff (NonDet : effs) ContractInstanceId
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask

handleYieldedUnbalancedTx ::
    forall effs.
    ( Member WalletEffect effs
    , Member (LogObserve (LogMessage Text)) effs
    )
    => RequestHandler effs UnbalancedTx ()
handleYieldedUnbalancedTx :: RequestHandler effs UnbalancedTx ()
handleYieldedUnbalancedTx =
    (UnbalancedTx -> Eff (NonDet : effs) ())
-> RequestHandler effs UnbalancedTx ()
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((UnbalancedTx -> Eff (NonDet : effs) ())
 -> RequestHandler effs UnbalancedTx ())
-> (UnbalancedTx -> Eff (NonDet : effs) ())
-> RequestHandler effs UnbalancedTx ()
forall a b. (a -> b) -> a -> b
$ \UnbalancedTx
utx ->
        Text -> Eff (NonDet : effs) () -> Eff (NonDet : effs) ()
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleYieldedUnbalancedTx" (Eff (NonDet : effs) () -> Eff (NonDet : effs) ())
-> Eff (NonDet : effs) () -> Eff (NonDet : effs) ()
forall a b. (a -> b) -> a -> b
$ do
            UnbalancedTx -> Eff (NonDet : effs) ()
forall (effs :: [* -> *]).
Member WalletEffect effs =>
UnbalancedTx -> Eff effs ()
Wallet.Effects.yieldUnbalancedTx UnbalancedTx
utx

handleAdjustUnbalancedTx ::
    forall effs.
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs UnbalancedTx UnbalancedTx
handleAdjustUnbalancedTx :: RequestHandler effs UnbalancedTx UnbalancedTx
handleAdjustUnbalancedTx =
    (UnbalancedTx -> Eff (NonDet : effs) UnbalancedTx)
-> RequestHandler effs UnbalancedTx UnbalancedTx
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((UnbalancedTx -> Eff (NonDet : effs) UnbalancedTx)
 -> RequestHandler effs UnbalancedTx UnbalancedTx)
-> (UnbalancedTx -> Eff (NonDet : effs) UnbalancedTx)
-> RequestHandler effs UnbalancedTx UnbalancedTx
forall a b. (a -> b) -> a -> b
$ \UnbalancedTx
utx ->
        Text
-> Eff (NonDet : effs) UnbalancedTx
-> Eff (NonDet : effs) UnbalancedTx
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleAdjustUnbalancedTx" (Eff (NonDet : effs) UnbalancedTx
 -> Eff (NonDet : effs) UnbalancedTx)
-> Eff (NonDet : effs) UnbalancedTx
-> Eff (NonDet : effs) UnbalancedTx
forall a b. (a -> b) -> a -> b
$ do
            Params
params <- Eff (NonDet : effs) Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams
            let ([Lovelace]
missingAdaCosts, UnbalancedTx
adjusted) = PParams -> UnbalancedTx -> ([Lovelace], UnbalancedTx)
Constraints.adjustUnbalancedTx (Params -> PParams
emulatorPParams Params
params) UnbalancedTx
utx
            RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug (RequestHandlerLogMsg -> Eff (NonDet : effs) ())
-> RequestHandlerLogMsg -> Eff (NonDet : effs) ()
forall a b. (a -> b) -> a -> b
$ [Lovelace] -> RequestHandlerLogMsg
AdjustingUnbalancedTx [Lovelace]
missingAdaCosts
            UnbalancedTx -> Eff (NonDet : effs) UnbalancedTx
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnbalancedTx
adjusted

handleGetParams ::
    forall effs.
    ( Member (LogObserve (LogMessage Text)) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs () Params
handleGetParams :: RequestHandler effs () Params
handleGetParams =
    (() -> Eff (NonDet : effs) Params) -> RequestHandler effs () Params
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((() -> Eff (NonDet : effs) Params)
 -> RequestHandler effs () Params)
-> (() -> Eff (NonDet : effs) Params)
-> RequestHandler effs () Params
forall a b. (a -> b) -> a -> b
$ \()
_ ->
        Text -> Eff (NonDet : effs) Params -> Eff (NonDet : effs) Params
forall v (effs :: [* -> *]) a.
Member (LogObserve (LogMessage v)) effs =>
v -> Eff effs a -> Eff effs a
surroundDebug @Text Text
"handleGetParams" (Eff (NonDet : effs) Params -> Eff (NonDet : effs) Params)
-> Eff (NonDet : effs) Params -> Eff (NonDet : effs) Params
forall a b. (a -> b) -> a -> b
$ do
            Eff (NonDet : effs) Params
forall (effs :: [* -> *]).
Member NodeClientEffect effs =>
Eff effs Params
getClientParams