{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE PackageImports     #-}
{-# LANGUAGE PatternSynonyms    #-}
{-# LANGUAGE QuasiQuotes        #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TemplateHaskell    #-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-
-- | Back-end support for Utxo Indexer

-- This module will create the SQL tables:
+ table: unspentTransactions
|---------+------+-------+-----------+-------+-------+------------------+--------------+------+-------------|
| Address | TxId | TxIdx | DatumHash | Datum | Value | InlineScriptHash | InlineScript | Slot | BlockNumber |
|---------+------+-------+-----------+-------+-------+------------------+--------------+------+-------------|

+ table: spent
  |------+------|
  | txId | txIx |
  |------+------|

-}
module Marconi.Index.Utxo
    (addressFilteredRows
    , Depth (..)
    , eventAtAddress
    , getUtxos
    , getUtxoEvents
    , open
    , query
    , queryPlusVolatile
    , Result
    , toRows
    , toAddr
    , utxoAddress
    , utxoEventSlotNo
    , utxoEventUtxos
    , utxoRowUtxo
    , Utxo (..)
    , UtxoEvent (..)
    , UtxoRow (..)
    , UtxoIndex
    , C.BlockNo (..)
    , C.SlotNo (..)
    ) where

import Codec.Serialise (Serialise (encode), deserialiseOrFail, serialise)
import Codec.Serialise.Class (Serialise (decode))
import Control.Concurrent.Async (concurrently_)
import Control.Exception (bracket_)
import Control.Lens (filtered, folded, traversed)
import Control.Lens.Combinators (imap)
import Control.Lens.Operators ((%~), (&), (^.), (^..))
import Control.Lens.TH (makeLenses)
import Control.Monad (unless, when)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Foldable (foldl')
import Data.List (union)
import Data.Maybe (fromJust)
import Data.Proxy (Proxy (Proxy))
import Data.Set (Set)
import Data.Set qualified as Set
import Database.SQLite.Simple (Only (Only), SQLData (SQLBlob, SQLInteger, SQLText))
import Database.SQLite.Simple qualified as SQL
import Database.SQLite.Simple.FromField (FromField (fromField), ResultError (ConversionFailed), returnError)
import Database.SQLite.Simple.FromRow (FromRow (fromRow), field)
import Database.SQLite.Simple.ToField (ToField (toField))
import Database.SQLite.Simple.ToRow (ToRow (toRow))
import GHC.Generics (Generic)
import System.Random.MWC (createSystemRandom, uniformR)
import Text.ParserCombinators.Parsec (parse)
import Text.RawString.QQ (r)

import Cardano.Api qualified as C
import "cardano-api" Cardano.Api.Shelley qualified as Shelley
import Cardano.Binary (fromCBOR, toCBOR)
import Marconi.Types (CurrentEra, TargetAddresses, TxOut, pattern CurrentEra)
import RewindableIndex.Index.VSqlite (SqliteIndex)
import RewindableIndex.Index.VSqlite qualified as Ix

data Utxo                       = Utxo
    { Utxo -> AddressAny
_utxoAddress          :: !C.AddressAny
    , Utxo -> TxId
_utxoTxId             :: !C.TxId
    , Utxo -> TxIx
_utxoTxIx             :: !C.TxIx
    , Utxo -> Maybe ScriptData
_utxoDatum            :: Maybe C.ScriptData
    , Utxo -> Maybe (Hash ScriptData)
_utxoDatumHash        :: Maybe (C.Hash C.ScriptData)
    , Utxo -> Value
_utxoValue            :: C.Value
    , Utxo -> Maybe ByteString
_utxoInlineScript     :: Maybe ByteString
    , Utxo -> Maybe ScriptHash
_utxoInlineScriptHash :: Maybe (C.ScriptHash)
    } deriving (Int -> Utxo -> ShowS
[Utxo] -> ShowS
Utxo -> String
(Int -> Utxo -> ShowS)
-> (Utxo -> String) -> ([Utxo] -> ShowS) -> Show Utxo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Utxo] -> ShowS
$cshowList :: [Utxo] -> ShowS
show :: Utxo -> String
$cshow :: Utxo -> String
showsPrec :: Int -> Utxo -> ShowS
$cshowsPrec :: Int -> Utxo -> ShowS
Show, (forall x. Utxo -> Rep Utxo x)
-> (forall x. Rep Utxo x -> Utxo) -> Generic Utxo
forall x. Rep Utxo x -> Utxo
forall x. Utxo -> Rep Utxo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Utxo x -> Utxo
$cfrom :: forall x. Utxo -> Rep Utxo x
Generic)

$(makeLenses ''Utxo)

instance Eq Utxo where
    Utxo
u1 == :: Utxo -> Utxo -> Bool
== Utxo
u2 = (Utxo -> TxId
_utxoTxId Utxo
u1) TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== (Utxo -> TxId
_utxoTxId Utxo
u2)

instance Ord Utxo where
    compare :: Utxo -> Utxo -> Ordering
compare Utxo
u1 Utxo
u2 = TxId -> TxId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Utxo -> TxId
_utxoTxId Utxo
u1) (Utxo -> TxId
_utxoTxId Utxo
u2)

data UtxoEvent          = UtxoEvent
    { UtxoEvent -> [Utxo]
_utxoEventUtxos   :: [Utxo]
    , UtxoEvent -> Set TxIn
_utxoEventInputs  :: !(Set C.TxIn)
    , UtxoEvent -> SlotNo
_utxoEventSlotNo  :: !C.SlotNo
    , UtxoEvent -> BlockNo
_utxoEventBlockNo :: !C.BlockNo
    } deriving (Int -> UtxoEvent -> ShowS
[UtxoEvent] -> ShowS
UtxoEvent -> String
(Int -> UtxoEvent -> ShowS)
-> (UtxoEvent -> String)
-> ([UtxoEvent] -> ShowS)
-> Show UtxoEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoEvent] -> ShowS
$cshowList :: [UtxoEvent] -> ShowS
show :: UtxoEvent -> String
$cshow :: UtxoEvent -> String
showsPrec :: Int -> UtxoEvent -> ShowS
$cshowsPrec :: Int -> UtxoEvent -> ShowS
Show, UtxoEvent -> UtxoEvent -> Bool
(UtxoEvent -> UtxoEvent -> Bool)
-> (UtxoEvent -> UtxoEvent -> Bool) -> Eq UtxoEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoEvent -> UtxoEvent -> Bool
$c/= :: UtxoEvent -> UtxoEvent -> Bool
== :: UtxoEvent -> UtxoEvent -> Bool
$c== :: UtxoEvent -> UtxoEvent -> Bool
Eq)

$(makeLenses ''UtxoEvent)

