{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Singular.Registry.Page
Description : The registry page: one value from explicit inputs, rendered as text or JSON
License     : Apache-2.0

The page says which registry this is, which release it runs, what its
rules are and what it holds now, from explicit inputs alone: the state
token, the release, the rules from the state datum and the replayed
facts. It reads no chain, file, clock, tip or session, so identical
inputs give identical bytes. Pending requests render in one fixed
order, by request output reference.

The text and the JSON carry the same facts: every key the JSON carries
appears as a @name:@ line in the text. The provenance line states what
the page does not prove: the facts are state fields read from a replay
checked from create, the indexer's answers are unverified claims, the
release label is the archive's own claim, and the page is unsigned.
-}
module Singular.Registry.Page
    ( -- * Release
      ReleaseInfo (..)
    , ReleaseLinks (..)
    , releaseLinks
    , blueprintSha
    , parseVersionLabel
    , PageRefusal (..)
    , renderPageRefusal

      -- * Page
    , PageInputs (..)
    , Page
    , describeRegistry
    , renderPageText
    , renderPageJson
    ) where

import Crypto.Hash (Digest, SHA256, hash)
import Data.Aeson (Value (..), object, toJSON, (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.ByteArray (convert)
import Data.ByteString (ByteString)
import Data.ByteString.Base16 qualified as B16
import Data.ByteString.Lazy qualified as BL
import Data.Char (isDigit)
import Data.Foldable (toList)
import Data.List qualified as List
import Data.Maybe (fromMaybe)
import Data.Scientific (floatingOrInteger)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Text.Read (readMaybe)

-- ---------------------------------------------------------
-- Release
-- ---------------------------------------------------------

-- | The release the page names: the archive's own claims.
data ReleaseInfo = ReleaseInfo
    { ReleaseInfo -> Text
releaseVersion :: Text
    -- ^ The label from @version.txt@ beside the blueprint
    , ReleaseInfo -> Text
releaseBlueprintTitle :: Text
    -- ^ The blueprint preamble title
    , ReleaseInfo -> Text
releaseBlueprintSha :: Text
    -- ^ Hex SHA-256 over the blueprint file bytes
    , ReleaseInfo -> Text
releaseApplicationHash :: Text
    -- ^ The applied application script hash the registry runs
    }
    deriving stock (ReleaseInfo -> ReleaseInfo -> Bool
(ReleaseInfo -> ReleaseInfo -> Bool)
-> (ReleaseInfo -> ReleaseInfo -> Bool) -> Eq ReleaseInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReleaseInfo -> ReleaseInfo -> Bool
== :: ReleaseInfo -> ReleaseInfo -> Bool
$c/= :: ReleaseInfo -> ReleaseInfo -> Bool
/= :: ReleaseInfo -> ReleaseInfo -> Bool
Eq, Int -> ReleaseInfo -> ShowS
[ReleaseInfo] -> ShowS
ReleaseInfo -> String
(Int -> ReleaseInfo -> ShowS)
-> (ReleaseInfo -> String)
-> ([ReleaseInfo] -> ShowS)
-> Show ReleaseInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReleaseInfo -> ShowS
showsPrec :: Int -> ReleaseInfo -> ShowS
$cshow :: ReleaseInfo -> String
show :: ReleaseInfo -> String
$cshowList :: [ReleaseInfo] -> ShowS
showList :: [ReleaseInfo] -> ShowS
Show)

-- | Where the claimed version lives: never fetched, only computed.
data ReleaseLinks = ReleaseLinks
    { ReleaseLinks -> Text
linkRelease :: Text
    -- ^ The GitHub release page for tag @v\<version\>@
    , ReleaseLinks -> Text
linkDocs :: Text
    -- ^ The documentation asset of that release
    }
    deriving stock (ReleaseLinks -> ReleaseLinks -> Bool
(ReleaseLinks -> ReleaseLinks -> Bool)
-> (ReleaseLinks -> ReleaseLinks -> Bool) -> Eq ReleaseLinks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReleaseLinks -> ReleaseLinks -> Bool
== :: ReleaseLinks -> ReleaseLinks -> Bool
$c/= :: ReleaseLinks -> ReleaseLinks -> Bool
/= :: ReleaseLinks -> ReleaseLinks -> Bool
Eq, Int -> ReleaseLinks -> ShowS
[ReleaseLinks] -> ShowS
ReleaseLinks -> String
(Int -> ReleaseLinks -> ShowS)
-> (ReleaseLinks -> String)
-> ([ReleaseLinks] -> ShowS)
-> Show ReleaseLinks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReleaseLinks -> ShowS
showsPrec :: Int -> ReleaseLinks -> ShowS
$cshow :: ReleaseLinks -> String
show :: ReleaseLinks -> String
$cshowList :: [ReleaseLinks] -> ShowS
showList :: [ReleaseLinks] -> ShowS
Show)

-- | The links for a release label, computed and never fetched.
releaseLinks :: ReleaseInfo -> ReleaseLinks
releaseLinks :: ReleaseInfo -> ReleaseLinks
releaseLinks ReleaseInfo
info =
    ReleaseLinks
        { linkRelease :: Text
linkRelease =
            Text
"https://github.com/lambdasistemi/singular/releases/tag/v"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseVersion ReleaseInfo
info
        , linkDocs :: Text
linkDocs =
            Text
"https://github.com/lambdasistemi/singular/releases/download/v"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseVersion ReleaseInfo
info
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/singular-docs-"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseVersion ReleaseInfo
info
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".tar.gz"
        }

-- | Hex SHA-256 over blueprint file bytes.
blueprintSha :: ByteString -> Text
blueprintSha :: ByteString -> Text
blueprintSha ByteString
bytes = ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
B16.encode (Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Digest SHA256
digest))
  where
    digest :: Digest SHA256
    digest :: Digest SHA256
digest = ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash ByteString
bytes

-- | Why no release label is printed.
data PageRefusal
    = -- | No @version.txt@ beside the blueprint
      VersionMissing
    | -- | @version.txt@ cannot be read; the detail says why
      VersionUnreadable Text
    | -- | @version.txt@ is not a version label; the detail shows it
      VersionMalformed Text
    deriving stock (PageRefusal -> PageRefusal -> Bool
(PageRefusal -> PageRefusal -> Bool)
-> (PageRefusal -> PageRefusal -> Bool) -> Eq PageRefusal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageRefusal -> PageRefusal -> Bool
== :: PageRefusal -> PageRefusal -> Bool
$c/= :: PageRefusal -> PageRefusal -> Bool
/= :: PageRefusal -> PageRefusal -> Bool
Eq, Int -> PageRefusal -> ShowS
[PageRefusal] -> ShowS
PageRefusal -> String
(Int -> PageRefusal -> ShowS)
-> (PageRefusal -> String)
-> ([PageRefusal] -> ShowS)
-> Show PageRefusal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageRefusal -> ShowS
showsPrec :: Int -> PageRefusal -> ShowS
$cshow :: PageRefusal -> String
show :: PageRefusal -> String
$cshowList :: [PageRefusal] -> ShowS
showList :: [PageRefusal] -> ShowS
Show)

-- | A refusal by name.
renderPageRefusal :: PageRefusal -> Text
renderPageRefusal :: PageRefusal -> Text
renderPageRefusal = \case
    PageRefusal
VersionMissing -> Text
"version-missing: no version.txt beside the blueprint"
    VersionUnreadable Text
why -> Text
"version-unreadable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
why
    VersionMalformed Text
raw -> Text
"version-malformed: not a version label: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
raw

-- | A version label to its stripped self, or why it is none.
parseVersionLabel :: Text -> Either PageRefusal Text
parseVersionLabel :: Text -> Either PageRefusal Text
parseVersionLabel Text
raw =
    let label :: Text
label = Text -> Text
T.strip Text
raw
    in  if Text -> Bool
T.null Text
label
            Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c) Text
