{-# 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', 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 (BeamEffect (..), BeamableSqlite, combined, selectList, selectOne, selectPage)
import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logError, logWarn)
import Control.Monad.Freer.Extras.Pagination (Page (Page), 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.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
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_, guard_,
                      limit_, not_, nub_, select, val_)
import Database.Beam.Backend.SQL (BeamSqlBackendCanSerialize)
import Database.Beam.Query (HasSqlEqualityCheck, asc_, desc_, exists_, orderBy_, update, (&&.), (<-.), (<.), (==.),
                            (>.))
import Database.Beam.Schema.Tables (zipTables)
import Database.Beam.Sqlite (Sqlite)
import Ledger (Address (..), ChainIndexTxOut (..), Datum, DatumHash (..), TxOut (..), TxOutRef (..), fromTxOut)
import Ledger.Value (AssetClass (AssetClass), flattenValue)
import Plutus.ChainIndex.Api (IsUtxoResponse (IsUtxoResponse), 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.TxUtxoBalance qualified as TxUtxoBalance
import Plutus.ChainIndex.Types (ChainSyncBlock (..), Depth (..), Diagnostics (..), Point (..), Tip (..),
                                TxProcessOption (..), TxUtxoBalance (..), tipAsPoint)
import Plutus.ChainIndex.UtxoState (InsertUtxoSuccess (..), RollbackResult (..), UtxoIndex)
import Plutus.ChainIndex.UtxoState qualified as UtxoState
import Plutus.V1.Ledger.Ada qualified as Ada
import Plutus.V1.Ledger.Api (Credential)

type ChainIndexState = UtxoIndex TxUtxoBalance

getResumePoints :: Member BeamEffect 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 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 effs =>
DatumHash -> Eff effs (Maybe Datum)
getDatumFromHash DatumHash
dh
    ValidatorFromHash ValidatorHash
hash      -> ValidatorHash -> Eff effs (Maybe Validator)
forall (effs :: [* -> *]) i o.
(Member BeamEffect 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 MintingPolicy)
forall (effs :: [* -> *]) i o.
(Member BeamEffect 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 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 StakeValidator)
forall (effs :: [* -> *]) i o.
(Member BeamEffect effs, HasDbType i, DbType i ~ ByteString,
 HasDbType o, DbType o ~ ByteString) =>
i -> Eff effs (Maybe o)
getScriptFromHash StakeValidatorHash
hash
    UnspentTxOutFromRef TxOutRef
tor     -> TxOutRef -> Eff effs (Maybe ChainIndexTxOut)
forall (effs :: [* -> *]).
Member BeamEffect effs =>
TxOutRef -> Eff effs (Maybe ChainIndexTxOut)
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 effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs UtxosResponse
getUtxoSetAtAddress 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 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 effs,
 Member (LogMsg ChainIndexLog) effs) =>
PageQuery TxOutRef -> Credential -> Eff effs TxosResponse
getTxoSetAtAddress PageQuery TxOutRef
pageQuery Credential
cred
    ChainIndexQueryEffect x
GetTip -> Eff effs x
forall (effs :: [* -> *]). Member BeamEffect effs => Eff effs Tip
getTip

getTip :: Member BeamEffect 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 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 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

