{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}

{-| Handlers for the 'ChainIndexQueryEffect' and the 'ChainIndexControlEffect' -}
module Plutus.ChainIndex.Handlers
    ( handleQuery
    , handleControl
    , restoreStateFromDb
    , getResumePoints
    , ChainIndexState
    ) where

import Cardano.Api qualified as C
import Control.Applicative (Const (..))
import Control.Lens (Lens', _Just, ix, 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.Beam (BeamableDb)
import Control.Monad.Freer.Extras.Beam.Effects (BeamEffect (..), combined, selectList, selectOne, selectPage)
import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logError, logWarn)
import Control.Monad.Freer.Extras.Pagination (Page (Page, nextPageQuery, pageItems), PageQuery (..))
import Control.Monad.Freer.Reader (Reader, ask)
import Control.Monad.Freer.State (State, get, gets, put)
import Data.ByteString (ByteString)
import Data.FingerTree qualified as FT
import Data.List qualified as List
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
import Data.Proxy (Proxy (..))
import Data.Set qualified as Set
import Data.Word (Word64)
import Database.Beam (Columnar, Identity, SqlSelect, TableEntity, aggregate_, all_, countAll_, delete, filter_, in_,
                      limit_, nub_, select, val_)
import Database.Beam.Backend.SQL (BeamSqlBackendCanSerialize)
import Database.Beam.Query (HasSqlEqualityCheck, asc_, desc_, exists_, guard_, isJust_, isNothing_, leftJoin_, orderBy_,
                            update, (&&.), (/=.), (<-.), (<.), (==.), (>.))
import Database.Beam.Schema.Tables (zipTables)
import Database.Beam.Sqlite (Sqlite)
import Ledger (Datum, DatumHash (..), TxId, TxOutRef (..), cardanoAddressCredential)
import Ledger qualified as L
import Ledger.Tx.CardanoAPI (fromCardanoValue)
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.Compatibility (toCardanoPoint)
import Plutus.ChainIndex.DbSchema
import Plutus.ChainIndex.Effects (ChainIndexControlEffect (..), ChainIndexQueryEffect (..))
import Plutus.ChainIndex.Tx
import Plutus.ChainIndex.Tx qualified as ChainIndex
import Plutus.ChainIndex.TxUtxoBalance qualified as TxUtxoBalance
import Plutus.ChainIndex.Types (ChainSyncBlock (..), Depth (..), Diagnostics (..), Point (..), Tip (..),
                                TxProcessOption (..), TxUtxoBalance (..), fromReferenceScript, tipAsPoint)
import Plutus.ChainIndex.UtxoState (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex)
import Plutus.ChainIndex.UtxoState qualified as UtxoState
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Scripts (datumHash)
import Plutus.Script.Utils.Value (AssetClass (AssetClass), flattenValue)
import Plutus.V2.Ledger.Api (Credential (..))
import PlutusTx.Builtins.Internal (emptyByteString)

type ChainIndexState = UtxoIndex TxUtxoBalance

getResumePoints :: Member (BeamEffect Sqlite) effs => Eff effs [C.ChainPoint]
getResumePoints :: Eff effs [ChainPoint]
getResumePoints
    = ([TipRow] -> [ChainPoint])
-> Eff effs [TipRow] -> Eff effs [ChainPoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TipRow -> Maybe ChainPoint) -> [TipRow] -> [ChainPoint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Point -> Maybe ChainPoint
toCardanoPoint (Point -> Maybe ChainPoint)
-> (TipRow -> Point) -> TipRow -> Maybe ChainPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tip -> Point
tipAsPoint (Tip -> Point) -> (TipRow -> Tip) -> TipRow -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TipRow -> Tip
forall a. HasDbType a => DbType a -> a
fromDbValue (Maybe TipRow -> Tip) -> (TipRow -> Maybe TipRow) -> TipRow -> Tip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TipRow -> Maybe TipRow
forall a. a -> Maybe a
Just))
    (Eff effs [TipRow] -> Eff effs [ChainPoint])
-> (DatabaseEntity Sqlite Db (TableEntity TipRowT)
    -> Eff effs [TipRow])
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Eff effs [ChainPoint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite TipRow -> Eff effs [TipRow]
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs [a]
selectList (SqlSelect Sqlite TipRow -> Eff effs [TipRow])
-> (DatabaseEntity Sqlite Db (TableEntity TipRowT)
    -> SqlSelect Sqlite TipRow)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Eff effs [TipRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect Sqlite TipRow
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> SqlSelect Sqlite TipRow)
-> (DatabaseEntity Sqlite Db (TableEntity TipRowT)
    -> Q Sqlite
         Db
         QBaseScope
         (TipRowT (QGenExpr QValueContext Sqlite QBaseScope)))
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> SqlSelect Sqlite TipRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TipRowT (QExpr Sqlite (QNested QBaseScope))
 -> QOrd Sqlite (QNested QBaseScope) Word64)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (TipRowT (QExpr Sqlite (QNested QBaseScope))))
forall s a ordering be (db :: (* -> *) -> *).
(Projectible be a, SqlOrderable be ordering,
 ThreadRewritable (QNested s) a) =>
(a -> ordering)
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
orderBy_ (QExpr Sqlite (QNested QBaseScope) Word64
-> QOrd Sqlite (QNested QBaseScope) Word64
forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
desc_ (QExpr Sqlite (QNested QBaseScope) Word64
 -> QOrd Sqlite (QNested QBaseScope) Word64)
-> (TipRowT (QExpr Sqlite (QNested QBaseScope))
    -> QExpr Sqlite (QNested QBaseScope) Word64)
-> TipRowT (QExpr Sqlite (QNested QBaseScope))
-> QOrd Sqlite (QNested QBaseScope) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TipRowT (QExpr Sqlite (QNested QBaseScope))
-> QExpr Sqlite (QNested QBaseScope) Word64
forall (f :: * -> *). TipRowT f -> Columnar f Word64
_tipRowSlot) (Q Sqlite
   Db
   (QNested QBaseScope)
   (TipRowT (QExpr Sqlite (QNested QBaseScope)))
 -> Q Sqlite
      Db
      QBaseScope
      (TipRowT (QGenExpr QValueContext Sqlite QBaseScope)))
-> (DatabaseEntity Sqlite Db (TableEntity TipRowT)
    -> Q Sqlite
         Db
         (QNested QBaseScope)
         (TipRowT (QExpr Sqlite (QNested QBaseScope))))
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Q Sqlite
     Db
     QBaseScope
     (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (DatabaseEntity Sqlite Db (TableEntity TipRowT)
 -> Eff effs [ChainPoint])
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Eff effs [ChainPoint]
forall a b. (a -> b) -> a -> b
$ Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
forall (f :: * -> *). Db f -> f (TableEntity TipRowT)
tipRows Db (DatabaseEntity Sqlite Db)
db

handleQuery ::
    ( Member (State ChainIndexState) effs
    , Member (BeamEffect Sqlite) effs
    , Member (Error ChainIndexError) effs
    , Member (LogMsg ChainIndexLog) effs
    ) => ChainIndexQueryEffect
    ~> Eff effs
handleQuery :: ChainIndexQueryEffect ~> Eff effs
handleQuery = \case
    DatumFromHash DatumHash
dh            -> DatumHash -> Eff effs (Maybe Datum)
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash DatumHash
dh
    ValidatorFromHash ValidatorHash
hash      -> ValidatorHash -> Eff effs (Maybe (Versioned Validator))
forall (effs :: [* -> *]) i o.
(Member (BeamEffect Sqlite) effs, HasDbType i,
 DbType i ~ ByteString, HasDbType o, DbType o ~ ByteString) =>
i -> Eff effs (Maybe o)
getScriptFromHash ValidatorHash
hash
    MintingPolicyFromHash MintingPolicyHash
hash  -> MintingPolicyHash -> Eff effs (Maybe (Versioned MintingPolicy))
forall (effs :: [* -> *]) i o.
(Member (BeamEffect Sqlite) effs, HasDbType i,
 DbType i ~ ByteString, HasDbType o, DbType o ~ ByteString) =>
i -> Eff effs (Maybe o)
getScriptFromHash MintingPolicyHash
hash
    RedeemerFromHash RedeemerHash
hash       -> RedeemerHash -> Eff effs (Maybe Redeemer)
forall (effs :: [* -> *]) i o.
(Member (BeamEffect Sqlite) effs, HasDbType i,
 DbType i ~ ByteString, HasDbType o, DbType o ~ ByteString) =>
i -> Eff effs (Maybe o)
getRedeemerFromHash RedeemerHash
hash
    StakeValidatorFromHash StakeValidatorHash
hash -> StakeValidatorHash -> Eff effs (Maybe (Versioned StakeValidator))
forall (effs :: [* -> *]) i o.
(Member (BeamEffect Sqlite) effs, HasDbType i,
 DbType i ~ ByteString, HasDbType o, DbType o ~ ByteString) =>
i -> Eff effs (Maybe o)
getScriptFromHash StakeValidatorHash
hash
    TxFromTxId TxId
txId -> TxId -> Eff effs (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId TxId
txId
    TxOutFromRef TxOutRef
tor            -> TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getTxOutFromRef TxOutRef
tor
    UnspentTxOutFromRef TxOutRef
tor     -> TxOutRef -> Eff effs (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
(Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getUtxoutFromRef TxOutRef
tor
    UtxoSetMembership TxOutRef
r -> do
        UtxoState TxUtxoBalance
utxoState <- (ChainIndexState -> UtxoState TxUtxoBalance)
-> Eff effs (UtxoState TxUtxoBalance)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets @ChainIndexState ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState
        case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
UtxoState.tip UtxoState TxUtxoBalance
utxoState 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
utxoState))
    UtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
    UnspentTxOutSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> PageQuery TxOutRef
-> Credential
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef
-> Credential
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
getTxOutSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
    DatumsAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> PageQuery TxOutRef
-> Credential -> Eff effs (QueryResponse [Datum])
forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef
-> Credential -> Eff effs (QueryResponse [Datum])
getDatumsAtAddress PageQuery TxOutRef
pageQuery Credential
cred
    UtxoSetWithCurrency PageQuery TxOutRef
pageQuery AssetClass
assetClass ->
      PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse
forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse
getUtxoSetWithCurrency PageQuery TxOutRef
pageQuery AssetClass
assetClass
    TxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred -> PageQuery TxOutRef -> Credential -> Eff effs TxosResponse
forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs TxosResponse
getTxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
    TxsFromTxIds [TxId]
txids -> [TxId] -> Eff effs [ChainIndexTx]
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
[TxId] -> Eff effs [ChainIndexTx]
getTxsFromTxIds [TxId]
txids
    ChainIndexQueryEffect x
GetTip -> Eff effs x
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
Eff effs Tip
getTip

getTip :: Member (BeamEffect Sqlite) effs => Eff effs Tip
getTip :: Eff effs Tip
getTip = (Maybe TipRow -> Tip) -> Eff effs (Maybe TipRow) -> Eff effs Tip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe TipRow -> Tip
forall a. HasDbType a => DbType a -> a
fromDbValue (Eff effs (Maybe TipRow) -> Eff effs Tip)
-> (Q Sqlite
      Db
      QBaseScope
      (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
    -> Eff effs (Maybe TipRow))
-> Q Sqlite
     Db
     QBaseScope
     (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs Tip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite TipRow -> Eff effs (Maybe TipRow)
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs (Maybe a)
selectOne (SqlSelect Sqlite TipRow -> Eff effs (Maybe TipRow))
-> (Q Sqlite
      Db
      QBaseScope
      (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
    -> SqlSelect Sqlite TipRow)
-> Q Sqlite
     Db
     QBaseScope
     (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs (Maybe TipRow)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect Sqlite TipRow
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> Eff effs Tip)
-> Q Sqlite
     Db
     QBaseScope
     (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs Tip
forall a b. (a -> b) -> a -> b
$ Integer
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (TipRowT (QExpr Sqlite (QNested QBaseScope))))
forall s a be (db :: (* -> *) -> *).
(Projectible be a, ThreadRewritable (QNested s) a) =>
Integer
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
limit_ Integer
1 ((TipRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QOrd Sqlite (QNested (QNested QBaseScope)) Word64)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (TipRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (WithRewrittenThread
        (QNested (QNested QBaseScope))
        (QNested QBaseScope)
        (TipRowT (QExpr Sqlite (QNested (QNested QBaseScope)))))
forall s a ordering be (db :: (* -> *) -> *).
(Projectible be a, SqlOrderable be ordering,
 ThreadRewritable (QNested s) a) =>
(a -> ordering)
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
orderBy_ (QExpr Sqlite (QNested (QNested QBaseScope)) Word64
-> QOrd Sqlite (QNested (QNested QBaseScope)) Word64
forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
desc_ (QExpr Sqlite (QNested (QNested QBaseScope)) Word64
 -> QOrd Sqlite (QNested (QNested QBaseScope)) Word64)
-> (TipRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
    -> QExpr Sqlite (QNested (QNested QBaseScope)) Word64)
-> TipRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QOrd Sqlite (QNested (QNested QBaseScope)) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TipRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QExpr Sqlite (QNested (QNested QBaseScope)) Word64
forall (f :: * -> *). TipRowT f -> Columnar f Word64
_tipRowSlot) (DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (TipRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
forall (f :: * -> *). Db f -> f (TableEntity TipRowT)
tipRows Db (DatabaseEntity Sqlite Db)
db)))

getDatumFromHash :: Member (BeamEffect Sqlite) effs => DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash :: DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash = SqlSelect Sqlite ByteString -> Eff effs (Maybe Datum)
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne (SqlSelect Sqlite ByteString -> Eff effs (Maybe Datum))
-> (DatumHash -> SqlSelect Sqlite ByteString)
-> DatumHash
-> Eff effs (Maybe Datum)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *). Db f -> f (TableEntity DatumRowT))
-> (forall (f :: * -> *).
    DatumRowT f -> Columnar f (DbType DatumHash))
-> (forall (f :: * -> *). DatumRowT f -> Columnar f ByteString)
-> DatumHash
-> SqlSelect Sqlite ByteString
forall key (table :: (* -> *) -> *) value.
(HasDbType key, HasSqlEqualityCheck Sqlite (DbType key),
 BeamSqlBackendCanSerialize Sqlite (DbType key)) =>
(forall (f :: * -> *). Db f -> f (TableEntity table))
-> (forall (f :: * -> *). table f -> Columnar f (DbType key))
-> (forall (f :: * -> *). table f -> Columnar f value)
-> key
-> SqlSelect Sqlite value
queryKeyValue forall (f :: * -> *). Db f -> f (TableEntity DatumRowT)
datumRows forall (f :: * -> *). DatumRowT f -> Columnar f ByteString
forall (f :: * -> *). DatumRowT f -> Columnar f (DbType DatumHash)
_datumRowHash forall (f :: * -> *). DatumRowT f -> Columnar f ByteString
_datumRowDatum

getTxFromTxId :: Member (BeamEffect Sqlite) effs => TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId :: TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId = SqlSelect Sqlite ByteString -> Eff effs (Maybe ChainIndexTx)
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne (SqlSelect Sqlite ByteString -> Eff effs (Maybe ChainIndexTx))
-> (TxId -> SqlSelect Sqlite ByteString)
-> TxId
-> Eff effs (Maybe ChainIndexTx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *). Db f -> f (TableEntity TxRowT))
-> (forall (f :: * -> *). TxRowT f -> Columnar f (DbType TxId))
-> (forall (f :: * -> *). TxRowT f -> Columnar f ByteString)
-> TxId
-> SqlSelect Sqlite ByteString
forall key (table :: (* -> *) -> *) value.
(HasDbType key, HasSqlEqualityCheck Sqlite (DbType key),
 BeamSqlBackendCanSerialize Sqlite (DbType key)) =>
(forall (f :: * -> *). Db f -> f (TableEntity table))
-> (forall (f :: * -> *). table f -> Columnar f (DbType key))
-> (forall (f :: * -> *). table f -> Columnar f value)
-> key
-> SqlSelect Sqlite value
queryKeyValue forall (f :: * -> *). Db f -> f (TableEntity TxRowT)
txRows forall (f :: * -> *). TxRowT f -> Columnar f ByteString
forall (f :: * -> *). TxRowT f -> Columnar f (DbType TxId)
_txRowTxId forall (f :: * -> *). TxRowT f -> Columnar f ByteString
_txRowTx

getScriptFromHash ::
    ( Member (BeamEffect Sqlite) effs
    , HasDbType i
    , DbType i ~ ByteString
    , HasDbType o
    , DbType o ~ ByteString
    ) => i
    -> Eff effs (Maybe o)
getScriptFromHash :: i -> Eff effs (Maybe o)
getScriptFromHash = SqlSelect Sqlite ByteString -> Eff effs (Maybe o)
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne (SqlSelect Sqlite ByteString -> Eff effs (Maybe o))
-> (i -> SqlSelect Sqlite ByteString) -> i -> Eff effs (Maybe o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *). Db f -> f (TableEntity ScriptRowT))
-> (forall (f :: * -> *). ScriptRowT f -> Columnar f (DbType i))
-> (forall (f :: * -> *). ScriptRowT f -> Columnar f ByteString)
-> i
-> SqlSelect Sqlite ByteString
forall key (table :: (* -> *) -> *) value.
(HasDbType key, HasSqlEqualityCheck Sqlite (DbType key),
 BeamSqlBackendCanSerialize Sqlite (DbType key)) =>
(forall (f :: * -> *). Db f -> f (TableEntity table))
-> (forall (f :: * -> *). table f -> Columnar f (DbType key))
-> (forall (f :: * -> *). table f -> Columnar f value)
-> key
-> SqlSelect Sqlite value
queryKeyValue forall (f :: * -> *). Db f -> f (TableEntity ScriptRowT)
scriptRows forall (f :: * -> *). ScriptRowT f -> Columnar f ByteString
forall (f :: * -> *). ScriptRowT f -> Columnar f (DbType i)
_scriptRowHash forall (f :: * -> *). ScriptRowT f -> Columnar f ByteString
_scriptRowScript

getRedeemerFromHash ::
    ( Member (BeamEffect Sqlite) effs
    , HasDbType i
    , DbType i ~ ByteString
    , HasDbType o
    , DbType o ~ ByteString
    ) => i
    -> Eff effs (Maybe o)
getRedeemerFromHash :: i -> Eff effs (Maybe o)
getRedeemerFromHash = SqlSelect Sqlite ByteString -> Eff effs (Maybe o)
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne (SqlSelect Sqlite ByteString -> Eff effs (Maybe o))
-> (i -> SqlSelect Sqlite ByteString) -> i -> Eff effs (Maybe o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *). Db f -> f (TableEntity RedeemerRowT))
-> (forall (f :: * -> *). RedeemerRowT f -> Columnar f (DbType i))
-> (forall (f :: * -> *). RedeemerRowT f -> Columnar f ByteString)
-> i
-> SqlSelect Sqlite ByteString
forall key (table :: (* -> *) -> *) value.
(HasDbType key, HasSqlEqualityCheck Sqlite (DbType key),
 BeamSqlBackendCanSerialize Sqlite (DbType key)) =>
(forall (f :: * -> *). Db f -> f (TableEntity table))
-> (forall (f :: * -> *). table f -> Columnar f (DbType key))
-> (forall (f :: * -> *). table f -> Columnar f value)
-> key
-> SqlSelect Sqlite value
queryKeyValue forall (f :: * -> *). Db f -> f (TableEntity RedeemerRowT)
redeemerRows forall (f :: * -> *). RedeemerRowT f -> Columnar f ByteString
forall (f :: * -> *). RedeemerRowT f -> Columnar f (DbType i)
_redeemerRowHash forall (f :: * -> *). RedeemerRowT f -> Columnar f ByteString
_redeemerRowRedeemer

queryKeyValue ::
    ( HasDbType key
    , HasSqlEqualityCheck Sqlite (DbType key)
    , BeamSqlBackendCanSerialize Sqlite (DbType key)
    ) => (forall f. Db f -> f (TableEntity table))
    -> (forall f. table f -> Columnar f (DbType key))
    -> (forall f. table f -> Columnar f value)
    -> key
    -> SqlSelect Sqlite value
queryKeyValue :: (forall (f :: * -> *). Db f -> f (TableEntity table))
-> (forall (f :: * -> *). table f -> Columnar f (DbType key))
-> (forall (f :: * -> *). table f -> Columnar f value)
-> key
-> SqlSelect Sqlite value
queryKeyValue forall (f :: * -> *). Db f -> f (TableEntity table)
table forall (f :: * -> *). table f -> Columnar f (DbType key)
getKey forall (f :: * -> *). table f -> Columnar f value
getValue (key -> DbType key
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType key
key) =
    Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope value)
