{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}

{- | The shipping generic Koios constructor. The caller supplies scope and
observation effects; the shared client owns every HTTP decoder and page.
-}
module Singular.Provider.Koios.Provider
    ( koiosProvider
    , ProviderRuntime (..)
    , ProviderEvent (..)
    , TimeSource (..)
    ) where

import Cardano.Ledger.Address (AccountAddress (..), AccountId (..))
import Cardano.Ledger.Api.Tx (bodyTxL)
import Cardano.Ledger.Api.Tx.Body (outputsTxBodyL)
import Cardano.Ledger.Api.Tx.Out (addrTxOutL)
import Cardano.Ledger.BaseTypes (TxIx (..))
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Credential (Credential (ScriptHashObj))
import Cardano.Ledger.TxIn (TxIn (..))
import Control.Monad.Except (ExceptT (..), runExceptT, throwError)
import Control.Tracer (nullTracer)
import Data.Bifunctor (first)
import Data.Bifunctor qualified
import Data.Containers.ListUtils (nubOrd)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Lens.Micro ((^.))
import Singular.Provider.Koios.Client qualified as Client
import Singular.Provider.Koios.History (assetHistory)
import Singular.Provider.Koios.Wire qualified as Wire
import Singular.Registry.Evidence
import Singular.Registry.LedgerProvider
import Singular.Registry.NetworkTime
    ( validateNetworkTime
    )
import Singular.Registry.TimeSource (TimeSource (..))

{- | Every exchange and local raw time read carries its acquisition identity.
Authorization headers are removed before an observation leaves this module.
-}
data ProviderEvent
    = SessionOpened SessionId Network
    | SessionClosed SessionId
    | RawExchange SessionId Client.RawRequest Client.Exchange
    | RawTime SessionId TimeSource
    | RawTimeFailure SessionId ReadFailure

{- | Scope effects are explicit. Pure State implementations keep their open
session set and events in State; IO implementations release on exceptions.
-}
data ProviderRuntime m = ProviderRuntime
    { forall (m :: * -> *).
ProviderRuntime m
-> forall a. (SessionId -> m a) -> (SessionId -> m ()) -> m a
scopedSession
        :: forall a. (SessionId -> m a) -> (SessionId -> m ()) -> m a
    , forall (m :: * -> *). ProviderRuntime m -> SessionId -> m Bool
sessionOpen :: SessionId -> m Bool
    , forall (m :: * -> *). ProviderRuntime m -> ProviderEvent -> m ()
recordEvent :: ProviderEvent -> m ()
    , forall (m :: * -> *).
ProviderRuntime m
-> forall a.
   SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
measureRead
        :: forall a. SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
    }

koiosProvider
    :: (Monad m)
    => ProviderRuntime m
    -> Network
    -> m (Either ReadFailure TimeSource)
    -> Client.Koios m
    -> LedgerProvider NoWitness m
koiosProvider :: forall (m :: * -> *).
Monad m =>
ProviderRuntime m
-> Network
-> m (Either ReadFailure TimeSource)
-> Koios m
-> LedgerProvider NoWitness m
koiosProvider ProviderRuntime m
runtime Network
configured m (Either ReadFailure TimeSource)
loadSource Koios m
client =
    LedgerProvider
        { acquire :: forall a.
Acquisition
-> (Session NoWitness m -> m a) -> m (Either AcquireFailure a)
acquire = \Acquisition
requested Session NoWitness m -> m a
action -> case Acquisition
requested of
            AtPoint Network
network ChainPoint
point
                | Network
network Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
configured ->
                    Either AcquireFailure a -> m (Either AcquireFailure a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AcquireFailure -> Either AcquireFailure a
forall a b. a -> Either a b
Left (Network -> Network -> AcquireFailure
WrongNetwork Network
configured Network
network))
                | Bool
otherwise -> Either AcquireFailure a -> m (Either AcquireFailure a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AcquireFailure -> Either AcquireFailure a
forall a b. a -> Either a b
Left (ChainPoint -> AcquireFailure
PointNotSupported ChainPoint
point))
            Latest Network
network
                | Network
network Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
configured ->
                    Either AcquireFailure a -> m (Either AcquireFailure a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AcquireFailure -> Either AcquireFailure a
forall a b. a -> Either a b
Left (Network -> Network -> AcquireFailure
WrongNetwork Network
configured Network
network))
                | Bool
otherwise ->
                    ProviderRuntime m
-> forall a. (SessionId -> m a) -> (SessionId -> m ()) -> m a
forall (m :: * -> *).
ProviderRuntime m
-> forall a. (SessionId -> m a) -> (SessionId -> m ()) -> m a
scopedSession
                        ProviderRuntime m
runtime
                        ( \SessionId
identity -> do
                            ProviderRuntime m -> ProviderEvent -> m ()
forall (m :: * -> *). ProviderRuntime m -> ProviderEvent -> m ()
recordEvent ProviderRuntime m
runtime (SessionId -> Network -> ProviderEvent
SessionOpened SessionId
identity Network
configured)
                            source <-
                                ProviderRuntime m
-> forall a.
   SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
forall (m :: * -> *).
ProviderRuntime m
-> forall a.
   SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
measureRead
                                    ProviderRuntime m
runtime
                                    SessionId
identity
                                    Text
"network-time"
                                    (SessionId -> Either ReadFailure TimeSource -> ProviderEvent
timeEvent SessionId
identity)
                                    m (Either ReadFailure TimeSource)
loadSource
                            Right <$> action (session identity source)
                        )
                        (ProviderRuntime m -> ProviderEvent -> m ()
forall (m :: * -> *). ProviderRuntime m -> ProviderEvent -> m ()
recordEvent ProviderRuntime m
runtime (ProviderEvent -> m ())
-> (SessionId -> ProviderEvent) -> SessionId -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId -> ProviderEvent
SessionClosed)
        , submitTx :: Network -> SignedTx -> m SubmitResult
submitTx = \Network
network SignedTx
signed ->
            if Network
network Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
configured
                then SubmitResult -> m SubmitResult
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Network -> Network -> SubmitResult
SubmitWrongNetwork Network
configured Network
network)
                else do
                    -- The shared signed-only raw submitter is the allowlisted
                    -- transport composition. Submission is outside a read scope.
                    result <- Koios m -> SignedTx -> m (Either ClientFailure SubmitOutcome)
