{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}

{- |
Module      : Singular.Provider.Koios.Wire
Description : Koios requests and the decoders of their answers
License     : Apache-2.0

One request description per Koios call, and one decoder per answer,
from Koios JSON into Conway ledger types. Nothing here performs a
request: a transport carries the description and returns the raw
answer, and "Singular.Provider.Koios.Client" pages and decodes it with
these functions. A recorded answer and a live one therefore pass
through the same code.

A request is indexed by its access: every call reads, except
'submitTxRequest', which is the only 'Submission'. A component that must
never submit, such as the fixture recorder, accepts only
@'Request' ''Read'@.

A decoder that fails names the position that failed, as a JSON path
into the answer. Outputs keep everything the ledger keeps: the
address, the value with every policy and asset name, an inline datum's
bytes or else a datum hash, and a reference script's bytes, checked
against the script hash Koios names. A native reference script is
refused by name: Koios gives no bytes for it, only a summary. Koios
reports a @datum_hash@ for an inline datum too; the inline datum wins.
Transaction bytes are decoded as a Conway transaction and checked
against the transaction id Koios names.

A transaction's validity — false for a transaction recorded as a
phase-2 failure, whose collateral alone was spent — is read from the
transaction itself where its bytes are decoded, from Koios's
@valid_contract@ otherwise, and never used to drop a transaction.

Requests name addresses and stake addresses in bech32, so they cover
Shelley addresses; Koios names Byron addresses in base58, which this
module does not render.
-}
module Singular.Provider.Koios.Wire
    ( -- * Calls
      Call (..)
    , callName

      -- * Requests
    , Access (..)
    , Method (..)
    , Body (..)
    , Request (..)
    , tipRequest
    , addressUtxosRequest
    , assetUtxosRequest
    , assetTxsRequest
    , txInfoRequest
    , txCborRequest
    , epochParamsRequest
    , cliProtocolParamsRequest
    , submitTxRequest
    , txStatusRequest
    , accountInfoRequest
    , referenceScriptUtxosRequest
    , utxoInfoRequest
    , assetInfoRequest

      -- * Decoded facts
    , Tip (..)
    , AssetTx (..)
    , TxInfo (..)
    , TxCbor (..)
    , TxStatus (..)
    , AccountStatus (..)
    , UtxoInfo (..)
    , AssetInfo (..)

      -- * Decoders
    , DecodeFailure (..)
    , parseBody
    , decodeTip
    , decodeUtxos
    , decodeAssetTxs
    , decodeTxInfos
    , decodeTxCbors
    , decodeEpochParams
    , decodeCliProtocolParams
    , decodeSubmitted
    , decodeTxStatuses
    , decodeAccountStatuses
    , decodeReferenceScriptUtxos
    , decodeUtxoInfos
    , decodeAssetInfos

      -- * Renderings
    , renderAddress
    , parseAddress
    , renderRewardAccount
    , parseRewardAccount
    , txIdHex
    , policyHex
    , assetNameHex
    ) where

import Codec.Binary.Bech32 qualified as Bech32
import Control.Monad (unless, when, zipWithM)
import Data.Aeson
    ( Key
    , Object
    , Value (..)
    , eitherDecodeStrict'
    , object
    , withArray
    , withObject
    , (.:)
    , (.:?)
    , (.=)
    )
import Data.Aeson.Types
    ( IResult (..)
    , JSONPathElement (..)
    , Parser
    , formatPath
    , iparse
    , parseJSON
    , (<?>)
    )
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.Short qualified as SBS
import Data.Foldable (toList)
import Data.Int (Int64)
import Data.Kind (Type)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Maybe.Strict (maybeToStrictMaybe)
import Data.Scientific (Scientific, floatingOrInteger)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Word (Word16, Word32, Word64, Word8)
import Lens.Micro ((&), (.~), (^.))

import Cardano.Crypto.Hash.Class
    ( Hash
    , HashAlgorithm
    , hashFromBytes
    , hashToTextAsHex
    )
import Cardano.Ledger.Address
    ( AccountAddress (..)
    , Addr
    , decodeAddrEither
    , deserialiseAccountAddress
    , getNetwork
    , serialiseAccountAddress
    , serialiseAddr
    )
import Cardano.Ledger.Alonzo.Scripts
    ( fromPlutusScript
    , mkBinaryPlutusScript
    )
import Cardano.Ledger.Alonzo.Tx (IsValid (..))
import Cardano.Ledger.Api.PParams
    ( CoinPerByte (..)
    , emptyPParams
    , ppA0L
    , ppCoinsPerUTxOByteL
    , ppCollateralPercentageL
    , ppCostModelsL
    , ppEMaxL
    , ppKeyDepositL
    , ppMaxBBSizeL
    , ppMaxBHSizeL
    , ppMaxBlockExUnitsL
    , ppMaxCollateralInputsL
    , ppMaxTxExUnitsL
    , ppMaxTxSizeL
    , ppMaxValSizeL
    , ppMinPoolCostL
    , ppNOptL
    , ppPoolDepositL
    , ppPricesL
    , ppProtocolVersionL
    , ppRhoL
    , ppTauL
    , ppTxFeeFixedL
    , ppTxFeePerByteL
    )
import Cardano.Ledger.Api.Tx (bodyTxL, isValidTxL)
import Cardano.Ledger.Api.Tx.Out
    ( TxOut
    , datumTxOutL
    , mkBasicTxOut
    , referenceScriptTxOutL
    )
import Cardano.Ledger.BaseTypes
    ( BoundedRational (..)
    , EpochInterval (..)
    , EpochNo (..)
    , Network (..)
    , ProtVer (..)
    , UnitInterval
    , mkVersion
    , txIxFromIntegral
    , txIxToInt
    )
import Cardano.Ledger.Binary (decCBOR, decodeFullAnnotator)
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.PParams
    ( DRepVotingThresholds (..)
    , PoolVotingThresholds (..)
    , ppCommitteeMaxTermLengthL
    , ppCommitteeMinSizeL
    , ppDRepActivityL
    , ppDRepDepositL
    , ppDRepVotingThresholdsL
    , ppGovActionDepositL
    , ppGovActionLifetimeL
    , ppMinFeeRefScriptCostPerByteL
    , ppPoolVotingThresholdsL
    )
import Cardano.Ledger.Core
    ( PParams
    , Script
    , eraProtVerHigh
    , hashScript
    , txIdTxBody
    )
import Cardano.Ledger.Hashes
    ( ScriptHash (..)
    , extractHash
    , unsafeMakeSafeHash
    )
import Cardano.Ledger.Mary.Value
    ( AssetName (..)
    , MaryValue (..)
    , MultiAsset (..)
    , PolicyID (..)
    )
import Cardano.Ledger.Plutus.CostModels
    ( CostModels
    , mkCostModelsLenient
    )
import Cardano.Ledger.Plutus.Data (Datum (..), makeBinaryData)
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..), Prices (..))
import Cardano.Ledger.Plutus.Language
    ( Language (..)
    , PlutusBinary (..)
    )
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Slotting.Slot (SlotNo (..))
import Cardano.Tx.Ledger (ConwayTx)

-- | The Koios calls this client makes.
data Call
    = CallTip
    | CallAddressUtxos
    | CallAssetUtxos
    | CallAssetTxs
    | CallTxInfo
    | CallTxCbor
    | CallEpochParams
    | CallCliProtocolParams
    | CallSubmitTx
    | CallTxStatus
    | CallAccountInfo
    | CallReferenceScriptUtxos
    | CallUtxoInfo
    | CallAssetInfo
    deriving stock (Call -> Call -> Bool
(Call -> Call -> Bool) -> (Call -> Call -> Bool) -> Eq Call
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Call -> Call -> Bool
== :: Call -> Call -> Bool
$c/= :: Call -> Call -> Bool
/= :: Call -> Call -> Bool
Eq, Eq Call
Eq Call =>
(Call -> Call -> Ordering)
-> (Call -> Call -> Bool)
-> (Call -> Call -> Bool)
-> (Call -> Call -> Bool)
-> (Call -> Call -> Bool)
-> (Call -> Call -> Call)
-> (Call -> Call -> Call)
-> Ord Call
Call -> Call -> Bool
Call -> Call -> Ordering
Call -> Call -> Call
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Call -> Call -> Ordering
compare :: Call -> Call -> Ordering
$c< :: Call -> Call -> Bool
< :: Call -> Call -> Bool
$c<= :: Call -> Call -> Bool
<= :: Call -> Call -> Bool
$c> :: Call -> Call -> Bool
> :: Call -> Call -> Bool
$c>= :: Call -> Call -> Bool
>= :: Call -> Call -> Bool
$cmax :: Call -> Call -> Call
max :: Call -> Call -> Call
$cmin :: Call -> Call -> Call
min :: Call -> Call -> Call
Ord, Int -> Call -> ShowS
[Call] -> ShowS
Call -> String
(Int -> Call -> ShowS)
-> (Call -> String) -> ([Call] -> ShowS) -> Show Call
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Call -> ShowS
showsPrec :: Int -> Call -> ShowS
$cshow :: Call -> String
show :: Call -> String
$cshowList :: [Call] -> ShowS
showList :: [Call] -> ShowS
Show, Int -> Call
Call -> Int
Call -> [Call]
Call -> Call
Call -> Call -> [Call]
Call -> Call -> Call -> [Call]
(Call -> Call)
-> (Call -> Call)
-> (Int -> Call)
-> (Call -> Int)
-> (Call -> [Call])
-> (Call -> Call -> [Call])
-> (Call -> Call -> [Call])
-> (Call -> Call -> Call -> [Call])
-> Enum Call
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Call -> Call
succ :: Call -> Call
$cpred :: Call -> Call
pred :: Call -> Call
$ctoEnum :: Int -> Call
toEnum :: Int -> Call
$cfromEnum :: Call -> Int
fromEnum :: Call -> Int
$cenumFrom :: Call -> [Call]
enumFrom :: Call -> [Call]
$cenumFromThen :: Call -> Call -> [Call]
enumFromThen :: Call -> Call -> [Call]
$cenumFromTo :: Call -> Call -> [Call]
enumFromTo :: Call -> Call -> [Call]
$cenumFromThenTo :: Call -> Call -> Call -> [Call]
enumFromThenTo :: Call -> Call -> Call -> [Call]
Enum, Call
Call -> Call -> Bounded Call
forall a. a -> a -> Bounded a
$cminBound :: Call
minBound :: Call
$cmaxBound :: Call
maxBound :: Call
Bounded)