getScriptFromHash ::
    ( Member BeamEffect 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 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 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 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 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite a -> Eff effs (Maybe a)
selectOne

-- | Get the 'ChainIndexTxOut' for a 'TxOutRef'.
getUtxoutFromRef ::
  forall effs.
  ( Member BeamEffect effs
  )
  => TxOutRef
  -> Eff effs (Maybe ChainIndexTxOut)
getUtxoutFromRef :: TxOutRef -> Eff effs (Maybe ChainIndexTxOut)
getUtxoutFromRef = (Maybe TxOut -> Maybe ChainIndexTxOut)
-> Eff effs (Maybe TxOut) -> Eff effs (Maybe ChainIndexTxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>) (TxOut -> Maybe ChainIndexTxOut
fromTxOut (TxOut -> Maybe ChainIndexTxOut)
-> Maybe TxOut -> Maybe ChainIndexTxOut
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Eff effs (Maybe TxOut) -> Eff effs (Maybe ChainIndexTxOut))
-> (TxOutRef -> Eff effs (Maybe TxOut))
-> TxOutRef
-> Eff effs (Maybe ChainIndexTxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlSelect Sqlite ByteString -> Eff effs (Maybe TxOut)
forall (effs :: [* -> *]) o.
(Member BeamEffect effs, HasDbType o) =>
SqlSelect Sqlite (DbType o) -> Eff effs (Maybe o)
queryOne (SqlSelect Sqlite ByteString -> Eff effs (Maybe TxOut))
-> (TxOutRef -> SqlSelect Sqlite ByteString)
-> TxOutRef
-> Eff effs (Maybe TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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

getUtxoSetAtAddress
  :: forall effs.
    ( Member (State ChainIndexState) effs
    , Member BeamEffect 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 =
                (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
&&. Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> QExpr Sqlite (QNested (QNested QBaseScope)) 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 (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnspentOutputRowT (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_ (\UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
utxo -> AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowOutRef 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
==. UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). UnspentOutputRowT f -> Columnar f ByteString
_unspentOutputRowOutRef UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
utxo) (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)))
                      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
&&. 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
not_ (Q Sqlite
  Db
  (QNested (QNested QBaseScope))
  (UnmatchedInputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> QExpr Sqlite (QNested (QNested QBaseScope)) 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 (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnmatchedInputRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnmatchedInputRowT (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_ (\UnmatchedInputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
utxi -> AddressRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AddressRowT f -> Columnar f ByteString
_addressRowOutRef 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
==. UnmatchedInputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). UnmatchedInputRowT f -> Columnar f ByteString
_unmatchedInputRowOutRef UnmatchedInputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
utxi) (DatabaseEntity Sqlite Db (TableEntity UnmatchedInputRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (UnmatchedInputRowT (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 UnmatchedInputRowT)
forall (f :: * -> *). Db f -> f (TableEntity UnmatchedInputRowT)
unmatchedInputRows Db (DatabaseEntity Sqlite Db)
db))))
                      )
                  (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
outRefs <- PageQuery ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Eff effs (Page ByteString)
forall a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow Sqlite a, HasSqlValueSyntax SqliteValueSyntax a,
 Member BeamEffect effs) =>
PageQuery a
-> Q Sqlite
     db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (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)

getUtxoSetWithCurrency
  :: forall effs.
    ( Member (State ChainIndexState) effs
    , Member BeamEffect 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 =
                (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (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 AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> QExpr Sqlite (QNested (QNested QBaseScope)) ByteString
forall (f :: * -> *). AssetClassRowT f -> Columnar f ByteString
_assetClassRowOutRef
                  (Q Sqlite
   Db
   (QNested (QNested QBaseScope))
   (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
 -> Q Sqlite
      Db
      (QNested (QNested QBaseScope))
      (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
forall a b. (a -> b) -> a -> b
$ (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
 -> QExpr Sqlite (QNested (QNested QBaseScope)) Bool)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (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_ (\AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
row -> AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AssetClassRowT f -> Columnar f ByteString
_assetClassRowAssetClass AssetClassRowT (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 AssetClass
assetClass)
                  (Q Sqlite
   Db
   (QNested (QNested QBaseScope))
   (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
 -> Q Sqlite
      Db
      (QNested (QNested QBaseScope))
      (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall a b. (a -> b) -> a -> b
$ do
                    UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
utxo <- 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)
                    AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
a <- DatabaseEntity Sqlite Db (TableEntity AssetClassRowT)
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (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 AssetClassRowT)
forall (f :: * -> *). Db f -> f (TableEntity AssetClassRowT)
assetClassRows Db (DatabaseEntity Sqlite Db)
db)
                    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_ (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). AssetClassRowT f -> Columnar f ByteString
_assetClassRowOutRef AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
a 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
==. UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Columnar
     (QExpr Sqlite (QNested (QNested QBaseScope))) ByteString
forall (f :: * -> *). UnspentOutputRowT f -> Columnar f ByteString
_unspentOutputRowOutRef UnspentOutputRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
utxo)
                    AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssetClassRowT (QExpr Sqlite (QNested (QNested QBaseScope)))
a

          Page ByteString
outRefs <- PageQuery ByteString
-> Q Sqlite
     Db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (QNested (QNested QBaseScope)) ByteString)
-> Eff effs (Page ByteString)
forall a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow Sqlite a, HasSqlValueSyntax SqliteValueSyntax a,
 Member BeamEffect effs) =>
PageQuery a
-> Q Sqlite
     db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (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)

getTxoSetAtAddress
  :: forall effs.
    ( Member (State ChainIndexState) effs
    , Member BeamEffect 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 a (db :: (* -> *) -> *) (effs :: [* -> *]).
(FromBackendRow Sqlite a, HasSqlValueSyntax SqliteValueSyntax a,
 Member BeamEffect effs) =>
PageQuery a
-> Q Sqlite
     db
     (QNested (QNested QBaseScope))
     (QExpr Sqlite (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 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 ()
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 () -> Eff effs (BeamEffect ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamEffect () -> Eff effs (BeamEffect ()))
-> BeamEffect () -> Eff effs (BeamEffect ())
forall a b. (a -> b) -> a -> b
$ [BeamEffect ()] -> BeamEffect ()
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 () -> Eff effs (BeamEffect ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamEffect () -> Eff effs (BeamEffect ()))
-> BeamEffect () -> Eff effs (BeamEffect ())
forall a b. (a -> b) -> a -> b
$ Tip -> BeamEffect ()
reduceOldUtxoDb (Tip -> BeamEffect ()) -> Tip -> BeamEffect ()
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 ()] -> Eff effs ()
forall (effs :: [* -> *]).
Member BeamEffect effs =>
[BeamEffect ()] -> Eff effs ()
combined
        [ BeamEffect ()
reduceOldUtxoDbEffect
        , Db InsertRows -> BeamEffect ()
insertRows (Db InsertRows -> BeamEffect ()) -> Db InsertRows -> BeamEffect ()
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 ()
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 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 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 ()] -> Eff effs ()
forall (effs :: [* -> *]).
Member BeamEffect effs =>
[BeamEffect ()] -> Eff effs ()
combined [Point -> BeamEffect ()
rollbackUtxoDb (Point -> BeamEffect ()) -> Point -> BeamEffect ()
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 ()] -> Eff effs ()
forall (effs :: [* -> *]).
Member BeamEffect effs =>
[BeamEffect ()] -> Eff effs ()
combined [Point -> BeamEffect ()
rollbackUtxoDb Point
tip_]
        ChainIndexState
newState <- Eff effs ChainIndexState
forall (effs :: [* -> *]).
Member BeamEffect 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
        [BeamEffect ()] -> Eff effs ()
forall (effs :: [* -> *]).
Member BeamEffect effs =>
[BeamEffect ()] -> Eff effs ()
combined ([BeamEffect ()] -> Eff effs ()) -> [BeamEffect ()] -> Eff effs ()
forall a b. (a -> b) -> a -> b
$
            [ SqlDelete Sqlite DatumRowT -> BeamEffect ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite DatumRowT -> BeamEffect ())
-> SqlDelete Sqlite DatumRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite ScriptRowT -> BeamEffect ())
-> SqlDelete Sqlite ScriptRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite RedeemerRowT -> BeamEffect ())
-> SqlDelete Sqlite RedeemerRowT -> BeamEffect ()
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 UtxoRowT -> BeamEffect ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite UtxoRowT -> BeamEffect ())
-> SqlDelete Sqlite UtxoRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite AddressRowT -> BeamEffect ())
-> SqlDelete Sqlite AddressRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite AssetClassRowT -> BeamEffect ())
-> SqlDelete Sqlite AssetClassRowT -> BeamEffect ()
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)
            ]
        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 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 ()
insertUtxoDb :: [ChainIndexTx] -> [UtxoState TxUtxoBalance] -> BeamEffect ()
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
        txOuts :: [(TxOut, TxOutRef)]
txOuts = (ChainIndexTx -> [(TxOut, TxOutRef)])
-> [ChainIndexTx] -> [(TxOut, TxOutRef)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ChainIndexTx -> [(TxOut, TxOutRef)]
txOutsWithRef [ChainIndexTx]
txs
    in Db InsertRows -> BeamEffect ()
insertRows (Db InsertRows -> BeamEffect ()) -> Db InsertRows -> BeamEffect ()
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 :: (* -> *) -> *).
BeamableSqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [TipRow]
tr
        , unspentOutputRows :: InsertRows (TableEntity UnspentOutputRowT)
unspentOutputRows = [UnspentOutputRowT Identity]
-> InsertRows (TableEntity UnspentOutputRowT)
forall (t :: (* -> *) -> *).
BeamableSqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [UnspentOutputRowT Identity]
ur
        , unmatchedInputRows :: InsertRows (TableEntity UnmatchedInputRowT)
unmatchedInputRows = [UnmatchedInputRowT Identity]
-> InsertRows (TableEntity UnmatchedInputRowT)
forall (t :: (* -> *) -> *).
BeamableSqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows [UnmatchedInputRowT Identity]
umr
        , utxoOutRefRows :: InsertRows (TableEntity UtxoRowT)
utxoOutRefRows = [UtxoRowT Identity] -> InsertRows (TableEntity UtxoRowT)
forall (t :: (* -> *) -> *).
BeamableSqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows ([UtxoRowT Identity] -> InsertRows (TableEntity UtxoRowT))
-> [UtxoRowT Identity] -> InsertRows (TableEntity UtxoRowT)
forall a b. (a -> b) -> a -> b
$ (\(TxOut
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) (TxOut -> DbType TxOut
forall a. HasDbType a => a -> DbType a
toDbValue TxOut
txOut)) ((TxOut, TxOutRef) -> UtxoRowT Identity)
-> [(TxOut, TxOutRef)] -> [UtxoRowT Identity]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOut, TxOutRef)]
txOuts
        }

reduceOldUtxoDb :: Tip -> BeamEffect ()
reduceOldUtxoDb :: Tip -> BeamEffect ()
reduceOldUtxoDb Tip
TipAtGenesis = [BeamEffect ()] -> BeamEffect ()
Combined []
reduceOldUtxoDb (Tip (Slot -> DbType Slot
forall a. HasDbType a => a -> DbType a
toDbValue -> DbType Slot
slot) BlockId
_ BlockNumber
_) = [BeamEffect ()] -> BeamEffect ()
Combined
    -- Delete all the tips before 'slot'
    [ SqlDelete Sqlite TipRowT -> BeamEffect ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite TipRowT -> BeamEffect ())
-> SqlDelete Sqlite TipRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlUpdate Sqlite table -> BeamEffect ()
UpdateRows (SqlUpdate Sqlite UnspentOutputRowT -> BeamEffect ())
-> SqlUpdate Sqlite UnspentOutputRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlUpdate Sqlite table -> BeamEffect ()
UpdateRows (SqlUpdate Sqlite UnmatchedInputRowT -> BeamEffect ())
-> SqlUpdate Sqlite UnmatchedInputRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite UtxoRowT -> BeamEffect ())
-> SqlDelete Sqlite UtxoRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite UnspentOutputRowT -> BeamEffect ())
-> SqlDelete Sqlite UnspentOutputRowT -> BeamEffect ()
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 ()
rollbackUtxoDb :: Point -> BeamEffect ()
rollbackUtxoDb Point
PointAtGenesis = SqlDelete Sqlite TipRowT -> BeamEffect ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite TipRowT -> BeamEffect ())
-> SqlDelete Sqlite TipRowT -> BeamEffect ()
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 ()] -> BeamEffect ()
Combined
    [ SqlDelete Sqlite TipRowT -> BeamEffect ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite TipRowT -> BeamEffect ())