label)
            Bool -> Bool -> Bool
|| HasCallStack => Text -> Char
Text -> Char
T.head Text
label Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
            Bool -> Bool -> Bool
|| HasCallStack => Text -> Char
Text -> Char
T.last Text
label Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
            Bool -> Bool -> Bool
|| Text
".." Text -> Text -> Bool
`T.isInfixOf` Text
label
            then PageRefusal -> Either PageRefusal Text
forall a b. a -> Either a b
Left (Text -> PageRefusal
VersionMalformed Text
raw)
            else Text -> Either PageRefusal Text
forall a b. b -> Either a b
Right Text
label

-- ---------------------------------------------------------
-- Page
-- ---------------------------------------------------------

-- | Every fact the page renders, supplied by the caller.
data PageInputs = PageInputs
    { PageInputs -> Text
pageStateToken :: Text
    -- ^ The registry, @POLICY.NAME@
    , PageInputs -> Text
pageStateOutput :: Text
    -- ^ The live state output holding the token
    , PageInputs -> Text
pageStateScript :: Text
    -- ^ The five script hashes the release derives, hex
    , PageInputs -> Text
pageApplicationScript :: Text
    , PageInputs -> Text
pageActiveScript :: Text
    , PageInputs -> Text
pageAbsentScript :: Text
    , PageInputs -> Text
pageTerminalScript :: Text
    , PageInputs -> ReleaseInfo
pageRelease :: ReleaseInfo
    , PageInputs -> Integer
pageProcessTime :: Integer
    -- ^ The processing window in milliseconds, from the state datum
    , PageInputs -> Integer
pageRetractTime :: Integer
    -- ^ The retract window in milliseconds, from the state datum
    , PageInputs -> Integer
pageTip :: Integer
    -- ^ Lovelace per request, from the state datum
    , PageInputs -> Int
pageMaxKeyBytes :: Int
    -- ^ The longest key in bytes, the release's own limit
    , PageInputs -> Text
pageRoot :: Text
    -- ^ The replayed root, hex
    , PageInputs -> Int
pageActiveKeys :: Int
    -- ^ Keys whose replayed leaf is active
    , PageInputs -> Int
pageTerminalKeys :: Int
    -- ^ Keys whose replayed leaf is terminal
    , PageInputs -> Int
pageFoldsSinceCreate :: Int
    , PageInputs -> Text
pageCreateTransaction :: Text
    -- ^ The transaction that minted the state token, hex
    , PageInputs -> Maybe Text
pageLastFold :: Maybe Text
    -- ^ The last fold transaction, hex, absent when no fold ran
    , PageInputs -> [Value]
pagePendingRequests :: [Value]
    -- ^ The objects @inspect@ prints for pending requests, any order
    }
    deriving stock (PageInputs -> PageInputs -> Bool
(PageInputs -> PageInputs -> Bool)
-> (PageInputs -> PageInputs -> Bool) -> Eq PageInputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageInputs -> PageInputs -> Bool
== :: PageInputs -> PageInputs -> Bool
$c/= :: PageInputs -> PageInputs -> Bool
/= :: PageInputs -> PageInputs -> Bool
Eq, Int -> PageInputs -> ShowS
[PageInputs] -> ShowS
PageInputs -> String
(Int -> PageInputs -> ShowS)
-> (PageInputs -> String)
-> ([PageInputs] -> ShowS)
-> Show PageInputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageInputs -> ShowS
showsPrec :: Int -> PageInputs -> ShowS
$cshow :: PageInputs -> String
show :: PageInputs -> String
$cshowList :: [PageInputs] -> ShowS
showList :: [PageInputs] -> ShowS
Show)

