-- | A book rendered from the same programs the live backend executes.
module Conformance.Book (renderBook, bookStories, bookReceipts) where

import Conformance.Edge.Permanent qualified as Permanent
import Conformance.Edge.Programs
    ( Chapter (..)
    , Classification (..)
    , Kind (..)
    , Program (..)
    , classify
    , displayStory
    , programFor
    , programs
    )
import Conformance.Receipt (Receipt (..), Verdict (..))
import Conformance.Rows (Row (..), RowState (..))
import Conformance.Story.Live (renderLive)
import Data.Aeson (Value (..))
import Data.Aeson.KeyMap qualified as KM
import Data.Foldable (toList)
import Data.List (intercalate)
import Data.Maybe (isJust)
import Data.Text qualified as T

-- | The stories a book run executes, renders and requires, in book order.
bookStories :: [String]
bookStories :: [String]
bookStories = [Program -> String
programRow Program
p | Program
p <- [Program]
programs, Maybe Chapter -> Bool
forall a. Maybe a -> Bool
isJust (Program -> Maybe Chapter
programChapter Program
p)]

{- | The receipts a book renders: one per story of the book, each agreeing
with the model, in book order; a missing or disagreeing story is refused,
named.
-}
bookReceipts :: [Receipt] -> Either String [Receipt]
bookReceipts :: [Receipt] -> Either String [Receipt]
bookReceipts [Receipt]
receipts = (String -> Either String Receipt)
-> [String] -> Either String [Receipt]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> Either String Receipt
story [String]
bookStories
  where
    story :: String -> Either String Receipt
story String
name = case [Receipt
r | Receipt
r <- [Receipt]
receipts, Receipt -> Text
receiptRow Receipt
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
name] of
        [Receipt
r]
            | Receipt -> Verdict
receiptVerdict Receipt
r Verdict -> Verdict -> Bool
forall a. Eq a => a -> a -> Bool
== Verdict
AgreesWithModel -> Receipt -> Either String Receipt
forall a b. b -> Either a b
Right Receipt
r
            | Bool
otherwise ->
                String -> Either String Receipt
forall a b. a -> Either a b
Left
                    (String
"the book's " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" receipt does not agree with the model")
        [] -> String -> Either String Receipt
