{-# LANGUAGE RankNTypes #-}

{- |
Module      : Singular.Registry.LedgerProvider
Description : Generic ledger capabilities over the consumer's effect
License     : Apache-2.0

Capabilities supply raw Conway facts and generic reconstruction material.
They neither interpret registry commands nor assert verification or snapshot
binding. One acquisition identifies all reads used to prepare a transaction.
-}
module Singular.Registry.LedgerProvider
    ( LedgerProvider (..)
    , Session (..)
    , Network (..)
    , ChainPoint (..)
    , Acquisition (..)
    , AcquireFailure (..)
    , ReadFailure (..)
    , SubmitResult (..)
    , OutputQuery (..)
    , MintRecord (..)
    , Outputs
    , Asset
    , TipObservation (..)
    , HistoryRange (..)
    , HistoryFailure (..)
    , HistoricalTransaction (..)
    , HistoryBlock (..)
    , HistoryStream (..)
    ) where

import Cardano.Ledger.Api.Tx.Out (TxOut)
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Core (PParams)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Mary.Value (AssetName, PolicyID)
import Cardano.Ledger.TxIn (TxId, TxIn)
import Cardano.Slotting.Slot (SlotNo)
import Cardano.Tx.Ledger (ConwayTx)
import Control.Exception (Exception)
import Control.Tracer (Tracer)
import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Word (Word32, Word64)
import Singular.Registry.Evidence
    ( Evidenced
    , SessionBinding
    , SessionId
    )
import Singular.Registry.Ledger (Addr)
import Singular.Registry.NetworkTime (NetworkTime, NetworkTimeFailure)
import Singular.Registry.Signing (SignedTx)
import Singular.Registry.Trace (Evaluation, ReadEvent)

-- | Explicit network magic; no process-global network choice.
newtype Network = Network Word32 deriving stock (Network -> Network -> Bool
(Network -> Network -> Bool)
-> (Network -> Network -> Bool) -> Eq Network
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Network -> Network -> Bool
== :: Network -> Network -> Bool
$c/= :: Network -> Network -> Bool
/= :: Network -> Network -> Bool
Eq, Eq Network
Eq Network =>
(Network -> Network -> Ordering)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Bool)
-> (Network -> Network -> Network)
-> (Network -> Network -> Network)
-> Ord Network
Network -> Network -> Bool
Network -> Network -> Ordering
Network -> Network -> Network
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
$ccompare :: Network -> Network -> Ordering
compare :: Network -> Network -> Ordering
$c< :: Network -> Network -> Bool
< :: Network -> Network -> Bool
$c<= :: Network -> Network -> Bool
<= :: Network -> Network -> Bool
$c> :: Network -> Network -> Bool
> :: Network -> Network -> Bool
$c>= :: Network -> Network -> Bool
>= :: Network -> Network -> Bool
$cmax :: Network -> Network -> Network
max :: Network -> Network -> Network
$cmin :: Network -> Network -> Network
min :: Network -> Network -> Network
Ord, Int -> Network -> ShowS
[Network] -> ShowS
Network -> String
(Int -> Network -> ShowS)
-> (Network -> String) -> ([Network] -> ShowS) -> Show Network
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Network -> ShowS
showsPrec :: Int -> Network -> ShowS
$cshow :: Network -> String
show :: Network -> String
$cshowList :: [Network] -> ShowS
showList :: [Network] -> ShowS
Show)

-- | A requested chain point. It does not establish a binding by observation.
data ChainPoint = Genesis | At SlotNo ByteString
    deriving stock (ChainPoint -> ChainPoint -> Bool
(ChainPoint -> ChainPoint -> Bool)
-> (ChainPoint -> ChainPoint -> Bool) -> Eq ChainPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainPoint -> ChainPoint -> Bool
== :: ChainPoint -> ChainPoint -> Bool
$c/= :: ChainPoint -> ChainPoint -> Bool
/= :: ChainPoint -> ChainPoint -> Bool
Eq, Int -> ChainPoint -> ShowS
[ChainPoint] -> ShowS
ChainPoint -> String
(Int -> ChainPoint -> ShowS)
-> (ChainPoint -> String)
-> ([ChainPoint] -> ShowS)
-> Show ChainPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainPoint -> ShowS
showsPrec :: Int -> ChainPoint -> ShowS
$cshow :: ChainPoint -> String
show :: ChainPoint -> String
$cshowList :: [ChainPoint] -> ShowS
showList :: [ChainPoint] -> ShowS
Show)

