{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

module Haskoin.Store.WebCommon where

import Control.Applicative ((<|>))
import Control.Monad (guard)
import Data.Bytes.Serial
import Data.Default (Default, def)
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Haskoin.Address
import Haskoin.Block
  ( Block,
    BlockHash,
    blockHashToHex,
    hexToBlockHash,
  )
import Haskoin.Crypto (Ctx, Hash256)
import Haskoin.Crypto.Keys
import Haskoin.Network.Data
import Haskoin.Store.Data qualified as Store
import Haskoin.Transaction
import Network.HTTP.Types (StdMethod (..))
import Numeric.Natural (Natural)
import Text.Read (readMaybe)
import Web.Scotty.Trans qualified as Scotty

-------------------
-- API Resources --
-------------------

class (Serial b) => ApiResource a b | a -> b where
  resourceMethod :: Proxy a -> StdMethod
  resourceMethod Proxy a
_ = StdMethod
GET
  resourcePath :: Proxy a -> ([Text] -> Text)
  queryParams :: a -> ([ParamBox], [ParamBox]) -- (resource, querystring)
  queryParams a
_ = ([], [])
  captureParams :: Proxy a -> [ProxyBox]
  captureParams Proxy a
_ = []
  resourceBody :: a -> Maybe PostBox
  resourceBody = Maybe PostBox -> a -> Maybe PostBox
forall a b. a -> b -> a
const Maybe PostBox
forall a. Maybe a
Nothing

data PostBox = forall s. (Serial s) => PostBox !s

data ParamBox = forall p. (Eq p, Param p) => ParamBox !p

data ProxyBox = forall p. (Param p) => ProxyBox !(Proxy p)

--------------------
-- Resource Paths --
--------------------

-- Blocks
data GetBlock = GetBlock !BlockHash !NoTx

data GetBlocks = GetBlocks ![BlockHash] !NoTx

newtype GetBlockRaw = GetBlockRaw BlockHash

newtype GetBlockBest = GetBlockBest NoTx

data GetBlockBestRaw = GetBlockBestRaw

newtype GetBlockLatest = GetBlockLatest NoTx

data GetBlockHeight = GetBlockHeight !HeightParam !NoTx

data GetBlockHeights = GetBlockHeights !HeightsParam !NoTx

newtype GetBlockHeightRaw = GetBlockHeightRaw HeightParam

data GetBlockTime = GetBlockTime !TimeParam !NoTx

newtype GetBlockTimeRaw = GetBlockTimeRaw TimeParam

data GetBlockMTP = GetBlockMTP !TimeParam !NoTx

newtype GetBlockMTPRaw = GetBlockMTPRaw TimeParam

-- Transactions
newtype GetTx = GetTx TxHash

newtype GetTxs = GetTxs [TxHash]

newtype GetTxRaw = GetTxRaw TxHash

newtype GetTxsRaw = GetTxsRaw [TxHash]

newtype GetTxsBlock = GetTxsBlock BlockHash

newtype GetTxsBlockRaw = GetTxsBlockRaw BlockHash

data GetTxAfter = GetTxAfter !TxHash !HeightParam

newtype PostTx = PostTx Tx

data GetMempool = GetMempool !(Maybe LimitParam) !OffsetParam

data GetEvents = GetEvents

-- Address
data GetAddrTxs = GetAddrTxs !Address !LimitsParam

data GetAddrsTxs = GetAddrsTxs ![Address] !LimitsParam

data GetAddrTxsFull = GetAddrTxsFull !Address !LimitsParam

data GetAddrsTxsFull = GetAddrsTxsFull ![Address] !LimitsParam

newtype GetAddrBalance = GetAddrBalance Address

newtype GetAddrsBalance = GetAddrsBalance [Address]

data GetAddrUnspent = GetAddrUnspent !Address !LimitsParam

data GetAddrsUnspent = GetAddrsUnspent ![Address] !LimitsParam

-- XPubs
data GetXPub = GetXPub !XPubKey !Store.DeriveType !NoCache

data GetXPubTxs = GetXPubTxs !XPubKey !Store.DeriveType !LimitsParam !NoCache

data GetXPubTxsFull = GetXPubTxsFull !XPubKey !Store.DeriveType !LimitsParam !NoCache

data GetXPubBalances = GetXPubBalances !XPubKey !Store.DeriveType !NoCache

data GetXPubUnspent = GetXPubUnspent !XPubKey !Store.DeriveType !LimitsParam !NoCache

data DelCachedXPub = DelCachedXPub !XPubKey !Store.DeriveType

-- Network
data GetPeers = GetPeers

data GetHealth = GetHealth

------------
-- Blocks --
------------

instance ApiResource GetBlock Store.BlockData where
  resourcePath :: Proxy GetBlock -> [Text] -> Text
resourcePath Proxy GetBlock
_ = (Text
"/block/" Text -> [Text] -> Text
<:>)
  queryParams :: GetBlock -> ([ParamBox], [ParamBox])
queryParams (GetBlock BlockHash
h NoTx
t) = ([BlockHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox BlockHash
h], NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)
  captureParams :: Proxy GetBlock -> [ProxyBox]
captureParams Proxy GetBlock
_ = [Proxy BlockHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy BlockHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy BlockHash)]

instance ApiResource GetBlocks (Store.SerialList Store.BlockData) where
  resourcePath :: Proxy GetBlocks -> [Text] -> Text
resourcePath Proxy GetBlocks
_ [Text]
_ = Text
"/blocks"
  queryParams :: GetBlocks -> ([ParamBox], [ParamBox])
queryParams (GetBlocks [BlockHash]
hs NoTx
t) = ([], [[BlockHash] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [BlockHash]
hs] [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)

instance ApiResource GetBlockRaw (Store.RawResult Block) where
  resourcePath :: Proxy GetBlockRaw -> [Text] -> Text
resourcePath Proxy GetBlockRaw
_ = Text
"/block/" Text -> Text -> [Text] -> Text
<+> Text
"/raw"
  queryParams :: GetBlockRaw -> ([ParamBox], [ParamBox])
queryParams (GetBlockRaw BlockHash
h) = ([BlockHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox BlockHash
h], [])
  captureParams :: Proxy GetBlockRaw -> [ProxyBox]
captureParams Proxy GetBlockRaw
_ = [Proxy BlockHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy BlockHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy BlockHash)]

instance ApiResource GetBlockBest Store.BlockData where
  resourcePath :: Proxy GetBlockBest -> [Text] -> Text
resourcePath Proxy GetBlockBest
_ [Text]
_ = Text
"/block/best"
  queryParams :: GetBlockBest -> ([ParamBox], [ParamBox])
queryParams (GetBlockBest NoTx
t) = ([], NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)

instance ApiResource GetBlockBestRaw (Store.RawResult Block) where
  resourcePath :: Proxy GetBlockBestRaw -> [Text] -> Text
resourcePath Proxy GetBlockBestRaw
_ [Text]
_ = Text
"/block/best/raw"

instance ApiResource GetBlockLatest (Store.SerialList Store.BlockData) where
  resourcePath :: Proxy GetBlockLatest -> [Text] -> Text
resourcePath Proxy GetBlockLatest
_ [Text]
_ = Text
"/block/latest"
  queryParams :: GetBlockLatest -> ([ParamBox], [ParamBox])
queryParams (GetBlockLatest NoTx
t) = ([], NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)

instance ApiResource GetBlockHeight (Store.SerialList Store.BlockData) where
  resourcePath :: Proxy GetBlockHeight -> [Text] -> Text
resourcePath Proxy GetBlockHeight
_ = (Text
"/block/height/" Text -> [Text] -> Text
<:>)
  queryParams :: GetBlockHeight -> ([ParamBox], [ParamBox])
queryParams (GetBlockHeight HeightParam
h NoTx
t) = ([HeightParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox HeightParam
h], NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)
  captureParams :: Proxy GetBlockHeight -> [ProxyBox]
captureParams Proxy GetBlockHeight
_ = [Proxy HeightParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy HeightParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy HeightParam)]

instance ApiResource GetBlockHeights (Store.SerialList Store.BlockData) where
  resourcePath :: Proxy GetBlockHeights -> [Text] -> Text
resourcePath Proxy GetBlockHeights
_ [Text]
_ = Text
"/block/heights"
  queryParams :: GetBlockHeights -> ([ParamBox], [ParamBox])
queryParams (GetBlockHeights HeightsParam
hs NoTx
t) = ([], [HeightsParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox HeightsParam
hs] [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)

instance ApiResource GetBlockHeightRaw (Store.RawResultList Block) where
  resourcePath :: Proxy GetBlockHeightRaw -> [Text] -> Text
resourcePath Proxy GetBlockHeightRaw
_ = Text
"/block/height/" Text -> Text -> [Text] -> Text
<+> Text
"/raw"
  queryParams :: GetBlockHeightRaw -> ([ParamBox], [ParamBox])
queryParams (GetBlockHeightRaw HeightParam
h) = ([HeightParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox HeightParam
h], [])
  captureParams :: Proxy GetBlockHeightRaw -> [ProxyBox]
captureParams Proxy GetBlockHeightRaw
_ = [Proxy HeightParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy HeightParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy HeightParam)]

instance ApiResource GetBlockTime Store.BlockData where
  resourcePath :: Proxy GetBlockTime -> [Text] -> Text
resourcePath Proxy GetBlockTime
_ = (Text
"/block/time/" Text -> [Text] -> Text
<:>)
  queryParams :: GetBlockTime -> ([ParamBox], [ParamBox])
queryParams (GetBlockTime TimeParam
u NoTx
t) = ([TimeParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TimeParam
u], NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)
  captureParams :: Proxy GetBlockTime -> [ProxyBox]
captureParams Proxy GetBlockTime
_ = [Proxy TimeParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TimeParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy TimeParam)]

instance ApiResource GetBlockTimeRaw (Store.RawResult Block) where
  resourcePath :: Proxy GetBlockTimeRaw -> [Text] -> Text
resourcePath Proxy GetBlockTimeRaw
_ = Text
"/block/time/" Text -> Text -> [Text] -> Text
<+> Text
"/raw"
  queryParams :: GetBlockTimeRaw -> ([ParamBox], [ParamBox])
queryParams (GetBlockTimeRaw TimeParam
u) = ([TimeParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TimeParam
u], [])
  captureParams :: Proxy GetBlockTimeRaw -> [ProxyBox]
captureParams Proxy GetBlockTimeRaw
_ = [Proxy TimeParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TimeParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy TimeParam)]

instance ApiResource GetBlockMTP Store.BlockData where
  resourcePath :: Proxy GetBlockMTP -> [Text] -> Text