-- | A page: its inputs with pending requests in one fixed order, and its links.
data Page = Page PageInputs ReleaseLinks
    deriving stock (Page -> Page -> Bool
(Page -> Page -> Bool) -> (Page -> Page -> Bool) -> Eq Page
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Page -> Page -> Bool
== :: Page -> Page -> Bool
$c/= :: Page -> Page -> Bool
/= :: Page -> Page -> Bool
Eq, Int -> Page -> ShowS
[Page] -> ShowS
Page -> String
(Int -> Page -> ShowS)
-> (Page -> String) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Page -> ShowS
showsPrec :: Int -> Page -> ShowS
$cshow :: Page -> String
show :: Page -> String
$cshowList :: [Page] -> ShowS
showList :: [Page] -> ShowS
Show)

-- | The page value for explicit inputs: total, sorting pending by request reference.
describeRegistry :: PageInputs -> Page
describeRegistry :: PageInputs -> Page
describeRegistry PageInputs
inputs =
    PageInputs -> ReleaseLinks -> Page
Page
        (PageInputs
inputs{pagePendingRequests = sortPending (pagePendingRequests inputs)})
        (ReleaseInfo -> ReleaseLinks
releaseLinks (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs))

{- | Pending requests in one fixed order: by request output reference,
the transaction then the index, as the ledger orders outputs. Entries
without one sort by their bytes.
-}
sortPending :: [Value] -> [Value]
sortPending :: [Value] -> [Value]
sortPending = (Value -> (Text, Integer)) -> [Value] -> [Value]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn Value -> (Text, Integer)
pendingOrder