forall a b. a -> Either a b
Left (String
"the book run has no receipt for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name)
        [Receipt]
_ -> String -> Either String Receipt
forall a b. a -> Either a b
Left (String
"the book run has more than one receipt for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name)

-- | Called only after both live stories and their observations have succeeded.
renderBook :: [Row] -> [Receipt] -> String
renderBook :: [Row] -> [Receipt] -> String
renderBook [Row]
requirements [Receipt]
receipts =
    String
"# The running registry book\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"These are executable stories. The runner supplies fresh registry and wallet contexts; the stories submit real transactions to a local Cardano devnet and check what happened. The same story programs supply the steps printed below.\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"## This run\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Receipt -> String) -> [Receipt] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
            Receipt -> String
result
            [Receipt
r | String
name <- [String]
bookStories, Receipt
r <- [Receipt]
receipts, Receipt -> Text
receiptRow Receipt
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
name]
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Program -> String) -> [Program] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Program -> String
chapterText [Program]
programs
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"## Permanent registration and termination\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The following program requires the new permanent registry and bounded model evaluator. No live conformance receipt for it is attached to this book; its inventory row remains uncovered. Exported-code component checks and the ordinary packaged CLI journey are separate evidence boundaries. Earlier deployed registries are abandoned. Protected rejection follows this carve with its own identity change and remains required before the first milestone closes.\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
Permanent.description
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"## What these runs do not establish\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Every declared observation of an accepted request in the running chapters is compared with the model: configuration, custody, held tokens, leaf, mint, payments, root, the resulting state and the transaction. Output minimum ada remains a named unobservable. The transaction's required signers are compared: the model requires none for a fold and the owner for a retraction, and the comparison reads them from the submitted transaction. The registration chapter folds two registrations in one transaction that mints both tokens at the first request's key; it is compared on its outcome and, both refusing, on the reason. The model builds no transaction for a batch, so no other observation of a batch is compared. For any step whose receipt reports unsupported, no acceptance or refusal of a completed chain fold is established; the observed reasons are published in the appendix. The original Absent retirement and deletion-refund requirements remain published and uncovered. The current retirement chapter starts from a reached Active registration; excluded encodings create no Absent state, and their refusals receive no credit for those broader requirements. The model admits a retraction only when the pending request inserts a key or reads a terminal one, its owner is among the transaction's required signers, and its validity interval lies inside phase 2. The interval starts no earlier than submission plus the processing time; its excluded upper bound may reach, but not pass, the end of the retraction time that follows. The model represents only finite validity bounds. Open validity intervals remain a named gap: the Aiken tests establish their not-phase2 refusal, but no live model comparison can represent them. The early rejections are compared in the processing window and the retraction window of one registry; a fold of an update in the retraction window is not compared there, because the validator refuses it while the model admits it, a separate tracked discrepancy. These examples exercise one local devnet and one protocol-parameter set; they do not establish every reachable state, every theorem consumer, or naming-application behavior beyond the observed approval.\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
refusalLimits
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"## Requirements inventory\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The descriptions and planned statuses below are preserved from the committed inventory. The transaction evidence above belongs to this particular run; it does not rewrite planned statuses or discharge unrelated requirements.\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Row -> String) -> [Row] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Row -> String
requirement [Row]
requirements
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"## Appendix: checking the evidence machinery\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The report-validation tests remain under `test/Conformance/Support`. They check missing and contradictory evidence, report parsing and preservation, and refusal attribution. They run alongside the live stories but do not replace them. Authentication tests are still compiled but unwired, tracked in #210.\n\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Receipt -> String) -> [Receipt] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Receipt -> String
gapEvidence [Receipt]
receipts
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
replayCaptures
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The generated book is committed to the repository and is not yet reachable from the documentation site, tracked as #218. The general census of Haskell specification bindings remains tracked in #213.\n"
  where
    result :: Receipt -> String
result Receipt
receipt =
        String
"Code revision: `"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptBase Receipt
receipt)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( if Receipt -> Bool
receiptDirty Receipt
receipt
                    then String
" (working tree had changes)."
                    else String
" (clean working tree)."
               )
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Node: `"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptNode Receipt
receipt)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`. Compiled validators: `"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Receipt -> Text
receiptBlueprint Receipt
receipt)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.\n\n"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> ([Value] -> String) -> Maybe [Value] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                String
""
                ( \[Value]
steps -> case String -> Maybe Program
programFor (Text -> String
T.unpack (Receipt -> Text
receiptRow Receipt
receipt)) Maybe Program -> (Program -> Maybe Chapter) -> Maybe Chapter
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Program -> Maybe Chapter
programChapter of
                    Just Chapter
chapterOf ->
                        Chapter -> String
chapterSummary Chapter
chapterOf
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" "
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Value] -> String
outcomeCounts [Value]
steps
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Value -> String) -> [Value] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> String
detection [Value]
steps
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Value -> String) -> [Value] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> String
refusedStep [Value]
steps
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Value -> String) -> [Value] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> String
refusedBatch [Value]
steps
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Value] -> String
admissionEvidence [Value]
steps
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Value] -> String
windowEvidence [Value]
steps
                    Maybe Chapter
Nothing -> String
""
                )
                (Receipt -> Maybe [Value]
receiptSteps Receipt
receipt)
    requirement :: Row -> String
requirement Row
row =
        String
"### "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Row -> Text
rowRequirement Row
row)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\nExpected: "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Row -> Text
rowExpected Row
row)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Planned evidence status: "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RowState -> String
forall {a}. IsString a => RowState -> a
stateName (Row -> RowState
rowState Row
row)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".\n\nSource: "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Row -> Text
rowSource Row
row)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".\n\n"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                String
""
                (\Text
e -> String
"Existing evidence: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n")
                (Row -> Maybe Text
rowEvidence Row
row)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Row -> String
classification Row
row
    -- A chapter is a program the book renders whole, with what it is for.
    chapterText :: Program -> String
chapterText Program
p = case Program -> Maybe Chapter
programChapter Program
p of
        Just Chapter
chapterOf ->
            String
"## "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Chapter -> String
chapterTitle Chapter
chapterOf
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Chapter -> String
chapterIntroduction Chapter
chapterOf
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Program -> String
rendered Program
p
        Maybe Chapter
Nothing -> String
""
    rendered :: Program -> String
rendered Program
p =
        (String -> String)
-> (Story String String String String String () -> String)
-> Either String (Story String String String String String ())
-> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\String
problem -> String
"The program cannot be rendered: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
problem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n")
            Story String String String String String () -> String
forall res. Story String String String String String res -> String
renderLive
            (Program
-> Either String (Story String String String String String ())
displayStory Program
p)
    -- How a registry row is run, read off the program that runs it or the
    -- reason the model cannot express it.
    classification :: Row -> String
classification Row
row
        | Row -> Text
rowGroup Row
row Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"registry-operations" = String
""
        | Bool
otherwise = case Text -> Either String Classification
classify (Row -> Text
rowId Row
row) of
            Right (Composed Kind
kind) ->
                Kind -> String
forall {a}. IsString a => Kind -> a
kindReading Kind
kind
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> (Program -> String) -> Maybe Program -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"." Program -> String
whereRun (String -> Maybe Program
programFor (Text -> String
T.unpack (Row -> Text
rowId Row
row)))
            Right (Outside Text
reason) ->
                String
"Outside the model's vocabulary: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
reason String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
            Left String
problem -> String
"Not classified: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
problem String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
    kindReading :: Kind -> a
kindReading Kind
EdgeComposition =
        a
"Run as an edge composition over the registry's operations"
    kindReading Kind
Tamper = a
"Run as a tamper of an edge's transaction"
    whereRun :: Program -> String
whereRun Program
p = case Program -> Maybe Chapter
programChapter Program
p of
        Just Chapter
chapterOf -> String
", in the chapter \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Chapter -> String
chapterTitle Chapter
chapterOf String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" above.\n\n"
        Maybe Chapter
Nothing -> String
", in the conformance session:\n\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Program -> String
rendered Program
p
    stateName :: RowState -> a
stateName RowState
Uncovered = a
"uncovered"
    stateName RowState
BoundElsewhere = a
"bound elsewhere"
    stateName RowState
OutOfScope = a
"outside the registry's scope"
    hasOutcome :: Text -> Value -> Bool
hasOutcome Text
expected Value
value = case Value
value of
        Object Object
fields -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"chain" Object
fields of
            Just (Object Object
chain) -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"outcome" Object
chain Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
expected)
            Maybe Value
_ -> Bool
False
        Value
_ -> Bool
False
    outcomeCounts :: [Value] -> String
outcomeCounts [Value]
allSteps =
        let steps :: [Value]
steps = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Value -> Bool) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Bool
isBatch) [Value]
allSteps
            batches :: [Value]
batches = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter Value -> Bool
isBatch [Value]
allSteps
        in  Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
steps)
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" requests: "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Value -> Bool
hasOutcome Text
"accepted") [Value]
steps))
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" accepted and "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Value -> Bool
hasOutcome Text
"refused") [Value]
steps))
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" refused on chain.\n\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Unsupported chain folds: "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Value -> Bool
hasOutcome Text
"unsupported") [Value]
steps))
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".\n\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( if [Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
batches
                        then String
""
                        else
                            String
"Batches submitted in one transaction: "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
batches)
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Value -> Bool
hasOutcome Text
"accepted") [Value]
batches))
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" accepted and "
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Value -> Bool
hasOutcome Text
"refused") [Value]
batches))
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" refused on chain.\n\n"
                   )
    isBatch :: Value -> Bool
isBatch Value
value = case Value
value of
        Object Object
fields -> Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
KM.member Key
"batch" Object
fields
        Value
_ -> Bool
False
    -- A batch the chain refused, the model's reason for its batch question,
    -- and what the traced replay of its transaction recorded: all read from the
    -- record, never typed here.
    refusedBatch :: Value -> String
refusedBatch Value
value = case Value
value of
        Object Object
fields -> case ( Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"batch" Object
fields
                              , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"requests" Object
fields
                              , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"chain" Object
fields
                              ) of
            (Just (String Text
question), Just (Array Array
asked), Just (Object Object
chain))
                | Just (String Text
"refused") <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"outcome" Object
chain
                , Just (String Text
txid) <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"txid" Object
chain ->
                    String
"The "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( if Text
question Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"foldBatch"
                                then String
"fold of "
                                else String
"reject of "
                           )
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Array -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array
asked)
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" requests in one transaction"
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"tamper" Object
fields of
                                Just (String Text
name) -> String
", tampered " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
","
                                Maybe Value
_ -> String
""
                           )
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" was refused on chain (transaction `"
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
txid
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`)"
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( case [Key] -> Value -> Maybe Value
at [Key
"model", Key
"reason"] Value
value of
                                Just (String Text
reason) ->
                                    String
"; the model's `"
                                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