resourcePath Proxy GetBlockMTP
_ = (Text
"/block/mtp/" Text -> [Text] -> Text
<:>)
  queryParams :: GetBlockMTP -> ([ParamBox], [ParamBox])
queryParams (GetBlockMTP TimeParam
u NoTx
t) = ([TimeParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TimeParam
u], NoTx -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoTx
t)
  captureParams :: Proxy GetBlockMTP -> [ProxyBox]
captureParams Proxy GetBlockMTP
_ = [Proxy TimeParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TimeParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy TimeParam)]

instance ApiResource GetBlockMTPRaw (Store.RawResult Block) where
  resourcePath :: Proxy GetBlockMTPRaw -> [Text] -> Text
resourcePath Proxy GetBlockMTPRaw
_ = Text
"/block/mtp/" Text -> Text -> [Text] -> Text
<+> Text
"/raw"
  queryParams :: GetBlockMTPRaw -> ([ParamBox], [ParamBox])
queryParams (GetBlockMTPRaw TimeParam
u) = ([TimeParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TimeParam
u], [])
  captureParams :: Proxy GetBlockMTPRaw -> [ProxyBox]
captureParams Proxy GetBlockMTPRaw
_ = [Proxy TimeParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TimeParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy TimeParam)]

------------------
-- Transactions --
------------------

instance ApiResource GetTx Store.Transaction where
  resourcePath :: Proxy GetTx -> [Text] -> Text
resourcePath Proxy GetTx
_ = (Text
"/transaction/" Text -> [Text] -> Text
<:>)
  queryParams :: GetTx -> ([ParamBox], [ParamBox])
queryParams (GetTx TxHash
h) = ([TxHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TxHash
h], [])
  captureParams :: Proxy GetTx -> [ProxyBox]
captureParams Proxy GetTx
_ = [Proxy TxHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TxHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy TxHash)]

instance ApiResource GetTxs (Store.SerialList Store.Transaction) where
  resourcePath :: Proxy GetTxs -> [Text] -> Text
resourcePath Proxy GetTxs
_ [Text]
_ = Text
"/transactions"
  queryParams :: GetTxs -> ([ParamBox], [ParamBox])
queryParams (GetTxs [TxHash]
hs) = ([], [[TxHash] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [TxHash]
hs])

instance ApiResource GetTxRaw (Store.RawResult Tx) where
  resourcePath :: Proxy GetTxRaw -> [Text] -> Text
resourcePath Proxy GetTxRaw
_ = Text
"/transaction/" Text -> Text -> [Text] -> Text
<+> Text
"/raw"
  queryParams :: GetTxRaw -> ([ParamBox], [ParamBox])
queryParams (GetTxRaw TxHash
h) = ([TxHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TxHash
h], [])
  captureParams :: Proxy GetTxRaw -> [ProxyBox]
captureParams Proxy GetTxRaw
_ = [Proxy TxHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TxHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy TxHash)]

instance ApiResource GetTxsRaw (Store.RawResultList Tx) where
  resourcePath :: Proxy GetTxsRaw -> [Text] -> Text
resourcePath Proxy GetTxsRaw
_ [Text]
_ = Text
"/transactions/raw"
  queryParams :: GetTxsRaw -> ([ParamBox], [ParamBox])
queryParams (GetTxsRaw [TxHash]
hs) = ([], [[TxHash] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [TxHash]
hs])

instance ApiResource GetTxsBlock (Store.SerialList Store.Transaction) where
  resourcePath :: Proxy GetTxsBlock -> [Text] -> Text
resourcePath Proxy GetTxsBlock
_ = (Text
"/transactions/block/" Text -> [Text] -> Text
<:>)
  queryParams :: GetTxsBlock -> ([ParamBox], [ParamBox])
queryParams (GetTxsBlock BlockHash
h) = ([BlockHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox BlockHash
h], [])
  captureParams :: Proxy GetTxsBlock -> [ProxyBox]
captureParams Proxy GetTxsBlock
_ = [Proxy BlockHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy BlockHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy BlockHash)]

instance ApiResource GetTxsBlockRaw (Store.RawResultList Tx) where
  resourcePath :: Proxy GetTxsBlockRaw -> [Text] -> Text
resourcePath Proxy GetTxsBlockRaw
_ = Text
"/transactions/block/" Text -> Text -> [Text] -> Text
<+> Text
"/raw"
  queryParams :: GetTxsBlockRaw -> ([ParamBox], [ParamBox])
queryParams (GetTxsBlockRaw BlockHash
h) = ([BlockHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox BlockHash
h], [])
  captureParams :: Proxy GetTxsBlockRaw -> [ProxyBox]
captureParams Proxy GetTxsBlockRaw
_ = [Proxy BlockHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy BlockHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy BlockHash)]

instance ApiResource GetTxAfter (Store.GenericResult (Maybe Bool)) where
  resourcePath :: Proxy GetTxAfter -> [Text] -> Text
resourcePath Proxy GetTxAfter
_ = Text
"/transaction/" Text -> Text -> [Text] -> Text
<++> Text
"/after/"
  queryParams :: GetTxAfter -> ([ParamBox], [ParamBox])
queryParams (GetTxAfter TxHash
h HeightParam
i) = ([TxHash -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox TxHash
h, HeightParam -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox HeightParam
i], [])
  captureParams :: Proxy GetTxAfter -> [ProxyBox]
captureParams Proxy GetTxAfter
_ =
    [ Proxy TxHash -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy TxHash
forall {k} (t :: k). Proxy t
Proxy :: Proxy TxHash),
      Proxy HeightParam -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy HeightParam
forall {k} (t :: k). Proxy t
Proxy :: Proxy HeightParam)
    ]

instance ApiResource PostTx Store.TxId where
  resourceMethod :: Proxy PostTx -> StdMethod
resourceMethod Proxy PostTx
_ = StdMethod
POST
  resourcePath :: Proxy PostTx -> [Text] -> Text
resourcePath Proxy PostTx
_ [Text]
_ = Text
"/transactions"
  resourceBody :: PostTx -> Maybe PostBox
resourceBody (PostTx Tx
tx) = PostBox -> Maybe PostBox
forall a. a -> Maybe a
Just (PostBox -> Maybe PostBox) -> PostBox -> Maybe PostBox
forall a b. (a -> b) -> a -> b
$ Tx -> PostBox
forall s. Serial s => s -> PostBox
PostBox Tx
tx

instance ApiResource GetMempool (Store.SerialList TxHash) where
  resourcePath :: Proxy GetMempool -> [Text] -> Text
resourcePath Proxy GetMempool
_ [Text]
_ = Text
"/mempool"
  queryParams :: GetMempool -> ([ParamBox], [ParamBox])
queryParams (GetMempool Maybe LimitParam
l OffsetParam
o) = ([], Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o)

instance ApiResource GetEvents (Store.SerialList Store.Event) where
  resourcePath :: Proxy GetEvents -> [Text] -> Text
resourcePath Proxy GetEvents
_ [Text]
_ = Text
"/events"

-------------
-- Address --
-------------

instance ApiResource GetAddrTxs (Store.SerialList Store.TxRef) where
  resourcePath :: Proxy GetAddrTxs -> [Text] -> Text
resourcePath Proxy GetAddrTxs
_ = Text
"/address/" Text -> Text -> [Text] -> Text
<+> Text
"/transactions"
  queryParams :: GetAddrTxs -> ([ParamBox], [ParamBox])
queryParams (GetAddrTxs Address
a (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM)) =
    ([Address -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox Address
a], Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM)
  captureParams :: Proxy GetAddrTxs -> [ProxyBox]
captureParams Proxy GetAddrTxs
_ = [Proxy Address -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy Address
forall {k} (t :: k). Proxy t
Proxy :: Proxy Address)]

instance ApiResource GetAddrsTxs (Store.SerialList Store.TxRef) where
  resourcePath :: Proxy GetAddrsTxs -> [Text] -> Text
resourcePath Proxy GetAddrsTxs
_ [Text]
_ = Text
"/address/transactions"
  queryParams :: GetAddrsTxs -> ([ParamBox], [ParamBox])
queryParams (GetAddrsTxs [Address]
as (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM)) =
    ([], [[Address] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [Address]
as] [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM)

instance ApiResource GetAddrTxsFull (Store.SerialList Store.Transaction) where
  resourcePath :: Proxy GetAddrTxsFull -> [Text] -> Text
resourcePath Proxy GetAddrTxsFull
_ = Text
"/address/" Text -> Text -> [Text] -> Text
<+> Text
"/transactions/full"
  queryParams :: GetAddrTxsFull -> ([ParamBox], [ParamBox])
queryParams (GetAddrTxsFull Address
a (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM)) =
    ([Address -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox Address
a], Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM)
  captureParams :: Proxy GetAddrTxsFull -> [ProxyBox]
captureParams Proxy GetAddrTxsFull
_ = [Proxy Address -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy Address
forall {k} (t :: k). Proxy t
Proxy :: Proxy Address)]

instance ApiResource GetAddrsTxsFull (Store.SerialList Store.Transaction) where
  resourcePath :: Proxy GetAddrsTxsFull -> [Text] -> Text
resourcePath Proxy GetAddrsTxsFull
_ [Text]
_ = Text
"/address/transactions/full"
  queryParams :: GetAddrsTxsFull -> ([ParamBox], [ParamBox])
queryParams (GetAddrsTxsFull [Address]
as (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM)) =
    ([], [[Address] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [Address]
as] [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM)

instance ApiResource GetAddrBalance Store.Balance where
  resourcePath :: Proxy GetAddrBalance -> [Text] -> Text
resourcePath Proxy GetAddrBalance
_ = Text
"/address/" Text -> Text -> [Text] -> Text
<+> Text
"/balance"
  queryParams :: GetAddrBalance -> ([ParamBox], [ParamBox])
queryParams (GetAddrBalance Address
a) = ([Address -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox Address
a], [])
  captureParams :: Proxy GetAddrBalance -> [ProxyBox]
captureParams Proxy GetAddrBalance
_ = [Proxy Address -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy Address
forall {k} (t :: k). Proxy t
Proxy :: Proxy Address)]

instance ApiResource GetAddrsBalance (Store.SerialList Store.Balance) where
  resourcePath :: Proxy GetAddrsBalance -> [Text] -> Text
resourcePath Proxy GetAddrsBalance
_ [Text]
_ = Text
"/address/balances"
  queryParams :: GetAddrsBalance -> ([ParamBox], [ParamBox])
queryParams (GetAddrsBalance [Address]
as) = ([], [[Address] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [Address]
as])

