{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}

{-| Handlers for the 'ChainIndexQueryEffect' and the 'ChainIndexControlEffect'
    in the emulator
-}
module Plutus.ChainIndex.Emulator.Handlers(
    handleQuery
    , handleControl
    , ChainIndexEmulatorState(..)
    , diskState
    , utxoIndex
    ) where

import Control.Lens (at, ix, makeLenses, over, preview, set, to, view, (&), (^?))
import Control.Monad (foldM)
import Control.Monad.Freer (Eff, Member, type (~>))
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logError, logWarn)
import Control.Monad.Freer.Extras.Pagination (Page (nextPageQuery, pageItems), PageQuery, pageOf)
import Control.Monad.Freer.State (State, get, gets, modify, put)
import Data.List qualified as List
import Data.Maybe (catMaybes, fromMaybe, maybeToList)
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.Set qualified as Set
import GHC.Generics (Generic)
import Ledger.Address (cardanoAddressCredential)
import Ledger.Scripts (ScriptHash (ScriptHash))
import Ledger.Tx (TxId, TxOutRef (..), Versioned)
import Ledger.Tx qualified as L (DatumFromQuery (..), DecoratedTxOut, datumInDatumFromQuery, decoratedTxOutDatum,
                                 mkPubkeyDecoratedTxOut, mkScriptDecoratedTxOut)
import Ledger.Tx.CardanoAPI (toCardanoAssetId)
import Plutus.ChainIndex.Api (IsUtxoResponse (IsUtxoResponse), QueryResponse (QueryResponse),
                              TxosResponse (TxosResponse), UtxosResponse (UtxosResponse))
import Plutus.ChainIndex.ChainIndexError (ChainIndexError (..))
import Plutus.ChainIndex.ChainIndexLog (ChainIndexLog (..))
import Plutus.ChainIndex.Effects (ChainIndexControlEffect (..), ChainIndexQueryEffect (..))
import Plutus.ChainIndex.Emulator.DiskState (DiskState, addressMap, assetClassMap, dataMap, redeemerMap, scriptMap,
                                             txMap)
import Plutus.ChainIndex.Emulator.DiskState qualified as DiskState
import Plutus.ChainIndex.Tx (txOuts)
import Plutus.ChainIndex.TxUtxoBalance qualified as TxUtxoBalance
import Plutus.ChainIndex.Types (ChainIndexTx, ChainIndexTxOut (..), ChainSyncBlock (..), Diagnostics (..),
                                Point (PointAtGenesis), Tip (..), TxProcessOption (..), TxUtxoBalance (..),
                                fromReferenceScript)
import Plutus.ChainIndex.UtxoState (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex, tip, utxoState)
import Plutus.ChainIndex.UtxoState qualified as UtxoState
import Plutus.Script.Utils.Scripts (datumHash)
import Plutus.V1.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), Datum, DatumHash,
                             MintingPolicy (MintingPolicy), MintingPolicyHash (MintingPolicyHash), Script,
                             StakeValidator (StakeValidator), StakeValidatorHash (StakeValidatorHash),
                             Validator (Validator), ValidatorHash (ValidatorHash))
import Plutus.V2.Ledger.Api (OutputDatum (..))

data ChainIndexEmulatorState =
    ChainIndexEmulatorState
        { ChainIndexEmulatorState -> DiskState
_diskState :: DiskState
        , ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance
_utxoIndex :: UtxoIndex TxUtxoBalance
        }
        deriving stock (ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool
(ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool)
-> (ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool)
-> Eq ChainIndexEmulatorState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool
$c/= :: ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool
== :: ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool
$c== :: ChainIndexEmulatorState -> ChainIndexEmulatorState -> Bool
Eq, Int -> ChainIndexEmulatorState -> ShowS
[ChainIndexEmulatorState] -> ShowS
ChainIndexEmulatorState -> String
(Int -> ChainIndexEmulatorState -> ShowS)
-> (ChainIndexEmulatorState -> String)
-> ([ChainIndexEmulatorState] -> ShowS)
-> Show ChainIndexEmulatorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainIndexEmulatorState] -> ShowS
$cshowList :: [ChainIndexEmulatorState] -> ShowS
show :: ChainIndexEmulatorState -> String
$cshow :: ChainIndexEmulatorState -> String
showsPrec :: Int -> ChainIndexEmulatorState -> ShowS
$cshowsPrec :: Int -> ChainIndexEmulatorState -> ShowS
Show, (forall x.
 ChainIndexEmulatorState -> Rep ChainIndexEmulatorState x)
-> (forall x.
    Rep ChainIndexEmulatorState x -> ChainIndexEmulatorState)
-> Generic ChainIndexEmulatorState
forall x. Rep ChainIndexEmulatorState x -> ChainIndexEmulatorState
forall x. ChainIndexEmulatorState -> Rep ChainIndexEmulatorState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainIndexEmulatorState x -> ChainIndexEmulatorState
$cfrom :: forall x. ChainIndexEmulatorState -> Rep ChainIndexEmulatorState x
Generic)
        deriving (b -> ChainIndexEmulatorState -> ChainIndexEmulatorState
NonEmpty ChainIndexEmulatorState -> ChainIndexEmulatorState
ChainIndexEmulatorState
-> ChainIndexEmulatorState -> ChainIndexEmulatorState
(ChainIndexEmulatorState
 -> ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> (NonEmpty ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> (forall b.
    Integral b =>
    b -> ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> Semigroup ChainIndexEmulatorState
forall b.
Integral b =>
b -> ChainIndexEmulatorState -> ChainIndexEmulatorState
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ChainIndexEmulatorState -> ChainIndexEmulatorState
$cstimes :: forall b.
Integral b =>
b -> ChainIndexEmulatorState -> ChainIndexEmulatorState
sconcat :: NonEmpty ChainIndexEmulatorState -> ChainIndexEmulatorState
$csconcat :: NonEmpty ChainIndexEmulatorState -> ChainIndexEmulatorState
<> :: ChainIndexEmulatorState
-> ChainIndexEmulatorState -> ChainIndexEmulatorState
$c<> :: ChainIndexEmulatorState
-> ChainIndexEmulatorState -> ChainIndexEmulatorState
Semigroup, Semigroup ChainIndexEmulatorState
ChainIndexEmulatorState
Semigroup ChainIndexEmulatorState
-> ChainIndexEmulatorState
-> (ChainIndexEmulatorState
    -> ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> ([ChainIndexEmulatorState] -> ChainIndexEmulatorState)
-> Monoid ChainIndexEmulatorState
[ChainIndexEmulatorState] -> ChainIndexEmulatorState
ChainIndexEmulatorState
-> ChainIndexEmulatorState -> ChainIndexEmulatorState
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ChainIndexEmulatorState] -> ChainIndexEmulatorState
$cmconcat :: [ChainIndexEmulatorState] -> ChainIndexEmulatorState
mappend :: ChainIndexEmulatorState
-> ChainIndexEmulatorState -> ChainIndexEmulatorState
$cmappend :: ChainIndexEmulatorState
-> ChainIndexEmulatorState -> ChainIndexEmulatorState
mempty :: ChainIndexEmulatorState
$cmempty :: ChainIndexEmulatorState
$cp1Monoid :: Semigroup ChainIndexEmulatorState
Monoid) via (GenericSemigroupMonoid ChainIndexEmulatorState)

makeLenses ''ChainIndexEmulatorState

getDatumFromHash ::
    forall effs.
    ( Member (State ChainIndexEmulatorState) effs
    )
    => DatumHash
    -> Eff effs (Maybe Datum)
getDatumFromHash :: DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash DatumHash
h = (ChainIndexEmulatorState -> Maybe Datum) -> Eff effs (Maybe Datum)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
-> ChainIndexEmulatorState -> Maybe Datum
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
 -> ChainIndexEmulatorState -> Maybe Datum)
-> Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
-> ChainIndexEmulatorState
-> Maybe Datum
forall a b. (a -> b) -> a -> b
$ (DiskState -> Const (Maybe Datum) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe Datum) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe Datum) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe Datum) ChainIndexEmulatorState)
-> ((Maybe Datum -> Const (Maybe Datum) (Maybe Datum))
    -> DiskState -> Const (Maybe Datum) DiskState)
-> Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map DatumHash Datum -> Const (Maybe Datum) (Map DatumHash Datum))
-> DiskState -> Const (Maybe Datum) DiskState
Lens' DiskState (Map DatumHash Datum)
dataMap ((Map DatumHash Datum -> Const (Maybe Datum) (Map DatumHash Datum))
 -> DiskState -> Const (Maybe Datum) DiskState)