-> SqlDelete Sqlite TipRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite UtxoRowT -> BeamEffect ())
-> SqlDelete Sqlite UtxoRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite UnspentOutputRowT -> BeamEffect ())
-> SqlDelete Sqlite UnspentOutputRowT -> BeamEffect ()
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 ()
forall (table :: (* -> *) -> *).
Beamable table =>
SqlDelete Sqlite table -> BeamEffect ()
DeleteRows (SqlDelete Sqlite UnmatchedInputRowT -> BeamEffect ())
-> SqlDelete Sqlite UnmatchedInputRowT -> BeamEffect ()
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 effs => Eff effs ChainIndexState
restoreStateFromDb :: Eff effs ChainIndexState
restoreStateFromDb = do
    [UnspentOutputRowT Identity]
uo <- SqlSelect Sqlite (UnspentOutputRowT Identity)
-> Eff effs [UnspentOutputRowT Identity]
forall a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 :: BeamableSqlite 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 :: (* -> *) -> *).
BeamableSqlite 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 BeamableSqlite t => Monoid (InsertRows (TableEntity t)) where
    mempty :: InsertRows (TableEntity t)
mempty = [t Identity] -> InsertRows (TableEntity t)
forall (t :: (* -> *) -> *).
BeamableSqlite t =>
[t Identity] -> InsertRows (TableEntity t)
InsertRows []

