{- | A genuine State adapter over real MPF nodes and recorded fixture history.
Fixture identities are application inputs, never observations of a ledger.
-}
module Singular.Registry.TrieState.Fixture
    ( FixtureStore
    , fixtureStore
    , fixtureTrieState
    , fixtureNodes
    , fixtureFolds
    , fixtureSnapshot
    ) where

import Control.Monad.State.Strict (State, gets, modify')
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import MPF.Backend.Pure (MPFInMemoryDB)
import Singular.Registry.TrieState
import Singular.Registry.TrieState.Core
    ( TrieEntry (..)
    , capability
    , checkedCoverage
    , snapshotObserved
    )

{- | A checked immutable fixture snapshot in the consumer's effect. This
carries no provider or ledger admission claim.
-}
fixtureSnapshot
    :: (Monad m)
    => FixtureStore -> TrieSelection -> Either TrieFailure (TrieSnapshot m)
fixtureSnapshot :: forall (m :: * -> *).
Monad m =>
FixtureStore
-> TrieSelection -> Either TrieFailure (TrieSnapshot m)
fixtureSnapshot (FixtureStore Map RegistryIdentity TrieEntry
entries) TrieSelection
chosen = do
    entry <-
        Either TrieFailure TrieEntry
-> (TrieEntry -> Either TrieFailure TrieEntry)
-> Maybe TrieEntry
-> Either TrieFailure TrieEntry
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ( TrieFailure -> Either TrieFailure TrieEntry
forall a b. a -> Either a b
Left
                (RegistryIdentity -> Maybe TxId -> Mismatch -> TrieFailure
WrongRegistry (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
chosen) Maybe TxId
forall a. Maybe a
Nothing Mismatch
UnknownRegistry)
            )
            TrieEntry -> Either TrieFailure TrieEntry
forall a b. b -> Either a b
Right
            (RegistryIdentity
-> Map RegistryIdentity TrieEntry -> Maybe TrieEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
chosen) Map RegistryIdentity TrieEntry
entries)
    coverage <- checkedCoverage entry
    if chosen == entrySelection entry
        then
            Right
                ( snapshotObserved
                    (const (pure ()))
                    chosen
                    (entryNodes entry)
                    coverage
                    Nothing
                )
        else
            Left
                ( StaleState
                    (trieSelectionIdentity chosen)
                    Nothing
                    (StaleSelection chosen (entrySelection entry))
                )

newtype FixtureStore = FixtureStore (Map RegistryIdentity TrieEntry)
fixtureStore
    :: [(TrieSelection, Maybe CreateRecord, [ObservedFold], MPFInMemoryDB)]
    -> FixtureStore
fixtureStore :: [(TrieSelection, Maybe CreateRecord, [ObservedFold],
  MPFInMemoryDB)]
-> FixtureStore
fixtureStore [(TrieSelection, Maybe CreateRecord, [ObservedFold],
  MPFInMemoryDB)]
entries =
    Map RegistryIdentity TrieEntry -> FixtureStore
FixtureStore (Map RegistryIdentity TrieEntry -> FixtureStore)
-> Map RegistryIdentity TrieEntry -> FixtureStore
forall a b. (a -> b) -> a -> b
$
        [(RegistryIdentity, TrieEntry)] -> Map RegistryIdentity TrieEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (TrieSelection -> RegistryIdentity
trieSelectionIdentity TrieSelection
chosen, TrieSelection
-> Maybe CreateRecord
-> [ObservedFold]
-> MPFInMemoryDB
-> TrieEntry
TrieEntry TrieSelection
chosen Maybe CreateRecord
create [ObservedFold]
events MPFInMemoryDB
nodes)
            | (TrieSelection
chosen, Maybe CreateRecord
create, [ObservedFold]
events, MPFInMemoryDB
nodes) <- [(TrieSelection, Maybe CreateRecord, [ObservedFold],
  MPFInMemoryDB)]
entries
            ]