-- | Acquisition always names its network.
data Acquisition = Latest Network | AtPoint Network ChainPoint
    deriving stock (Acquisition -> Acquisition -> Bool
(Acquisition -> Acquisition -> Bool)
-> (Acquisition -> Acquisition -> Bool) -> Eq Acquisition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Acquisition -> Acquisition -> Bool
== :: Acquisition -> Acquisition -> Bool
$c/= :: Acquisition -> Acquisition -> Bool
/= :: Acquisition -> Acquisition -> Bool
Eq, Int -> Acquisition -> ShowS
[Acquisition] -> ShowS
Acquisition -> String
(Int -> Acquisition -> ShowS)
-> (Acquisition -> String)
-> ([Acquisition] -> ShowS)
-> Show Acquisition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Acquisition -> ShowS
showsPrec :: Int -> Acquisition -> ShowS
$cshow :: Acquisition -> String
show :: Acquisition -> String
$cshowList :: [Acquisition] -> ShowS
showList :: [Acquisition] -> ShowS
Show)

-- | Named acquisition refusal, distinct from an empty query result.
data AcquireFailure
    = WrongNetwork Network Network
    | PointNotSupported ChainPoint
    | AcquisitionReadFailure ReadFailure
    deriving stock (AcquireFailure -> AcquireFailure -> Bool
(AcquireFailure -> AcquireFailure -> Bool)
-> (AcquireFailure -> AcquireFailure -> Bool) -> Eq AcquireFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AcquireFailure -> AcquireFailure -> Bool
== :: AcquireFailure -> AcquireFailure -> Bool
$c/= :: AcquireFailure -> AcquireFailure -> Bool
/= :: AcquireFailure -> AcquireFailure -> Bool
Eq, Int -> AcquireFailure -> ShowS
[AcquireFailure] -> ShowS
AcquireFailure -> String
(Int -> AcquireFailure -> ShowS)
-> (AcquireFailure -> String)
-> ([AcquireFailure] -> ShowS)
-> Show AcquireFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AcquireFailure -> ShowS
showsPrec :: Int -> AcquireFailure -> ShowS
$cshow :: AcquireFailure -> String
show :: AcquireFailure -> String
$cshowList :: [AcquireFailure] -> ShowS
showList :: [AcquireFailure] -> ShowS
Show)

instance Exception AcquireFailure

-- | Read refusals retain the missing/conflicting identity or backend reason.
data ReadFailure
    = ReleasedSession SessionId
    | MissingOutput TxIn
    | ConflictingOutput TxIn
    | BackendReadFailure Text
    | NetworkTimeRefusal NetworkTimeFailure
    deriving stock (ReadFailure -> ReadFailure -> Bool
(ReadFailure -> ReadFailure -> Bool)
-> (ReadFailure -> ReadFailure -> Bool) -> Eq ReadFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadFailure -> ReadFailure -> Bool
== :: ReadFailure -> ReadFailure -> Bool
$c/= :: ReadFailure -> ReadFailure -> Bool
/= :: ReadFailure -> ReadFailure -> Bool
Eq, Int -> ReadFailure -> ShowS
[ReadFailure] -> ShowS
ReadFailure -> String
(Int -> ReadFailure -> ShowS)
-> (ReadFailure -> String)
-> ([ReadFailure] -> ShowS)
-> Show ReadFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadFailure -> ShowS
showsPrec :: Int -> ReadFailure -> ShowS
$cshow :: ReadFailure -> String
show :: ReadFailure -> String
$cshowList :: [ReadFailure] -> ShowS
showList :: [ReadFailure] -> ShowS
Show)

instance Exception ReadFailure