-- | The Koios endpoint name of a call, as in its path.
callName :: Call -> Text
callName :: Call -> Text
callName = \case
    Call
CallTip -> Text
"tip"
    Call
CallAddressUtxos -> Text
"address_utxos"
    Call
CallAssetUtxos -> Text
"asset_utxos"
    Call
CallAssetTxs -> Text
"asset_txs"
    Call
CallTxInfo -> Text
"tx_info"
    Call
CallTxCbor -> Text
"tx_cbor"
    Call
CallEpochParams -> Text
"epoch_params"
    Call
CallCliProtocolParams -> Text
"cli_protocol_params"
    Call
CallSubmitTx -> Text
"submittx"
    Call
CallTxStatus -> Text
"tx_status"
    Call
CallAccountInfo -> Text
"account_info"
    Call
CallReferenceScriptUtxos -> Text
"reference_script_utxos"
    Call
CallUtxoInfo -> Text
"utxo_info"
    Call
CallAssetInfo -> Text
"asset_info"

-- | Whether a request reads or submits.
data Access = Read | Submission

-- | HTTP method of a request.
data Method = Get | Post
    deriving stock (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, Eq Method
Eq Method =>
(Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Method -> Method -> Ordering
compare :: Method -> Method -> Ordering
$c< :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
>= :: Method -> Method -> Bool
$cmax :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
min :: Method -> Method -> Method
Ord, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show)

-- | Request body.
data Body
    = NoBody
    | -- | A JSON document
      JsonBody Value
    | -- | Raw CBOR bytes, as @submittx@ takes them
      CborBody ByteString
    deriving stock (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
/= :: Body -> Body -> Bool
Eq, Int -> Body -> ShowS
[Body] -> ShowS
Body -> String
(Int -> Body -> ShowS)
-> (Body -> String) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Body -> ShowS
showsPrec :: Int -> Body -> ShowS
$cshow :: Body -> String
show :: Body -> String
$cshowList :: [Body] -> ShowS
showList :: [Body] -> ShowS
Show)

{- | One Koios request, before paging. A paged request names the order
its rows are read in; the client adds offset and limit.
-}
type Request :: Access -> Type
data Request a = Request
    { forall (a :: Access). Request a -> Call
requestCall :: Call
    , forall (a :: Access). Request a -> Method
requestMethod :: Method
    , forall (a :: Access). Request a -> Text
requestPath :: Text
    -- ^ Path below the base URL, with its leading slash
    , forall (a :: Access). Request a -> [(Text, Text)]
requestQuery :: [(Text, Text)]
    , forall (a :: Access). Request a -> Body
requestBody :: Body
    , forall (a :: Access). Request a -> Maybe Text
requestOrder :: Maybe Text
    -- ^ @Just@ the order clause when the call is paged
    }
    deriving stock (Request a -> Request a -> Bool
(Request a -> Request a -> Bool)
-> (Request a -> Request a -> Bool) -> Eq (Request a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: Access). Request a -> Request a -> Bool
$c== :: forall (a :: Access). Request a -> Request a -> Bool
== :: Request a -> Request a -> Bool
$c/= :: forall (a :: Access). Request a -> Request a -> Bool
/= :: Request a -> Request a -> Bool
Eq, Int -> Request a -> ShowS
[Request a] -> ShowS
Request a -> String
(Int -> Request a -> ShowS)
-> (Request a -> String)
-> ([Request a] -> ShowS)
-> Show (Request a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: Access). Int -> Request a -> ShowS
forall (a :: Access). [Request a] -> ShowS
forall (a :: Access). Request a -> String
$cshowsPrec :: forall (a :: Access). Int -> Request a -> ShowS
showsPrec :: Int -> Request a -> ShowS
$cshow :: forall (a :: Access). Request a -> String
show :: Request a -> String
$cshowList :: forall (a :: Access). [Request a] -> ShowS
showList :: [Request a] -> ShowS
Show)

-- | A request whose path is its call's endpoint.
request
    :: Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request :: forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request Call
call Method
method [(Text, Text)]
query Body
body Maybe Text
order =
    Request
        { requestCall :: Call
requestCall = Call
call
        , requestMethod :: Method
requestMethod = Method
method
        , requestPath :: Text
requestPath = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Call -> Text
callName Call
call
        , requestQuery :: [(Text, Text)]
requestQuery = [(Text, Text)]
query
        , requestBody :: Body
requestBody = Body
body
        , requestOrder :: Maybe Text
requestOrder = Maybe Text
order
        }

-- | Output references: the stable order of the output listings.
byOutputReference :: Maybe Text
byOutputReference :: Maybe Text
byOutputReference = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"tx_hash.asc,tx_index.asc"

-- | @tip@: the chain tip.
tipRequest :: Request 'Read
tipRequest :: Request 'Read
tipRequest = Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request Call
CallTip Method
Get [] Body
NoBody Maybe Text
forall a. Maybe a
Nothing

-- | @address_utxos@, extended, ordered by output reference.
addressUtxosRequest :: [Addr] -> Request 'Read
addressUtxosRequest :: [Addr] -> Request 'Read
addressUtxosRequest [Addr]
addrs =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallAddressUtxos
        Method
Post
        []
        ( Value -> Body
JsonBody (Value -> Body) -> Value -> Body
forall a b. (a -> b) -> a -> b
$
            [Pair] -> Value
object
                [ Key
"_addresses" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Addr -> Text) -> [Addr] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Addr -> Text
renderAddress [Addr]
addrs
                , Key
"_extended" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                ]
        )
        Maybe Text
byOutputReference

-- | @asset_utxos@, extended, ordered by output reference.
assetUtxosRequest :: [(PolicyID, AssetName)] -> Request 'Read
assetUtxosRequest :: [(PolicyID, AssetName)] -> Request 'Read
assetUtxosRequest [(PolicyID, AssetName)]
assets =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallAssetUtxos
        Method
Post
        []
        ( Value -> Body
JsonBody (Value -> Body) -> Value -> Body
forall a b. (a -> b) -> a -> b
$
            [Pair] -> Value
object
                [ Key
"_asset_list"
                    Key -> [[Text]] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [[PolicyID -> Text
policyHex PolicyID
p, AssetName -> Text
assetNameHex AssetName
n] | (PolicyID
p, AssetName
n) <- [(PolicyID, AssetName)]
assets]
                , Key
"_extended" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                ]
        )
        Maybe Text
byOutputReference

{- | @asset_txs@ with history: every transaction that included the asset.
Koios lists them newest first; pages are read by block height then
transaction id only so that pages are stable. That order is not the
order in which the asset was passed on: Koios gives no index within a
block, and a transaction that included the asset need not have spent
it.
-}
assetTxsRequest :: PolicyID -> AssetName -> Request 'Read
assetTxsRequest :: PolicyID -> AssetName -> Request 'Read
assetTxsRequest PolicyID
p AssetName
n =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallAssetTxs
        Method
Get
        [ (Text
"_asset_policy", PolicyID -> Text
policyHex PolicyID
p)
        , (Text
"_asset_name", AssetName -> Text
assetNameHex AssetName
n)
        , (Text
"_history", Text
"true")
        ]
        Body
NoBody
        (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"block_height.asc,tx_hash.asc")

{- | @tx_info@ with inputs, assets, scripts and bytecode. Without
@_assets@ Koios answers every asset list empty.
-}
txInfoRequest :: [TxId] -> Request 'Read
txInfoRequest :: [TxId] -> Request 'Read
txInfoRequest [TxId]
ids =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallTxInfo
        Method
Post
        []
        ( Value -> Body
JsonBody (Value -> Body) -> Value -> Body
forall a b. (a -> b) -> a -> b
$
            [Pair] -> Value
object
                [ Key
"_tx_hashes" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TxId -> Text) -> [TxId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TxId -> Text
txIdHex [TxId]
ids
                , Key
"_inputs" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                , Key
"_assets" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                , Key
"_scripts" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                , Key
"_bytecode" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
                ]
        )
        Maybe Text
forall a. Maybe a
Nothing

-- | @tx_cbor@: the raw transactions.
txCborRequest :: [TxId] -> Request 'Read
txCborRequest :: [TxId] -> Request 'Read
txCborRequest [TxId]
ids =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallTxCbor
        Method
Post
        []
        (Value -> Body
JsonBody ([Pair] -> Value
object [Key
"_tx_hashes" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TxId -> Text) -> [TxId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TxId -> Text
txIdHex [TxId]
ids]))
        Maybe Text
forall a. Maybe a
Nothing

-- | @epoch_params@ of one epoch.
epochParamsRequest :: EpochNo -> Request 'Read
epochParamsRequest :: EpochNo -> Request 'Read
epochParamsRequest (EpochNo Word64
e) =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallEpochParams
        Method
Get
        [(Text
"_epoch_no", String -> Text
T.pack (Word64 -> String
forall a. Show a => a -> String
show Word64
e))]
        Body
NoBody
        Maybe Text
forall a. Maybe a
Nothing

{- | @cli_protocol_params@: the current protocol parameters in the
node's own JSON form.
-}
cliProtocolParamsRequest :: Request 'Read
cliProtocolParamsRequest :: Request 'Read
cliProtocolParamsRequest =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request Call
CallCliProtocolParams Method
Get [] Body
NoBody Maybe Text
forall a. Maybe a
Nothing

-- | @submittx@: submit a signed transaction's CBOR.
submitTxRequest :: ByteString -> Request 'Submission
submitTxRequest :: ByteString -> Request 'Submission
submitTxRequest ByteString
bytes =
    Call
-> Method
-> [(Text, Text)]
-> Body
-> Maybe Text
-> Request 'Submission
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request Call
CallSubmitTx Method
Post [] (ByteString -> Body
CborBody ByteString
bytes) Maybe Text
forall a. Maybe a
Nothing

-- | @tx_status@: confirmations of transactions.
txStatusRequest :: [TxId] -> Request 'Read
txStatusRequest :: [TxId] -> Request 'Read
txStatusRequest [TxId]
ids =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallTxStatus
        Method
Post
        []
        (Value -> Body
JsonBody ([Pair] -> Value
object [Key
"_tx_hashes" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TxId -> Text) -> [TxId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TxId -> Text
txIdHex [TxId]
ids]))
        Maybe Text
forall a. Maybe a
Nothing

-- | @account_info@ of one stake address.
accountInfoRequest :: AccountAddress -> Request 'Read
accountInfoRequest :: AccountAddress -> Request 'Read
accountInfoRequest AccountAddress
account =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallAccountInfo
        Method