-> SqlSelect
     Sqlite
     (QExprToIdentity (QGenExpr QValueContext Sqlite QBaseScope value))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope value)
 -> SqlSelect
      Sqlite
      (QExprToIdentity (QGenExpr QValueContext Sqlite QBaseScope value)))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope value)
-> SqlSelect
     Sqlite
     (QExprToIdentity (QGenExpr QValueContext Sqlite QBaseScope value))
forall a b. (a -> b) -> a -> b
$ table (QGenExpr QValueContext Sqlite QBaseScope)
-> QGenExpr QValueContext Sqlite QBaseScope value
forall (f :: * -> *). table f -> Columnar f value
getValue (table (QGenExpr QValueContext Sqlite QBaseScope)
 -> QGenExpr QValueContext Sqlite QBaseScope value)
-> Q Sqlite
     Db
     QBaseScope
     (table (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (table (QGenExpr QValueContext Sqlite QBaseScope)
 -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     Db
     QBaseScope
     (table (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (table (QGenExpr QValueContext Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\table (QGenExpr QValueContext Sqlite QBaseScope)
row -> table (QGenExpr QValueContext Sqlite QBaseScope)
-> Columnar (QGenExpr QValueContext Sqlite QBaseScope) (DbType key)
forall (f :: * -> *). table f -> Columnar f (DbType key)
getKey table (QGenExpr QValueContext Sqlite QBaseScope)
row QGenExpr QValueContext Sqlite QBaseScope (DbType key)
-> QGenExpr QValueContext Sqlite QBaseScope (DbType key)
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope (DbType key))
-> QGenExpr QValueContext Sqlite QBaseScope (DbType key)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope (DbType key))
DbType key
key) (DatabaseEntity Sqlite Db (TableEntity table)
-> Q Sqlite
     Db
     QBaseScope
     (table (QGenExpr QValueContext Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity table)
forall (f :: * -> *). Db f -> f (TableEntity table)
table Db (DatabaseEntity Sqlite Db)
db))

queryOne ::
    ( Member (BeamEffect Sqlite) effs
    , HasDbType o
    ) => SqlSelect Sqlite (DbType o)
    -> Eff effs (Maybe o)
queryOne :: SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne = (Maybe (DbType o) -> Maybe o)
-> Eff effs (Maybe (DbType o)) -> Eff effs (Maybe o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DbType o -> o) -> Maybe (DbType o) -> Maybe o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DbType o -> o
forall a. HasDbType a => DbType a -> a
fromDbValue) (Eff effs (Maybe (DbType o)) -> Eff effs (Maybe o))
-> (SqlSelect Sqlite (DbType o) -> Eff effs (Maybe (DbType o)))
-> SqlSelect Sqlite (DbType o)
-> Eff effs (Maybe o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite (DbType o) -> Eff effs (Maybe (DbType o))
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs (Maybe a)
selectOne


queryList ::
    ( Member (BeamEffect Sqlite) effs
    , HasDbType o
    ) => SqlSelect Sqlite (DbType o)
    -> Eff effs [o]
queryList :: SqlSelect Sqlite (DbType o) -> Eff effs [o]
queryList = ([DbType o] -> [o]) -> Eff effs [DbType o] -> Eff effs [o]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DbType o -> o) -> [DbType o] -> [o]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DbType o -> o
forall a. HasDbType a => DbType a -> a
fromDbValue) (Eff effs [DbType o] -> Eff effs [o])
-> (SqlSelect Sqlite (DbType o) -> Eff effs [DbType o])
-> SqlSelect Sqlite (DbType o)
-> Eff effs [o]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite (DbType o) -> Eff effs [DbType o]
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs [a]
selectList


-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
getTxOutFromRef ::
  forall effs.
  ( Member (BeamEffect Sqlite) 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
  Maybe ChainIndexTx
mTx <- TxId -> Eff effs (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId TxId
txOutRefId
  -- Find the output in the tx matching the output ref
  case Maybe ChainIndexTx
mTx Maybe ChainIndexTx
-> Getting
     (First ChainIndexTxOut) (Maybe ChainIndexTx) ChainIndexTxOut
-> Maybe ChainIndexTxOut
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
-> Maybe ChainIndexTx
-> Const (First ChainIndexTxOut) (Maybe ChainIndexTx)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
 -> Maybe ChainIndexTx
 -> Const (First ChainIndexTxOut) (Maybe ChainIndexTx))
-> ((ChainIndexTxOut
     -> Const (First ChainIndexTxOut) ChainIndexTxOut)
    -> ChainIndexTx -> Const (First ChainIndexTxOut) ChainIndexTx)
-> Getting
     (First ChainIndexTxOut) (Maybe ChainIndexTx) ChainIndexTxOut
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) 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 (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
makeChainIndexTxOut ChainIndexTxOut
txout


-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
getUtxoutFromRef ::
  forall effs.
  ( Member (BeamEffect Sqlite) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => TxOutRef
  -> Eff effs (Maybe L.DecoratedTxOut)
getUtxoutFromRef :: TxOutRef -> Eff effs (Maybe DecoratedTxOut)
getUtxoutFromRef TxOutRef
txOutRef = do
    Maybe ChainIndexTxOut
mTxOut <- SqlSelect Sqlite (DbType ChainIndexTxOut)
-> Eff effs (Maybe ChainIndexTxOut)
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne (SqlSelect Sqlite (DbType ChainIndexTxOut)
 -> Eff effs (Maybe ChainIndexTxOut))
-> SqlSelect Sqlite (DbType ChainIndexTxOut)
-> Eff effs (Maybe ChainIndexTxOut)
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *). Db f -> f (TableEntity UtxoRowT))
-> (forall (f :: * -> *).
    UtxoRowT f -> Columnar f (DbType TxOutRef))
-> (forall (f :: * -> *). UtxoRowT f -> Columnar f ByteString)
-> TxOutRef
-> SqlSelect Sqlite ByteString
forall key (table :: (* -> *) -> *) value.
(HasDbType key, HasSqlEqualityCheck Sqlite (DbType key),
 BeamSqlBackendCanSerialize Sqlite (DbType key)) =>
(forall (f :: * -> *). Db f -> f (TableEntity table))
-> (forall (f :: * -> *). table f -> Columnar f (DbType key))
-> (forall (f :: * -> *). table f -> Columnar f value)
-> key
-> SqlSelect Sqlite value
queryKeyValue forall (f :: * -> *). Db f -> f (TableEntity UtxoRowT)
utxoOutRefRows forall (f :: * -> *). UtxoRowT f -> Columnar f ByteString
forall (f :: * -> *). UtxoRowT f -> Columnar f (DbType TxOutRef)
_utxoRowOutRef forall (f :: * -> *). UtxoRowT f -> Columnar f ByteString
_utxoRowTxOut TxOutRef
txOutRef
    case Maybe ChainIndexTxOut
mTxOut of
      Maybe ChainIndexTxOut
Nothing    -> ChainIndexLog -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logWarn (TxOutRef -> ChainIndexLog
TxOutNotFound TxOutRef
txOutRef) 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 (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexTxOut -> Eff effs (Maybe DecoratedTxOut)
makeChainIndexTxOut ChainIndexTxOut
txout

makeChainIndexTxOut ::
  forall effs.
  ( Member (BeamEffect Sqlite) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => ChainIndex.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
  case CardanoAddress -> Credential
forall era. AddressInEra era -> Credential
L.cardanoAddressCredential CardanoAddress
address 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
vh ->
      case Maybe (DatumHash, DatumFromQuery)
datumWithHash of
        Just (DatumHash, DatumFromQuery)
d -> do
          Maybe (Versioned Validator)
v <- ValidatorHash -> Eff effs (Maybe (Versioned Validator))
forall (effs :: [* -> *]) i o.
(Member (BeamEffect Sqlite) effs, HasDbType i,
 DbType i ~ ByteString, HasDbType o, DbType o ~ ByteString) =>
i -> Eff effs (Maybe o)
getScriptFromHash ValidatorHash
vh
          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 Maybe (Versioned Validator)
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 (BeamEffect Sqlite) 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

getUtxoSetAtAddress
  :: forall effs.
    ( Member (State ChainIndexState) effs
    , Member (BeamEffect Sqlite) effs
    , Member (LogMsg ChainIndexLog) effs
    )
  => PageQuery TxOutRef
  -> Credential
  -> Eff effs UtxosResponse
getUtxoSetAtAddress :: PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery (Credential -> DbType Credential
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType Credential
cred) = do
  UtxoState TxUtxoBalance
utxoState <- (ChainIndexState -> UtxoState TxUtxoBalance)
-> Eff effs (UtxoState TxUtxoBalance)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets @ChainIndexState ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState

  case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
UtxoState.tip UtxoState TxUtxoBalance
utxoState 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
-> Maybe (PageQuery TxOutRef) -> [TxOutRef] -> Page TxOutRef
forall a. PageQuery a -> Maybe (PageQuery a) -> [a] -> Page a
Page PageQuery TxOutRef
pageQuery Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing []))
      Tip
tp           -> do
          let query :: Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
query = do
                QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef <- (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall (f :: * -> *). UnspentOutputRowT f -> Columnar f ByteString
_unspentOutputRowOutRef (DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db))
                QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
rowCred <- Q Sqlite
  Db
  (QNested (QNested (QNested QBaseScope)))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
-> (WithRewrittenThread
      (QNested (QNested (QNested QBaseScope)))
      (QNested (QNested QBaseScope))
      (QGenExpr
         QValueContext
         Sqlite
         (QNested (QNested (QNested QBaseScope)))
         ByteString)
    -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (Retag
        Nullable
        (WithRewrittenThread
           (QNested (QNested (QNested QBaseScope)))
           (QNested (QNested QBaseScope))
           (QGenExpr
              QValueContext
              Sqlite
              (QNested (QNested (QNested QBaseScope)))
              ByteString)))
forall s r be (db :: (* -> *) -> *).
(BeamSqlBackend be, Projectible be r,
 ThreadRewritable (QNested s) r,
 Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r)) =>
Q be db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr be s Bool)
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_
                           ((AddressRowT
   (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
 -> QGenExpr
      QValueContext
      Sqlite
      (QNested (QNested (QNested QBaseScope)))
      ByteString)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AddressRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (QGenExpr
        QValueContext
        Sqlite
        (QNested (QNested (QNested QBaseScope)))
        ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressRowT (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowOutRef ((AddressRowT
   (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
 -> QExpr Sqlite (QNested (QNested (QNested QBaseScope))) Bool)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AddressRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AddressRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\AddressRowT (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
row -> AddressRowT (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
-> Columnar
     (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowCred AddressRowT (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
row QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested (QNested QBaseScope)))
  ByteString
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
-> QExpr Sqlite (QNested (QNested (QNested QBaseScope))) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
DbType Credential
cred) (DatabaseEntity Sqlite Db (TableEntity AddressRowT)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AddressRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
forall (f :: * -> *). Db f -> f (TableEntity AddressRowT)
addressRows Db (DatabaseEntity Sqlite Db)
db))))
                           (\WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
row -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
row QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef)
                QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
utxi <- Q Sqlite
  Db
  (QNested (QNested (QNested QBaseScope)))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
-> (WithRewrittenThread
      (QNested (QNested (QNested QBaseScope)))
      (QNested (QNested QBaseScope))
      (QGenExpr
         QValueContext
         Sqlite
         (QNested (QNested (QNested QBaseScope)))
         ByteString)
    -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (Retag
        Nullable
        (WithRewrittenThread
           (QNested (QNested (QNested QBaseScope)))
           (QNested (QNested QBaseScope))
           (QGenExpr
              QValueContext
              Sqlite
              (QNested (QNested (QNested QBaseScope)))
              ByteString)))
forall s r be (db :: (* -> *) -> *).
(BeamSqlBackend be, Projectible be r,
 ThreadRewritable (QNested s) r,
 Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r)) =>
Q be db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr be s Bool)
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_ ((UnmatchedInputRowT
   (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
 -> QGenExpr
      QValueContext
      Sqlite
      (QNested (QNested (QNested QBaseScope)))
      ByteString)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (UnmatchedInputRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (QGenExpr
        QValueContext
        Sqlite
        (QNested (QNested (QNested QBaseScope)))
        ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnmatchedInputRowT
  (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
forall (f :: * -> *). UnmatchedInputRowT f -> Columnar f ByteString
_unmatchedInputRowOutRef (Q Sqlite
   Db
   (QNested (QNested (QNested QBaseScope)))
   (UnmatchedInputRowT
      (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
 -> Q Sqlite
      Db
      (QNested (QNested (QNested QBaseScope)))
      (QGenExpr
         QValueContext
         Sqlite
         (QNested (QNested (QNested QBaseScope)))
         ByteString))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (UnmatchedInputRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (QGenExpr
        QValueContext
        Sqlite
        (QNested (QNested (QNested QBaseScope)))
        ByteString)
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (UnmatchedInputRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db)) (\WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
utxi -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
utxi)
                QExpr Sqlite (QNested (QNested QBaseScope)) Bool
-> Q Sqlite Db (QNested (QNested QBaseScope)) ()
forall be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
QExpr be s Bool -> Q be db s ()
guard_ (QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall be a nonNullA s ctxt.
SqlDeconstructMaybe be a nonNullA s =>
a -> QGenExpr ctxt be s Bool
isNothing_ QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
utxi)
                QExpr Sqlite (QNested (QNested QBaseScope)) Bool
-> Q Sqlite Db (QNested (QNested QBaseScope)) ()
forall be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
QExpr be s Bool -> Q be db s ()
guard_ (QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall be a nonNullA s ctxt.
SqlDeconstructMaybe be a nonNullA s =>
a -> QGenExpr ctxt be s Bool
isJust_ QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
rowCred)
                QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef

          Page ByteString
outRefs <- PageQuery ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Eff effs (Page ByteString)
forall dbt a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow dbt a, HasSqlValueSyntax (Synt dbt) a,
 Member (BeamEffect dbt) effs, HasQBuilder dbt) =>
PageQuery a
-> Q dbt
     db
     (QNested (QNested QBaseScope))
     (QExpr dbt (QNested (QNested QBaseScope)) a)
-> Eff effs (Page a)
selectPage ((TxOutRef -> ByteString)
-> PageQuery TxOutRef -> PageQuery ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOutRef -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue PageQuery TxOutRef
pageQuery) Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
query
          let page :: Page TxOutRef
page = (ByteString -> TxOutRef) -> Page ByteString -> Page TxOutRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> TxOutRef
forall a. HasDbType a => DbType a -> a
fromDbValue Page ByteString
outRefs

          UtxosResponse -> Eff effs UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
tp Page TxOutRef
page)


getTxOutSetAtAddress ::
  forall effs.
  ( Member (State ChainIndexState) effs
  , Member (BeamEffect Sqlite) effs
  , Member (LogMsg ChainIndexLog) effs
  )
  => PageQuery TxOutRef
  -> Credential
  -> Eff effs (QueryResponse [(TxOutRef, L.DecoratedTxOut)])
getTxOutSetAtAddress :: PageQuery TxOutRef
-> Credential
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
getTxOutSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred = do
  (UtxosResponse Tip
tip Page TxOutRef
page) <- PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
  case Tip
tip of
    Tip
TipAtGenesis -> do
      QueryResponse [(TxOutRef, DecoratedTxOut)]
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(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 (BeamEffect Sqlite) 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)


getDatumsAtAddress ::
  forall effs.
    ( Member (State ChainIndexState) effs
    , Member (BeamEffect Sqlite) effs
    , Member (LogMsg ChainIndexLog) effs
    )
  => PageQuery TxOutRef
  -> Credential
  -> Eff effs (QueryResponse [Datum])
getDatumsAtAddress :: PageQuery TxOutRef
-> Credential -> Eff effs (QueryResponse [Datum])
getDatumsAtAddress PageQuery TxOutRef
pageQuery (Credential -> DbType Credential
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType Credential
cred) = do
  UtxoState TxUtxoBalance
utxoState <- (ChainIndexState -> UtxoState TxUtxoBalance)
-> Eff effs (UtxoState TxUtxoBalance)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets @ChainIndexState ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState
  case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
UtxoState.tip UtxoState TxUtxoBalance
utxoState 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 ([Datum] -> Maybe (PageQuery TxOutRef) -> QueryResponse [Datum]
forall a. a -> Maybe (PageQuery TxOutRef) -> QueryResponse a
QueryResponse [] Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing)

    Tip
_             -> do
      let emptyHash :: DbType DatumHash
emptyHash = DatumHash -> DbType DatumHash
forall a. HasDbType a => a -> DbType a
toDbValue (DatumHash -> DbType DatumHash) -> DatumHash -> DbType DatumHash
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> DatumHash
DatumHash BuiltinByteString
emptyByteString
          queryPage :: Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
queryPage =
            (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowOutRef
            (Q Sqlite
   Db
   (QNested (QNested QBaseScope))
   (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
 -> Q Sqlite
      Db
      (QNested (QNested QBaseScope))
      (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall a b. (a -> b) -> a -> b
$ (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
row ->
                         ( AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowCred AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
row QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
DbType Credential
cred )
                         QExpr Sqlite (QNested (QNested QBaseScope)) Bool
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&. (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowDatumHash AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
row QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
/=. HaskellLiteralForQExpr
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ ByteString
HaskellLiteralForQExpr
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
emptyHash) )
            (Q Sqlite
   Db
   (QNested (QNested QBaseScope))
   (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
 -> Q Sqlite
      Db
      (QNested (QNested QBaseScope))
      (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity AddressRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
forall (f :: * -> *). Db f -> f (TableEntity AddressRowT)
addressRows Db (DatabaseEntity Sqlite Db)
db)
          queryAll :: SqlSelect
  Sqlite
  (QExprToIdentity
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)))
queryAll =
            Q Sqlite
  Db
  QBaseScope
  (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect
     Sqlite
     (QExprToIdentity
        (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select
            (Q Sqlite
   Db
   QBaseScope
   (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> SqlSelect
      Sqlite
      (QExprToIdentity
         (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))))
-> Q Sqlite
     Db
     QBaseScope
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect
     Sqlite
     (QExprToIdentity
        (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)))
forall a b. (a -> b) -> a -> b
$ (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)
 -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     Db
     QBaseScope
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)
row -> AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)
-> Columnar (QGenExpr QValueContext Sqlite QBaseScope) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowCred AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)
row QGenExpr QValueContext Sqlite QBaseScope ByteString
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
DbType Credential
cred
                       QExpr Sqlite QBaseScope Bool
-> QExpr Sqlite QBaseScope Bool -> QExpr Sqlite QBaseScope Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&. (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)
-> Columnar (QGenExpr QValueContext Sqlite QBaseScope) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowDatumHash AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)
row QGenExpr QValueContext Sqlite QBaseScope ByteString
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
/=. HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ ByteString
HaskellLiteralForQExpr
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
emptyHash ) )
            (Q Sqlite
   Db
   QBaseScope
   (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> Q Sqlite
      Db
      QBaseScope
      (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity AddressRowT)
-> Q Sqlite
     Db
     QBaseScope
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
forall (f :: * -> *). Db f -> f (TableEntity AddressRowT)
addressRows Db (DatabaseEntity Sqlite Db)
db)
      Page ByteString
pRefs <- PageQuery ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Eff effs (Page ByteString)
forall dbt a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow dbt a, HasSqlValueSyntax (Synt dbt) a,
 Member (BeamEffect dbt) effs, HasQBuilder dbt) =>
PageQuery a
-> Q dbt
     db
     (QNested (QNested QBaseScope))
     (QExpr dbt (QNested (QNested QBaseScope)) a)
-> Eff effs (Page a)
selectPage ((TxOutRef -> ByteString)
-> PageQuery TxOutRef -> PageQuery ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOutRef -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue PageQuery TxOutRef
pageQuery) Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
queryPage
      let page :: Page TxOutRef
page = (ByteString -> TxOutRef) -> Page ByteString -> Page TxOutRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> TxOutRef
forall a. HasDbType a => DbType a -> a
fromDbValue Page ByteString
pRefs
      [(Credential, TxOutRef, Maybe DatumHash)]
row_l <- ((Credential, TxOutRef, Maybe DatumHash) -> Bool)
-> [(Credential, TxOutRef, Maybe DatumHash)]
-> [(Credential, TxOutRef, Maybe DatumHash)]
forall a. (a -> Bool) -> [a] -> [a]
List.filter (\(Credential
_, TxOutRef
t, Maybe DatumHash
_) -> TxOutRef -> [TxOutRef] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem TxOutRef
t (Page TxOutRef -> [TxOutRef]
forall a. Page a -> [a]
pageItems Page TxOutRef
page)) ([(Credential, TxOutRef, Maybe DatumHash)]
 -> [(Credential, TxOutRef, Maybe DatumHash)])
-> Eff effs [(Credential, TxOutRef, Maybe DatumHash)]
-> Eff effs [(Credential, TxOutRef, Maybe DatumHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlSelect Sqlite (DbType (Credential, TxOutRef, Maybe DatumHash))
-> Eff effs [(Credential, TxOutRef, Maybe DatumHash)]
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs [o]
queryList SqlSelect
  Sqlite
  (QExprToIdentity
     (AddressRowT (QGenExpr QValueContext Sqlite QBaseScope)))
SqlSelect Sqlite (DbType (Credential, TxOutRef, Maybe DatumHash))
queryAll
      [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
<$> ((Credential, TxOutRef, Maybe DatumHash) -> Eff effs (Maybe Datum))
-> [(Credential, TxOutRef, Maybe DatumHash)]
-> Eff effs [Maybe Datum]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Credential, TxOutRef, Maybe DatumHash) -> Eff effs (Maybe Datum)
f_map [(Credential, TxOutRef, Maybe DatumHash)]
row_l
      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)

  where
    f_map :: (Credential, TxOutRef, Maybe DatumHash) -> Eff effs (Maybe Datum)
    f_map :: (Credential, TxOutRef, Maybe DatumHash) -> Eff effs (Maybe Datum)
f_map (Credential
_, TxOutRef
_, Maybe DatumHash
Nothing) = Maybe Datum -> Eff effs (Maybe Datum)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Datum
forall a. Maybe a
Nothing
    f_map (Credential
_, TxOutRef
_, Just DatumHash
dh) = DatumHash -> Eff effs (Maybe Datum)
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash DatumHash
dh


getUtxoSetWithCurrency
  :: forall effs.
    ( Member (State ChainIndexState) effs
    , Member (BeamEffect Sqlite) effs
    , Member (LogMsg ChainIndexLog) effs
    )
  => PageQuery TxOutRef
  -> AssetClass
  -> Eff effs UtxosResponse
getUtxoSetWithCurrency :: PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse
getUtxoSetWithCurrency PageQuery TxOutRef
pageQuery (AssetClass -> DbType AssetClass
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType AssetClass
assetClass) = do
  UtxoState TxUtxoBalance
utxoState <- (ChainIndexState -> UtxoState TxUtxoBalance)
-> Eff effs (UtxoState TxUtxoBalance)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets @ChainIndexState ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState

  case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
UtxoState.tip UtxoState TxUtxoBalance
utxoState 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
-> Maybe (PageQuery TxOutRef) -> [TxOutRef] -> Page TxOutRef
forall a. PageQuery a -> Maybe (PageQuery a) -> [a] -> Page a
Page PageQuery TxOutRef
pageQuery Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing []))
      Tip
tp           -> do
          let query :: Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
query = do
                QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef <- (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall (f :: * -> *). UnspentOutputRowT f -> Columnar f ByteString
_unspentOutputRowOutRef (DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db))
                QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
rowClass <- Q Sqlite
  Db
  (QNested (QNested (QNested QBaseScope)))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
-> (WithRewrittenThread
      (QNested (QNested (QNested QBaseScope)))
      (QNested (QNested QBaseScope))
      (QGenExpr
         QValueContext
         Sqlite
         (QNested (QNested (QNested QBaseScope)))
         ByteString)
    -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (Retag
        Nullable
        (WithRewrittenThread
           (QNested (QNested (QNested QBaseScope)))
           (QNested (QNested QBaseScope))
           (QGenExpr
              QValueContext
              Sqlite
              (QNested (QNested (QNested QBaseScope)))
              ByteString)))
forall s r be (db :: (* -> *) -> *).
(BeamSqlBackend be, Projectible be r,
 ThreadRewritable (QNested s) r,
 Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r)) =>
Q be db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr be s Bool)
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_
                            ((AssetClassRowT
   (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
 -> QGenExpr
      QValueContext
      Sqlite
      (QNested (QNested (QNested QBaseScope)))
      ByteString)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AssetClassRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (QGenExpr
        QValueContext
        Sqlite
        (QNested (QNested (QNested QBaseScope)))
        ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AssetClassRowT
  (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
forall (f :: * -> *). AssetClassRowT f -> Columnar f ByteString
_assetClassRowOutRef ((AssetClassRowT
   (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
 -> QExpr Sqlite (QNested (QNested (QNested QBaseScope))) Bool)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AssetClassRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AssetClassRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\AssetClassRowT
  (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
row -> AssetClassRowT
  (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
-> Columnar
     (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))) ByteString
forall (f :: * -> *). AssetClassRowT f -> Columnar f ByteString
_assetClassRowAssetClass AssetClassRowT
  (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
row QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested (QNested QBaseScope)))
  ByteString
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
-> QExpr Sqlite (QNested (QNested (QNested QBaseScope))) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
DbType AssetClass
assetClass) (DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (AssetClassRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
forall (f :: * -> *). Db f -> f (TableEntity AssetClassRowT)
assetClassRows Db (DatabaseEntity Sqlite Db)
db))))
                            (\WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
row -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
row QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef)
                QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
utxi <- Q Sqlite
  Db
  (QNested (QNested (QNested QBaseScope)))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
-> (WithRewrittenThread
      (QNested (QNested (QNested QBaseScope)))
      (QNested (QNested QBaseScope))
      (QGenExpr
         QValueContext
         Sqlite
         (QNested (QNested (QNested QBaseScope)))
         ByteString)
    -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (Retag
        Nullable
        (WithRewrittenThread
           (QNested (QNested (QNested QBaseScope)))
           (QNested (QNested QBaseScope))
           (QGenExpr
              QValueContext
              Sqlite
              (QNested (QNested (QNested QBaseScope)))
              ByteString)))
forall s r be (db :: (* -> *) -> *).
(BeamSqlBackend be, Projectible be r,
 ThreadRewritable (QNested s) r,
 Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r)) =>
Q be db (QNested s) r
-> (WithRewrittenThread (QNested s) s r -> QExpr be s Bool)
-> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r))
leftJoin_ ((UnmatchedInputRowT
   (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
 -> QGenExpr
      QValueContext
      Sqlite
      (QNested (QNested (QNested QBaseScope)))
      ByteString)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (UnmatchedInputRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (QGenExpr
        QValueContext
        Sqlite
        (QNested (QNested (QNested QBaseScope)))
        ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnmatchedInputRowT
  (QExpr Sqlite (QNested (QNested (QNested QBaseScope))))
-> QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString
forall (f :: * -> *). UnmatchedInputRowT f -> Columnar f ByteString
_unmatchedInputRowOutRef (Q Sqlite
   Db
   (QNested (QNested (QNested QBaseScope)))
   (UnmatchedInputRowT
      (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
 -> Q Sqlite
      Db
      (QNested (QNested (QNested QBaseScope)))
      (QGenExpr
         QValueContext
         Sqlite
         (QNested (QNested (QNested QBaseScope)))
         ByteString))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (UnmatchedInputRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (QGenExpr
        QValueContext
        Sqlite
        (QNested (QNested (QNested QBaseScope)))
        ByteString)
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> Q Sqlite
     Db
     (QNested (QNested (QNested QBaseScope)))
     (UnmatchedInputRowT
        (QExpr Sqlite (QNested (QNested (QNested QBaseScope)))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db)) (\WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
utxi -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
WithRewrittenThread
  (QNested (QNested (QNested QBaseScope)))
  (QNested (QNested QBaseScope))
  (QGenExpr
     QValueContext
     Sqlite
     (QNested (QNested (QNested QBaseScope)))
     ByteString)
utxi)
                QExpr Sqlite (QNested (QNested QBaseScope)) Bool
-> Q Sqlite Db (QNested (QNested QBaseScope)) ()
forall be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
QExpr be s Bool -> Q be db s ()
guard_ (QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall be a nonNullA s ctxt.
SqlDeconstructMaybe be a nonNullA s =>
a -> QGenExpr ctxt be s Bool
isNothing_ QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
utxi)
                QExpr Sqlite (QNested (QNested QBaseScope)) Bool
-> Q Sqlite Db (QNested (QNested QBaseScope)) ()
forall be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
QExpr be s Bool -> Q be db s ()
guard_ (QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall be a nonNullA s ctxt.
SqlDeconstructMaybe be a nonNullA s =>
a -> QGenExpr ctxt be s Bool
isJust_ QGenExpr
  QValueContext
  Sqlite
  (QNested (QNested QBaseScope))
  (Maybe ByteString)
rowClass)
                QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
rowRef

          Page ByteString
outRefs <- PageQuery ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Eff effs (Page ByteString)
forall dbt a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow dbt a, HasSqlValueSyntax (Synt dbt) a,
 Member (BeamEffect dbt) effs, HasQBuilder dbt) =>
PageQuery a
-> Q dbt
     db
     (QNested (QNested QBaseScope))
     (QExpr dbt (QNested (QNested QBaseScope)) a)
-> Eff effs (Page a)
selectPage ((TxOutRef -> ByteString)
-> PageQuery TxOutRef -> PageQuery ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOutRef -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue PageQuery TxOutRef
pageQuery) Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
query
          let page :: Page TxOutRef
page = (ByteString -> TxOutRef) -> Page ByteString -> Page TxOutRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> TxOutRef
forall a. HasDbType a => DbType a -> a
fromDbValue Page ByteString
outRefs

          UtxosResponse -> Eff effs UtxosResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tip -> Page TxOutRef -> UtxosResponse
UtxosResponse Tip
tp Page TxOutRef
page)

getTxsFromTxIds
  :: forall effs.
    ( Member (BeamEffect Sqlite) effs
    )
  => [TxId]
  -> Eff effs [ChainIndexTx]
getTxsFromTxIds :: [TxId] -> Eff effs [ChainIndexTx]
getTxsFromTxIds [TxId]
txIds =
  do
    let
      txIds' :: [ByteString]
txIds' = TxId -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue (TxId -> ByteString) -> [TxId] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxId]
txIds
      query :: Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
query =
        (TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
 -> QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
forall (f :: * -> *). TxRowT f -> Columnar f ByteString
_txRowTx
          (Q Sqlite
   Db
   QBaseScope
   (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope ByteString))
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
forall a b. (a -> b) -> a -> b
$ (TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
 -> QExpr Sqlite QBaseScope Bool)
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
row -> TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
-> Columnar (QGenExpr QValueContext Sqlite QBaseScope) ByteString
forall (f :: * -> *). TxRowT f -> Columnar f ByteString
_txRowTxId TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
row QGenExpr QValueContext Sqlite QBaseScope ByteString
-> [QGenExpr QValueContext Sqlite QBaseScope ByteString]
-> QExpr Sqlite QBaseScope Bool
forall (expr :: * -> *) a. SqlIn expr a => a -> [a] -> expr Bool
`in_` (ByteString -> QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> [ByteString]
-> [QGenExpr QValueContext Sqlite QBaseScope ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> QGenExpr QValueContext Sqlite QBaseScope ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ [ByteString]
txIds')
          (Q Sqlite
   Db
   QBaseScope
   (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> Q Sqlite
      Db
      QBaseScope
      (TxRowT (QGenExpr QValueContext Sqlite QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity TxRowT)
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TxRowT)
forall (f :: * -> *). Db f -> f (TableEntity TxRowT)
txRows Db (DatabaseEntity Sqlite Db)
db)
    [ByteString]
txs <- SqlSelect Sqlite ByteString -> Eff effs [ByteString]
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs [a]
selectList (SqlSelect Sqlite ByteString -> Eff effs [ByteString])
-> SqlSelect Sqlite ByteString -> Eff effs [ByteString]
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> SqlSelect
     Sqlite
     (QExprToIdentity
        (QGenExpr QValueContext Sqlite QBaseScope ByteString))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
query
    [ChainIndexTx] -> Eff effs [ChainIndexTx]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ChainIndexTx] -> Eff effs [ChainIndexTx])
-> [ChainIndexTx] -> Eff effs [ChainIndexTx]
forall a b. (a -> b) -> a -> b
$ (ByteString -> ChainIndexTx) -> [ByteString] -> [ChainIndexTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ChainIndexTx
forall a. HasDbType a => DbType a -> a
fromDbValue [ByteString]
txs

getTxoSetAtAddress
  :: forall effs.
    ( Member (State ChainIndexState) effs
    , Member (BeamEffect Sqlite) effs
    , Member (LogMsg ChainIndexLog) effs
    )
  => PageQuery TxOutRef
  -> Credential
  -> Eff effs TxosResponse
getTxoSetAtAddress :: PageQuery TxOutRef -> Credential -> Eff effs TxosResponse
getTxoSetAtAddress PageQuery TxOutRef
pageQuery (Credential -> DbType Credential
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType Credential
cred) = do
  UtxoState TxUtxoBalance
utxoState <- (ChainIndexState -> UtxoState TxUtxoBalance)
-> Eff effs (UtxoState TxUtxoBalance)
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets @ChainIndexState ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState
  case UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
UtxoState.tip UtxoState TxUtxoBalance
utxoState 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 (Page TxOutRef -> TxosResponse
TxosResponse (PageQuery TxOutRef
-> Maybe (PageQuery TxOutRef) -> [TxOutRef] -> Page TxOutRef
forall a. PageQuery a -> Maybe (PageQuery a) -> [a] -> Page a
Page PageQuery TxOutRef
pageQuery Maybe (PageQuery TxOutRef)
forall a. Maybe a
Nothing []))
      Tip
_           -> do
          let query :: Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
query =
                (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowOutRef
                  (Q Sqlite
   Db
   (QNested (QNested QBaseScope))
   (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
 -> Q Sqlite
      Db
      (QNested (QNested QBaseScope))
      (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall a b. (a -> b) -> a -> b
$ (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
row -> AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowCred AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
row QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
-> QExpr Sqlite (QNested (QNested QBaseScope)) Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
DbType Credential
cred)
                  (Q Sqlite
   Db
   (QNested (QNested QBaseScope))
   (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
 -> Q Sqlite
      Db
      (QNested (QNested QBaseScope))
      (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity AddressRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
forall (f :: * -> *). Db f -> f (TableEntity AddressRowT)
addressRows Db (DatabaseEntity Sqlite Db)
db)
          Page ByteString
txOutRefs' <- PageQuery ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Eff effs (Page ByteString)
forall dbt a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow dbt a, HasSqlValueSyntax (Synt dbt) a,
 Member (BeamEffect dbt) effs, HasQBuilder dbt) =>
PageQuery a
-> Q dbt
     db
     (QNested (QNested QBaseScope))
     (QExpr dbt (QNested (QNested QBaseScope)) a)
-> Eff effs (Page a)
selectPage ((TxOutRef -> ByteString)
-> PageQuery TxOutRef -> PageQuery ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOutRef -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue PageQuery TxOutRef
pageQuery) Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
query
          let page :: Page TxOutRef
page = (ByteString -> TxOutRef) -> Page ByteString -> Page TxOutRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> TxOutRef
forall a. HasDbType a => DbType a -> a
fromDbValue Page ByteString
txOutRefs'
          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

appendBlocks ::
    forall effs.
    ( Member (State ChainIndexState) effs
    , Member (Reader Depth) effs
    , Member (BeamEffect Sqlite) 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 :: (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
 [UtxoState TxUtxoBalance])
-> ChainSyncBlock
-> Eff
     effs
     (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
      [UtxoState TxUtxoBalance])
processBlock (ChainIndexState
utxoIndexState, [(ChainIndexTx, TxProcessOption)]
txs, [UtxoState TxUtxoBalance]
utxoStates) (Block Tip
tip_ [(ChainIndexTx, TxProcessOption)]
transactions) = do
            let newUtxoState :: UtxoState TxUtxoBalance
newUtxoState = 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)
            case UtxoState TxUtxoBalance
-> ChainIndexState
-> Either InsertUtxoFailed (InsertUtxoSuccess TxUtxoBalance)
forall a.
(Monoid a, Eq a) =>
UtxoState a
-> UtxoIndex a -> Either InsertUtxoFailed (InsertUtxoSuccess a)
UtxoState.insert UtxoState TxUtxoBalance
newUtxoState ChainIndexState
utxoIndexState of
                Left InsertUtxoFailed
err -> do
                    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 -> ChainIndexLog)
-> ChainIndexError -> ChainIndexLog
forall a b. (a -> b) -> a -> b
$ InsertUtxoFailed -> ChainIndexError
InsertionFailed InsertUtxoFailed
err
                    (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
 [UtxoState TxUtxoBalance])
-> Eff
     effs
     (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
      [UtxoState TxUtxoBalance])
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainIndexState
utxoIndexState, [(ChainIndexTx, TxProcessOption)]
txs, [UtxoState TxUtxoBalance]
utxoStates)
                Right InsertUtxoSuccess{ChainIndexState
newIndex :: forall a. InsertUtxoSuccess a -> UtxoIndex a
newIndex :: ChainIndexState
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
                    (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
 [UtxoState TxUtxoBalance])
-> Eff
     effs
     (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
      [UtxoState TxUtxoBalance])
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainIndexState
newIndex, [(ChainIndexTx, TxProcessOption)]
transactions [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
-> [(ChainIndexTx, TxProcessOption)]
forall a. [a] -> [a] -> [a]
++ [(ChainIndexTx, TxProcessOption)]
txs, UtxoState TxUtxoBalance
newUtxoState UtxoState TxUtxoBalance
-> [UtxoState TxUtxoBalance] -> [UtxoState TxUtxoBalance]
forall a. a -> [a] -> [a]
: [UtxoState TxUtxoBalance]
utxoStates)
    ChainIndexState
oldIndex <- forall (effs :: [* -> *]).
Member (State ChainIndexState) effs =>
Eff effs ChainIndexState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @ChainIndexState
    (ChainIndexState
newIndex, [(ChainIndexTx, TxProcessOption)]
transactions, [UtxoState TxUtxoBalance]
utxoStates) <- ((ChainIndexState, [(ChainIndexTx, TxProcessOption)],
  [UtxoState TxUtxoBalance])
 -> ChainSyncBlock
 -> Eff
      effs
      (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
       [UtxoState TxUtxoBalance]))
-> (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
    [UtxoState TxUtxoBalance])
-> [ChainSyncBlock]
-> Eff
     effs
     (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
      [UtxoState TxUtxoBalance])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
 [UtxoState TxUtxoBalance])
-> ChainSyncBlock
-> Eff
     effs
     (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
      [UtxoState TxUtxoBalance])
forall (effs :: [* -> *]).
FindElem (LogMsg ChainIndexLog) effs =>
(ChainIndexState, [(ChainIndexTx, TxProcessOption)],
 [UtxoState TxUtxoBalance])
-> ChainSyncBlock
-> Eff
     effs
     (ChainIndexState, [(ChainIndexTx, TxProcessOption)],
      [UtxoState TxUtxoBalance])
processBlock (ChainIndexState
oldIndex, [], []) [ChainSyncBlock]
blocks
    Depth
depth <- forall (effs :: [* -> *]).
Member (Reader Depth) effs =>
Eff effs Depth
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @Depth
    BeamEffect Sqlite ()
reduceOldUtxoDbEffect <- case Depth -> ChainIndexState -> ReduceBlockCountResult TxUtxoBalance
forall a.
Monoid a =>
Depth -> UtxoIndex a -> ReduceBlockCountResult a
UtxoState.reduceBlockCount Depth
depth ChainIndexState
newIndex of
      ReduceBlockCountResult TxUtxoBalance
UtxoState.BlockCountNotReduced -> do
        ChainIndexState -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put ChainIndexState
newIndex
        BeamEffect Sqlite () -> Eff effs (BeamEffect Sqlite ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamEffect Sqlite () -> Eff effs (BeamEffect Sqlite ()))
-> BeamEffect Sqlite () -> Eff effs (BeamEffect Sqlite ())
forall a b. (a -> b) -> a -> b
$ [BeamEffect Sqlite ()] -> BeamEffect Sqlite ()
forall dbt. [BeamEffect dbt ()] -> BeamEffect dbt ()
Combined []
      ReduceBlockCountResult TxUtxoBalance
lbcResult -> do
        ChainIndexState -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put (ChainIndexState -> Eff effs ()) -> ChainIndexState -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ReduceBlockCountResult TxUtxoBalance -> ChainIndexState
forall a. ReduceBlockCountResult a -> UtxoIndex a
UtxoState.reducedIndex ReduceBlockCountResult TxUtxoBalance
lbcResult
        BeamEffect Sqlite () -> Eff effs (BeamEffect Sqlite ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamEffect Sqlite () -> Eff effs (BeamEffect Sqlite ()))
-> BeamEffect Sqlite () -> Eff effs (BeamEffect Sqlite ())
forall a b. (a -> b) -> a -> b
$ Tip -> BeamEffect Sqlite ()
reduceOldUtxoDb (Tip -> BeamEffect Sqlite ()) -> Tip -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ UtxoState TxUtxoBalance -> Tip
forall a. UtxoState a -> Tip
UtxoState._usTip (UtxoState TxUtxoBalance -> Tip) -> UtxoState TxUtxoBalance -> Tip
forall a b. (a -> b) -> a -> b
$ ReduceBlockCountResult TxUtxoBalance -> UtxoState TxUtxoBalance
forall a. ReduceBlockCountResult a -> UtxoState a
UtxoState.combinedState ReduceBlockCountResult TxUtxoBalance
lbcResult
    [BeamEffect Sqlite ()] -> Eff effs ()
forall dbt (effs :: [* -> *]).
Member (BeamEffect dbt) effs =>
[BeamEffect dbt ()] -> Eff effs ()
combined
        [ BeamEffect Sqlite ()
reduceOldUtxoDbEffect
        , Db InsertRows -> BeamEffect Sqlite ()
insertRows (Db InsertRows -> BeamEffect Sqlite ())
-> Db InsertRows -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTx, TxProcessOption) -> Db InsertRows)
-> [(ChainIndexTx, TxProcessOption)] -> Db InsertRows
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 -> Db InsertRows
fromTx ChainIndexTx
tx else Db InsertRows
forall a. Monoid a => a
mempty) [(ChainIndexTx, TxProcessOption)]
transactions
        , [ChainIndexTx] -> [UtxoState TxUtxoBalance] -> BeamEffect Sqlite ()
insertUtxoDb (((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) [UtxoState TxUtxoBalance]
utxoStates
        ]

handleControl ::
    forall effs.
    ( Member (State ChainIndexState) effs
    , Member (Reader Depth) effs
    , Member (BeamEffect Sqlite) 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 ChainIndexState) effs, Member (Reader Depth) effs,
 Member (BeamEffect Sqlite) effs,
 Member (LogMsg ChainIndexLog) effs) =>
[ChainSyncBlock] -> Eff effs ()
appendBlocks [ChainSyncBlock]
blocks
    Rollback Point
tip_ -> do
        ChainIndexState
oldIndex <- forall (effs :: [* -> *]).
Member (State ChainIndexState) effs =>
Eff effs ChainIndexState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @ChainIndexState
        case Point
-> ChainIndexState
-> Either RollbackFailed (RollbackResult TxUtxoBalance)
TxUtxoBalance.rollback Point
tip_ ChainIndexState
oldIndex 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, ChainIndexState
rolledBackIndex :: forall a. RollbackResult a -> UtxoIndex a
rolledBackIndex :: ChainIndexState
rolledBackIndex} -> do
                ChainIndexState -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put ChainIndexState
rolledBackIndex
                [BeamEffect Sqlite ()] -> Eff effs ()
forall dbt (effs :: [* -> *]).
Member (BeamEffect dbt) effs =>
[BeamEffect dbt ()] -> Eff effs ()
combined [Point -> BeamEffect Sqlite ()
rollbackUtxoDb (Point -> BeamEffect Sqlite ()) -> Point -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ Tip -> Point
tipAsPoint Tip
newTip]
                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
tip_ -> do
        [BeamEffect Sqlite ()] -> Eff effs ()
forall dbt (effs :: [* -> *]).
Member (BeamEffect dbt) effs =>
[BeamEffect dbt ()] -> Eff effs ()
combined [Point -> BeamEffect Sqlite ()
rollbackUtxoDb Point
tip_]
        ChainIndexState
newState <- Eff effs ChainIndexState
forall (effs :: [* -> *]).
Member (BeamEffect Sqlite) effs =>
Eff effs ChainIndexState
restoreStateFromDb
        ChainIndexState -> Eff effs ()
forall s (effs :: [* -> *]).
Member (State s) effs =>
s -> Eff effs ()
put ChainIndexState
newState
    ChainIndexControlEffect x
CollectGarbage -> do
        -- Rebuild the index using only transactions that still have at
        -- least one output in the UTXO set
        [TxId]
utxos <- (ChainIndexState -> [TxId]) -> Eff effs [TxId]
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets ((ChainIndexState -> [TxId]) -> Eff effs [TxId])
-> (ChainIndexState -> [TxId]) -> Eff effs [TxId]
forall a b. (a -> b) -> a -> b
$
            Set TxId -> [TxId]
forall a. Set a -> [a]
Set.toList
            (Set TxId -> [TxId])
-> (ChainIndexState -> Set TxId) -> ChainIndexState -> [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)
-> (ChainIndexState -> Set TxOutRef) -> ChainIndexState -> Set TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoState TxUtxoBalance -> Set TxOutRef
TxUtxoBalance.unspentOutputs
            (UtxoState TxUtxoBalance -> Set TxOutRef)
-> (ChainIndexState -> UtxoState TxUtxoBalance)
-> ChainIndexState
-> Set TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState
        Db InsertRows
rows <- (ChainIndexTx -> Db InsertRows) -> [ChainIndexTx] -> Db InsertRows
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ChainIndexTx -> Db InsertRows
fromTx ([ChainIndexTx] -> Db InsertRows)
-> ([Maybe ChainIndexTx] -> [ChainIndexTx])
-> [Maybe ChainIndexTx]
-> Db InsertRows
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ChainIndexTx] -> [ChainIndexTx]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ChainIndexTx] -> Db InsertRows)
-> Eff effs [Maybe ChainIndexTx] -> Eff effs (Db InsertRows)
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 (BeamEffect Sqlite) effs =>
TxId -> Eff effs (Maybe ChainIndexTx)
getTxFromTxId [TxId]
utxos
        [BeamEffect Sqlite ()] -> Eff effs ()
forall dbt (effs :: [* -> *]).
Member (BeamEffect dbt) effs =>
[BeamEffect dbt ()] -> Eff effs ()
combined ([BeamEffect Sqlite ()] -> Eff effs ())
-> [BeamEffect Sqlite ()] -> Eff effs ()
forall a b. (a -> b) -> a -> b
$
            [ SqlDelete Sqlite DatumRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite DatumRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite DatumRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity DatumRowT)
-> SqlDelete Sqlite DatumRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity DatumRowT)
forall (f :: * -> *). Db f -> f (TableEntity DatumRowT)
datumRows Db (DatabaseEntity Sqlite Db)
db)
            , SqlDelete Sqlite ScriptRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite ScriptRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite ScriptRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity ScriptRowT)
-> SqlDelete Sqlite ScriptRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity ScriptRowT)
forall (f :: * -> *). Db f -> f (TableEntity ScriptRowT)
scriptRows Db (DatabaseEntity Sqlite Db)
db)
            , SqlDelete Sqlite RedeemerRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite RedeemerRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite RedeemerRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity RedeemerRowT)
-> SqlDelete Sqlite RedeemerRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity RedeemerRowT)
forall (f :: * -> *). Db f -> f (TableEntity RedeemerRowT)
redeemerRows Db (DatabaseEntity Sqlite Db)
db)
            , SqlDelete Sqlite TxRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite TxRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite TxRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity TxRowT)
-> SqlDelete Sqlite TxRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TxRowT)
forall (f :: * -> *). Db f -> f (TableEntity TxRowT)
txRows Db (DatabaseEntity Sqlite Db)
db)
            , SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
-> SqlDelete Sqlite UtxoRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
forall (f :: * -> *). Db f -> f (TableEntity UtxoRowT)
utxoOutRefRows Db (DatabaseEntity Sqlite Db)
db)
            , SqlDelete Sqlite AddressRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite AddressRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite AddressRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity AddressRowT)