-> ((Maybe Datum -> Const (Maybe Datum) (Maybe Datum))
    -> Map DatumHash Datum
    -> Const (Maybe Datum) (Map DatumHash Datum))
-> (Maybe Datum -> Const (Maybe Datum) (Maybe Datum))
-> DiskState
-> Const (Maybe Datum) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map DatumHash Datum)
-> Lens'
     (Map DatumHash Datum) (Maybe (IxValue (Map DatumHash Datum)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map DatumHash Datum)
DatumHash
h)

getScriptFromHash ::
    forall effs.
    ( Member (State ChainIndexEmulatorState) effs
    )
    => ScriptHash
    -> Eff effs (Maybe (Versioned Script))
getScriptFromHash :: ScriptHash -> Eff effs (Maybe (Versioned Script))
getScriptFromHash ScriptHash
h = (ChainIndexEmulatorState -> Maybe (Versioned Script))
-> Eff effs (Maybe (Versioned Script))
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting
  (Maybe (Versioned Script))
  ChainIndexEmulatorState
  (Maybe (Versioned Script))
-> ChainIndexEmulatorState -> Maybe (Versioned Script)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Maybe (Versioned Script))
   ChainIndexEmulatorState
   (Maybe (Versioned Script))
 -> ChainIndexEmulatorState -> Maybe (Versioned Script))
-> Getting
     (Maybe (Versioned Script))
     ChainIndexEmulatorState
     (Maybe (Versioned Script))
-> ChainIndexEmulatorState
-> Maybe (Versioned Script)
forall a b. (a -> b) -> a -> b
$ (DiskState -> Const (Maybe (Versioned Script)) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe (Versioned Script)) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe (Versioned Script)) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe (Versioned Script)) ChainIndexEmulatorState)
-> ((Maybe (Versioned Script)
     -> Const (Maybe (Versioned Script)) (Maybe (Versioned Script)))
    -> DiskState -> Const (Maybe (Versioned Script)) DiskState)
-> Getting
     (Maybe (Versioned Script))
     ChainIndexEmulatorState
     (Maybe (Versioned Script))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map ScriptHash (Versioned Script)
 -> Const
      (Maybe (Versioned Script)) (Map ScriptHash (Versioned Script)))
-> DiskState -> Const (Maybe (Versioned Script)) DiskState
Lens' DiskState (Map ScriptHash (Versioned Script))
scriptMap ((Map ScriptHash (Versioned Script)
  -> Const
       (Maybe (Versioned Script)) (Map ScriptHash (Versioned Script)))
 -> DiskState -> Const (Maybe (Versioned Script)) DiskState)
-> ((Maybe (Versioned Script)
     -> Const (Maybe (Versioned Script)) (Maybe (Versioned Script)))
    -> Map ScriptHash (Versioned Script)
    -> Const
         (Maybe (Versioned Script)) (Map ScriptHash (Versioned Script)))
-> (Maybe (Versioned Script)
    -> Const (Maybe (Versioned Script)) (Maybe (Versioned Script)))
-> DiskState
-> Const (Maybe (Versioned Script)) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map ScriptHash (Versioned Script))
-> Lens'
     (Map ScriptHash (Versioned Script))
     (Maybe (IxValue (Map ScriptHash (Versioned Script))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ScriptHash (Versioned Script))
ScriptHash
h)

-- | Get the 'ChainIndexTx' for a transaction ID
getTxFromTxId ::
    forall effs.
    (Member (State ChainIndexEmulatorState) effs
    , Member (LogMsg ChainIndexLog) effs
    ) => TxId
    -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId :: TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId TxId
i = do
    Maybe ChainIndexTx
result <- (ChainIndexEmulatorState -> Maybe ChainIndexTx)
-> Eff effs (Maybe ChainIndexTx)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting
  (Maybe ChainIndexTx) ChainIndexEmulatorState (Maybe ChainIndexTx)
-> ChainIndexEmulatorState -> Maybe ChainIndexTx
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Maybe ChainIndexTx) ChainIndexEmulatorState (Maybe ChainIndexTx)
 -> ChainIndexEmulatorState -> Maybe ChainIndexTx)
-> Getting
     (Maybe ChainIndexTx) ChainIndexEmulatorState (Maybe ChainIndexTx)
-> ChainIndexEmulatorState
-> Maybe ChainIndexTx
forall a b. (a -> b) -> a -> b
$ (DiskState -> Const (Maybe ChainIndexTx) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe ChainIndexTx) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe ChainIndexTx) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe ChainIndexTx) ChainIndexEmulatorState)
-> ((Maybe ChainIndexTx
     -> Const (Maybe ChainIndexTx) (Maybe ChainIndexTx))
    -> DiskState -> Const (Maybe ChainIndexTx) DiskState)
-> Getting
     (Maybe ChainIndexTx) ChainIndexEmulatorState (Maybe ChainIndexTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map TxId ChainIndexTx
 -> Const (Maybe ChainIndexTx) (Map TxId ChainIndexTx))
-> DiskState -> Const (Maybe ChainIndexTx) DiskState
Lens' DiskState (Map TxId ChainIndexTx)
txMap ((Map TxId ChainIndexTx
  -> Const (Maybe ChainIndexTx) (Map TxId ChainIndexTx))
 -> DiskState -> Const (Maybe ChainIndexTx) DiskState)
-> ((Maybe ChainIndexTx
     -> Const (Maybe ChainIndexTx) (Maybe ChainIndexTx))
    -> Map TxId ChainIndexTx
    -> Const (Maybe ChainIndexTx) (Map TxId ChainIndexTx))
-> (Maybe ChainIndexTx
    -> Const (Maybe ChainIndexTx) (Maybe ChainIndexTx))
-> DiskState
-> Const (Maybe ChainIndexTx) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map TxId ChainIndexTx)
-> Lens'
     (Map TxId ChainIndexTx) (Maybe (IxValue (Map TxId ChainIndexTx)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map TxId ChainIndexTx)
TxId
i)
    case Maybe ChainIndexTx
result of
        Maybe ChainIndexTx
Nothing -> ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (TxId -> ChainIndexLog
TxNotFound TxId
i) Eff effs ()
-> Eff effs (Maybe ChainIndexTx) -> Eff effs (Maybe ChainIndexTx)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ChainIndexTx -> Eff effs (Maybe ChainIndexTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ChainIndexTx
forall a. Maybe a
Nothing
        Maybe ChainIndexTx
_       -> Maybe ChainIndexTx -> Eff effs (Maybe ChainIndexTx)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ChainIndexTx
result


-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
getTxOutFromRef ::
  forall effs.
  ( Member (State ChainIndexEmulatorState) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => TxOutRef
  -> Eff effs (Maybe L.DecoratedTxOut)
getTxOutFromRef :: TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getTxOutFromRef ref :: TxOutRef
ref@TxOutRef{TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId :: TxId
txOutRefId, Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx :: Integer
txOutRefIdx} = do
  DiskState
ds <- (ChainIndexEmulatorState -> DiskState) -> Eff effs DiskState
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting DiskState ChainIndexEmulatorState DiskState
-> ChainIndexEmulatorState -> DiskState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DiskState ChainIndexEmulatorState DiskState
Lens' ChainIndexEmulatorState DiskState
diskState)
  -- Find the output in the tx matching the output ref
  case Getting (First ChainIndexTxOut) DiskState ChainIndexTxOut
-> DiskState -> Maybe ChainIndexTxOut
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map TxId ChainIndexTx
 -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
-> DiskState -> Const (First ChainIndexTxOut) DiskState
Lens' DiskState (Map TxId ChainIndexTx)
txMap ((Map TxId ChainIndexTx
  -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
 -> DiskState -> Const (First ChainIndexTxOut) DiskState)
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> Map TxId ChainIndexTx
    -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
-> Getting (First ChainIndexTxOut) DiskState ChainIndexTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map TxId ChainIndexTx)
-> Traversal'
     (Map TxId ChainIndexTx) (IxValue (Map TxId ChainIndexTx))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map TxId ChainIndexTx)
TxId
txOutRefId ((ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
 -> Map TxId ChainIndexTx
 -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
-> (ChainIndexTxOut
    -> Const (First ChainIndexTxOut) ChainIndexTxOut)
-> Map TxId ChainIndexTx
-> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTx -> [ChainIndexTxOut])
-> Optic'
     (->) (Const (First ChainIndexTxOut)) ChainIndexTx [ChainIndexTxOut]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ChainIndexTx -> [ChainIndexTxOut]
txOuts Optic'
  (->) (Const (First ChainIndexTxOut)) ChainIndexTx [ChainIndexTxOut]
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> [ChainIndexTxOut]
    -> Const (First ChainIndexTxOut) [ChainIndexTxOut])
