{- | The common node/proof engine. Backend effects only fetch and persist a
registry entry. Snapshot reads and speculation use captured immutable nodes.
-}
module Singular.Registry.TrieState.Core
    ( TrieEntry (..)
    , capability
    , capabilityObserved
    , checkedCoverage
    , walkNodes
    , provenLeaf
    , snapshotObserved
    ) where

import Control.Monad (foldM)
import Control.Monad.State.Strict (runState)
import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import MPF.Backend.Pure (MPFInMemoryDB, emptyMPFInMemoryDB)
import MPF.Verify (verifyAikenInclusionProof)
import Singular.Registry.Ledger (Root (..))
import Singular.Registry.Trie.Pure
    ( exclusionFromDb
    , membershipFromDb
    , provesAbsent
    , provesMember
    , rootFromDb
    , stateTrie
    )
import Singular.Registry.TrieState.Types
import Singular.Registry.TxBuilder.Internal.Edges (walkEdge)

data TrieEntry = TrieEntry
    { TrieEntry -> TrieSelection
entrySelection :: TrieSelection
    , TrieEntry -> Maybe CreateRecord
entryCreate :: Maybe CreateRecord
    , TrieEntry -> [ObservedFold]
entryFolds :: [ObservedFold]
    , TrieEntry -> MPFInMemoryDB
entryNodes :: MPFInMemoryDB
    }

walkNodes
    :: RegistryIdentity
    -> MPFInMemoryDB
    -> NonEmpty (ByteString, Integer)
    -> Either TrieFailure (MPFInMemoryDB, SpeculativeWalk)