Post
        []
        ( Value -> Body
JsonBody
            ([Pair] -> Value
object [Key
"_stake_addresses" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [AccountAddress -> Text
renderRewardAccount AccountAddress
account]])
        )
        Maybe Text
forall a. Maybe a
Nothing

{- | @reference_script_utxos@: every unspent output whose reference script
is one of the hashes, ordered by output reference. Koios names each row's
hash; a consumer computes it from the output instead.
-}
referenceScriptUtxosRequest :: [ScriptHash] -> Request 'Read
referenceScriptUtxosRequest :: [ScriptHash] -> Request 'Read
referenceScriptUtxosRequest [ScriptHash]
hashes =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallReferenceScriptUtxos
        Method
Post
        []
        (Value -> Body
JsonBody ([Pair] -> Value
object [Key
"_script_hashes" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (ScriptHash -> Text) -> [ScriptHash] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ScriptHash -> Text
scriptHashHex [ScriptHash]
hashes]))
        Maybe Text
byOutputReference

-- | @utxo_info@: whether each named output is spent.
utxoInfoRequest :: [TxIn] -> Request 'Read
utxoInfoRequest :: [TxIn] -> Request 'Read
utxoInfoRequest [TxIn]
references =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallUtxoInfo
        Method
Post
        []
        ( Value -> Body
JsonBody (Value -> Body) -> Value -> Body
forall a b. (a -> b) -> a -> b
$
            [Pair] -> Value
object
                [ Key
"_utxo_refs" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (TxIn -> Text) -> [TxIn] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> Text
outputReferenceText [TxIn]
references
                , Key
"_extended" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
False
                ]
        )
        Maybe Text
forall a. Maybe a
Nothing

-- | @asset_info@ of one asset: its latest minting transaction and supply.
assetInfoRequest :: (PolicyID, AssetName) -> Request 'Read
assetInfoRequest :: (PolicyID, AssetName) -> Request 'Read
assetInfoRequest (PolicyID
p, AssetName
n) =
    Call
-> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request 'Read
forall (a :: Access).
Call -> Method -> [(Text, Text)] -> Body -> Maybe Text -> Request a
request
        Call
CallAssetInfo
        Method
Post
        []
        (Value -> Body
JsonBody ([Pair] -> Value
object [Key
"_asset_list" Key -> [[Text]] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [[PolicyID -> Text
policyHex PolicyID
p, AssetName -> Text
assetNameHex AssetName
n]]]))
        Maybe Text
forall a. Maybe a
Nothing

scriptHashHex :: ScriptHash -> Text
scriptHashHex :: ScriptHash -> Text
scriptHashHex (ScriptHash Hash ADDRHASH EraIndependentScript
h) = Hash ADDRHASH EraIndependentScript -> Text
forall h a. Hash h a -> Text
hashToTextAsHex Hash ADDRHASH EraIndependentScript
h

outputReferenceText :: TxIn -> Text
outputReferenceText :: TxIn -> Text
outputReferenceText (TxIn TxId
txId TxIx
ix) =
    TxId -> Text
txIdHex TxId
txId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (TxIx -> Int
txIxToInt TxIx
ix))

-- | The chain tip.
data Tip = Tip
    { Tip -> SlotNo
tipSlot :: SlotNo
    , Tip -> ByteString
tipBlockHash :: ByteString
    , Tip -> Word64
tipBlockHeight :: Word64
    , Tip -> EpochNo
tipEpoch :: EpochNo
    , Tip -> Word64
tipBlockTime :: Word64
    -- ^ Required raw UNIX/POSIX seconds, never inferred from the tip slot.
    }
    deriving stock (Tip -> Tip -> Bool
(Tip -> Tip -> Bool) -> (Tip -> Tip -> Bool) -> Eq Tip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tip -> Tip -> Bool
== :: Tip -> Tip -> Bool
$c/= :: Tip -> Tip -> Bool
/= :: Tip -> Tip -> Bool
Eq, Int -> Tip -> ShowS
[Tip] -> ShowS
Tip -> String
(Int -> Tip -> ShowS)
-> (Tip -> String) -> ([Tip] -> ShowS) -> Show Tip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tip -> ShowS
showsPrec :: Int -> Tip -> ShowS
$cshow :: Tip -> String
show :: Tip -> String
$cshowList :: [Tip] -> ShowS
showList :: [Tip] -> ShowS
Show)

-- | One transaction that included an asset.
data AssetTx = AssetTx
    { AssetTx -> TxId
assetTxId :: TxId
    , AssetTx -> Word64
assetTxBlockHeight :: Word64
    , AssetTx -> EpochNo
assetTxEpoch :: EpochNo
    }
    deriving stock (AssetTx -> AssetTx -> Bool
(AssetTx -> AssetTx -> Bool)
-> (AssetTx -> AssetTx -> Bool) -> Eq AssetTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetTx -> AssetTx -> Bool
== :: AssetTx -> AssetTx -> Bool
$c/= :: AssetTx -> AssetTx -> Bool
/= :: AssetTx -> AssetTx -> Bool
Eq, Int -> AssetTx -> ShowS
[AssetTx] -> ShowS
AssetTx -> String
(Int -> AssetTx -> ShowS)
-> (AssetTx -> String) -> ([AssetTx] -> ShowS) -> Show AssetTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetTx -> ShowS
showsPrec :: Int -> AssetTx -> ShowS
$cshow :: AssetTx -> String
show :: AssetTx -> String
$cshowList :: [AssetTx] -> ShowS
showList :: [AssetTx] -> ShowS
Show)

{- | One transaction's resolved outputs: the outputs it spent, the
outputs it referenced and the outputs it created, each with its output
reference, and whether it is valid.
-}
data TxInfo = TxInfo
    { TxInfo -> TxId
txInfoId :: TxId
    , TxInfo -> Word64
txInfoBlockHeight :: Word64
    -- ^ Required raw block height, used to resolve omitted same-block creators.
    , TxInfo -> [(TxIn, TxOut ConwayEra)]
txInfoInputs :: [(TxIn, TxOut ConwayEra)]
    , TxInfo -> [(TxIn, TxOut ConwayEra)]
txInfoReferenceInputs :: [(TxIn, TxOut ConwayEra)]
    , TxInfo -> [(TxIn, TxOut ConwayEra)]
txInfoOutputs :: [(TxIn, TxOut ConwayEra)]
    , TxInfo -> Bool
txInfoValid :: Bool
    {- ^ Koios's @valid_contract@: at top level when present, else every
    script's; true for a transaction without scripts
    -}
    }
    deriving stock (TxInfo -> TxInfo -> Bool
(TxInfo -> TxInfo -> Bool)
-> (TxInfo -> TxInfo -> Bool) -> Eq TxInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxInfo -> TxInfo -> Bool
== :: TxInfo -> TxInfo -> Bool
$c/= :: TxInfo -> TxInfo -> Bool
/= :: TxInfo -> TxInfo -> Bool
Eq, Int -> TxInfo -> ShowS
[TxInfo] -> ShowS
TxInfo -> String
(Int -> TxInfo -> ShowS)
-> (TxInfo -> String) -> ([TxInfo] -> ShowS) -> Show TxInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxInfo -> ShowS
showsPrec :: Int -> TxInfo -> ShowS
$cshow :: TxInfo -> String
show :: TxInfo -> String
$cshowList :: [TxInfo] -> ShowS
showList :: [TxInfo] -> ShowS
Show)

{- | One transaction's raw bytes, decoded as a Conway transaction whose
id is the one Koios named.
-}
data TxCbor = TxCbor
    { TxCbor -> TxId
txCborId :: TxId
    , TxCbor -> ByteString
txCborBytes :: ByteString
    , TxCbor -> ConwayTx
txCborTx :: ConwayTx
    , TxCbor -> Bool
txCborValid :: Bool
    {- ^ The transaction's own validity flag; when Koios also sends
    @valid_contract@ the two agree
    -}
    }
    deriving stock (TxCbor -> TxCbor -> Bool
(TxCbor -> TxCbor -> Bool)
-> (TxCbor -> TxCbor -> Bool) -> Eq TxCbor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxCbor -> TxCbor -> Bool
== :: TxCbor -> TxCbor -> Bool
$c/= :: TxCbor -> TxCbor -> Bool
/= :: TxCbor -> TxCbor -> Bool
Eq, Int -> TxCbor -> ShowS
[TxCbor] -> ShowS
TxCbor -> String
(Int -> TxCbor -> ShowS)
-> (TxCbor -> String) -> ([TxCbor] -> ShowS) -> Show TxCbor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxCbor -> ShowS
showsPrec :: Int -> TxCbor -> ShowS
$cshow :: TxCbor -> String
show :: TxCbor -> String
$cshowList :: [TxCbor] -> ShowS
showList :: [TxCbor] -> ShowS
Show)

-- | One transaction's confirmations, or 'Nothing' when not yet seen.
data TxStatus = TxStatus
    { TxStatus -> TxId
txStatusId :: TxId
    , TxStatus -> Maybe Word64
txStatusConfirmations :: Maybe Word64
    }
    deriving stock (TxStatus -> TxStatus -> Bool
(TxStatus -> TxStatus -> Bool)
-> (TxStatus -> TxStatus -> Bool) -> Eq TxStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxStatus -> TxStatus -> Bool
== :: TxStatus -> TxStatus -> Bool
$c/= :: TxStatus -> TxStatus -> Bool
/= :: TxStatus -> TxStatus -> Bool
Eq, Int -> TxStatus -> ShowS
[TxStatus] -> ShowS
TxStatus -> String
(Int -> TxStatus -> ShowS)
-> (TxStatus -> String) -> ([TxStatus] -> ShowS) -> Show TxStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxStatus -> ShowS
showsPrec :: Int -> TxStatus -> ShowS
$cshow :: TxStatus -> String
show :: TxStatus -> String
$cshowList :: [TxStatus] -> ShowS
showList :: [TxStatus] -> ShowS
Show)