question
                                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` refused it for `"
                                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
reason
                                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`."
                                Maybe Value
_ -> String
"."
                           )
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
tracedReplay Object
chain
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
            (Maybe Value, Maybe Value, Maybe Value)
_ -> String
""
        Value
_ -> String
""
    -- A tamper the ledger accepted, and the difference the comparison detected
    -- in the transaction it built: read from the step, never typed here.
    detection :: Value -> String
detection Value
value = case Value
value of
        Object Object
fields -> case ( Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"tamper" Object
fields
                              , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"comparison" Object
fields
                              , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"differences" Object
fields
                              , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"chain" Object
fields
                              ) of
            ( Just (String Text
name)
                , Just (String Text
"agrees")
                , Just (Array Array
differences)
                , Just (Object Object
chain)
                )
                    | Bool -> Bool
not (Array -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
differences)
                    , Just (String Text
"accepted") <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"outcome" Object
chain
                    , Just (String Text
txid) <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"txid" Object
chain ->
                        String
"The "
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" registration was accepted on chain (transaction `"
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
txid
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`); the comparison detected the difference at "
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate
                                String
", "
                                [ String
"`" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
observation String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`"
                                | Object Object
difference <- Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
differences
                                , Just (String Text
observation) <- [Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"observation" Object
difference]
                                , Just (String Text
path) <- [Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"path" Object
difference]
                                ]
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".\n\n"
            (Maybe Value, Maybe Value, Maybe Value, Maybe Value)
_ -> String
""
        Value
_ -> String
""
    -- A request the chain refused, the model's reason, and what the traced
    -- replay of its transaction recorded: all read from the step, never typed
    -- here.
    refusedStep :: Value -> String
refusedStep Value
value = case Value
value of
        Object Object
fields -> case ( Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"edge" Object
fields
                              , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"chain" Object
fields
                              ) of
            (Just (String Text
edge), Just (Object Object
chain))
                | Just (String Text
"refused") <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"outcome" Object
chain
                , Just (String Text
txid) <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"txid" Object
chain ->
                    String
"The "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"tamper" Object
fields of
                                Just (String Text
name) -> Text -> String
T.unpack Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" "
                                Maybe Value
_ -> String
""
                           )
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> Text -> String
exitOf Object
fields Text
edge
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" was refused on chain (transaction `"
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
txid
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`)"
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( case [Key] -> Value -> Maybe Value
at [Key
"model", Key
"reason"] Value
value of
                                Just (String Text
reason) ->
                                    String
"; the model refused it for `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
reason String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`."
                                Maybe Value
_ -> String
"."
                           )
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" "
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
tracedReplay Object
chain
                        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
            (Maybe Value, Maybe Value)
_ -> String
""
        Value
_ -> String
""
    -- What the traced replay of a refused transaction recorded, purpose by
    -- purpose, or that it recorded nothing.
    tracedReplay :: Object -> String
tracedReplay Object
chain = case Object -> [Object]
replayOf Object
chain of
        [] -> String
"No traced replay of this refusal is recorded."
        [Object]
entries ->
            [String] -> String
unwords
                [ String
"The traced replay of the deployed script `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
deployed
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
observed
                | Object