{- | What an entry sorts by: its request output reference, or its bytes
when it has none.
-}
pendingOrder :: Value -> (Text, Integer)
pendingOrder :: Value -> (Text, Integer)
pendingOrder = \case
    Object Object
o -> case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"request" Object
o of
        Just (String Text
ref) -> Text -> (Text, Integer)
forall {b}. (Read b, Num b) => Text -> (Text, b)
splitRef Text
ref
        Maybe Value
_ -> (Object -> Text
forall {a}. ToJSON a => a -> Text
encoded Object
o, -Integer
1)
    Value
v -> (Value -> Text
forall {a}. ToJSON a => a -> Text
encoded Value
v, -Integer
1)
  where
    encoded :: a -> Text
encoded a
w = ByteString -> Text
TE.decodeUtf8 (LazyByteString -> ByteString
BL.toStrict (a -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Aeson.encode a
w))
    splitRef :: Text -> (Text, b)
splitRef Text
ref = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"#" Text
ref of
        [Text
txid, Text
index] -> case String -> Maybe b
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
index) of
            Just b
n -> (Text
txid, b
n)
            Maybe b
_ -> (Text
ref, -b
1)
        [Text]
_ -> (Text
ref, -b
1)

-- | The JSON rendering: a receipt-shaped object with the page sections.
renderPageJson :: Page -> Value
renderPageJson :: Page -> Value
renderPageJson (Page PageInputs
inputs ReleaseLinks
links) =
    [Pair] -> Value
object
        [ Key
"command" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"describe" :: Text)
        , Key
"outcome" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"success" :: Text)
        , Key
"registry"
            Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                [ Key
"stateToken" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageStateToken PageInputs
inputs
                , Key
"stateOutput" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageStateOutput PageInputs
inputs
                , Key
"stateScript" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageStateScript PageInputs
inputs
                , Key
"applicationScript" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageApplicationScript PageInputs
inputs
                , Key
"activeScript" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageActiveScript PageInputs
inputs
                , Key
"absentScript" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageAbsentScript PageInputs
inputs
                , Key
"terminalScript" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageTerminalScript PageInputs
inputs
                ]
        , Key