-> SqlDelete Sqlite AddressRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
forall (f :: * -> *). Db f -> f (TableEntity AddressRowT)
addressRows Db (DatabaseEntity Sqlite Db)
db)
            , SqlDelete Sqlite AssetClassRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite AssetClassRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite AssetClassRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
-> SqlDelete Sqlite AssetClassRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
forall (f :: * -> *). Db f -> f (TableEntity AssetClassRowT)
assetClassRows Db (DatabaseEntity Sqlite Db)
db)
            ] [BeamEffect Sqlite ()]
-> [BeamEffect Sqlite ()] -> [BeamEffect Sqlite ()]
forall a. [a] -> [a] -> [a]
++ Const [BeamEffect Sqlite ()] (Db Any) -> [BeamEffect Sqlite ()]
forall a k (b :: k). Const a b -> a
getConst (Proxy Any
-> (forall tbl.
    (IsDatabaseEntity Any tbl,
     DatabaseEntityRegularRequirements Any tbl) =>
    DatabaseEntity Sqlite Db tbl
    -> InsertRows tbl -> Const [BeamEffect Sqlite ()] (Any tbl))
-> Db (DatabaseEntity Sqlite Db)
-> Db InsertRows
-> Const [BeamEffect Sqlite ()] (Db Any)
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables Proxy Any
forall k (t :: k). Proxy t
Proxy (\DatabaseEntity Sqlite Db tbl
tbl (InsertRows r) -> [BeamEffect Sqlite ()] -> Const [BeamEffect Sqlite ()] (Any tbl)
forall k a (b :: k). a -> Const a b
Const [Int
-> DatabaseEntity Sqlite Db (TableEntity t)
-> [t Identity]
-> BeamEffect Sqlite ()
forall dbt (table :: (* -> *) -> *) (db :: (* -> *) -> *).
BeamableDb dbt table =>
Int
-> DatabaseEntity dbt db (TableEntity table)
-> [table Identity]
-> BeamEffect dbt ()
AddRowsInBatches Int
batchSize DatabaseEntity Sqlite Db tbl
DatabaseEntity Sqlite Db (TableEntity t)
tbl [t Identity]
r]) Db (DatabaseEntity Sqlite Db)
db Db InsertRows
rows)

        where
            truncateTable :: DatabaseEntity be db (TableEntity table) -> SqlDelete be table
