-- | Owner-signed retractions on either side of phase 2 and inside it.
module Conformance.Edge.RetractionWindow (story, requests) where

import Conformance.Story.Live
    ( Context (..)
    , Edge (..)
    , EdgeRequest (..)
    , Exit (..)
    , Story
    , Tamper (..)
    , compareWithModel
    , observe
    , retract
    , tamperExit
    )

-- | Two requests booked together, before either is retracted.
requests :: wal -> (EdgeRequest wal, EdgeRequest wal)
requests :: forall wal. wal -> (EdgeRequest wal, EdgeRequest wal)
requests wal
owner =
    ( Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"window-first" wal
owner
    , Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"window-second" wal
owner
    )

{- | The first request is refused before phase 2 then accepted inside it.
The second, booked with it by the same owner, is refused after its window.
-}
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
owner) = do
    let (EdgeRequest wal
first, EdgeRequest wal
second) = wal -> (EdgeRequest wal, EdgeRequest wal)
forall wal. wal -> (EdgeRequest wal, EdgeRequest wal)
requests wal
owner
    Tamper
-> Exit
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
forall reg wal step obs cmp.
Tamper
-> Exit
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
tamperExit Tamper
BeforePhase2 Exit
Retract reg
registry EdgeRequest wal
first Story reg wal step obs cmp step
-> (step
    -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ())
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall a b.
ProgramT (Step (LiveI reg wal step obs cmp)) Identity a
-> (a -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity b)
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= step -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall {step} {reg} {wal} {a} {cmp}.
step -> ProgramT (Step (LiveI reg wal step a cmp)) Identity ()
compared
    reg -> EdgeRequest wal -> Story reg wal step obs cmp step
forall reg wal step obs cmp.
reg -> EdgeRequest wal -> Story reg wal step obs cmp step
retract reg
registry EdgeRequest wal
first Story reg wal step obs cmp step
-> (step
    -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ())
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall a b.
ProgramT (Step (LiveI reg wal step obs cmp)) Identity a
-> (a -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity b)
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= step -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall {step} {reg} {wal} {a} {cmp}.
step -> ProgramT (Step (LiveI reg wal step a cmp)) Identity ()
compared
    Tamper
-> Exit
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
forall reg wal step obs cmp.
Tamper
-> Exit
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
tamperExit Tamper
AfterPhase2 Exit
Retract reg
registry EdgeRequest wal
second Story reg wal step obs cmp step
-> (step
    -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ())
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall a b.
ProgramT (Step (LiveI reg wal step obs cmp)) Identity a
-> (a -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity b)
-> ProgramT (Step (LiveI reg wal step obs cmp)) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= step -> ProgramT (Step (LiveI reg wal step obs cmp)) Identity ()
forall {step} {reg} {wal} {a} {cmp}.
step -> ProgramT (Step (LiveI reg wal step a cmp)) Identity ()
compared
  where
    compared :: step -> ProgramT (Step (LiveI reg wal step a cmp)) Identity ()
compared step
step = do
        observation <- step -> Story reg wal step a cmp a
forall step reg wal obs cmp. step -> Story reg wal step obs cmp obs
observe step
step
        _ <- compareWithModel step observation
        pure ()