data UtxoRow            = UtxoRow
    { UtxoRow -> Utxo
_utxoRowUtxo    :: Utxo
    , UtxoRow -> SlotNo
_utxoRowSlotNo  :: !C.SlotNo
    , UtxoRow -> BlockNo
_utxoRowBlockNo :: !C.BlockNo
    } deriving (Int -> UtxoRow -> ShowS
[UtxoRow] -> ShowS
UtxoRow -> String
(Int -> UtxoRow -> ShowS)
-> (UtxoRow -> String) -> ([UtxoRow] -> ShowS) -> Show UtxoRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoRow] -> ShowS
$cshowList :: [UtxoRow] -> ShowS
show :: UtxoRow -> String
$cshow :: UtxoRow -> String
showsPrec :: Int -> UtxoRow -> ShowS
$cshowsPrec :: Int -> UtxoRow -> ShowS
Show, UtxoRow -> UtxoRow -> Bool
(UtxoRow -> UtxoRow -> Bool)
-> (UtxoRow -> UtxoRow -> Bool) -> Eq UtxoRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoRow -> UtxoRow -> Bool
$c/= :: UtxoRow -> UtxoRow -> Bool
== :: UtxoRow -> UtxoRow -> Bool
$c== :: UtxoRow -> UtxoRow -> Bool
Eq, Eq UtxoRow
Eq UtxoRow
-> (UtxoRow -> UtxoRow -> Ordering)
-> (UtxoRow -> UtxoRow -> Bool)
-> (UtxoRow -> UtxoRow -> Bool)
-> (UtxoRow -> UtxoRow -> Bool)
-> (UtxoRow -> UtxoRow -> Bool)
-> (UtxoRow -> UtxoRow -> UtxoRow)
-> (UtxoRow -> UtxoRow -> UtxoRow)
-> Ord UtxoRow
UtxoRow -> UtxoRow -> Bool
UtxoRow -> UtxoRow -> Ordering
UtxoRow -> UtxoRow -> UtxoRow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UtxoRow -> UtxoRow -> UtxoRow
$cmin :: UtxoRow -> UtxoRow -> UtxoRow
max :: UtxoRow -> UtxoRow -> UtxoRow
$cmax :: UtxoRow -> UtxoRow -> UtxoRow
>= :: UtxoRow -> UtxoRow -> Bool
$c>= :: UtxoRow -> UtxoRow -> Bool
> :: UtxoRow -> UtxoRow -> Bool
$c> :: UtxoRow -> UtxoRow -> Bool
<= :: UtxoRow -> UtxoRow -> Bool
$c<= :: UtxoRow -> UtxoRow -> Bool
< :: UtxoRow -> UtxoRow -> Bool
$c< :: UtxoRow -> UtxoRow -> Bool
compare :: UtxoRow -> UtxoRow -> Ordering
$ccompare :: UtxoRow -> UtxoRow -> Ordering
$cp1Ord :: Eq UtxoRow
Ord, (forall x. UtxoRow -> Rep UtxoRow x)
-> (forall x. Rep UtxoRow x -> UtxoRow) -> Generic UtxoRow
forall x. Rep UtxoRow x -> UtxoRow
forall x. UtxoRow -> Rep UtxoRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoRow x -> UtxoRow
$cfrom :: forall x. UtxoRow -> Rep UtxoRow x
Generic)

$(makeLenses ''UtxoRow)

type Result = Maybe [UtxoRow]

type Notification = ()

type UtxoIndex
    = SqliteIndex
      UtxoEvent
      Notification
      C.AddressAny
      Result

newtype Depth = Depth Int

instance FromRow C.TxIn where
    fromRow :: RowParser TxIn
fromRow = TxId -> TxIx -> TxIn
C.TxIn (TxId -> TxIx -> TxIn)
-> RowParser TxId -> RowParser (TxIx -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser TxId
forall a. FromField a => RowParser a
field RowParser (TxIx -> TxIn) -> RowParser TxIx -> RowParser TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser TxIx
forall a. FromField a => RowParser a
field
instance ToRow C.TxIn where
    toRow :: TxIn -> [SQLData]
toRow (C.TxIn TxId
txid TxIx
txix) = (TxId, TxIx) -> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (TxId
txid, TxIx
txix)
instance ToRow UtxoRow where
    toRow :: UtxoRow -> [SQLData]
toRow UtxoRow
u = (AddressAny, TxId, TxIx, Maybe ScriptData, Maybe (Hash ScriptData),
 Value, Maybe ByteString, Maybe ScriptHash, SlotNo, BlockNo)
-> [SQLData]
forall a. ToRow a => a -> [SQLData]
toRow (
        (UtxoRow
u UtxoRow -> Getting AddressAny UtxoRow AddressAny -> AddressAny
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const AddressAny Utxo)
-> UtxoRow -> Const AddressAny UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const AddressAny Utxo)
 -> UtxoRow -> Const AddressAny UtxoRow)
-> ((AddressAny -> Const AddressAny AddressAny)
    -> Utxo -> Const AddressAny Utxo)
-> Getting AddressAny UtxoRow AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressAny -> Const AddressAny AddressAny)
-> Utxo -> Const AddressAny Utxo
Lens' Utxo AddressAny
utxoAddress)
        , (UtxoRow
u UtxoRow -> Getting TxId UtxoRow TxId -> TxId
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const TxId Utxo) -> UtxoRow -> Const TxId UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const TxId Utxo) -> UtxoRow -> Const TxId UtxoRow)
-> ((TxId -> Const TxId TxId) -> Utxo -> Const TxId Utxo)
-> Getting TxId UtxoRow TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxId -> Const TxId TxId) -> Utxo -> Const TxId Utxo
Lens' Utxo TxId
utxoTxId)
        , (UtxoRow
u UtxoRow -> Getting TxIx UtxoRow TxIx -> TxIx
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const TxIx Utxo) -> UtxoRow -> Const TxIx UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const TxIx Utxo) -> UtxoRow -> Const TxIx UtxoRow)
-> ((TxIx -> Const TxIx TxIx) -> Utxo -> Const TxIx Utxo)
-> Getting TxIx UtxoRow TxIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIx -> Const TxIx TxIx) -> Utxo -> Const TxIx Utxo
Lens' Utxo TxIx
utxoTxIx)
        , (UtxoRow
u UtxoRow
-> Getting (Maybe ScriptData) UtxoRow (Maybe ScriptData)
-> Maybe ScriptData
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const (Maybe ScriptData) Utxo)
-> UtxoRow -> Const (Maybe ScriptData) UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const (Maybe ScriptData) Utxo)
 -> UtxoRow -> Const (Maybe ScriptData) UtxoRow)
-> ((Maybe ScriptData
     -> Const (Maybe ScriptData) (Maybe ScriptData))
    -> Utxo -> Const (Maybe ScriptData) Utxo)
-> Getting (Maybe ScriptData) UtxoRow (Maybe ScriptData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ScriptData -> Const (Maybe ScriptData) (Maybe ScriptData))
-> Utxo -> Const (Maybe ScriptData) Utxo
Lens' Utxo (Maybe ScriptData)
utxoDatum)
        , (UtxoRow
u UtxoRow
-> Getting
     (Maybe (Hash ScriptData)) UtxoRow (Maybe (Hash ScriptData))
-> Maybe (Hash ScriptData)
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const (Maybe (Hash ScriptData)) Utxo)
-> UtxoRow -> Const (Maybe (Hash ScriptData)) UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const (Maybe (Hash ScriptData)) Utxo)
 -> UtxoRow -> Const (Maybe (Hash ScriptData)) UtxoRow)
-> ((Maybe (Hash ScriptData)
     -> Const (Maybe (Hash ScriptData)) (Maybe (Hash ScriptData)))
    -> Utxo -> Const (Maybe (Hash ScriptData)) Utxo)
-> Getting
     (Maybe (Hash ScriptData)) UtxoRow (Maybe (Hash ScriptData))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Hash ScriptData)
 -> Const (Maybe (Hash ScriptData)) (Maybe (Hash ScriptData)))
-> Utxo -> Const (Maybe (Hash ScriptData)) Utxo
Lens' Utxo (Maybe (Hash ScriptData))
utxoDatumHash)
        , (UtxoRow
u UtxoRow -> Getting Value UtxoRow Value -> Value
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const Value Utxo) -> UtxoRow -> Const Value UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const Value Utxo) -> UtxoRow -> Const Value UtxoRow)
-> ((Value -> Const Value Value) -> Utxo -> Const Value Utxo)
-> Getting Value UtxoRow Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const Value Value) -> Utxo -> Const Value Utxo
Lens' Utxo Value
utxoValue)
        , (UtxoRow
u UtxoRow
-> Getting (Maybe ByteString) UtxoRow (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const (Maybe ByteString) Utxo)
-> UtxoRow -> Const (Maybe ByteString) UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const (Maybe ByteString) Utxo)
 -> UtxoRow -> Const (Maybe ByteString) UtxoRow)
-> ((Maybe ByteString
     -> Const (Maybe ByteString) (Maybe ByteString))
    -> Utxo -> Const (Maybe ByteString) Utxo)