instance ApiResource GetAddrUnspent (Store.SerialList Store.Unspent) where
  resourcePath :: Proxy GetAddrUnspent -> [Text] -> Text
resourcePath Proxy GetAddrUnspent
_ = Text
"/address/" Text -> Text -> [Text] -> Text
<+> Text
"/unspent"
  queryParams :: GetAddrUnspent -> ([ParamBox], [ParamBox])
queryParams (GetAddrUnspent Address
a (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM)) =
    ([Address -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox Address
a], Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM)
  captureParams :: Proxy GetAddrUnspent -> [ProxyBox]
captureParams Proxy GetAddrUnspent
_ = [Proxy Address -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy Address
forall {k} (t :: k). Proxy t
Proxy :: Proxy Address)]

instance ApiResource GetAddrsUnspent (Store.SerialList Store.Unspent) where
  resourcePath :: Proxy GetAddrsUnspent -> [Text] -> Text
resourcePath Proxy GetAddrsUnspent
_ [Text]
_ = Text
"/address/unspent"
  queryParams :: GetAddrsUnspent -> ([ParamBox], [ParamBox])
queryParams (GetAddrsUnspent [Address]
as (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM)) =
    ([], [[Address] -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox [Address]
as] [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM)

-----------
-- XPubs --
-----------

instance ApiResource GetXPub Store.XPubSummary where
  resourcePath :: Proxy GetXPub -> [Text] -> Text
resourcePath Proxy GetXPub
_ = (Text
"/xpub/" Text -> [Text] -> Text
<:>)
  queryParams :: GetXPub -> ([ParamBox], [ParamBox])
queryParams (GetXPub XPubKey
p DeriveType
d NoCache
n) = ([XPubKey -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox XPubKey
p], DeriveType -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox DeriveType
d [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoCache -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoCache
n)
  captureParams :: Proxy GetXPub -> [ProxyBox]
captureParams Proxy GetXPub
_ = [Proxy XPubKey -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy XPubKey
forall {k} (t :: k). Proxy t
Proxy :: Proxy XPubKey)]

instance ApiResource GetXPubTxs (Store.SerialList Store.TxRef) where
  resourcePath :: Proxy GetXPubTxs -> [Text] -> Text
resourcePath Proxy GetXPubTxs
_ = Text
"/xpub/" Text -> Text -> [Text] -> Text
<+> Text
"/transactions"
  queryParams :: GetXPubTxs -> ([ParamBox], [ParamBox])
queryParams (GetXPubTxs XPubKey
p DeriveType
d (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM) NoCache
n) =
    ( [XPubKey -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox XPubKey
p],
      DeriveType -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox DeriveType
d [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoCache -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoCache
n
    )
  captureParams :: Proxy GetXPubTxs -> [ProxyBox]
captureParams Proxy GetXPubTxs
_ = [Proxy XPubKey -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy XPubKey
forall {k} (t :: k). Proxy t
Proxy :: Proxy XPubKey)]

instance ApiResource GetXPubTxsFull (Store.SerialList Store.Transaction) where
  resourcePath :: Proxy GetXPubTxsFull -> [Text] -> Text
resourcePath Proxy GetXPubTxsFull
_ = Text
"/xpub/" Text -> Text -> [Text] -> Text
<+> Text
"/transactions/full"
  queryParams :: GetXPubTxsFull -> ([ParamBox], [ParamBox])
queryParams (GetXPubTxsFull XPubKey
p DeriveType
d (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM) NoCache
n) =
    ( [XPubKey -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox XPubKey
p],
      DeriveType -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox DeriveType
d [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoCache -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoCache
n
    )
  captureParams :: Proxy GetXPubTxsFull -> [ProxyBox]
captureParams Proxy GetXPubTxsFull
_ = [Proxy XPubKey -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy XPubKey
forall {k} (t :: k). Proxy t
Proxy :: Proxy XPubKey)]

instance ApiResource GetXPubBalances (Store.SerialList Store.XPubBal) where
  resourcePath :: Proxy GetXPubBalances -> [Text] -> Text
resourcePath Proxy GetXPubBalances
_ = Text
"/xpub/" Text -> Text -> [Text] -> Text
<+> Text
"/balances"
  queryParams :: GetXPubBalances -> ([ParamBox], [ParamBox])
queryParams (GetXPubBalances XPubKey
p DeriveType
d NoCache
n) = ([XPubKey -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox XPubKey
p], DeriveType -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox DeriveType
d [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoCache -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoCache
n)
  captureParams :: Proxy GetXPubBalances -> [ProxyBox]
captureParams Proxy GetXPubBalances
_ = [Proxy XPubKey -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy XPubKey
forall {k} (t :: k). Proxy t
Proxy :: Proxy XPubKey)]

instance ApiResource GetXPubUnspent (Store.SerialList Store.XPubUnspent) where
  resourcePath :: Proxy GetXPubUnspent -> [Text] -> Text
resourcePath Proxy GetXPubUnspent
_ = Text
"/xpub/" Text -> Text -> [Text] -> Text
<+> Text
"/unspent"
  queryParams :: GetXPubUnspent -> ([ParamBox], [ParamBox])
queryParams (GetXPubUnspent XPubKey
p DeriveType
d (LimitsParam Maybe LimitParam
l OffsetParam
o Maybe StartParam
sM) NoCache
n) =
    ( [XPubKey -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox XPubKey
p],
      DeriveType -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox DeriveType
d [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe LimitParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe LimitParam
l [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> OffsetParam -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox OffsetParam
o [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> Maybe StartParam -> [ParamBox]
forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox Maybe StartParam
sM [ParamBox] -> [ParamBox] -> [ParamBox]
forall a. Semigroup a => a -> a -> a
<> NoCache -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox NoCache
n
    )
  captureParams :: Proxy GetXPubUnspent -> [ProxyBox]
captureParams Proxy GetXPubUnspent
_ = [Proxy XPubKey -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy XPubKey
forall {k} (t :: k). Proxy t
Proxy :: Proxy XPubKey)]

instance ApiResource DelCachedXPub (Store.GenericResult Bool) where
  resourceMethod :: Proxy DelCachedXPub -> StdMethod
resourceMethod Proxy DelCachedXPub
_ = StdMethod
DELETE
  resourcePath :: Proxy DelCachedXPub -> [Text] -> Text
resourcePath Proxy DelCachedXPub
_ = (Text
"/xpub/" Text -> [Text] -> Text
<:>)
  queryParams :: DelCachedXPub -> ([ParamBox], [ParamBox])
queryParams (DelCachedXPub XPubKey
p DeriveType
d) = ([XPubKey -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox XPubKey
p], DeriveType -> [ParamBox]
forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox DeriveType
d)
  captureParams :: Proxy DelCachedXPub -> [ProxyBox]
captureParams Proxy DelCachedXPub
_ = [Proxy XPubKey -> ProxyBox
forall p. Param p => Proxy p -> ProxyBox
ProxyBox (Proxy XPubKey
forall {k} (t :: k). Proxy t
Proxy :: Proxy XPubKey)]

-------------
-- Network --
-------------

instance ApiResource GetPeers (Store.SerialList Store.PeerInfo) where
  resourcePath :: Proxy GetPeers -> [Text] -> Text
resourcePath Proxy GetPeers
_ [Text]
_ = Text
"/peers"

instance ApiResource GetHealth Store.HealthCheck where
  resourcePath :: Proxy GetHealth -> [Text] -> Text
resourcePath Proxy GetHealth
_ [Text]
_ = Text
"/health"

-------------
-- Helpers --
-------------

(<:>) :: Text -> [Text] -> Text
<:> :: Text -> [Text] -> Text
(<:>) = (Text -> Text -> [Text] -> Text
<+> Text
"")

(<+>) :: Text -> Text -> [Text] -> Text
Text
a <+> :: Text -> Text -> [Text] -> Text
<+> Text
b = Int -> [Text] -> [Text] -> Text
fill Int
1 [Text
a, Text
b]

(<++>) :: Text -> Text -> [Text] -> Text
Text
a <++> :: Text -> Text -> [Text] -> Text
<++> Text
b = Int -> [Text] -> [Text] -> Text
fill Int
2 [Text
a, Text
b]

fill :: Int -> [Text] -> [Text] -> Text
fill :: Int -> [Text] -> [Text] -> Text
fill Int
i [Text]
a [Text]
b
  | [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i = [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid query parameters"
  | Bool
otherwise = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text) -> (Text, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
a ([Text]
b [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
"")

noDefBox :: (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox :: forall p. (Default p, Param p, Eq p) => p -> [ParamBox]
noDefBox p
p = [p -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox p
p | p
p p -> p -> Bool
forall a. Eq a => a -> a -> Bool
/= p
forall a. Default a => a
def]

noMaybeBox :: (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox :: forall p. (Param p, Eq p) => Maybe p -> [ParamBox]
noMaybeBox (Just p
p) = [p -> ParamBox
forall p. (Eq p, Param p) => p -> ParamBox
ParamBox p
p]
noMaybeBox Maybe p
_ = []

asProxy :: a -> Proxy a
asProxy :: forall a. a -> Proxy a
asProxy = Proxy a -> a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy

queryPath :: (ApiResource a b) => Network -> Ctx -> a -> Text
queryPath :: forall a b. ApiResource a b => Network -> Ctx -> a -> Text
queryPath Network
net Ctx
ctx a
a = [Text] -> Text
f ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ParamBox -> Text
encParam (ParamBox -> Text) -> [ParamBox] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ParamBox], [ParamBox]) -> [ParamBox]
forall a b. (a, b) -> a
fst (a -> ([ParamBox], [ParamBox])
forall a b. ApiResource a b => a -> ([ParamBox], [ParamBox])
queryParams a
a)
  where
    f :: [Text] -> Text
f = Proxy a -> [Text] -> Text
forall a b. ApiResource a b => Proxy a -> [Text] -> Text
resourcePath (Proxy a -> [Text] -> Text) -> Proxy a -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ a -> Proxy a
forall a. a -> Proxy a
asProxy a
a
    encParam :: ParamBox -> Text
encParam (ParamBox p
p) =
      case Network -> Ctx -> p -> Maybe [Text]
forall a. Param a => Network -> Ctx -> a -> Maybe [Text]
encodeParam Network
net Ctx
ctx p
p of
        Just [Text
res] -> Text
res
        Maybe [Text]
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid query param"

capturePath :: (ApiResource a b) => Proxy a -> Scotty.RoutePattern
capturePath :: forall a b. ApiResource a b => Proxy a -> RoutePattern
capturePath Proxy a
proxy =
  [Char] -> RoutePattern
forall a. IsString a => [Char] -> a
fromString ([Char] -> RoutePattern) -> [Char] -> RoutePattern
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
f ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ProxyBox -> Text
toLabel (ProxyBox -> Text) -> [ProxyBox] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> [ProxyBox]
forall a b. ApiResource a b => Proxy a -> [ProxyBox]
captureParams Proxy a
proxy
  where
    f :: [Text] -> Text
f = Proxy a -> [Text] -> Text
forall a b. ApiResource a b => Proxy a -> [Text] -> Text
resourcePath Proxy a
proxy
    toLabel :: ProxyBox -> Text
toLabel (ProxyBox Proxy p
p) = Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy p -> Text
forall a. Param a => Proxy a -> Text
proxyLabel Proxy p
p

paramLabel :: (Param p) => p -> Text
paramLabel :: forall p. Param p => p -> Text
paramLabel = Proxy p -> Text
forall a. Param a => Proxy a -> Text
proxyLabel (Proxy p -> Text) -> (p -> Proxy p) -> p -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Proxy p
forall a. a -> Proxy a
asProxy

-------------
-- Options --
-------------

class Param a where
  proxyLabel :: Proxy a -> Text
  encodeParam :: Network -> Ctx -> a -> Maybe [Text]
  parseParam :: Network -> Ctx -> [Text] -> Maybe a

instance Param Address where
  proxyLabel :: Proxy Address -> Text
proxyLabel = Text -> Proxy Address -> Text
forall a b. a -> b -> a
const Text
"address"
  encodeParam :: Network -> Ctx -> Address -> Maybe [Text]
encodeParam Network
net Ctx
ctx Address
a = (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: []) (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Address -> Maybe Text
addrToText Network
net Address
a
  parseParam :: Network -> Ctx -> [Text] -> Maybe Address
parseParam Network
net Ctx
ctx [Text
a] = Network -> Text -> Maybe Address
textToAddr Network
net Text
a
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe Address
forall a. Maybe a
Nothing

instance Param [Address] where
  proxyLabel :: Proxy [Address] -> Text
proxyLabel = Text -> Proxy [Address] -> Text
forall a b. a -> b -> a
const Text
"addresses"
  encodeParam :: Network -> Ctx -> [Address] -> Maybe [Text]
encodeParam Network
net Ctx
ctx = (Address -> Maybe Text) -> [Address] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Network -> Address -> Maybe Text
addrToText Network
net)
  parseParam :: Network -> Ctx -> [Text] -> Maybe [Address]
parseParam Network
net Ctx
ctx = (Text -> Maybe Address) -> [Text] -> Maybe [Address]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Network -> Text -> Maybe Address
textToAddr Network
net)

data StartParam
  = StartParamHash {StartParam -> Hash256
hash :: Hash256}
  | StartParamHeight {StartParam -> Natural
height :: Natural}
  | StartParamTime {StartParam -> UnixTime
time :: Store.UnixTime}
  deriving (StartParam -> StartParam -> Bool
(StartParam -> StartParam -> Bool)
-> (StartParam -> StartParam -> Bool) -> Eq StartParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StartParam -> StartParam -> Bool
== :: StartParam -> StartParam -> Bool
$c/= :: StartParam -> StartParam -> Bool
/= :: StartParam -> StartParam -> Bool
Eq, Int -> StartParam -> ShowS
[StartParam] -> ShowS
StartParam -> [Char]
(Int -> StartParam -> ShowS)
-> (StartParam -> [Char])
-> ([StartParam] -> ShowS)
-> Show StartParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartParam -> ShowS
showsPrec :: Int -> StartParam -> ShowS
$cshow :: StartParam -> [Char]
show :: StartParam -> [Char]
$cshowList :: [StartParam] -> ShowS
showList :: [StartParam] -> ShowS
Show)

instance Param StartParam where
  proxyLabel :: Proxy StartParam -> Text
proxyLabel = Text -> Proxy StartParam -> Text
forall a b. a -> b -> a
const Text
"height"
  encodeParam :: Network -> Ctx -> StartParam -> Maybe [Text]
encodeParam Network
net Ctx
ctx StartParam
p =
    case StartParam
p of
      StartParamHash Hash256
h -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxHash -> Text
txHashToHex (Hash256 -> TxHash
TxHash Hash256
h)]
      StartParamHeight Natural
h -> do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Natural
h Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
1230768000
        [Text] -> Maybe [Text]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
h]
      StartParamTime UnixTime
t -> do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ UnixTime
t UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
> UnixTime
1230768000
        [Text] -> Maybe [Text]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ UnixTime -> [Char]
forall a. Show a => a -> [Char]
show UnixTime
t]
  parseParam :: Network -> Ctx -> [Text] -> Maybe StartParam
parseParam Network
net Ctx
ctx [Text
s] =
    Maybe StartParam
parseHash Maybe StartParam -> Maybe StartParam -> Maybe StartParam
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StartParam
parseHeight Maybe StartParam -> Maybe StartParam -> Maybe StartParam
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StartParam
parseUnix
    where
      parseHash :: Maybe StartParam
parseHash = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
        TxHash Hash256
x <- Text -> Maybe TxHash
hexToTxHash Text
s
        StartParam -> Maybe StartParam
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StartParam -> Maybe StartParam) -> StartParam -> Maybe StartParam
forall a b. (a -> b) -> a -> b
$ Hash256 -> StartParam
StartParamHash Hash256
x
      parseHeight :: Maybe StartParam
parseHeight = do
        Natural
x <- [Char] -> Maybe Natural
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Natural) -> [Char] -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
s
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Natural
x Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
1230768000
        StartParam -> Maybe StartParam
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StartParam -> Maybe StartParam) -> StartParam -> Maybe StartParam
forall a b. (a -> b) -> a -> b
$ Natural -> StartParam
StartParamHeight Natural
x
      parseUnix :: Maybe StartParam