insertRows :: Db InsertRows -> BeamEffect ()
insertRows :: Db InsertRows -> BeamEffect ()
insertRows = Const (BeamEffect ()) (Db Any) -> BeamEffect ()
forall a k (b :: k). Const a b -> a
getConst (Const (BeamEffect ()) (Db Any) -> BeamEffect ())
-> (Db InsertRows -> Const (BeamEffect ()) (Db Any))
-> Db InsertRows
-> BeamEffect ()
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 ()) (Any tbl))
-> Db (DatabaseEntity Sqlite Db)
-> Db InsertRows
-> Const (BeamEffect ()) (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 () -> Const (BeamEffect ()) (Any tbl)
forall k a (b :: k). a -> Const a b
Const (BeamEffect () -> Const (BeamEffect ()) (Any tbl))
-> BeamEffect () -> Const (BeamEffect ()) (Any tbl)
forall a b. (a -> b) -> a -> b
$ Int
-> DatabaseEntity Sqlite Db (TableEntity t)
-> [t Identity]
-> BeamEffect ()
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *).
BeamableSqlite table =>
Int
-> DatabaseEntity Sqlite db (TableEntity table)
-> [table Identity]
-> BeamEffect ()
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 = Lens' ChainIndexTx (Map DatumHash Datum)
-> InsertRows (TableEntity DatumRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableSqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity) =>
Lens' ChainIndexTx (Map k v) -> InsertRows (TableEntity t)
fromMap Lens' ChainIndexTx (Map DatumHash Datum)
citxData
    , scriptRows :: InsertRows (TableEntity ScriptRowT)