-> Getting (Maybe ByteString) UtxoRow (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Const (Maybe ByteString) (Maybe ByteString))
-> Utxo -> Const (Maybe ByteString) Utxo
Lens' Utxo (Maybe ByteString)
utxoInlineScript)
        , (UtxoRow
u UtxoRow
-> Getting (Maybe ScriptHash) UtxoRow (Maybe ScriptHash)
-> Maybe ScriptHash
forall s a. s -> Getting a s a -> a
^. (Utxo -> Const (Maybe ScriptHash) Utxo)
-> UtxoRow -> Const (Maybe ScriptHash) UtxoRow
Lens' UtxoRow Utxo
utxoRowUtxo ((Utxo -> Const (Maybe ScriptHash) Utxo)
 -> UtxoRow -> Const (Maybe ScriptHash) UtxoRow)
-> ((Maybe ScriptHash
     -> Const (Maybe ScriptHash) (Maybe ScriptHash))
    -> Utxo -> Const (Maybe ScriptHash) Utxo)
-> Getting (Maybe ScriptHash) UtxoRow (Maybe ScriptHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ScriptHash -> Const (Maybe ScriptHash) (Maybe ScriptHash))
-> Utxo -> Const (Maybe ScriptHash) Utxo
Lens' Utxo (Maybe ScriptHash)
utxoInlineScriptHash)
        , (UtxoRow
u UtxoRow -> Getting SlotNo UtxoRow SlotNo -> SlotNo
forall s a. s -> Getting a s a -> a
^. Getting SlotNo UtxoRow SlotNo
Lens' UtxoRow SlotNo
utxoRowSlotNo)
        , (UtxoRow
u UtxoRow -> Getting BlockNo UtxoRow BlockNo -> BlockNo
forall s a. s -> Getting a s a -> a
^. Getting BlockNo UtxoRow BlockNo
Lens' UtxoRow BlockNo
utxoRowBlockNo))

instance FromRow UtxoRow where
    fromRow :: RowParser UtxoRow
fromRow
        = Utxo -> SlotNo -> BlockNo -> UtxoRow
UtxoRow
        (Utxo -> SlotNo -> BlockNo -> UtxoRow)
-> RowParser Utxo -> RowParser (SlotNo -> BlockNo -> UtxoRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AddressAny
-> TxId
-> TxIx
-> Maybe ScriptData
-> Maybe (Hash ScriptData)
-> Value
-> Maybe ByteString
-> Maybe ScriptHash
-> Utxo
Utxo
             (AddressAny
 -> TxId
 -> TxIx
 -> Maybe ScriptData
 -> Maybe (Hash ScriptData)
 -> Value
 -> Maybe ByteString
 -> Maybe ScriptHash
 -> Utxo)
-> RowParser AddressAny
-> RowParser
     (TxId
      -> TxIx
      -> Maybe ScriptData
      -> Maybe (Hash ScriptData)
      -> Value
      -> Maybe ByteString
      -> Maybe ScriptHash
      -> Utxo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser AddressAny
forall a. FromField a => RowParser a
field
             RowParser
  (TxId
   -> TxIx
   -> Maybe ScriptData
   -> Maybe (Hash ScriptData)
   -> Value
   -> Maybe ByteString
   -> Maybe ScriptHash
   -> Utxo)
-> RowParser TxId
-> RowParser
     (TxIx
      -> Maybe ScriptData
      -> Maybe (Hash ScriptData)
      -> Value
      -> Maybe ByteString
      -> Maybe ScriptHash
      -> Utxo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser TxId
forall a. FromField a => RowParser a
field
             RowParser
  (TxIx
   -> Maybe ScriptData
   -> Maybe (Hash ScriptData)
   -> Value
   -> Maybe ByteString
   -> Maybe ScriptHash
   -> Utxo)
-> RowParser TxIx
-> RowParser
     (Maybe ScriptData
      -> Maybe (Hash ScriptData)
      -> Value
      -> Maybe ByteString
      -> Maybe ScriptHash
      -> Utxo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser TxIx
forall a. FromField a => RowParser a
field
             RowParser
  (Maybe ScriptData
   -> Maybe (Hash ScriptData)
   -> Value
   -> Maybe ByteString
   -> Maybe ScriptHash
   -> Utxo)
-> RowParser (Maybe ScriptData)
-> RowParser
     (Maybe (Hash ScriptData)
      -> Value -> Maybe ByteString -> Maybe ScriptHash -> Utxo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe ScriptData)
forall a. FromField a => RowParser a
field
             RowParser
  (Maybe (Hash ScriptData)
   -> Value -> Maybe ByteString -> Maybe ScriptHash -> Utxo)
-> RowParser (Maybe (Hash ScriptData))
-> RowParser
     (Value -> Maybe ByteString -> Maybe ScriptHash -> Utxo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe (Hash ScriptData))
forall a. FromField a => RowParser a
field
             RowParser (Value -> Maybe ByteString -> Maybe ScriptHash -> Utxo)
-> RowParser Value
-> RowParser (Maybe ByteString -> Maybe ScriptHash -> Utxo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Value
forall a. FromField a => RowParser a
field
             RowParser (Maybe ByteString -> Maybe ScriptHash -> Utxo)
-> RowParser (Maybe ByteString)
-> RowParser (Maybe ScriptHash -> Utxo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe ByteString)
forall a. FromField a => RowParser a
field
             RowParser (Maybe ScriptHash -> Utxo)
-> RowParser (Maybe ScriptHash) -> RowParser Utxo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe ScriptHash)
forall a. FromField a => RowParser a
field )
        RowParser (SlotNo -> BlockNo -> UtxoRow)
-> RowParser SlotNo -> RowParser (BlockNo -> UtxoRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser SlotNo
forall a. FromField a => RowParser a
field
        RowParser (BlockNo -> UtxoRow)
-> RowParser BlockNo -> RowParser UtxoRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser BlockNo
forall a. FromField a => RowParser a
field

instance FromField C.AddressAny where
  fromField :: FieldParser AddressAny
fromField Field
f = FieldParser ByteString
forall a. FromField a => FieldParser a
fromField Field
f Ok ByteString -> (ByteString -> Ok AddressAny) -> Ok AddressAny
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      Ok AddressAny
-> (AddressAny -> Ok AddressAny)
-> Maybe AddressAny
-> Ok AddressAny
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String -> String -> String -> ResultError)
-> Field -> String -> Ok AddressAny
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"Cannot deserialise address.")
          AddressAny -> Ok AddressAny
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AddressAny -> Ok AddressAny)
-> (ByteString -> Maybe AddressAny) -> ByteString -> Ok AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType AddressAny -> ByteString -> Maybe AddressAny
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
C.deserialiseFromRawBytes AsType AddressAny
C.AsAddressAny

instance ToField C.AddressAny where
  toField :: AddressAny -> SQLData
toField = ByteString -> SQLData
SQLBlob (ByteString -> SQLData)
-> (AddressAny -> ByteString) -> AddressAny -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAny -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes

instance FromField C.TxId where
  fromField :: FieldParser TxId
fromField Field
f = FieldParser ByteString
forall a. FromField a => FieldParser a
fromField Field
f Ok ByteString -> (ByteString -> Ok TxId) -> Ok TxId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      Ok TxId -> (TxId -> Ok TxId) -> Maybe TxId -> Ok TxId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String -> String -> String -> ResultError)
-> Field -> String -> Ok TxId
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"Cannot deserialise TxId.")
          TxId -> Ok TxId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TxId -> Ok TxId)
-> (ByteString -> Maybe TxId) -> ByteString -> Ok TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType TxId -> ByteString -> Maybe TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
C.deserialiseFromRawBytes (Proxy TxId -> AsType TxId
forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType Proxy TxId
forall k (t :: k). Proxy t
Proxy)

instance ToField C.TxId where
  toField :: TxId -> SQLData
toField = ByteString -> SQLData
SQLBlob (ByteString -> SQLData) -> (TxId -> ByteString) -> TxId -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes

instance FromField C.TxIx where
  fromField :: FieldParser TxIx
fromField = (Word -> TxIx) -> Ok Word -> Ok TxIx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> TxIx
C.TxIx (Ok Word -> Ok TxIx) -> (Field -> Ok Word) -> FieldParser TxIx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> Ok Word
forall a. FromField a => FieldParser a
fromField

instance ToField C.TxIx where
  toField :: TxIx -> SQLData
toField (C.TxIx Word
i) = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> Int64 -> SQLData
forall a b. (a -> b) -> a -> b
$ Word -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i