-- | One stake address's registration status, as Koios states it.
data AccountStatus = AccountStatus
    { AccountStatus -> Text
accountStakeAddress :: Text
    , AccountStatus -> Text
accountStatus :: Text
    }
    deriving stock (AccountStatus -> AccountStatus -> Bool
(AccountStatus -> AccountStatus -> Bool)
-> (AccountStatus -> AccountStatus -> Bool) -> Eq AccountStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountStatus -> AccountStatus -> Bool
== :: AccountStatus -> AccountStatus -> Bool
$c/= :: AccountStatus -> AccountStatus -> Bool
/= :: AccountStatus -> AccountStatus -> Bool
Eq, Int -> AccountStatus -> ShowS
[AccountStatus] -> ShowS
AccountStatus -> String
(Int -> AccountStatus -> ShowS)
-> (AccountStatus -> String)
-> ([AccountStatus] -> ShowS)
-> Show AccountStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountStatus -> ShowS
showsPrec :: Int -> AccountStatus -> ShowS
$cshow :: AccountStatus -> String
show :: AccountStatus -> String
$cshowList :: [AccountStatus] -> ShowS
showList :: [AccountStatus] -> ShowS
Show)

-- | One named output and whether Koios reports it spent.
data UtxoInfo = UtxoInfo
    { UtxoInfo -> TxIn
utxoInfoReference :: TxIn
    , UtxoInfo -> Bool
utxoInfoSpent :: Bool
    }
    deriving stock (UtxoInfo -> UtxoInfo -> Bool
(UtxoInfo -> UtxoInfo -> Bool)
-> (UtxoInfo -> UtxoInfo -> Bool) -> Eq UtxoInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UtxoInfo -> UtxoInfo -> Bool
== :: UtxoInfo -> UtxoInfo -> Bool
$c/= :: UtxoInfo -> UtxoInfo -> Bool
/= :: UtxoInfo -> UtxoInfo -> Bool
Eq, Int -> UtxoInfo -> ShowS
[UtxoInfo] -> ShowS
UtxoInfo -> String
(Int -> UtxoInfo -> ShowS)
-> (UtxoInfo -> String) -> ([UtxoInfo] -> ShowS) -> Show UtxoInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UtxoInfo -> ShowS
showsPrec :: Int -> UtxoInfo -> ShowS
$cshow :: UtxoInfo -> String
show :: UtxoInfo -> String
$cshowList :: [UtxoInfo] -> ShowS
showList :: [UtxoInfo] -> ShowS
Show)

{- | One asset's latest minting transaction and its current total supply,
as @asset_info@ states them.
-}
data AssetInfo = AssetInfo
    { AssetInfo -> TxId
assetInfoMintingTx :: TxId
    , AssetInfo -> Integer
assetInfoSupply :: Integer
    }
    deriving stock (AssetInfo -> AssetInfo -> Bool
(AssetInfo -> AssetInfo -> Bool)
-> (AssetInfo -> AssetInfo -> Bool) -> Eq AssetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssetInfo -> AssetInfo -> Bool
== :: AssetInfo -> AssetInfo -> Bool
$c/= :: AssetInfo -> AssetInfo -> Bool
/= :: AssetInfo -> AssetInfo -> Bool
Eq, Int -> AssetInfo -> ShowS
[AssetInfo] -> ShowS
AssetInfo -> String
(Int -> AssetInfo -> ShowS)
-> (AssetInfo -> String)
-> ([AssetInfo] -> ShowS)
-> Show AssetInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssetInfo -> ShowS
showsPrec :: Int -> AssetInfo -> ShowS
$cshow :: AssetInfo -> String
show :: AssetInfo -> String
$cshowList :: [AssetInfo] -> ShowS
showList :: [AssetInfo] -> ShowS
Show)

-- | An answer that does not decode, with the position that failed.
data DecodeFailure = DecodeFailure
    { DecodeFailure -> Text
decodePosition :: Text
    -- ^ JSON path into the answer, @$@ for the body as a whole
    , DecodeFailure -> Text
decodeReason :: Text
    }
    deriving stock (DecodeFailure -> DecodeFailure -> Bool
(DecodeFailure -> DecodeFailure -> Bool)
-> (DecodeFailure -> DecodeFailure -> Bool) -> Eq DecodeFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeFailure -> DecodeFailure -> Bool
== :: DecodeFailure -> DecodeFailure -> Bool
$c/= :: DecodeFailure -> DecodeFailure -> Bool
/= :: DecodeFailure -> DecodeFailure -> Bool
Eq, Int -> DecodeFailure -> ShowS
[DecodeFailure] -> ShowS
DecodeFailure -> String
(Int -> DecodeFailure -> ShowS)
-> (DecodeFailure -> String)
-> ([DecodeFailure] -> ShowS)
-> Show DecodeFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeFailure -> ShowS
showsPrec :: Int -> DecodeFailure -> ShowS
$cshow :: DecodeFailure -> String
show :: DecodeFailure -> String
$cshowList :: [DecodeFailure] -> ShowS
showList :: [DecodeFailure] -> ShowS
Show)

{- | Parse an answer body as one JSON document. A body that is not one,
such as a body cut off mid-array, fails with the parser's reason.
-}
parseBody :: ByteString -> Either DecodeFailure Value
parseBody :: ByteString -> Either DecodeFailure Value
parseBody ByteString
body = case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
body of
    Right Value
v -> Value -> Either DecodeFailure Value
forall a b. b -> Either a b
Right Value
v
    Left String
e -> DecodeFailure -> Either DecodeFailure Value
forall a b. a -> Either a b
Left (Text -> Text -> DecodeFailure
DecodeFailure Text
"$" (String -> Text
T.pack String
e))

-- | Run a parser, naming the JSON path that failed.
runParser :: (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser :: forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser Value -> Parser a
p Value
v = case (Value -> Parser a) -> Value -> IResult a
forall a b. (a -> Parser b) -> a -> IResult b
iparse Value -> Parser a
p Value
v of
    ISuccess a
a -> a -> Either DecodeFailure a
forall a b. b -> Either a b
Right a
a
    IError JSONPath
path String
e ->
        DecodeFailure -> Either DecodeFailure a
forall a b. a -> Either a b
Left (Text -> Text -> DecodeFailure
DecodeFailure (String -> Text
T.pack (JSONPath -> String
formatPath JSONPath
path)) (String -> Text
T.pack String
e))

-- | Each row of an array, its index on the path.
rows :: (Object -> Parser a) -> Value -> Parser [a]
rows :: forall a. (Object -> Parser a) -> Value -> Parser [a]
rows Object -> Parser a
p = String -> (Array -> Parser [a]) -> Value -> Parser [a]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"rows" ((Array -> Parser [a]) -> Value -> Parser [a])
-> (Array -> Parser [a]) -> Value -> Parser [a]
forall a b. (a -> b) -> a -> b
$ \Array
arr ->
    (Int -> Value -> Parser a) -> [Int] -> [Value] -> Parser [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (\Int
i Value
v -> String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"row" Object -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
i)
        [Int
0 ..]
        (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
arr)

{- | Decode a @tip@ answer: empty when Koios returned no row.
Koios API 1.4.2, cardano-community/koios-artifacts revision
2e2eb57933e1e2528de5ca36ee961759841cf389,
specs/results/koiosapi-preprod.yaml:
#/components/schemas/tip/items/properties/block_time refers to
#/components/schemas/blocks/items/properties/block_time, UNIX seconds.
Missing, fractional, negative or overflowing raw seconds refuse by name.
-}
decodeTip :: Value -> Either DecodeFailure [Tip]
decodeTip :: Value -> Either DecodeFailure [Tip]
decodeTip = (Value -> Parser [Tip]) -> Value -> Either DecodeFailure [Tip]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [Tip]) -> Value -> Either DecodeFailure [Tip])
-> (Value -> Parser [Tip]) -> Value -> Either DecodeFailure [Tip]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser Tip) -> Value -> Parser [Tip]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser Tip) -> Value -> Parser [Tip])
-> (Object -> Parser Tip) -> Value -> Parser [Tip]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SlotNo -> ByteString -> Word64 -> EpochNo -> Word64 -> Tip
Tip (SlotNo -> ByteString -> Word64 -> EpochNo -> Word64 -> Tip)
-> (Word64 -> SlotNo)
-> Word64
-> ByteString
-> Word64
-> EpochNo
-> Word64
-> Tip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo
        (Word64 -> ByteString -> Word64 -> EpochNo -> Word64 -> Tip)
-> Parser Word64
-> Parser (ByteString -> Word64 -> EpochNo -> Word64 -> Tip)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"abs_slot"
        Parser (ByteString -> Word64 -> EpochNo -> Word64 -> Tip)
-> Parser ByteString -> Parser (Word64 -> EpochNo -> Word64 -> Tip)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Text -> Parser ByteString
hexSized Int
32)
        Parser (Word64 -> EpochNo -> Word64 -> Tip)
-> Parser Word64 -> Parser (EpochNo -> Word64 -> Tip)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_height"
        Parser (EpochNo -> Word64 -> Tip)
-> Parser EpochNo -> Parser (Word64 -> Tip)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Parser Word64 -> Parser EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"epoch_no")
        Parser (Word64 -> Tip) -> Parser Word64 -> Parser Tip
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_time" Parser Word64 -> JSONPathElement -> Parser Word64
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"block_time")

-- | Decode the rows of an @address_utxos@ or @asset_utxos@ page.
decodeUtxos :: Value -> Either DecodeFailure [(TxIn, TxOut ConwayEra)]
decodeUtxos :: Value -> Either DecodeFailure [(TxIn, TxOut ConwayEra)]
decodeUtxos = (Value -> Parser [(TxIn, TxOut ConwayEra)])
-> Value -> Either DecodeFailure [(TxIn, TxOut ConwayEra)]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [(TxIn, TxOut ConwayEra)])
 -> Value -> Either DecodeFailure [(TxIn, TxOut ConwayEra)])
-> (Value -> Parser [(TxIn, TxOut ConwayEra)])
-> Value
-> Either DecodeFailure [(TxIn, TxOut ConwayEra)]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser (TxIn, TxOut ConwayEra))
-> Value -> Parser [(TxIn, TxOut ConwayEra)]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser (TxIn, TxOut ConwayEra))
 -> Value -> Parser [(TxIn, TxOut ConwayEra)])
-> (Object -> Parser (TxIn, TxOut ConwayEra))
-> Value
-> Parser [(TxIn, TxOut ConwayEra)]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    txIn <- Object -> Parser TxIn
txInOf Object
o
    address <- o .: "address" >>= addressOf
    out <- outputOf address o
    pure (txIn, out)

-- | One output reference.
txInOf :: Object -> Parser TxIn
txInOf :: Object -> Parser TxIn
txInOf Object
o = do
    txId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_hash" Parser Text -> (Text -> Parser TxId) -> Parser TxId
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser TxId
txIdOf
    ix <- o .: "tx_index"
    case txIxFromIntegral (ix :: Integer) of
        Just TxIx