"release"
            Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                [ Key
"version" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReleaseInfo -> Text
releaseVersion (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
                , Key
"blueprintTitle" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReleaseInfo -> Text
releaseBlueprintTitle (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
                , Key
"blueprintSha" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReleaseInfo -> Text
releaseBlueprintSha (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
                , Key
"applicationHash" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReleaseInfo -> Text
releaseApplicationHash (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
                , Key
"releaseUrl" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReleaseLinks -> Text
linkRelease ReleaseLinks
links
                , Key
"docsUrl" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReleaseLinks -> Text
linkDocs ReleaseLinks
links
                ]
        , Key
"rules"
            Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                [ Key
"processTime" Key -> Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Integer
pageProcessTime PageInputs
inputs
                , Key
"retractTime" Key -> Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Integer
pageRetractTime PageInputs
inputs
                , Key
"tip" Key -> Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Integer
pageTip PageInputs
inputs
                , Key
"maxKeyBytes" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Int
pageMaxKeyBytes PageInputs
inputs
                , Key
"publicFold" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
publicFoldText
                ]
        , Key
"state"
            Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
                [ Key
"root" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageRoot PageInputs
inputs
                , Key
"activeKeys" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Int
pageActiveKeys PageInputs
inputs
                , Key
"terminalKeys" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Int
pageTerminalKeys PageInputs
inputs
                , Key
"foldsSinceCreate" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Int
pageFoldsSinceCreate PageInputs
inputs
                , Key
"createTransaction" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageCreateTransaction PageInputs
inputs
                , Key
"lastFold" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Aeson.Null Text -> Value
forall a. ToJSON a => a -> Value
toJSON (PageInputs -> Maybe Text
pageLastFold PageInputs
inputs)
                , Key
"stateOutput" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PageInputs -> Text
pageStateOutput PageInputs
inputs
                , Key
"pendingRequests" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON (PageInputs -> [Value]
pagePendingRequests PageInputs
inputs)
                ]
        , Key
"provenance" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
provenanceText
        ]

-- | The text rendering: every JSON key as a @name:@ line, same facts as the JSON.
renderPageText :: Page -> Text
renderPageText :: Page -> Text
renderPageText (Page PageInputs
inputs ReleaseLinks
links) =
    [Text] -> Text
T.unlines
        ( [ Text
"command: describe"
          , Text
"outcome: success"
          , Text
"registry:"
          , Text
"  stateToken: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageStateToken PageInputs
inputs
          , Text
"  stateOutput: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageStateOutput PageInputs
inputs
          , Text
"  stateScript: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageStateScript PageInputs
inputs
          , Text
"  applicationScript: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageApplicationScript PageInputs
inputs
          , Text
"  activeScript: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageActiveScript PageInputs
inputs
          , Text
"  absentScript: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageAbsentScript PageInputs
inputs
          , Text
"  terminalScript: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageTerminalScript PageInputs
inputs
          , Text
"release:"
          , Text
"  version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseVersion (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
          , Text
"  blueprintTitle: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseBlueprintTitle (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
          , Text
"  blueprintSha: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseBlueprintSha (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
          , Text
"  applicationHash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseInfo -> Text
releaseApplicationHash (PageInputs -> ReleaseInfo
pageRelease PageInputs
inputs)
          , Text
"  releaseUrl: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseLinks -> Text
linkRelease ReleaseLinks
links
          , Text
"  docsUrl: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ReleaseLinks -> Text
linkDocs ReleaseLinks
links
          , Text
"rules:"
          , Text
"  processTime: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
number (PageInputs -> Integer
pageProcessTime PageInputs
inputs)
          , Text
"  retractTime: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
number (PageInputs -> Integer
pageRetractTime PageInputs
inputs)
          , Text
"  tip: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
number (PageInputs -> Integer
pageTip PageInputs
inputs)
          , Text
"  maxKeyBytes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (PageInputs -> Int
pageMaxKeyBytes PageInputs
inputs))
          , Text
"  publicFold: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
publicFoldText
          , Text
"state:"
          , Text
"  root: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageRoot PageInputs
inputs
          , Text
"  activeKeys: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (PageInputs -> Int
pageActiveKeys PageInputs
inputs))
          , Text
"  terminalKeys: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (PageInputs -> Int
pageTerminalKeys PageInputs
inputs))
          , Text
"  foldsSinceCreate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (PageInputs -> Int
pageFoldsSinceCreate PageInputs
inputs))
          , Text
"  createTransaction: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageCreateTransaction PageInputs
inputs
          , Text
"  lastFold: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"none" (PageInputs -> Maybe Text
pageLastFold PageInputs
inputs)
          , Text
"  stateOutput: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PageInputs -> Text
pageStateOutput PageInputs
inputs
          ]
            [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Value] -> [Text]