entry <- [Object]
entries
                , Just (String Text
deployed) <- [Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"deployedHash" Object
entry]
                , Just String
observed <- [Object -> Maybe String
replayObserved Object
entry]
                ]
    replayOf :: Object -> [Object]
replayOf Object
chain = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"refusal" Object
chain of
        Just (Object Object
refusal)
            | Just (Array Array
entries) <- Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"replay" Object
refusal ->
                [Object
entry | Object Object
entry <- Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
entries]
        Maybe Value
_ -> []
    replayObserved :: Object -> Maybe String
replayObserved Object
entry = case ( Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"reason" Object
entry
                                , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"cause" Object
entry
                                , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"tracedHash" Object
entry
                                ) of
        (Just (String Text
reason), Maybe Value
_, Just (String Text
traced)) ->
            String -> Maybe String
forall a. a -> Maybe a
Just
                ( String
"(traced build `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
traced
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`) failed with `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
reason
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`."
                )
        (Maybe Value
_, Just (String Text
cause), Maybe Value
_) ->
            String -> Maybe String
forall a. a -> Maybe a
Just (String
"admits no reason: `" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
cause String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.")
        (Maybe Value, Maybe Value, Maybe Value)
_ -> Maybe String
forall a. Maybe a
Nothing
    -- Every refused request of the run's chapters, with its replay.
    refusedChains :: [Object]
refusedChains =
        [ Object
chain
        | Receipt
receipt <- [Receipt]
receipts
        , Value
step <- Maybe [Value] -> [Value]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Receipt -> Maybe [Value]
receiptSteps Receipt
receipt)
        , Just (Object Object
chain) <- [[Key] -> Value -> Maybe Value
at [Key
"chain"] Value
step]
        , Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"outcome" Object
chain Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"refused")
        ]
    recorded :: ([Object] -> Bool) -> Int