-> (ChainIndexTxOut
    -> Const (First ChainIndexTxOut) ChainIndexTxOut)
-> ChainIndexTx
-> Const (First ChainIndexTxOut) ChainIndexTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [ChainIndexTxOut]
-> Traversal' [ChainIndexTxOut] (IxValue [ChainIndexTxOut])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
txOutRefIdx)) DiskState
ds of
    Maybe ChainIndexTxOut
Nothing    -> ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (TxOutRef -> ChainIndexLog
TxOutNotFound TxOutRef
ref) Eff effs ()
-> Eff effs (Maybe DecoratedTxOut)
-> Eff effs (Maybe DecoratedTxOut)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DecoratedTxOut
forall a. Maybe a
Nothing
    Just ChainIndexTxOut
txout -> ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
makeChainIndexTxOut ChainIndexTxOut
txout

-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
getUtxoutFromRef ::
  forall effs.
  ( Member (State ChainIndexEmulatorState) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => TxOutRef
  -> Eff effs (Maybe L.DecoratedTxOut)
getUtxoutFromRef :: TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getUtxoutFromRef ref :: TxOutRef
ref@TxOutRef{TxId
txOutRefId :: TxId
txOutRefId :: TxOutRef -> TxId
txOutRefId, Integer
txOutRefIdx :: Integer
txOutRefIdx :: TxOutRef -> Integer
txOutRefIdx} = do
  DiskState
ds <- (ChainIndexEmulatorState -> DiskState) -> Eff effs DiskState
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting DiskState ChainIndexEmulatorState DiskState
-> ChainIndexEmulatorState -> DiskState
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DiskState ChainIndexEmulatorState DiskState
Lens' ChainIndexEmulatorState DiskState
diskState)
  -- Find the output in the tx matching the output ref
  case Getting (First ChainIndexTxOut) DiskState ChainIndexTxOut
-> DiskState -> Maybe ChainIndexTxOut
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map TxId ChainIndexTx
 -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
-> DiskState -> Const (First ChainIndexTxOut) DiskState
Lens' DiskState (Map TxId ChainIndexTx)
txMap ((Map TxId ChainIndexTx
  -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
 -> DiskState -> Const (First ChainIndexTxOut) DiskState)
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> Map TxId ChainIndexTx
    -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
-> Getting (First ChainIndexTxOut) DiskState ChainIndexTxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map TxId ChainIndexTx)
-> Traversal'
     (Map TxId ChainIndexTx) (IxValue (Map TxId ChainIndexTx))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map TxId ChainIndexTx)
TxId
txOutRefId ((ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
 -> Map TxId ChainIndexTx
 -> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx))
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
-> (ChainIndexTxOut
    -> Const (First ChainIndexTxOut) ChainIndexTxOut)
-> Map TxId ChainIndexTx
-> Const (First ChainIndexTxOut) (Map TxId ChainIndexTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTx -> [ChainIndexTxOut])
-> Optic'
     (->) (Const (First ChainIndexTxOut)) ChainIndexTx [ChainIndexTxOut]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ChainIndexTx -> [ChainIndexTxOut]
txOuts Optic'
  (->) (Const (First ChainIndexTxOut)) ChainIndexTx [ChainIndexTxOut]
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> [ChainIndexTxOut]
    -> Const (First ChainIndexTxOut) [ChainIndexTxOut])
-> (ChainIndexTxOut
    -> Const (First ChainIndexTxOut) ChainIndexTxOut)
-> ChainIndexTx
-> Const (First ChainIndexTxOut) ChainIndexTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [ChainIndexTxOut]
-> Traversal' [ChainIndexTxOut] (IxValue [ChainIndexTxOut])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
txOutRefIdx)) DiskState
ds of
    Maybe ChainIndexTxOut
Nothing    -> ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (TxOutRef -> ChainIndexLog
TxOutNotFound TxOutRef
ref) Eff effs ()
-> Eff effs (Maybe DecoratedTxOut)
-> Eff effs (Maybe DecoratedTxOut)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DecoratedTxOut
forall a. Maybe a
Nothing
    Just ChainIndexTxOut
txout -> do ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
makeChainIndexTxOut ChainIndexTxOut
txout

makeChainIndexTxOut ::
  forall effs.
  ( Member (State ChainIndexEmulatorState) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => ChainIndexTxOut
  -> Eff effs (Maybe L.DecoratedTxOut)
makeChainIndexTxOut :: ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
makeChainIndexTxOut txout :: ChainIndexTxOut
txout@(ChainIndexTxOut CardanoAddress
address Value
value OutputDatum
datum ReferenceScript
refScript) = do
  Maybe (DatumHash, DatumFromQuery)
datumWithHash <- OutputDatum -> Eff effs (Maybe (DatumHash, DatumFromQuery))
getDatumWithHash OutputDatum
datum
  -- The output might come from a public key address or a script address.
  -- We need to handle them differently.
  case CardanoAddress -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential (CardanoAddress -> Credential) -> CardanoAddress -> Credential
forall a b. (a -> b) -> a -> b
$ ChainIndexTxOut -> CardanoAddress
citoAddress ChainIndexTxOut
txout of
    PubKeyCredential PubKeyHash
_ -> Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut))
-> Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall a b. (a -> b) -> a -> b
$ CardanoAddress
-> Value
-> Maybe (DatumHash, DatumFromQuery)
-> Maybe (Versioned Script)
-> Maybe DecoratedTxOut
L.mkPubkeyDecoratedTxOut CardanoAddress
address Value
value Maybe (DatumHash, DatumFromQuery)
datumWithHash Maybe (Versioned Script)
script
    ScriptCredential (ValidatorHash BuiltinByteString
h) -> do
      case Maybe (DatumHash, DatumFromQuery)
datumWithHash of
        Just (DatumHash, DatumFromQuery)
d -> do
          Maybe (Versioned Script)
v <- ScriptHash -> Eff effs (Maybe (Versioned Script))
forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
ScriptHash -> Eff effs (Maybe (Versioned Script))
getScriptFromHash (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
h)
          Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut))
-> Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall a b. (a -> b) -> a -> b
$ CardanoAddress
-> Value
-> (DatumHash, DatumFromQuery)
-> Maybe (Versioned Script)
-> Maybe (Versioned Validator)
-> Maybe DecoratedTxOut
L.mkScriptDecoratedTxOut CardanoAddress
address Value
value (DatumHash, DatumFromQuery)
d Maybe (Versioned Script)
script ((Script -> Validator) -> Versioned Script -> Versioned Validator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> Validator
Validator (Versioned Script -> Versioned Validator)
-> Maybe (Versioned Script) -> Maybe (Versioned Validator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Versioned Script)
v)
        Maybe (DatumHash, DatumFromQuery)
Nothing -> do
          -- If the txout comes from a script address, the Datum should not be Nothing
          ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (ChainIndexLog -> Eff effs ()) -> ChainIndexLog -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ChainIndexTxOut -> ChainIndexLog
NoDatumScriptAddr ChainIndexTxOut
txout
          Maybe DecoratedTxOut -> Eff effs (Maybe DecoratedTxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DecoratedTxOut
forall a. Maybe a
Nothing
 where
    getDatumWithHash :: OutputDatum -> Eff effs (Maybe (DatumHash, L.DatumFromQuery))
    getDatumWithHash :: OutputDatum -> Eff effs (Maybe (DatumHash, DatumFromQuery))
getDatumWithHash OutputDatum
NoOutputDatum = Maybe (DatumHash, DatumFromQuery)
-> Eff effs (Maybe (DatumHash, DatumFromQuery))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (DatumHash, DatumFromQuery)
forall a. Maybe a
Nothing
    getDatumWithHash (OutputDatumHash DatumHash
dh) = do
        Maybe Datum
d <- DatumHash -> Eff effs (Maybe Datum)
forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash DatumHash
dh
        Maybe (DatumHash, DatumFromQuery)
-> Eff effs (Maybe (DatumHash, DatumFromQuery))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DatumHash, DatumFromQuery)
 -> Eff effs (Maybe (DatumHash, DatumFromQuery)))