forall (m :: * -> *).
Monad m =>
Koios m -> SignedTx -> m (Either ClientFailure SubmitOutcome)
Client.submitTx Koios m
client SignedTx
signed
                    pure $ case result of
                        Left ClientFailure
failure -> Text -> SubmitResult
SubmitFailed (String -> Text
Text.pack (ClientFailure -> String
forall a. Show a => a -> String
show ClientFailure
failure))
                        Right (Client.SubmitAccepted TxId
key) -> TxId -> SubmitResult
SubmitAccepted TxId
key
                        Right (Client.SubmitRefused Text
reason) -> Text -> SubmitResult
SubmitRefused Text
reason
        }
  where
    timeEvent :: SessionId -> Either ReadFailure TimeSource -> ProviderEvent
timeEvent SessionId
identity = (ReadFailure -> ProviderEvent)
-> (TimeSource -> ProviderEvent)
-> Either ReadFailure TimeSource
-> ProviderEvent
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SessionId -> ReadFailure -> ProviderEvent
RawTimeFailure SessionId
identity) (SessionId -> TimeSource -> ProviderEvent
RawTime SessionId
identity)
    session :: SessionId -> Either ReadFailure TimeSource -> Session w m
session SessionId
identity Either ReadFailure TimeSource
source =
        let scopedClient :: Koios m
scopedClient =
                Koios m
client
                    { Client.koiosTransport = Client.Transport $ \RawRequest
request -> do
                        ProviderRuntime m
-> forall a.
   SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
forall (m :: * -> *).
ProviderRuntime m
-> forall a.
   SessionId -> Text -> (a -> ProviderEvent) -> m a -> m a
measureRead
                            ProviderRuntime m
runtime
                            SessionId
identity
                            (Call -> Text
Wire.callName (RawRequest -> Call
Client.rawCall RawRequest
request))
                            ( SessionId -> RawRequest -> Exchange -> ProviderEvent
RawExchange
                                SessionId
identity
                                RawRequest
request
                                    { Client.rawHeaders =
                                        filter ((/= "authorization") . fst) (Client.rawHeaders request)
                                    }
                            )
                            (Transport m -> RawRequest -> m Exchange
forall (m :: * -> *). Transport m -> RawRequest -> m Exchange
Client.exchange (Koios m -> Transport m
forall (m :: * -> *). Koios m -> Transport m
Client.koiosTransport Koios m
client) RawRequest
request)
                    }
            readFact :: m (Either ClientFailure a)
-> m (Either ReadFailure (Evidenced w a))
readFact m (Either ClientFailure a)
action =
                SessionId
-> m (Either ReadFailure (Evidenced w a))
-> m (Either ReadFailure (Evidenced w a))
forall {b}.
SessionId -> m (Either ReadFailure b) -> m (Either ReadFailure b)
guarded
                    SessionId