instance FromField (C.Hash C.ScriptData) where
    fromField :: FieldParser (Hash ScriptData)
fromField Field
f = FieldParser ByteString
forall a. FromField a => FieldParser a
fromField Field
f Ok ByteString
-> (ByteString -> Ok (Hash ScriptData)) -> Ok (Hash ScriptData)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Ok (Hash ScriptData)
-> (Hash ScriptData -> Ok (Hash ScriptData))
-> Maybe (Hash ScriptData)
-> Ok (Hash ScriptData)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String -> String -> String -> ResultError)
-> Field -> String -> Ok (Hash ScriptData)
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"Cannot deserialise scriptDataHash.")
          Hash ScriptData -> Ok (Hash ScriptData)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Hash ScriptData) -> Ok (Hash ScriptData))
-> (ByteString -> Maybe (Hash ScriptData))
-> ByteString
-> Ok (Hash ScriptData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Hash ScriptData) -> ByteString -> Maybe (Hash ScriptData)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
C.deserialiseFromRawBytes (Proxy (Hash ScriptData) -> AsType (Hash ScriptData)
forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType Proxy (Hash ScriptData)
forall k (t :: k). Proxy t
Proxy)

instance ToField (C.Hash C.ScriptData) where
  toField :: Hash ScriptData -> SQLData
toField = ByteString -> SQLData
SQLBlob (ByteString -> SQLData)
-> (Hash ScriptData -> ByteString) -> Hash ScriptData -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ScriptData -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes

instance Serialise C.ScriptData where
  encode :: ScriptData -> Encoding
encode = ScriptData -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decode :: Decoder s ScriptData
decode = Decoder s ScriptData
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance FromField C.ScriptData where
  fromField :: FieldParser ScriptData
fromField Field
f = FieldParser ByteString
forall a. FromField a => FieldParser a
fromField Field
f Ok ByteString -> (ByteString -> Ok ScriptData) -> Ok ScriptData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (DeserialiseFailure -> Ok ScriptData)
-> (ScriptData -> Ok ScriptData)
-> Either DeserialiseFailure ScriptData
-> Ok ScriptData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Ok ScriptData -> DeserialiseFailure -> Ok ScriptData
forall a b. a -> b -> a
const (Ok ScriptData -> DeserialiseFailure -> Ok ScriptData)
-> Ok ScriptData -> DeserialiseFailure -> Ok ScriptData
forall a b. (a -> b) -> a -> b
$ (String -> String -> String -> ResultError)
-> Field -> String -> Ok ScriptData
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"Cannot deserialise scriptdata.")
    ScriptData -> Ok ScriptData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DeserialiseFailure ScriptData -> Ok ScriptData)
-> (ByteString -> Either DeserialiseFailure ScriptData)
-> ByteString
-> Ok ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DeserialiseFailure ScriptData
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail

instance ToField C.ScriptData where
  toField :: ScriptData -> SQLData
toField = ByteString -> SQLData
SQLBlob (ByteString -> SQLData)
-> (ScriptData -> ByteString) -> ScriptData -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (ScriptData -> ByteString) -> ScriptData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptData -> ByteString
forall a. Serialise a => a -> ByteString
serialise

instance ToField C.Value where
    toField :: Value -> SQLData
toField  = Text -> SQLData
SQLText (Text -> SQLData) -> (Value -> Text) -> Value -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
C.renderValue

instance FromField C.Value where
    fromField :: FieldParser Value
fromField Field
f = FieldParser String
forall a. FromField a => FieldParser a
fromField Field
f Ok String -> (String -> Ok Value) -> Ok Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        (ParseError -> Ok Value)
-> (Value -> Ok Value) -> Either ParseError Value -> Ok Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Ok Value -> ParseError -> Ok Value
forall a b. a -> b -> a
const (Ok Value -> ParseError -> Ok Value)
-> Ok Value -> ParseError -> Ok Value
forall a b. (a -> b) -> a -> b
$ (String -> String -> String -> ResultError)
-> Field -> String -> Ok Value
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"Cannot deserialise value.") Value -> Ok Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either ParseError Value -> Ok Value)
-> (String -> Either ParseError Value) -> String -> Ok Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsec String () Value
-> String -> String -> Either ParseError Value
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Value
C.parseValue String
"")

instance ToField C.ScriptHash where
    toField :: ScriptHash -> SQLData
toField = ByteString -> SQLData
SQLBlob (ByteString -> SQLData)
-> (ScriptHash -> ByteString) -> ScriptHash -> SQLData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
C.serialiseToRawBytes

instance FromField C.ScriptHash where
    fromField :: FieldParser ScriptHash
fromField Field
f = FieldParser ByteString
forall a. FromField a => FieldParser a
fromField Field
f Ok ByteString -> (ByteString -> Ok ScriptHash) -> Ok ScriptHash
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Ok ScriptHash
-> (ScriptHash -> Ok ScriptHash)
-> Maybe ScriptHash
-> Ok ScriptHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((String -> String -> String -> ResultError)
-> Field -> String -> Ok ScriptHash
forall a err.
(Typeable a, Exception err) =>
(String -> String -> String -> err) -> Field -> String -> Ok a
returnError String -> String -> String -> ResultError
ConversionFailed Field
f String
"Cannot deserialise scriptDataHash.")
          ScriptHash -> Ok ScriptHash
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ScriptHash -> Ok ScriptHash)
-> (ByteString -> Maybe ScriptHash) -> ByteString -> Ok ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType ScriptHash -> ByteString -> Maybe ScriptHash
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
C.deserialiseFromRawBytes (Proxy ScriptHash -> AsType ScriptHash
forall t. HasTypeProxy t => Proxy t -> AsType t
C.proxyToAsType Proxy ScriptHash
forall k (t :: k). Proxy t
Proxy)


instance FromField C.SlotNo where
  fromField :: FieldParser SlotNo
fromField Field
f = Word64 -> SlotNo
C.SlotNo (Word64 -> SlotNo) -> Ok Word64 -> Ok SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Word64
forall a. FromField a => FieldParser a
fromField Field
f

instance ToField C.SlotNo where
  toField :: SlotNo -> SQLData
toField (C.SlotNo Word64
s) = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> Int64 -> SQLData
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s

instance FromField C.BlockNo where
  fromField :: FieldParser BlockNo
fromField Field
f = Word64 -> BlockNo
C.BlockNo (Word64 -> BlockNo) -> Ok Word64 -> Ok BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldParser Word64
forall a. FromField a => FieldParser a
fromField Field
f

instance ToField C.BlockNo where
  toField :: BlockNo -> SQLData
toField (C.BlockNo Word64
s) = Int64 -> SQLData
SQLInteger (Int64 -> SQLData) -> Int64 -> SQLData
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
s

open
  :: FilePath  -- ^ sqlite file path
  -> Depth
  -> IO UtxoIndex
open :: String -> Depth -> IO UtxoIndex
open String
dbPath (Depth Int
k) = do
  -- The second parameter ((k + 1) * 2) specifies the amount of events that are buffered.
  -- The larger the number, the more RAM the indexer uses. However, we get improved SQL
  -- queries due to batching more events together.
  UtxoIndex
ix <- Maybe UtxoIndex -> UtxoIndex
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UtxoIndex -> UtxoIndex)
-> IO (Maybe UtxoIndex) -> IO UtxoIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UtxoIndex -> AddressAny -> [UtxoEvent] -> IO Result)
-> (UtxoIndex -> IO ())
-> (UtxoIndex -> UtxoEvent -> IO [()])
-> Int
-> Int
-> String
-> IO (Maybe UtxoIndex)
forall e n q r.
(BoxedIndex e n q r -> q -> [e] -> IO r)
-> (BoxedIndex e n q r -> IO ())
-> (BoxedIndex e n q r -> e -> IO [n])
-> Int
-> Int
-> String
-> IO (Maybe (BoxedIndex e n q r))
Ix.newBoxed UtxoIndex -> AddressAny -> [UtxoEvent] -> IO Result
query UtxoIndex -> IO ()
store UtxoIndex -> UtxoEvent -> IO [()]
onInsert Int
k ((Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) String
dbPath
  let conn :: Connection
conn = UtxoIndex
ix UtxoIndex -> Getting Connection UtxoIndex Connection -> Connection
forall s a. s -> Getting a s a -> a
^. Getting Connection UtxoIndex Connection
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) h
Ix.handle
  Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"DROP TABLE IF EXISTS unspent_transactions"
  Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"DROP TABLE IF EXISTS spent"
  Connection -> Query -> IO ()
