{- | A request that is never folded: a folder rejects it after its owner's
retraction window has closed, or its owner retracts it. Each owes the owner the
deposit back, and a retraction the tip too, through an output bound to the
request it retracts.
-}
module Conformance.Edge.Exit (story) where

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

{- | Reject in one registry, retract in another: the rejection registry's
rejects are placed after their owner's retraction window, which closes a
second after it opens; the retraction registry's requests stay retractable long
enough to be retracted. Rejects inside the windows are the early rejection
story's. Each tampered exit is refused and leaves its request pending; the
untampered one is its control. An update request cannot be retracted, and an
insertion cannot be retracted without its owner's signature; the owner-signed
insertion is their control.
-}
story
    :: Context reg wal -> Context reg wal -> Story reg wal step obs cmp ()
story :: forall reg wal step obs cmp.
Context reg wal -> Context reg wal -> Story reg wal step obs cmp ()
story (Context reg
rejection wal
holder) (Context reg
retraction wal
_) = do
    let rejected :: EdgeRequest wal
rejected = Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"rejected" wal
holder
    Tamper
-> Placement
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
forall reg wal step obs cmp.
Tamper
-> Placement
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
tamperRejectWithin Tamper
ShortByOne Placement
AfterTheWindows reg
rejection EdgeRequest wal
rejected
        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
-> Placement
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
forall reg wal step obs cmp.
Tamper
-> Placement
-> reg
-> EdgeRequest wal
-> Story reg wal step obs cmp step
tamperRejectWithin Tamper
OtherAddress Placement
AfterTheWindows reg
rejection EdgeRequest wal
rejected
        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
    Placement
-> reg -> EdgeRequest wal -> Story reg wal step obs cmp step
forall reg wal step obs cmp.
Placement
-> reg -> EdgeRequest wal -> Story reg wal step obs cmp step
rejectWithin Placement
AfterTheWindows reg
rejection EdgeRequest wal
rejected 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
    let retracted :: EdgeRequest wal
retracted = Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"retracted" wal
holder
    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
ShortByOne Exit
Retract reg
retraction EdgeRequest wal
retracted 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
OtherAddress Exit
Retract reg
retraction EdgeRequest wal
retracted 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
OtherReference Exit
Retract reg
retraction EdgeRequest wal
retracted 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
StateSpent Exit
Retract reg
retraction EdgeRequest wal
retracted 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
retraction
        (Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
UpdateTerminal String
"pending-update" wal
holder)
        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
Unsigned Exit
Retract reg
retraction EdgeRequest wal
retracted 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
retraction EdgeRequest wal
retracted 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 ()