identity
                    ( (Either ClientFailure a -> Either ReadFailure (Evidenced w a))
-> m (Either ClientFailure a)
-> m (Either ReadFailure (Evidenced w a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                        ((ClientFailure -> ReadFailure)
-> Either ClientFailure (Evidenced w a)
-> Either ReadFailure (Evidenced w a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ClientFailure -> ReadFailure
backendFailure (Either ClientFailure (Evidenced w a)
 -> Either ReadFailure (Evidenced w a))
-> (Either ClientFailure a -> Either ClientFailure (Evidenced w a))
-> Either ClientFailure a
-> Either ReadFailure (Evidenced w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Evidenced w a)
-> Either ClientFailure a -> Either ClientFailure (Evidenced w a)
forall a b.
(a -> b) -> Either ClientFailure a -> Either ClientFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe w -> Evidenced w a
forall w a. a -> Maybe w -> Evidenced w a
`Evidenced` Maybe w
forall a. Maybe a
Nothing))
                        m (Either ClientFailure a)
action
                    )
            localTime :: m (Either ReadFailure (Evidenced w NetworkTime))
localTime = Either ReadFailure (Evidenced w NetworkTime)
-> m (Either ReadFailure (Evidenced w NetworkTime))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ReadFailure (Evidenced w NetworkTime)
 -> m (Either ReadFailure (Evidenced w NetworkTime)))
-> Either ReadFailure (Evidenced w NetworkTime)
-> m (Either ReadFailure (Evidenced w NetworkTime))
forall a b. (a -> b) -> a -> b
$ do
                TimeSource manifest genesis eras <- Either ReadFailure TimeSource
source
                let Network magic = configured
                first NetworkTimeRefusal $
                    fmap
                        (`Evidenced` Nothing)
                        (validateNetworkTime magic manifest genesis eras)
            readHistory :: Asset
-> HistoryRange -> m (Either HistoryFailure (HistoryStream m))
readHistory Asset
asset HistoryRange
range = do
                open <- ProviderRuntime m -> SessionId -> m Bool
forall (m :: * -> *). ProviderRuntime m -> SessionId -> m Bool
sessionOpen ProviderRuntime m
runtime SessionId
identity
                if not open
                    then pure (Left (HistoryReadFailure (ReleasedSession identity)))
                    else
                        fmap
                            (fmap (guardStream identity))
                            (assetHistory scopedClient asset range)
        in  Session
                { sessionNetwork :: Network
sessionNetwork = Network
configured
                , sessionId :: SessionId
sessionId = SessionId
identity
                , sessionBinding :: SessionBinding
sessionBinding = SessionBinding
Unbound
                , sessionTracer :: Tracer m ReadEvent
sessionTracer = Tracer m ReadEvent
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
                , sessionEvaluated :: Evaluation -> m ()
sessionEvaluated = \Evaluation
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                , outputs :: OutputQuery -> m (Either ReadFailure (Evidenced w Outputs))
outputs =
                    SessionId
-> m (Either
        ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
-> m (Either
        ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
forall {b}.
SessionId -> m (Either ReadFailure b) -> m (Either ReadFailure b)
guarded
                        SessionId
identity
                        (m (Either
      ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
 -> m (Either
         ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)])))
-> (OutputQuery
    -> m (Either
            ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)])))
-> OutputQuery
-> m (Either
        ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)]
 -> Either
      ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
-> m (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)])
-> m (Either
        ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            (([(TxIn, BabbageTxOut ConwayEra)]
 -> Evidenced w [(TxIn, BabbageTxOut ConwayEra)])
-> Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)]
-> Either
     ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)])
forall a b.
(a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(TxIn, BabbageTxOut ConwayEra)]
-> Maybe w -> Evidenced w [(TxIn, BabbageTxOut ConwayEra)]
forall w a. a -> Maybe w -> Evidenced w a
`Evidenced` Maybe w
forall a. Maybe a
Nothing))
                        (m (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)])
 -> m (Either
         ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)])))
-> (OutputQuery
    -> m (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)]))
-> OutputQuery
-> m (Either
        ReadFailure (Evidenced w [(TxIn, BabbageTxOut ConwayEra)]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
-> m (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
                        (ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
 -> m (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)]))
-> (OutputQuery
    -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> OutputQuery
-> m (Either ReadFailure [(TxIn, BabbageTxOut ConwayEra)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
forall (m :: * -> *).
Monad m =>
Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
queryOutputs Koios m
scopedClient
                , protocolParameters :: m (Either ReadFailure (Evidenced w (PParams ConwayEra)))
protocolParameters = m (Either ClientFailure (PParams ConwayEra))
-> m (Either ReadFailure (Evidenced w (PParams ConwayEra)))
forall {a} {w}.
m (Either ClientFailure a)
-> m (Either ReadFailure (Evidenced w a))
readFact (Koios m -> m (Either ClientFailure (PParams ConwayEra))
forall (m :: * -> *).
Monad m =>
Koios m -> m (Either ClientFailure (PParams ConwayEra))
Client.cliProtocolParams Koios m
scopedClient)
                , tipObservation :: m (Either ReadFailure (Evidenced w TipObservation))
tipObservation =
                    m (Either ClientFailure TipObservation)
-> m (Either ReadFailure (Evidenced w TipObservation))
forall {a} {w}.
m (Either ClientFailure a)
-> m (Either ReadFailure (Evidenced w a))
readFact ((Either ClientFailure Tip -> Either ClientFailure TipObservation)
-> m (Either ClientFailure Tip)
-> m (Either ClientFailure TipObservation)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tip -> TipObservation)
-> Either ClientFailure Tip -> Either ClientFailure TipObservation
forall a b.
(a -> b) -> Either ClientFailure a -> Either ClientFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tip -> TipObservation
observation) (Koios m -> m (Either ClientFailure Tip)
forall (m :: * -> *).
Monad m =>
Koios m -> m (Either ClientFailure Tip)
Client.tip Koios m
scopedClient))
                , networkTime :: m (Either ReadFailure (Evidenced w NetworkTime))
networkTime = SessionId
-> m (Either ReadFailure (Evidenced w NetworkTime))
-> m (Either ReadFailure (Evidenced w NetworkTime))
forall {b}.
SessionId -> m (Either ReadFailure b) -> m (Either ReadFailure b)
guarded SessionId
identity m (Either ReadFailure (Evidenced w NetworkTime))
forall {w}. m (Either ReadFailure (Evidenced w NetworkTime))
localTime
                , scriptRegistered :: ScriptHash -> m (Either ReadFailure (Evidenced w Bool))
scriptRegistered =
                    m (Either ClientFailure Bool)
-> m (Either ReadFailure (Evidenced w Bool))
forall {a} {w}.
m (Either ClientFailure a)
-> m (Either ReadFailure (Evidenced w a))
readFact
                        (m (Either ClientFailure Bool)
 -> m (Either ReadFailure (Evidenced w Bool)))
-> (ScriptHash -> m (Either ClientFailure Bool))
-> ScriptHash
-> m (Either ReadFailure (Evidenced w Bool))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Koios m -> AccountAddress -> m (Either ClientFailure Bool)
forall (m :: * -> *).
Monad m =>
Koios m -> AccountAddress -> m (Either ClientFailure Bool)
Client.accountRegistered
                            Koios m
scopedClient
                        (AccountAddress -> m (Either ClientFailure Bool))
-> (ScriptHash -> AccountAddress)
-> ScriptHash
-> m (Either ClientFailure Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> AccountId -> AccountAddress
AccountAddress Network
Ledger.Testnet
                        (AccountId -> AccountAddress)
-> (ScriptHash -> AccountId) -> ScriptHash -> AccountAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential Staking -> AccountId
AccountId
                        (Credential Staking -> AccountId)
-> (ScriptHash -> Credential Staking) -> ScriptHash -> AccountId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj
                , mintRecord :: Asset -> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
mintRecord =
                    SessionId
-> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
-> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
forall {b}.
SessionId -> m (Either ReadFailure b) -> m (Either ReadFailure b)
guarded SessionId
identity
                        (m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
 -> m (Either ReadFailure (Evidenced w (Maybe MintRecord))))
-> (Asset
    -> m (Either ReadFailure (Evidenced w (Maybe MintRecord))))
-> Asset
-> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ReadFailure (Maybe MintRecord)
 -> Either ReadFailure (Evidenced w (Maybe MintRecord)))
-> m (Either ReadFailure (Maybe MintRecord))
-> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe MintRecord -> Evidenced w (Maybe MintRecord))
-> Either ReadFailure (Maybe MintRecord)
-> Either ReadFailure (Evidenced w (Maybe MintRecord))
forall a b.
(a -> b) -> Either ReadFailure a -> Either ReadFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe MintRecord -> Maybe w -> Evidenced w (Maybe MintRecord)
forall w a. a -> Maybe w -> Evidenced w a
`Evidenced` Maybe w
forall a. Maybe a
Nothing))
                        (m (Either ReadFailure (Maybe MintRecord))
 -> m (Either ReadFailure (Evidenced w (Maybe MintRecord))))
