{- | The fixed contract's participant story in the existing description language.
Execution requires a permanent registry and the bounded model evaluator.
-}
module Conformance.Edge.Permanent (story, description) where

import Conformance.Story.Live
    ( Context (..)
    , Edge (..)
    , EdgeRequest (..)
    , Story
    , compareWithModel
    , foldBatch
    , observe
    , renderLive
    , submit
    )

story :: Context reg wal -> Story reg wal step obs cmp ()
story :: forall reg wal step obs cmp.
Context reg wal -> Story reg wal step obs cmp ()
story (Context reg
registry wal
participant) = do
    EdgeRequest wal
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall {wal} {a} {obs} {cmp}.
EdgeRequest wal
-> ProgramT (Step (LiveI reg wal a obs cmp)) Identity ()
compared (Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"registered-key" wal
participant)
    EdgeRequest wal
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall {wal} {a} {obs} {cmp}.
EdgeRequest wal
-> ProgramT (Step (LiveI reg wal a obs cmp)) Identity ()
compared (Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
UpdateTerminal String
"registered-key" wal
participant)
    (Edge -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ())
-> [Edge]
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
        (\Edge
edge -> EdgeRequest wal
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall {wal} {a} {obs} {cmp}.
EdgeRequest wal
-> ProgramT (Step (LiveI reg wal a obs cmp)) Identity ()
compared (Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
edge String
"registered-key" wal
participant))
        [ Edge
InsertAbsent
        , Edge
UpdateActive
        , Edge
DeleteAbsent
        , Edge
DeleteActive
        , Edge
WitnessTerminal
        ]
    _ <-
        reg -> [EdgeRequest wal] -> Story reg wal step obs cmp cmp
forall reg wal step obs cmp.
reg -> [EdgeRequest wal] -> Story reg wal step obs cmp cmp
foldBatch
            reg
registry
            [ Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"another-key" wal
participant
            , Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
WitnessTerminal String
"registered-key" wal
participant
            ]
    pure ()
  where
    compared :: EdgeRequest wal
-> ProgramT (Step (LiveI reg wal a obs cmp)) Identity ()
compared EdgeRequest wal
request = do
        step <- reg -> EdgeRequest wal -> Story reg wal a obs cmp a
forall reg wal step obs cmp.
reg -> EdgeRequest wal -> Story reg wal step obs cmp step
submit reg
registry EdgeRequest wal
request
        observation <- observe step
        _ <- compareWithModel step observation
        pure ()

-- | Render the same actions that an interpreter executes, with opaque handles.
description :: String
description :: String
description = Story String String String String String () -> String
forall res. Story String String String String String res -> String
renderLive (Context String String
-> Story String String String String String ()
forall reg wal step obs cmp.
Context reg wal -> Story reg wal step obs cmp ()
story (String -> String -> Context String String
forall reg wal. reg -> wal -> Context reg wal
Context String
"permanent registry" String
"participant"))