scriptRows = Lens' ChainIndexTx (Map ScriptHash Script)
-> InsertRows (TableEntity ScriptRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableSqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity) =>
Lens' ChainIndexTx (Map k v) -> InsertRows (TableEntity t)
fromMap Lens' ChainIndexTx (Map ScriptHash Script)
citxScripts
    , redeemerRows :: InsertRows (TableEntity RedeemerRowT)
redeemerRows = Lens' ChainIndexTx (Map RedeemerHash Redeemer)
-> InsertRows (TableEntity RedeemerRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableSqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity) =>
Lens' ChainIndexTx (Map k v) -> InsertRows (TableEntity t)
fromMap Lens' ChainIndexTx (Map RedeemerHash Redeemer)
citxRedeemers
    , addressRows :: InsertRows (TableEntity AddressRowT)
addressRows = (ChainIndexTx -> [(Credential, TxOutRef)])
-> InsertRows (TableEntity AddressRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableSqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity) =>
(ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
fromPairs (((TxOut, TxOutRef) -> (Credential, TxOutRef))
-> [(TxOut, TxOutRef)] -> [(Credential, TxOutRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOut, TxOutRef) -> (Credential, TxOutRef)
credential ([(TxOut, TxOutRef)] -> [(Credential, TxOutRef)])
-> (ChainIndexTx -> [(TxOut, TxOutRef)])
-> ChainIndexTx
-> [(Credential, TxOutRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(TxOut, TxOutRef)]
txOutsWithRef)
    , assetClassRows :: InsertRows (TableEntity AssetClassRowT)
assetClassRows = (ChainIndexTx -> [(AssetClass, TxOutRef)])
-> InsertRows (TableEntity AssetClassRowT)
forall (t :: (* -> *) -> *) k v.
(BeamableSqlite t, HasDbType (k, v), DbType (k, v) ~ t Identity) =>
(ChainIndexTx -> [(k, v)]) -> InsertRows (TableEntity t)
fromPairs (((TxOut, TxOutRef) -> [(AssetClass, TxOutRef)])
-> [(TxOut, TxOutRef)] -> [(AssetClass, TxOutRef)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TxOut, TxOutRef) -> [(AssetClass, TxOutRef)]
assetClasses ([(TxOut, TxOutRef)] -> [(AssetClass, TxOutRef)])
-> (ChainIndexTx -> [(TxOut, TxOutRef)])
-> ChainIndexTx
-> [(AssetClass, TxOutRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTx -> [(TxOut, TxOutRef)]
txOutsWithRef)
    }
    where
        credential :: (TxOut, TxOutRef) -> (Credential, TxOutRef)
        credential :: (TxOut, TxOutRef) -> (Credential, TxOutRef)
credential (TxOut{txOutAddress :: TxOut -> Address
txOutAddress=Address{Credential
addressCredential :: Address -> Credential
addressCredential :: Credential
addressCredential}}, TxOutRef
ref) =
          (Credential
addressCredential, TxOutRef
ref)
        assetClasses :: (TxOut, TxOutRef) -> [(AssetClass, TxOutRef)]
        assetClasses :: (TxOut, TxOutRef) -> [(AssetClass, TxOutRef)]
assetClasses (TxOut{Value
txOutValue :: TxOut -> Value
txOutValue :: Value
txOutValue}, 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
txOutValue
        fromMap
            :: (BeamableSqlite 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.
(BeamableSqlite 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
            :: (BeamableSqlite 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 :: (* -> *) -> *).
BeamableSqlite 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


diagnostics ::
    ( Member BeamEffect effs
    , Member (State ChainIndexState) effs
    ) => Eff effs Diagnostics
diagnostics :: Eff effs Diagnostics
diagnostics = do
    Maybe Integer
numScripts <- SqlSelect Sqlite Integer -> Eff effs (Maybe Integer)
forall a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 a (effs :: [* -> *]).
(FromBackendRow Sqlite a, Member BeamEffect effs) =>
SqlSelect Sqlite 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 -> Int -> Int -> Diagnostics
Diagnostics
        { 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
        }