txIx -> TxIn -> Parser TxIn
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxId -> TxIx -> TxIn
TxIn TxId
txId TxIx
txIx)
        Maybe TxIx
Nothing -> String -> Parser TxIn
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"output index out of range: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
ix)

-- | One output: value, assets, datum and reference script.
outputOf :: Addr -> Object -> Parser (TxOut ConwayEra)
outputOf :: Addr -> Object -> Parser (TxOut ConwayEra)
outputOf Addr
address Object
o = do
    lovelace <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value" Parser Value -> (Value -> Parser Integer) -> Parser Integer
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Integer
integral
    assets <-
        o .:? "asset_list"
            >>= maybe (pure []) (zipWithM (\Int
i Value
a -> Value -> Parser (PolicyID, Map AssetName Integer)
assetOf Value
a Parser (PolicyID, Map AssetName Integer)
-> JSONPathElement -> Parser (PolicyID, Map AssetName Integer)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
i) [0 ..])
    inline <- o .:? "inline_datum"
    hashed <- o .:? "datum_hash"
    datum <- case (inline, hashed) of
        (Just Value
d, Maybe Value
_) -> Value -> Parser (Datum ConwayEra)
inlineDatumOf Value
d Parser (Datum ConwayEra)
-> JSONPathElement -> Parser (Datum ConwayEra)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"inline_datum"
        (Maybe Value
Nothing, Just Value
h) -> Value -> Parser (Datum ConwayEra)
datumHashOf Value
h Parser (Datum ConwayEra)
-> JSONPathElement -> Parser (Datum ConwayEra)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"datum_hash"
        (Maybe Value
Nothing, Maybe Value
Nothing) -> Datum ConwayEra -> Parser (Datum ConwayEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum ConwayEra
forall era. Datum era
NoDatum
    script <-
        o .:? "reference_script" >>= \case
            Maybe Value
Nothing -> Maybe (AlonzoScript ConwayEra)
-> Parser (Maybe (AlonzoScript ConwayEra))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (AlonzoScript ConwayEra)
forall a. Maybe a
Nothing
            Just Value
s -> AlonzoScript ConwayEra -> Maybe (AlonzoScript ConwayEra)
forall a. a -> Maybe a
Just (AlonzoScript ConwayEra -> Maybe (AlonzoScript ConwayEra))
-> Parser (AlonzoScript ConwayEra)
-> Parser (Maybe (AlonzoScript ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Script ConwayEra)
scriptOf Value
s Parser (AlonzoScript ConwayEra)
-> JSONPathElement -> Parser (AlonzoScript ConwayEra)
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"reference_script"
    let value =
            Coin -> MultiAsset -> MaryValue
MaryValue
                (Integer -> Coin
Coin Integer
lovelace)
                (Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset ((Map AssetName Integer
 -> Map AssetName Integer -> Map AssetName Integer)
-> [(PolicyID, Map AssetName Integer)]
-> Map PolicyID (Map AssetName Integer)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((Integer -> Integer -> Integer)
-> Map AssetName Integer
-> Map AssetName Integer
-> Map AssetName Integer
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)) [(PolicyID, Map AssetName Integer)]
assets))
    pure $
        mkBasicTxOut address value
            & datumTxOutL .~ datum
            & referenceScriptTxOutL .~ maybeToStrictMaybe script

-- | One entry of an asset list.
assetOf :: Value -> Parser (PolicyID, Map.Map AssetName Integer)
assetOf :: Value -> Parser (PolicyID, Map AssetName Integer)
assetOf = String
-> (Object -> Parser (PolicyID, Map AssetName Integer))
-> Value
-> Parser (PolicyID, Map AssetName Integer)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"asset" ((Object -> Parser (PolicyID, Map AssetName Integer))
 -> Value -> Parser (PolicyID, Map AssetName Integer))
-> (Object -> Parser (PolicyID, Map AssetName Integer))
-> Value
-> Parser (PolicyID, Map AssetName Integer)
forall a b. (a -> b) -> a -> b
$ \Object
a -> do
    policy <- Object
a Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"policy_id" Parser Text -> (Text -> Parser PolicyID) -> Parser PolicyID
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Hash ADDRHASH EraIndependentScript -> PolicyID)
-> Parser (Hash ADDRHASH EraIndependentScript) -> Parser PolicyID
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID)
-> (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript
-> PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash) (Parser (Hash ADDRHASH EraIndependentScript) -> Parser PolicyID)
-> (Text -> Parser (Hash ADDRHASH EraIndependentScript))
-> Text
-> Parser PolicyID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => Text -> Parser (Hash h a)
hashOf
    name <- a .:? "asset_name" >>= maybe (pure "") hexAny
    when (BS.length name > 32) $ fail "asset name longer than 32 bytes"
    quantity <- a .: "quantity" >>= integral
    pure (policy, Map.singleton (AssetName (SBS.toShort name)) quantity)

inlineDatumOf :: Value -> Parser (Datum ConwayEra)
inlineDatumOf :: Value -> Parser (Datum ConwayEra)
inlineDatumOf = String
-> (Object -> Parser (Datum ConwayEra))
-> Value
-> Parser (Datum ConwayEra)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"inline_datum" ((Object -> Parser (Datum ConwayEra))
 -> Value -> Parser (Datum ConwayEra))
-> (Object -> Parser (Datum ConwayEra))
-> Value
-> Parser (Datum ConwayEra)
forall a b. (a -> b) -> a -> b
$ \Object
d -> do
    bytes <- Object
d Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bytes" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
hexAny
    case makeBinaryData (SBS.toShort bytes) of
        Right BinaryData ConwayEra
binary -> Datum ConwayEra -> Parser (Datum ConwayEra)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BinaryData ConwayEra -> Datum ConwayEra
forall era. BinaryData era -> Datum era
Datum BinaryData ConwayEra
binary)
        Left String
e -> String -> Parser (Datum ConwayEra)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"inline datum is not plutus data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)

datumHashOf :: Value -> Parser (Datum ConwayEra)
datumHashOf :: Value -> Parser (Datum ConwayEra)
datumHashOf Value
v = DataHash -> Datum ConwayEra
forall era. DataHash -> Datum era
DatumHash (DataHash -> Datum ConwayEra)
-> (Hash HASH EraIndependentData -> DataHash)
-> Hash HASH EraIndependentData
-> Datum ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH EraIndependentData -> DataHash
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Hash HASH EraIndependentData -> Datum ConwayEra)
-> Parser (Hash HASH EraIndependentData)
-> Parser (Datum ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Text
-> (Text -> Parser (Hash HASH EraIndependentData))
-> Parser (Hash HASH EraIndependentData)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser (Hash HASH EraIndependentData)
forall h a. HashAlgorithm h => Text -> Parser (Hash h a)
hashOf)

-- | A reference script, checked against the hash Koios names.
scriptOf :: Value -> Parser (Script ConwayEra)
scriptOf :: Value -> Parser (Script ConwayEra)
scriptOf = String
-> (Object -> Parser (Script ConwayEra))
-> Value
-> Parser (Script ConwayEra)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"reference_script" ((Object -> Parser (Script ConwayEra))
 -> Value -> Parser (Script ConwayEra))
-> (Object -> Parser (Script ConwayEra))
-> Value
-> Parser (Script ConwayEra)
forall a b. (a -> b) -> a -> b
$ \Object
s -> do
    kind <- Object
s Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    when (kind `elem` ["timelock", "multisig"]) $
        fail
            ( "a native ("
                <> T.unpack kind
                <> ") reference script: Koios gives no bytes for it, only a summary"
            )
    bytes <- s .: "bytes" >>= hexAny
    expected <- s .: "hash" >>= fmap ScriptHash . hashOf
    script <- case kind :: Text of
        Text
"plutusV1" -> Language -> ByteString -> Parser (Script ConwayEra)
forall {era} {f :: * -> *}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, MonadFail f) =>
Language -> ByteString -> f (Script era)
plutus Language
PlutusV1 ByteString
bytes
        Text
"plutusV2" -> Language -> ByteString -> Parser (Script ConwayEra)
forall {era} {f :: * -> *}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, MonadFail f) =>
Language -> ByteString -> f (Script era)
plutus Language
PlutusV2 ByteString
bytes
        Text
"plutusV3" -> Language -> ByteString -> Parser (Script ConwayEra)
forall {era} {f :: * -> *}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraScript era, MonadFail f) =>
Language -> ByteString -> f (Script era)
plutus Language
PlutusV3 ByteString
bytes
        Text
other ->
            String -> Parser (AlonzoScript ConwayEra)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unsupported reference script type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
other)
    let actual = forall era. EraScript era => Script era -> ScriptHash
hashScript @ConwayEra AlonzoScript ConwayEra
Script ConwayEra
script
    unless (actual == expected) $
        fail ("script bytes hash to " <> show actual)
    pure script
  where
    plutus :: Language -> ByteString -> f (Script era)
plutus Language
lang ByteString
bytes =
        case Language -> PlutusBinary -> Maybe (PlutusScript era)
forall (m :: * -> *) era.
(MonadFail m, AlonzoEraScript era) =>
Language -> PlutusBinary -> m (PlutusScript era)
mkBinaryPlutusScript Language
lang (ShortByteString -> PlutusBinary
PlutusBinary (ByteString -> ShortByteString
SBS.toShort ByteString
bytes)) of
            Just PlutusScript era
ps -> Script era -> f (Script era)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
ps)
            Maybe (PlutusScript era)
Nothing -> String -> f (Script era)
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"not a " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Language -> String
forall a. Show a => a -> String
show Language
lang String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" script in this era")

-- | Decode the rows of an @asset_txs@ page.
decodeAssetTxs :: Value -> Either DecodeFailure [AssetTx]
decodeAssetTxs :: Value -> Either DecodeFailure [AssetTx]
decodeAssetTxs = (Value -> Parser [AssetTx])
-> Value -> Either DecodeFailure [AssetTx]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [AssetTx])
 -> Value -> Either DecodeFailure [AssetTx])
-> (Value -> Parser [AssetTx])
-> Value
-> Either DecodeFailure [AssetTx]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser AssetTx) -> Value -> Parser [AssetTx]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser AssetTx) -> Value -> Parser [AssetTx])
-> (Object -> Parser AssetTx) -> Value -> Parser [AssetTx]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    TxId -> Word64 -> EpochNo -> AssetTx
AssetTx
        (TxId -> Word64 -> EpochNo -> AssetTx)