-- | Signed submission's actual backend outcome.
data SubmitResult
    = SubmitAccepted TxId
    | SubmitRefused Text
    | SubmitFailed Text
    | SubmitWrongNetwork Network Network
    deriving stock (SubmitResult -> SubmitResult -> Bool
(SubmitResult -> SubmitResult -> Bool)
-> (SubmitResult -> SubmitResult -> Bool) -> Eq SubmitResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitResult -> SubmitResult -> Bool
== :: SubmitResult -> SubmitResult -> Bool
$c/= :: SubmitResult -> SubmitResult -> Bool
/= :: SubmitResult -> SubmitResult -> Bool
Eq, Int -> SubmitResult -> ShowS
[SubmitResult] -> ShowS
SubmitResult -> String
(Int -> SubmitResult -> ShowS)
-> (SubmitResult -> String)
-> ([SubmitResult] -> ShowS)
-> Show SubmitResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitResult -> ShowS
showsPrec :: Int -> SubmitResult -> ShowS
$cshow :: SubmitResult -> String
show :: SubmitResult -> String
$cshowList :: [SubmitResult] -> ShowS
showList :: [SubmitResult] -> ShowS
Show)

-- | Exact output references and full ledger outputs.
type Outputs = [(TxIn, TxOut ConwayEra)]

-- | A ledger asset, independent of registry interpretation.
type Asset = (PolicyID, AssetName)

-- | Nonempty composed queries; an absent exact reference refuses by name.
data OutputQuery
    = AtAddress Addr
    | HoldingAsset Asset
    | AtTxIn TxIn
    | {- | Live outputs carrying this reference script. An empty answer
      means not found by this provider, never not on chain; a consumer
      checks each candidate's script itself.
      -}
      CarryingReferenceScript ScriptHash
    | AnyOf (NonEmpty OutputQuery)
    | AllOf (NonEmpty OutputQuery)
    deriving stock (OutputQuery -> OutputQuery -> Bool
(OutputQuery -> OutputQuery -> Bool)
-> (OutputQuery -> OutputQuery -> Bool) -> Eq OutputQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputQuery -> OutputQuery -> Bool
== :: OutputQuery -> OutputQuery -> Bool
$c/= :: OutputQuery -> OutputQuery -> Bool
/= :: OutputQuery -> OutputQuery -> Bool
Eq, Int -> OutputQuery -> ShowS
[OutputQuery] -> ShowS
OutputQuery -> String
(Int -> OutputQuery -> ShowS)
-> (OutputQuery -> String)
-> ([OutputQuery] -> ShowS)
-> Show OutputQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputQuery -> ShowS
showsPrec :: Int -> OutputQuery -> ShowS
$cshow :: OutputQuery -> String
show :: OutputQuery -> String
$cshowList :: [OutputQuery] -> ShowS
showList :: [OutputQuery] -> ShowS
Show)

{- | How an asset came to be: the transaction that minted it, every input
that transaction spent, and the asset's current total supply.
-}
data MintRecord = MintRecord
    { MintRecord -> TxId
mintTransaction :: TxId
    , MintRecord -> [TxIn]
mintSpentInputs :: [TxIn]
    , MintRecord -> Integer
mintSupply :: Integer
    }
    deriving stock (MintRecord -> MintRecord -> Bool
(MintRecord -> MintRecord -> Bool)
-> (MintRecord -> MintRecord -> Bool) -> Eq MintRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MintRecord -> MintRecord -> Bool
== :: MintRecord -> MintRecord -> Bool
$c/= :: MintRecord -> MintRecord -> Bool
/= :: MintRecord -> MintRecord -> Bool
Eq, Int -> MintRecord -> ShowS
[MintRecord] -> ShowS
MintRecord -> String
(Int -> MintRecord -> ShowS)
-> (MintRecord -> String)
-> ([MintRecord] -> ShowS)
-> Show MintRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MintRecord -> ShowS
showsPrec :: Int -> MintRecord -> ShowS
$cshow :: MintRecord -> String
show :: MintRecord -> String
$cshowList :: [MintRecord] -> ShowS
showList :: [MintRecord] -> ShowS
Show)