SQL.execute_ Connection
conn [r|CREATE TABLE IF NOT EXISTS unspent_transactions
                            (address TEXT NOT NULL
                            ,txId TEXT NOT NULL
                            , txIx INT NOT NULL
                            , datum BLOB
                            , datumHash BLOB
                            , value TEXT
                            , inLineScript BLOB
                            , inLineScriptHash BLOB
                            , slotNo INT
                            , blockNo INT)|]
  Connection -> Query -> IO ()
SQL.execute_ Connection
conn [r|CREATE TABLE IF NOT EXISTS spent
                            (txId TEXT NOT NULL
                            , txIx INT NOT NULL)|]
  Connection -> Query -> IO ()
SQL.execute_ Connection
conn [r|CREATE INDEX IF NOT EXISTS
                      unspent_transaction_address
                      ON unspent_transactions (address)|]
  Connection -> Query -> IO ()
SQL.execute_ Connection
conn [r|CREATE UNIQUE INDEX IF NOT EXISTS
                      unspent_transaction_txid ON
                      unspent_transactions (txId)|]
  UtxoIndex -> IO UtxoIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure UtxoIndex
ix

eventAtAddress :: C.AddressAny -> UtxoEvent -> [UtxoEvent]
eventAtAddress :: AddressAny -> UtxoEvent -> [UtxoEvent]
eventAtAddress AddressAny
addr UtxoEvent
event =
    let
        utxosAtAddress :: [Utxo]
        utxosAtAddress :: [Utxo]
utxosAtAddress = UtxoEvent
event UtxoEvent -> Getting [Utxo] UtxoEvent [Utxo] -> [Utxo]
forall s a. s -> Getting a s a -> a
^. Getting [Utxo] UtxoEvent [Utxo]
Lens' UtxoEvent [Utxo]
utxoEventUtxos [Utxo] -> Getting (Endo [Utxo]) [Utxo] Utxo -> [Utxo]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Utxo]) [Utxo] Utxo
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded Getting (Endo [Utxo]) [Utxo] Utxo
-> ((Utxo -> Const (Endo [Utxo]) Utxo)
    -> Utxo -> Const (Endo [Utxo]) Utxo)
-> Getting (Endo [Utxo]) [Utxo] Utxo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Utxo -> Bool)
-> (Utxo -> Const (Endo [Utxo]) Utxo)
-> Utxo
-> Const (Endo [Utxo]) Utxo
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\Utxo
u -> (Utxo
u Utxo
-> ((AddressAny -> Const AddressAny AddressAny)
    -> Utxo -> Const AddressAny Utxo)
-> AddressAny
forall s a. s -> Getting a s a -> a
^. (AddressAny -> Const AddressAny AddressAny)
-> Utxo -> Const AddressAny Utxo
Lens' Utxo AddressAny
utxoAddress ) AddressAny -> AddressAny -> Bool
forall a. Eq a => a -> a -> Bool
== AddressAny
addr)
    in
        if [Utxo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Utxo]
utxosAtAddress  then []
        else [UtxoEvent
event { _utxoEventUtxos :: [Utxo]
_utxoEventUtxos = [Utxo]
utxosAtAddress }]

findByAddress :: C.AddressAny -> [UtxoEvent] -> [UtxoEvent]
findByAddress :: AddressAny -> [UtxoEvent] -> [UtxoEvent]
findByAddress AddressAny
addr = (UtxoEvent -> [UtxoEvent]) -> [UtxoEvent] -> [UtxoEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (AddressAny -> UtxoEvent -> [UtxoEvent]
eventAtAddress AddressAny
addr)

-- | remove spent transactions
rmSpentUtxos :: UtxoEvent -> UtxoEvent
rmSpentUtxos :: UtxoEvent -> UtxoEvent
rmSpentUtxos UtxoEvent
event =
    UtxoEvent
event UtxoEvent -> (UtxoEvent -> UtxoEvent) -> UtxoEvent
forall a b. a -> (a -> b) -> b
& ([Utxo] -> Identity [Utxo]) -> UtxoEvent -> Identity UtxoEvent
Lens' UtxoEvent [Utxo]
utxoEventUtxos (([Utxo] -> Identity [Utxo]) -> UtxoEvent -> Identity UtxoEvent)
-> ([Utxo] -> [Utxo]) -> UtxoEvent -> UtxoEvent
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Set TxIn -> [Utxo] -> [Utxo]
f (UtxoEvent
event UtxoEvent -> Getting (Set TxIn) UtxoEvent (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) UtxoEvent (Set TxIn)
Lens' UtxoEvent (Set TxIn)
utxoEventInputs) )
    where
        f :: (Set C.TxIn) -> [Utxo] -> [Utxo]
        f :: Set TxIn -> [Utxo] -> [Utxo]
f Set TxIn
txIns [Utxo]
utxos = (Utxo -> Bool) -> [Utxo] -> [Utxo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Utxo -> Bool) -> Utxo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TxIn -> Utxo -> Bool
isUtxoSpent Set TxIn
txIns) [Utxo]
utxos
        isUtxoSpent :: (Set C.TxIn) -> Utxo -> Bool
        isUtxoSpent :: Set TxIn -> Utxo -> Bool
isUtxoSpent Set TxIn
txIns Utxo
u = ( TxId -> TxIx -> TxIn
C.TxIn (Utxo
u Utxo
-> ((TxId -> Const TxId TxId) -> Utxo -> Const TxId Utxo) -> TxId
forall s a. s -> Getting a s a -> a
^. (TxId -> Const TxId TxId) -> Utxo -> Const TxId Utxo
Lens' Utxo TxId
utxoTxId)(Utxo
u Utxo
-> ((TxIx -> Const TxIx TxIx) -> Utxo -> Const TxIx Utxo) -> TxIx
forall s a. s -> Getting a s a -> a
^. (TxIx -> Const TxIx TxIx) -> Utxo -> Const TxIx Utxo
Lens' Utxo TxIx
utxoTxIx)) TxIn -> Set TxIn -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TxIn
txIns

-- | convert utoEvents to utxoRows
toRows :: UtxoEvent -> [UtxoRow]
toRows :: UtxoEvent -> [UtxoRow]
toRows UtxoEvent
event =  UtxoEvent
event UtxoEvent -> Getting [Utxo] UtxoEvent [Utxo] -> [Utxo]
forall s a. s -> Getting a s a -> a
^. Getting [Utxo] UtxoEvent [Utxo]
Lens' UtxoEvent [Utxo]
utxoEventUtxos [Utxo] -> ([Utxo] -> [UtxoRow]) -> [UtxoRow]
forall a b. a -> (a -> b) -> b
& (Utxo -> Identity UtxoRow) -> [Utxo] -> Identity [UtxoRow]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((Utxo -> Identity UtxoRow) -> [Utxo] -> Identity [UtxoRow])
-> (Utxo -> UtxoRow) -> [Utxo] -> [UtxoRow]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Utxo -> UtxoRow
f
    where
        f :: Utxo -> UtxoRow
        f :: Utxo -> UtxoRow
f  Utxo
u = Utxo -> SlotNo -> BlockNo -> UtxoRow
UtxoRow Utxo
u (UtxoEvent
event UtxoEvent -> Getting SlotNo UtxoEvent SlotNo -> SlotNo
forall s a. s -> Getting a s a -> a
^. Getting SlotNo UtxoEvent SlotNo
Lens' UtxoEvent SlotNo
utxoEventSlotNo ) (UtxoEvent
event UtxoEvent -> Getting BlockNo UtxoEvent BlockNo -> BlockNo
forall s a. s -> Getting a s a -> a
^. Getting BlockNo UtxoEvent BlockNo
Lens' UtxoEvent BlockNo
utxoEventBlockNo)

