{-# LANGUAGE LambdaCase #-}

{- | Exact redacted source observations alongside the consumer's fact
receipts. Raw byte fields retain producer input; they assert no snapshot,
verification, ledger admission or inclusion.
-}
module Singular.Provider.Koios.Evidence (providerEventJson) where

import Data.Aeson (Value, object, (.=))
import Data.ByteString (ByteString)
import Data.ByteString.Base16 qualified as B16
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import Singular.Provider.Koios.Client qualified as Client
import Singular.Provider.Koios.Provider
    ( ProviderEvent (..)
    , TimeSource (..)
    )
import Singular.Provider.Koios.Wire qualified as Wire
import Singular.Registry.Evidence (SessionId (..))
import Singular.Registry.LedgerProvider (Network (..))
import Singular.Registry.NetworkTime (NetworkTimeManifest (..))

hex :: ByteString -> Text
hex :: ByteString -> Text
hex = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.encode

providerEventJson :: ProviderEvent -> Value
providerEventJson :: ProviderEvent -> Value
providerEventJson = \case
    SessionOpened (SessionId Text
identity) (Network Word32
magic) ->
        [Pair] -> Value
object
            [ Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"acquire" :: Text)
            , Key
"session" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
identity
            , Key
"networkMagic" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word32
magic
            , Key
"binding" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Unbound" :: Text)
            ]
    SessionClosed (SessionId Text
identity) ->
        [Pair] -> Value
object
            [Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"release" :: Text), Key
"session" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
identity]
    RawTimeFailure (SessionId Text
identity) ReadFailure
failure ->
        [Pair] -> Value
object
            [ Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"time-source-refusal" :: Text)
            , Key
"session" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
identity
            , Key
"refusal" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReadFailure -> String
forall a. Show a => a -> String
show ReadFailure
failure
            ]
    RawTime (SessionId Text
identity) (TimeSource NetworkTimeManifest
manifest ByteString
genesis ByteString
eras) ->
        [Pair] -> Value
object
            [ Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"raw-time" :: Text)
            , Key
"session" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
identity
            , Key
"networkMagic" Key -> Word32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkTimeManifest -> Word32
timeNetworkMagic NetworkTimeManifest
manifest
            , Key
"systemStartMs" Key -> Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkTimeManifest -> Integer
timeSystemStartMs NetworkTimeManifest
manifest
            , Key
"genesisSha256" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
hex (NetworkTimeManifest -> ByteString
timeGenesisSha256 NetworkTimeManifest
manifest)
            , Key
"eraHistorySha256" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
hex (NetworkTimeManifest -> ByteString
timeEraHistorySha256 NetworkTimeManifest
manifest)
            , Key
"horizonSlot" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkTimeManifest -> SlotNo
timeHorizonSlot NetworkTimeManifest
manifest
            , Key
"protocolMajor" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkTimeManifest -> Word64
timeProtocolMajor NetworkTimeManifest
manifest
            , Key
"sourceIdentity" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NetworkTimeManifest -> Text
timeSourceIdentity NetworkTimeManifest
manifest
            , Key
"genesisHex" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
hex ByteString
genesis
            , Key
"eraHistoryCbor" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
hex ByteString
eras
            ]
    RawExchange (SessionId Text
identity) RawRequest
request Exchange
exchange ->
        [Pair] -> Value
object
            [ Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"raw-exchange" :: Text)
            , Key
"session" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
identity
            , Key
"call" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Call -> Text
Wire.callName (RawRequest -> Call
Client.rawCall RawRequest
request)
            , Key
"method" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Method -> String
forall a. Show a => a -> String
show (RawRequest -> Method
Client.rawMethod RawRequest
request)
            , Key
"path" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RawRequest -> Text
Client.rawPath RawRequest
request
            , Key
"query" Key -> [(Text, Text)] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RawRequest -> [(Text, Text)]
Client.rawQuery RawRequest
request
            , Key
"headers" Key -> [(Text, Text)] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RawRequest -> [(Text, Text)]
Client.rawHeaders RawRequest
request
            , Key
"body" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Body -> Value
bodyJson (RawRequest -> Body
Client.rawBody RawRequest
request)
            , Key
"attempts" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Exchange -> Int
Client.exchangeAttempts Exchange
exchange
            , Key
"result" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= case Exchange -> Either NoAnswer Answer
Client.exchangeResult Exchange
exchange of
                Left NoAnswer
refusal -> [Pair] -> Value
object [Key
"noAnswer" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NoAnswer -> String
forall a. Show a => a -> String
show NoAnswer
refusal]
                Right Answer
answer ->
                    [Pair] -> Value
object
                        [ Key
"status" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Answer -> Int
Client.answerStatus Answer
answer
                        , Key
"headers" Key -> [(Text, Text)] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Answer -> [(Text, Text)]
Client.answerHeaders Answer
answer
                        , Key
"bodyHex" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
hex (Answer -> ByteString
Client.answerBody Answer
answer)
                        ]
            ]
  where
    bodyJson :: Body -> Value
bodyJson Body
Wire.NoBody = [Pair] -> Value
object [Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"none" :: Text)]
    bodyJson (Wire.JsonBody Value
document) =
        [Pair] -> Value
object
            [Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"json" :: Text), Key
"value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
document]
    bodyJson (Wire.CborBody ByteString
bytes) =
        [Pair] -> Value
object
            [Key
"kind" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"cbor" :: Text), Key
"bytesHex" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
hex ByteString
bytes]