truncateTable DatabaseEntity be db (TableEntity table)
table = DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete DatabaseEntity be db (TableEntity table)
table (QExpr be s Bool -> table (QExpr be Any) -> QExpr be s Bool
forall a b. a -> b -> a
const (HaskellLiteralForQExpr (QExpr be s Bool) -> QExpr be s Bool
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Bool
HaskellLiteralForQExpr (QExpr be s Bool)
True))
    ChainIndexControlEffect x
GetDiagnostics -> Eff effs x
forall (effs :: [* -> *]).
(Member (BeamEffect Sqlite) effs,
 Member (State ChainIndexState) effs) =>
Eff effs Diagnostics
diagnostics


-- Use a batch size of 200 so that we don't hit the sql too-many-variables
-- limit.
batchSize :: Int
batchSize :: Int
batchSize = Int
200

insertUtxoDb
    :: [ChainIndexTx]
    -> [UtxoState.UtxoState TxUtxoBalance]
    -> (BeamEffect Sqlite) ()
insertUtxoDb :: [ChainIndexTx] -> [UtxoState TxUtxoBalance] -> BeamEffect Sqlite ()
insertUtxoDb [ChainIndexTx]
txs [UtxoState TxUtxoBalance]
utxoStates =
    let
        go :: ([TipRow], [UnspentOutputRowT f], [UnmatchedInputRowT f])