-- | only store rows in the address list.
addressFilteredRows :: C.AddressAny -> [UtxoEvent] -> [UtxoRow]
addressFilteredRows :: AddressAny -> [UtxoEvent] -> [UtxoRow]
addressFilteredRows AddressAny
addr = ((UtxoEvent -> [UtxoRow]) -> [UtxoEvent] -> [UtxoRow]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UtxoEvent -> [UtxoRow]
toRows ) ([UtxoEvent] -> [UtxoRow])
-> ([UtxoEvent] -> [UtxoEvent]) -> [UtxoEvent] -> [UtxoRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAny -> [UtxoEvent] -> [UtxoEvent]
findByAddress AddressAny
addr

-- | Query the data stored in the indexer
-- Quries SQL + buffered data, where buffered data is the data that will be batched to SQL
query
  :: UtxoIndex                  -- ^ in-memory indexer
  -> C.AddressAny               -- ^ Address to filter for
  -> [UtxoEvent]                -- ^ volatile events that may be rollbacked
  -> IO Result                  -- ^ search results
query :: UtxoIndex -> AddressAny -> [UtxoEvent] -> IO Result
query UtxoIndex
ix AddressAny
addr [UtxoEvent]
volatiles = do
  [UtxoRow]
diskStored <-
      Connection -> Query -> Only AddressAny -> IO [UtxoRow]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
SQL.query
        (UtxoIndex
ix UtxoIndex -> Getting Connection UtxoIndex Connection -> Connection
forall s a. s -> Getting a s a -> a
^. Getting Connection UtxoIndex Connection
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) h
Ix.handle)
        [r|SELECT u.address
            , u.txId
            , u.txIx
            , u.datum
            , u.datumHash
            , u.value
            , u.inLineScriptHash
            , u.inLineScriptHash
            , u.slotNo, u.blockNo
       FROM unspent_transactions u
       LEFT JOIN spent s ON u.txId = s.txId
            AND u.txIx = s.txIx
       WHERE u.address = ?|]
       (AddressAny -> Only AddressAny
forall a. a -> Only a
Only AddressAny
addr) :: IO[UtxoRow]
  [UtxoEvent]
buffered <- Storage Vector IO UtxoEvent -> IO [UtxoEvent]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Storage v m e -> m [e]
Ix.getBuffer (Storage Vector IO UtxoEvent -> IO [UtxoEvent])
-> Storage Vector IO UtxoEvent -> IO [UtxoEvent]
forall a b. (a -> b) -> a -> b
$ UtxoIndex
ix UtxoIndex
-> Getting
     (Storage Vector IO UtxoEvent)
     UtxoIndex
     (Storage Vector IO UtxoEvent)
-> Storage Vector IO UtxoEvent
forall s a. s -> Getting a s a -> a
^. Getting
  (Storage Vector IO UtxoEvent)
  UtxoIndex
  (Storage Vector IO UtxoEvent)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
Ix.storage :: IO [UtxoEvent]
  let events :: [UtxoEvent]
events = [UtxoEvent]
volatiles [UtxoEvent] -> [UtxoEvent] -> [UtxoEvent]
forall a. [a] -> [a] -> [a]
++ [UtxoEvent]
buffered
  Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result)
-> ([UtxoRow] -> Result) -> [UtxoRow] -> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UtxoRow] -> Result
forall a. a -> Maybe a
Just ([UtxoRow] -> IO Result) -> [UtxoRow] -> IO Result
forall a b. (a -> b) -> a -> b
$
      ( (UtxoEvent -> [UtxoRow]) -> [UtxoEvent] -> [UtxoRow]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UtxoEvent -> [UtxoRow]
toRows ([UtxoEvent] -> [UtxoRow])
-> ([UtxoEvent] -> [UtxoEvent]) -> [UtxoEvent] -> [UtxoRow]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoEvent -> UtxoEvent) -> [UtxoEvent] -> [UtxoEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UtxoEvent -> UtxoEvent
rmSpentUtxos ([UtxoEvent] -> [UtxoEvent])
-> ([UtxoEvent] -> [UtxoEvent]) -> [UtxoEvent] -> [UtxoEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AddressAny -> [UtxoEvent] -> [UtxoEvent]
findByAddress AddressAny
addr) ([UtxoEvent] -> [UtxoRow]) -> [UtxoEvent] -> [UtxoRow]
forall a b. (a -> b) -> a -> b
$ [UtxoEvent]
events)
      [UtxoRow] -> [UtxoRow] -> [UtxoRow]
forall a. Eq a => [a] -> [a] -> [a]
`union`
      [UtxoRow]
diskStored

-- | Query the data stored in the indexer as a whole from:
    -- + volatile  : in-memory, datat that may rollback
    -- + diskStore : on-disk
    -- + buffered  : in-memeoy, data that will flush to storage
queryPlusVolatile
  :: UtxoIndex                  -- ^ in-memory indexer
  -> C.AddressAny               -- ^ Address to filter for
  -> IO Result                  -- ^ search results
queryPlusVolatile :: UtxoIndex -> AddressAny -> IO Result
queryPlusVolatile UtxoIndex
ix AddressAny
addr =
  Storage Vector IO UtxoEvent -> IO [UtxoEvent]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Storage v m e -> m [e]
Ix.getEvents (UtxoIndex
ix UtxoIndex
-> Getting
     (Storage Vector IO UtxoEvent)
     UtxoIndex
     (Storage Vector IO UtxoEvent)
-> Storage Vector IO UtxoEvent
forall s a. s -> Getting a s a -> a
^. Getting
  (Storage Vector IO UtxoEvent)
  UtxoIndex
  (Storage Vector IO UtxoEvent)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
Ix.storage)  IO [UtxoEvent] -> ([UtxoEvent] -> IO Result) -> IO Result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UtxoIndex -> AddressAny -> [UtxoEvent] -> IO Result
query UtxoIndex
ix AddressAny
addr

onInsert :: UtxoIndex -> UtxoEvent -> IO [Notification]
onInsert :: UtxoIndex -> UtxoEvent -> IO [()]
onInsert  UtxoIndex
_ UtxoEvent
_ =  [()] -> IO [()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

store :: UtxoIndex -> IO ()
store :: UtxoIndex -> IO ()
store UtxoIndex
ix = do
  [UtxoEvent]
buffer <- Storage Vector IO UtxoEvent -> IO [UtxoEvent]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Storage v m e -> m [e]
Ix.getBuffer (Storage Vector IO UtxoEvent -> IO [UtxoEvent])
-> Storage Vector IO UtxoEvent -> IO [UtxoEvent]
forall a b. (a -> b) -> a -> b
$ UtxoIndex
ix UtxoIndex
-> Getting
     (Storage Vector IO UtxoEvent)
     UtxoIndex
     (Storage Vector IO UtxoEvent)
-> Storage Vector IO UtxoEvent
forall s a. s -> Getting a s a -> a
^. Getting
  (Storage Vector IO UtxoEvent)
  UtxoIndex
  (Storage Vector IO UtxoEvent)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
Ix.storage
  let rows :: [UtxoRow]
rows =  ((UtxoEvent -> [UtxoRow]) -> [UtxoEvent] -> [UtxoRow]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UtxoEvent -> [UtxoRow]
toRows) ([UtxoEvent] -> [UtxoRow]) -> [UtxoEvent] -> [UtxoRow]
forall a b. (a -> b) -> a -> b
$  [UtxoEvent]
buffer
      spent :: [TxIn]
spent = (UtxoEvent -> [TxIn]) -> [UtxoEvent] -> [TxIn]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (Set TxIn -> [TxIn])
-> (UtxoEvent -> Set TxIn) -> UtxoEvent -> [TxIn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoEvent -> Set TxIn
_utxoEventInputs) [UtxoEvent]
buffer
      conn :: Connection
conn = UtxoIndex
ix UtxoIndex -> Getting Connection UtxoIndex Connection -> Connection
forall s a. s -> Getting a s a -> a
^. Getting Connection UtxoIndex Connection
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) h
Ix.handle
  IO () -> IO () -> IO () -> IO ()
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
      (Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"BEGIN")
      (Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"COMMIT")
      ( IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
concurrently_
            (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([UtxoRow] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UtxoRow]
rows)
                (Connection -> Query -> [UtxoRow] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
SQL.executeMany Connection
conn
                Query
"INSERT OR REPLACE INTO unspent_transactions (address, txId, txIx, datum, datumHash, value, inlineScript, inlineScriptHash, slotNo, blockNo) VALUES (?,?,?,?,?,?,?,?,?,?)"
                [UtxoRow]
rows))
            (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxIn]