-> Parser TxId -> Parser (Word64 -> EpochNo -> AssetTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_hash" Parser Text -> (Text -> Parser TxId) -> Parser TxId
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser TxId
txIdOf)
        Parser (Word64 -> EpochNo -> AssetTx)
-> Parser Word64 -> Parser (EpochNo -> AssetTx)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_height"
        Parser (EpochNo -> AssetTx) -> Parser EpochNo -> Parser AssetTx
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Parser Word64 -> Parser EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"epoch_no")

{- | Decode a @tx_info@ answer. The same pinned schema's
#/components/schemas/tx_info/items/properties/block_height refers to
#/components/schemas/blocks/items/properties/block_height, a block height.
-}
decodeTxInfos :: Value -> Either DecodeFailure [TxInfo]
decodeTxInfos :: Value -> Either DecodeFailure [TxInfo]
decodeTxInfos = (Value -> Parser [TxInfo])
-> Value -> Either DecodeFailure [TxInfo]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [TxInfo])
 -> Value -> Either DecodeFailure [TxInfo])
-> (Value -> Parser [TxInfo])
-> Value
-> Either DecodeFailure [TxInfo]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser TxInfo) -> Value -> Parser [TxInfo]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser TxInfo) -> Value -> Parser [TxInfo])
-> (Object -> Parser TxInfo) -> Value -> Parser [TxInfo]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    txId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_hash" Parser Text -> (Text -> Parser TxId) -> Parser TxId
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser TxId
txIdOf
    height <- o .: "block_height" <?> Key "block_height"
    inputs <- o .: "inputs" >>= ioRows "inputs"
    references <-
        o .:? "reference_inputs"
            >>= maybe (pure []) (ioRows "reference_inputs")
    outputs <- o .: "outputs" >>= ioRows "outputs"
    topLevel <- o .:? "valid_contract"
    contracts <-
        o .:? "plutus_contracts"
            >>= maybe (pure []) (mapM contractValid)
    pure
        TxInfo
            { txInfoId = txId
            , txInfoBlockHeight = height
            , txInfoInputs = inputs
            , txInfoReferenceInputs = references
            , txInfoOutputs = outputs
            , txInfoValid = fromMaybe (and contracts) topLevel
            }
  where
    ioRows :: Key -> Value -> Parser [(TxIn, TxOut ConwayEra)]
    ioRows :: Key -> Value -> Parser [(TxIn, TxOut ConwayEra)]
ioRows Key
key Value
v = (Object -> Parser (TxIn, BabbageTxOut ConwayEra))
-> Value -> Parser [(TxIn, BabbageTxOut ConwayEra)]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows Object -> Parser (TxIn, BabbageTxOut ConwayEra)
ioRow Value
v Parser [(TxIn, BabbageTxOut ConwayEra)]
-> JSONPathElement -> Parser [(TxIn, BabbageTxOut ConwayEra)]
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
    ioRow :: Object -> Parser (TxIn, BabbageTxOut ConwayEra)
ioRow Object
o = do
        txIn <- Object -> Parser TxIn
txInOf Object
o
        address <-
            o .: "payment_addr"
                >>= withObject "payment_addr" (.: "bech32")
                >>= addressOf
        out <- outputOf address o
        pure (txIn, out)
    contractValid :: Value -> Parser Bool
contractValid = String -> (Object -> Parser Bool) -> Value -> Parser Bool
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"plutus_contract" (Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"valid_contract")

-- | Decode a @tx_cbor@ answer, each transaction checked against its id.
decodeTxCbors :: Value -> Either DecodeFailure [TxCbor]
decodeTxCbors :: Value -> Either DecodeFailure [TxCbor]
decodeTxCbors = (Value -> Parser [TxCbor])
-> Value -> Either DecodeFailure [TxCbor]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [TxCbor])
 -> Value -> Either DecodeFailure [TxCbor])
-> (Value -> Parser [TxCbor])
-> Value
-> Either DecodeFailure [TxCbor]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser TxCbor) -> Value -> Parser [TxCbor]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser TxCbor) -> Value -> Parser [TxCbor])
-> (Object -> Parser TxCbor) -> Value -> Parser [TxCbor]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    txId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_hash" Parser Text -> (Text -> Parser TxId) -> Parser TxId
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser TxId
txIdOf
    bytes <- o .: "cbor" >>= hexAny
    tx <- case decodeConwayTx bytes of
        Right ConwayTx
tx -> ConwayTx -> Parser ConwayTx
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConwayTx
tx
        Left String
e -> String -> Parser ConwayTx
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"not a Conway transaction: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e) Parser ConwayTx -> JSONPathElement -> Parser ConwayTx
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"cbor"
    let actual = TxBody TopTx ConwayEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
txIdTxBody (ConwayTx
tx ConwayTx
-> Getting
     (TxBody TopTx ConwayEra) ConwayTx (TxBody TopTx ConwayEra)
-> TxBody TopTx ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting (TxBody TopTx ConwayEra) ConwayTx (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL)
    when (actual /= txId) $
        fail ("transaction bytes hash to " <> T.unpack (txIdHex actual))
            <?> Key "cbor"
    let IsValid valid = tx ^. isValidTxL
    stated <- o .:? "valid_contract"
    when (maybe False (/= valid) stated) $
        fail "valid_contract disagrees with the transaction's own flag"
            <?> Key "valid_contract"
    pure
        TxCbor
            { txCborId = txId
            , txCborBytes = bytes
            , txCborTx = tx
            , txCborValid = valid
            }

decodeConwayTx :: ByteString -> Either String ConwayTx
decodeConwayTx :: ByteString -> Either String ConwayTx
decodeConwayTx ByteString
bytes =
    (DecoderError -> Either String ConwayTx)
-> (ConwayTx -> Either String ConwayTx)
-> Either DecoderError ConwayTx
-> Either String ConwayTx
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String ConwayTx
forall a b. a -> Either a b
Left (String -> Either String ConwayTx)
-> (DecoderError -> String)
-> DecoderError
-> Either String ConwayTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall a. Show a => a -> String
show) ConwayTx -> Either String ConwayTx
forall a b. b -> Either a b
Right (Either DecoderError ConwayTx -> Either String ConwayTx)
-> Either DecoderError ConwayTx -> Either String ConwayTx
forall a b. (a -> b) -> a -> b
$
        Version
-> Text
-> (forall s. Decoder s (Annotator ConwayTx))
-> ByteString
-> Either DecoderError ConwayTx
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator
            (forall era. Era era => Version
eraProtVerHigh @ConwayEra)
            Text
"ConwayTx"
            Decoder s (Annotator ConwayTx)
forall s. Decoder s (Annotator ConwayTx)
forall a s. DecCBOR a => Decoder s a
decCBOR
            (ByteString -> ByteString
BSL.fromStrict ByteString
bytes)

-- | Decode an @epoch_params@ answer: empty when Koios returned no row.
decodeEpochParams :: Value -> Either DecodeFailure [PParams ConwayEra]
decodeEpochParams :: Value -> Either DecodeFailure [PParams ConwayEra]
decodeEpochParams = (Value -> Parser [PParams ConwayEra])
-> Value -> Either DecodeFailure [PParams ConwayEra]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [PParams ConwayEra])
 -> Value -> Either DecodeFailure [PParams ConwayEra])
-> (Value -> Parser [PParams ConwayEra])
-> Value
-> Either DecodeFailure [PParams ConwayEra]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser (PParams ConwayEra))
-> Value -> Parser [PParams ConwayEra]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser (PParams ConwayEra))
 -> Value -> Parser [PParams ConwayEra])
-> (Object -> Parser (PParams ConwayEra))
-> Value
-> Parser [PParams ConwayEra]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    let threshold :: Key -> Parser UnitInterval
        threshold :: Key -> Parser UnitInterval
threshold Key
key = (Object
o Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
key Parser Scientific
-> (Scientific -> Parser UnitInterval) -> Parser UnitInterval
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser UnitInterval
forall r. BoundedRational r => Scientific -> Parser r
bounded) Parser UnitInterval -> JSONPathElement -> Parser UnitInterval
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
        ratio :: Key -> Parser a
ratio Key
key = (Object
o Object -> Key -> Parser Scientific
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
key Parser Scientific -> (Scientific -> Parser a) -> Parser a
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Parser a
forall r. BoundedRational r => Scientific -> Parser r
bounded) Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
key
        lovelace :: Key -> Parser Coin
lovelace Key
key = Integer -> Coin
Coin (Integer -> Coin) -> Parser Integer -> Parser Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
key Parser Value -> (Value -> Parser Integer) -> Parser Integer
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Integer
integral)
    major <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocol_major"
    version <- case mkVersion (major :: Word64) of
        Just Version
v -> Version -> Parser Version
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
        Maybe Version