-> Maybe (DatumHash, DatumFromQuery)
-> Eff effs (Maybe (DatumHash, DatumFromQuery))
forall a b. (a -> b) -> a -> b
$ (DatumHash, DatumFromQuery) -> Maybe (DatumHash, DatumFromQuery)
forall a. a -> Maybe a
Just (DatumHash
dh, DatumFromQuery
-> (Datum -> DatumFromQuery) -> Maybe Datum -> DatumFromQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DatumFromQuery
L.DatumUnknown Datum -> DatumFromQuery
L.DatumInBody Maybe Datum
d)
    getDatumWithHash (OutputDatum Datum
d) = do
        Maybe (DatumHash, DatumFromQuery)
-> Eff effs (Maybe (DatumHash, DatumFromQuery))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (DatumHash, DatumFromQuery)
 -> Eff effs (Maybe (DatumHash, DatumFromQuery)))
-> Maybe (DatumHash, DatumFromQuery)
-> Eff effs (Maybe (DatumHash, DatumFromQuery))
forall a b. (a -> b) -> a -> b
$ (DatumHash, DatumFromQuery) -> Maybe (DatumHash, DatumFromQuery)
forall a. a -> Maybe a
Just (Datum -> DatumHash
datumHash Datum
d, Datum -> DatumFromQuery
L.DatumInline Datum
d)

    script :: Maybe (Versioned Script)
script = ReferenceScript -> Maybe (Versioned Script)
fromReferenceScript ReferenceScript
refScript

-- | Unspent outputs located at addresses with the given credential.
getUtxoSetAtAddress ::
  forall effs.
  ( Member (State ChainIndexEmulatorState) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => PageQuery TxOutRef
  -> Credential
  -> Eff effs UtxosResponse
getUtxoSetAtAddress :: PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred = do
  ChainIndexEmulatorState
state <- Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
  let outRefs :: Maybe (Set TxOutRef)
outRefs = Getting
  (Maybe (Set TxOutRef))
  ChainIndexEmulatorState
  (Maybe (Set TxOutRef))
-> ChainIndexEmulatorState -> Maybe (Set TxOutRef)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> Getting
     (Maybe (Set TxOutRef))
     ChainIndexEmulatorState
     (Maybe (Set TxOutRef))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
-> DiskState -> Const (Maybe (Set TxOutRef)) DiskState
Lens' DiskState CredentialMap
addressMap ((CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
 -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
-> (Maybe (Set TxOutRef)
    -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
-> DiskState
-> Const (Maybe (Set TxOutRef)) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index CredentialMap
-> Lens' CredentialMap (Maybe (IxValue CredentialMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index CredentialMap
Credential
cred) ChainIndexEmulatorState
state
      utxo :: UtxoState TxUtxoBalance
utxo = Getting
  (UtxoState TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoState TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoState TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UtxoIndex TxUtxoBalance
 -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> ChainIndexEmulatorState
-> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex ((UtxoIndex TxUtxoBalance
  -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
 -> ChainIndexEmulatorState
 -> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState)
-> ((UtxoState TxUtxoBalance
     -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
    -> UtxoIndex TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> Getting
     (UtxoState TxUtxoBalance)
     ChainIndexEmulatorState
     (UtxoState TxUtxoBalance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (UtxoState TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
-> UtxoIndex TxUtxoBalance
-> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState) ChainIndexEmulatorState
state
      utxoRefs :: Set TxOutRef
utxoRefs = (TxOutRef -> Bool) -> Set TxOutRef -> Set TxOutRef
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((TxOutRef -> UtxoState TxUtxoBalance -> Bool)
-> UtxoState TxUtxoBalance -> TxOutRef -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip TxOutRef -> UtxoState TxUtxoBalance -> Bool
TxUtxoBalance.isUnspentOutput UtxoState TxUtxoBalance
utxo)
                            (Set TxOutRef -> Maybe (Set TxOutRef) -> Set TxOutRef
forall a. a -> Maybe a -> a
fromMaybe Set TxOutRef
forall a. Monoid a => a
mempty Maybe (Set TxOutRef)
outRefs)
      page :: Page TxOutRef
page = PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
utxoRefs
  case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
tip UtxoState TxUtxoBalance
utxo of
    Tip
TipAtGenesis -> do
      ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn ChainIndexLog
TipIsGenesis
      UtxosResponse -> Eff effs UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
TipAtGenesis (PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
forall a. Set a
Set.empty))
    Tip
tp           -> UtxosResponse -> Eff effs UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
tp Page TxOutRef
page)


handleQuery ::
    forall effs.
    ( Member (State ChainIndexEmulatorState) effs
    , Member (Error ChainIndexError) effs
    , Member (LogMsg ChainIndexLog) effs
    ) => ChainIndexQueryEffect
    ~> Eff effs
handleQuery :: ChainIndexQueryEffect ~> Eff effs
handleQuery = \case
    DatumFromHash DatumHash
h -> DatumHash -> Eff effs (Maybe Datum)
forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash DatumHash
h
    ValidatorFromHash (ValidatorHash BuiltinByteString
h) ->  do
      (Versioned Script -> Versioned Validator)
-> Maybe (Versioned Script) -> Maybe (Versioned Validator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Script -> Validator) -> Versioned Script -> Versioned Validator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> Validator
Validator) (Maybe (Versioned Script) -> Maybe (Versioned Validator))
-> Eff effs (Maybe (Versioned Script))
-> Eff effs (Maybe (Versioned Validator))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> Eff effs (Maybe (Versioned Script))
forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
ScriptHash -> Eff effs (Maybe (Versioned Script))
getScriptFromHash (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
h)
    MintingPolicyFromHash (MintingPolicyHash BuiltinByteString
h) ->
      (Versioned Script -> Versioned MintingPolicy)
-> Maybe (Versioned Script) -> Maybe (Versioned MintingPolicy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Script -> MintingPolicy)
-> Versioned Script -> Versioned MintingPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> MintingPolicy
MintingPolicy) (Maybe (Versioned Script) -> Maybe (Versioned MintingPolicy))
-> Eff effs (Maybe (Versioned Script))
-> Eff effs (Maybe (Versioned MintingPolicy))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> Eff effs (Maybe (Versioned Script))
forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
ScriptHash -> Eff effs (Maybe (Versioned Script))
getScriptFromHash (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
h)
    StakeValidatorFromHash (StakeValidatorHash BuiltinByteString
h) ->
      (Versioned Script -> Versioned StakeValidator)
-> Maybe (Versioned Script) -> Maybe (Versioned StakeValidator)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Script -> StakeValidator)
-> Versioned Script -> Versioned StakeValidator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Script -> StakeValidator
StakeValidator) (Maybe (Versioned Script) -> Maybe (Versioned StakeValidator))
-> Eff effs (Maybe (Versioned Script))
-> Eff effs (Maybe (Versioned StakeValidator))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> Eff effs (Maybe (Versioned Script))
forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
ScriptHash -> Eff effs (Maybe (Versioned Script))
getScriptFromHash (BuiltinByteString -> ScriptHash
ScriptHash BuiltinByteString
h)
    UnspentTxOutFromRef TxOutRef
ref -> TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getTxOutFromRef TxOutRef
ref
    TxOutFromRef TxOutRef
ref -> TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getTxOutFromRef TxOutRef
ref
    RedeemerFromHash RedeemerHash
h -> (ChainIndexEmulatorState -> x) -> Eff effs x
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting (Maybe Redeemer) ChainIndexEmulatorState (Maybe Redeemer)
-> ChainIndexEmulatorState -> Maybe Redeemer
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Redeemer) ChainIndexEmulatorState (Maybe Redeemer)
 -> ChainIndexEmulatorState -> Maybe Redeemer)
-> Getting
     (Maybe Redeemer) ChainIndexEmulatorState (Maybe Redeemer)
-> ChainIndexEmulatorState
-> Maybe Redeemer
forall a b. (a -> b) -> a -> b
$ (DiskState -> Const (Maybe Redeemer) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe Redeemer) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe Redeemer) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe Redeemer) ChainIndexEmulatorState)
-> ((Maybe Redeemer -> Const (Maybe Redeemer) (Maybe Redeemer))
    -> DiskState -> Const (Maybe Redeemer) DiskState)
-> Getting
     (Maybe Redeemer) ChainIndexEmulatorState (Maybe Redeemer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map RedeemerHash Redeemer
 -> Const (Maybe Redeemer) (Map RedeemerHash Redeemer))
-> DiskState -> Const (Maybe Redeemer) DiskState
Lens' DiskState (Map RedeemerHash Redeemer)
redeemerMap ((Map RedeemerHash Redeemer
  -> Const (Maybe Redeemer) (Map RedeemerHash Redeemer))
 -> DiskState -> Const (Maybe Redeemer) DiskState)