parseUnix = do
        UnixTime
x <- [Char] -> Maybe UnixTime
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe UnixTime) -> [Char] -> Maybe UnixTime
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
s
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ UnixTime
x UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
> UnixTime
1230768000
        StartParam -> Maybe StartParam
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (StartParam -> Maybe StartParam) -> StartParam -> Maybe StartParam
forall a b. (a -> b) -> a -> b
$ UnixTime -> StartParam
StartParamTime UnixTime
x
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe StartParam
forall a. Maybe a
Nothing

newtype OffsetParam = OffsetParam {OffsetParam -> Natural
get :: Natural}
  deriving (OffsetParam -> OffsetParam -> Bool
(OffsetParam -> OffsetParam -> Bool)
-> (OffsetParam -> OffsetParam -> Bool) -> Eq OffsetParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OffsetParam -> OffsetParam -> Bool
== :: OffsetParam -> OffsetParam -> Bool
$c/= :: OffsetParam -> OffsetParam -> Bool
/= :: OffsetParam -> OffsetParam -> Bool
Eq, Int -> OffsetParam -> ShowS
[OffsetParam] -> ShowS
OffsetParam -> [Char]
(Int -> OffsetParam -> ShowS)
-> (OffsetParam -> [Char])
-> ([OffsetParam] -> ShowS)
-> Show OffsetParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OffsetParam -> ShowS
showsPrec :: Int -> OffsetParam -> ShowS
$cshow :: OffsetParam -> [Char]
show :: OffsetParam -> [Char]
$cshowList :: [OffsetParam] -> ShowS
showList :: [OffsetParam] -> ShowS
Show, ReadPrec [OffsetParam]
ReadPrec OffsetParam
Int -> ReadS OffsetParam
ReadS [OffsetParam]
(Int -> ReadS OffsetParam)
-> ReadS [OffsetParam]
-> ReadPrec OffsetParam
-> ReadPrec [OffsetParam]
-> Read OffsetParam
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OffsetParam
readsPrec :: Int -> ReadS OffsetParam
$creadList :: ReadS [OffsetParam]
readList :: ReadS [OffsetParam]
$creadPrec :: ReadPrec OffsetParam
readPrec :: ReadPrec OffsetParam
$creadListPrec :: ReadPrec [OffsetParam]
readListPrec :: ReadPrec [OffsetParam]
Read, Int -> OffsetParam
OffsetParam -> Int
OffsetParam -> [OffsetParam]
OffsetParam -> OffsetParam
OffsetParam -> OffsetParam -> [OffsetParam]
OffsetParam -> OffsetParam -> OffsetParam -> [OffsetParam]
(OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam)
-> (Int -> OffsetParam)
-> (OffsetParam -> Int)
-> (OffsetParam -> [OffsetParam])
-> (OffsetParam -> OffsetParam -> [OffsetParam])
-> (OffsetParam -> OffsetParam -> [OffsetParam])
-> (OffsetParam -> OffsetParam -> OffsetParam -> [OffsetParam])
-> Enum OffsetParam
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 :: OffsetParam -> OffsetParam
succ :: OffsetParam -> OffsetParam
$cpred :: OffsetParam -> OffsetParam
pred :: OffsetParam -> OffsetParam
$ctoEnum :: Int -> OffsetParam
toEnum :: Int -> OffsetParam
$cfromEnum :: OffsetParam -> Int
fromEnum :: OffsetParam -> Int
$cenumFrom :: OffsetParam -> [OffsetParam]
enumFrom :: OffsetParam -> [OffsetParam]
$cenumFromThen :: OffsetParam -> OffsetParam -> [OffsetParam]
enumFromThen :: OffsetParam -> OffsetParam -> [OffsetParam]
$cenumFromTo :: OffsetParam -> OffsetParam -> [OffsetParam]
enumFromTo :: OffsetParam -> OffsetParam -> [OffsetParam]
$cenumFromThenTo :: OffsetParam -> OffsetParam -> OffsetParam -> [OffsetParam]
enumFromThenTo :: OffsetParam -> OffsetParam -> OffsetParam -> [OffsetParam]
Enum, Eq OffsetParam
Eq OffsetParam =>
(OffsetParam -> OffsetParam -> Ordering)
-> (OffsetParam -> OffsetParam -> Bool)
-> (OffsetParam -> OffsetParam -> Bool)
-> (OffsetParam -> OffsetParam -> Bool)
-> (OffsetParam -> OffsetParam -> Bool)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> Ord OffsetParam
OffsetParam -> OffsetParam -> Bool
OffsetParam -> OffsetParam -> Ordering
OffsetParam -> OffsetParam -> OffsetParam
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 :: OffsetParam -> OffsetParam -> Ordering
compare :: OffsetParam -> OffsetParam -> Ordering
$c< :: OffsetParam -> OffsetParam -> Bool
< :: OffsetParam -> OffsetParam -> Bool
$c<= :: OffsetParam -> OffsetParam -> Bool
<= :: OffsetParam -> OffsetParam -> Bool
$c> :: OffsetParam -> OffsetParam -> Bool
> :: OffsetParam -> OffsetParam -> Bool
$c>= :: OffsetParam -> OffsetParam -> Bool
>= :: OffsetParam -> OffsetParam -> Bool
$cmax :: OffsetParam -> OffsetParam -> OffsetParam
max :: OffsetParam -> OffsetParam -> OffsetParam
$cmin :: OffsetParam -> OffsetParam -> OffsetParam
min :: OffsetParam -> OffsetParam -> OffsetParam
Ord, Integer -> OffsetParam
OffsetParam -> OffsetParam
OffsetParam -> OffsetParam -> OffsetParam
(OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam)
-> (Integer -> OffsetParam)
-> Num OffsetParam
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: OffsetParam -> OffsetParam -> OffsetParam
+ :: OffsetParam -> OffsetParam -> OffsetParam
$c- :: OffsetParam -> OffsetParam -> OffsetParam
- :: OffsetParam -> OffsetParam -> OffsetParam
$c* :: OffsetParam -> OffsetParam -> OffsetParam
* :: OffsetParam -> OffsetParam -> OffsetParam
$cnegate :: OffsetParam -> OffsetParam
negate :: OffsetParam -> OffsetParam
$cabs :: OffsetParam -> OffsetParam
abs :: OffsetParam -> OffsetParam
$csignum :: OffsetParam -> OffsetParam
signum :: OffsetParam -> OffsetParam
$cfromInteger :: Integer -> OffsetParam
fromInteger :: Integer -> OffsetParam
Num, Num OffsetParam
Ord OffsetParam
(Num OffsetParam, Ord OffsetParam) =>
(OffsetParam -> Rational) -> Real OffsetParam
OffsetParam -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: OffsetParam -> Rational
toRational :: OffsetParam -> Rational
Real, Enum OffsetParam
Real OffsetParam
(Real OffsetParam, Enum OffsetParam) =>
(OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> OffsetParam)
-> (OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam))
-> (OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam))
-> (OffsetParam -> Integer)
-> Integral OffsetParam
OffsetParam -> Integer
OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam)
OffsetParam -> OffsetParam -> OffsetParam
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: OffsetParam -> OffsetParam -> OffsetParam
quot :: OffsetParam -> OffsetParam -> OffsetParam
$crem :: OffsetParam -> OffsetParam -> OffsetParam
rem :: OffsetParam -> OffsetParam -> OffsetParam
$cdiv :: OffsetParam -> OffsetParam -> OffsetParam
div :: OffsetParam -> OffsetParam -> OffsetParam
$cmod :: OffsetParam -> OffsetParam -> OffsetParam
mod :: OffsetParam -> OffsetParam -> OffsetParam
$cquotRem :: OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam)
quotRem :: OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam)
$cdivMod :: OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam)
divMod :: OffsetParam -> OffsetParam -> (OffsetParam, OffsetParam)
$ctoInteger :: OffsetParam -> Integer
toInteger :: OffsetParam -> Integer
Integral)