recorded [Object] -> Bool
predicate =
        [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | Object
chain <- [Object]
refusedChains, [Object] -> Bool
predicate (Object -> [Object]
replayOf Object
chain)]
    admitted :: [KeyMap a] -> Bool
admitted = (KeyMap a -> Bool) -> [KeyMap a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Key -> KeyMap a -> Bool
forall a. Key -> KeyMap a -> Bool
KM.member Key
"reason")
    named :: [KeyMap a] -> Bool
named [KeyMap a]
entries = Bool -> Bool
not ([KeyMap a] -> Bool
forall {a}. [KeyMap a] -> Bool
admitted [KeyMap a]
entries) Bool -> Bool -> Bool
&& (KeyMap a -> Bool) -> [KeyMap a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Key -> KeyMap a -> Bool
forall a. Key -> KeyMap a -> Bool
KM.member Key
"cause") [KeyMap a]
entries
    refusalLimits :: String
refusalLimits =
        String
"Refusal reasons come from traced re-evaluation. The deployed validators are compiled without traces, so the ledger names the script that refused but not why. Each refused transaction is evaluated again on the arguments the ledger built for it: once with the deployed bytes, and once with a build of the same source, compiler and parameters that keeps only the validators' own traces. A reason is admitted only when both evaluations fail and the traced one leaves exactly one trace; otherwise the receipt names the cause no reason was admitted. The receipt names both script hashes, and each refused request above prints what its replay recorded. Of the "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Object] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Object]
refusedChains)
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( if [Object] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Object]
refusedChains Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                    then String
" refused request"
                    else String
" refused requests"
               )
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" in this run's chapters, "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String -> String
forall {a}.
(Show a, Eq a, Num a) =>
a -> String -> String -> String
counted
                (([Object] -> Bool) -> Int
recorded [Object] -> Bool
forall {a}. [KeyMap a] -> Bool
admitted)
                String
"carries a reason its"
                String