pendingLines (PageInputs -> [Value]
pagePendingRequests PageInputs
inputs)
            [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"provenance: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
provenanceText]
        )

-- | Pending requests as indented @name:@ lines, in the page's fixed order.
pendingLines :: [Value] -> [Text]
pendingLines :: [Value] -> [Text]
pendingLines [] = [Text
"  pendingRequests: []"]
pendingLines [Value]
entries = Text
"  pendingRequests:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Value -> [Text]) -> [Value] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Text]
entryLines [Value]
entries

-- | One pending request: the fields @inspect@ prints, then what it locks.
entryLines :: Value -> [Text]
entryLines :: Value -> [Text]
entryLines Value
entry =
    [ Text
"  - request: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"request" Value
entry
    , Text
"    owner: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"owner" Value
entry
    , Text
"    key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"key" Value
entry
    , Text
"    edge: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"edge" Value
entry
    , Text
"    submittedAt: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"submittedAt" Value
entry
    , Text
"    locked:"
    , Text
"      lovelace: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"lovelace" Value
locked
    , Text
"      assets:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if [Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
assets then Text
" []" else Text
""
    ]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Value -> [Text]) -> [Value] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Text]
assetLines [Value]
assets
  where
    locked :: Value
locked = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Aeson.Null (Text -> Value -> Maybe Value
field Text
"locked" Value
entry)
    assets :: [Value]
assets = case Text -> Value -> Maybe Value
field Text
"assets" Value
locked of
        Just (Array Array
items) -> Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
items
        Maybe Value
_ -> []

-- | One locked asset.
assetLines :: Value -> [Text]
assetLines :: Value -> [Text]
assetLines Value
asset =
    [ Text
"      - policy: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"policy" Value
asset
    , Text
"        name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"name" Value
asset
    , Text
"        quantity: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> Text
fieldText Text
"quantity" Value
asset
    ]

-- | One field of an object, or nothing.
field :: Text -> Value -> Maybe Value
field :: Text -> Value -> Maybe Value
field Text
name = \case
    Object Object
o -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
name) Object
o
    Value
_ -> Maybe Value
forall a. Maybe a
Nothing

-- | One field as text, or null when it has none.
fieldText :: Text -> Value -> Text
fieldText :: Text -> Value -> Text
fieldText Text
name Value
entry = Text -> (Value -> Text) -> Maybe Value -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"null" Value -> Text
scalar (Text -> Value -> Maybe Value
field Text
name Value
entry)

-- | One JSON value as text: strings bare, whole numbers plain, the rest compact.
scalar :: Value -> Text
scalar :: Value -> Text
scalar = \case
    String Text
t -> Text
t
    Number Scientific
n -> case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Integer of
        Right Integer
i -> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
i)
        Left Double
_ -> String -> Text
T.pack (Scientific -> String
forall a. Show a => a -> String
show Scientific
n)
    Bool Bool
b -> if Bool
b then Text
"true" else Text
"false"
    Value
Null -> Text
"null"
    Value
v -> ByteString -> Text
TE.decodeUtf8 (LazyByteString -> ByteString
BL.toStrict (Value -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Aeson.encode Value
v))

number :: Integer -> Text
number :: Integer -> Text
number = String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

-- | Anyone may build a fold from the public view.
publicFoldText :: Text
publicFoldText :: Text
publicFoldText =
    Text
"anyone may build a fold from the public view (Singular.Statements.fold_inputs_public)"

{- | What the page does not prove, in fixed text: what was replayed, from
which provider, that its answers are unverified, and whose claims the
label and the page are.
-}
provenanceText :: Text
provenanceText :: Text
provenanceText =
    Text
"the page shows the public history of the state token from create to the live \
    \state output, each fold's rebuilt root checked against the root recorded in that \
    \fold's state datum, and nothing beyond it. The history was read from Koios. \
    \The provider's answers are unverified: it supplies raw facts and untrusted \
    \reconstruction material, no ledger proofs and no anchor. The release label is \
    \the archive's own claim. The page is unsigned."