instance Default OffsetParam where
  def :: OffsetParam
def = Natural -> OffsetParam
OffsetParam Natural
0

instance Param OffsetParam where
  proxyLabel :: Proxy OffsetParam -> Text
proxyLabel = Text -> Proxy OffsetParam -> Text
forall a b. a -> b -> a
const Text
"offset"
  encodeParam :: Network -> Ctx -> OffsetParam -> Maybe [Text]
encodeParam Network
net Ctx
ctx (OffsetParam Natural
o) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
o]
  parseParam :: Network -> Ctx -> [Text] -> Maybe OffsetParam
parseParam Network
net Ctx
ctx [Text
s] = Natural -> OffsetParam
OffsetParam (Natural -> OffsetParam) -> Maybe Natural -> Maybe OffsetParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Natural
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
s)
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe OffsetParam
forall a. Maybe a
Nothing

newtype LimitParam = LimitParam {LimitParam -> Natural
get :: Natural}
  deriving (LimitParam -> LimitParam -> Bool
(LimitParam -> LimitParam -> Bool)
-> (LimitParam -> LimitParam -> Bool) -> Eq LimitParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LimitParam -> LimitParam -> Bool
== :: LimitParam -> LimitParam -> Bool
$c/= :: LimitParam -> LimitParam -> Bool
/= :: LimitParam -> LimitParam -> Bool
Eq, Int -> LimitParam -> ShowS
[LimitParam] -> ShowS
LimitParam -> [Char]
(Int -> LimitParam -> ShowS)
-> (LimitParam -> [Char])
-> ([LimitParam] -> ShowS)
-> Show LimitParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LimitParam -> ShowS
showsPrec :: Int -> LimitParam -> ShowS
$cshow :: LimitParam -> [Char]
show :: LimitParam -> [Char]
$cshowList :: [LimitParam] -> ShowS
showList :: [LimitParam] -> ShowS
Show, ReadPrec [LimitParam]
ReadPrec LimitParam
Int -> ReadS LimitParam
ReadS [LimitParam]
(Int -> ReadS LimitParam)
-> ReadS [LimitParam]
-> ReadPrec LimitParam
-> ReadPrec [LimitParam]
-> Read LimitParam
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LimitParam
readsPrec :: Int -> ReadS LimitParam
$creadList :: ReadS [LimitParam]
readList :: ReadS [LimitParam]
$creadPrec :: ReadPrec LimitParam
readPrec :: ReadPrec LimitParam
$creadListPrec :: ReadPrec [LimitParam]
readListPrec :: ReadPrec [LimitParam]
Read, Int -> LimitParam
LimitParam -> Int
LimitParam -> [LimitParam]
LimitParam -> LimitParam
LimitParam -> LimitParam -> [LimitParam]
LimitParam -> LimitParam -> LimitParam -> [LimitParam]
(LimitParam -> LimitParam)
-> (LimitParam -> LimitParam)
-> (Int -> LimitParam)
-> (LimitParam -> Int)
-> (LimitParam -> [LimitParam])
-> (LimitParam -> LimitParam -> [LimitParam])
-> (LimitParam -> LimitParam -> [LimitParam])
-> (LimitParam -> LimitParam -> LimitParam -> [LimitParam])
-> Enum LimitParam
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 :: LimitParam -> LimitParam
succ :: LimitParam -> LimitParam
$cpred :: LimitParam -> LimitParam
pred :: LimitParam -> LimitParam
$ctoEnum :: Int -> LimitParam
toEnum :: Int -> LimitParam
$cfromEnum :: LimitParam -> Int
fromEnum :: LimitParam -> Int
$cenumFrom :: LimitParam -> [LimitParam]
enumFrom :: LimitParam -> [LimitParam]
$cenumFromThen :: LimitParam -> LimitParam -> [LimitParam]
enumFromThen :: LimitParam -> LimitParam -> [LimitParam]
$cenumFromTo :: LimitParam -> LimitParam -> [LimitParam]
enumFromTo :: LimitParam -> LimitParam -> [LimitParam]
$cenumFromThenTo :: LimitParam -> LimitParam -> LimitParam -> [LimitParam]
enumFromThenTo :: LimitParam -> LimitParam -> LimitParam -> [LimitParam]
Enum, Eq LimitParam
Eq LimitParam =>
(LimitParam -> LimitParam -> Ordering)
-> (LimitParam -> LimitParam -> Bool)
-> (LimitParam -> LimitParam -> Bool)
-> (LimitParam -> LimitParam -> Bool)
-> (LimitParam -> LimitParam -> Bool)
-> (LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> LimitParam)
-> Ord LimitParam
LimitParam -> LimitParam -> Bool
LimitParam -> LimitParam -> Ordering
LimitParam -> LimitParam -> LimitParam
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 :: LimitParam -> LimitParam -> Ordering
compare :: LimitParam -> LimitParam -> Ordering
$c< :: LimitParam -> LimitParam -> Bool
< :: LimitParam -> LimitParam -> Bool
$c<= :: LimitParam -> LimitParam -> Bool
<= :: LimitParam -> LimitParam -> Bool
$c> :: LimitParam -> LimitParam -> Bool
> :: LimitParam -> LimitParam -> Bool
$c>= :: LimitParam -> LimitParam -> Bool
>= :: LimitParam -> LimitParam -> Bool
$cmax :: LimitParam -> LimitParam -> LimitParam
max :: LimitParam -> LimitParam -> LimitParam
$cmin :: LimitParam -> LimitParam -> LimitParam
min :: LimitParam -> LimitParam -> LimitParam
Ord, Integer -> LimitParam
LimitParam -> LimitParam
LimitParam -> LimitParam -> LimitParam
(LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam)
-> (LimitParam -> LimitParam)
-> (LimitParam -> LimitParam)
-> (Integer -> LimitParam)
-> Num LimitParam
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: LimitParam -> LimitParam -> LimitParam
+ :: LimitParam -> LimitParam -> LimitParam
$c- :: LimitParam -> LimitParam -> LimitParam
- :: LimitParam -> LimitParam -> LimitParam
$c* :: LimitParam -> LimitParam -> LimitParam
* :: LimitParam -> LimitParam -> LimitParam
$cnegate :: LimitParam -> LimitParam
negate :: LimitParam -> LimitParam
$cabs :: LimitParam -> LimitParam
abs :: LimitParam -> LimitParam
$csignum :: LimitParam -> LimitParam
signum :: LimitParam -> LimitParam
$cfromInteger :: Integer -> LimitParam
fromInteger :: Integer -> LimitParam
Num, Num LimitParam
Ord LimitParam
(Num LimitParam, Ord LimitParam) =>
(LimitParam -> Rational) -> Real LimitParam
LimitParam -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: LimitParam -> Rational
toRational :: LimitParam -> Rational
Real, Enum LimitParam
Real LimitParam
(Real LimitParam, Enum LimitParam) =>
(LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> LimitParam)
-> (LimitParam -> LimitParam -> (LimitParam, LimitParam))
-> (LimitParam -> LimitParam -> (LimitParam, LimitParam))
-> (LimitParam -> Integer)
-> Integral LimitParam
LimitParam -> Integer
LimitParam -> LimitParam -> (LimitParam, LimitParam)
LimitParam -> LimitParam -> LimitParam
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: LimitParam -> LimitParam -> LimitParam
quot :: LimitParam -> LimitParam -> LimitParam
$crem :: LimitParam -> LimitParam -> LimitParam
rem :: LimitParam -> LimitParam -> LimitParam
$cdiv :: LimitParam -> LimitParam -> LimitParam
div :: LimitParam -> LimitParam -> LimitParam
$cmod :: LimitParam -> LimitParam -> LimitParam
mod :: LimitParam -> LimitParam -> LimitParam
$cquotRem :: LimitParam -> LimitParam -> (LimitParam, LimitParam)
quotRem :: LimitParam -> LimitParam -> (LimitParam, LimitParam)
$cdivMod :: LimitParam -> LimitParam -> (LimitParam, LimitParam)
divMod :: LimitParam -> LimitParam -> (LimitParam, LimitParam)
$ctoInteger :: LimitParam -> Integer
toInteger :: LimitParam -> Integer
Integral)