-> UtxoState TxUtxoBalance
-> ([TipRow], [UnspentOutputRowT f], [UnmatchedInputRowT f])
go ([TipRow], [UnspentOutputRowT f], [UnmatchedInputRowT f])
acc (UtxoState.UtxoState TxUtxoBalance
_ Tip
TipAtGenesis) = ([TipRow], [UnspentOutputRowT f], [UnmatchedInputRowT f])
acc
        go ([TipRow]
tipRows, [UnspentOutputRowT f]
unspentRows, [UnmatchedInputRowT f]
unmatchedRows) (UtxoState.UtxoState (TxUtxoBalance Set TxOutRef
outputs Set TxOutRef
inputs) Tip
tip) =
            let
                tipRowId :: PrimaryKey TipRowT f
tipRowId = Columnar f Word64 -> PrimaryKey TipRowT f
forall (f :: * -> *). Columnar f Word64 -> PrimaryKey TipRowT f
TipRowId (Slot -> DbType Slot
forall a. HasDbType a => a -> DbType a
toDbValue (Tip -> Slot
tipSlot Tip
tip))
                newTips :: [TipRow]
newTips = [Maybe TipRow] -> [TipRow]
forall a. [Maybe a] -> [a]
catMaybes [Tip -> DbType Tip
forall a. HasDbType a => a -> DbType a
toDbValue Tip
tip]
                newUnspent :: [UnspentOutputRowT f]
newUnspent = PrimaryKey TipRowT f
-> Columnar f ByteString -> UnspentOutputRowT f
forall (f :: * -> *).
PrimaryKey TipRowT f
-> Columnar f ByteString -> UnspentOutputRowT f
UnspentOutputRow PrimaryKey TipRowT f
tipRowId (ByteString -> UnspentOutputRowT f)
-> (TxOutRef -> ByteString) -> TxOutRef -> UnspentOutputRowT f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue (TxOutRef -> UnspentOutputRowT f)
-> [TxOutRef] -> [UnspentOutputRowT f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
outputs
                newUnmatched :: [UnmatchedInputRowT f]
newUnmatched = PrimaryKey TipRowT f
-> Columnar f ByteString -> UnmatchedInputRowT f
forall (f :: * -> *).
PrimaryKey TipRowT f
-> Columnar f ByteString -> UnmatchedInputRowT f
UnmatchedInputRow PrimaryKey TipRowT f
tipRowId (ByteString -> UnmatchedInputRowT f)
-> (TxOutRef -> ByteString) -> TxOutRef -> UnmatchedInputRowT f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> ByteString
forall a. HasDbType a => a -> DbType a
toDbValue (TxOutRef -> UnmatchedInputRowT f)
-> [TxOutRef] -> [UnmatchedInputRowT f]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TxOutRef -> [TxOutRef]
forall a. Set a -> [a]
Set.toList Set TxOutRef
inputs
            in
            ( [TipRow]
newTips [TipRow] -> [TipRow] -> [TipRow]
forall a. [a] -> [a] -> [a]
++ [TipRow]
tipRows
            , [UnspentOutputRowT f]
newUnspent [UnspentOutputRowT f]
-> [UnspentOutputRowT f] -> [UnspentOutputRowT f]
forall a. [a] -> [a] -> [a]
++ [UnspentOutputRowT f]
unspentRows
            , [UnmatchedInputRowT f]
newUnmatched [UnmatchedInputRowT f]
-> [UnmatchedInputRowT f] -> [UnmatchedInputRowT f]
forall a. [a] -> [a] -> [a]
++ [UnmatchedInputRowT f]
unmatchedRows)
        ([TipRow]
tr, [UnspentOutputRowT Identity]
ur, [UnmatchedInputRowT Identity]
umr) = (([TipRow], [UnspentOutputRowT Identity],
  [UnmatchedInputRowT Identity])
 -> UtxoState TxUtxoBalance
 -> ([TipRow], [UnspentOutputRowT Identity],
     [UnmatchedInputRowT Identity]))
-> ([TipRow], [UnspentOutputRowT Identity],
    [UnmatchedInputRowT Identity])
-> [UtxoState TxUtxoBalance]
-> ([TipRow], [UnspentOutputRowT Identity],
    [UnmatchedInputRowT Identity])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([TipRow], [UnspentOutputRowT Identity],
 [UnmatchedInputRowT Identity])
-> UtxoState TxUtxoBalance
-> ([TipRow], [UnspentOutputRowT Identity],
    [UnmatchedInputRowT Identity])
forall (f :: * -> *).
(Columnar f Word64 ~ Word64, Columnar f ByteString ~ ByteString) =>
([TipRow], [UnspentOutputRowT f], [UnmatchedInputRowT f])
-> UtxoState TxUtxoBalance
-> ([TipRow], [UnspentOutputRowT f], [UnmatchedInputRowT f])
go ([] :: [TipRow], [] :: [UnspentOutputRow], [] :: [UnmatchedInputRow]) [UtxoState TxUtxoBalance]
utxoStates
        outs :: [(ChainIndexTxOut, TxOutRef)]
outs = (ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)])
-> [ChainIndexTx] -> [(ChainIndexTxOut, TxOutRef)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef [ChainIndexTx]
txs
    in Db InsertRows -> BeamEffect Sqlite ()
insertRows (Db InsertRows -> BeamEffect Sqlite ())
-> Db InsertRows -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ Db InsertRows
forall a. Monoid a => a
mempty
        { tipRows :: InsertRows (TableEntity TipRowT)
tipRows = [TipRow] -> InsertRows (TableEntity TipRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [TipRow]
tr
        , unspentOutputRows :: InsertRows (TableEntity UnspentOutputRowT)
unspentOutputRows = [UnspentOutputRowT Identity]
-> InsertRows (TableEntity UnspentOutputRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [UnspentOutputRowT Identity]
ur
        , unmatchedInputRows :: InsertRows (TableEntity UnmatchedInputRowT)
unmatchedInputRows = [UnmatchedInputRowT Identity]
-> InsertRows (TableEntity UnmatchedInputRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [UnmatchedInputRowT Identity]
umr
        , utxoOutRefRows :: InsertRows (TableEntity UtxoRowT)
utxoOutRefRows = [UtxoRowT Identity] -> InsertRows (TableEntity UtxoRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows ([UtxoRowT Identity] -> InsertRows (TableEntity UtxoRowT))
-> [UtxoRowT Identity] -> InsertRows (TableEntity UtxoRowT)
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTxOut, TxOutRef) -> UtxoRowT Identity)
-> [(ChainIndexTxOut, TxOutRef)] -> [UtxoRowT Identity]
forall a b. (a -> b) -> [a] -> [b]
map (\(ChainIndexTxOut
txOut, TxOutRef
txOutRef) -> Columnar Identity ByteString
-> Columnar Identity ByteString -> UtxoRowT Identity
forall (f :: * -> *).
Columnar f ByteString -> Columnar f ByteString -> UtxoRowT f
UtxoRow (TxOutRef -> DbType TxOutRef
forall a. HasDbType a => a -> DbType a
toDbValue TxOutRef
txOutRef) (ChainIndexTxOut -> DbType ChainIndexTxOut
forall a. HasDbType a => a -> DbType a
toDbValue ChainIndexTxOut
txOut)) [(ChainIndexTxOut, TxOutRef)]
outs
        }

reduceOldUtxoDb :: Tip -> (BeamEffect Sqlite) ()
reduceOldUtxoDb :: Tip -> BeamEffect Sqlite ()
reduceOldUtxoDb Tip
TipAtGenesis = [BeamEffect Sqlite ()] -> BeamEffect Sqlite ()
forall dbt. [BeamEffect dbt ()] -> BeamEffect dbt ()
Combined []
reduceOldUtxoDb (Tip (Slot -> DbType Slot
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType Slot
slot) BlockId
_ BlockNumber
_) = [BeamEffect Sqlite ()] -> BeamEffect Sqlite ()
forall dbt. [BeamEffect dbt ()] -> BeamEffect dbt ()
Combined
    -- Delete all the tips before 'slot'
    [ SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> (forall s.
    (forall s'. TipRowT (QExpr Sqlite s')) -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite TipRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
forall (f :: * -> *). Db f -> f (TableEntity TipRowT)
tipRows Db (DatabaseEntity Sqlite Db)
db) (\forall s'. TipRowT (QExpr Sqlite s')
row -> TipRowT (QExpr Sqlite s) -> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). TipRowT f -> Columnar f Word64
_tipRowSlot TipRowT (QExpr Sqlite s)
forall s'. TipRowT (QExpr Sqlite s')
row QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
<. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot)
    -- Assign all the older utxo changes to 'slot'
    , SqlUpdate Sqlite UnspentOutputRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlUpdate dbt table -> BeamEffect dbt ()
UpdateRows (SqlUpdate Sqlite UnspentOutputRowT -> BeamEffect Sqlite ())
-> SqlUpdate Sqlite UnspentOutputRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> (forall s. UnspentOutputRowT (QField s) -> QAssignment Sqlite s)
-> (forall s.
    UnspentOutputRowT (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> SqlUpdate Sqlite UnspentOutputRowT
forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> (forall s. table (QField s) -> QAssignment be s)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
update
        (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db)
        (\UnspentOutputRowT (QField s)
row -> UnspentOutputRowT (QField s) -> PrimaryKey TipRowT (QField s)
forall (f :: * -> *). UnspentOutputRowT f -> PrimaryKey TipRowT f
_unspentOutputRowTip UnspentOutputRowT (QField s)
row PrimaryKey TipRowT (QField s)
-> PrimaryKey TipRowT (QExpr Sqlite s) -> QAssignment Sqlite s
forall be s lhs rhs.
SqlUpdatable be s lhs rhs =>
lhs -> rhs -> QAssignment be s
<-. Columnar (QExpr Sqlite s) Word64
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). Columnar f Word64 -> PrimaryKey TipRowT f
TipRowId (HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot))
        (\UnspentOutputRowT (QExpr Sqlite s)
row -> PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnspentOutputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnspentOutputRowT f -> PrimaryKey TipRowT f
_unspentOutputRowTip UnspentOutputRowT (QExpr Sqlite s)
row) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
<. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot)
    , SqlUpdate Sqlite UnmatchedInputRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlUpdate dbt table -> BeamEffect dbt ()
UpdateRows (SqlUpdate Sqlite UnmatchedInputRowT -> BeamEffect Sqlite ())
-> SqlUpdate Sqlite UnmatchedInputRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> (forall s.
    UnmatchedInputRowT (QField s) -> QAssignment Sqlite s)