spent)
                (Connection -> Query -> [TxIn] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
SQL.executeMany Connection
conn
                Query
"INSERT OR REPLACE INTO spent (txId, txIx) VALUES (?, ?)"
                [TxIn]
spent))
      )
  -- We want to perform vacuum about once every 100 * buffer ((k + 1) * 2)
  Int
rndCheck <- IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, Int) -> GenIO -> IO Int
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (Int
1 :: Int, Int
100)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rndCheck Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
42) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"DELETE FROM unspent_transactions WHERE unspent_transactions.rowid IN (SELECT unspent_transactions.rowid FROM unspent_transactions LEFT JOIN spent on unspent_transactions.txId = spent.txId AND unspent_transactions.txIx = spent.txIx WHERE spent.txId IS NOT NULL)"
    Connection -> Query -> IO ()
SQL.execute_ Connection
conn Query
"VACUUM"

-- convert to AddressAny from address in any valid cardano era
toAddr :: C.AddressInEra CurrentEra -> C.AddressAny
toAddr :: AddressInEra CurrentEra -> AddressAny
toAddr (C.AddressInEra AddressTypeInEra addrtype CurrentEra
C.ByronAddressInAnyEra Address addrtype
addr)    = Address ByronAddr -> AddressAny
C.AddressByron Address addrtype
Address ByronAddr
addr
toAddr (C.AddressInEra (C.ShelleyAddressInEra ShelleyBasedEra CurrentEra
_) Address addrtype
addr) = Address ShelleyAddr -> AddressAny
C.AddressShelley Address addrtype
Address ShelleyAddr
addr

-- UtxoIndexer
getUtxos
  :: (C.IsCardanoEra era)
  => Maybe TargetAddresses
  -> C.Tx era
  -> [Utxo]
getUtxos :: Maybe TargetAddresses -> Tx era -> [Utxo]
getUtxos Maybe TargetAddresses
maybeTargetAddresses (C.Tx txBody :: TxBody era
txBody@(C.TxBody C.TxBodyContent{[TxOut CtxTx era]
txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts :: [TxOut CtxTx era]
C.txOuts}) [KeyWitness era]
_) =
    (EraCastError -> [Utxo])
-> ([Utxo] -> [Utxo]) -> Either EraCastError [Utxo] -> [Utxo]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Utxo] -> EraCastError -> [Utxo]
forall a b. a -> b -> a
const []) [Utxo] -> [Utxo]
addressDiscriminator ([TxOut CtxTx era] -> Either EraCastError [Utxo]
forall era.
IsCardanoEra era =>
[TxOut CtxTx era] -> Either EraCastError [Utxo]
getUtxos' [TxOut CtxTx era]
txOuts)
    where
        addressDiscriminator :: [Utxo] -> [Utxo]
        addressDiscriminator :: [Utxo] -> [Utxo]
addressDiscriminator = case Maybe TargetAddresses
maybeTargetAddresses of
            Just TargetAddresses
targetAddresses -> (Utxo -> Bool) -> [Utxo] -> [Utxo]
forall a. (a -> Bool) -> [a] -> [a]
filter ( TargetAddresses -> Utxo -> Bool
isAddressInTarget TargetAddresses
targetAddresses)
            Maybe TargetAddresses
_                    -> [Utxo] -> [Utxo]
forall a. a -> a
id

        getUtxos' :: C.IsCardanoEra era => [C.TxOut C.CtxTx  era] -> Either C.EraCastError [Utxo]
        getUtxos' :: [TxOut CtxTx era] -> Either EraCastError [Utxo]
getUtxos' = ([TxOut] -> [Utxo])
-> Either EraCastError [TxOut] -> Either EraCastError [Utxo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> TxOut -> Utxo) -> [TxOut] -> [Utxo]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap Int -> TxOut -> Utxo
txoutToUtxo) (Either EraCastError [TxOut] -> Either EraCastError [Utxo])
-> ([TxOut CtxTx era] -> Either EraCastError [TxOut])
-> [TxOut CtxTx era]
-> Either EraCastError [Utxo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut CtxTx era -> Either EraCastError TxOut)
-> [TxOut CtxTx era] -> Either EraCastError [TxOut]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (CardanoEra CurrentEra
-> TxOut CtxTx era -> Either EraCastError TxOut
forall (f :: * -> *) fromEra toEra.
(EraCast f, IsCardanoEra fromEra, IsCardanoEra toEra) =>
CardanoEra toEra -> f fromEra -> Either EraCastError (f toEra)
C.eraCast CardanoEra CurrentEra
CurrentEra)

        txoutToUtxo :: Int -> TxOut -> Utxo
        txoutToUtxo :: Int -> TxOut -> Utxo
txoutToUtxo  Int
ix TxOut
out =
            let
                _utxoTxIx :: TxIx
_utxoTxIx = Word -> TxIx
C.TxIx (Word -> TxIx) -> Word -> TxIx
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix
                _utxoTxId :: TxId
_utxoTxId = TxBody era -> TxId
forall era. TxBody era -> TxId
C.getTxId TxBody era
txBody
                (C.TxOut AddressInEra CurrentEra
address' TxOutValue CurrentEra
value' TxOutDatum CtxTx CurrentEra
datum' ReferenceScript CurrentEra
refScript ) = TxOut
out
                _utxoAddress :: AddressAny
_utxoAddress = AddressInEra CurrentEra -> AddressAny
toAddr AddressInEra CurrentEra
address'
                _utxoValue :: Value
_utxoValue = TxOutValue CurrentEra -> Value
forall era. TxOutValue era -> Value
C.txOutValueToValue TxOutValue CurrentEra
value'
                _utxoDatumHash :: Maybe (Hash ScriptData)
_utxoDatumHash = case TxOutDatum CtxTx CurrentEra
datum' of
                    (C.TxOutDatumHash ScriptDataSupportedInEra CurrentEra
_ Hash ScriptData
d ) -> Hash ScriptData -> Maybe (Hash ScriptData)
forall a. a -> Maybe a
Just Hash ScriptData
d
                    TxOutDatum CtxTx CurrentEra
_                       ->  Maybe (Hash ScriptData)
forall a. Maybe a
Nothing
                _utxoDatum :: Maybe ScriptData
_utxoDatum = case TxOutDatum CtxTx CurrentEra
datum' of
                    (C.TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra CurrentEra
_ ScriptData
d ) -> ScriptData -> Maybe ScriptData
forall a. a -> Maybe a
Just ScriptData
d
                    TxOutDatum CtxTx CurrentEra
_                         ->  Maybe ScriptData
forall a. Maybe a
Nothing
                (Maybe ByteString
_utxoInlineScript, Maybe ScriptHash
_utxoInlineScriptHash) = case ReferenceScript CurrentEra
refScript of
                    ReferenceScript CurrentEra
Shelley.ReferenceScriptNone -> (Maybe ByteString
forall a. Maybe a
Nothing, Maybe ScriptHash
forall a. Maybe a
Nothing)
                    Shelley.ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra CurrentEra
_
                        (Shelley.ScriptInAnyLang
                            (C.SimpleScriptLanguage (SimpleScriptVersion lang
C.SimpleScriptV1) )
                            Script lang
script) -> (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Script lang -> ByteString) -> Script lang -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR (Script lang -> Maybe ByteString)
-> Script lang -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Script lang
script, ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash)
-> (Script lang -> ScriptHash) -> Script lang -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript (Script lang -> Maybe ScriptHash)
-> Script lang -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ Script lang
script)    -- TODO this is hack to get pass build , Just . C.hashScript $ script)
                    Shelley.ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra CurrentEra