instance Param LimitParam where
  proxyLabel :: Proxy LimitParam -> Text
proxyLabel = Text -> Proxy LimitParam -> Text
forall a b. a -> b -> a
const Text
"limit"
  encodeParam :: Network -> Ctx -> LimitParam -> Maybe [Text]
encodeParam Network
net Ctx
ctx (LimitParam Natural
l) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
l]
  parseParam :: Network -> Ctx -> [Text] -> Maybe LimitParam
parseParam Network
net Ctx
ctx [Text
s] = Natural -> LimitParam
LimitParam (Natural -> LimitParam) -> Maybe Natural -> Maybe LimitParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Natural
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
s)
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe LimitParam
forall a. Maybe a
Nothing

data LimitsParam = LimitsParam
  { LimitsParam -> Maybe LimitParam
limit :: Maybe LimitParam, -- 0 means maximum
    LimitsParam -> OffsetParam
offset :: OffsetParam,
    LimitsParam -> Maybe StartParam
start :: Maybe StartParam
  }
  deriving (LimitsParam -> LimitsParam -> Bool
(LimitsParam -> LimitsParam -> Bool)
-> (LimitsParam -> LimitsParam -> Bool) -> Eq LimitsParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LimitsParam -> LimitsParam -> Bool
== :: LimitsParam -> LimitsParam -> Bool
$c/= :: LimitsParam -> LimitsParam -> Bool
/= :: LimitsParam -> LimitsParam -> Bool
Eq, Int -> LimitsParam -> ShowS
[LimitsParam] -> ShowS
LimitsParam -> [Char]
(Int -> LimitsParam -> ShowS)
-> (LimitsParam -> [Char])
-> ([LimitsParam] -> ShowS)
-> Show LimitsParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LimitsParam -> ShowS
showsPrec :: Int -> LimitsParam -> ShowS
$cshow :: LimitsParam -> [Char]
show :: LimitsParam -> [Char]
$cshowList :: [LimitsParam] -> ShowS
showList :: [LimitsParam] -> ShowS
Show)

instance Default LimitsParam where
  def :: LimitsParam
def = Maybe LimitParam -> OffsetParam -> Maybe StartParam -> LimitsParam
LimitsParam Maybe LimitParam
forall a. Maybe a
Nothing OffsetParam
forall a. Default a => a
def Maybe StartParam
forall a. Maybe a
Nothing

newtype HeightParam = HeightParam {HeightParam -> Natural
get :: Natural}
  deriving (HeightParam -> HeightParam -> Bool
(HeightParam -> HeightParam -> Bool)
-> (HeightParam -> HeightParam -> Bool) -> Eq HeightParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeightParam -> HeightParam -> Bool
== :: HeightParam -> HeightParam -> Bool
$c/= :: HeightParam -> HeightParam -> Bool
/= :: HeightParam -> HeightParam -> Bool
Eq, Int -> HeightParam -> ShowS
[HeightParam] -> ShowS
HeightParam -> [Char]
(Int -> HeightParam -> ShowS)
-> (HeightParam -> [Char])
-> ([HeightParam] -> ShowS)
-> Show HeightParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeightParam -> ShowS
showsPrec :: Int -> HeightParam -> ShowS
$cshow :: HeightParam -> [Char]
show :: HeightParam -> [Char]
$cshowList :: [HeightParam] -> ShowS
showList :: [HeightParam] -> ShowS
Show, ReadPrec [HeightParam]
ReadPrec HeightParam
Int -> ReadS HeightParam
ReadS [HeightParam]
(Int -> ReadS HeightParam)
-> ReadS [HeightParam]
-> ReadPrec HeightParam
-> ReadPrec [HeightParam]
-> Read HeightParam
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HeightParam
readsPrec :: Int -> ReadS HeightParam
$creadList :: ReadS [HeightParam]
readList :: ReadS [HeightParam]
$creadPrec :: ReadPrec HeightParam
readPrec :: ReadPrec HeightParam
$creadListPrec :: ReadPrec [HeightParam]
readListPrec :: ReadPrec [HeightParam]
Read, Int -> HeightParam
HeightParam -> Int
HeightParam -> [HeightParam]
HeightParam -> HeightParam
HeightParam -> HeightParam -> [HeightParam]
HeightParam -> HeightParam -> HeightParam -> [HeightParam]
(HeightParam -> HeightParam)
-> (HeightParam -> HeightParam)
-> (Int -> HeightParam)
-> (HeightParam -> Int)
-> (HeightParam -> [HeightParam])
-> (HeightParam -> HeightParam -> [HeightParam])
-> (HeightParam -> HeightParam -> [HeightParam])
-> (HeightParam -> HeightParam -> HeightParam -> [HeightParam])
-> Enum HeightParam
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 :: HeightParam -> HeightParam
succ :: HeightParam -> HeightParam
$cpred :: HeightParam -> HeightParam
pred :: HeightParam -> HeightParam
$ctoEnum :: Int -> HeightParam
toEnum :: Int -> HeightParam
$cfromEnum :: HeightParam -> Int
fromEnum :: HeightParam -> Int
$cenumFrom :: HeightParam -> [HeightParam]
enumFrom :: HeightParam -> [HeightParam]
$cenumFromThen :: HeightParam -> HeightParam -> [HeightParam]
enumFromThen :: HeightParam -> HeightParam -> [HeightParam]
$cenumFromTo :: HeightParam -> HeightParam -> [HeightParam]
enumFromTo :: HeightParam -> HeightParam -> [HeightParam]
$cenumFromThenTo :: HeightParam -> HeightParam -> HeightParam -> [HeightParam]
enumFromThenTo :: HeightParam -> HeightParam -> HeightParam -> [HeightParam]
Enum, Eq HeightParam
Eq HeightParam =>
(HeightParam -> HeightParam -> Ordering)
-> (HeightParam -> HeightParam -> Bool)
-> (HeightParam -> HeightParam -> Bool)
-> (HeightParam -> HeightParam -> Bool)
-> (HeightParam -> HeightParam -> Bool)
-> (HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> HeightParam)
-> Ord HeightParam
HeightParam -> HeightParam -> Bool
HeightParam -> HeightParam -> Ordering
HeightParam -> HeightParam -> HeightParam
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 :: HeightParam -> HeightParam -> Ordering
compare :: HeightParam -> HeightParam -> Ordering
$c< :: HeightParam -> HeightParam -> Bool
< :: HeightParam -> HeightParam -> Bool
$c<= :: HeightParam -> HeightParam -> Bool
<= :: HeightParam -> HeightParam -> Bool
$c> :: HeightParam -> HeightParam -> Bool
> :: HeightParam -> HeightParam -> Bool
$c>= :: HeightParam -> HeightParam -> Bool
>= :: HeightParam -> HeightParam -> Bool
$cmax :: HeightParam -> HeightParam -> HeightParam
max :: HeightParam -> HeightParam -> HeightParam
$cmin :: HeightParam -> HeightParam -> HeightParam
min :: HeightParam -> HeightParam -> HeightParam
Ord, Integer -> HeightParam
HeightParam -> HeightParam
HeightParam -> HeightParam -> HeightParam
(HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam)
-> (HeightParam -> HeightParam)
-> (HeightParam -> HeightParam)
-> (Integer -> HeightParam)
-> Num HeightParam
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: HeightParam -> HeightParam -> HeightParam
+ :: HeightParam -> HeightParam -> HeightParam
$c- :: HeightParam -> HeightParam -> HeightParam
- :: HeightParam -> HeightParam -> HeightParam
$c* :: HeightParam -> HeightParam -> HeightParam
* :: HeightParam -> HeightParam -> HeightParam
$cnegate :: HeightParam -> HeightParam
negate :: HeightParam -> HeightParam
$cabs :: HeightParam -> HeightParam
abs :: HeightParam -> HeightParam
$csignum :: HeightParam -> HeightParam
signum :: HeightParam -> HeightParam
$cfromInteger :: Integer -> HeightParam
fromInteger :: Integer -> HeightParam
Num, Num HeightParam
Ord HeightParam
(Num HeightParam, Ord HeightParam) =>
(HeightParam -> Rational) -> Real HeightParam
HeightParam -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: HeightParam -> Rational
toRational :: HeightParam -> Rational
Real, Enum HeightParam
Real HeightParam
(Real HeightParam, Enum HeightParam) =>
(HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> HeightParam)
-> (HeightParam -> HeightParam -> (HeightParam, HeightParam))
-> (HeightParam -> HeightParam -> (HeightParam, HeightParam))
-> (HeightParam -> Integer)
-> Integral HeightParam
HeightParam -> Integer
HeightParam -> HeightParam -> (HeightParam, HeightParam)
HeightParam -> HeightParam -> HeightParam
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: HeightParam -> HeightParam -> HeightParam
quot :: HeightParam -> HeightParam -> HeightParam
$crem :: HeightParam -> HeightParam -> HeightParam
rem :: HeightParam -> HeightParam -> HeightParam
$cdiv :: HeightParam -> HeightParam -> HeightParam
div :: HeightParam -> HeightParam -> HeightParam
$cmod :: HeightParam -> HeightParam -> HeightParam
mod :: HeightParam -> HeightParam -> HeightParam
$cquotRem :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
quotRem :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
$cdivMod :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
divMod :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
$ctoInteger :: HeightParam -> Integer
toInteger :: HeightParam -> Integer
Integral)

instance Param HeightParam where
  proxyLabel :: Proxy HeightParam -> Text
proxyLabel = Text -> Proxy HeightParam -> Text
forall a b. a -> b -> a
const Text
"height"
  encodeParam :: Network -> Ctx -> HeightParam -> Maybe [Text]
encodeParam Network
net Ctx
ctx (HeightParam Natural
h) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
h]
  parseParam :: Network -> Ctx -> [Text] -> Maybe HeightParam
parseParam Network
net Ctx
ctx [Text
s] = Natural -> HeightParam
HeightParam (Natural -> HeightParam) -> Maybe Natural -> Maybe HeightParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Natural
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
s)
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe HeightParam
forall a. Maybe a
Nothing