-> ((Maybe Redeemer -> Const (Maybe Redeemer) (Maybe Redeemer))
    -> Map RedeemerHash Redeemer
    -> Const (Maybe Redeemer) (Map RedeemerHash Redeemer))
-> (Maybe Redeemer -> Const (Maybe Redeemer) (Maybe Redeemer))
-> DiskState
-> Const (Maybe Redeemer) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map RedeemerHash Redeemer)
-> Lens'
     (Map RedeemerHash Redeemer)
     (Maybe (IxValue (Map RedeemerHash Redeemer)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map RedeemerHash Redeemer)
RedeemerHash
h)
    TxFromTxId TxId
i -> TxId -> Eff effs (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId TxId
i
    UtxoSetMembership TxOutRef
r -> do
        UtxoState TxUtxoBalance
utxo <- (ChainIndexEmulatorState -> UtxoState TxUtxoBalance)
-> Eff effs (UtxoState TxUtxoBalance)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState
-> UtxoState TxUtxoBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex)
        case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
tip UtxoState TxUtxoBalance
utxo of
            Tip
TipAtGenesis -> ChainIndexError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError ChainIndexError
QueryFailedNoTip
            Tip
tp           -> IsUtxoResponse -> Eff effs IsUtxoResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Bool -> IsUtxoResponse
IsUtxoResponse Tip
tp (TxOutRef -> UtxoState TxUtxoBalance -> Bool
TxUtxoBalance.isUnspentOutput TxOutRef
r UtxoState TxUtxoBalance
utxo))
    UtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
    UnspentTxOutSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> do
        (UtxosResponse Tip
tp Page TxOutRef
page) <- PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
        case Tip
tp of
          Tip
TipAtGenesis -> do
            QueryResponse [(TxOutRef, DecoratedTxOut)]
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResponse [(TxOutRef, DecoratedTxOut)]
 -> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)]))
-> QueryResponse [(TxOutRef, DecoratedTxOut)]
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall a b. (a -> b) -> a -> b
$ [(TxOutRef, DecoratedTxOut)]
-> Maybe (PageQuery TxOutRef)
-> QueryResponse [(TxOutRef, DecoratedTxOut)]
forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse [] Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing
          Tip
_            -> do
            [Maybe DecoratedTxOut]
mtxouts <- (TxOutRef -> Eff effs (Maybe DecoratedTxOut))
-> [TxOutRef] -> Eff effs [Maybe DecoratedTxOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getUtxoutFromRef (Page TxOutRef -> [TxOutRef]
forall a. Page a -> [a]
pageItems Page TxOutRef
page)
            let txouts :: [(TxOutRef, DecoratedTxOut)]
txouts = [ (TxOutRef
t, DecoratedTxOut
o) | (TxOutRef
t, Maybe DecoratedTxOut
mo) <- [TxOutRef]
-> [Maybe DecoratedTxOut] -> [(TxOutRef, Maybe DecoratedTxOut)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip (Page TxOutRef -> [TxOutRef]
forall a. Page a -> [a]
pageItems Page TxOutRef
page) [Maybe DecoratedTxOut]
mtxouts, DecoratedTxOut
o <- Maybe DecoratedTxOut -> [DecoratedTxOut]
forall a. Maybe a -> [a]
maybeToList Maybe DecoratedTxOut
mo]
            QueryResponse [(TxOutRef, DecoratedTxOut)]
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResponse [(TxOutRef, DecoratedTxOut)]
 -> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)]))
-> QueryResponse [(TxOutRef, DecoratedTxOut)]
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall a b. (a -> b) -> a -> b
$ [(TxOutRef, DecoratedTxOut)]
-> Maybe (PageQuery TxOutRef)
-> QueryResponse [(TxOutRef, DecoratedTxOut)]
forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse [(TxOutRef, DecoratedTxOut)]
txouts (Page TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. Page a -> Maybe (PageQuery a)
nextPageQuery Page TxOutRef
page)
    DatumsAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> do
      ChainIndexEmulatorState
state <- Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
      let outRefs :: Maybe (Set TxOutRef)
outRefs = Getting
  (Maybe (Set TxOutRef))
  ChainIndexEmulatorState
  (Maybe (Set TxOutRef))
-> ChainIndexEmulatorState -> Maybe (Set TxOutRef)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> Getting
     (Maybe (Set TxOutRef))
     ChainIndexEmulatorState
     (Maybe (Set TxOutRef))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
-> DiskState -> Const (Maybe (Set TxOutRef)) DiskState
Lens' DiskState CredentialMap
addressMap ((CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
 -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
-> (Maybe (Set TxOutRef)
    -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
-> DiskState
-> Const (Maybe (Set TxOutRef)) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index CredentialMap
-> Lens' CredentialMap (Maybe (IxValue CredentialMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index CredentialMap
Credential
cred) ChainIndexEmulatorState
state
          txoRefs :: Set TxOutRef
txoRefs = Set TxOutRef -> Maybe (Set TxOutRef) -> Set TxOutRef
forall a. a -> Maybe a -> a
fromMaybe Set TxOutRef
forall a. Monoid a => a
mempty Maybe (Set TxOutRef)
outRefs
          utxo :: UtxoState TxUtxoBalance
utxo = Getting
  (UtxoState TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoState TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoState TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UtxoIndex TxUtxoBalance
 -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> ChainIndexEmulatorState
-> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex ((UtxoIndex TxUtxoBalance
  -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
 -> ChainIndexEmulatorState
 -> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState)
-> ((UtxoState TxUtxoBalance
     -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
    -> UtxoIndex TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> Getting
     (UtxoState TxUtxoBalance)
     ChainIndexEmulatorState
     (UtxoState TxUtxoBalance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (UtxoState TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
-> UtxoIndex TxUtxoBalance
-> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState) ChainIndexEmulatorState
state
          page :: Page TxOutRef
page = PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
txoRefs
          resolveDatum :: (Maybe DatumHash, Maybe Datum) -> Eff effs (Maybe Datum)
resolveDatum (Just DatumHash
h, Maybe Datum
Nothing) = (ChainIndexEmulatorState -> Maybe Datum) -> Eff effs (Maybe Datum)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
-> ChainIndexEmulatorState -> Maybe Datum
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
 -> ChainIndexEmulatorState -> Maybe Datum)
-> Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
-> ChainIndexEmulatorState
-> Maybe Datum
forall a b. (a -> b) -> a -> b
$ (DiskState -> Const (Maybe Datum) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe Datum) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe Datum) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe Datum) ChainIndexEmulatorState)
-> ((Maybe Datum -> Const (Maybe Datum) (Maybe Datum))
    -> DiskState -> Const (Maybe Datum) DiskState)
-> Getting (Maybe Datum) ChainIndexEmulatorState (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map DatumHash Datum -> Const (Maybe Datum) (Map DatumHash Datum))
-> DiskState -> Const (Maybe Datum) DiskState
Lens' DiskState (Map DatumHash Datum)
dataMap ((Map DatumHash Datum -> Const (Maybe Datum) (Map DatumHash Datum))
 -> DiskState -> Const (Maybe Datum) DiskState)
-> ((Maybe Datum -> Const (Maybe Datum) (Maybe Datum))
    -> Map DatumHash Datum
    -> Const (Maybe Datum) (Map DatumHash Datum))
-> (Maybe Datum -> Const (Maybe Datum) (Maybe Datum))
-> DiskState
-> Const (Maybe Datum) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map DatumHash Datum)
-> Lens'
     (Map DatumHash Datum) (Maybe (IxValue (Map DatumHash Datum)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map DatumHash Datum)
DatumHash
h)
          resolveDatum (Maybe DatumHash
_, Just Datum
d)       = Maybe Datum -> Eff effs (Maybe Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Datum -> Eff effs (Maybe Datum))
-> Maybe Datum -> Eff effs (Maybe Datum)
forall a b. (a -> b) -> a -> b
$ Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
d
          resolveDatum (Maybe DatumHash
_, Maybe Datum
_)            = Maybe Datum -> Eff effs (Maybe Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Datum
forall a. Maybe a
Nothing
          txOutToDatum :: DecoratedTxOut -> (Maybe DatumHash, Maybe Datum)
txOutToDatum DecoratedTxOut
txout = (Maybe DatumHash, Maybe Datum)
-> Maybe (Maybe DatumHash, Maybe Datum)
-> (Maybe DatumHash, Maybe Datum)
forall a. a -> Maybe a -> a
fromMaybe (Maybe DatumHash
forall a. Maybe a
Nothing, Maybe Datum
forall a. Maybe a
Nothing) (Maybe (Maybe DatumHash, Maybe Datum)
 -> (Maybe DatumHash, Maybe Datum))
-> Maybe (Maybe DatumHash, Maybe Datum)
-> (Maybe DatumHash, Maybe Datum)
forall a b. (a -> b) -> a -> b
$ do
              (DatumHash
dh, DatumFromQuery
mdatum) <- DecoratedTxOut
txout DecoratedTxOut
-> Getting
     (First (DatumHash, DatumFromQuery))
     DecoratedTxOut
     (DatumHash, DatumFromQuery)
-> Maybe (DatumHash, DatumFromQuery)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (DatumHash, DatumFromQuery))
  DecoratedTxOut
  (DatumHash, DatumFromQuery)
Traversal' DecoratedTxOut (DatumHash, DatumFromQuery)
L.decoratedTxOutDatum
              (Maybe DatumHash, Maybe Datum)
-> Maybe (Maybe DatumHash, Maybe Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just DatumHash
dh, DatumFromQuery
mdatum DatumFromQuery
-> Getting (First Datum) DatumFromQuery Datum -> Maybe Datum
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Datum) DatumFromQuery Datum
Traversal' DatumFromQuery Datum
L.datumInDatumFromQuery)
      [DecoratedTxOut]
txouts <- [Maybe DecoratedTxOut] -> [DecoratedTxOut]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe DecoratedTxOut] -> [DecoratedTxOut])
-> Eff effs [Maybe DecoratedTxOut] -> Eff effs [DecoratedTxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxOutRef -> Eff effs (Maybe DecoratedTxOut))
-> [TxOutRef] -> Eff effs [Maybe DecoratedTxOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getTxOutFromRef (Page TxOutRef -> [TxOutRef]
forall a. Page a -> [a]
pageItems Page TxOutRef
page)
      [Datum]
datums <- [Maybe Datum] -> [Datum]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Datum] -> [Datum])
-> Eff effs [Maybe Datum] -> Eff effs [Datum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DecoratedTxOut -> Eff effs (Maybe Datum))
-> [DecoratedTxOut] -> Eff effs [Maybe Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe DatumHash, Maybe Datum) -> Eff effs (Maybe Datum)
forall (effs :: [* -> *]).
FindElem (State ChainIndexEmulatorState) effs =>
(Maybe DatumHash, Maybe Datum) -> Eff effs (Maybe Datum)
resolveDatum ((Maybe DatumHash, Maybe Datum) -> Eff effs (Maybe Datum))
-> (DecoratedTxOut -> (Maybe DatumHash, Maybe Datum))
-> DecoratedTxOut
-> Eff effs (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoratedTxOut -> (Maybe DatumHash, Maybe Datum)
txOutToDatum) [DecoratedTxOut]
txouts
      case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