Nothing ->
            String -> Parser Version
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unknown protocol version " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
major)
                Parser Version -> JSONPathElement -> Parser Version
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"protocol_major"
    minor <- o .: "protocol_minor"
    pvt <-
        PoolVotingThresholds
            <$> threshold "pvt_motion_no_confidence"
            <*> threshold "pvt_committee_normal"
            <*> threshold "pvt_committee_no_confidence"
            <*> threshold "pvt_hard_fork_initiation"
            <*> threshold "pvtpp_security_group"
    dvt <-
        DRepVotingThresholds
            <$> threshold "dvt_motion_no_confidence"
            <*> threshold "dvt_committee_normal"
            <*> threshold "dvt_committee_no_confidence"
            <*> threshold "dvt_update_to_constitution"
            <*> threshold "dvt_hard_fork_initiation"
            <*> threshold "dvt_p_p_network_group"
            <*> threshold "dvt_p_p_economic_group"
            <*> threshold "dvt_p_p_technical_group"
            <*> threshold "dvt_p_p_gov_group"
            <*> threshold "dvt_treasury_withdrawal"
    minFeeA <- (o .: "min_fee_a" >>= compactCoin) <?> Key "min_fee_a"
    minFeeB <- lovelace "min_fee_b"
    maxBlock <- o .: "max_block_size"
    maxTx <- o .: "max_tx_size"
    maxHeader <- o .: "max_bh_size"
    keyDeposit <- lovelace "key_deposit"
    poolDeposit <- lovelace "pool_deposit"
    eMax <- o .: "max_epoch"
    nOpt <- o .: "optimal_pool_count"
    a0 <- ratio "influence"
    rho <- ratio "monetary_expand_rate"
    tau <- ratio "treasury_growth_rate"
    minPoolCost <- lovelace "min_pool_cost"
    costModels <-
        (o .: "cost_models" >>= costModelsOf) <?> Key "cost_models"
    priceMem <- ratio "price_mem"
    priceStep <- ratio "price_step"
    maxTxMem <- o .: "max_tx_ex_mem"
    maxTxSteps <- o .: "max_tx_ex_steps"
    maxBlockMem <- o .: "max_block_ex_mem"
    maxBlockSteps <- o .: "max_block_ex_steps"
    maxVal <- o .: "max_val_size"
    collateral <- o .: "collateral_percent"
    maxCollateral <- o .: "max_collateral_inputs"
    perByte <-
        (o .: "coins_per_utxo_size" >>= integral >>= compactCoin)
            <?> Key "coins_per_utxo_size"
    committeeMin <- o .: "committee_min_size"
    committeeTerm <- o .: "committee_max_term_length"
    lifetime <- o .: "gov_action_lifetime"
    govDeposit <- lovelace "gov_action_deposit"
    drepDeposit <- lovelace "drep_deposit"
    drepActivity <- o .: "drep_activity"
    refScript <- ratio "min_fee_ref_script_cost_per_byte"
    pure $
        emptyPParams @ConwayEra
            & ppTxFeePerByteL .~ CoinPerByte minFeeA
            & ppTxFeeFixedL .~ minFeeB
            & ppMaxBBSizeL .~ (maxBlock :: Word32)
            & ppMaxTxSizeL .~ (maxTx :: Word32)
            & ppMaxBHSizeL .~ (maxHeader :: Word16)
            & ppKeyDepositL .~ keyDeposit
            & ppPoolDepositL .~ poolDeposit
            & ppEMaxL .~ EpochInterval eMax
            & ppNOptL .~ (nOpt :: Word16)
            & ppA0L .~ a0
            & ppRhoL .~ rho
            & ppTauL .~ tau
            & ppProtocolVersionL .~ ProtVer version minor
            & ppMinPoolCostL .~ minPoolCost
            & ppCostModelsL .~ costModels
            & ppPricesL .~ Prices priceMem priceStep
            & ppMaxTxExUnitsL .~ ExUnits maxTxMem maxTxSteps
            & ppMaxBlockExUnitsL .~ ExUnits maxBlockMem maxBlockSteps
            & ppMaxValSizeL .~ (maxVal :: Word32)
            & ppCollateralPercentageL .~ (collateral :: Word16)
            & ppMaxCollateralInputsL .~ (maxCollateral :: Word16)
            & ppCoinsPerUTxOByteL .~ CoinPerByte perByte
            & ppPoolVotingThresholdsL .~ pvt
            & ppDRepVotingThresholdsL .~ dvt
            & ppCommitteeMinSizeL .~ (committeeMin :: Word16)
            & ppCommitteeMaxTermLengthL .~ EpochInterval committeeTerm
            & ppGovActionLifetimeL .~ EpochInterval lifetime
            & ppGovActionDepositL .~ govDeposit
            & ppDRepDepositL .~ drepDeposit
            & ppDRepActivityL .~ EpochInterval drepActivity
            & ppMinFeeRefScriptCostPerByteL .~ refScript

-- | A lovelace amount in its compact form.
compactCoin :: Integer -> Parser (CompactForm Coin)
compactCoin :: Integer -> Parser (CompactForm Coin)
compactCoin Integer
n
    | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) =
        CompactForm Coin -> Parser (CompactForm Coin)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> CompactForm Coin
CompactCoin (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n))
    | Bool
otherwise = String -> Parser (CompactForm Coin)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"lovelace out of range: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
n)

-- | A bounded ratio from a JSON number, exactly.
bounded :: (BoundedRational r) => Scientific -> Parser r
bounded :: forall r. BoundedRational r => Scientific -> Parser r
bounded Scientific
s = case Rational -> Maybe r
forall r. BoundedRational r => Rational -> Maybe r
boundRational (Scientific -> Rational
forall a. Real a => a -> Rational
toRational Scientific
s) of
    Just r
r -> r -> Parser r
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
    Maybe r
Nothing -> String -> Parser r
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
s)

-- | Cost models by Plutus language name.
costModelsOf :: Value -> Parser CostModels
costModelsOf :: Value -> Parser CostModels
costModelsOf = String
-> (Object -> Parser CostModels) -> Value -> Parser CostModels
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"cost_models" ((Object -> Parser CostModels) -> Value -> Parser CostModels)
-> (Object -> Parser CostModels) -> Value -> Parser CostModels
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    let language :: Key -> Word8 -> Parser [(Word8, [Int64])]
        language :: Key -> Word8 -> Parser [(Word8, [Int64])]
language Key
name Word8
index =
            Object
o Object -> Key -> Parser (Maybe [Int64])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
name Parser (Maybe [Int64])
-> (Maybe [Int64] -> Parser [(Word8, [Int64])])
-> Parser [(Word8, [Int64])]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe [Int64]
Nothing -> [(Word8, [Int64])] -> Parser [(Word8, [Int64])]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just [Int64]
params -> [(Word8, [Int64])] -> Parser [(Word8, [Int64])]
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Word8
index, [Int64]
params)]
    v1 <- Key -> Word8 -> Parser [(Word8, [Int64])]
language Key
"PlutusV1" Word8
0
    v2 <- language "PlutusV2" 1
    v3 <- language "PlutusV3" 2
    mkCostModelsLenient (Map.fromList (v1 <> v2 <> v3))

-- | Decode a @cli_protocol_params@ answer with the ledger's own reader.
decodeCliProtocolParams
    :: Value -> Either DecodeFailure (PParams ConwayEra)
decodeCliProtocolParams :: Value -> Either DecodeFailure (PParams ConwayEra)
decodeCliProtocolParams = (Value -> Parser (PParams ConwayEra))
-> Value -> Either DecodeFailure (PParams ConwayEra)
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser Value -> Parser (PParams ConwayEra)
forall a. FromJSON a => Value -> Parser a
parseJSON

{- | Decode the transaction id a @submittx@ accepted: a JSON string, or
the bare hex text.
-}
decodeSubmitted :: ByteString -> Either DecodeFailure TxId
decodeSubmitted :: ByteString -> Either DecodeFailure TxId
decodeSubmitted ByteString
body =
    case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
body of
        Right (String Text
t) -> Text -> Either DecodeFailure TxId
txIdText Text
t
        Right Value
_ -> DecodeFailure -> Either DecodeFailure TxId
forall a b. a -> Either a b
Left (Text -> Text -> DecodeFailure
DecodeFailure Text
"$" Text
"not a transaction id")
        Left String
_ -> Text -> Either DecodeFailure TxId
txIdText (Text -> Text
T.strip (ByteString -> Text
TE.decodeUtf8Lenient ByteString
body))
  where
    txIdText :: Text -> Either DecodeFailure TxId
txIdText Text
t = (Value -> Parser TxId) -> Value -> Either DecodeFailure TxId
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser (Parser TxId -> Value -> Parser TxId
forall a b. a -> b -> a
const (Text -> Parser TxId
txIdOf Text
t)) Value
Null

-- | Decode a @tx_status@ answer.
decodeTxStatuses :: Value -> Either DecodeFailure [TxStatus]
decodeTxStatuses :: Value -> Either DecodeFailure [TxStatus]
decodeTxStatuses = (Value -> Parser [TxStatus])
-> Value -> Either DecodeFailure [TxStatus]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [TxStatus])
 -> Value -> Either DecodeFailure [TxStatus])
-> (Value -> Parser [TxStatus])
-> Value
-> Either DecodeFailure [TxStatus]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser TxStatus) -> Value -> Parser [TxStatus]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser TxStatus) -> Value -> Parser [TxStatus])
-> (Object -> Parser TxStatus) -> Value -> Parser [TxStatus]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    TxId -> Maybe Word64 -> TxStatus
TxStatus
        (TxId -> Maybe Word64 -> TxStatus)
-> Parser TxId -> Parser (Maybe Word64 -> TxStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_hash" Parser Text -> (Text -> Parser TxId) -> Parser TxId
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser TxId
txIdOf)
        Parser (Maybe Word64 -> TxStatus)
-> Parser (Maybe Word64) -> Parser TxStatus
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"num_confirmations"

-- | Decode an @account_info@ answer.
decodeAccountStatuses :: Value -> Either DecodeFailure [AccountStatus]
decodeAccountStatuses :: Value -> Either DecodeFailure [AccountStatus]
decodeAccountStatuses = (Value -> Parser [AccountStatus])
-> Value -> Either DecodeFailure [AccountStatus]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [AccountStatus])
 -> Value -> Either DecodeFailure [AccountStatus])
-> (Value -> Parser [AccountStatus])
-> Value
-> Either DecodeFailure [AccountStatus]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser AccountStatus) -> Value -> Parser [AccountStatus]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser AccountStatus)
 -> Value -> Parser [AccountStatus])
-> (Object -> Parser AccountStatus)
-> Value
-> Parser [AccountStatus]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> AccountStatus
AccountStatus (Text -> Text -> AccountStatus)
-> Parser Text -> Parser (Text -> AccountStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stake_address" Parser (Text -> AccountStatus)
-> Parser Text -> Parser AccountStatus
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"

-- | Decode a @reference_script_utxos@ page: each row's hash and reference.
decodeReferenceScriptUtxos
    :: Value -> Either DecodeFailure [(ScriptHash, TxIn)]
decodeReferenceScriptUtxos :: Value -> Either DecodeFailure [(ScriptHash, TxIn)]
decodeReferenceScriptUtxos = (Value -> Parser [(ScriptHash, TxIn)])
-> Value -> Either DecodeFailure [(ScriptHash, TxIn)]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [(ScriptHash, TxIn)])
 -> Value -> Either DecodeFailure [(ScriptHash, TxIn)])
-> (Value -> Parser [(ScriptHash, TxIn)])
-> Value
-> Either DecodeFailure [(ScriptHash, TxIn)]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser (ScriptHash, TxIn))
-> Value -> Parser [(ScriptHash, TxIn)]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser (ScriptHash, TxIn))
 -> Value -> Parser [(ScriptHash, TxIn)])