newtype HeightsParam = HeightsParam {HeightsParam -> [Natural]
get :: [Natural]}
  deriving (HeightsParam -> HeightsParam -> Bool
(HeightsParam -> HeightsParam -> Bool)
-> (HeightsParam -> HeightsParam -> Bool) -> Eq HeightsParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeightsParam -> HeightsParam -> Bool
== :: HeightsParam -> HeightsParam -> Bool
$c/= :: HeightsParam -> HeightsParam -> Bool
/= :: HeightsParam -> HeightsParam -> Bool
Eq, Int -> HeightsParam -> ShowS
[HeightsParam] -> ShowS
HeightsParam -> [Char]
(Int -> HeightsParam -> ShowS)
-> (HeightsParam -> [Char])
-> ([HeightsParam] -> ShowS)
-> Show HeightsParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeightsParam -> ShowS
showsPrec :: Int -> HeightsParam -> ShowS
$cshow :: HeightsParam -> [Char]
show :: HeightsParam -> [Char]
$cshowList :: [HeightsParam] -> ShowS
showList :: [HeightsParam] -> ShowS
Show, ReadPrec [HeightsParam]
ReadPrec HeightsParam
Int -> ReadS HeightsParam
ReadS [HeightsParam]
(Int -> ReadS HeightsParam)
-> ReadS [HeightsParam]
-> ReadPrec HeightsParam
-> ReadPrec [HeightsParam]
-> Read HeightsParam
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HeightsParam
readsPrec :: Int -> ReadS HeightsParam
$creadList :: ReadS [HeightsParam]
readList :: ReadS [HeightsParam]
$creadPrec :: ReadPrec HeightsParam
readPrec :: ReadPrec HeightsParam
$creadListPrec :: ReadPrec [HeightsParam]
readListPrec :: ReadPrec [HeightsParam]
Read)

instance Param HeightsParam where
  proxyLabel :: Proxy HeightsParam -> Text
proxyLabel = Text -> Proxy HeightsParam -> Text
forall a b. a -> b -> a
const Text
"heights"
  encodeParam :: Network -> Ctx -> HeightsParam -> Maybe [Text]
encodeParam Network
net Ctx
ctx (HeightsParam [Natural]
hs) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> (Natural -> [Char]) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [Char]
forall a. Show a => a -> [Char]
show (Natural -> Text) -> [Natural] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural]
hs
  parseParam :: Network -> Ctx -> [Text] -> Maybe HeightsParam
parseParam Network
net Ctx
ctx [Text]
xs = [Natural] -> HeightsParam
HeightsParam ([Natural] -> HeightsParam)
-> Maybe [Natural] -> Maybe HeightsParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Natural) -> [Text] -> Maybe [Natural]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> Maybe Natural
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Natural)
-> (Text -> [Char]) -> Text -> Maybe Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs) [Text]
xs

newtype TimeParam = TimeParam {TimeParam -> UnixTime
get :: Store.UnixTime}
  deriving (TimeParam -> TimeParam -> Bool
(TimeParam -> TimeParam -> Bool)
-> (TimeParam -> TimeParam -> Bool) -> Eq TimeParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeParam -> TimeParam -> Bool
== :: TimeParam -> TimeParam -> Bool
$c/= :: TimeParam -> TimeParam -> Bool
/= :: TimeParam -> TimeParam -> Bool
Eq, Int -> TimeParam -> ShowS
[TimeParam] -> ShowS
TimeParam -> [Char]
(Int -> TimeParam -> ShowS)
-> (TimeParam -> [Char])
-> ([TimeParam] -> ShowS)
-> Show TimeParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeParam -> ShowS
showsPrec :: Int -> TimeParam -> ShowS
$cshow :: TimeParam -> [Char]
show :: TimeParam -> [Char]
$cshowList :: [TimeParam] -> ShowS
showList :: [TimeParam] -> ShowS
Show, ReadPrec [TimeParam]
ReadPrec TimeParam
Int -> ReadS TimeParam
ReadS [TimeParam]
(Int -> ReadS TimeParam)
-> ReadS [TimeParam]
-> ReadPrec TimeParam
-> ReadPrec [TimeParam]
-> Read TimeParam
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TimeParam
readsPrec :: Int -> ReadS TimeParam
$creadList :: ReadS [TimeParam]
readList :: ReadS [TimeParam]
$creadPrec :: ReadPrec TimeParam
readPrec :: ReadPrec TimeParam
$creadListPrec :: ReadPrec [TimeParam]
readListPrec :: ReadPrec [TimeParam]
Read, Int -> TimeParam
TimeParam -> Int
TimeParam -> [TimeParam]
TimeParam -> TimeParam
TimeParam -> TimeParam -> [TimeParam]
TimeParam -> TimeParam -> TimeParam -> [TimeParam]
(TimeParam -> TimeParam)
-> (TimeParam -> TimeParam)
-> (Int -> TimeParam)
-> (TimeParam -> Int)
-> (TimeParam -> [TimeParam])
-> (TimeParam -> TimeParam -> [TimeParam])
-> (TimeParam -> TimeParam -> [TimeParam])
-> (TimeParam -> TimeParam -> TimeParam -> [TimeParam])
-> Enum TimeParam
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 :: TimeParam -> TimeParam
succ :: TimeParam -> TimeParam
$cpred :: TimeParam -> TimeParam
pred :: TimeParam -> TimeParam
$ctoEnum :: Int -> TimeParam
toEnum :: Int -> TimeParam
$cfromEnum :: TimeParam -> Int
fromEnum :: TimeParam -> Int
$cenumFrom :: TimeParam -> [TimeParam]
enumFrom :: TimeParam -> [TimeParam]
$cenumFromThen :: TimeParam -> TimeParam -> [TimeParam]
enumFromThen :: TimeParam -> TimeParam -> [TimeParam]
$cenumFromTo :: TimeParam -> TimeParam -> [TimeParam]
enumFromTo :: TimeParam -> TimeParam -> [TimeParam]
$cenumFromThenTo :: TimeParam -> TimeParam -> TimeParam -> [TimeParam]
enumFromThenTo :: TimeParam -> TimeParam -> TimeParam -> [TimeParam]
Enum, Eq TimeParam
Eq TimeParam =>
(TimeParam -> TimeParam -> Ordering)
-> (TimeParam -> TimeParam -> Bool)
-> (TimeParam -> TimeParam -> Bool)
-> (TimeParam -> TimeParam -> Bool)
-> (TimeParam -> TimeParam -> Bool)
-> (TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> TimeParam)
-> Ord TimeParam
TimeParam -> TimeParam -> Bool
TimeParam -> TimeParam -> Ordering
TimeParam -> TimeParam -> TimeParam
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 :: TimeParam -> TimeParam -> Ordering
compare :: TimeParam -> TimeParam -> Ordering
$c< :: TimeParam -> TimeParam -> Bool
< :: TimeParam -> TimeParam -> Bool
$c<= :: TimeParam -> TimeParam -> Bool
<= :: TimeParam -> TimeParam -> Bool
$c> :: TimeParam -> TimeParam -> Bool
> :: TimeParam -> TimeParam -> Bool
$c>= :: TimeParam -> TimeParam -> Bool
>= :: TimeParam -> TimeParam -> Bool
$cmax :: TimeParam -> TimeParam -> TimeParam
max :: TimeParam -> TimeParam -> TimeParam
$cmin :: TimeParam -> TimeParam -> TimeParam
min :: TimeParam -> TimeParam -> TimeParam
Ord, Integer -> TimeParam
TimeParam -> TimeParam
TimeParam -> TimeParam -> TimeParam
(TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam)
-> (TimeParam -> TimeParam)
-> (TimeParam -> TimeParam)
-> (Integer -> TimeParam)
-> Num TimeParam
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TimeParam -> TimeParam -> TimeParam
+ :: TimeParam -> TimeParam -> TimeParam
$c- :: TimeParam -> TimeParam -> TimeParam
- :: TimeParam -> TimeParam -> TimeParam
$c* :: TimeParam -> TimeParam -> TimeParam
* :: TimeParam -> TimeParam -> TimeParam
$cnegate :: TimeParam -> TimeParam
negate :: TimeParam -> TimeParam
$cabs :: TimeParam -> TimeParam
abs :: TimeParam -> TimeParam
$csignum :: TimeParam -> TimeParam
signum :: TimeParam -> TimeParam
$cfromInteger :: Integer -> TimeParam
fromInteger :: Integer -> TimeParam
Num, Num TimeParam
Ord TimeParam
(Num TimeParam, Ord TimeParam) =>
(TimeParam -> Rational) -> Real TimeParam
TimeParam -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: TimeParam -> Rational
toRational :: TimeParam -> Rational
Real, Enum TimeParam
Real TimeParam
(Real TimeParam, Enum TimeParam) =>
(TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> TimeParam)
-> (TimeParam -> TimeParam -> (TimeParam, TimeParam))
-> (TimeParam -> TimeParam -> (TimeParam, TimeParam))
-> (TimeParam -> Integer)
-> Integral TimeParam
TimeParam -> Integer
TimeParam -> TimeParam -> (TimeParam, TimeParam)
TimeParam -> TimeParam -> TimeParam
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: TimeParam -> TimeParam -> TimeParam
quot :: TimeParam -> TimeParam -> TimeParam
$crem :: TimeParam -> TimeParam -> TimeParam
rem :: TimeParam -> TimeParam -> TimeParam
$cdiv :: TimeParam -> TimeParam -> TimeParam
div :: TimeParam -> TimeParam -> TimeParam
$cmod :: TimeParam -> TimeParam -> TimeParam
mod :: TimeParam -> TimeParam -> TimeParam
$cquotRem :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
quotRem :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
$cdivMod :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
divMod :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
$ctoInteger :: TimeParam -> Integer
toInteger :: TimeParam -> Integer
Integral)

instance Param TimeParam where
  proxyLabel :: Proxy TimeParam -> Text
proxyLabel = Text -> Proxy TimeParam -> Text
forall a b. a -> b -> a
const Text
"time"
  encodeParam :: Network -> Ctx -> TimeParam -> Maybe [Text]
encodeParam Network
net Ctx
ctx (TimeParam UnixTime
t) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [[Char] -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ UnixTime -> [Char]
forall a. Show a => a -> [Char]
show UnixTime
t]
  parseParam :: Network -> Ctx -> [Text] -> Maybe TimeParam
parseParam Network
net Ctx
ctx [Text
s] = UnixTime -> TimeParam
TimeParam (UnixTime -> TimeParam) -> Maybe UnixTime -> Maybe TimeParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe UnixTime
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
forall a b. ConvertibleStrings a b => a -> b
cs Text
s)
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe TimeParam
forall a. Maybe a
Nothing