-> (forall s.
    UnmatchedInputRowT (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> SqlUpdate Sqlite UnmatchedInputRowT
forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> (forall s. table (QField s) -> QAssignment be s)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
update
        (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db)
        (\UnmatchedInputRowT (QField s)
row -> UnmatchedInputRowT (QField s) -> PrimaryKey TipRowT (QField s)
forall (f :: * -> *). UnmatchedInputRowT f -> PrimaryKey TipRowT f
_unmatchedInputRowTip UnmatchedInputRowT (QField s)
row PrimaryKey TipRowT (QField s)
-> PrimaryKey TipRowT (QExpr Sqlite s) -> QAssignment Sqlite s
forall be s lhs rhs.
SqlUpdatable be s lhs rhs =>
lhs -> rhs -> QAssignment be s
<-. Columnar (QExpr Sqlite s) Word64
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). Columnar f Word64 -> PrimaryKey TipRowT f
TipRowId (HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot))
        (\UnmatchedInputRowT (QExpr Sqlite s)
row -> PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnmatchedInputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnmatchedInputRowT f -> PrimaryKey TipRowT f
_unmatchedInputRowTip UnmatchedInputRowT (QExpr Sqlite s)
row) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
<. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot)
    -- Among these older changes, delete the matching input/output pairs
    -- We're deleting only the outputs here, the matching input is deleted by a trigger (See Main.hs)
    , SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
-> (forall s.
    (forall s'. UtxoRowT (QExpr Sqlite s')) -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite UtxoRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete
        (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
forall (f :: * -> *). Db f -> f (TableEntity UtxoRowT)
utxoOutRefRows Db (DatabaseEntity Sqlite Db)
db)
        (\forall s'. UtxoRowT (QExpr Sqlite s')
utxoRow ->
            Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
-> QExpr Sqlite s Bool
forall be a (db :: (* -> *) -> *) s.
(BeamSqlBackend be, HasQBuilder be, Projectible be a) =>
Q be db s a -> QExpr be s Bool
exists_ ((UnmatchedInputRowT (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
-> Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
                (\UnmatchedInputRowT (QExpr Sqlite s)
input ->
                    (PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnmatchedInputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnmatchedInputRowT f -> PrimaryKey TipRowT f
_unmatchedInputRowTip UnmatchedInputRowT (QExpr Sqlite s)
input) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot) QExpr Sqlite s Bool -> QExpr Sqlite s Bool -> QExpr Sqlite s Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&.
                    (UtxoRowT (QExpr Sqlite s) -> Columnar (QExpr Sqlite s) ByteString
forall (f :: * -> *). UtxoRowT f -> Columnar f ByteString
_utxoRowOutRef UtxoRowT (QExpr Sqlite s)
forall s'. UtxoRowT (QExpr Sqlite s')
utxoRow QGenExpr QValueContext Sqlite s ByteString
-> QGenExpr QValueContext Sqlite s ByteString
-> QExpr Sqlite s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. UnmatchedInputRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) ByteString
forall (f :: * -> *). UnmatchedInputRowT f -> Columnar f ByteString
_unmatchedInputRowOutRef UnmatchedInputRowT (QExpr Sqlite s)
input))
                (DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db))))
    , SqlDelete Sqlite UnspentOutputRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite UnspentOutputRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite UnspentOutputRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> (forall s.
    (forall s'. UnspentOutputRowT (QExpr Sqlite s'))
    -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite UnspentOutputRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete
        (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db)
        (\forall s'. UnspentOutputRowT (QExpr Sqlite s')
output -> PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnspentOutputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnspentOutputRowT f -> PrimaryKey TipRowT f
_unspentOutputRowTip UnspentOutputRowT (QExpr Sqlite s)
forall s'. UnspentOutputRowT (QExpr Sqlite s')
output) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot QExpr Sqlite s Bool -> QExpr Sqlite s Bool -> QExpr Sqlite s Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&.
            Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
-> QExpr Sqlite s Bool
forall be a (db :: (* -> *) -> *) s.
(BeamSqlBackend be, HasQBuilder be, Projectible be a) =>
Q be db s a -> QExpr be s Bool
exists_ ((UnmatchedInputRowT (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
-> Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
                (\UnmatchedInputRowT (QExpr Sqlite s)
input ->
                    (PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnmatchedInputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnmatchedInputRowT f -> PrimaryKey TipRowT f
_unmatchedInputRowTip UnmatchedInputRowT (QExpr Sqlite s)
input) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot) QExpr Sqlite s Bool -> QExpr Sqlite s Bool -> QExpr Sqlite s Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&.
                    (UnspentOutputRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) ByteString
forall (f :: * -> *). UnspentOutputRowT f -> Columnar f ByteString
_unspentOutputRowOutRef UnspentOutputRowT (QExpr Sqlite s)
forall s'. UnspentOutputRowT (QExpr Sqlite s')
output QGenExpr QValueContext Sqlite s ByteString
-> QGenExpr QValueContext Sqlite s ByteString
-> QExpr Sqlite s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. UnmatchedInputRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) ByteString
forall (f :: * -> *). UnmatchedInputRowT f -> Columnar f ByteString
_unmatchedInputRowOutRef UnmatchedInputRowT (QExpr Sqlite s)
input))
                (DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> Q Sqlite Db s (UnmatchedInputRowT (QExpr Sqlite s))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db))))
    ]

rollbackUtxoDb :: Point -> (BeamEffect Sqlite) ()
rollbackUtxoDb :: Point -> BeamEffect Sqlite ()
rollbackUtxoDb Point
PointAtGenesis = SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> (forall s.
    (forall s'. TipRowT (QExpr Sqlite s')) -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite TipRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
forall (f :: * -> *). Db f -> f (TableEntity TipRowT)
tipRows Db (DatabaseEntity Sqlite Db)
db) (QExpr Sqlite s Bool
-> TipRowT (QExpr Sqlite Any) -> QExpr Sqlite s Bool
forall a b. a -> b -> a
const (HaskellLiteralForQExpr (QExpr Sqlite s Bool) -> QExpr Sqlite s Bool
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ Bool
HaskellLiteralForQExpr (QExpr Sqlite s Bool)
True))
rollbackUtxoDb (Point (Slot -> DbType Slot
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType Slot
slot) BlockId
_) = [BeamEffect Sqlite ()] -> BeamEffect Sqlite ()
forall dbt. [BeamEffect dbt ()] -> BeamEffect dbt ()
Combined
    [ SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite TipRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> (forall s.
    (forall s'. TipRowT (QExpr Sqlite s')) -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite TipRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
forall (f :: * -> *). Db f -> f (TableEntity TipRowT)
tipRows Db (DatabaseEntity Sqlite Db)
db) (\forall s'. TipRowT (QExpr Sqlite s')
row -> TipRowT (QExpr Sqlite s) -> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). TipRowT f -> Columnar f Word64
_tipRowSlot TipRowT (QExpr Sqlite s)
forall s'. TipRowT (QExpr Sqlite s')
row QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
>. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot)
    , SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite UtxoRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
-> (forall s.
    (forall s'. UtxoRowT (QExpr Sqlite s')) -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite UtxoRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
forall (f :: * -> *). Db f -> f (TableEntity UtxoRowT)
utxoOutRefRows Db (DatabaseEntity Sqlite Db)
db)
        (\forall s'. UtxoRowT (QExpr Sqlite s')
utxoRow ->
            Q Sqlite Db s (UnspentOutputRowT (QExpr Sqlite s))
-> QExpr Sqlite s Bool
forall be a (db :: (* -> *) -> *) s.
(BeamSqlBackend be, HasQBuilder be, Projectible be a) =>
Q be db s a -> QExpr be s Bool
exists_ ((UnspentOutputRowT (QExpr Sqlite s) -> QExpr Sqlite s Bool)
-> Q Sqlite Db s (UnspentOutputRowT (QExpr Sqlite s))
-> Q Sqlite Db s (UnspentOutputRowT (QExpr Sqlite s))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_
                (\UnspentOutputRowT (QExpr Sqlite s)
output ->
                    (PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnspentOutputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnspentOutputRowT f -> PrimaryKey TipRowT f
_unspentOutputRowTip UnspentOutputRowT (QExpr Sqlite s)
output) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
>. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot) QExpr Sqlite s Bool -> QExpr Sqlite s Bool -> QExpr Sqlite s Bool
forall be context s.
BeamSqlBackend be =>
QGenExpr context be s Bool
-> QGenExpr context be s Bool -> QGenExpr context be s Bool
&&.
                    (UtxoRowT (QExpr Sqlite s) -> Columnar (QExpr Sqlite s) ByteString
forall (f :: * -> *). UtxoRowT f -> Columnar f ByteString
_utxoRowOutRef UtxoRowT (QExpr Sqlite s)
forall s'. UtxoRowT (QExpr Sqlite s')
utxoRow QGenExpr QValueContext Sqlite s ByteString
-> QGenExpr QValueContext Sqlite s ByteString
-> QExpr Sqlite s Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. UnspentOutputRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) ByteString
forall (f :: * -> *). UnspentOutputRowT f -> Columnar f ByteString
_unspentOutputRowOutRef UnspentOutputRowT (QExpr Sqlite s)
output))
                (DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> Q Sqlite Db s (UnspentOutputRowT (QExpr Sqlite s))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db))))
    , SqlDelete Sqlite UnspentOutputRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite UnspentOutputRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite UnspentOutputRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> (forall s.
    (forall s'. UnspentOutputRowT (QExpr Sqlite s'))
    -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite UnspentOutputRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db) (\forall s'. UnspentOutputRowT (QExpr Sqlite s')
row -> PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnspentOutputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnspentOutputRowT f -> PrimaryKey TipRowT f
_unspentOutputRowTip UnspentOutputRowT (QExpr Sqlite s)
forall s'. UnspentOutputRowT (QExpr Sqlite s')
row) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
>. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot)
    , SqlDelete Sqlite UnmatchedInputRowT -> BeamEffect Sqlite ()
forall (table :: (* -> *) -> *) dbt.
Beamable table =>
SqlDelete dbt table -> BeamEffect dbt ()
DeleteRows (SqlDelete Sqlite UnmatchedInputRowT -> BeamEffect Sqlite ())
-> SqlDelete Sqlite UnmatchedInputRowT -> BeamEffect Sqlite ()
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> (forall s.
    (forall s'. UnmatchedInputRowT (QExpr Sqlite s'))
    -> QExpr Sqlite s Bool)
-> SqlDelete Sqlite UnmatchedInputRowT
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db) (\forall s'. UnmatchedInputRowT (QExpr Sqlite s')
row -> PrimaryKey TipRowT (QExpr Sqlite s)
-> Columnar (QExpr Sqlite s) Word64
forall (f :: * -> *). PrimaryKey TipRowT f -> Columnar f Word64
unTipRowId (UnmatchedInputRowT (QExpr Sqlite s)
-> PrimaryKey TipRowT (QExpr Sqlite s)
forall (f :: * -> *). UnmatchedInputRowT f -> PrimaryKey TipRowT f
_unmatchedInputRowTip UnmatchedInputRowT (QExpr Sqlite s)
forall s'. UnmatchedInputRowT (QExpr Sqlite s')
row) QGenExpr QValueContext Sqlite s Word64
-> QGenExpr QValueContext Sqlite s Word64 -> QExpr Sqlite s Bool
forall (expr :: * -> *) e. SqlOrd expr e => e -> e -> expr Bool
>. HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
-> QGenExpr QValueContext Sqlite s Word64
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ HaskellLiteralForQExpr (QGenExpr QValueContext Sqlite s Word64)
DbType Slot
slot)
    ]

restoreStateFromDb :: Member (BeamEffect Sqlite) effs => Eff effs ChainIndexState
restoreStateFromDb :: Eff effs ChainIndexState
restoreStateFromDb = do
    [UnspentOutputRowT Identity]
uo <- SqlSelect Sqlite (UnspentOutputRowT Identity)
-> Eff effs [UnspentOutputRowT Identity]
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs [a]
selectList (SqlSelect Sqlite (UnspentOutputRowT Identity)
 -> Eff effs [UnspentOutputRowT Identity])
-> (Q Sqlite
      Db
      QBaseScope
      (UnspentOutputRowT (QGenExpr QValueContext Sqlite QBaseScope))
    -> SqlSelect Sqlite (UnspentOutputRowT Identity))