-> (Object -> Parser (ScriptHash, TxIn))
-> Value
-> Parser [(ScriptHash, TxIn)]
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    hash <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script_hash" Parser Text -> (Text -> Parser ScriptHash) -> Parser ScriptHash
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Parser (Hash ADDRHASH EraIndependentScript) -> Parser ScriptHash
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash (Parser (Hash ADDRHASH EraIndependentScript) -> Parser ScriptHash)
-> (Text -> Parser (Hash ADDRHASH EraIndependentScript))
-> Text
-> Parser ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Parser (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => Text -> Parser (Hash h a)
hashOf
    reference <- txInOf o
    pure (hash, reference)

-- | Decode a @utxo_info@ answer.
decodeUtxoInfos :: Value -> Either DecodeFailure [UtxoInfo]
decodeUtxoInfos :: Value -> Either DecodeFailure [UtxoInfo]
decodeUtxoInfos = (Value -> Parser [UtxoInfo])
-> Value -> Either DecodeFailure [UtxoInfo]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [UtxoInfo])
 -> Value -> Either DecodeFailure [UtxoInfo])
-> (Value -> Parser [UtxoInfo])
-> Value
-> Either DecodeFailure [UtxoInfo]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser UtxoInfo) -> Value -> Parser [UtxoInfo]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser UtxoInfo) -> Value -> Parser [UtxoInfo])
-> (Object -> Parser UtxoInfo) -> Value -> Parser [UtxoInfo]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    TxIn -> Bool -> UtxoInfo
UtxoInfo (TxIn -> Bool -> UtxoInfo)
-> Parser TxIn -> Parser (Bool -> UtxoInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser TxIn
txInOf Object
o Parser (Bool -> UtxoInfo) -> Parser Bool -> Parser UtxoInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"is_spent"

-- | Decode an @asset_info@ answer.
decodeAssetInfos :: Value -> Either DecodeFailure [AssetInfo]
decodeAssetInfos :: Value -> Either DecodeFailure [AssetInfo]
decodeAssetInfos = (Value -> Parser [AssetInfo])
-> Value -> Either DecodeFailure [AssetInfo]
forall a. (Value -> Parser a) -> Value -> Either DecodeFailure a
runParser ((Value -> Parser [AssetInfo])
 -> Value -> Either DecodeFailure [AssetInfo])
-> (Value -> Parser [AssetInfo])
-> Value
-> Either DecodeFailure [AssetInfo]
forall a b. (a -> b) -> a -> b
$ (Object -> Parser AssetInfo) -> Value -> Parser [AssetInfo]
forall a. (Object -> Parser a) -> Value -> Parser [a]
rows ((Object -> Parser AssetInfo) -> Value -> Parser [AssetInfo])
-> (Object -> Parser AssetInfo) -> Value -> Parser [AssetInfo]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    TxId -> Integer -> AssetInfo
AssetInfo
        (TxId -> Integer -> AssetInfo)
-> Parser TxId -> Parser (Integer -> AssetInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"minting_tx_hash" Parser Text -> (Text -> Parser TxId) -> Parser TxId
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser TxId
txIdOf)
        Parser (Integer -> AssetInfo) -> Parser Integer -> Parser AssetInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_supply" Parser Text -> (Text -> Parser Integer) -> Parser Integer
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Integer
integerText)

-- | The bech32 rendering of a Shelley address.
renderAddress :: Addr -> Text
renderAddress :: Addr -> Text
renderAddress Addr
a = Text -> ByteString -> Text
bech32 Text
hrp (Addr -> ByteString
serialiseAddr Addr
a)
  where
    hrp :: Text
hrp = case Addr -> Network
getNetwork Addr
a of
        Network
Mainnet -> Text
"addr"
        Network
Testnet -> Text
"addr_test"

-- | Parse a bech32 address.
parseAddress :: Text -> Either Text Addr
parseAddress :: Text -> Either Text Addr
parseAddress Text
t = do
    (hrp, bytes) <- Text -> Either Text (Text, ByteString)
unbech32 Text
t
    unless (hrp `elem` ["addr", "addr_test"]) $
        Left ("not an address: " <> hrp)
    either (Left . T.pack) Right (decodeAddrEither bytes)

-- | The bech32 stake address of a reward account.
renderRewardAccount :: AccountAddress -> Text
renderRewardAccount :: AccountAddress -> Text
renderRewardAccount account :: AccountAddress
account@(AccountAddress Network
network AccountId
_) =
    Text -> ByteString -> Text
bech32 Text
hrp (AccountAddress -> ByteString
serialiseAccountAddress AccountAddress
account)
  where
    hrp :: Text
hrp = case Network
network of
        Network
Mainnet -> Text
"stake"
        Network
Testnet -> Text
"stake_test"

-- | Parse a bech32 stake address.
parseRewardAccount :: Text -> Either Text AccountAddress
parseRewardAccount :: Text -> Either Text AccountAddress
parseRewardAccount Text
t = do
    (hrp, bytes) <- Text -> Either Text (Text, ByteString)
unbech32 Text
t
    unless (hrp `elem` ["stake", "stake_test"]) $
        Left ("not a stake address: " <> hrp)
    maybe
        (Left "not a reward account")
        Right
        (deserialiseAccountAddress bytes)

bech32 :: Text -> ByteString -> Text
bech32 :: Text -> ByteString -> Text
bech32 Text
hrp ByteString
bytes = case Text -> Either HumanReadablePartError HumanReadablePart
Bech32.humanReadablePartFromText Text
hrp of
    Right HumanReadablePart
part -> HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient HumanReadablePart
part (ByteString -> DataPart
Bech32.dataPartFromBytes ByteString
bytes)
    Left HumanReadablePartError
e -> String -> Text
forall a. HasCallStack => String -> a
error (String
"Singular.Provider.Koios.Wire.bech32: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> HumanReadablePartError -> String
forall a. Show a => a -> String
show HumanReadablePartError
e)

unbech32 :: Text -> Either Text (Text, ByteString)
unbech32 :: Text -> Either Text (Text, ByteString)
unbech32 Text
t = case Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
t of
    Left DecodingError
e -> Text -> Either Text (Text, ByteString)
forall a b. a -> Either a b
Left (String -> Text
T.pack (DecodingError -> String
forall a. Show a => a -> String
show DecodingError
e))
    Right (HumanReadablePart
hrp, DataPart
dat) -> case DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dat of
        Just ByteString
bytes -> (Text, ByteString) -> Either Text (Text, ByteString)
forall a b. b -> Either a b
Right (HumanReadablePart -> Text
Bech32.humanReadablePartToText HumanReadablePart
hrp, ByteString
bytes)
        Maybe ByteString
Nothing -> Text -> Either Text (Text, ByteString)
forall a b. a -> Either a b
Left Text
"bech32 data part is not bytes"

-- | Hex of a transaction id.
txIdHex :: TxId -> Text
txIdHex :: TxId -> Text
txIdHex (TxId SafeHash EraIndependentTxBody
h) = Hash HASH EraIndependentTxBody -> Text
forall h a. Hash h a -> Text
hashToTextAsHex (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
extractHash SafeHash EraIndependentTxBody
h)

-- | Hex of a policy id.
policyHex :: PolicyID -> Text
policyHex :: PolicyID -> Text
policyHex (PolicyID (ScriptHash Hash ADDRHASH EraIndependentScript
h)) = Hash ADDRHASH EraIndependentScript -> Text
forall h a. Hash h a -> Text
hashToTextAsHex Hash ADDRHASH EraIndependentScript
h

-- | Hex of an asset name.
assetNameHex :: AssetName -> Text
assetNameHex :: AssetName -> Text
assetNameHex (AssetName ShortByteString
n) = ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
Base16.encode (ShortByteString -> ByteString
SBS.fromShort ShortByteString
n))

addressOf :: Text -> Parser Addr
addressOf :: Text -> Parser Addr
addressOf Text
t = (Text -> Parser Addr)
-> (Addr -> Parser Addr) -> Either Text Addr -> Parser Addr
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Addr
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Addr) -> (Text -> String) -> Text -> Parser Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Addr -> Parser Addr
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text Addr
parseAddress Text
t)

txIdOf :: Text -> Parser TxId
txIdOf :: Text -> Parser TxId
txIdOf Text
t = SafeHash EraIndependentTxBody -> TxId
TxId (SafeHash EraIndependentTxBody -> TxId)
-> (Hash HASH EraIndependentTxBody
    -> SafeHash EraIndependentTxBody)
-> Hash HASH EraIndependentTxBody
-> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH EraIndependentTxBody -> SafeHash EraIndependentTxBody
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Hash HASH EraIndependentTxBody -> TxId)
-> Parser (Hash HASH EraIndependentTxBody) -> Parser TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (Hash HASH EraIndependentTxBody)
forall h a. HashAlgorithm h => Text -> Parser (Hash h a)
hashOf Text
t

hashOf :: (HashAlgorithm h) => Text -> Parser (Hash h a)
hashOf :: forall h a. HashAlgorithm h => Text -> Parser (Hash h a)
hashOf Text
t = do
    bytes <- Text -> Parser ByteString
hexAny Text
t
    maybe (fail ("not a hash of this size: " <> T.unpack t)) pure $
        hashFromBytes bytes

hexSized :: Int -> Text -> Parser ByteString
hexSized :: Int -> Text -> Parser ByteString
hexSized Int
size Text
t = do
    bytes <- Text -> Parser ByteString
hexAny Text
t
    unless (BS.length bytes == size) $
        fail
            ("expected " <> show size <> " bytes, got " <> show (BS.length bytes))
    pure bytes

hexAny :: Text -> Parser ByteString
hexAny :: Text -> Parser ByteString
hexAny Text
t =
    (String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> Parser ByteString
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString)
-> ShowS -> String -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"not hex: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>))
        ByteString -> Parser ByteString
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t))

-- | An integer Koios sends as a JSON string or a JSON number.
integral :: Value -> Parser Integer
integral :: Value -> Parser Integer
integral = \case
    String Text
t -> Text -> Parser Integer
integerText 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 -> Integer -> Parser Integer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
        Left Double
_ -> String -> Parser Integer
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"not an integer: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
n)
    Value
other -> String -> Parser Integer
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"not an integer: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
other)

integerText :: Text -> Parser Integer
integerText :: Text -> Parser Integer
integerText Text
t = case ReadS Integer
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
t) of
    [(Integer
n, String
"")] -> Integer -> Parser Integer
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
n
    [(Integer, String)]
_ -> String -> Parser Integer
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"not an integer: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t)