tip UtxoState TxUtxoBalance
utxo of
        Tip
TipAtGenesis -> do
          ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn ChainIndexLog
TipIsGenesis
          QueryResponse [Datum] -> Eff effs (QueryResponse [Datum])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResponse [Datum] -> Eff effs (QueryResponse [Datum]))
-> QueryResponse [Datum] -> Eff effs (QueryResponse [Datum])
forall a b. (a -> b) -> a -> b
$ [Datum] -> Maybe (PageQuery TxOutRef) -> QueryResponse [Datum]
forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse [] Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing
        Tip
_ -> QueryResponse [Datum] -> Eff effs (QueryResponse [Datum])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryResponse [Datum] -> Eff effs (QueryResponse [Datum]))
-> QueryResponse [Datum] -> Eff effs (QueryResponse [Datum])
forall a b. (a -> b) -> a -> b
$ [Datum] -> Maybe (PageQuery TxOutRef) -> QueryResponse [Datum]
forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse [Datum]
datums (Page TxOutRef -> Maybe (PageQuery TxOutRef)
forall a. Page a -> Maybe (PageQuery a)
nextPageQuery Page TxOutRef
page)
    UtxoSetWithCurrency PageQuery TxOutRef
pageQuery AssetClass
assetClass -> do
        AssetId
assetId <- (ToCardanoError -> Eff effs AssetId)
-> (AssetId -> Eff effs AssetId)
-> Either ToCardanoError AssetId
-> Eff effs AssetId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ChainIndexError -> Eff effs AssetId
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ChainIndexError -> Eff effs AssetId)
-> (ToCardanoError -> ChainIndexError)
-> ToCardanoError
-> Eff effs AssetId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> ChainIndexError
ToCardanoError) AssetId -> Eff effs AssetId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ToCardanoError AssetId -> Eff effs AssetId)
-> Either ToCardanoError AssetId -> Eff effs AssetId
forall a b. (a -> b) -> a -> b
$ AssetClass -> Either ToCardanoError AssetId
toCardanoAssetId AssetClass
assetClass
        ChainIndexEmulatorState
state <- Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
        let outRefs :: Maybe (Set TxOutRef)
outRefs = Getting
  (Maybe (Set TxOutRef))
  ChainIndexEmulatorState
  (Maybe (Set TxOutRef))
-> ChainIndexEmulatorState -> Maybe (Set TxOutRef)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> Getting
     (Maybe (Set TxOutRef))
     ChainIndexEmulatorState
     (Maybe (Set TxOutRef))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssetClassMap -> Const (Maybe (Set TxOutRef)) AssetClassMap)
-> DiskState -> Const (Maybe (Set TxOutRef)) DiskState
Lens' DiskState AssetClassMap
assetClassMap ((AssetClassMap -> Const (Maybe (Set TxOutRef)) AssetClassMap)
 -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> AssetClassMap -> Const (Maybe (Set TxOutRef)) AssetClassMap)
-> (Maybe (Set TxOutRef)
    -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
-> DiskState
-> Const (Maybe (Set TxOutRef)) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index AssetClassMap
-> Lens' AssetClassMap (Maybe (IxValue AssetClassMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at AssetId
Index AssetClassMap
assetId) ChainIndexEmulatorState
state
            utxo :: UtxoState TxUtxoBalance