walkNodes :: RegistryIdentity
-> MPFInMemoryDB
-> NonEmpty (ByteString, Integer)
-> Either TrieFailure (MPFInMemoryDB, SpeculativeWalk)
walkNodes RegistryIdentity
who MPFInMemoryDB
db NonEmpty (ByteString, Integer)
moves
    | (ByteString
_, Integer
edge) : [(ByteString, Integer)]
_ <- ((ByteString, Integer) -> Bool)
-> [(ByteString, Integer)] -> [(ByteString, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ByteString
_, Integer
e) -> Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
6) (NonEmpty (ByteString, Integer) -> [(ByteString, Integer)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (ByteString, Integer)
moves) =
        TrieFailure -> Either TrieFailure (MPFInMemoryDB, SpeculativeWalk)
forall a b. a -> Either a b
Left (RegistryIdentity -> Maybe TxId -> Undecodable -> TrieFailure
UndecodableRequest RegistryIdentity
who Maybe TxId
forall a. Maybe a
Nothing (Integer -> Undecodable
EdgeOutOfRange Integer
edge))
    | Bool
otherwise = do
        (changed, reversed) <- ((MPFInMemoryDB, [[ProofStep]])
 -> (ByteString, Integer)
 -> Either TrieFailure (MPFInMemoryDB, [[ProofStep]]))
-> (MPFInMemoryDB, [[ProofStep]])
-> [(ByteString, Integer)]
-> Either TrieFailure (MPFInMemoryDB, [[ProofStep]])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (MPFInMemoryDB, [[ProofStep]])
-> (ByteString, Integer)
-> Either TrieFailure (MPFInMemoryDB, [[ProofStep]])
step (MPFInMemoryDB
db, []) (NonEmpty (ByteString, Integer) -> [(ByteString, Integer)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (ByteString, Integer)
moves)
        Right
            (changed, SpeculativeWalk (rootFromDb changed) (reverse reversed))
  where
    step :: (MPFInMemoryDB, [[ProofStep]])
-> (ByteString, Integer)
-> Either TrieFailure (MPFInMemoryDB, [[ProofStep]])
step (MPFInMemoryDB
before, [[ProofStep]]
proofs) (ByteString
key, Integer
edge) = do
        let ([ProofStep]
proof, MPFInMemoryDB
after) = State MPFInMemoryDB [ProofStep]
-> MPFInMemoryDB -> ([ProofStep], MPFInMemoryDB)
forall s a. State s a -> s -> (a, s)
runState (Trie (StateT MPFInMemoryDB Identity)
-> ByteString -> Integer -> State MPFInMemoryDB [ProofStep]
forall (m :: * -> *).
Monad m =>
Trie m -> ByteString -> Integer -> m [ProofStep]
walkEdge Trie (StateT MPFInMemoryDB Identity)
stateTrie ByteString
key Integer
edge) MPFInMemoryDB
before
            proofNodes :: MPFInMemoryDB
proofNodes = if Integer
edge Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then MPFInMemoryDB
after else MPFInMemoryDB
before
        -- A singleton's legitimate proof has zero steps. Check the actual
        -- producer's Maybe instead of treating every empty list as missing.
        case MPFInMemoryDB -> ByteString -> Maybe ByteString
membershipFromDb MPFInMemoryDB
proofNodes ByteString
key of
            Maybe ByteString
Nothing -> TrieFailure -> Either TrieFailure (MPFInMemoryDB, [[ProofStep]])
forall a b. a -> Either a b
Left (RegistryIdentity -> Missing -> TrieFailure
MissingProof RegistryIdentity
who (ByteString -> Missing
NoProofFor ByteString
key))
            Just ByteString
_ -> (MPFInMemoryDB, [[ProofStep]])
-> Either TrieFailure (MPFInMemoryDB, [[ProofStep]])
forall a b. b -> Either a b
Right (MPFInMemoryDB
after, [ProofStep]
proof [ProofStep] -> [[ProofStep]] -> [[ProofStep]]
forall a. a -> [a] -> [a]
: [[ProofStep]]
proofs)

provenLeaf
    :: RegistryIdentity
    -> MPFInMemoryDB
    -> Root
    -> ByteString
    -> Either TrieFailure Leaf
provenLeaf :: RegistryIdentity
-> MPFInMemoryDB -> Root -> ByteString -> Either TrieFailure Leaf
provenLeaf RegistryIdentity
who MPFInMemoryDB
db (Root ByteString
root) ByteString
key =
    case [ Leaf
leaf
         | Leaf
leaf <- [Leaf
Absent, Leaf
Active, Leaf
Terminal]
         , MPFInMemoryDB -> ByteString -> ByteString -> ByteString -> Bool
provesMember MPFInMemoryDB
db ByteString
root ByteString
key (Leaf -> ByteString
leafBytes Leaf
leaf)
         ] of
        [Leaf
leaf] -> Leaf -> Either TrieFailure Leaf
forall a b. b -> Either a b
Right Leaf
leaf
        [] | MPFInMemoryDB -> ByteString -> ByteString -> Bool
provesAbsent MPFInMemoryDB
db ByteString
root ByteString
key -> Leaf -> Either TrieFailure Leaf
forall a b. b -> Either a b
Right Leaf
Unknown
        [Leaf]
_ -> TrieFailure -> Either TrieFailure Leaf
forall a b. a -> Either a b
Left (RegistryIdentity -> Missing -> TrieFailure
MissingProof RegistryIdentity
who (ByteString -> Missing
NoProofFor ByteString
key))

{- | Replay starts from the actual empty MPF database. Root-preserving history
records are neither required nor counted. The selected output is a separate
caller-session observation; coverage does not claim output-reference lineage.
-}
checkedCoverage :: TrieEntry -> Either TrieFailure CompleteFromCreate
checkedCoverage :: TrieEntry -> Either TrieFailure CompleteFromCreate
checkedCoverage TrieEntry{[ObservedFold]
Maybe CreateRecord
MPFInMemoryDB
TrieSelection
entrySelection :: TrieEntry -> TrieSelection
entryCreate :: TrieEntry -> Maybe CreateRecord
entryFolds :: TrieEntry -> [ObservedFold]
entryNodes :: TrieEntry -> MPFInMemoryDB
entrySelection :: TrieSelection
entryCreate :: Maybe CreateRecord
entryFolds :: [ObservedFold]
entryNodes :: MPFInMemoryDB
..} = do
    case Maybe CreateRecord
entryCreate of
        Maybe CreateRecord
Nothing -> TrieFailure -> Either TrieFailure ()
forall a b. a -> Either a b
Left (RegistryIdentity -> Maybe TxId -> Incomplete -> TrieFailure
HistoryIncomplete RegistryIdentity
who Maybe TxId
forall a. Maybe a
Nothing Incomplete
MissingTransaction)
        Just (CreateRecord RegistryIdentity
other TxIn
_)
            | RegistryIdentity
other RegistryIdentity -> RegistryIdentity -> Bool
forall a. Eq a => a -> a -> Bool
/= RegistryIdentity
who ->
                TrieFailure -> Either TrieFailure ()
forall a b. a -> Either a b
Left (RegistryIdentity -> Maybe TxId -> Mismatch -> TrieFailure
WrongRegistry RegistryIdentity
who Maybe TxId
forall a. Maybe a
Nothing (RegistryIdentity -> Mismatch
OtherRegistry RegistryIdentity
other))
        Just CreateRecord
_ -> () -> Either TrieFailure ()
forall a b. b -> Either a b
Right ()
    (replayed, count) <- ((MPFInMemoryDB, Int)
 -> ObservedFold -> Either TrieFailure (MPFInMemoryDB, Int))
-> (MPFInMemoryDB, Int)
-> [ObservedFold]
-> Either TrieFailure (MPFInMemoryDB, Int)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (MPFInMemoryDB, Int)
-> ObservedFold -> Either TrieFailure (MPFInMemoryDB, Int)
forall {b}.
Num b =>
(MPFInMemoryDB, b)
-> ObservedFold -> Either TrieFailure (MPFInMemoryDB, b)
replay (MPFInMemoryDB
emptyMPFInMemoryDB, Int
0) [ObservedFold]
entryFolds
    if rootFromDb replayed /= selected
        then Left (HistoryIncomplete who Nothing MissingTransaction)
        else
            if rootFromDb entryNodes /= selected
                then
                    Left
                        ( RootDoesNotChain
                            who
                            Nothing
                            (RootsPart (rootFromDb entryNodes) selected)
                        )
                else Right (CompleteFromCreate count)
  where
    who :: RegistryIdentity
who = TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
entrySelection
    selected :: Root
selected = TrieSelection -> Root
trieSelectionRoot TrieSelection
entrySelection
    replay :: (MPFInMemoryDB, b)
-> ObservedFold -> Either TrieFailure (MPFInMemoryDB, b)
replay (MPFInMemoryDB
db, b
count) (ObservedFold TrieSelection
from TrieSelection
to NonEmpty (ByteString, Integer)
edges)
        | TrieSelection -> Root
trieSelectionRoot TrieSelection
from Root -> Root -> Bool
forall a. Eq a => a -> a -> Bool
== TrieSelection -> Root
trieSelectionRoot TrieSelection
to = (MPFInMemoryDB, b) -> Either TrieFailure (MPFInMemoryDB, b)
forall a b. b -> Either a b
Right (MPFInMemoryDB
db, b
count)
        | RegistryIdentity
other : [RegistryIdentity]
_ <-
            (RegistryIdentity -> Bool)
-> [RegistryIdentity] -> [RegistryIdentity]
forall a. (a -> Bool) -> [a] -> [a]
filter (RegistryIdentity -> RegistryIdentity -> Bool
forall a. Eq a => a -> a -> Bool
/= RegistryIdentity
who) [TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
from, TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
to] =
            TrieFailure -> Either TrieFailure (MPFInMemoryDB, b)
forall a b. a -> Either a b
Left (RegistryIdentity -> Maybe TxId -> Mismatch -> TrieFailure
WrongRegistry RegistryIdentity
who Maybe TxId
forall a. Maybe a
Nothing (RegistryIdentity -> Mismatch
OtherRegistry RegistryIdentity
other))
        | TrieSelection -> Root
trieSelectionRoot TrieSelection
from Root -> Root -> Bool
forall a. Eq a => a -> a -> Bool
/= MPFInMemoryDB -> Root
rootFromDb MPFInMemoryDB
db =
            TrieFailure -> Either TrieFailure (MPFInMemoryDB, b)
forall a b. a -> Either a b
Left
                ( RegistryIdentity -> Maybe TxId -> Parting -> TrieFailure
RootDoesNotChain
                    RegistryIdentity
who
                    Maybe TxId
forall a. Maybe a
Nothing
                    (Root -> Root -> Parting
RootsPart (MPFInMemoryDB -> Root
rootFromDb MPFInMemoryDB
db) (TrieSelection -> Root
trieSelectionRoot TrieSelection
from))
                )
        | Bool
otherwise = do
            (changed, walked) <- RegistryIdentity
-> MPFInMemoryDB
-> NonEmpty (ByteString, Integer)
-> Either TrieFailure (MPFInMemoryDB, SpeculativeWalk)
walkNodes RegistryIdentity
who MPFInMemoryDB
db NonEmpty (ByteString, Integer)
edges
            if walkRoot walked == trieSelectionRoot to
                then Right (changed, count + 1)
                else
                    Left
                        ( RootDoesNotChain
                            who
                            Nothing
                            (RootsPart (walkRoot walked) (trieSelectionRoot to))
                        )

capability
    :: (Monad m)
    => (RegistryIdentity -> m (Either TrieFailure TrieEntry))
    -> (TrieEntry -> m ())
    -> TrieState m
capability :: forall (m :: * -> *).
Monad m =>
(RegistryIdentity -> m (Either TrieFailure TrieEntry))
-> (TrieEntry -> m ()) -> TrieState m
capability RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch TrieEntry -> m ()
persist = (RegistryIdentity -> m (Either TrieFailure TrieEntry))
-> (TrieEntry -> m ()) -> (TrieObservation -> m ()) -> TrieState m
forall (m :: * -> *).
Monad m =>
(RegistryIdentity -> m (Either TrieFailure TrieEntry))
-> (TrieEntry -> m ()) -> (TrieObservation -> m ()) -> TrieState m
capabilityObserved RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch TrieEntry -> m ()
persist (m () -> TrieObservation -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

-- The observer is optional evidence, after the actual computation. State
-- supplies no effects; the IO mirror supplies only its bounded harness writer.
capabilityObserved
    :: (Monad m)
    => (RegistryIdentity -> m (Either TrieFailure TrieEntry))
    -> (TrieEntry -> m ())
    -> (TrieObservation -> m ())
    -> TrieState m
capabilityObserved :: forall (m :: * -> *).
Monad m =>
(RegistryIdentity -> m (Either TrieFailure TrieEntry))
-> (TrieEntry -> m ()) -> (TrieObservation -> m ()) -> TrieState m
capabilityObserved RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch TrieEntry -> m ()
persist TrieObservation -> m ()
emit = (forall a.
 TrieSelection
 -> (TrieSnapshot m -> m a) -> m (Either TrieFailure a))
-> (ObservedFold -> m (Either TrieFailure ())) -> TrieState m
forall (m :: * -> *).
(forall a.
 TrieSelection
 -> (TrieSnapshot m -> m a) -> m (Either TrieFailure a))
-> (ObservedFold -> m (Either TrieFailure ())) -> TrieState m
TrieState TrieSelection
-> (TrieSnapshot m -> m a) -> m (Either TrieFailure a)
forall a.
TrieSelection
-> (TrieSnapshot m -> m a) -> m (Either TrieFailure a)
select ObservedFold -> m (Either TrieFailure ())
accept
  where
    select :: TrieSelection
-> (TrieSnapshot m -> m b) -> m (Either TrieFailure b)
select TrieSelection
chosen TrieSnapshot m -> m b
use = do
        found <- RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
chosen)
        case found >>= validate chosen of
            Left TrieFailure
why -> Either TrieFailure b -> m (Either TrieFailure b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TrieFailure -> Either TrieFailure b
forall a b. a -> Either a b
Left TrieFailure
why)
            Right (TrieEntry
entry, CompleteFromCreate
coverage) -> do
                TrieObservation -> m ()
emit (TrieSelection -> TrieObservation
Selected (TrieEntry -> TrieSelection
entrySelection TrieEntry
entry))
                b -> Either TrieFailure b
forall a b. b -> Either a b
Right
                    (b -> Either TrieFailure b) -> m b -> m (Either TrieFailure b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TrieSnapshot m -> m b
use
                        ( (TrieObservation -> m ())
-> TrieSelection
-> MPFInMemoryDB
-> CompleteFromCreate
-> Maybe PublicLineage
-> TrieSnapshot m
forall (m :: * -> *).
Monad m =>
(TrieObservation -> m ())
-> TrieSelection
-> MPFInMemoryDB
-> CompleteFromCreate
-> Maybe PublicLineage
-> TrieSnapshot m
snapshotObserved
                            TrieObservation -> m ()
emit
                            (TrieEntry -> TrieSelection
entrySelection TrieEntry
entry)
                            (TrieEntry -> MPFInMemoryDB
entryNodes TrieEntry
entry)
                            CompleteFromCreate
coverage
                            Maybe PublicLineage
forall a. Maybe a
Nothing
                        )
    validate :: TrieSelection
-> TrieEntry -> Either TrieFailure (TrieEntry, CompleteFromCreate)
validate TrieSelection
chosen TrieEntry
entry
        | TrieSelection
chosen TrieSelection -> TrieSelection -> Bool
forall a. Eq a => a -> a -> Bool
/= TrieEntry -> TrieSelection
entrySelection TrieEntry
entry =
            TrieFailure -> Either TrieFailure (TrieEntry, CompleteFromCreate)
forall a b. a -> Either a b
Left
                ( RegistryIdentity -> Maybe TxId -> Staleness -> TrieFailure
StaleState
                    (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
chosen)
                    Maybe TxId
forall a. Maybe a
Nothing
                    (TrieSelection -> TrieSelection -> Staleness
StaleSelection TrieSelection
chosen (TrieEntry -> TrieSelection
entrySelection TrieEntry
entry))
                )
        | Bool
otherwise = (TrieEntry
entry,) (CompleteFromCreate -> (TrieEntry, CompleteFromCreate))
-> Either TrieFailure CompleteFromCreate
-> Either TrieFailure (TrieEntry, CompleteFromCreate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TrieEntry -> Either TrieFailure CompleteFromCreate
checkedCoverage TrieEntry
entry
    accept :: ObservedFold -> m (Either TrieFailure ())
accept event :: ObservedFold
event@(ObservedFold TrieSelection
from TrieSelection
to NonEmpty (ByteString, Integer)
edges) = do
        found <- RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
from)
        case found >>= advance event from to edges of
            Left TrieFailure
why -> Either TrieFailure () -> m (Either TrieFailure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TrieFailure -> Either TrieFailure ()
forall a b. a -> Either a b
Left TrieFailure
why)
            Right Maybe TrieEntry
Nothing -> TrieObservation -> m ()
emit (TrieSelection -> TrieSelection -> TrieObservation
FoldAccepted TrieSelection
from TrieSelection
to) m () -> m (Either TrieFailure ()) -> m (Either TrieFailure ())
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either TrieFailure () -> m (Either TrieFailure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either TrieFailure ()
forall a b. b -> Either a b
Right ())
            Right (Just TrieEntry
changed) -> do
                TrieEntry -> m ()
persist TrieEntry
changed
                TrieObservation -> m ()
emit (TrieSelection -> TrieSelection -> TrieObservation
FoldAccepted TrieSelection
from (TrieEntry -> TrieSelection
entrySelection TrieEntry
changed))
                Either TrieFailure () -> m (Either TrieFailure ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either TrieFailure ()
forall a b. b -> Either a b
Right ())
    advance :: ObservedFold
-> TrieSelection
-> TrieSelection
-> NonEmpty (ByteString, Integer)
-> TrieEntry
-> Either TrieFailure (Maybe TrieEntry)
advance ObservedFold
event TrieSelection
from TrieSelection
to NonEmpty (ByteString, Integer)
edges TrieEntry
entry
        | TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
from RegistryIdentity -> RegistryIdentity -> Bool
forall a. Eq a => a -> a -> Bool
/= TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
to =
            TrieFailure -> Either TrieFailure (Maybe TrieEntry)
forall a b. a -> Either a b
Left
                ( RegistryIdentity -> Maybe TxId -> Mismatch -> TrieFailure
WrongRegistry
                    (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
from)
                    Maybe TxId
forall a. Maybe a
Nothing
                    (RegistryIdentity -> Mismatch
OtherRegistry (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
to))
                )
        | ObservedFold
event ObservedFold -> [ObservedFold] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TrieEntry -> [ObservedFold]
entryFolds TrieEntry
entry Bool -> Bool -> Bool
&& TrieEntry -> TrieSelection
entrySelection TrieEntry
entry TrieSelection -> TrieSelection -> Bool
forall a. Eq a => a -> a -> Bool
== TrieSelection
to =
            Maybe TrieEntry -> Either TrieFailure (Maybe TrieEntry)
forall a b. b -> Either a b
Right Maybe TrieEntry
forall a. Maybe a
Nothing
        | TrieEntry -> TrieSelection
entrySelection TrieEntry
entry TrieSelection -> TrieSelection -> Bool
forall a. Eq a => a -> a -> Bool
/= TrieSelection
from =
            TrieFailure -> Either TrieFailure (Maybe TrieEntry)
forall a b. a -> Either a b
Left
                ( RegistryIdentity -> Maybe TxId -> Staleness -> TrieFailure
StaleState
                    (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
from)
                    Maybe TxId
forall a. Maybe a
Nothing
                    (TrieSelection -> TrieSelection -> Staleness
StaleSelection TrieSelection
from (TrieEntry -> TrieSelection
entrySelection TrieEntry
entry))
                )
        | Bool
otherwise = do
            _ <- TrieEntry -> Either TrieFailure CompleteFromCreate
checkedCoverage TrieEntry
entry
            (nodes, walked) <-
                walkNodes (trieSelectionIdentity from) (entryNodes entry) edges
            if walkRoot walked /= trieSelectionRoot to
                then
                    Left
                        ( RootDoesNotChain
                            (trieSelectionIdentity from)
                            Nothing
                            (RootsPart (walkRoot walked) (trieSelectionRoot to))
                        )
                else
                    Right
                        ( Just
                            entry
                                { entrySelection = to
                                , entryNodes = nodes
                                , entryFolds = entryFolds entry <> [event]
                                }
                        )

snapshotObserved
    :: (Monad m)
    => (TrieObservation -> m ())
    -> TrieSelection
    -> MPFInMemoryDB
    -> CompleteFromCreate
    -> Maybe PublicLineage
    -> TrieSnapshot m
snapshotObserved :: forall (m :: * -> *).
Monad m =>
(TrieObservation -> m ())
-> TrieSelection
-> MPFInMemoryDB
-> CompleteFromCreate
-> Maybe PublicLineage
-> TrieSnapshot m
snapshotObserved TrieObservation -> m ()
emit TrieSelection
entrySelection MPFInMemoryDB
entryNodes CompleteFromCreate
coverage Maybe PublicLineage
lineage =
    let who :: RegistryIdentity
who = TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
entrySelection
        noProof :: ByteString -> Either TrieFailure b
noProof ByteString
key = TrieFailure -> Either TrieFailure b
forall a b. a -> Either a b
Left (RegistryIdentity -> Missing -> TrieFailure
MissingProof RegistryIdentity
who (ByteString -> Missing
NoProofFor ByteString
key))
    in  TrieSnapshot
            { snapshotTrieIdentity :: RegistryIdentity
snapshotTrieIdentity = TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
entrySelection
            , snapshotTriePoint :: StatePoint
snapshotTriePoint = TrieSelection -> StatePoint
trieSelectionPoint TrieSelection
entrySelection
            , snapshotTrieRoot :: Root
snapshotTrieRoot = TrieSelection -> Root
trieSelectionRoot TrieSelection
entrySelection
            , snapshotTrieCoverage :: CompleteFromCreate
snapshotTrieCoverage = CompleteFromCreate
coverage
            , snapshotTrieLineage :: Maybe PublicLineage
snapshotTrieLineage = Maybe PublicLineage
lineage
            , snapshotLeafAt :: ByteString -> m (Either TrieFailure Leaf)
snapshotLeafAt = \ByteString
key ->
                (TrieObservation -> m ())
-> Either TrieFailure Leaf
-> (Leaf -> TrieObservation)
-> m (Either TrieFailure Leaf)
forall (m :: * -> *) a.
Monad m =>
(TrieObservation -> m ())
-> Either TrieFailure a
-> (a -> TrieObservation)
-> m (Either TrieFailure a)
recordResult
                    TrieObservation -> m ()
emit
                    (RegistryIdentity
-> MPFInMemoryDB -> Root -> ByteString -> Either TrieFailure Leaf
provenLeaf RegistryIdentity
who MPFInMemoryDB
entryNodes (TrieSelection -> Root
trieSelectionRoot TrieSelection
entrySelection) ByteString
key)
                    (TrieSelection -> ByteString -> Leaf -> TrieObservation
LeafRead TrieSelection
entrySelection ByteString
key)
            , snapshotMembership :: ByteString -> Leaf -> m (Either TrieFailure MembershipProof)
snapshotMembership = \ByteString
key Leaf
leaf ->
                (TrieObservation -> m ())
-> Either TrieFailure MembershipProof
-> (MembershipProof -> TrieObservation)
-> m (Either TrieFailure MembershipProof)
forall (m :: * -> *) a.
Monad m =>
(TrieObservation -> m ())
-> Either TrieFailure a
-> (a -> TrieObservation)
-> m (Either TrieFailure a)
recordResult
                    TrieObservation -> m ()
emit
                    ( do
                        bytes <-
                            Either TrieFailure ByteString
-> (ByteString -> Either TrieFailure ByteString)
-> Maybe ByteString
-> Either TrieFailure ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Either TrieFailure ByteString
forall {b}. ByteString -> Either TrieFailure b
noProof ByteString
key) ByteString -> Either TrieFailure ByteString
forall a b. b -> Either a b
Right (MPFInMemoryDB -> ByteString -> Maybe ByteString
membershipFromDb MPFInMemoryDB
entryNodes ByteString
key)
                        if leaf /= Unknown
                            && verifyAikenInclusionProof
                                (unRoot (trieSelectionRoot entrySelection))
                                key
                                (leafBytes leaf)
                                bytes
                            then Right (MembershipProof bytes)
                            else noProof key
                    )
                    (TrieSelection
-> ByteString -> Leaf -> ByteString -> TrieObservation
MemberProved TrieSelection
entrySelection ByteString
key Leaf
leaf (ByteString -> TrieObservation)
-> (MembershipProof -> ByteString)
-> MembershipProof
-> TrieObservation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MembershipProof -> ByteString
membershipBytes)
            , snapshotNonMembership :: ByteString -> m (Either TrieFailure NonMembershipProof)
snapshotNonMembership = \ByteString
key ->
                (TrieObservation -> m ())
-> Either TrieFailure NonMembershipProof
-> (NonMembershipProof -> TrieObservation)
-> m (Either TrieFailure NonMembershipProof)
forall (m :: * -> *) a.
Monad m =>
(TrieObservation -> m ())
-> Either TrieFailure a
-> (a -> TrieObservation)
-> m (Either TrieFailure a)
recordResult
                    TrieObservation -> m ()
emit
                    ( do
                        if MPFInMemoryDB -> ByteString -> ByteString -> Bool
provesAbsent
                            MPFInMemoryDB
entryNodes
                            (Root -> ByteString
unRoot (TrieSelection -> Root
trieSelectionRoot TrieSelection
entrySelection))
                            ByteString
key
                            then
                                ByteString -> MPFExclusionProof MPFHash -> NonMembershipProof
NonMembershipProof ByteString
key
                                    (MPFExclusionProof MPFHash -> NonMembershipProof)
-> Either TrieFailure (MPFExclusionProof MPFHash)
-> Either TrieFailure NonMembershipProof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either TrieFailure (MPFExclusionProof MPFHash)
-> (MPFExclusionProof MPFHash
    -> Either TrieFailure (MPFExclusionProof MPFHash))
-> Maybe (MPFExclusionProof MPFHash)
-> Either TrieFailure (MPFExclusionProof MPFHash)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Either TrieFailure (MPFExclusionProof MPFHash)
forall {b}. ByteString -> Either TrieFailure b
noProof ByteString
key) MPFExclusionProof MPFHash
-> Either TrieFailure (MPFExclusionProof MPFHash)
forall a b. b -> Either a b
Right (MPFInMemoryDB -> ByteString -> Maybe (MPFExclusionProof MPFHash)
exclusionFromDb MPFInMemoryDB
entryNodes ByteString
key)
                            else ByteString -> Either TrieFailure NonMembershipProof
forall {b}. ByteString -> Either TrieFailure b
noProof ByteString
key
                    )
                    (TrieObservation -> NonMembershipProof -> TrieObservation
forall a b. a -> b -> a
const (TrieSelection -> ByteString -> TrieObservation
AbsenceProved TrieSelection
entrySelection ByteString
key))
            , snapshotSpeculateEdges :: NonEmpty (ByteString, Integer)
-> m (Either TrieFailure SpeculativeWalk)
snapshotSpeculateEdges = \NonEmpty (ByteString, Integer)
moves ->
                (TrieObservation -> m ())
-> Either TrieFailure SpeculativeWalk
-> (SpeculativeWalk -> TrieObservation)
-> m (Either TrieFailure SpeculativeWalk)
forall (m :: * -> *) a.
Monad m =>
(TrieObservation -> m ())
-> Either TrieFailure a
-> (a -> TrieObservation)
-> m (Either TrieFailure a)
recordResult
                    TrieObservation -> m ()
emit
                    (((MPFInMemoryDB, SpeculativeWalk) -> SpeculativeWalk)
-> Either TrieFailure (MPFInMemoryDB, SpeculativeWalk)
-> Either TrieFailure SpeculativeWalk
forall a b.
(a -> b) -> Either TrieFailure a -> Either TrieFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MPFInMemoryDB, SpeculativeWalk) -> SpeculativeWalk
forall a b. (a, b) -> b
snd (RegistryIdentity
-> MPFInMemoryDB
-> NonEmpty (ByteString, Integer)
-> Either TrieFailure (MPFInMemoryDB, SpeculativeWalk)
walkNodes RegistryIdentity
who MPFInMemoryDB
entryNodes NonEmpty (ByteString, Integer)
moves))
                    (TrieSelection -> SpeculativeWalk -> TrieObservation
Speculated TrieSelection
entrySelection)
            }

recordResult
    :: (Monad m)
    => (TrieObservation -> m ())
    -> Either TrieFailure a
    -> (a -> TrieObservation)
    -> m (Either TrieFailure a)
recordResult :: forall (m :: * -> *) a.
Monad m =>
(TrieObservation -> m ())
-> Either TrieFailure a
-> (a -> TrieObservation)
-> m (Either TrieFailure a)
recordResult TrieObservation -> m ()
emit Either TrieFailure a
result a -> TrieObservation
describe = do
    case Either TrieFailure a
result of
        Left TrieFailure
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Right a
value -> TrieObservation -> m ()
emit (a -> TrieObservation
describe a
value)
    Either TrieFailure a -> m (Either TrieFailure a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either TrieFailure a
result