instance Param XPubKey where
  proxyLabel :: Proxy XPubKey -> Text
proxyLabel = Text -> Proxy XPubKey -> Text
forall a b. a -> b -> a
const Text
"xpub"
  encodeParam :: Network -> Ctx -> XPubKey -> Maybe [Text]
encodeParam Network
net Ctx
ctx XPubKey
p = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Network -> Ctx -> XPubKey -> Text
xPubExport Network
net Ctx
ctx XPubKey
p]
  parseParam :: Network -> Ctx -> [Text] -> Maybe XPubKey
parseParam Network
net Ctx
ctx [Text
s] = Network -> Ctx -> Text -> Maybe XPubKey
xPubImport Network
net Ctx
ctx Text
s
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe XPubKey
forall a. Maybe a
Nothing

instance Param Store.DeriveType where
  proxyLabel :: Proxy DeriveType -> Text
proxyLabel = Text -> Proxy DeriveType -> Text
forall a b. a -> b -> a
const Text
"derive"
  encodeParam :: Network -> Ctx -> DeriveType -> Maybe [Text]
encodeParam Network
net Ctx
ctx DeriveType
p = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Network
net.segWit Bool -> Bool -> Bool
|| DeriveType
p DeriveType -> DeriveType -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveType
Store.DeriveNormal)
    [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [DeriveType -> Text
Store.deriveTypeToText DeriveType
p]
  parseParam :: Network -> Ctx -> [Text] -> Maybe DeriveType
parseParam Network
net Ctx
ctx [Text]
d = do
    DeriveType
res <- case [Text]
d of
      [Text
x] -> Text -> Maybe DeriveType
Store.textToDeriveType Text
x
      [Text]
_ -> Maybe DeriveType
forall a. Maybe a
Nothing
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Network
net.segWit Bool -> Bool -> Bool
|| DeriveType
res DeriveType -> DeriveType -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveType
Store.DeriveNormal)
    DeriveType -> Maybe DeriveType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
res

newtype NoCache = NoCache {NoCache -> Bool
get :: Bool}
  deriving (NoCache -> NoCache -> Bool
(NoCache -> NoCache -> Bool)
-> (NoCache -> NoCache -> Bool) -> Eq NoCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoCache -> NoCache -> Bool
== :: NoCache -> NoCache -> Bool
$c/= :: NoCache -> NoCache -> Bool
/= :: NoCache -> NoCache -> Bool
Eq, Int -> NoCache -> ShowS
[NoCache] -> ShowS
NoCache -> [Char]
(Int -> NoCache -> ShowS)
-> (NoCache -> [Char]) -> ([NoCache] -> ShowS) -> Show NoCache
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoCache -> ShowS
showsPrec :: Int -> NoCache -> ShowS
$cshow :: NoCache -> [Char]
show :: NoCache -> [Char]
$cshowList :: [NoCache] -> ShowS
showList :: [NoCache] -> ShowS
Show, ReadPrec [NoCache]
ReadPrec NoCache
Int -> ReadS NoCache
ReadS [NoCache]
(Int -> ReadS NoCache)
-> ReadS [NoCache]
-> ReadPrec NoCache
-> ReadPrec [NoCache]
-> Read NoCache
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NoCache
readsPrec :: Int -> ReadS NoCache
$creadList :: ReadS [NoCache]
readList :: ReadS [NoCache]
$creadPrec :: ReadPrec NoCache
readPrec :: ReadPrec NoCache
$creadListPrec :: ReadPrec [NoCache]
readListPrec :: ReadPrec [NoCache]
Read)

instance Default NoCache where
  def :: NoCache
def = Bool -> NoCache
NoCache Bool
False

instance Param NoCache where
  proxyLabel :: Proxy NoCache -> Text
proxyLabel = Text -> Proxy NoCache -> Text
forall a b. a -> b -> a
const Text
"nocache"
  encodeParam :: Network -> Ctx -> NoCache -> Maybe [Text]
encodeParam Network
net Ctx
ctx (NoCache Bool
True) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"true"]
  encodeParam Network
net Ctx
ctx (NoCache Bool
False) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"false"]
  parseParam :: Network -> Ctx -> [Text] -> Maybe NoCache
parseParam Network
net Ctx
ctx = \case
    [Text
"true"] -> NoCache -> Maybe NoCache
forall a. a -> Maybe a
Just (NoCache -> Maybe NoCache) -> NoCache -> Maybe NoCache
forall a b. (a -> b) -> a -> b
$ Bool -> NoCache
NoCache Bool
True
    [Text
"false"] -> NoCache -> Maybe NoCache
forall a. a -> Maybe a
Just (NoCache -> Maybe NoCache) -> NoCache -> Maybe NoCache
forall a b. (a -> b) -> a -> b
$ Bool -> NoCache
NoCache Bool
False
    [Text]
_ -> Maybe NoCache
forall a. Maybe a
Nothing

newtype NoTx = NoTx {NoTx -> Bool
get :: Bool}
  deriving (NoTx -> NoTx -> Bool
(NoTx -> NoTx -> Bool) -> (NoTx -> NoTx -> Bool) -> Eq NoTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoTx -> NoTx -> Bool
== :: NoTx -> NoTx -> Bool
$c/= :: NoTx -> NoTx -> Bool
/= :: NoTx -> NoTx -> Bool
Eq, Int -> NoTx -> ShowS
[NoTx] -> ShowS
NoTx -> [Char]
(Int -> NoTx -> ShowS)
-> (NoTx -> [Char]) -> ([NoTx] -> ShowS) -> Show NoTx
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoTx -> ShowS
showsPrec :: Int -> NoTx -> ShowS
$cshow :: NoTx -> [Char]
show :: NoTx -> [Char]
$cshowList :: [NoTx] -> ShowS
showList :: [NoTx] -> ShowS
Show, ReadPrec [NoTx]
ReadPrec NoTx
Int -> ReadS NoTx
ReadS [NoTx]
(Int -> ReadS NoTx)
-> ReadS [NoTx] -> ReadPrec NoTx -> ReadPrec [NoTx] -> Read NoTx
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NoTx
readsPrec :: Int -> ReadS NoTx
$creadList :: ReadS [NoTx]
readList :: ReadS [NoTx]
$creadPrec :: ReadPrec NoTx
readPrec :: ReadPrec NoTx
$creadListPrec :: ReadPrec [NoTx]
readListPrec :: ReadPrec [NoTx]
Read)

instance Default NoTx where
  def :: NoTx
def = Bool -> NoTx
NoTx Bool
False

instance Param NoTx where
  proxyLabel :: Proxy NoTx -> Text
proxyLabel = Text -> Proxy NoTx -> Text
forall a b. a -> b -> a
const Text
"notx"
  encodeParam :: Network -> Ctx -> NoTx -> Maybe [Text]
encodeParam Network
net Ctx
ctx (NoTx Bool
True) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"true"]
  encodeParam Network
net Ctx
ctx (NoTx Bool
False) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"false"]
  parseParam :: Network -> Ctx -> [Text] -> Maybe NoTx
parseParam Network
net Ctx
ctx = \case
    [Text
"true"] -> NoTx -> Maybe NoTx
forall a. a -> Maybe a
Just (NoTx -> Maybe NoTx) -> NoTx -> Maybe NoTx
forall a b. (a -> b) -> a -> b
$ Bool -> NoTx
NoTx Bool
True
    [Text
"false"] -> NoTx -> Maybe NoTx
forall a. a -> Maybe a
Just (NoTx -> Maybe NoTx) -> NoTx -> Maybe NoTx
forall a b. (a -> b) -> a -> b
$ Bool -> NoTx
NoTx Bool
False
    [Text]
_ -> Maybe NoTx
forall a. Maybe a
Nothing

instance Param BlockHash where
  proxyLabel :: Proxy BlockHash -> Text
proxyLabel = Text -> Proxy BlockHash -> Text
forall a b. a -> b -> a
const Text
"block"
  encodeParam :: Network -> Ctx -> BlockHash -> Maybe [Text]
encodeParam Network
net Ctx
ctx BlockHash
b = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [BlockHash -> Text
blockHashToHex BlockHash
b]
  parseParam :: Network -> Ctx -> [Text] -> Maybe BlockHash
parseParam Network
net Ctx
ctx [Text
s] = Text -> Maybe BlockHash
hexToBlockHash Text
s
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe BlockHash
forall a. Maybe a
Nothing

instance Param [BlockHash] where
  proxyLabel :: Proxy [BlockHash] -> Text
proxyLabel = Text -> Proxy [BlockHash] -> Text
forall a b. a -> b -> a
const Text
"blocks"
  encodeParam :: Network -> Ctx -> [BlockHash] -> Maybe [Text]
encodeParam Network
net Ctx
ctx [BlockHash]
bs = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ BlockHash -> Text
blockHashToHex (BlockHash -> Text) -> [BlockHash] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BlockHash]
bs
  parseParam :: Network -> Ctx -> [Text] -> Maybe [BlockHash]
parseParam Network
net Ctx
ctx = (Text -> Maybe BlockHash) -> [Text] -> Maybe [BlockHash]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe BlockHash
hexToBlockHash

instance Param TxHash where
  proxyLabel :: Proxy TxHash -> Text
proxyLabel = Text -> Proxy TxHash -> Text
forall a b. a -> b -> a
const Text
"txid"
  encodeParam :: Network -> Ctx -> TxHash -> Maybe [Text]
encodeParam Network
net Ctx
ctx TxHash
t = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [TxHash -> Text
txHashToHex TxHash
t]
  parseParam :: Network -> Ctx -> [Text] -> Maybe TxHash
parseParam Network
net Ctx
ctx [Text
s] = Text -> Maybe TxHash
hexToTxHash Text
s
  parseParam Network
net Ctx
ctx [Text]
_ = Maybe TxHash
forall a. Maybe a
Nothing

instance Param [TxHash] where
  proxyLabel :: Proxy [TxHash] -> Text
proxyLabel = Text -> Proxy [TxHash] -> Text
forall a b. a -> b -> a
const Text
"txids"
  encodeParam :: Network -> Ctx -> [TxHash] -> Maybe [Text]
encodeParam Network
net Ctx
ctx [TxHash]
ts = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ TxHash -> Text
txHashToHex (TxHash -> Text) -> [TxHash] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxHash]
ts
  parseParam :: Network -> Ctx -> [Text] -> Maybe [TxHash]
parseParam Network
net Ctx
ctx = (Text -> Maybe TxHash) -> [Text] -> Maybe [TxHash]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe TxHash
hexToTxHash