fixtureNodes :: FixtureStore -> Map RegistryIdentity MPFInMemoryDB
fixtureNodes :: FixtureStore -> Map RegistryIdentity MPFInMemoryDB
fixtureNodes (FixtureStore Map RegistryIdentity TrieEntry
entries) = TrieEntry -> MPFInMemoryDB
entryNodes (TrieEntry -> MPFInMemoryDB)
-> Map RegistryIdentity TrieEntry
-> Map RegistryIdentity MPFInMemoryDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map RegistryIdentity TrieEntry
entries
fixtureFolds :: FixtureStore -> Map RegistryIdentity [ObservedFold]
fixtureFolds :: FixtureStore -> Map RegistryIdentity [ObservedFold]
fixtureFolds (FixtureStore Map RegistryIdentity TrieEntry
entries) = TrieEntry -> [ObservedFold]
entryFolds (TrieEntry -> [ObservedFold])
-> Map RegistryIdentity TrieEntry
-> Map RegistryIdentity [ObservedFold]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map RegistryIdentity TrieEntry
entries
fixtureTrieState :: TrieState (State FixtureStore)
fixtureTrieState :: TrieState (State FixtureStore)
fixtureTrieState = (RegistryIdentity
 -> State FixtureStore (Either TrieFailure TrieEntry))
-> (TrieEntry -> State FixtureStore ())
-> TrieState (State FixtureStore)
forall (m :: * -> *).
Monad m =>
(RegistryIdentity -> m (Either TrieFailure TrieEntry))
-> (TrieEntry -> m ()) -> TrieState m
capability RegistryIdentity
-> State FixtureStore (Either TrieFailure TrieEntry)
forall {m :: * -> *}.
MonadState FixtureStore m =>
RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch TrieEntry -> State FixtureStore ()
forall {m :: * -> *}.
MonadState FixtureStore m =>
TrieEntry -> m ()
persist
  where
    fetch :: RegistryIdentity -> m (Either TrieFailure TrieEntry)
fetch RegistryIdentity
who = (FixtureStore -> Either TrieFailure TrieEntry)
-> m (Either TrieFailure TrieEntry)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((FixtureStore -> Either TrieFailure TrieEntry)
 -> m (Either TrieFailure TrieEntry))
-> (FixtureStore -> Either TrieFailure TrieEntry)
-> m (Either TrieFailure TrieEntry)
forall a b. (a -> b) -> a -> b
$ \(FixtureStore Map RegistryIdentity TrieEntry
entries) ->
        Either TrieFailure TrieEntry
-> (TrieEntry -> Either TrieFailure TrieEntry)
-> Maybe TrieEntry
-> Either TrieFailure TrieEntry
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (TrieFailure -> Either TrieFailure TrieEntry
forall a b. a -> Either a b
Left (RegistryIdentity -> Maybe TxId -> Mismatch -> TrieFailure
WrongRegistry RegistryIdentity
who Maybe TxId
forall a. Maybe a
Nothing Mismatch
UnknownRegistry))
            TrieEntry -> Either TrieFailure TrieEntry
forall a b. b -> Either a b
Right
            (RegistryIdentity
-> Map RegistryIdentity TrieEntry -> Maybe TrieEntry
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup RegistryIdentity
who Map RegistryIdentity TrieEntry
entries)
    persist :: TrieEntry -> m ()
persist TrieEntry
entry = (FixtureStore -> FixtureStore) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FixtureStore -> FixtureStore) -> m ())
-> (FixtureStore -> FixtureStore) -> m ()
forall a b. (a -> b) -> a -> b
$ \(FixtureStore Map RegistryIdentity TrieEntry
entries) ->
        Map RegistryIdentity TrieEntry -> FixtureStore
FixtureStore
            ( RegistryIdentity
-> TrieEntry
-> Map RegistryIdentity TrieEntry
-> Map RegistryIdentity TrieEntry
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
                (TrieSelection -> RegistryIdentity
trieSelectionIdentity (TrieEntry -> TrieSelection
entrySelection TrieEntry
entry))
                TrieEntry
entry
                Map RegistryIdentity TrieEntry
entries
            )