utxo = Getting
  (UtxoState TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoState TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoState TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UtxoIndex TxUtxoBalance
 -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> ChainIndexEmulatorState
-> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex ((UtxoIndex TxUtxoBalance
  -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
 -> ChainIndexEmulatorState
 -> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState)
-> ((UtxoState TxUtxoBalance
     -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
    -> UtxoIndex TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> Getting
     (UtxoState TxUtxoBalance)
     ChainIndexEmulatorState
     (UtxoState TxUtxoBalance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (UtxoState TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
-> UtxoIndex TxUtxoBalance
-> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState) ChainIndexEmulatorState
state
            utxoRefs :: Set TxOutRef
utxoRefs = (TxOutRef -> Bool) -> Set TxOutRef -> Set TxOutRef
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((TxOutRef -> UtxoState TxUtxoBalance -> Bool)
-> UtxoState TxUtxoBalance -> TxOutRef -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip TxOutRef -> UtxoState TxUtxoBalance -> Bool
TxUtxoBalance.isUnspentOutput UtxoState TxUtxoBalance
utxo) (Set TxOutRef -> Maybe (Set TxOutRef) -> Set TxOutRef
forall a. a -> Maybe a -> a
fromMaybe Set TxOutRef
forall a. Monoid a => a
mempty Maybe (Set TxOutRef)
outRefs)
            page :: Page TxOutRef
page = PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
utxoRefs
        case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
tip UtxoState TxUtxoBalance
utxo of
            Tip
TipAtGenesis -> do
                ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn ChainIndexLog
TipIsGenesis
                UtxosResponse -> Eff effs UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
TipAtGenesis (PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
forall a. Set a
Set.empty))
            Tip
tp           -> UtxosResponse -> Eff effs UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
tp Page TxOutRef
page)
    TxsFromTxIds [TxId]
is -> [Maybe ChainIndexTx] -> [ChainIndexTx]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ChainIndexTx] -> [ChainIndexTx])
-> Eff effs [Maybe ChainIndexTx] -> Eff effs [ChainIndexTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxId -> Eff effs (Maybe ChainIndexTx))
-> [TxId] -> Eff effs [Maybe ChainIndexTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxId -> Eff effs (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId [TxId]
is
    TxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> do
        ChainIndexEmulatorState
state <- Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
        let outRefs :: Maybe (Set TxOutRef)
outRefs = Getting
  (Maybe (Set TxOutRef))
  ChainIndexEmulatorState
  (Maybe (Set TxOutRef))
-> ChainIndexEmulatorState -> Maybe (Set TxOutRef)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ChainIndexEmulatorState
-> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState DiskState
diskState ((DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
 -> ChainIndexEmulatorState
 -> Const (Maybe (Set TxOutRef)) ChainIndexEmulatorState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> Getting
     (Maybe (Set TxOutRef))
     ChainIndexEmulatorState
     (Maybe (Set TxOutRef))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
-> DiskState -> Const (Maybe (Set TxOutRef)) DiskState
Lens' DiskState CredentialMap
addressMap ((CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
 -> DiskState -> Const (Maybe (Set TxOutRef)) DiskState)
-> ((Maybe (Set TxOutRef)
     -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
    -> CredentialMap -> Const (Maybe (Set TxOutRef)) CredentialMap)
-> (Maybe (Set TxOutRef)
    -> Const (Maybe (Set TxOutRef)) (Maybe (Set TxOutRef)))
-> DiskState
-> Const (Maybe (Set TxOutRef)) DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index CredentialMap
-> Lens' CredentialMap (Maybe (IxValue CredentialMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index CredentialMap
Credential
cred) ChainIndexEmulatorState
state
            txoRefs :: Set TxOutRef
txoRefs = Set TxOutRef -> Maybe (Set TxOutRef) -> Set TxOutRef
forall a. a -> Maybe a -> a
fromMaybe Set TxOutRef
forall a. Monoid a => a
mempty Maybe (Set TxOutRef)
outRefs
            utxo :: UtxoState TxUtxoBalance
utxo = Getting
  (UtxoState TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoState TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoState TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UtxoIndex TxUtxoBalance
 -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> ChainIndexEmulatorState
-> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex ((UtxoIndex TxUtxoBalance
  -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
 -> ChainIndexEmulatorState
 -> Const (UtxoState TxUtxoBalance) ChainIndexEmulatorState)
-> ((UtxoState TxUtxoBalance
     -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
    -> UtxoIndex TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance))
-> Getting
     (UtxoState TxUtxoBalance)
     ChainIndexEmulatorState
     (UtxoState TxUtxoBalance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (UtxoState TxUtxoBalance
    -> Const (UtxoState TxUtxoBalance) (UtxoState TxUtxoBalance))
-> UtxoIndex TxUtxoBalance
-> Const (UtxoState TxUtxoBalance) (UtxoIndex TxUtxoBalance)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState) ChainIndexEmulatorState
state
            page :: Page TxOutRef
page = PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
txoRefs
        case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
tip UtxoState TxUtxoBalance
utxo of
            Tip
TipAtGenesis -> do
                ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn ChainIndexLog
TipIsGenesis
                TxosResponse -> Eff effs TxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxosResponse -> Eff effs TxosResponse)
-> TxosResponse -> Eff effs TxosResponse
forall a b. (a -> b) -> a -> b
$ Page TxOutRef -> TxosResponse
TxosResponse (Page TxOutRef -> TxosResponse) -> Page TxOutRef -> TxosResponse
forall a b. (a -> b) -> a -> b
$ PageQuery TxOutRef -> Set TxOutRef -> Page TxOutRef
forall a. Eq a => PageQuery a -> Set a -> Page a
pageOf PageQuery TxOutRef
pageQuery Set TxOutRef
forall a. Set a
Set.empty
            Tip
_            -> TxosResponse -> Eff effs TxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxosResponse -> Eff effs TxosResponse)
-> TxosResponse -> Eff effs TxosResponse
forall a b. (a -> b) -> a -> b
$ Page TxOutRef -> TxosResponse
TxosResponse Page TxOutRef
page
    ChainIndexQueryEffect x
GetTip ->
        (ChainIndexEmulatorState -> Tip) -> Eff effs Tip
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
tip (UtxoState TxUtxoBalance -> Tip)
-> (ChainIndexEmulatorState -> UtxoState TxUtxoBalance)
-> ChainIndexEmulatorState
-> Tip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState
-> UtxoState TxUtxoBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex)

appendBlocks ::
    forall effs.
    ( Member (State ChainIndexEmulatorState) effs
    , Member (LogMsg ChainIndexLog) effs
    )
    => [ChainSyncBlock] -> Eff effs ()
appendBlocks :: [ChainSyncBlock] -> Eff effs ()
appendBlocks [] = () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
appendBlocks [ChainSyncBlock]
blocks = do
    let
        processBlock :: (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
-> ChainSyncBlock
-> Eff
     effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
processBlock (UtxoIndex TxUtxoBalance
utxoIndexState, [(ChainIndexTx, TxProcessOption)]
txs) (Block Tip
tip_ [(ChainIndexTx, TxProcessOption)]
transactions) = do
            case UtxoState TxUtxoBalance
-> UtxoIndex TxUtxoBalance
-> Either InsertUtxoFailed (InsertUtxoSuccess TxUtxoBalance)
forall a.
(Monoid a, Eq a) =>
UtxoState a
-> UtxoIndex a -> Either InsertUtxoFailed (InsertUtxoSuccess a)
UtxoState.insert (Tip -> [ChainIndexTx] -> UtxoState TxUtxoBalance
TxUtxoBalance.fromBlock Tip
tip_ (((ChainIndexTx, TxProcessOption) -> ChainIndexTx)
-> [(ChainIndexTx, TxProcessOption)] -> [ChainIndexTx]
forall a b. (a -> b) -> [a] -> [b]
map (ChainIndexTx, TxProcessOption) -> ChainIndexTx
forall a b. (a, b) -> a
fst [(ChainIndexTx, TxProcessOption)]
transactions)) UtxoIndex TxUtxoBalance
utxoIndexState of
                Left InsertUtxoFailed
err -> do
                    let reason :: ChainIndexError
reason = InsertUtxoFailed -> ChainIndexError
InsertionFailed InsertUtxoFailed
err
                    ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logError (ChainIndexLog -> Eff effs ()) -> ChainIndexLog -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ChainIndexError -> ChainIndexLog
Err ChainIndexError
reason
                    (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
-> Eff
     effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
forall (m :: * -> *) a. Monad m => a -> m a
return (UtxoIndex TxUtxoBalance
utxoIndexState, [(ChainIndexTx, TxProcessOption)]
txs)
                Right InsertUtxoSuccess{UtxoIndex TxUtxoBalance
newIndex :: forall a. InsertUtxoSuccess a -> UtxoIndex a
newIndex :: UtxoIndex TxUtxoBalance
newIndex, InsertUtxoPosition
insertPosition :: forall a. InsertUtxoSuccess a -> InsertUtxoPosition
insertPosition :: InsertUtxoPosition
insertPosition} -> do
                    ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug (ChainIndexLog -> Eff effs ()) -> ChainIndexLog -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Tip -> InsertUtxoPosition -> ChainIndexLog
InsertionSuccess Tip
tip_ InsertUtxoPosition
insertPosition
                    (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
-> Eff
     effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
forall (m :: * -> *) a. Monad m => a -> m a
return (UtxoIndex TxUtxoBalance
newIndex, [(ChainIndexTx, TxProcessOption)]
transactions [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
forall a. [a] -> [a] -> [a]
++ [(ChainIndexTx, TxProcessOption)]
txs)
    ChainIndexEmulatorState
oldState <- forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @ChainIndexEmulatorState
    (UtxoIndex TxUtxoBalance
newIndex, [(ChainIndexTx, TxProcessOption)]
transactions) <- ((UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
 -> ChainSyncBlock
 -> Eff
      effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)]))
-> (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
-> [ChainSyncBlock]
-> Eff
     effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
-> ChainSyncBlock
-> Eff
     effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
forall (effs :: [* -> *]).
FindElem (LogMsg ChainIndexLog) effs =>
(UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
-> ChainSyncBlock
-> Eff
     effs (UtxoIndex TxUtxoBalance, [(ChainIndexTx, TxProcessOption)])
processBlock (Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex ChainIndexEmulatorState
oldState, []) [ChainSyncBlock]
blocks
    ChainIndexEmulatorState -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put (ChainIndexEmulatorState -> Eff effs ())
-> ChainIndexEmulatorState -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ChainIndexEmulatorState
oldState
            ChainIndexEmulatorState
-> (ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> ChainIndexEmulatorState
forall a b. a -> (a -> b) -> b
& ASetter
  ChainIndexEmulatorState
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
  (UtxoIndex TxUtxoBalance)
-> UtxoIndex TxUtxoBalance
-> ChainIndexEmulatorState
-> ChainIndexEmulatorState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ChainIndexEmulatorState
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex UtxoIndex TxUtxoBalance
newIndex
            ChainIndexEmulatorState
-> (ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> ChainIndexEmulatorState
forall a b. a -> (a -> b) -> b
& ASetter
  ChainIndexEmulatorState ChainIndexEmulatorState DiskState DiskState
-> (DiskState -> DiskState)
-> ChainIndexEmulatorState
-> ChainIndexEmulatorState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ChainIndexEmulatorState ChainIndexEmulatorState DiskState DiskState
Lens' ChainIndexEmulatorState DiskState
diskState
                (DiskState -> DiskState -> DiskState
forall a. Monoid a => a -> a -> a
mappend (DiskState -> DiskState -> DiskState)
-> DiskState -> DiskState -> DiskState
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTx, TxProcessOption) -> DiskState)
-> [(ChainIndexTx, TxProcessOption)] -> DiskState
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ChainIndexTx
tx, TxProcessOption
opt) -> if TxProcessOption -> Bool
tpoStoreTx TxProcessOption
opt then ChainIndexTx -> DiskState
DiskState.fromTx ChainIndexTx
tx else DiskState
forall a. Monoid a => a
mempty) [(ChainIndexTx, TxProcessOption)]
transactions)

handleControl ::
    forall effs.
    ( Member (State ChainIndexEmulatorState) effs
    , Member (Error ChainIndexError) effs
    , Member (LogMsg ChainIndexLog) effs
    )
    => ChainIndexControlEffect
    ~> Eff effs
handleControl :: ChainIndexControlEffect ~> Eff effs
handleControl = \case
    AppendBlocks [ChainSyncBlock]
blocks -> [ChainSyncBlock] -> Eff effs ()
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
[ChainSyncBlock] -> Eff effs ()
appendBlocks [ChainSyncBlock]
blocks
    Rollback Point
tip_ -> do
        ChainIndexEmulatorState
oldState <- forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @ChainIndexEmulatorState
        case Point
-> UtxoIndex TxUtxoBalance
-> Either RollbackFailed (RollbackResult TxUtxoBalance)
TxUtxoBalance.rollback Point
tip_ (Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex ChainIndexEmulatorState
oldState) of
            Left RollbackFailed
err -> do
                let reason :: ChainIndexError
reason = RollbackFailed -> ChainIndexError
RollbackFailed RollbackFailed
err
                ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logError (ChainIndexLog -> Eff effs ()) -> ChainIndexLog -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ChainIndexError -> ChainIndexLog
Err ChainIndexError
reason
                ChainIndexError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError ChainIndexError
reason
            Right RollbackResult{Tip
newTip :: forall a. RollbackResult a -> Tip
newTip :: Tip
newTip, UtxoIndex TxUtxoBalance
rolledBackIndex :: forall a. RollbackResult a -> UtxoIndex a
rolledBackIndex :: UtxoIndex TxUtxoBalance
rolledBackIndex} -> do
                ChainIndexEmulatorState -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put (ChainIndexEmulatorState -> Eff effs ())
-> ChainIndexEmulatorState -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ChainIndexEmulatorState
oldState ChainIndexEmulatorState
-> (ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> ChainIndexEmulatorState
forall a b. a -> (a -> b) -> b
& ASetter
  ChainIndexEmulatorState
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
  (UtxoIndex TxUtxoBalance)
-> UtxoIndex TxUtxoBalance
-> ChainIndexEmulatorState
-> ChainIndexEmulatorState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ChainIndexEmulatorState
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex UtxoIndex TxUtxoBalance
rolledBackIndex
                ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug (ChainIndexLog -> Eff effs ()) -> ChainIndexLog -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Tip -> ChainIndexLog
RollbackSuccess Tip
newTip
    ResumeSync Point
PointAtGenesis -> () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ResumeSync Point
_ ->
        -- The emulator can only resume from genesis.
        ChainIndexError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError ChainIndexError
ResumeNotSupported
    ChainIndexControlEffect x
CollectGarbage -> do
        -- Rebuild the index using only transactions that still have at
        -- least one output in the UTXO set
        [TxId]
utxos <- (ChainIndexEmulatorState -> [TxId]) -> Eff effs [TxId]
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets ((ChainIndexEmulatorState -> [TxId]) -> Eff effs [TxId])
-> (ChainIndexEmulatorState -> [TxId]) -> Eff effs [TxId]
forall a b. (a -> b) -> a -> b
$
            Set TxId -> [TxId]
forall a. Set a -> [a]
Set.toList
            (Set TxId -> [TxId])
-> (ChainIndexEmulatorState -> Set TxId)
-> ChainIndexEmulatorState
-> [TxId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef -> TxId) -> Set TxOutRef -> Set TxId
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TxOutRef -> TxId
txOutRefId
            (Set TxOutRef -> Set TxId)
-> (ChainIndexEmulatorState -> Set TxOutRef)
-> ChainIndexEmulatorState
-> Set TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoState TxUtxoBalance -> Set TxOutRef
TxUtxoBalance.unspentOutputs
            (UtxoState TxUtxoBalance -> Set TxOutRef)
-> (ChainIndexEmulatorState -> UtxoState TxUtxoBalance)
-> ChainIndexEmulatorState
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState
            (UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance)
-> (ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState
-> UtxoState TxUtxoBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
-> ChainIndexEmulatorState -> UtxoIndex TxUtxoBalance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (UtxoIndex TxUtxoBalance)
  ChainIndexEmulatorState
  (UtxoIndex TxUtxoBalance)
Lens' ChainIndexEmulatorState (UtxoIndex TxUtxoBalance)
utxoIndex
        DiskState
newDiskState <- (ChainIndexTx -> DiskState) -> [ChainIndexTx] -> DiskState
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ChainIndexTx -> DiskState
DiskState.fromTx ([ChainIndexTx] -> DiskState)
-> ([Maybe ChainIndexTx] -> [ChainIndexTx])
-> [Maybe ChainIndexTx]
-> DiskState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ChainIndexTx] -> [ChainIndexTx]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ChainIndexTx] -> DiskState)
-> Eff effs [Maybe ChainIndexTx] -> Eff effs DiskState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxId -> Eff effs (Maybe ChainIndexTx))
-> [TxId] -> Eff effs [Maybe ChainIndexTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxId -> Eff effs (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId [TxId]
utxos
        (ChainIndexEmulatorState -> ChainIndexEmulatorState) -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
(s -> s) -> Eff effs ()
modify ((ChainIndexEmulatorState -> ChainIndexEmulatorState)
 -> Eff effs ())
-> (ChainIndexEmulatorState -> ChainIndexEmulatorState)
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ASetter
  ChainIndexEmulatorState ChainIndexEmulatorState DiskState DiskState
-> DiskState -> ChainIndexEmulatorState -> ChainIndexEmulatorState
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  ChainIndexEmulatorState ChainIndexEmulatorState DiskState DiskState
Lens' ChainIndexEmulatorState DiskState
diskState DiskState
newDiskState
    ChainIndexControlEffect x
GetDiagnostics -> ChainIndexEmulatorState -> Diagnostics
diagnostics (ChainIndexEmulatorState -> Diagnostics)
-> Eff effs ChainIndexEmulatorState -> Eff effs Diagnostics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (effs :: [* -> *]).
Member (State ChainIndexEmulatorState) effs =>
Eff effs ChainIndexEmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @ChainIndexEmulatorState

diagnostics :: ChainIndexEmulatorState -> Diagnostics
diagnostics :: ChainIndexEmulatorState -> Diagnostics
diagnostics (ChainIndexEmulatorState DiskState
ds UtxoIndex TxUtxoBalance
ui) =
    let TxUtxoBalance Set TxOutRef
outputs Set TxOutRef
inputs = UtxoState TxUtxoBalance -> TxUtxoBalance
forall a. UtxoState a -> a
UtxoState._usTxUtxoData (UtxoState TxUtxoBalance -> TxUtxoBalance)
-> UtxoState TxUtxoBalance -> TxUtxoBalance
forall a b. (a -> b) -> a -> b
$ UtxoIndex TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState UtxoIndex TxUtxoBalance
ui
    in (DiskState -> Diagnostics
DiskState.diagnostics DiskState
ds)
        { numUnspentOutputs :: Int
numUnspentOutputs  = Set TxOutRef -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set TxOutRef
outputs
        , numUnmatchedInputs :: Int
numUnmatchedInputs = Set TxOutRef -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set TxOutRef
inputs
        }