"carry a reason their"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" traced replay admitted, "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String -> String
forall {a}.
(Show a, Eq a, Num a) =>
a -> String -> String -> String
counted (([Object] -> Bool) -> Int
recorded [Object] -> Bool
forall {a}. [KeyMap a] -> Bool
named) String
"names the cause its" String
"name the cause their"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" replay admits none, and "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String -> String
forall {a}.
(Show a, Eq a, Num a) =>
a -> String -> String -> String
counted (([Object] -> Bool) -> Int
recorded [Object] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) String
"records" String
"record"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" no traced replay.\n\n"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Refusals outside these chapters, by row, recorded in the receipts of the conformance session rather than in this book. Three have no counterpart in the model, so their model comparison is unmet: each receipt carries the verdict unmet by ruling and shows what the traced replay of the refusal recorded. wrong-redeemer-constructor-index, a fold redeemer at a wrong constructor index: the model has no vocabulary for decoding a redeemer; the witness script names its refusal, while the state and request scripts fail on a path that carries no user-defined trace, so their live refusal reason is not observed (lambdasistemi/singular#347). fold-against-superseded-root, a fold whose proof was built against a root the registry has since superseded: the model takes no proof and no authenticated root and admits the insertion on that unoccupied key, so nothing compares with the chain's reason (lambdasistemi/singular#346). surplus-fold-actions, a fold carrying an action beyond its requests, and one missing an action: the model takes no action list (lambdasistemi/singular#345). The other refusals are compared with the model's batch questions, each against the reason the traced replay admits for the state script: empty-fold, an empty fold, with the fold batch over no request; request-value-and-refund-routing, two rejects whose refunds are crossed and two whose first refund is short, with the reject batch judged on the refunds the transaction pays; and reject-before-deadline-consumer-requirement's control, a reject refunding its owner one lovelace short, with the reject batch of that one request. reject-before-deadline-consumer-requirement itself, a reject while the request can still be folded, is accepted by the chain and by the model, while the consuming project requires it refused: that requirement stays unmet by ruling. Where a reject pays its owner, the chain and the model read the payment differently: the chain requires the output in each refund's position to pay that request's owner what it is owed, while the model credits an owner the sum of every output at its key. A reject paying its owner short in the refund's position and the rest in another output at the same key is refused by the chain and accepted by the model: reject-before-deadline-consumer-requirement's receipt records that disagreement from a devnet run, a known divergence and never a pass (lambdasistemi/singular#361). Every compared reject, here and in the conformance session, leaves no other output at its owners' keys, so their agreement holds for that shape only. Whether empty-fold and request-value-and-refund-routing meet the consuming project's requirements remains unresolved; the two rows stay held.\n\n"
    -- A count with the words that agree with it.
    counted :: a -> String -> String -> String
counted a
n String
one String
many = a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (if a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then String
one else String
many)
    -- The capture each refused request's replay was evaluated from: harness
    -- evidence, kept to the appendix.
    replayCaptures :: String
replayCaptures = case [ String
"Transaction `"
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
txid
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`: capture `"
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
capture
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` of the deployed script `"
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
deployed
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.\n\n"
                          | Object
chain <- [Object]
refusedChains
                          , Just (String Text
txid) <- [Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"txid" Object
chain]
                          , Object
entry <- Object -> [Object]
replayOf Object
chain
                          , Just (String Text
capture) <- [Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"captureId" Object
entry]
                          , Just (String Text
deployed) <- [Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"deployedHash" Object
entry]
                          ] of
        [] -> String
""
        [String]
captures ->
            String
"Each refused request's traced replay was evaluated from a capture of the refused transaction, the outputs it spends, the protocol parameters and the era history:\n\n"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
captures
    -- A fold is named by its edge; a reject or a retraction by its exit and the
    -- edge its request named.
    exitOf :: Object -> Text -> String
exitOf Object
fields Text
edge = case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"exit" Object
fields of
        Just (String Text
exit)
            | Text
exit Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"reject", Text
"retract"] ->
                Text -> String
T.unpack Text
exit String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
edge
        Maybe Value
_ -> Text -> String
T.unpack Text
edge
    -- Publish the admission run only with both attributed refusals and their
    -- signed insertion control. Missing evidence never becomes a run claim.
    admissionEvidence :: [Value] -> String
admissionEvidence [Value]
steps = case [ (Value
unsigned, Value
update, Value
control)
                                   | Value
unsigned <- [Value]
steps
                                   , [Text] -> Value -> Text -> Value -> Bool
refuses
                                        [Text
"insertAbsent", Text
"insertActive"]
                                        (Text -> Value
String Text
"unsigned")
                                        Text
"retract-owner"
                                        Value
unsigned
                                   , Value -> Maybe Bool
ownerSigned Value
unsigned Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                                   , Value
update <- [Value]
steps
                                   , [Text] -> Value -> Text -> Value -> Bool
refuses
                                        [Text
"updateActive", Text
"updateTerminal"]
                                        Value
Null
                                        Text
"withdraw-insert-only"
                                        Value
update
                                   , Value -> Maybe Bool
ownerSigned Value
update Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                                   , [Key] -> Value -> Value -> Bool
same [Key
"registry"] Value
unsigned Value
update
                                   , Value
control <- [Value]
steps
                                   , Value -> Bool
retraction Value
control
                                   , [Key] -> Value -> Maybe Value
at [Key
"tamper"] Value
control Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Null
                                   , [Key] -> Value -> Maybe Value
at [Key
"model", Key
"outcome"] Value
control Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"accepted")
                                   , [Key] -> Value -> Maybe Value