-> (Asset -> m (Either ReadFailure (Maybe MintRecord)))
-> Asset
-> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ReadFailure m (Maybe MintRecord)
-> m (Either ReadFailure (Maybe MintRecord))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
                        (ExceptT ReadFailure m (Maybe MintRecord)
 -> m (Either ReadFailure (Maybe MintRecord)))
-> (Asset -> ExceptT ReadFailure m (Maybe MintRecord))
-> Asset
-> m (Either ReadFailure (Maybe MintRecord))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Koios m -> Asset -> ExceptT ReadFailure m (Maybe MintRecord)
forall (m :: * -> *).
Monad m =>
Koios m -> Asset -> ExceptT ReadFailure m (Maybe MintRecord)
mintRecordOf Koios m
scopedClient
                , history :: Asset
-> HistoryRange -> m (Either HistoryFailure (HistoryStream m))
history = Asset
-> HistoryRange -> m (Either HistoryFailure (HistoryStream m))
readHistory
                }
    guarded :: SessionId -> m (Either ReadFailure b) -> m (Either ReadFailure b)
guarded SessionId
identity m (Either ReadFailure b)
action = do
        open <- ProviderRuntime m -> SessionId -> m Bool
forall (m :: * -> *). ProviderRuntime m -> SessionId -> m Bool
sessionOpen ProviderRuntime m
runtime SessionId
identity
        if open then action else pure (Left (ReleasedSession identity))
    guardStream :: SessionId -> HistoryStream m -> HistoryStream m
guardStream SessionId
identity HistoryStream m
stream = m (Either HistoryFailure (Maybe (HistoryBlock, HistoryStream m)))
-> HistoryStream m
forall (m :: * -> *).
m (Either HistoryFailure (Maybe (HistoryBlock, HistoryStream m)))
-> HistoryStream m
HistoryStream (m (Either HistoryFailure (Maybe (HistoryBlock, HistoryStream m)))
 -> HistoryStream m)
-> m (Either
        HistoryFailure (Maybe (HistoryBlock, HistoryStream m)))
-> HistoryStream m
forall a b. (a -> b) -> a -> b
$ do
        open <- ProviderRuntime m -> SessionId -> m Bool
forall (m :: * -> *). ProviderRuntime m -> SessionId -> m Bool
sessionOpen ProviderRuntime m
runtime SessionId
identity
        if open
            then
                fmap
                    ( fmap
                        ( fmap
                            (\(HistoryBlock, HistoryStream m)
pair -> (HistoryBlock, HistoryStream m)
pair (HistoryBlock, HistoryStream m)
-> (HistoryBlock, HistoryStream m)
-> (HistoryBlock, HistoryStream m)
forall a b. a -> b -> b
`seq` (HistoryStream m -> HistoryStream m)
-> (HistoryBlock, HistoryStream m)
-> (HistoryBlock, HistoryStream m)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
Data.Bifunctor.second (SessionId -> HistoryStream m -> HistoryStream m
guardStream SessionId
identity) (HistoryBlock, HistoryStream m)
pair)
                        )
                    )
                    (nextBlock stream)
            else pure (Left (HistoryReadFailure (ReleasedSession identity)))