-- | Latest observed block facts, with raw POSIX seconds independent of slots.
data TipObservation = TipObservation
    { TipObservation -> SlotNo
observedSlot :: SlotNo
    , TipObservation -> ByteString
observedHash :: ByteString
    , TipObservation -> Word64
observedHeight :: Word64
    , TipObservation -> Word64
observedBlockTime :: Word64
    }
    deriving stock (TipObservation -> TipObservation -> Bool
(TipObservation -> TipObservation -> Bool)
-> (TipObservation -> TipObservation -> Bool) -> Eq TipObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TipObservation -> TipObservation -> Bool
== :: TipObservation -> TipObservation -> Bool
$c/= :: TipObservation -> TipObservation -> Bool
/= :: TipObservation -> TipObservation -> Bool
Eq, Int -> TipObservation -> ShowS
[TipObservation] -> ShowS
TipObservation -> String
(Int -> TipObservation -> ShowS)
-> (TipObservation -> String)
-> ([TipObservation] -> ShowS)
-> Show TipObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TipObservation -> ShowS
showsPrec :: Int -> TipObservation -> ShowS
$cshow :: TipObservation -> String
show :: TipObservation -> String
$cshowList :: [TipObservation] -> ShowS
showList :: [TipObservation] -> ShowS
Show)

-- | Inclusive block-height bounds; absent bounds leave that side open.
data HistoryRange = HistoryRange
    { HistoryRange -> Maybe Word64
fromHeight :: Maybe Word64
    , HistoryRange -> Maybe Word64
throughHeight :: Maybe Word64
    }
    deriving stock (HistoryRange -> HistoryRange -> Bool
(HistoryRange -> HistoryRange -> Bool)
-> (HistoryRange -> HistoryRange -> Bool) -> Eq HistoryRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HistoryRange -> HistoryRange -> Bool
== :: HistoryRange -> HistoryRange -> Bool
$c/= :: HistoryRange -> HistoryRange -> Bool
/= :: HistoryRange -> HistoryRange -> Bool
Eq, Int -> HistoryRange -> ShowS
[HistoryRange] -> ShowS
HistoryRange -> String
(Int -> HistoryRange -> ShowS)
-> (HistoryRange -> String)
-> ([HistoryRange] -> ShowS)
-> Show HistoryRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HistoryRange -> ShowS
showsPrec :: Int -> HistoryRange -> ShowS
$cshow :: HistoryRange -> String
show :: HistoryRange -> String
$cshowList :: [HistoryRange] -> ShowS
showList :: [HistoryRange] -> ShowS
Show)

-- | History refuses incomplete or inconsistent reconstruction material.
data HistoryFailure
    = HistoryReadFailure ReadFailure
    | HistoryDependencyCycle (NonEmpty TxId)
    | MissingInBlockParent TxId TxId
    | DuplicateSpend TxIn
    | HistoryMaterialMismatch TxId Text
    | HistoryOrderMismatch Word64 Word64
    deriving stock (HistoryFailure -> HistoryFailure -> Bool
(HistoryFailure -> HistoryFailure -> Bool)
-> (HistoryFailure -> HistoryFailure -> Bool) -> Eq HistoryFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HistoryFailure -> HistoryFailure -> Bool
== :: HistoryFailure -> HistoryFailure -> Bool
$c/= :: HistoryFailure -> HistoryFailure -> Bool
/= :: HistoryFailure -> HistoryFailure -> Bool
Eq, Int -> HistoryFailure -> ShowS
[HistoryFailure] -> ShowS
HistoryFailure -> String
(Int -> HistoryFailure -> ShowS)
-> (HistoryFailure -> String)
-> ([HistoryFailure] -> ShowS)
-> Show HistoryFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HistoryFailure -> ShowS
showsPrec :: Int -> HistoryFailure -> ShowS
$cshow :: HistoryFailure -> String
show :: HistoryFailure -> String
$cshowList :: [HistoryFailure] -> ShowS
showList :: [HistoryFailure] -> ShowS
Show)

instance Exception HistoryFailure

