{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
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 qualified Data.Text               as T
import           Haskoin.Address
import           Haskoin.Block           (Block, BlockHash, blockHashToHex,
                                          hexToBlockHash)
import           Haskoin.Constants
import           Haskoin.Data
import           Haskoin.Crypto          (Hash256)
import           Haskoin.Keys
import qualified Haskoin.Store.Data      as Store
import           Haskoin.Transaction
import           Network.HTTP.Types      (StdMethod (..))
import           Numeric.Natural         (Natural)
import           Text.Read               (readMaybe)
import qualified Web.Scotty.Trans        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.PeerInformation) 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 (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 :: 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 :: 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 :: 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 -> a -> Text
queryPath :: Network -> a -> Text
queryPath Network
net 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 -> p -> Maybe [Text]
forall a. Param a => Network -> a -> Maybe [Text]
encodeParam Network
net 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 :: 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 :: 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 -> a -> Maybe [Text]
    parseParam :: Network -> [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 -> Address -> Maybe [Text]
encodeParam Network
net 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 -> [Text] -> Maybe Address
parseParam Network
net [Text
a] = Network -> Text -> Maybe Address
textToAddr Network
net Text
a
    parseParam Network
_ [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 -> [Address] -> Maybe [Text]
encodeParam = (Address -> Maybe Text) -> [Address] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Address -> Maybe Text) -> [Address] -> Maybe [Text])
-> (Network -> Address -> Maybe Text)
-> Network
-> [Address]
-> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Address -> Maybe Text
addrToText
    parseParam :: Network -> [Text] -> Maybe [Address]
parseParam = (Text -> Maybe Address) -> [Text] -> Maybe [Address]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> Maybe Address) -> [Text] -> Maybe [Address])
-> (Network -> Text -> Maybe Address)
-> Network
-> [Text]
-> Maybe [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Text -> Maybe Address
textToAddr

data StartParam = StartParamHash
    { StartParam -> Hash256
startParamHash :: Hash256
    }
    | StartParamHeight
    { StartParam -> Natural
startParamHeight :: Natural
    }
    | StartParamTime
    { StartParam -> UnixTime
startParamTime :: Store.UnixTime
    }
    deriving (StartParam -> StartParam -> Bool
(StartParam -> StartParam -> Bool)
-> (StartParam -> StartParam -> Bool) -> Eq StartParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartParam -> StartParam -> Bool
$c/= :: StartParam -> StartParam -> Bool
== :: StartParam -> StartParam -> Bool
$c== :: 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
showList :: [StartParam] -> ShowS
$cshowList :: [StartParam] -> ShowS
show :: StartParam -> [Char]
$cshow :: StartParam -> [Char]
showsPrec :: Int -> StartParam -> ShowS
$cshowsPrec :: Int -> 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 -> StartParam -> Maybe [Text]
encodeParam Network
_ StartParam
p =
        case StartParam
p of
            StartParamHash Hash256
h -> [Text] -> Maybe [Text]
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 (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 (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 -> [Text] -> Maybe StartParam
parseParam Network
_ [Text
s] = Maybe StartParam
parseHash Maybe StartParam -> Maybe StartParam -> Maybe StartParam
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe StartParam
parseHeight Maybe StartParam -> Maybe StartParam -> Maybe StartParam
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 (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 (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 (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
_ [Text]
_ = Maybe StartParam
forall a. Maybe a
Nothing

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

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

data LimitsParam =
    LimitsParam
        { LimitsParam -> Maybe LimitParam
paramLimit  :: Maybe LimitParam -- 0 means maximum
        , LimitsParam -> OffsetParam
paramOffset :: OffsetParam
        , LimitsParam -> Maybe StartParam
paramStart  :: Maybe StartParam
        }
    deriving (LimitsParam -> LimitsParam -> Bool
(LimitsParam -> LimitsParam -> Bool)
-> (LimitsParam -> LimitsParam -> Bool) -> Eq LimitsParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LimitsParam -> LimitsParam -> Bool
$c/= :: LimitsParam -> LimitsParam -> Bool
== :: LimitsParam -> LimitsParam -> Bool
$c== :: 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
showList :: [LimitsParam] -> ShowS
$cshowList :: [LimitsParam] -> ShowS
show :: LimitsParam -> [Char]
$cshow :: LimitsParam -> [Char]
showsPrec :: Int -> LimitsParam -> ShowS
$cshowsPrec :: Int -> 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
getHeightParam :: Natural
    } deriving (HeightParam -> HeightParam -> Bool
(HeightParam -> HeightParam -> Bool)
-> (HeightParam -> HeightParam -> Bool) -> Eq HeightParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeightParam -> HeightParam -> Bool
$c/= :: HeightParam -> HeightParam -> Bool
== :: HeightParam -> HeightParam -> Bool
$c== :: 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
showList :: [HeightParam] -> ShowS
$cshowList :: [HeightParam] -> ShowS
show :: HeightParam -> [Char]
$cshow :: HeightParam -> [Char]
showsPrec :: Int -> HeightParam -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [HeightParam]
$creadListPrec :: ReadPrec [HeightParam]
readPrec :: ReadPrec HeightParam
$creadPrec :: ReadPrec HeightParam
readList :: ReadS [HeightParam]
$creadList :: ReadS [HeightParam]
readsPrec :: Int -> ReadS HeightParam
$creadsPrec :: Int -> ReadS 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
enumFromThenTo :: HeightParam -> HeightParam -> HeightParam -> [HeightParam]
$cenumFromThenTo :: HeightParam -> HeightParam -> HeightParam -> [HeightParam]
enumFromTo :: HeightParam -> HeightParam -> [HeightParam]
$cenumFromTo :: HeightParam -> HeightParam -> [HeightParam]
enumFromThen :: HeightParam -> HeightParam -> [HeightParam]
$cenumFromThen :: HeightParam -> HeightParam -> [HeightParam]
enumFrom :: HeightParam -> [HeightParam]
$cenumFrom :: HeightParam -> [HeightParam]
fromEnum :: HeightParam -> Int
$cfromEnum :: HeightParam -> Int
toEnum :: Int -> HeightParam
$ctoEnum :: Int -> HeightParam
pred :: HeightParam -> HeightParam
$cpred :: HeightParam -> HeightParam
succ :: HeightParam -> HeightParam
$csucc :: 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
min :: HeightParam -> HeightParam -> HeightParam
$cmin :: HeightParam -> HeightParam -> HeightParam
max :: HeightParam -> HeightParam -> HeightParam
$cmax :: HeightParam -> HeightParam -> HeightParam
>= :: HeightParam -> HeightParam -> Bool
$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
compare :: HeightParam -> HeightParam -> Ordering
$ccompare :: HeightParam -> HeightParam -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> HeightParam
$cfromInteger :: Integer -> HeightParam
signum :: HeightParam -> HeightParam
$csignum :: HeightParam -> HeightParam
abs :: HeightParam -> HeightParam
$cabs :: HeightParam -> HeightParam
negate :: HeightParam -> HeightParam
$cnegate :: HeightParam -> HeightParam
* :: HeightParam -> HeightParam -> HeightParam
$c* :: HeightParam -> HeightParam -> HeightParam
- :: HeightParam -> HeightParam -> HeightParam
$c- :: HeightParam -> HeightParam -> HeightParam
+ :: HeightParam -> HeightParam -> HeightParam
$c+ :: HeightParam -> HeightParam -> 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
toRational :: HeightParam -> Rational
$ctoRational :: HeightParam -> Rational
$cp2Real :: Ord HeightParam
$cp1Real :: Num HeightParam
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
toInteger :: HeightParam -> Integer
$ctoInteger :: HeightParam -> Integer
divMod :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
$cdivMod :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
quotRem :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
$cquotRem :: HeightParam -> HeightParam -> (HeightParam, HeightParam)
mod :: HeightParam -> HeightParam -> HeightParam
$cmod :: HeightParam -> HeightParam -> HeightParam
div :: HeightParam -> HeightParam -> HeightParam
$cdiv :: HeightParam -> HeightParam -> HeightParam
rem :: HeightParam -> HeightParam -> HeightParam
$crem :: HeightParam -> HeightParam -> HeightParam
quot :: HeightParam -> HeightParam -> HeightParam
$cquot :: HeightParam -> HeightParam -> HeightParam
$cp2Integral :: Enum HeightParam
$cp1Integral :: Real HeightParam
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 -> HeightParam -> Maybe [Text]
encodeParam Network
_ (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 -> [Text] -> Maybe HeightParam
parseParam Network
_ [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
_ [Text]
_   = Maybe HeightParam
forall a. Maybe a
Nothing

newtype HeightsParam = HeightsParam
    { HeightsParam -> [Natural]
getHeightsParam :: [Natural]
    } deriving (HeightsParam -> HeightsParam -> Bool
(HeightsParam -> HeightsParam -> Bool)
-> (HeightsParam -> HeightsParam -> Bool) -> Eq HeightsParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeightsParam -> HeightsParam -> Bool
$c/= :: HeightsParam -> HeightsParam -> Bool
== :: HeightsParam -> HeightsParam -> Bool
$c== :: 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
showList :: [HeightsParam] -> ShowS
$cshowList :: [HeightsParam] -> ShowS
show :: HeightsParam -> [Char]
$cshow :: HeightsParam -> [Char]
showsPrec :: Int -> HeightsParam -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [HeightsParam]
$creadListPrec :: ReadPrec [HeightsParam]
readPrec :: ReadPrec HeightsParam
$creadPrec :: ReadPrec HeightsParam
readList :: ReadS [HeightsParam]
$creadList :: ReadS [HeightsParam]
readsPrec :: Int -> ReadS HeightsParam
$creadsPrec :: Int -> ReadS 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 -> HeightsParam -> Maybe [Text]
encodeParam Network
_ (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 -> [Text] -> Maybe HeightsParam
parseParam Network
_ [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)
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
getTimeParam :: Store.UnixTime
    } deriving (TimeParam -> TimeParam -> Bool
(TimeParam -> TimeParam -> Bool)
-> (TimeParam -> TimeParam -> Bool) -> Eq TimeParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeParam -> TimeParam -> Bool
$c/= :: TimeParam -> TimeParam -> Bool
== :: TimeParam -> TimeParam -> Bool
$c== :: 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
showList :: [TimeParam] -> ShowS
$cshowList :: [TimeParam] -> ShowS
show :: TimeParam -> [Char]
$cshow :: TimeParam -> [Char]
showsPrec :: Int -> TimeParam -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [TimeParam]
$creadListPrec :: ReadPrec [TimeParam]
readPrec :: ReadPrec TimeParam
$creadPrec :: ReadPrec TimeParam
readList :: ReadS [TimeParam]
$creadList :: ReadS [TimeParam]
readsPrec :: Int -> ReadS TimeParam
$creadsPrec :: Int -> ReadS 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
enumFromThenTo :: TimeParam -> TimeParam -> TimeParam -> [TimeParam]
$cenumFromThenTo :: TimeParam -> TimeParam -> TimeParam -> [TimeParam]
enumFromTo :: TimeParam -> TimeParam -> [TimeParam]
$cenumFromTo :: TimeParam -> TimeParam -> [TimeParam]
enumFromThen :: TimeParam -> TimeParam -> [TimeParam]
$cenumFromThen :: TimeParam -> TimeParam -> [TimeParam]
enumFrom :: TimeParam -> [TimeParam]
$cenumFrom :: TimeParam -> [TimeParam]
fromEnum :: TimeParam -> Int
$cfromEnum :: TimeParam -> Int
toEnum :: Int -> TimeParam
$ctoEnum :: Int -> TimeParam
pred :: TimeParam -> TimeParam
$cpred :: TimeParam -> TimeParam
succ :: TimeParam -> TimeParam
$csucc :: 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
min :: TimeParam -> TimeParam -> TimeParam
$cmin :: TimeParam -> TimeParam -> TimeParam
max :: TimeParam -> TimeParam -> TimeParam
$cmax :: TimeParam -> TimeParam -> TimeParam
>= :: TimeParam -> TimeParam -> Bool
$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
compare :: TimeParam -> TimeParam -> Ordering
$ccompare :: TimeParam -> TimeParam -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> TimeParam
$cfromInteger :: Integer -> TimeParam
signum :: TimeParam -> TimeParam
$csignum :: TimeParam -> TimeParam
abs :: TimeParam -> TimeParam
$cabs :: TimeParam -> TimeParam
negate :: TimeParam -> TimeParam
$cnegate :: TimeParam -> TimeParam
* :: TimeParam -> TimeParam -> TimeParam
$c* :: TimeParam -> TimeParam -> TimeParam
- :: TimeParam -> TimeParam -> TimeParam
$c- :: TimeParam -> TimeParam -> TimeParam
+ :: TimeParam -> TimeParam -> TimeParam
$c+ :: TimeParam -> TimeParam -> 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
toRational :: TimeParam -> Rational
$ctoRational :: TimeParam -> Rational
$cp2Real :: Ord TimeParam
$cp1Real :: Num TimeParam
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
toInteger :: TimeParam -> Integer
$ctoInteger :: TimeParam -> Integer
divMod :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
$cdivMod :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
quotRem :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
$cquotRem :: TimeParam -> TimeParam -> (TimeParam, TimeParam)
mod :: TimeParam -> TimeParam -> TimeParam
$cmod :: TimeParam -> TimeParam -> TimeParam
div :: TimeParam -> TimeParam -> TimeParam
$cdiv :: TimeParam -> TimeParam -> TimeParam
rem :: TimeParam -> TimeParam -> TimeParam
$crem :: TimeParam -> TimeParam -> TimeParam
quot :: TimeParam -> TimeParam -> TimeParam
$cquot :: TimeParam -> TimeParam -> TimeParam
$cp2Integral :: Enum TimeParam
$cp1Integral :: Real TimeParam
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 -> TimeParam -> Maybe [Text]
encodeParam Network
_ (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 -> [Text] -> Maybe TimeParam
parseParam Network
_ [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
_ [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 -> XPubKey -> Maybe [Text]
encodeParam Network
net XPubKey
p = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Network -> XPubKey -> Text
xPubExport Network
net XPubKey
p]
    parseParam :: Network -> [Text] -> Maybe XPubKey
parseParam Network
net [Text
s] = Network -> Text -> Maybe XPubKey
xPubImport Network
net Text
s
    parseParam Network
_ [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 -> DeriveType -> Maybe [Text]
encodeParam Network
net DeriveType
p = do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Network -> Bool
getSegWit Network
net 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 -> [Text] -> Maybe DeriveType
parseParam Network
net [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 -> Bool
getSegWit Network
net Bool -> Bool -> Bool
|| DeriveType
res DeriveType -> DeriveType -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveType
Store.DeriveNormal)
        DeriveType -> Maybe DeriveType
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
res

newtype NoCache = NoCache
    { NoCache -> Bool
getNoCache :: Bool
    } deriving (NoCache -> NoCache -> Bool
(NoCache -> NoCache -> Bool)
-> (NoCache -> NoCache -> Bool) -> Eq NoCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoCache -> NoCache -> Bool
$c/= :: NoCache -> NoCache -> Bool
== :: NoCache -> NoCache -> Bool
$c== :: 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
showList :: [NoCache] -> ShowS
$cshowList :: [NoCache] -> ShowS
show :: NoCache -> [Char]
$cshow :: NoCache -> [Char]
showsPrec :: Int -> NoCache -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [NoCache]
$creadListPrec :: ReadPrec [NoCache]
readPrec :: ReadPrec NoCache
$creadPrec :: ReadPrec NoCache
readList :: ReadS [NoCache]
$creadList :: ReadS [NoCache]
readsPrec :: Int -> ReadS NoCache
$creadsPrec :: Int -> ReadS 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 -> NoCache -> Maybe [Text]
encodeParam Network
_ (NoCache Bool
True)  = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"true"]
    encodeParam Network
_ (NoCache Bool
False) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"false"]
    parseParam :: Network -> [Text] -> Maybe NoCache
parseParam Network
_ = \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
getNoTx :: Bool
    } deriving (NoTx -> NoTx -> Bool
(NoTx -> NoTx -> Bool) -> (NoTx -> NoTx -> Bool) -> Eq NoTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoTx -> NoTx -> Bool
$c/= :: NoTx -> NoTx -> Bool
== :: NoTx -> NoTx -> Bool
$c== :: 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
showList :: [NoTx] -> ShowS
$cshowList :: [NoTx] -> ShowS
show :: NoTx -> [Char]
$cshow :: NoTx -> [Char]
showsPrec :: Int -> NoTx -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [NoTx]
$creadListPrec :: ReadPrec [NoTx]
readPrec :: ReadPrec NoTx
$creadPrec :: ReadPrec NoTx
readList :: ReadS [NoTx]
$creadList :: ReadS [NoTx]
readsPrec :: Int -> ReadS NoTx
$creadsPrec :: Int -> ReadS 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 -> NoTx -> Maybe [Text]
encodeParam Network
_ (NoTx Bool
True)  = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"true"]
    encodeParam Network
_ (NoTx Bool
False) = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
"false"]
    parseParam :: Network -> [Text] -> Maybe NoTx
parseParam Network
_ = \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 -> BlockHash -> Maybe [Text]
encodeParam Network
_ BlockHash
b = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [BlockHash -> Text
blockHashToHex BlockHash
b]
    parseParam :: Network -> [Text] -> Maybe BlockHash
parseParam Network
_ [Text
s] = Text -> Maybe BlockHash
hexToBlockHash Text
s
    parseParam Network
_ [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 -> [BlockHash] -> Maybe [Text]
encodeParam Network
_ [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 -> [Text] -> Maybe [BlockHash]
parseParam Network
_ = (Text -> Maybe BlockHash) -> [Text] -> Maybe [BlockHash]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 -> TxHash -> Maybe [Text]
encodeParam Network
_ TxHash
t = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [TxHash -> Text
txHashToHex TxHash
t]
    parseParam :: Network -> [Text] -> Maybe TxHash
parseParam Network
_ [Text
s] = Text -> Maybe TxHash
hexToTxHash Text
s
    parseParam Network
_ [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 -> [TxHash] -> Maybe [Text]
encodeParam Network
_ [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 -> [Text] -> Maybe [TxHash]
parseParam Network
_ = (Text -> Maybe TxHash) -> [Text] -> Maybe [TxHash]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe TxHash
hexToTxHash