backendFailure :: Client.ClientFailure -> ReadFailure
backendFailure :: ClientFailure -> ReadFailure
backendFailure = Text -> ReadFailure
BackendReadFailure (Text -> ReadFailure)
-> (ClientFailure -> Text) -> ClientFailure -> ReadFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text)
-> (ClientFailure -> String) -> ClientFailure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientFailure -> String
forall a. Show a => a -> String
show

observation :: Wire.Tip -> TipObservation
observation :: Tip -> TipObservation
observation Tip
tip =
    TipObservation
        { observedSlot :: SlotNo
observedSlot = Tip -> SlotNo
Wire.tipSlot Tip
tip
        , observedHash :: ByteString
observedHash = Tip -> ByteString
Wire.tipBlockHash Tip
tip
        , observedHeight :: Word64
observedHeight = Tip -> Word64
Wire.tipBlockHeight Tip
tip
        , observedBlockTime :: Word64
observedBlockTime = Tip -> Word64
Wire.tipBlockTime Tip
tip
        }

queryOutputs
    :: (Monad m)
    => Client.Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
queryOutputs :: forall (m :: * -> *).
Monad m =>
Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
queryOutputs Koios m
client = \case
    AtAddress Addr
address -> m (Either ClientFailure [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall {a}. m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch (Koios m -> [Addr] -> m (Either ClientFailure Outputs)
forall (m :: * -> *).
Monad m =>
Koios m -> [Addr] -> m (Either ClientFailure Outputs)
Client.addressUtxos Koios m
client [Addr
address]) ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
-> ([(TxIn, BabbageTxOut ConwayEra)]
    -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a b.
ExceptT ReadFailure m a
-> (a -> ExceptT ReadFailure m b) -> ExceptT ReadFailure m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Outputs -> ExceptT ReadFailure m Outputs
[(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall (m :: * -> *).
Monad m =>
Outputs -> ExceptT ReadFailure m Outputs
mergeOutputs
    HoldingAsset Asset
asset -> m (Either ClientFailure [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall {a}. m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch (Koios m -> [Asset] -> m (Either ClientFailure Outputs)
forall (m :: * -> *).
Monad m =>
Koios m -> [Asset] -> m (Either ClientFailure Outputs)
Client.assetUtxos Koios m
client [Asset
asset]) ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
-> ([(TxIn, BabbageTxOut ConwayEra)]
    -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a b.
ExceptT ReadFailure m a
-> (a -> ExceptT ReadFailure m b) -> ExceptT ReadFailure m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Outputs -> ExceptT ReadFailure m Outputs
[(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall (m :: * -> *).
Monad m =>
Outputs -> ExceptT ReadFailure m Outputs
mergeOutputs
    AtTxIn reference :: TxIn
reference@(TxIn TxId
key TxIx
_) -> do
        -- tx_info includes spent outputs: current visibility requires the
        -- shared UTxO endpoint at the resolved output's address as well.
        infos <-
            m (Either ReadFailure [TxInfo]) -> ExceptT ReadFailure m [TxInfo]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ReadFailure [TxInfo]) -> ExceptT ReadFailure m [TxInfo])
-> m (Either ReadFailure [TxInfo])
-> ExceptT ReadFailure m [TxInfo]
forall a b. (a -> b) -> a -> b
$ (Either ClientFailure [TxInfo] -> Either ReadFailure [TxInfo])
-> m (Either ClientFailure [TxInfo])
-> m (Either ReadFailure [TxInfo])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClientFailure -> ReadFailure)
-> Either ClientFailure [TxInfo] -> Either ReadFailure [TxInfo]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ClientFailure -> ReadFailure
missingTransaction) (Koios m -> [TxId] -> m (Either ClientFailure [TxInfo])
forall (m :: * -> *).
Monad m =>
Koios m -> [TxId] -> m (Either ClientFailure [TxInfo])
Client.txInfo Koios m
client [TxId
key])
        produced <- mergeOutputs (concatMap Wire.txInfoOutputs infos)
        case lookup reference produced of
            Maybe (BabbageTxOut ConwayEra)
Nothing -> ReadFailure
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a. ReadFailure -> ExceptT ReadFailure m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxIn -> ReadFailure
MissingOutput TxIn
reference)
            Just BabbageTxOut ConwayEra
output -> do
                current <-
                    m (Either ClientFailure [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall {a}. m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch (Koios m -> [Addr] -> m (Either ClientFailure Outputs)
forall (m :: * -> *).
Monad m =>
Koios m -> [Addr] -> m (Either ClientFailure Outputs)
Client.addressUtxos Koios m
client [BabbageTxOut ConwayEra
output BabbageTxOut ConwayEra
-> Getting Addr (BabbageTxOut ConwayEra) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. (Addr -> Const Addr Addr)
-> TxOut ConwayEra -> Const Addr (TxOut ConwayEra)
Getting Addr (BabbageTxOut ConwayEra) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut ConwayEra) Addr
addrTxOutL])
                        ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
-> ([(TxIn, BabbageTxOut ConwayEra)]
    -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a b.
ExceptT ReadFailure m a
-> (a -> ExceptT ReadFailure m b) -> ExceptT ReadFailure m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Outputs -> ExceptT ReadFailure m Outputs
[(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall (m :: * -> *).
Monad m =>
Outputs -> ExceptT ReadFailure m Outputs
mergeOutputs
                case lookup reference current of
                    Maybe (BabbageTxOut ConwayEra)
Nothing -> ReadFailure
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a. ReadFailure -> ExceptT ReadFailure m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxIn -> ReadFailure
MissingOutput TxIn
reference)
                    Just BabbageTxOut ConwayEra
actual | BabbageTxOut ConwayEra
actual BabbageTxOut ConwayEra -> BabbageTxOut ConwayEra -> Bool
forall a. Eq a => a -> a -> Bool
/= BabbageTxOut ConwayEra
output -> ReadFailure
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a. ReadFailure -> ExceptT ReadFailure m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxIn -> ReadFailure
ConflictingOutput TxIn
reference)
                    Just BabbageTxOut ConwayEra
_ -> [(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(TxIn
reference, BabbageTxOut ConwayEra
output)]
      where
        missingTransaction :: ClientFailure -> ReadFailure
missingTransaction ClientFailure
failure
            | Client.UnknownFact (Client.UnknownTransaction TxId
missing) <-
                ClientFailure -> FailureReason
Client.failureReason ClientFailure
failure
            , TxId
missing TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
key =
                TxIn -> ReadFailure
MissingOutput TxIn
reference
            | Bool
otherwise = ClientFailure -> ReadFailure
backendFailure ClientFailure
failure
    CarryingReferenceScript ScriptHash
script -> do
        -- Koios names a hash per row; it is not read. The consumer computes
        -- each candidate's hash from the output itself.
        listed <- m (Either ClientFailure [(ScriptHash, TxIn)])
-> ExceptT ReadFailure m [(ScriptHash, TxIn)]
forall {a}. m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch (Koios m
-> NonEmpty ScriptHash
-> m (Either ClientFailure [(ScriptHash, TxIn)])
forall (m :: * -> *).
Monad m =>
Koios m
-> NonEmpty ScriptHash
-> m (Either ClientFailure [(ScriptHash, TxIn)])
Client.referenceScriptUtxos Koios m
client (ScriptHash
script ScriptHash -> [ScriptHash] -> NonEmpty ScriptHash
forall a. a -> [a] -> NonEmpty a
:| []))
        case NE.nonEmpty (nubOrd (map snd listed)) of
            Maybe (NonEmpty TxIn)
Nothing -> [(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Just NonEmpty TxIn
candidates -> do
                infos <- m (Either ClientFailure [UtxoInfo])
-> ExceptT ReadFailure m [UtxoInfo]
forall {a}. m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch (Koios m -> NonEmpty TxIn -> m (Either ClientFailure [UtxoInfo])
forall (m :: * -> *).
Monad m =>
Koios m -> NonEmpty TxIn -> m (Either ClientFailure [UtxoInfo])
Client.utxoInfo Koios m
client NonEmpty TxIn
candidates)
                let unspent =
                        [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList
                            [ UtxoInfo -> TxIn
Wire.utxoInfoReference UtxoInfo
i
                            | UtxoInfo
i <- [UtxoInfo]
infos
                            , Bool -> Bool
not (UtxoInfo -> Bool
Wire.utxoInfoSpent UtxoInfo
i)
                            ]
                    live = (TxIn -> Bool) -> [TxIn] -> [TxIn]
forall a. (a -> Bool) -> [a] -> [a]
filter (TxIn -> Set TxIn -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TxIn
unspent) (NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxIn
candidates)
                case NE.nonEmpty (nubOrd [key | TxIn key _ <- live]) of
                    Maybe (NonEmpty TxId)
Nothing -> [(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                    Just NonEmpty TxId
producers -> do
                        txs <- m (Either ClientFailure [TxCbor]) -> ExceptT ReadFailure m [TxCbor]
forall {a}. m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch (Koios m -> [TxId] -> m (Either ClientFailure [TxCbor])
forall (m :: * -> *).
Monad m =>
Koios m -> [TxId] -> m (Either ClientFailure [TxCbor])
Client.txCbor Koios m
client (NonEmpty TxId -> [TxId]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TxId
producers))
                        let produced =
                                [(TxIn, BabbageTxOut ConwayEra)]
-> Map TxIn (BabbageTxOut ConwayEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                    [ (TxId -> TxIx -> TxIn
TxIn (TxCbor -> TxId
Wire.txCborId TxCbor
tx) (Word16 -> TxIx
TxIx Word16
index), BabbageTxOut ConwayEra
output)
                                    | TxCbor
tx <- [TxCbor]
txs
                                    , (Word16
index, BabbageTxOut ConwayEra
output) <-
                                        [Word16]
-> [BabbageTxOut ConwayEra] -> [(Word16, BabbageTxOut ConwayEra)]
forall a b. [a] -> [b] -> [(a, b)]
zip
                                            [Word16
0 ..]
                                            (StrictSeq (BabbageTxOut ConwayEra) -> [BabbageTxOut ConwayEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxCbor -> ConwayTx
Wire.txCborTx TxCbor
tx ConwayTx
-> Getting
     (StrictSeq (BabbageTxOut ConwayEra))
     ConwayTx
     (StrictSeq (BabbageTxOut ConwayEra))
-> StrictSeq (BabbageTxOut ConwayEra)
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx ConwayEra
 -> Const
      (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra))
-> ConwayTx -> Const (StrictSeq (BabbageTxOut ConwayEra)) ConwayTx
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL ((TxBody TopTx ConwayEra
  -> Const
       (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra))
 -> ConwayTx -> Const (StrictSeq (BabbageTxOut ConwayEra)) ConwayTx)
-> ((StrictSeq (BabbageTxOut ConwayEra)
     -> Const
          (StrictSeq (BabbageTxOut ConwayEra))
          (StrictSeq (BabbageTxOut ConwayEra)))
    -> TxBody TopTx ConwayEra
    -> Const
         (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra))
-> Getting
     (StrictSeq (BabbageTxOut ConwayEra))
     ConwayTx
     (StrictSeq (BabbageTxOut ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut ConwayEra)
 -> Const
      (StrictSeq (BabbageTxOut ConwayEra)) (StrictSeq (TxOut ConwayEra)))
-> TxBody TopTx ConwayEra
-> Const
     (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra)
(StrictSeq (BabbageTxOut ConwayEra)
 -> Const
      (StrictSeq (BabbageTxOut ConwayEra))
      (StrictSeq (BabbageTxOut ConwayEra)))
-> TxBody TopTx ConwayEra
-> Const
     (StrictSeq (BabbageTxOut ConwayEra)) (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL))
                                    ]
                        exact <-
                            traverse
                                ( \TxIn
reference -> case TxIn
-> Map TxIn (BabbageTxOut ConwayEra)
-> Maybe (BabbageTxOut ConwayEra)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
reference Map TxIn (BabbageTxOut ConwayEra)
produced of
                                    Just BabbageTxOut ConwayEra
output -> (TxIn, BabbageTxOut ConwayEra)
-> ExceptT ReadFailure m (TxIn, BabbageTxOut ConwayEra)
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn
reference, BabbageTxOut ConwayEra
output)
                                    Maybe (BabbageTxOut ConwayEra)
Nothing -> ReadFailure -> ExceptT ReadFailure m (TxIn, BabbageTxOut ConwayEra)
forall a. ReadFailure -> ExceptT ReadFailure m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxIn -> ReadFailure
MissingOutput TxIn
reference)
                                )
                                live
                        mergeOutputs exact
    AnyOf NonEmpty OutputQuery
queries ->
        (OutputQuery
 -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> [OutputQuery]
-> ExceptT ReadFailure m [[(TxIn, BabbageTxOut ConwayEra)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
forall (m :: * -> *).
Monad m =>
Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
queryOutputs Koios m
client) (NonEmpty OutputQuery -> [OutputQuery]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty OutputQuery
queries)
            ExceptT ReadFailure m [[(TxIn, BabbageTxOut ConwayEra)]]
-> ([[(TxIn, BabbageTxOut ConwayEra)]]
    -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a b.
ExceptT ReadFailure m a
-> (a -> ExceptT ReadFailure m b) -> ExceptT ReadFailure m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Outputs -> ExceptT ReadFailure m Outputs
[(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall (m :: * -> *).
Monad m =>
Outputs -> ExceptT ReadFailure m Outputs
mergeOutputs ([(TxIn, BabbageTxOut ConwayEra)]
 -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> ([[(TxIn, BabbageTxOut ConwayEra)]]
    -> [(TxIn, BabbageTxOut ConwayEra)])
-> [[(TxIn, BabbageTxOut ConwayEra)]]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(TxIn, BabbageTxOut ConwayEra)]]
-> [(TxIn, BabbageTxOut ConwayEra)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    AllOf NonEmpty OutputQuery
queries -> do
        found <- (OutputQuery
 -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> [OutputQuery]
-> ExceptT ReadFailure m [[(TxIn, BabbageTxOut ConwayEra)]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
forall (m :: * -> *).
Monad m =>
Koios m -> OutputQuery -> ExceptT ReadFailure m Outputs
queryOutputs Koios m
client) (NonEmpty OutputQuery -> [OutputQuery]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty OutputQuery
queries)
        combined <- mergeOutputs (concat found)
        pure
            [ pair
            | pair@(reference, _) <- combined
            , all (elem reference . map fst) found
            ]
  where
    fetch :: m (Either ClientFailure a) -> ExceptT ReadFailure m a
fetch = m (Either ReadFailure a) -> ExceptT ReadFailure m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ReadFailure a) -> ExceptT ReadFailure m a)
-> (m (Either ClientFailure a) -> m (Either ReadFailure a))
-> m (Either ClientFailure a)
-> ExceptT ReadFailure m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ClientFailure a -> Either ReadFailure a)
-> m (Either ClientFailure a) -> m (Either ReadFailure a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ClientFailure -> ReadFailure)
-> Either ClientFailure a -> Either ReadFailure a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ClientFailure -> ReadFailure
backendFailure)

mergeOutputs :: (Monad m) => Outputs -> ExceptT ReadFailure m Outputs
mergeOutputs :: forall (m :: * -> *).
Monad m =>
Outputs -> ExceptT ReadFailure m Outputs
mergeOutputs = (Map TxIn (BabbageTxOut ConwayEra)
 -> [(TxIn, BabbageTxOut ConwayEra)])
-> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall a b.
(a -> b) -> ExceptT ReadFailure m a -> ExceptT ReadFailure m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map TxIn (BabbageTxOut ConwayEra)
-> [(TxIn, BabbageTxOut ConwayEra)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
 -> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)])
-> ([(TxIn, BabbageTxOut ConwayEra)]
    -> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra)))
-> [(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m [(TxIn, BabbageTxOut ConwayEra)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
 -> (TxIn, BabbageTxOut ConwayEra)
 -> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra)))
-> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
-> [(TxIn, BabbageTxOut ConwayEra)]
-> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
-> (TxIn, BabbageTxOut ConwayEra)
-> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
forall {m :: * -> *} {a}.
(Eq a, MonadError ReadFailure m) =>
m (Map TxIn a) -> (TxIn, a) -> m (Map TxIn a)
step (Map TxIn (BabbageTxOut ConwayEra)
-> ExceptT ReadFailure m (Map TxIn (BabbageTxOut ConwayEra))
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map TxIn (BabbageTxOut ConwayEra)
forall k a. Map k a
Map.empty)
  where
    step :: m (Map TxIn a) -> (TxIn, a) -> m (Map TxIn a)
step m (Map TxIn a)
accumulated (TxIn
reference, a
output) = do
        known <- m (Map TxIn a)
accumulated
        case Map.lookup reference known of
            Just a
other | a
other a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
output -> ReadFailure -> m (Map TxIn a)
forall a. ReadFailure -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxIn -> ReadFailure
ConflictingOutput TxIn
reference)
            Maybe a
_ -> Map TxIn a -> m (Map TxIn a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn -> a -> Map TxIn a -> Map TxIn a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
reference a
output Map TxIn a
known)

{- | The asset's mint record: its latest minting transaction and supply from
@asset_info@, and the inputs that transaction spent from @tx_info@. No row
is no record.
-}
mintRecordOf
    :: (Monad m)
    => Client.Koios m -> Asset -> ExceptT ReadFailure m (Maybe MintRecord)
mintRecordOf :: forall (m :: * -> *).
Monad m =>
Koios m -> Asset -> ExceptT ReadFailure m (Maybe MintRecord)
mintRecordOf Koios m
client Asset
asset = do
    found <-
        m (Either ReadFailure (Maybe AssetInfo))
-> ExceptT ReadFailure m (Maybe AssetInfo)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((ClientFailure -> ReadFailure)
-> Either ClientFailure (Maybe AssetInfo)
-> Either ReadFailure (Maybe AssetInfo)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ClientFailure -> ReadFailure
backendFailure (Either ClientFailure (Maybe AssetInfo)
 -> Either ReadFailure (Maybe AssetInfo))
-> m (Either ClientFailure (Maybe AssetInfo))
-> m (Either ReadFailure (Maybe AssetInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Koios m -> Asset -> m (Either ClientFailure (Maybe AssetInfo))
forall (m :: * -> *).
Monad m =>
Koios m -> Asset -> m (Either ClientFailure (Maybe AssetInfo))
Client.assetInfo Koios m
client Asset
asset)
    case found of
        Maybe AssetInfo
Nothing -> Maybe MintRecord -> ExceptT ReadFailure m (Maybe MintRecord)
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe MintRecord
forall a. Maybe a
Nothing
        Just AssetInfo
info -> do
            let minting :: TxId
minting = AssetInfo -> TxId
Wire.assetInfoMintingTx AssetInfo
info
            transactions <-
                m (Either ReadFailure [TxInfo]) -> ExceptT ReadFailure m [TxInfo]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((ClientFailure -> ReadFailure)
-> Either ClientFailure [TxInfo] -> Either ReadFailure [TxInfo]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ClientFailure -> ReadFailure
backendFailure (Either ClientFailure [TxInfo] -> Either ReadFailure [TxInfo])
-> m (Either ClientFailure [TxInfo])
-> m (Either ReadFailure [TxInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Koios m -> [TxId] -> m (Either ClientFailure [TxInfo])
forall (m :: * -> *).
Monad m =>
Koios m -> [TxId] -> m (Either ClientFailure [TxInfo])
Client.txInfo Koios m
client [TxId
minting])
            case transactions of
                [TxInfo
transaction] ->
                    Maybe MintRecord -> ExceptT ReadFailure m (Maybe MintRecord)
forall a. a -> ExceptT ReadFailure m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe MintRecord -> ExceptT ReadFailure m (Maybe MintRecord))
-> Maybe MintRecord -> ExceptT ReadFailure m (Maybe MintRecord)
forall a b. (a -> b) -> a -> b
$
                        MintRecord -> Maybe MintRecord
forall a. a -> Maybe a
Just
                            MintRecord
                                { mintTransaction :: TxId
mintTransaction = TxId
minting
                                , mintSpentInputs :: [TxIn]
mintSpentInputs = ((TxIn, BabbageTxOut ConwayEra) -> TxIn)
-> [(TxIn, BabbageTxOut ConwayEra)] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn, BabbageTxOut ConwayEra) -> TxIn
forall a b. (a, b) -> a
fst (TxInfo -> Outputs
Wire.txInfoInputs TxInfo
transaction)
                                , mintSupply :: Integer
mintSupply = AssetInfo -> Integer
Wire.assetInfoSupply AssetInfo
info
                                }
                [TxInfo]
_ ->
                    ReadFailure -> ExceptT ReadFailure m (Maybe MintRecord)
forall a. ReadFailure -> ExceptT ReadFailure m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
                        ( Text -> ReadFailure
BackendReadFailure
                            Text
"tx_info did not answer the asset's minting transaction once"
                        )