{- | Complete CBOR plus resolved inputs, references and outputs, with validity.
These are reconstruction material, without an evidence verdict.
-}
data HistoricalTransaction = HistoricalTransaction
    { HistoricalTransaction -> TxId
historicalId :: TxId
    , HistoricalTransaction -> ByteString
historicalCbor :: ByteString
    , HistoricalTransaction -> ConwayTx
historicalTx :: ConwayTx
    , HistoricalTransaction -> Outputs
spentOutputs :: Outputs
    , HistoricalTransaction -> Outputs
referenceOutputs :: Outputs
    , HistoricalTransaction -> Outputs
createdOutputs :: Outputs
    , HistoricalTransaction -> Bool
scriptValid :: Bool
    }

-- | One complete block, in creator-before-spender order within its height.
data HistoryBlock = HistoryBlock
    { HistoryBlock -> Word64
blockHeight :: Word64
    , HistoryBlock -> NonEmpty HistoricalTransaction
blockTransactions :: NonEmpty HistoricalTransaction
    }

-- | Deferred complete-block consumption; never joins the entire history first.
newtype HistoryStream m = HistoryStream
    { forall (m :: * -> *).
HistoryStream m
-> m (Either
        HistoryFailure (Maybe (HistoryBlock, HistoryStream m)))
nextBlock
        :: m (Either HistoryFailure (Maybe (HistoryBlock, HistoryStream m)))
    }

-- | Facts consumed within one acquired scope and its named network.
data Session w m = Session
    { forall w (m :: * -> *). Session w m -> Network
sessionNetwork :: Network
    , forall w (m :: * -> *). Session w m -> SessionId
sessionId :: SessionId
    , forall w (m :: * -> *). Session w m -> SessionBinding
sessionBinding :: SessionBinding
    , forall w (m :: * -> *). Session w m -> Tracer m ReadEvent
sessionTracer :: Tracer m ReadEvent
    {- ^ Where the local services report what they do under this session:
    the tracer of the scope that acquired it
    -}
    , forall w (m :: * -> *). Session w m -> Evaluation -> m ()
sessionEvaluated :: Evaluation -> m ()
    {- ^ Where the local evaluator records the outcome of each evaluation under
    this session, typed: the build that owns the session reads it to say
    whether its scripts failed. Not a tracer: nothing renders it.
    -}
    , forall w (m :: * -> *).
Session w m
-> OutputQuery -> m (Either ReadFailure (Evidenced w Outputs))
outputs :: OutputQuery -> m (Either ReadFailure (Evidenced w Outputs))
    , forall w (m :: * -> *).
Session w m
-> m (Either ReadFailure (Evidenced w (PParams ConwayEra)))
protocolParameters
        :: m (Either ReadFailure (Evidenced w (PParams ConwayEra)))
    , forall w (m :: * -> *).
Session w m -> m (Either ReadFailure (Evidenced w TipObservation))
tipObservation :: m (Either ReadFailure (Evidenced w TipObservation))
    , forall w (m :: * -> *).
Session w m -> m (Either ReadFailure (Evidenced w NetworkTime))
networkTime :: m (Either ReadFailure (Evidenced w NetworkTime))
    , forall w (m :: * -> *).
Session w m
-> ScriptHash -> m (Either ReadFailure (Evidenced w Bool))
scriptRegistered
        :: ScriptHash -> m (Either ReadFailure (Evidenced w Bool))
    , forall w (m :: * -> *).
Session w m
-> Asset -> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
mintRecord
        :: Asset -> m (Either ReadFailure (Evidenced w (Maybe MintRecord)))
    -- ^ No record for an asset the provider does not know
    , forall w (m :: * -> *).
Session w m
-> Asset
-> HistoryRange
-> m (Either HistoryFailure (HistoryStream m))
history
        :: Asset -> HistoryRange -> m (Either HistoryFailure (HistoryStream m))
    }

-- | Reading and signed submission in the caller's monad and witness domain.
data LedgerProvider w m = LedgerProvider
    { forall w (m :: * -> *).
LedgerProvider w m
-> forall a.
   Acquisition -> (Session w m -> m a) -> m (Either AcquireFailure a)
acquire
        :: forall a
         . Acquisition -> (Session w m -> m a) -> m (Either AcquireFailure a)
    , forall w (m :: * -> *).
LedgerProvider w m -> Network -> SignedTx -> m SubmitResult
submitTx :: Network -> SignedTx -> m SubmitResult
    }