-> Q Sqlite
     Db
     QBaseScope
     (UnspentOutputRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs [UnspentOutputRowT Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (UnspentOutputRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect Sqlite (UnspentOutputRowT Identity)
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (UnspentOutputRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> Eff effs [UnspentOutputRowT Identity])
-> Q Sqlite
     Db
     QBaseScope
     (UnspentOutputRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs [UnspentOutputRowT Identity]
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
-> Q Sqlite
     Db
     QBaseScope
     (UnspentOutputRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnspentOutputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnspentOutputRowT)
unspentOutputRows Db (DatabaseEntity Sqlite Db)
db)
    [UnmatchedInputRowT Identity]
ui <- SqlSelect Sqlite (UnmatchedInputRowT Identity)
-> Eff effs [UnmatchedInputRowT Identity]
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs [a]
selectList (SqlSelect Sqlite (UnmatchedInputRowT Identity)
 -> Eff effs [UnmatchedInputRowT Identity])
-> (Q Sqlite
      Db
      QBaseScope
      (UnmatchedInputRowT (QGenExpr QValueContext Sqlite QBaseScope))
    -> SqlSelect Sqlite (UnmatchedInputRowT Identity))
-> Q Sqlite
     Db
     QBaseScope
     (UnmatchedInputRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs [UnmatchedInputRowT Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (UnmatchedInputRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect Sqlite (UnmatchedInputRowT Identity)
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (UnmatchedInputRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> Eff effs [UnmatchedInputRowT Identity])
-> Q Sqlite
     Db
     QBaseScope
     (UnmatchedInputRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Eff effs [UnmatchedInputRowT Identity]
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> Q Sqlite
     Db
     QBaseScope
     (UnmatchedInputRowT (QGenExpr QValueContext Sqlite QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db)
    let balances :: Map Word64 TxUtxoBalance
balances = (TxUtxoBalance -> TxUtxoBalance -> TxUtxoBalance)
-> [(Word64, TxUtxoBalance)] -> Map Word64 TxUtxoBalance
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith TxUtxoBalance -> TxUtxoBalance -> TxUtxoBalance
forall a. Semigroup a => a -> a -> a
(<>) ([(Word64, TxUtxoBalance)] -> Map Word64 TxUtxoBalance)
-> [(Word64, TxUtxoBalance)] -> Map Word64 TxUtxoBalance
forall a b. (a -> b) -> a -> b
$ (UnspentOutputRowT Identity -> (Word64, TxUtxoBalance))
-> [UnspentOutputRowT Identity] -> [(Word64, TxUtxoBalance)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnspentOutputRowT Identity -> (Word64, TxUtxoBalance)
outputToTxUtxoBalance [UnspentOutputRowT Identity]
uo [(Word64, TxUtxoBalance)]
-> [(Word64, TxUtxoBalance)] -> [(Word64, TxUtxoBalance)]
forall a. [a] -> [a] -> [a]
++ (UnmatchedInputRowT Identity -> (Word64, TxUtxoBalance))
-> [UnmatchedInputRowT Identity] -> [(Word64, TxUtxoBalance)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnmatchedInputRowT Identity -> (Word64, TxUtxoBalance)
inputToTxUtxoBalance [UnmatchedInputRowT Identity]
ui
    [TipRow]
tips <- SqlSelect Sqlite TipRow -> Eff effs [TipRow]
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs [a]
selectList (SqlSelect Sqlite TipRow -> Eff effs [TipRow])
-> (Q Sqlite
      Db
      (QNested QBaseScope)
      (TipRowT (QExpr Sqlite (QNested QBaseScope)))
    -> SqlSelect Sqlite TipRow)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
-> Eff effs [TipRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> SqlSelect Sqlite TipRow
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select
        (Q Sqlite
   Db
   QBaseScope
   (TipRowT (QGenExpr QValueContext Sqlite QBaseScope))
 -> SqlSelect Sqlite TipRow)
-> (Q Sqlite
      Db
      (QNested QBaseScope)
      (TipRowT (QExpr Sqlite (QNested QBaseScope)))
    -> Q Sqlite
         Db
         QBaseScope
         (TipRowT (QGenExpr QValueContext Sqlite QBaseScope)))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
-> SqlSelect Sqlite TipRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TipRowT (QExpr Sqlite (QNested QBaseScope))
 -> QOrd Sqlite (QNested QBaseScope) Word64)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (TipRowT (QExpr Sqlite (QNested QBaseScope))))
forall s a ordering be (db :: (* -> *) -> *).
(Projectible be a, SqlOrderable be ordering,
 ThreadRewritable (QNested s) a) =>
(a -> ordering)
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
orderBy_ (QExpr Sqlite (QNested QBaseScope) Word64
-> QOrd Sqlite (QNested QBaseScope) Word64
forall be s a. BeamSqlBackend be => QExpr be s a -> QOrd be s a
asc_ (QExpr Sqlite (QNested QBaseScope) Word64
 -> QOrd Sqlite (QNested QBaseScope) Word64)
-> (TipRowT (QExpr Sqlite (QNested QBaseScope))
    -> QExpr Sqlite (QNested QBaseScope) Word64)
-> TipRowT (QExpr Sqlite (QNested QBaseScope))
-> QOrd Sqlite (QNested QBaseScope) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TipRowT (QExpr Sqlite (QNested QBaseScope))
-> QExpr Sqlite (QNested QBaseScope) Word64
forall (f :: * -> *). TipRowT f -> Columnar f Word64
_tipRowSlot)
        (Q Sqlite
   Db
   (QNested QBaseScope)
   (TipRowT (QExpr Sqlite (QNested QBaseScope)))
 -> Eff effs [TipRow])
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
-> Eff effs [TipRow]
forall a b. (a -> b) -> a -> b
$ DatabaseEntity Sqlite Db (TableEntity TipRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TipRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TipRowT)
forall (f :: * -> *). Db f -> f (TableEntity TipRowT)
tipRows Db (DatabaseEntity Sqlite Db)
db)
    ChainIndexState -> Eff effs ChainIndexState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainIndexState -> Eff effs ChainIndexState)
-> ChainIndexState -> Eff effs ChainIndexState
forall a b. (a -> b) -> a -> b
$ [UtxoState TxUtxoBalance] -> ChainIndexState
forall v a. Measured v a => [a] -> FingerTree v a
FT.fromList ([UtxoState TxUtxoBalance] -> ChainIndexState)
-> ([TipRow] -> [UtxoState TxUtxoBalance])
-> [TipRow]
-> ChainIndexState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TipRow -> UtxoState TxUtxoBalance)
-> [TipRow] -> [UtxoState TxUtxoBalance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Word64 TxUtxoBalance -> TipRow -> UtxoState TxUtxoBalance
toUtxoState Map Word64 TxUtxoBalance
balances) ([TipRow] -> ChainIndexState) -> [TipRow] -> ChainIndexState
forall a b. (a -> b) -> a -> b
$ [TipRow]
tips
    where
        outputToTxUtxoBalance :: UnspentOutputRow -> (Word64, TxUtxoBalance)
        outputToTxUtxoBalance :: UnspentOutputRowT Identity -> (Word64, TxUtxoBalance)
outputToTxUtxoBalance (UnspentOutputRow (TipRowId slot) Columnar Identity ByteString
outRef)
            = (Word64
Columnar Identity Word64
slot, Set TxOutRef -> Set TxOutRef -> TxUtxoBalance
TxUtxoBalance (TxOutRef -> Set TxOutRef
forall a. a -> Set a
Set.singleton (DbType TxOutRef -> TxOutRef
forall a. HasDbType a => DbType a -> a
fromDbValue Columnar Identity ByteString
DbType TxOutRef
outRef)) Set TxOutRef
forall a. Monoid a => a
mempty)
        inputToTxUtxoBalance :: UnmatchedInputRow -> (Word64, TxUtxoBalance)
        inputToTxUtxoBalance :: UnmatchedInputRowT Identity -> (Word64, TxUtxoBalance)
inputToTxUtxoBalance (UnmatchedInputRow (TipRowId slot) Columnar Identity ByteString
outRef)
            = (Word64
Columnar Identity Word64
slot, Set TxOutRef -> Set TxOutRef -> TxUtxoBalance
TxUtxoBalance Set TxOutRef
forall a. Monoid a => a
mempty (TxOutRef -> Set TxOutRef
forall a. a -> Set a
Set.singleton (DbType TxOutRef -> TxOutRef
forall a. HasDbType a => DbType a -> a
fromDbValue Columnar Identity ByteString
DbType TxOutRef
outRef)))
        toUtxoState :: Map.Map Word64 TxUtxoBalance -> TipRow -> UtxoState.UtxoState TxUtxoBalance
        toUtxoState :: Map Word64 TxUtxoBalance -> TipRow -> UtxoState TxUtxoBalance
toUtxoState Map Word64 TxUtxoBalance
balances tip :: TipRow
tip@(TipRow Columnar Identity Word64
slot Columnar Identity ByteString
_ Columnar Identity Word64
_)
            = TxUtxoBalance -> Tip -> UtxoState TxUtxoBalance
forall a. a -> Tip -> UtxoState a
UtxoState.UtxoState (TxUtxoBalance
-> Word64 -> Map Word64 TxUtxoBalance -> TxUtxoBalance
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault TxUtxoBalance
forall a. Monoid a => a
mempty Word64
Columnar Identity Word64
slot Map Word64 TxUtxoBalance
balances) (DbType Tip -> Tip
forall a. HasDbType a => DbType a -> a
fromDbValue (TipRow -> Maybe TipRow
forall a. a -> Maybe a
Just TipRow
tip))

data InsertRows te where
    InsertRows :: BeamableDb Sqlite t => [t Identity] -> InsertRows (TableEntity t)

instance Semigroup (InsertRows te) where
    InsertRows [t Identity]
l <> :: InsertRows te -> InsertRows te -> InsertRows te
<> InsertRows [t Identity]
r = [t Identity] -> InsertRows (TableEntity t)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows ([t Identity]
l [t Identity] -> [t Identity] -> [t Identity]
forall a. Semigroup a => a -> a -> a
<> [t Identity]
[t Identity]
r)
instance BeamableDb Sqlite t => Monoid (InsertRows (TableEntity t)) where
    mempty :: InsertRows (TableEntity t)
mempty = [t Identity] -> InsertRows (TableEntity t)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows []

insertRows :: Db InsertRows -> (BeamEffect Sqlite) ()
insertRows :: Db InsertRows -> BeamEffect Sqlite ()
insertRows = Const (BeamEffect Sqlite ()) (Db Any) -> BeamEffect Sqlite ()
forall a k (b :: k). Const a b -> a
getConst (Const (BeamEffect Sqlite ()) (Db Any) -> BeamEffect Sqlite ())
-> (Db InsertRows -> Const (BeamEffect Sqlite ()) (Db Any))
-> Db InsertRows
-> BeamEffect Sqlite ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Any
-> (forall tbl.
    (IsDatabaseEntity Any tbl,
     DatabaseEntityRegularRequirements Any tbl) =>
    DatabaseEntity Sqlite Db tbl
    -> InsertRows tbl -> Const (BeamEffect Sqlite ()) (Any tbl))
-> Db (DatabaseEntity Sqlite Db)
-> Db InsertRows
-> Const (BeamEffect Sqlite ()) (Db Any)
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
    (IsDatabaseEntity be tbl,
     DatabaseEntityRegularRequirements be tbl) =>
    f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables Proxy Any
forall k (t :: k). Proxy t
Proxy (\DatabaseEntity Sqlite Db tbl
tbl (InsertRows rows) -> BeamEffect Sqlite () -> Const (BeamEffect Sqlite ()) (Any tbl)
forall k a (b :: k). a -> Const a b
Const (BeamEffect Sqlite () -> Const (BeamEffect Sqlite ()) (Any tbl))
-> BeamEffect Sqlite () -> Const (BeamEffect Sqlite ()) (Any tbl)
forall a b. (a -> b) -> a -> b
$ Int
-> DatabaseEntity Sqlite Db (TableEntity t)
-> [t Identity]
-> BeamEffect Sqlite ()
forall dbt (table :: (* -> *) -> *) (db :: (* -> *) -> *).
BeamableDb dbt table =>
Int
-> DatabaseEntity dbt db (TableEntity table)
-> [table Identity]
-> BeamEffect dbt ()
AddRowsInBatches Int
batchSize DatabaseEntity Sqlite Db tbl
DatabaseEntity Sqlite Db (TableEntity t)
tbl [t Identity]
rows) Db (DatabaseEntity Sqlite Db)
db

fromTx :: ChainIndexTx -> Db InsertRows
fromTx :: ChainIndexTx -> Db InsertRows
fromTx ChainIndexTx
tx = Db InsertRows
forall a. Monoid a => a
mempty
    { datumRows :: InsertRows (TableEntity DatumRowT)
datumRows = [DatumRowT Identity] -> InsertRows (TableEntity DatumRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows ([DatumRowT Identity] -> InsertRows (TableEntity DatumRowT))
-> ([(DatumHash, Datum)] -> [DatumRowT Identity])
-> [(DatumHash, Datum)]
-> InsertRows (TableEntity DatumRowT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DatumHash, Datum) -> DatumRowT Identity)
-> [(DatumHash, Datum)] -> [DatumRowT Identity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DatumHash, Datum) -> DatumRowT Identity
forall a. HasDbType a => a -> DbType a
toDbValue ([(DatumHash, Datum)] -> InsertRows (TableEntity DatumRowT))
-> [(DatumHash, Datum)] -> InsertRows (TableEntity DatumRowT)
forall a b. (a -> b) -> a -> b
$ (Map DatumHash Datum -> [(DatumHash, Datum)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map DatumHash Datum -> [(DatumHash, Datum)])
-> Map DatumHash Datum -> [(DatumHash, Datum)]
forall a b. (a -> b) -> a -> b
$ Map DatumHash Datum -> [ChainIndexTxOut] -> Map DatumHash Datum
updateMapWithInlineDatum (ChainIndexTx -> Map DatumHash Datum
_citxData ChainIndexTx
tx) (ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx
tx))
    , scriptRows :: InsertRows (TableEntity ScriptRowT)
scriptRows = Lens' ChainIndexTx (Map ScriptHash (Versioned Script))
-> InsertRows (TableEntity ScriptRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableDb Sqlite t, HasDbType (k, v),
 DbType (k, v) ~ t Identity) =>
Lens' ChainIndexTx (Map k v) -> InsertRows (TableEntity t)
fromMap Lens' ChainIndexTx (Map ScriptHash (Versioned Script))
citxScripts
    , redeemerRows :: InsertRows (TableEntity RedeemerRowT)
redeemerRows = (ChainIndexTx -> [(RedeemerHash, Redeemer)])
-> InsertRows (TableEntity RedeemerRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableDb Sqlite t, HasDbType (k, v),
 DbType (k, v) ~ t Identity) =>
(ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
fromPairs (Map RedeemerHash Redeemer -> [(RedeemerHash, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map RedeemerHash Redeemer -> [(RedeemerHash, Redeemer)])
-> (ChainIndexTx -> Map RedeemerHash Redeemer)
-> ChainIndexTx
-> [(RedeemerHash, Redeemer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> Map RedeemerHash Redeemer
txRedeemersWithHash)
    , txRows :: InsertRows (TableEntity TxRowT)
txRows = [TxRowT Identity] -> InsertRows (TableEntity TxRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [(TxId, ChainIndexTx) -> DbType (TxId, ChainIndexTx)
forall a. HasDbType a => a -> DbType a
toDbValue (ChainIndexTx -> TxId
_citxTxId ChainIndexTx
tx, ChainIndexTx
tx)]
    , addressRows :: InsertRows (TableEntity AddressRowT)
addressRows = [AddressRowT Identity] -> InsertRows (TableEntity AddressRowT)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows ([AddressRowT Identity] -> InsertRows (TableEntity AddressRowT))
-> (ChainIndexTx -> [AddressRowT Identity])
-> ChainIndexTx
-> InsertRows (TableEntity AddressRowT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ChainIndexTxOut, TxOutRef) -> AddressRowT Identity)
-> [(ChainIndexTxOut, TxOutRef)] -> [AddressRowT Identity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Credential, TxOutRef, Maybe DatumHash) -> AddressRowT Identity
forall a. HasDbType a => a -> DbType a
toDbValue ((Credential, TxOutRef, Maybe DatumHash) -> AddressRowT Identity)
-> ((ChainIndexTxOut, TxOutRef)
    -> (Credential, TxOutRef, Maybe DatumHash))
-> (ChainIndexTxOut, TxOutRef)
-> AddressRowT Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTxOut, TxOutRef)
-> (Credential, TxOutRef, Maybe DatumHash)
credential) ([(ChainIndexTxOut, TxOutRef)] -> [AddressRowT Identity])
-> (ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)])
-> ChainIndexTx
-> [AddressRowT Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef (ChainIndexTx -> InsertRows (TableEntity AddressRowT))
-> ChainIndexTx -> InsertRows (TableEntity AddressRowT)
forall a b. (a -> b) -> a -> b
$ ChainIndexTx
tx
    , assetClassRows :: InsertRows (TableEntity AssetClassRowT)
assetClassRows = (ChainIndexTx -> [(AssetClass, TxOutRef)])
-> InsertRows (TableEntity AssetClassRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableDb Sqlite t, HasDbType (k, v),
 DbType (k, v) ~ t Identity) =>
(ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
fromPairs (((ChainIndexTxOut, TxOutRef) -> [(AssetClass, TxOutRef)])
-> [(ChainIndexTxOut, TxOutRef)] -> [(AssetClass, TxOutRef)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ChainIndexTxOut, TxOutRef) -> [(AssetClass, TxOutRef)]
assetClasses ([(ChainIndexTxOut, TxOutRef)] -> [(AssetClass, TxOutRef)])
-> (ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)])
-> ChainIndexTx
-> [(AssetClass, TxOutRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef)
    }
    where
        credential :: (ChainIndex.ChainIndexTxOut, TxOutRef) -> (Credential, TxOutRef, Maybe DatumHash)
        credential :: (ChainIndexTxOut, TxOutRef)
-> (Credential, TxOutRef, Maybe DatumHash)
credential (ChainIndexTxOut{CardanoAddress
citoAddress :: ChainIndexTxOut -> CardanoAddress
citoAddress :: CardanoAddress
citoAddress,OutputDatum
citoDatum :: ChainIndexTxOut -> OutputDatum
citoDatum :: OutputDatum
citoDatum}, TxOutRef
ref) =
          (CardanoAddress -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential CardanoAddress
citoAddress, TxOutRef
ref, OutputDatum -> Maybe DatumHash
getHashFromDatum OutputDatum
citoDatum)
        assetClasses :: (ChainIndex.ChainIndexTxOut, TxOutRef) -> [(AssetClass, TxOutRef)]
        assetClasses :: (ChainIndexTxOut, TxOutRef) -> [(AssetClass, TxOutRef)]
assetClasses (ChainIndexTxOut{Value
citoValue :: ChainIndexTxOut -> Value
citoValue :: Value
citoValue}, TxOutRef
ref) =
          ((CurrencySymbol, TokenName, Integer) -> (AssetClass, TxOutRef))
-> [(CurrencySymbol, TokenName, Integer)]
-> [(AssetClass, TxOutRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CurrencySymbol
c, TokenName
t, Integer
_) -> ((CurrencySymbol, TokenName) -> AssetClass
AssetClass (CurrencySymbol
c, TokenName
t), TxOutRef
ref))
               -- We don't store the 'AssetClass' when it is the Ada currency.
               ([(CurrencySymbol, TokenName, Integer)]
 -> [(AssetClass, TxOutRef)])
-> [(CurrencySymbol, TokenName, Integer)]
-> [(AssetClass, TxOutRef)]
forall a b. (a -> b) -> a -> b
$ ((CurrencySymbol, TokenName, Integer) -> Bool)
-> [(CurrencySymbol, TokenName, Integer)]
-> [(CurrencySymbol, TokenName, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CurrencySymbol
c, TokenName
t, Integer
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ CurrencySymbol
Ada.adaSymbol CurrencySymbol -> CurrencySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CurrencySymbol
c Bool -> Bool -> Bool
&& TokenName
Ada.adaToken TokenName -> TokenName -> Bool
forall a. Eq a => a -> a -> Bool
== TokenName
t)
               ([(CurrencySymbol, TokenName, Integer)]
 -> [(CurrencySymbol, TokenName, Integer)])
-> [(CurrencySymbol, TokenName, Integer)]
-> [(CurrencySymbol, TokenName, Integer)]
forall a b. (a -> b) -> a -> b
$ Value -> [(CurrencySymbol, TokenName, Integer)]
flattenValue (Value -> [(CurrencySymbol, TokenName, Integer)])
-> Value -> [(CurrencySymbol, TokenName, Integer)]
forall a b. (a -> b) -> a -> b
$ Value -> Value
fromCardanoValue Value
citoValue
        fromMap
            :: (BeamableDb Sqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity)
            => Lens' ChainIndexTx (Map.Map k v)
            -> InsertRows (TableEntity t)
        fromMap :: Lens' ChainIndexTx (Map k v) -> InsertRows (TableEntity t)
fromMap Lens' ChainIndexTx (Map k v)
l = (ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
forall (t :: (* -> *) -> *) k v.
(BeamableDb Sqlite t, HasDbType (k, v),
 DbType (k, v) ~ t Identity) =>
(ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
fromPairs (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map k v -> [(k, v)])
-> (ChainIndexTx -> Map k v) -> ChainIndexTx -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map k v) ChainIndexTx (Map k v) -> ChainIndexTx -> Map k v
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map k v) ChainIndexTx (Map k v)
Lens' ChainIndexTx (Map k v)
l)
        fromPairs
            :: (BeamableDb Sqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity)
            => (ChainIndexTx -> [(k, v)])
            -> InsertRows (TableEntity t)
        fromPairs :: (ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
fromPairs ChainIndexTx -> [(k, v)]
l = [t Identity] -> InsertRows (TableEntity t)
forall (t :: (* -> *) -> *).
BeamableDb Sqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows ([t Identity] -> InsertRows (TableEntity t))
-> (ChainIndexTx -> [t Identity])
-> ChainIndexTx
-> InsertRows (TableEntity t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> t Identity) -> [(k, v)] -> [t Identity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, v) -> t Identity
forall a. HasDbType a => a -> DbType a
toDbValue ([(k, v)] -> [t Identity])
-> (ChainIndexTx -> [(k, v)]) -> ChainIndexTx -> [t Identity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(k, v)]
l (ChainIndexTx -> InsertRows (TableEntity t))
-> ChainIndexTx -> InsertRows (TableEntity t)
forall a b. (a -> b) -> a -> b
$ ChainIndexTx
tx

        updateMapWithInlineDatum :: Map.Map DatumHash Datum -> [ChainIndex.ChainIndexTxOut] -> Map.Map DatumHash Datum
        updateMapWithInlineDatum :: Map DatumHash Datum -> [ChainIndexTxOut] -> Map DatumHash Datum
updateMapWithInlineDatum Map DatumHash Datum
witness [] = Map DatumHash Datum
witness
        updateMapWithInlineDatum Map DatumHash Datum
witness (ChainIndexTxOut{citoDatum :: ChainIndexTxOut -> OutputDatum
citoDatum=OutputDatum Datum
d} : [ChainIndexTxOut]
tl) =
          Map DatumHash Datum -> [ChainIndexTxOut] -> Map DatumHash Datum
updateMapWithInlineDatum (DatumHash -> Datum -> Map DatumHash Datum -> Map DatumHash Datum
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Datum -> DatumHash
datumHash Datum
d) Datum
d Map DatumHash Datum
witness) [ChainIndexTxOut]
tl
        updateMapWithInlineDatum Map DatumHash Datum
witness (ChainIndexTxOut
_ : [ChainIndexTxOut]
tl) = Map DatumHash Datum -> [ChainIndexTxOut] -> Map DatumHash Datum
updateMapWithInlineDatum Map DatumHash Datum
witness [ChainIndexTxOut]
tl

        getHashFromDatum :: OutputDatum -> Maybe DatumHash
        getHashFromDatum :: OutputDatum -> Maybe DatumHash
getHashFromDatum OutputDatum
NoOutputDatum        = Maybe DatumHash
forall a. Maybe a
Nothing
        getHashFromDatum (OutputDatumHash DatumHash
dh) = DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just DatumHash
dh
        getHashFromDatum (OutputDatum Datum
d)      = DatumHash -> Maybe DatumHash
forall a. a -> Maybe a
Just (Datum -> DatumHash
datumHash Datum
d)
        -- note that the datum hash for inline datum is implicitly added in datumRows


diagnostics ::
    ( Member (BeamEffect Sqlite) effs
    , Member (State ChainIndexState) effs
    ) => Eff effs Diagnostics
diagnostics :: Eff effs Diagnostics
diagnostics = do
    Maybe Integer
numTransactions <- SqlSelect Sqlite Integer -> Eff effs (Maybe Integer)
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs (Maybe a)
selectOne (SqlSelect Sqlite Integer -> Eff effs (Maybe Integer))
-> (Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope Integer)
    -> SqlSelect Sqlite Integer)
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> SqlSelect Sqlite Integer
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope Integer)
 -> Eff effs (Maybe Integer))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ (TxRowT (QExpr Sqlite (QNested QBaseScope))
 -> QAgg Sqlite (QNested QBaseScope) Integer)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TxRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext))
forall be a r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Aggregable be a, Projectible be r,
 Projectible be a, ContextRewritable a,
 ThreadRewritable
   (QNested s) (WithRewrittenContext a QValueContext)) =>
(r -> a)
-> Q be db (QNested s) r
-> Q be
     db
     s
     (WithRewrittenThread
        (QNested s) s (WithRewrittenContext a QValueContext))
aggregate_ (QAgg Sqlite (QNested QBaseScope) Integer
-> TxRowT (QExpr Sqlite (QNested QBaseScope))
-> QAgg Sqlite (QNested QBaseScope) Integer
forall a b. a -> b -> a
const QAgg Sqlite (QNested QBaseScope) Integer
forall be a s. (BeamSqlBackend be, Integral a) => QAgg be s a
countAll_) (DatabaseEntity Sqlite Db (TableEntity TxRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TxRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TxRowT)
forall (f :: * -> *). Db f -> f (TableEntity TxRowT)
txRows Db (DatabaseEntity Sqlite Db)
db))
    [TxId]
txIds <- SqlSelect Sqlite ByteString -> Eff effs [TxId]
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs [o]
queryList (SqlSelect Sqlite ByteString -> Eff effs [TxId])
-> (Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope ByteString)
    -> SqlSelect Sqlite ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Eff effs [TxId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> SqlSelect Sqlite ByteString
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope ByteString)
 -> Eff effs [TxId])
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Eff effs [TxId]
forall a b. (a -> b) -> a -> b
$ TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
forall (f :: * -> *). TxRowT f -> Columnar f ByteString
_txRowTxId (TxRowT (QGenExpr QValueContext Sqlite QBaseScope)
 -> QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (TxRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TxRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (TxRowT (QExpr Sqlite (QNested QBaseScope))))
forall s a be (db :: (* -> *) -> *).
(Projectible be a, ThreadRewritable (QNested s) a) =>
Integer
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
limit_ Integer
10 (DatabaseEntity Sqlite Db (TableEntity TxRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (TxRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity TxRowT)
forall (f :: * -> *). Db f -> f (TableEntity TxRowT)
txRows Db (DatabaseEntity Sqlite Db)
db))
    [ChainIndexTxOut]
unspentTxOuts <- SqlSelect Sqlite ByteString -> Eff effs [ChainIndexTxOut]
forall (effs :: [* -> *]) o.
(Member (BeamEffect Sqlite) effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs [o]
queryList (SqlSelect Sqlite ByteString -> Eff effs [ChainIndexTxOut])
-> (Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope ByteString)
    -> SqlSelect Sqlite ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Eff effs [ChainIndexTxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> SqlSelect Sqlite ByteString
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope ByteString)
 -> Eff effs [ChainIndexTxOut])
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Eff effs [ChainIndexTxOut]
forall a b. (a -> b) -> a -> b
$ UtxoRowT (QGenExpr QValueContext Sqlite QBaseScope)
-> QGenExpr QValueContext Sqlite QBaseScope ByteString
forall (f :: * -> *). UtxoRowT f -> Columnar f ByteString
_utxoRowTxOut (UtxoRowT (QGenExpr QValueContext Sqlite QBaseScope)
 -> QGenExpr QValueContext Sqlite QBaseScope ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (UtxoRowT (QGenExpr QValueContext Sqlite QBaseScope))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (UtxoRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (UtxoRowT (QExpr Sqlite (QNested QBaseScope))))
forall s a be (db :: (* -> *) -> *).
(Projectible be a, ThreadRewritable (QNested s) a) =>
Integer
-> Q be db (QNested s) a
-> Q be db s (WithRewrittenThread (QNested s) s a)
limit_ Integer
10 (DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (UtxoRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity UtxoRowT)
forall (f :: * -> *). Db f -> f (TableEntity UtxoRowT)
utxoOutRefRows Db (DatabaseEntity Sqlite Db)
db))
    Maybe Integer
numScripts <- SqlSelect Sqlite Integer -> Eff effs (Maybe Integer)
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs (Maybe a)
selectOne (SqlSelect Sqlite Integer -> Eff effs (Maybe Integer))
-> (Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope Integer)
    -> SqlSelect Sqlite Integer)
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> SqlSelect Sqlite Integer
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope Integer)
 -> Eff effs (Maybe Integer))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ (ScriptRowT (QExpr Sqlite (QNested QBaseScope))
 -> QAgg Sqlite (QNested QBaseScope) Integer)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (ScriptRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext))
