{- | Early rejection (#320): a folder rejects a pending request before its
owner's retraction deadline. The model gives a reject no admission, so a reject
is accepted in every window; each owes the owner the deposit back.
-}
module Conformance.Edge.EarlyReject (story, requests) where

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

-- | Two insertion requests booked together, before either is rejected.
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
"early-processing" wal
owner
    , Edge -> String -> wal -> EdgeRequest wal
forall wal. Edge -> String -> wal -> EdgeRequest wal
EdgeRequest Edge
InsertActive String
"early-retraction" wal
owner
    )

{- | The first request is rejected while it can still be folded, the second
while its owner can still retract it. In each window a reject refunding the
owner one lovelace short and one refunding another key are refused and leave
the request pending; the untampered reject of the same request is their
control.
-}
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
-> 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
InProcessingWindow 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
-> 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
InProcessingWindow 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
    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
InProcessingWindow 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
-> 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
InRetractionWindow 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
    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
InRetractionWindow 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
    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
InRetractionWindow 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 ()