at [Key
"chain", Key
"outcome"] Value
control Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"accepted")
                                   , Value -> Maybe Bool
ownerSigned Value
control Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                                   , [Key] -> Value -> Value -> Bool
same [Key
"registry"] Value
unsigned Value
control
                                   , [Key] -> Value -> Value -> Bool
same [Key
"request"] Value
unsigned Value
control
                                   , [Key] -> Value -> Value -> Bool
same [Key
"edge"] Value
unsigned Value
control
                                   ] of
        (Value
unsigned, Value
update, Value
control) : [(Value, Value, Value)]
_ ->
            String
"The exit chapter compared both admission refusals: the unsigned insertion retraction (transaction `"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
unsigned
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`) was refused by the model for `"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"model", Key
"reason"] Value
unsigned
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`, and the pending update retraction (transaction `"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
update
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`) for `"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"model", Key
"reason"] Value
update
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`; the chain attributes both refusals to the request validator. The owner-signed insertion control accepted by both is transaction `"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
control
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.\n\n"
        [] -> String
""
    windowEvidence :: [Value] -> String
windowEvidence [Value]
steps = case [Value]
steps of
        [Value
before, Value
control, Value
after]
            | [Text] -> Value -> Text -> Value -> Bool
refuses [Text
"insertActive"] (Text -> Value
String Text
"before-phase-2") Text
"not-phase2" Value
before
            , [Text] -> Value -> Text -> Value -> Bool
refuses [Text
"insertActive"] (Text -> Value
String Text
"after-phase-2") Text
"not-phase2" Value
after
            , (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (Maybe Bool -> Bool) -> (Value -> Maybe Bool) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Bool
ownerSigned) [Value]
steps
            , (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Key] -> Value -> Value -> Bool
same [Key
"registry"] Value
before) [Value
control, Value
after]
            , [Key] -> Value -> Value -> Bool
same [Key
"request"] Value
before Value
control
            , [Key] -> Value -> Value -> Bool
same [Key
"request", Key
"owner"] Value
before Value
after
            , [Key] -> Value -> Value -> Bool
same [Key
"edge"] Value
before Value
after
            , [Key] -> Value -> Maybe Value
at [Key
"request", Key
"reference"] Value
before
                Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
/= [Key] -> Value -> Maybe Value
at [Key
"request", Key
"reference"] Value
after
            , Value -> Bool
retraction Value
control
            , [Key] -> Value -> Maybe Value
at [Key
"tamper"] Value
control Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Null
            , [Key] -> Value -> Maybe Value
at [Key
"model", Key
"outcome"] Value
control Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"accepted")
            , [Key] -> Value -> Maybe Value
at [Key
"chain", Key
"outcome"] Value
control Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"accepted") ->
                String
"The window chapter compared both finite timing refusals: transaction `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
before
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` before phase 2 and transaction `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
after
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"` after phase 2. The model refused both for `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"model", Key
"reason"] Value
before
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`; the chain attributes both refusals to the request validator. Their owner-signed in-window control accepted by both is transaction `"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
control
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"`.\n\n"
        [Value]
_ -> String
""
    refuses :: [Text] -> Value -> Text -> Value -> Bool
refuses [Text]
edges Value
alteration Text
reason Value
step =
        Value -> Bool
retraction Value
step
            Bool -> Bool -> Bool
&& [Key] -> Value -> Maybe Value
at [Key
"edge"] Value
step Maybe Value -> [Maybe Value] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Maybe Value) -> [Text] -> [Maybe Value]
forall a b. (a -> b) -> [a] -> [b]
map (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (Text -> Value) -> Text -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String) [Text]
edges
            Bool -> Bool -> Bool