forall be a r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Aggregable be a, Projectible be r,
 Projectible be a, ContextRewritable a,
 ThreadRewritable
   (QNested s) (WithRewrittenContext a QValueContext)) =>
(r -> a)
-> Q be db (QNested s) r
-> Q be
     db
     s
     (WithRewrittenThread
        (QNested s) s (WithRewrittenContext a QValueContext))
aggregate_ (QAgg Sqlite (QNested QBaseScope) Integer
-> ScriptRowT (QExpr Sqlite (QNested QBaseScope))
-> QAgg Sqlite (QNested QBaseScope) Integer
forall a b. a -> b -> a
const QAgg Sqlite (QNested QBaseScope) Integer
forall be a s. (BeamSqlBackend be, Integral a) => QAgg be s a
countAll_) (DatabaseEntity Sqlite Db (TableEntity ScriptRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (ScriptRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity ScriptRowT)
forall (f :: * -> *). Db f -> f (TableEntity ScriptRowT)
scriptRows Db (DatabaseEntity Sqlite Db)
db))
    Maybe Integer
numAddresses <- SqlSelect Sqlite Integer -> Eff effs (Maybe Integer)
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs (Maybe a)
selectOne (SqlSelect Sqlite Integer -> Eff effs (Maybe Integer))
-> (Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope Integer)
    -> SqlSelect Sqlite Integer)
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> SqlSelect Sqlite Integer
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope Integer)
 -> Eff effs (Maybe Integer))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString
 -> QAgg Sqlite (QNested QBaseScope) Integer)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext))
forall be a r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Aggregable be a, Projectible be r,
 Projectible be a, ContextRewritable a,
 ThreadRewritable
   (QNested s) (WithRewrittenContext a QValueContext)) =>
(r -> a)
-> Q be db (QNested s) r
-> Q be
     db
     s
     (WithRewrittenThread
        (QNested s) s (WithRewrittenContext a QValueContext))
aggregate_ (QAgg Sqlite (QNested QBaseScope) Integer
-> QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString
-> QAgg Sqlite (QNested QBaseScope) Integer
forall a b. a -> b -> a
const QAgg Sqlite (QNested QBaseScope) Integer
forall be a s. (BeamSqlBackend be, Integral a) => QAgg be s a
countAll_) (Q Sqlite
   Db
   (QNested QBaseScope)
   (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
 -> Q Sqlite
      Db
      QBaseScope
      (WithRewrittenThread
         (QNested QBaseScope)
         QBaseScope
         (WithRewrittenContext
            (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext)))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  Db
  (QNested QBaseScope)
  (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
forall be r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Projectible be r) =>
Q be db s r -> Q be db s r
nub_ (Q Sqlite
   Db
   (QNested QBaseScope)
   (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
 -> Q Sqlite
      Db
      (QNested QBaseScope)
      (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
forall a b. (a -> b) -> a -> b
$ AddressRowT (QExpr Sqlite (QNested QBaseScope))
-> QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowCred (AddressRowT (QExpr Sqlite (QNested QBaseScope))
 -> QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (AddressRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (AddressRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AddressRowT)
forall (f :: * -> *). Db f -> f (TableEntity AddressRowT)
addressRows Db (DatabaseEntity Sqlite Db)
db)
    Maybe Integer
numAssetClasses <- SqlSelect Sqlite Integer -> Eff effs (Maybe Integer)
forall dbt a (effs :: [* -> *]).
(FromBackendRow dbt a, Member (BeamEffect dbt) effs) =>
SqlSelect dbt a -> Eff effs (Maybe a)
selectOne (SqlSelect Sqlite Integer -> Eff effs (Maybe Integer))
-> (Q Sqlite
      Db
      QBaseScope
      (QGenExpr QValueContext Sqlite QBaseScope Integer)
    -> SqlSelect Sqlite Integer)
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Sqlite
  Db
  QBaseScope
  (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> SqlSelect Sqlite Integer
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q Sqlite
   Db
   QBaseScope
   (QGenExpr QValueContext Sqlite QBaseScope Integer)
 -> Eff effs (Maybe Integer))
-> Q Sqlite
     Db
     QBaseScope
     (QGenExpr QValueContext Sqlite QBaseScope Integer)
-> Eff effs (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString
 -> QAgg Sqlite (QNested QBaseScope) Integer)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext))
forall be a r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Aggregable be a, Projectible be r,
 Projectible be a, ContextRewritable a,
 ThreadRewritable
   (QNested s) (WithRewrittenContext a QValueContext)) =>
(r -> a)
-> Q be db (QNested s) r
-> Q be
     db
     s
     (WithRewrittenThread
        (QNested s) s (WithRewrittenContext a QValueContext))
aggregate_ (QAgg Sqlite (QNested QBaseScope) Integer
-> QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString
-> QAgg Sqlite (QNested QBaseScope) Integer
forall a b. a -> b -> a
const QAgg Sqlite (QNested QBaseScope) Integer
forall be a s. (BeamSqlBackend be, Integral a) => QAgg be s a
countAll_) (Q Sqlite
   Db
   (QNested QBaseScope)
   (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
 -> Q Sqlite
      Db
      QBaseScope
      (WithRewrittenThread
         (QNested QBaseScope)
         QBaseScope
         (WithRewrittenContext
            (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext)))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     QBaseScope
     (WithRewrittenThread
        (QNested QBaseScope)
        QBaseScope
        (WithRewrittenContext
           (QAgg Sqlite (QNested QBaseScope) Integer) QValueContext))
forall a b. (a -> b) -> a -> b
$ Q Sqlite
  Db
  (QNested QBaseScope)
  (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
forall be r (db :: (* -> *) -> *) s.
(BeamSqlBackend be, Projectible be r) =>
Q be db s r -> Q be db s r
nub_ (Q Sqlite
   Db
   (QNested QBaseScope)
   (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
 -> Q Sqlite
      Db
      (QNested QBaseScope)
      (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
forall a b. (a -> b) -> a -> b
$ AssetClassRowT (QExpr Sqlite (QNested QBaseScope))
-> QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString
forall (f :: * -> *). AssetClassRowT f -> Columnar f ByteString
_assetClassRowAssetClass (AssetClassRowT (QExpr Sqlite (QNested QBaseScope))
 -> QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (AssetClassRowT (QExpr Sqlite (QNested QBaseScope)))
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (QGenExpr QValueContext Sqlite (QNested QBaseScope) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
-> Q Sqlite
     Db
     (QNested QBaseScope)
     (AssetClassRowT (QExpr Sqlite (QNested QBaseScope)))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ (Db (DatabaseEntity Sqlite Db)
-> DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
forall (f :: * -> *). Db f -> f (TableEntity AssetClassRowT)
assetClassRows Db (DatabaseEntity Sqlite Db)
db)
    TxUtxoBalance Set TxOutRef
outputs Set TxOutRef
inputs <- UtxoState TxUtxoBalance -> TxUtxoBalance
forall a. UtxoState a -> a
UtxoState._usTxUtxoData (UtxoState TxUtxoBalance -> TxUtxoBalance)
-> (ChainIndexState -> UtxoState TxUtxoBalance)
-> ChainIndexState
-> TxUtxoBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexState -> UtxoState TxUtxoBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
UtxoState.utxoState (ChainIndexState -> TxUtxoBalance)
-> Eff effs ChainIndexState -> Eff effs TxUtxoBalance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (effs :: [* -> *]).
Member (State ChainIndexState) effs =>
Eff effs ChainIndexState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get @ChainIndexState

    Diagnostics -> Eff effs Diagnostics
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Diagnostics -> Eff effs Diagnostics)
-> Diagnostics -> Eff effs Diagnostics
forall a b. (a -> b) -> a -> b
$ Diagnostics :: Integer
-> Integer
-> Integer
-> Integer
-> Int
-> Int
-> [TxId]
-> [ChainIndexTxOut]
-> Diagnostics
Diagnostics
        { numTransactions :: Integer
numTransactions    = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) Maybe Integer
numTransactions
        , numScripts :: Integer
numScripts         = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) Maybe Integer
numScripts
        , numAddresses :: Integer
numAddresses       = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) Maybe Integer
numAddresses
        , numAssetClasses :: Integer
numAssetClasses    = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) Maybe Integer
numAssetClasses
        , 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
        , someTransactions :: [TxId]
someTransactions   = [TxId]
txIds
        , unspentTxOuts :: [ChainIndexTxOut]
unspentTxOuts = [ChainIndexTxOut]
unspentTxOuts
        }