_
                        (Shelley.ScriptInAnyLang
                            (C.SimpleScriptLanguage (SimpleScriptVersion lang
C.SimpleScriptV2) )
                            Script lang
script) -> (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Script lang -> ByteString) -> Script lang -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR (Script lang -> Maybe ByteString)
-> Script lang -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Script lang
script, ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash)
-> (Script lang -> ScriptHash) -> Script lang -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript (Script lang -> Maybe ScriptHash)
-> Script lang -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ Script lang
script)    -- TODO this is hack to get pass build , Just . C.hashScript $ script)
                    Shelley.ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra CurrentEra
_
                        (Shelley.ScriptInAnyLang
                            (C.PlutusScriptLanguage (PlutusScriptVersion lang
C.PlutusScriptV1) )
                            Script lang
script) -> (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Script lang -> ByteString) -> Script lang -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR (Script lang -> Maybe ByteString)
-> Script lang -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Script lang
script, ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash)
-> (Script lang -> ScriptHash) -> Script lang -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript (Script lang -> Maybe ScriptHash)
-> Script lang -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ Script lang
script)    -- TODO this is hack to get pass build , Just . C.hashScript $ script)
                    Shelley.ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra CurrentEra
_
                        (Shelley.ScriptInAnyLang
                            (C.PlutusScriptLanguage (PlutusScriptVersion lang
C.PlutusScriptV2) )
                            Script lang
script) -> (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Script lang -> ByteString) -> Script lang -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR (Script lang -> Maybe ByteString)
-> Script lang -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Script lang
script, ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash)
-> (Script lang -> ScriptHash) -> Script lang -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
C.hashScript (Script lang -> Maybe ScriptHash)
-> Script lang -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ Script lang
script)    -- TODO this is hack to get pass build , Just . C.hashScript $ script)
            in
                Utxo :: AddressAny
-> TxId
-> TxIx
-> Maybe ScriptData
-> Maybe (Hash ScriptData)
-> Value
-> Maybe ByteString
-> Maybe ScriptHash
-> Utxo
Utxo {Maybe ByteString
Maybe ScriptHash
Maybe ScriptData
Maybe (Hash ScriptData)
Value
AddressAny
TxId
TxIx
_utxoInlineScriptHash :: Maybe ScriptHash
_utxoInlineScript :: Maybe ByteString
_utxoDatum :: Maybe ScriptData
_utxoDatumHash :: Maybe (Hash ScriptData)
_utxoValue :: Value
_utxoAddress :: AddressAny
_utxoTxId :: TxId
_utxoTxIx :: TxIx
_utxoInlineScriptHash :: Maybe ScriptHash
_utxoInlineScript :: Maybe ByteString
_utxoValue :: Value
_utxoDatumHash :: Maybe (Hash ScriptData)
_utxoDatum :: Maybe ScriptData
_utxoTxIx :: TxIx
_utxoTxId :: TxId
_utxoAddress :: AddressAny
..}
getUtxoEvents
  :: C.IsCardanoEra era
  => Maybe TargetAddresses              -- ^ target addresses to filter for
  -> C.SlotNo
  -> C.BlockNo
  -> [C.Tx era]
  -> Maybe UtxoEvent               -- ^ UtxoEvents are stored in storage after conversion to UtxoRow
getUtxoEvents :: Maybe TargetAddresses
-> SlotNo -> BlockNo -> [Tx era] -> Maybe UtxoEvent
getUtxoEvents Maybe TargetAddresses
maybeTargetAddresses SlotNo
slotNo BlockNo
blkNo [Tx era]
txs =
    let
        utxos :: [Utxo]
utxos = ([[Utxo]] -> [Utxo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Utxo]] -> [Utxo])
-> ([Tx era] -> [[Utxo]]) -> [Tx era] -> [Utxo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx era -> [Utxo]) -> [Tx era] -> [[Utxo]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe TargetAddresses -> Tx era -> [Utxo]
forall era.
IsCardanoEra era =>
Maybe TargetAddresses -> Tx era -> [Utxo]
getUtxos Maybe TargetAddresses
maybeTargetAddresses) ([Tx era] -> [Utxo]) -> [Tx era] -> [Utxo]
forall a b. (a -> b) -> a -> b
$ [Tx era]
txs )
        ins :: Set TxIn
ins  = (Set TxIn -> Set TxIn -> Set TxIn)
-> Set TxIn -> [Set TxIn] -> Set TxIn
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set TxIn
forall a. Set a
Set.empty ([Set TxIn] -> Set TxIn) -> [Set TxIn] -> Set TxIn
forall a b. (a -> b) -> a -> b
$ Tx era -> Set TxIn
forall era. Tx era -> Set TxIn
getInputs (Tx era -> Set TxIn) -> [Tx era] -> [Set TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx era]
txs
    in
        if [Utxo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Utxo]
utxos then
            Maybe UtxoEvent
forall a. Maybe a
Nothing
        else
            UtxoEvent -> Maybe UtxoEvent
forall a. a -> Maybe a
Just ([Utxo] -> Set TxIn -> SlotNo -> BlockNo -> UtxoEvent
UtxoEvent [Utxo]
utxos Set TxIn
ins SlotNo
slotNo BlockNo
blkNo)

getInputs
  :: C.Tx era
  -> Set C.TxIn
getInputs :: Tx era -> Set TxIn
getInputs (C.Tx (C.TxBody C.TxBodyContent{TxIns ViewTx era
txIns :: forall build era. TxBodyContent build era -> TxIns build era
txIns :: TxIns ViewTx era
C.txIns, TxScriptValidity era
txScriptValidity :: forall build era. TxBodyContent build era -> TxScriptValidity era
txScriptValidity :: TxScriptValidity era
C.txScriptValidity, TxInsCollateral era
txInsCollateral :: forall build era. TxBodyContent build era -> TxInsCollateral era
txInsCollateral :: TxInsCollateral era
C.txInsCollateral}) [KeyWitness era]
_) =
  let inputs :: [TxIn]
inputs = case TxScriptValidity era -> ScriptValidity
forall era. TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidity era
txScriptValidity of
        ScriptValidity
C.ScriptValid -> (TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era)) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, BuildTxWith ViewTx (Witness WitCtxTxIn era)) -> TxIn)
-> TxIns ViewTx era -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxIns ViewTx era
txIns
        ScriptValidity
C.ScriptInvalid -> case TxInsCollateral era
txInsCollateral of
                                TxInsCollateral era
C.TxInsCollateralNone     -> []
                                C.TxInsCollateral CollateralSupportedInEra era
_ [TxIn]
txins -> [TxIn]
txins
  in [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
inputs

-- | Duplicated from cardano-api (not exposed in cardano-api)
-- This function should be removed when marconi will depend on a cardano-api version that has accepted this PR:
-- https://github.com/input-output-hk/cardano-node/pull/4569
txScriptValidityToScriptValidity :: C.TxScriptValidity era -> C.ScriptValidity
txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity
txScriptValidityToScriptValidity TxScriptValidity era
C.TxScriptValidityNone                = ScriptValidity
C.ScriptValid
txScriptValidityToScriptValidity (C.TxScriptValidity TxScriptValiditySupportedInEra era
_ ScriptValidity
scriptValidity) = ScriptValidity
scriptValidity

-- | does the transaction contain a targetAddress
isAddressInTarget
    :: TargetAddresses
    -> Utxo
    -> Bool
isAddressInTarget :: TargetAddresses -> Utxo -> Bool
isAddressInTarget TargetAddresses
targetAddresses Utxo
utxo =
    case (Utxo
utxo Utxo
-> ((AddressAny -> Const AddressAny AddressAny)
    -> Utxo -> Const AddressAny Utxo)
-> AddressAny
forall s a. s -> Getting a s a -> a
^. (AddressAny -> Const AddressAny AddressAny)
-> Utxo -> Const AddressAny Utxo
Lens' Utxo AddressAny
utxoAddress) of
        C.AddressByron Address ByronAddr
_      -> Bool
False
        C.AddressShelley Address ShelleyAddr
addr -> Address ShelleyAddr
addr Address ShelleyAddr -> TargetAddresses -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TargetAddresses
targetAddresses