&& [Key] -> Value -> Maybe Value
at [Key
"tamper"] Value
step Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
alteration
            Bool -> Bool -> Bool
&& [Key] -> Value -> Maybe Value
at [Key
"model", Key
"outcome"] Value
step Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"refused")
            Bool -> Bool -> Bool
&& [Key] -> Value -> Maybe Value
at [Key
"model", Key
"reason"] Value
step Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
reason)
            Bool -> Bool -> Bool
&& [Key] -> Value -> Maybe Value
at [Key
"chain", Key
"outcome"] Value
step Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"refused")
            Bool -> Bool -> Bool
&& case ([Key] -> Value -> Maybe Value
at [Key
"requestScript"] Value
step, [Key] -> Value -> Maybe Value
at [Key
"chain", Key
"refusal", Key
"hashes"] Value
step) of
                (Just (String Text
script), Just (Array Array
hashes)) -> Bool -> Bool
not (Text -> Bool
T.null Text
script) Bool -> Bool -> Bool
&& Text -> Value
String Text
script Value -> Array -> Bool
forall a. Eq a => a -> Vector a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Array
hashes
                (Maybe Value, Maybe Value)
_ -> Bool
False
    retraction :: Value -> Bool
retraction Value
step =
        [Key] -> Value -> Maybe Value
at [Key
"exit"] Value
step Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"retract")
            Bool -> Bool -> Bool
&& [Key] -> Value -> Maybe Value
at [Key
"comparison"] Value
step Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
String Text
"agrees")
            Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Key] -> Value -> String
textAt [Key
"chain", Key
"txid"] Value
step))
    ownerSigned :: Value -> Maybe Bool
ownerSigned Value
step = case ([Key] -> Value -> Maybe Value
at [Key
"request", Key
"owner"] Value
step, [Key] -> Value -> Maybe Value
at [Key
"witness", Key
"signatories"] Value
step) of
        (Just owner :: Value
owner@(Number Scientific
_), Just (Array Array
signatories)) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Value
owner Value -> Array -> Bool
forall a. Eq a => a -> Vector a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Array
signatories)
        (Maybe Value, Maybe Value)
_ -> Maybe Bool
forall a. Maybe a
Nothing
    same :: [Key] -> Value -> Value -> Bool
same [Key]
path Value
left Value
right = case [Key] -> Value -> Maybe Value
at [Key]
path Value
left of
        Just Value
value -> [Key] -> Value -> Maybe Value
at [Key]
path Value
right Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
        Maybe Value
Nothing -> Bool
False
    textAt :: [Key] -> Value -> String
textAt [Key]
path Value
step = case [Key] -> Value -> Maybe Value
at [Key]
path Value
step of
        Just (String Text
value) -> Text -> String
T.unpack Text
value
        Maybe Value
_ -> String
""
    at :: [Key] -> Value -> Maybe Value
at [] Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
    at (Key
key : [Key]
path) (Object Object
fields) = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
fields Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Key] -> Value -> Maybe Value
at [Key]
path
    at [Key]
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing
    gapEvidence :: Receipt -> String
gapEvidence Receipt
receipt
        | Receipt -> Text
receiptRow Receipt
receipt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"sequence" =
            String -> ([Value] -> String) -> Maybe [Value] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((Value -> String) -> [Value] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> String
gapReason) (Receipt -> Maybe [Value]
receiptSteps Receipt
receipt)
        | Bool
otherwise = String
""
    gapReason :: Value -> String
gapReason (Object Object
fields) = case (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"edge" Object
fields, Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"chain" Object
fields) of
        (Just (String Text
edge), Just (Object Object
chain)) -> case (Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"outcome" Object
chain, Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
"reason" Object
chain) of
            (Just (String Text
"unsupported"), Just (String Text
reason)) ->
                String
"### "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
edge
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" — observed gap\n\n"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall {a} {p}. IsString a => p -> a
gapExplanation Text
edge
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The observed reason follows from the receipt.\n\n"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"```text\n"
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
reason
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n```\n\n"
            (Maybe Value, Maybe Value)
_ -> String
""
        (Maybe Value, Maybe Value)
_ -> String
""
    gapReason Value
_ = String
""
    gapExplanation :: p -> a
gapExplanation p
_ =
        a
"The attempted operation did not produce a supported fold.\n\n"