{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Haskoin.Store.Web (
    -- * Web
    WebConfig (..),
    Except (..),
    WebLimits (..),
    WebTimeouts (..),
    runWeb,
) where

import Conduit (
    ConduitT,
    await,
    concatMapC,
    concatMapMC,
    dropC,
    dropWhileC,
    headC,
    mapC,
    runConduit,
    sinkList,
    takeC,
    takeWhileC,
    yield,
    (.|),
 )
import Control.Applicative ((<|>))
import Control.Arrow (second)
import Control.Lens ((.~), (^.))
import Control.Monad (
    forM_,
    forever,
    join,
    unless,
    when,
    (<=<),
 )
import Control.Monad.Logger (
    MonadLoggerIO,
    logDebugS,
    logErrorS,
    logWarnS,
 )
import Control.Monad.Reader (
    ReaderT,
    asks,
    local,
    runReaderT,
 )
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Control (liftWith, restoreT)
import Control.Monad.Trans.Maybe (
    MaybeT (..),
    runMaybeT,
 )
import Data.Aeson (
    Encoding,
    ToJSON (..),
    Value,
 )
import qualified Data.Aeson as A
import Data.Aeson.Encode.Pretty (
    Config (..),
    defConfig,
    encodePretty',
 )
import Data.Aeson.Encoding (
    encodingToLazyByteString,
    list,
 )
import Data.Aeson.Text (encodeToLazyText)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import Data.ByteString.Builder (lazyByteString)
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Char (isSpace)
import Data.Default (Default (..))
import Data.Function ((&))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Int (Int64)
import Data.List (nub)
import Data.Maybe (
    catMaybes,
    fromJust,
    fromMaybe,
    isJust,
    mapMaybe,
    maybeToList,
 )
import Data.Proxy (Proxy (..))
import Data.Serialize (decode)
import Data.String (fromString)
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Text.Lazy (toStrict)
import qualified Data.Text.Lazy as TL
import Data.Time.Clock (diffUTCTime)
import Data.Time.Clock.System (
    getSystemTime,
    systemSeconds,
    systemToUTCTime,
 )
import qualified Data.Vault.Lazy as V
import Data.Word (Word32, Word64)
import Database.RocksDB (
    Property (..),
    getProperty,
 )
import Haskoin.Address
import qualified Haskoin.Block as H
import Haskoin.Constants
import Haskoin.Data
import Haskoin.Keys
import Haskoin.Network
import Haskoin.Node (
    Chain,
    OnlinePeer (..),
    PeerManager,
    chainGetAncestor,
    chainGetBest,
    getPeers,
    sendMessage,
 )
import Haskoin.Script
import Haskoin.Store.BlockStore
import Haskoin.Store.Cache
import Haskoin.Store.Common
import Haskoin.Store.Data
import Haskoin.Store.Database.Reader
import Haskoin.Store.Manager
import Haskoin.Store.Stats
import Haskoin.Store.WebCommon
import Haskoin.Transaction
import Haskoin.Util
import NQE (
    Inbox,
    Publisher,
    receive,
    withSubscription,
 )
import Network.HTTP.Types (
    Status (..),
    requestEntityTooLarge413,
    status400,
    status404,
    status409,
    status413,
    status500,
    status503,
    statusIsClientError,
    statusIsServerError,
    statusIsSuccessful,
 )
import Network.Wai (
    Middleware,
    Request (..),
    Response,
    getRequestBodyChunk,
    responseLBS,
    responseStatus,
 )
import Network.Wai.Handler.Warp (
    defaultSettings,
    setHost,
    setPort,
 )
import Network.Wai.Handler.WebSockets (websocketsOr)
import Network.Wai.Middleware.RequestSizeLimit
import Network.WebSockets (
    ServerApp,
    acceptRequest,
    defaultConnectionOptions,
    pendingRequest,
    rejectRequestWith,
    requestPath,
    sendTextData,
 )
import qualified Network.WebSockets as WebSockets
import qualified Network.Wreq as Wreq
import Network.Wreq.Session as Wreq (Session)
import qualified Network.Wreq.Session as Wreq.Session
import System.IO.Unsafe (unsafeInterleaveIO)
import qualified System.Metrics as Metrics
import qualified System.Metrics.Gauge as Metrics (Gauge)
import qualified System.Metrics.Gauge as Metrics.Gauge
import UnliftIO (
    MonadIO,
    MonadUnliftIO,
    TVar,
    askRunInIO,
    atomically,
    bracket,
    bracket_,
    handleAny,
    liftIO,
    modifyTVar,
    newTVarIO,
    readTVarIO,
    timeout,
    withAsync,
    withRunInIO,
    writeTVar,
 )
import UnliftIO.Concurrent (threadDelay)
import Web.Scotty.Internal.Types (ActionT)
import qualified Web.Scotty.Trans as S

type WebT m = ActionT Except (ReaderT WebState m)

data WebLimits = WebLimits
    { WebLimits -> Word32
maxLimitCount :: !Word32
    , WebLimits -> Word32
maxLimitFull :: !Word32
    , WebLimits -> Word32
maxLimitOffset :: !Word32
    , WebLimits -> Word32
maxLimitDefault :: !Word32
    , WebLimits -> Word32
maxLimitGap :: !Word32
    , WebLimits -> Word32
maxLimitInitialGap :: !Word32
    , WebLimits -> Word32
maxLimitBody :: !Word32
    }
    deriving (WebLimits -> WebLimits -> Bool
(WebLimits -> WebLimits -> Bool)
-> (WebLimits -> WebLimits -> Bool) -> Eq WebLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebLimits -> WebLimits -> Bool
$c/= :: WebLimits -> WebLimits -> Bool
== :: WebLimits -> WebLimits -> Bool
$c== :: WebLimits -> WebLimits -> Bool
Eq, Int -> WebLimits -> ShowS
[WebLimits] -> ShowS
WebLimits -> String
(Int -> WebLimits -> ShowS)
-> (WebLimits -> String)
-> ([WebLimits] -> ShowS)
-> Show WebLimits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebLimits] -> ShowS
$cshowList :: [WebLimits] -> ShowS
show :: WebLimits -> String
$cshow :: WebLimits -> String
showsPrec :: Int -> WebLimits -> ShowS
$cshowsPrec :: Int -> WebLimits -> ShowS
Show)

instance Default WebLimits where
    def :: WebLimits
def =
        WebLimits :: Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> WebLimits
WebLimits
            { maxLimitCount :: Word32
maxLimitCount = Word32
200000
            , maxLimitFull :: Word32
maxLimitFull = Word32
5000
            , maxLimitOffset :: Word32
maxLimitOffset = Word32
50000
            , maxLimitDefault :: Word32
maxLimitDefault = Word32
100
            , maxLimitGap :: Word32
maxLimitGap = Word32
32
            , maxLimitInitialGap :: Word32
maxLimitInitialGap = Word32
20
            , maxLimitBody :: Word32
maxLimitBody = Word32
1024 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024
            }

data WebConfig = WebConfig
    { WebConfig -> String
webHost :: !String
    , WebConfig -> Int
webPort :: !Int
    , WebConfig -> Store
webStore :: !Store
    , WebConfig -> Int
webMaxDiff :: !Int
    , WebConfig -> Int
webMaxPending :: !Int
    , WebConfig -> WebLimits
webMaxLimits :: !WebLimits
    , WebConfig -> WebTimeouts
webTimeouts :: !WebTimeouts
    , WebConfig -> String
webVersion :: !String
    , WebConfig -> Bool
webNoMempool :: !Bool
    , WebConfig -> Maybe Store
webStats :: !(Maybe Metrics.Store)
    , WebConfig -> Int
webPriceGet :: !Int
    , WebConfig -> String
webTickerURL :: !String
    , WebConfig -> String
webHistoryURL :: !String
    }

data WebState = WebState
    { WebState -> WebConfig
webConfig :: !WebConfig
    , WebState -> TVar (HashMap Text BinfoTicker)
webTicker :: !(TVar (HashMap Text BinfoTicker))
    , WebState -> Maybe WebMetrics
webMetrics :: !(Maybe WebMetrics)
    , WebState -> Session
webWreqSession :: !Wreq.Session
    }

data WebMetrics = WebMetrics
    { WebMetrics -> StatDist
statAll :: !StatDist
    , -- Addresses
      WebMetrics -> StatDist
statAddressTransactions :: !StatDist
    , WebMetrics -> StatDist
statAddressTransactionsFull :: !StatDist
    , WebMetrics -> StatDist
statAddressBalance :: !StatDist
    , WebMetrics -> StatDist
statAddressUnspent :: !StatDist
    , WebMetrics -> StatDist
statXpub :: !StatDist
    , WebMetrics -> StatDist
statXpubDelete :: !StatDist
    , WebMetrics -> StatDist
statXpubTransactionsFull :: !StatDist
    , WebMetrics -> StatDist
statXpubTransactions :: !StatDist
    , WebMetrics -> StatDist
statXpubBalances :: !StatDist
    , WebMetrics -> StatDist
statXpubUnspent :: !StatDist
    , -- Transactions
      WebMetrics -> StatDist
statTransaction :: !StatDist
    , WebMetrics -> StatDist
statTransactionRaw :: !StatDist
    , WebMetrics -> StatDist
statTransactionAfter :: !StatDist
    , WebMetrics -> StatDist
statTransactionsBlock :: !StatDist
    , WebMetrics -> StatDist
statTransactionsBlockRaw :: !StatDist
    , WebMetrics -> StatDist
statTransactionPost :: !StatDist
    , WebMetrics -> StatDist
statMempool :: !StatDist
    , -- Blocks
      WebMetrics -> StatDist
statBlock :: !StatDist
    , WebMetrics -> StatDist
statBlockRaw :: !StatDist
    , -- Blockchain
      WebMetrics -> StatDist
statBlockchainMultiaddr :: !StatDist
    , WebMetrics -> StatDist
statBlockchainBalance :: !StatDist
    , WebMetrics -> StatDist
statBlockchainRawaddr :: !StatDist
    , WebMetrics -> StatDist
statBlockchainUnspent :: !StatDist
    , WebMetrics -> StatDist
statBlockchainRawtx :: !StatDist
    , WebMetrics -> StatDist
statBlockchainRawblock :: !StatDist
    , WebMetrics -> StatDist
statBlockchainMempool :: !StatDist
    , WebMetrics -> StatDist
statBlockchainBlockHeight :: !StatDist
    , WebMetrics -> StatDist
statBlockchainBlocks :: !StatDist
    , WebMetrics -> StatDist
statBlockchainLatestblock :: !StatDist
    , WebMetrics -> StatDist
statBlockchainExportHistory :: !StatDist
    , -- Blockchain /q endpoints
      WebMetrics -> StatDist
statBlockchainQaddresstohash :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQhashtoaddress :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQaddrpubkey :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQpubkeyaddr :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQhashpubkey :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQgetblockcount :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQlatesthash :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQbcperblock :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQtxtotalbtcoutput :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQtxtotalbtcinput :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQtxfee :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQtxresult :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQgetreceivedbyaddress :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQgetsentbyaddress :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQaddressbalance :: !StatDist
    , WebMetrics -> StatDist
statBlockchainQaddressfirstseen :: !StatDist
    , -- Others
      WebMetrics -> StatDist
statHealth :: !StatDist
    , WebMetrics -> StatDist
statPeers :: !StatDist
    , WebMetrics -> StatDist
statDbstats :: !StatDist
    , WebMetrics -> Gauge
statEvents :: !Metrics.Gauge.Gauge
    , -- Request
      WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey :: !(V.Key (TVar (Maybe (WebMetrics -> StatDist))))
    }

createMetrics :: MonadIO m => Metrics.Store -> m WebMetrics
createMetrics :: Store -> m WebMetrics
createMetrics Store
s = IO WebMetrics -> m WebMetrics
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WebMetrics -> m WebMetrics) -> IO WebMetrics -> m WebMetrics
forall a b. (a -> b) -> a -> b
$ do
    StatDist
statAll <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"all"

    -- Addresses
    StatDist
statAddressTransactions <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"address_transactions"
    StatDist
statAddressTransactionsFull <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"address_transactions_full"
    StatDist
statAddressBalance <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"address_balance"
    StatDist
statAddressUnspent <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"address_unspent"
    StatDist
statXpub <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"xpub"
    StatDist
statXpubDelete <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"xpub_delete"
    StatDist
statXpubTransactionsFull <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"xpub_transactions_full"
    StatDist
statXpubTransactions <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"xpub_transactions"
    StatDist
statXpubBalances <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"xpub_balances"
    StatDist
statXpubUnspent <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"xpub_unspent"

    -- Transactions
    StatDist
statTransaction <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"transaction"
    StatDist
statTransactionRaw <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"transaction_raw"
    StatDist
statTransactionAfter <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"transaction_after"
    StatDist
statTransactionPost <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"transaction_post"
    StatDist
statTransactionsBlock <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"transactions_block"
    StatDist
statTransactionsBlockRaw <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"transactions_block_raw"
    StatDist
statMempool <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"mempool"

    -- Blocks
    StatDist
statBlockBest <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_best"
    StatDist
statBlockLatest <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_latest"
    StatDist
statBlock <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block"
    StatDist
statBlockRaw <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_raw"
    StatDist
statBlockHeight <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_height"
    StatDist
statBlockHeightRaw <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_height_raw"
    StatDist
statBlockTime <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_time"
    StatDist
statBlockTimeRaw <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_time_raw"
    StatDist
statBlockMtp <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_mtp"
    StatDist
statBlockMtpRaw <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"block_mtp_raw"

    -- Blockchain
    StatDist
statBlockchainMultiaddr <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_multiaddr"
    StatDist
statBlockchainBalance <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_balance"
    StatDist
statBlockchainRawaddr <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_rawaddr"
    StatDist
statBlockchainUnspent <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_unspent"
    StatDist
statBlockchainRawtx <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_rawtx"
    StatDist
statBlockchainRawblock <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_rawblock"
    StatDist
statBlockchainLatestblock <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_latestblock"
    StatDist
statBlockchainMempool <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_mempool"
    StatDist
statBlockchainBlockHeight <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_block_height"
    StatDist
statBlockchainBlocks <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_blocks"
    StatDist
statBlockchainExportHistory <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_export_history"

    -- Blockchain /q endpoints
    StatDist
statBlockchainQaddresstohash <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_addresstohash"
    StatDist
statBlockchainQhashtoaddress <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_hashtoaddress"
    StatDist
statBlockchainQaddrpubkey <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockckhain_q_addrpubkey"
    StatDist
statBlockchainQpubkeyaddr <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_pubkeyaddr"
    StatDist
statBlockchainQhashpubkey <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_hashpubkey"
    StatDist
statBlockchainQgetblockcount <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_getblockcount"
    StatDist
statBlockchainQlatesthash <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_latesthash"
    StatDist
statBlockchainQbcperblock <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_bcperblock"
    StatDist
statBlockchainQtxtotalbtcoutput <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txtotalbtcoutput"
    StatDist
statBlockchainQtxtotalbtcinput <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txtotalbtcinput"
    StatDist
statBlockchainQtxfee <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txfee"
    StatDist
statBlockchainQtxresult <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txresult"
    StatDist
statBlockchainQgetreceivedbyaddress <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_getreceivedbyaddress"
    StatDist
statBlockchainQgetsentbyaddress <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_getsentbyaddress"
    StatDist
statBlockchainQaddressbalance <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_addressbalance"
    StatDist
statBlockchainQaddressfirstseen <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"blockchain_q_addressfirstseen"

    -- Others
    StatDist
statHealth <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"health"
    StatDist
statPeers <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"peers"
    StatDist
statDbstats <- Text -> IO StatDist
forall (m :: * -> *). MonadIO m => Text -> m StatDist
d Text
"dbstats"

    Gauge
statEvents <- Text -> IO Gauge
g Text
"events_connected"
    Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey <- IO (Key (TVar (Maybe (WebMetrics -> StatDist))))
forall a. IO (Key a)
V.newKey
    WebMetrics -> IO WebMetrics
forall (m :: * -> *) a. Monad m => a -> m a
return WebMetrics :: StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> StatDist
-> Gauge
-> Key (TVar (Maybe (WebMetrics -> StatDist)))
-> WebMetrics
WebMetrics{Gauge
Key (TVar (Maybe (WebMetrics -> StatDist)))
StatDist
statKey :: Key (TVar (Maybe (WebMetrics -> StatDist)))
statEvents :: Gauge
statDbstats :: StatDist
statPeers :: StatDist
statHealth :: StatDist
statBlockchainQaddressfirstseen :: StatDist
statBlockchainQaddressbalance :: StatDist
statBlockchainQgetsentbyaddress :: StatDist
statBlockchainQgetreceivedbyaddress :: StatDist
statBlockchainQtxresult :: StatDist
statBlockchainQtxfee :: StatDist
statBlockchainQtxtotalbtcinput :: StatDist
statBlockchainQtxtotalbtcoutput :: StatDist
statBlockchainQbcperblock :: StatDist
statBlockchainQlatesthash :: StatDist
statBlockchainQgetblockcount :: StatDist
statBlockchainQhashpubkey :: StatDist
statBlockchainQpubkeyaddr :: StatDist
statBlockchainQaddrpubkey :: StatDist
statBlockchainQhashtoaddress :: StatDist
statBlockchainQaddresstohash :: StatDist
statBlockchainExportHistory :: StatDist
statBlockchainBlocks :: StatDist
statBlockchainBlockHeight :: StatDist
statBlockchainMempool :: StatDist
statBlockchainLatestblock :: StatDist
statBlockchainRawblock :: StatDist
statBlockchainRawtx :: StatDist
statBlockchainUnspent :: StatDist
statBlockchainRawaddr :: StatDist
statBlockchainBalance :: StatDist
statBlockchainMultiaddr :: StatDist
statBlockRaw :: StatDist
statBlock :: StatDist
statMempool :: StatDist
statTransactionsBlockRaw :: StatDist
statTransactionsBlock :: StatDist
statTransactionPost :: StatDist
statTransactionAfter :: StatDist
statTransactionRaw :: StatDist
statTransaction :: StatDist
statXpubUnspent :: StatDist
statXpubBalances :: StatDist
statXpubTransactions :: StatDist
statXpubTransactionsFull :: StatDist
statXpubDelete :: StatDist
statXpub :: StatDist
statAddressUnspent :: StatDist
statAddressBalance :: StatDist
statAddressTransactionsFull :: StatDist
statAddressTransactions :: StatDist
statAll :: StatDist
statKey :: Key (TVar (Maybe (WebMetrics -> StatDist)))
statEvents :: Gauge
statDbstats :: StatDist
statPeers :: StatDist
statHealth :: StatDist
statBlockchainQaddressfirstseen :: StatDist
statBlockchainQaddressbalance :: StatDist
statBlockchainQgetsentbyaddress :: StatDist
statBlockchainQgetreceivedbyaddress :: StatDist
statBlockchainQtxresult :: StatDist
statBlockchainQtxfee :: StatDist
statBlockchainQtxtotalbtcinput :: StatDist
statBlockchainQtxtotalbtcoutput :: StatDist
statBlockchainQbcperblock :: StatDist
statBlockchainQlatesthash :: StatDist
statBlockchainQgetblockcount :: StatDist
statBlockchainQhashpubkey :: StatDist
statBlockchainQpubkeyaddr :: StatDist
statBlockchainQaddrpubkey :: StatDist
statBlockchainQhashtoaddress :: StatDist
statBlockchainQaddresstohash :: StatDist
statBlockchainExportHistory :: StatDist
statBlockchainLatestblock :: StatDist
statBlockchainBlocks :: StatDist
statBlockchainBlockHeight :: StatDist
statBlockchainMempool :: StatDist
statBlockchainRawblock :: StatDist
statBlockchainRawtx :: StatDist
statBlockchainUnspent :: StatDist
statBlockchainRawaddr :: StatDist
statBlockchainBalance :: StatDist
statBlockchainMultiaddr :: StatDist
statBlockRaw :: StatDist
statBlock :: StatDist
statMempool :: StatDist
statTransactionPost :: StatDist
statTransactionsBlockRaw :: StatDist
statTransactionsBlock :: StatDist
statTransactionAfter :: StatDist
statTransactionRaw :: StatDist
statTransaction :: StatDist
statXpubUnspent :: StatDist
statXpubBalances :: StatDist
statXpubTransactions :: StatDist
statXpubTransactionsFull :: StatDist
statXpubDelete :: StatDist
statXpub :: StatDist
statAddressUnspent :: StatDist
statAddressBalance :: StatDist
statAddressTransactionsFull :: StatDist
statAddressTransactions :: StatDist
statAll :: StatDist
..}
  where
    d :: Text -> m StatDist
d Text
x = Text -> Store -> m StatDist
forall (m :: * -> *). MonadIO m => Text -> Store -> m StatDist
createStatDist (Text
"web." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) Store
s
    g :: Text -> IO Gauge
g Text
x = Text -> Store -> IO Gauge
Metrics.createGauge (Text
"web." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) Store
s

withGaugeIO :: MonadUnliftIO m => Metrics.Gauge -> m a -> m a
withGaugeIO :: Gauge -> m a -> m a
withGaugeIO Gauge
g =
    m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_
        (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
Metrics.Gauge.inc Gauge
g)
        (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
Metrics.Gauge.dec Gauge
g)

withGaugeIncrease ::
    MonadUnliftIO m =>
    (WebMetrics -> Metrics.Gauge) ->
    WebT m a ->
    WebT m a
withGaugeIncrease :: (WebMetrics -> Gauge) -> WebT m a -> WebT m a
withGaugeIncrease WebMetrics -> Gauge
gf WebT m a
go =
    ReaderT WebState m (Maybe WebMetrics)
-> ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Maybe WebMetrics)
-> ReaderT WebState m (Maybe WebMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics) ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> WebT m a) -> WebT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe WebMetrics
Nothing -> WebT m a
go
        Just WebMetrics
m -> do
            (Either (ActionError Except) a, ScottyResponse)
s <- (Run (ActionT Except)
 -> ReaderT
      WebState m (Either (ActionError Except) a, ScottyResponse))
-> ActionT
     Except
     (ReaderT WebState m)
     (Either (ActionError Except) a, ScottyResponse)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (ActionT Except)
  -> ReaderT
       WebState m (Either (ActionError Except) a, ScottyResponse))
 -> ActionT
      Except
      (ReaderT WebState m)
      (Either (ActionError Except) a, ScottyResponse))
-> (Run (ActionT Except)
    -> ReaderT
         WebState m (Either (ActionError Except) a, ScottyResponse))
-> ActionT
     Except
     (ReaderT WebState m)
     (Either (ActionError Except) a, ScottyResponse)
forall a b. (a -> b) -> a -> b
$ \Run (ActionT Except)
run -> Gauge
-> ReaderT
     WebState m (Either (ActionError Except) a, ScottyResponse)
-> ReaderT
     WebState m (Either (ActionError Except) a, ScottyResponse)
forall (m :: * -> *) a. MonadUnliftIO m => Gauge -> m a -> m a
withGaugeIO (WebMetrics -> Gauge
gf WebMetrics
m) (WebT m a -> ReaderT WebState m (StT (ActionT Except) a)
Run (ActionT Except)
run WebT m a
go)
            ReaderT WebState m (StT (ActionT Except) a) -> WebT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (ReaderT WebState m (StT (ActionT Except) a) -> WebT m a)
-> ReaderT WebState m (StT (ActionT Except) a) -> WebT m a
forall a b. (a -> b) -> a -> b
$ (Either (ActionError Except) a, ScottyResponse)
-> ReaderT
     WebState m (Either (ActionError Except) a, ScottyResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ActionError Except) a, ScottyResponse)
s

setMetrics :: MonadUnliftIO m => (WebMetrics -> StatDist) -> WebT m ()
setMetrics :: (WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
df =
    (WebState -> Maybe WebMetrics)
-> ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WebMetrics -> WebT m ()) -> Maybe WebMetrics -> WebT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ WebMetrics -> WebT m ()
forall (m :: * -> *) e.
(ScottyError e, MonadIO m) =>
WebMetrics -> ActionT e m ()
go
  where
    go :: WebMetrics -> ActionT e m ()
go WebMetrics
m = do
        Request
req <- ActionT e m Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
S.request
        let t :: TVar (Maybe (WebMetrics -> StatDist))
t = TVar (Maybe (WebMetrics -> StatDist))
-> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
-> TVar (Maybe (WebMetrics -> StatDist))
forall a. a -> Maybe a -> a
fromMaybe TVar (Maybe (WebMetrics -> StatDist))
forall a. a
e (Maybe (TVar (Maybe (WebMetrics -> StatDist)))
 -> TVar (Maybe (WebMetrics -> StatDist)))
-> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
-> TVar (Maybe (WebMetrics -> StatDist))
forall a b. (a -> b) -> a -> b
$ Key (TVar (Maybe (WebMetrics -> StatDist)))
-> Vault -> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
forall a. Key a -> Vault -> Maybe a
V.lookup (WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey WebMetrics
m) (Request -> Vault
vault Request
req)
        STM () -> ActionT e m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ActionT e m ()) -> STM () -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (WebMetrics -> StatDist))
-> Maybe (WebMetrics -> StatDist) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (WebMetrics -> StatDist))
t ((WebMetrics -> StatDist) -> Maybe (WebMetrics -> StatDist)
forall a. a -> Maybe a
Just WebMetrics -> StatDist
df)
    e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"the ways of the warrior are yet to be mastered"

addItemCount :: MonadUnliftIO m => Int -> WebT m ()
addItemCount :: Int -> WebT m ()
addItemCount Int
i =
    (WebState -> Maybe WebMetrics)
-> ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WebMetrics -> WebT m ()) -> Maybe WebMetrics -> WebT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \WebMetrics
m ->
        StatDist -> Int64 -> WebT m ()
forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatItems (WebMetrics -> StatDist
statAll WebMetrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
            WebT m ()
-> ActionT Except (ReaderT WebState m) Request
-> ActionT Except (ReaderT WebState m) Request
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActionT Except (ReaderT WebState m) Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
S.request ActionT Except (ReaderT WebState m) Request
-> (Request -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Request
req ->
                Maybe (TVar (Maybe (WebMetrics -> StatDist)))
-> (TVar (Maybe (WebMetrics -> StatDist)) -> WebT m ())
-> WebT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Key (TVar (Maybe (WebMetrics -> StatDist)))
-> Vault -> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
forall a. Key a -> Vault -> Maybe a
V.lookup (WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey WebMetrics
m) (Request -> Vault
vault Request
req)) \TVar (Maybe (WebMetrics -> StatDist))
t ->
                    TVar (Maybe (WebMetrics -> StatDist))
-> ActionT
     Except (ReaderT WebState m) (Maybe (WebMetrics -> StatDist))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (WebMetrics -> StatDist))
t ActionT
  Except (ReaderT WebState m) (Maybe (WebMetrics -> StatDist))
-> (Maybe (WebMetrics -> StatDist) -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((WebMetrics -> StatDist) -> WebT m ())
-> Maybe (WebMetrics -> StatDist) -> WebT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \WebMetrics -> StatDist
s ->
                        StatDist -> Int64 -> WebT m ()
forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatItems (WebMetrics -> StatDist
s WebMetrics
m) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

data WebTimeouts = WebTimeouts
    { WebTimeouts -> Word64
txTimeout :: !Word64
    , WebTimeouts -> Word64
blockTimeout :: !Word64
    }
    deriving (WebTimeouts -> WebTimeouts -> Bool
(WebTimeouts -> WebTimeouts -> Bool)
-> (WebTimeouts -> WebTimeouts -> Bool) -> Eq WebTimeouts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebTimeouts -> WebTimeouts -> Bool
$c/= :: WebTimeouts -> WebTimeouts -> Bool
== :: WebTimeouts -> WebTimeouts -> Bool
$c== :: WebTimeouts -> WebTimeouts -> Bool
Eq, Int -> WebTimeouts -> ShowS
[WebTimeouts] -> ShowS
WebTimeouts -> String
(Int -> WebTimeouts -> ShowS)
-> (WebTimeouts -> String)
-> ([WebTimeouts] -> ShowS)
-> Show WebTimeouts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebTimeouts] -> ShowS
$cshowList :: [WebTimeouts] -> ShowS
show :: WebTimeouts -> String
$cshow :: WebTimeouts -> String
showsPrec :: Int -> WebTimeouts -> ShowS
$cshowsPrec :: Int -> WebTimeouts -> ShowS
Show)

data SerialAs = SerialAsBinary | SerialAsJSON | SerialAsPrettyJSON
    deriving (SerialAs -> SerialAs -> Bool
(SerialAs -> SerialAs -> Bool)
-> (SerialAs -> SerialAs -> Bool) -> Eq SerialAs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SerialAs -> SerialAs -> Bool
$c/= :: SerialAs -> SerialAs -> Bool
== :: SerialAs -> SerialAs -> Bool
$c== :: SerialAs -> SerialAs -> Bool
Eq, Int -> SerialAs -> ShowS
[SerialAs] -> ShowS
SerialAs -> String
(Int -> SerialAs -> ShowS)
-> (SerialAs -> String) -> ([SerialAs] -> ShowS) -> Show SerialAs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerialAs] -> ShowS
$cshowList :: [SerialAs] -> ShowS
show :: SerialAs -> String
$cshow :: SerialAs -> String
showsPrec :: Int -> SerialAs -> ShowS
$cshowsPrec :: Int -> SerialAs -> ShowS
Show)

instance Default WebTimeouts where
    def :: WebTimeouts
def = WebTimeouts :: Word64 -> Word64 -> WebTimeouts
WebTimeouts{txTimeout :: Word64
txTimeout = Word64
300, blockTimeout :: Word64
blockTimeout = Word64
7200}

instance
    (MonadUnliftIO m, MonadLoggerIO m) =>
    StoreReadBase (ReaderT WebState m)
    where
    getNetwork :: ReaderT WebState m Network
getNetwork = CacheT (DatabaseReaderT m) Network -> ReaderT WebState m Network
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader CacheT (DatabaseReaderT m) Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
    getBestBlock :: ReaderT WebState m (Maybe BlockHash)
getBestBlock = CacheT (DatabaseReaderT m) (Maybe BlockHash)
-> ReaderT WebState m (Maybe BlockHash)
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader CacheT (DatabaseReaderT m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
    getBlocksAtHeight :: Word32 -> ReaderT WebState m [BlockHash]
getBlocksAtHeight Word32
height = CacheT (DatabaseReaderT m) [BlockHash]
-> ReaderT WebState m [BlockHash]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (Word32 -> CacheT (DatabaseReaderT m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
height)
    getBlock :: BlockHash -> ReaderT WebState m (Maybe BlockData)
getBlock BlockHash
bh = CacheT (DatabaseReaderT m) (Maybe BlockData)
-> ReaderT WebState m (Maybe BlockData)
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (BlockHash -> CacheT (DatabaseReaderT m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh)
    getTxData :: TxHash -> ReaderT WebState m (Maybe TxData)
getTxData TxHash
th = CacheT (DatabaseReaderT m) (Maybe TxData)
-> ReaderT WebState m (Maybe TxData)
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (TxHash -> CacheT (DatabaseReaderT m) (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th)
    getSpender :: OutPoint -> ReaderT WebState m (Maybe Spender)
getSpender OutPoint
op = CacheT (DatabaseReaderT m) (Maybe Spender)
-> ReaderT WebState m (Maybe Spender)
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (OutPoint -> CacheT (DatabaseReaderT m) (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender OutPoint
op)
    getUnspent :: OutPoint -> ReaderT WebState m (Maybe Unspent)
getUnspent OutPoint
op = CacheT (DatabaseReaderT m) (Maybe Unspent)
-> ReaderT WebState m (Maybe Unspent)
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (OutPoint -> CacheT (DatabaseReaderT m) (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op)
    getBalance :: Address -> ReaderT WebState m (Maybe Balance)
getBalance Address
a = CacheT (DatabaseReaderT m) (Maybe Balance)
-> ReaderT WebState m (Maybe Balance)
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (Address -> CacheT (DatabaseReaderT m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a)
    getMempool :: ReaderT WebState m [(Word64, TxHash)]
getMempool = CacheT (DatabaseReaderT m) [(Word64, TxHash)]
-> ReaderT WebState m [(Word64, TxHash)]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader CacheT (DatabaseReaderT m) [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool

instance
    (MonadUnliftIO m, MonadLoggerIO m) =>
    StoreReadExtra (ReaderT WebState m)
    where
    getMaxGap :: ReaderT WebState m Word32
getMaxGap = CacheT (DatabaseReaderT m) Word32 -> ReaderT WebState m Word32
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader CacheT (DatabaseReaderT m) Word32
forall (m :: * -> *). StoreReadExtra m => m Word32
getMaxGap
    getInitialGap :: ReaderT WebState m Word32
getInitialGap = CacheT (DatabaseReaderT m) Word32 -> ReaderT WebState m Word32
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader CacheT (DatabaseReaderT m) Word32
forall (m :: * -> *). StoreReadExtra m => m Word32
getInitialGap
    getBalances :: [Address] -> ReaderT WebState m [Balance]
getBalances [Address]
as = CacheT (DatabaseReaderT m) [Balance]
-> ReaderT WebState m [Balance]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader ([Address] -> CacheT (DatabaseReaderT m) [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances [Address]
as)
    getAddressesTxs :: [Address] -> Limits -> ReaderT WebState m [TxRef]
getAddressesTxs [Address]
as = CacheT (DatabaseReaderT m) [TxRef] -> ReaderT WebState m [TxRef]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [TxRef] -> ReaderT WebState m [TxRef])
-> (Limits -> CacheT (DatabaseReaderT m) [TxRef])
-> Limits
-> ReaderT WebState m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> Limits -> CacheT (DatabaseReaderT m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
as
    getAddressTxs :: Address -> Limits -> ReaderT WebState m [TxRef]
getAddressTxs Address
a = CacheT (DatabaseReaderT m) [TxRef] -> ReaderT WebState m [TxRef]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [TxRef] -> ReaderT WebState m [TxRef])
-> (Limits -> CacheT (DatabaseReaderT m) [TxRef])
-> Limits
-> ReaderT WebState m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Limits -> CacheT (DatabaseReaderT m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a
    getAddressUnspents :: Address -> Limits -> ReaderT WebState m [Unspent]
getAddressUnspents Address
a = CacheT (DatabaseReaderT m) [Unspent]
-> ReaderT WebState m [Unspent]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [Unspent]
 -> ReaderT WebState m [Unspent])
-> (Limits -> CacheT (DatabaseReaderT m) [Unspent])
-> Limits
-> ReaderT WebState m [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Limits -> CacheT (DatabaseReaderT m) [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
a
    getAddressesUnspents :: [Address] -> Limits -> ReaderT WebState m [Unspent]
getAddressesUnspents [Address]
as = CacheT (DatabaseReaderT m) [Unspent]
-> ReaderT WebState m [Unspent]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [Unspent]
 -> ReaderT WebState m [Unspent])
-> (Limits -> CacheT (DatabaseReaderT m) [Unspent])
-> Limits
-> ReaderT WebState m [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> Limits -> CacheT (DatabaseReaderT m) [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
as
    xPubBals :: XPubSpec -> ReaderT WebState m [XPubBal]
xPubBals = CacheT (DatabaseReaderT m) [XPubBal]
-> ReaderT WebState m [XPubBal]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [XPubBal]
 -> ReaderT WebState m [XPubBal])
-> (XPubSpec -> CacheT (DatabaseReaderT m) [XPubBal])
-> XPubSpec
-> ReaderT WebState m [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> CacheT (DatabaseReaderT m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals
    xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals = CacheT (DatabaseReaderT m) [XPubUnspent]
-> ReaderT WebState m [XPubUnspent]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [XPubUnspent]
 -> ReaderT WebState m [XPubUnspent])
-> (Limits -> CacheT (DatabaseReaderT m) [XPubUnspent])
-> Limits
-> ReaderT WebState m [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec
-> [XPubBal] -> Limits -> CacheT (DatabaseReaderT m) [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals
    xPubTxs :: XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals = CacheT (DatabaseReaderT m) [TxRef] -> ReaderT WebState m [TxRef]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [TxRef] -> ReaderT WebState m [TxRef])
-> (Limits -> CacheT (DatabaseReaderT m) [TxRef])
-> Limits
-> ReaderT WebState m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec
-> [XPubBal] -> Limits -> CacheT (DatabaseReaderT m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals
    xPubTxCount :: XPubSpec -> [XPubBal] -> ReaderT WebState m Word32
xPubTxCount XPubSpec
xpub = CacheT (DatabaseReaderT m) Word32 -> ReaderT WebState m Word32
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) Word32 -> ReaderT WebState m Word32)
-> ([XPubBal] -> CacheT (DatabaseReaderT m) Word32)
-> [XPubBal]
-> ReaderT WebState m Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> [XPubBal] -> CacheT (DatabaseReaderT m) Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xpub
    getNumTxData :: Word64 -> ReaderT WebState m [TxData]
getNumTxData = CacheT (DatabaseReaderT m) [TxData] -> ReaderT WebState m [TxData]
forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (CacheT (DatabaseReaderT m) [TxData]
 -> ReaderT WebState m [TxData])
-> (Word64 -> CacheT (DatabaseReaderT m) [TxData])
-> Word64
-> ReaderT WebState m [TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CacheT (DatabaseReaderT m) [TxData]
forall (m :: * -> *). StoreReadExtra m => Word64 -> m [TxData]
getNumTxData

instance (MonadUnliftIO m, MonadLoggerIO m) => StoreReadBase (WebT m) where
    getNetwork :: WebT m Network
getNetwork = ReaderT WebState m Network -> WebT m Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT WebState m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
    getBestBlock :: WebT m (Maybe BlockHash)
getBestBlock = ReaderT WebState m (Maybe BlockHash) -> WebT m (Maybe BlockHash)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT WebState m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
    getBlocksAtHeight :: Word32 -> WebT m [BlockHash]
getBlocksAtHeight = ReaderT WebState m [BlockHash] -> WebT m [BlockHash]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BlockHash] -> WebT m [BlockHash])
-> (Word32 -> ReaderT WebState m [BlockHash])
-> Word32
-> WebT m [BlockHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ReaderT WebState m [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight
    getBlock :: BlockHash -> WebT m (Maybe BlockData)
getBlock = ReaderT WebState m (Maybe BlockData) -> WebT m (Maybe BlockData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe BlockData) -> WebT m (Maybe BlockData))
-> (BlockHash -> ReaderT WebState m (Maybe BlockData))
-> BlockHash
-> WebT m (Maybe BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> ReaderT WebState m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
    getTxData :: TxHash -> WebT m (Maybe TxData)
getTxData = ReaderT WebState m (Maybe TxData) -> WebT m (Maybe TxData)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe TxData) -> WebT m (Maybe TxData))
-> (TxHash -> ReaderT WebState m (Maybe TxData))
-> TxHash
-> WebT m (Maybe TxData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> ReaderT WebState m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData
    getSpender :: OutPoint -> WebT m (Maybe Spender)
getSpender = ReaderT WebState m (Maybe Spender) -> WebT m (Maybe Spender)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe Spender) -> WebT m (Maybe Spender))
-> (OutPoint -> ReaderT WebState m (Maybe Spender))
-> OutPoint
-> WebT m (Maybe Spender)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> ReaderT WebState m (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender
    getUnspent :: OutPoint -> WebT m (Maybe Unspent)
getUnspent = ReaderT WebState m (Maybe Unspent) -> WebT m (Maybe Unspent)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe Unspent) -> WebT m (Maybe Unspent))
-> (OutPoint -> ReaderT WebState m (Maybe Unspent))
-> OutPoint
-> WebT m (Maybe Unspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutPoint -> ReaderT WebState m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent
    getBalance :: Address -> WebT m (Maybe Balance)
getBalance = ReaderT WebState m (Maybe Balance) -> WebT m (Maybe Balance)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe Balance) -> WebT m (Maybe Balance))
-> (Address -> ReaderT WebState m (Maybe Balance))
-> Address
-> WebT m (Maybe Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> ReaderT WebState m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance
    getMempool :: WebT m [(Word64, TxHash)]
getMempool = ReaderT WebState m [(Word64, TxHash)] -> WebT m [(Word64, TxHash)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT WebState m [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool

instance (MonadUnliftIO m, MonadLoggerIO m) => StoreReadExtra (WebT m) where
    getBalances :: [Address] -> WebT m [Balance]
getBalances = ReaderT WebState m [Balance] -> WebT m [Balance]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Balance] -> WebT m [Balance])
-> ([Address] -> ReaderT WebState m [Balance])
-> [Address]
-> WebT m [Balance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> ReaderT WebState m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances
    getAddressesTxs :: [Address] -> Limits -> WebT m [TxRef]
getAddressesTxs [Address]
as = ReaderT WebState m [TxRef] -> WebT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> WebT m [TxRef])
-> (Limits -> ReaderT WebState m [TxRef])
-> Limits
-> WebT m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> Limits -> ReaderT WebState m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
as
    getAddressTxs :: Address -> Limits -> WebT m [TxRef]
getAddressTxs Address
a = ReaderT WebState m [TxRef] -> WebT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> WebT m [TxRef])
-> (Limits -> ReaderT WebState m [TxRef])
-> Limits
-> WebT m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Limits -> ReaderT WebState m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a
    getAddressUnspents :: Address -> Limits -> WebT m [Unspent]
getAddressUnspents Address
a = ReaderT WebState m [Unspent] -> WebT m [Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Unspent] -> WebT m [Unspent])
-> (Limits -> ReaderT WebState m [Unspent])
-> Limits
-> WebT m [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Limits -> ReaderT WebState m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
a
    getAddressesUnspents :: [Address] -> Limits -> WebT m [Unspent]
getAddressesUnspents [Address]
as = ReaderT WebState m [Unspent] -> WebT m [Unspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Unspent] -> WebT m [Unspent])
-> (Limits -> ReaderT WebState m [Unspent])
-> Limits
-> WebT m [Unspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> Limits -> ReaderT WebState m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
as
    xPubBals :: XPubSpec -> WebT m [XPubBal]
xPubBals = ReaderT WebState m [XPubBal] -> WebT m [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubBal] -> WebT m [XPubBal])
-> (XPubSpec -> ReaderT WebState m [XPubBal])
-> XPubSpec
-> WebT m [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> ReaderT WebState m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals
    xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> WebT m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals = ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent])
-> (Limits -> ReaderT WebState m [XPubUnspent])
-> Limits
-> WebT m [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals
    xPubTxs :: XPubSpec -> [XPubBal] -> Limits -> WebT m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals = ReaderT WebState m [TxRef] -> WebT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> WebT m [TxRef])
-> (Limits -> ReaderT WebState m [TxRef])
-> Limits
-> WebT m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals
    xPubTxCount :: XPubSpec -> [XPubBal] -> WebT m Word32
xPubTxCount XPubSpec
xpub = ReaderT WebState m Word32 -> WebT m Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Word32 -> WebT m Word32)
-> ([XPubBal] -> ReaderT WebState m Word32)
-> [XPubBal]
-> WebT m Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> [XPubBal] -> ReaderT WebState m Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xpub
    getMaxGap :: WebT m Word32
getMaxGap = ReaderT WebState m Word32 -> WebT m Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT WebState m Word32
forall (m :: * -> *). StoreReadExtra m => m Word32
getMaxGap
    getInitialGap :: WebT m Word32
getInitialGap = ReaderT WebState m Word32 -> WebT m Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT WebState m Word32
forall (m :: * -> *). StoreReadExtra m => m Word32
getInitialGap
    getNumTxData :: Word64 -> WebT m [TxData]
getNumTxData = ReaderT WebState m [TxData] -> WebT m [TxData]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxData] -> WebT m [TxData])
-> (Word64 -> ReaderT WebState m [TxData])
-> Word64
-> WebT m [TxData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ReaderT WebState m [TxData]
forall (m :: * -> *). StoreReadExtra m => Word64 -> m [TxData]
getNumTxData

-------------------
-- Path Handlers --
-------------------

runWeb :: (MonadUnliftIO m, MonadLoggerIO m) => WebConfig -> m ()
runWeb :: WebConfig -> m ()
runWeb
    cfg :: WebConfig
cfg@WebConfig
        { webHost :: WebConfig -> String
webHost = String
host
        , webPort :: WebConfig -> Int
webPort = Int
port
        , webStore :: WebConfig -> Store
webStore = Store
store'
        , webStats :: WebConfig -> Maybe Store
webStats = Maybe Store
stats
        , webPriceGet :: WebConfig -> Int
webPriceGet = Int
pget
        , webTickerURL :: WebConfig -> String
webTickerURL = String
turl
        , webMaxLimits :: WebConfig -> WebLimits
webMaxLimits = WebLimits{Word32
maxLimitBody :: Word32
maxLimitInitialGap :: Word32
maxLimitGap :: Word32
maxLimitDefault :: Word32
maxLimitOffset :: Word32
maxLimitFull :: Word32
maxLimitCount :: Word32
maxLimitBody :: WebLimits -> Word32
maxLimitInitialGap :: WebLimits -> Word32
maxLimitGap :: WebLimits -> Word32
maxLimitDefault :: WebLimits -> Word32
maxLimitOffset :: WebLimits -> Word32
maxLimitFull :: WebLimits -> Word32
maxLimitCount :: WebLimits -> Word32
..}
        } = do
        TVar (HashMap Text BinfoTicker)
ticker <- HashMap Text BinfoTicker -> m (TVar (HashMap Text BinfoTicker))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO HashMap Text BinfoTicker
forall k v. HashMap k v
HashMap.empty
        Maybe WebMetrics
metrics <- (Store -> m WebMetrics) -> Maybe Store -> m (Maybe WebMetrics)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Store -> m WebMetrics
forall (m :: * -> *). MonadIO m => Store -> m WebMetrics
createMetrics Maybe Store
stats
        Session
session <- IO Session -> m Session
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Session
Wreq.Session.newAPISession
        let st :: WebState
st =
                WebState :: WebConfig
-> TVar (HashMap Text BinfoTicker)
-> Maybe WebMetrics
-> Session
-> WebState
WebState
                    { webConfig :: WebConfig
webConfig = WebConfig
cfg
                    , webTicker :: TVar (HashMap Text BinfoTicker)
webTicker = TVar (HashMap Text BinfoTicker)
ticker
                    , webMetrics :: Maybe WebMetrics
webMetrics = Maybe WebMetrics
metrics
                    , webWreqSession :: Session
webWreqSession = Session
session
                    }
            net :: Network
net = Store -> Network
storeNetwork Store
store'
        m () -> (Async () -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (Network
-> Session
-> String
-> Int
-> TVar (HashMap Text BinfoTicker)
-> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network
-> Session
-> String
-> Int
-> TVar (HashMap Text BinfoTicker)
-> m ()
price Network
net Session
session String
turl Int
pget TVar (HashMap Text BinfoTicker)
ticker) ((Async () -> m ()) -> m ()) -> (Async () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
            m () -> Async () -> m ()
forall a b. a -> b -> a
const (m () -> Async () -> m ()) -> m () -> Async () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                Middleware
reqLogger <- Maybe WebMetrics -> m Middleware
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Maybe WebMetrics -> m Middleware
logIt Maybe WebMetrics
metrics
                m Response -> IO Response
runner <- m (m Response -> IO Response)
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
                Options
-> (ReaderT WebState m Response -> IO Response)
-> ScottyT Except (ReaderT WebState m) ()
-> m ()
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
S.scottyOptsT Options
opts (m Response -> IO Response
runner (m Response -> IO Response)
-> (ReaderT WebState m Response -> m Response)
-> ReaderT WebState m Response
-> IO Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT WebState m Response -> WebState -> m Response
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` WebState
st)) (ScottyT Except (ReaderT WebState m) () -> m ())
-> ScottyT Except (ReaderT WebState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                    Middleware -> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (WebState -> Middleware
webSocketEvents WebState
st)
                    Middleware -> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware Middleware
reqLogger
                    Middleware -> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (Word32 -> Middleware
forall i. Integral i => i -> Middleware
reqSizeLimit Word32
maxLimitBody)
                    (Except -> ActionT Except (ReaderT WebState m) ())
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
(e -> ActionT e m ()) -> ScottyT e m ()
S.defaultHandler Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Except -> WebT m ()
defHandler
                    ScottyT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ScottyT Except (ReaderT WebState m) ()
handlePaths
                    ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m () -> ScottyT e m ()
S.notFound (ActionT Except (ReaderT WebState m) ()
 -> ScottyT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
      where
        opts :: Options
opts = Options
forall a. Default a => a
def{settings :: Settings
S.settings = Settings -> Settings
settings Settings
defaultSettings}
        settings :: Settings -> Settings
settings = Int -> Settings -> Settings
setPort Int
port (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostPreference -> Settings -> Settings
setHost (String -> HostPreference
forall a. IsString a => String -> a
fromString String
host)

getRates ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    Network ->
    Wreq.Session ->
    String ->
    Text ->
    [Word64] ->
    m [BinfoRate]
getRates :: Network -> Session -> String -> Text -> [Word64] -> m [BinfoRate]
getRates Network
net Session
session String
url Text
currency [Word64]
times = do
    (SomeException -> m [BinfoRate]) -> m [BinfoRate] -> m [BinfoRate]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny SomeException -> m [BinfoRate]
forall (m :: * -> *) p a. MonadLogger m => p -> m [a]
err (m [BinfoRate] -> m [BinfoRate]) -> m [BinfoRate] -> m [BinfoRate]
forall a b. (a -> b) -> a -> b
$ do
        Response [BinfoRate]
r <-
            IO (Response [BinfoRate]) -> m (Response [BinfoRate])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response [BinfoRate]) -> m (Response [BinfoRate]))
-> IO (Response [BinfoRate]) -> m (Response [BinfoRate])
forall a b. (a -> b) -> a -> b
$
                Response ByteString -> IO (Response [BinfoRate])
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON
                    (Response ByteString -> IO (Response [BinfoRate]))
-> IO (Response ByteString) -> IO (Response [BinfoRate])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> Session -> String -> Value -> IO (Response ByteString)
forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
Wreq.Session.postWith Options
opts Session
session String
url Value
body
        [BinfoRate] -> m [BinfoRate]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BinfoRate] -> m [BinfoRate]) -> [BinfoRate] -> m [BinfoRate]
forall a b. (a -> b) -> a -> b
$ Response [BinfoRate]
r Response [BinfoRate]
-> Getting [BinfoRate] (Response [BinfoRate]) [BinfoRate]
-> [BinfoRate]
forall s a. s -> Getting a s a -> a
^. Getting [BinfoRate] (Response [BinfoRate]) [BinfoRate]
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody
  where
    err :: p -> m [a]
err p
_ = do
        $(Text -> Text -> m ()
logErrorS) Text
"Web" Text
"Could not get historic prices"
        [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    body :: Value
body = [Word64] -> Value
forall a. ToJSON a => a -> Value
toJSON [Word64]
times
    base :: Options
base =
        Options
Wreq.defaults
            Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
Wreq.param Text
"base" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Text
T.toUpper (String -> Text
T.pack (Network -> String
getNetworkName Network
net))]
    opts :: Options
opts = Options
base Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
Wreq.param Text
"quote" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
currency]

price ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    Network ->
    Wreq.Session ->
    String ->
    Int ->
    TVar (HashMap Text BinfoTicker) ->
    m ()
price :: Network
-> Session
-> String
-> Int
-> TVar (HashMap Text BinfoTicker)
-> m ()
price Network
net Session
session String
url Int
pget TVar (HashMap Text BinfoTicker)
v = Maybe String -> (String -> m Any) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
purl ((String -> m Any) -> m ()) -> (String -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ \String
u -> m () -> m Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m Any) -> m () -> m Any
forall a b. (a -> b) -> a -> b
$ do
    let err :: a -> m ()
err a
e = $(Text -> Text -> m ()
logErrorS) Text
"Price" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (a -> String
forall a. Show a => a -> String
show a
e)
    (SomeException -> m ()) -> m () -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny SomeException -> m ()
forall (m :: * -> *) a. (MonadLogger m, Show a) => a -> m ()
err (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Response (HashMap Text BinfoTicker)
r <- IO (Response (HashMap Text BinfoTicker))
-> m (Response (HashMap Text BinfoTicker))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response (HashMap Text BinfoTicker))
 -> m (Response (HashMap Text BinfoTicker)))
-> IO (Response (HashMap Text BinfoTicker))
-> m (Response (HashMap Text BinfoTicker))
forall a b. (a -> b) -> a -> b
$ Response ByteString -> IO (Response (HashMap Text BinfoTicker))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON (Response ByteString -> IO (Response (HashMap Text BinfoTicker)))
-> IO (Response ByteString)
-> IO (Response (HashMap Text BinfoTicker))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Session -> String -> IO (Response ByteString)
Wreq.Session.get Session
session String
u
        STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ())
-> (HashMap Text BinfoTicker -> STM ())
-> HashMap Text BinfoTicker
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (HashMap Text BinfoTicker)
-> HashMap Text BinfoTicker -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (HashMap Text BinfoTicker)
v (HashMap Text BinfoTicker -> m ())
-> HashMap Text BinfoTicker -> m ()
forall a b. (a -> b) -> a -> b
$ Response (HashMap Text BinfoTicker)
r Response (HashMap Text BinfoTicker)
-> Getting
     (HashMap Text BinfoTicker)
     (Response (HashMap Text BinfoTicker))
     (HashMap Text BinfoTicker)
-> HashMap Text BinfoTicker
forall s a. s -> Getting a s a -> a
^. Getting
  (HashMap Text BinfoTicker)
  (Response (HashMap Text BinfoTicker))
  (HashMap Text BinfoTicker)
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody
    Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
pget
  where
    purl :: Maybe String
purl = case Maybe String
code of
        Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
        Just String
x -> String -> Maybe String
forall a. a -> Maybe a
Just (String
url String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"?base=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x)
      where
        code :: Maybe String
code
            | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
btc = String -> Maybe String
forall a. a -> Maybe a
Just String
"btc"
            | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch = String -> Maybe String
forall a. a -> Maybe a
Just String
"bch"
            | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing

raise :: MonadIO m => Except -> WebT m a
raise :: Except -> WebT m a
raise Except
err =
    ReaderT WebState m (Maybe WebMetrics)
-> ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Maybe WebMetrics)
-> ReaderT WebState m (Maybe WebMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics) ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> WebT m a) -> WebT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe WebMetrics
Nothing -> Except -> WebT m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
e -> ActionT e m a
S.raise Except
err
        Just WebMetrics
m -> do
            Request
req <- ActionT Except (ReaderT WebState m) Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
S.request
            Maybe (WebMetrics -> StatDist)
mM <- case Key (TVar (Maybe (WebMetrics -> StatDist)))
-> Vault -> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
forall a. Key a -> Vault -> Maybe a
V.lookup (WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey WebMetrics
m) (Request -> Vault
vault Request
req) of
                Maybe (TVar (Maybe (WebMetrics -> StatDist)))
Nothing -> Maybe (WebMetrics -> StatDist)
-> ActionT
     Except (ReaderT WebState m) (Maybe (WebMetrics -> StatDist))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (WebMetrics -> StatDist)
forall a. Maybe a
Nothing
                Just TVar (Maybe (WebMetrics -> StatDist))
t -> TVar (Maybe (WebMetrics -> StatDist))
-> ActionT
     Except (ReaderT WebState m) (Maybe (WebMetrics -> StatDist))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (WebMetrics -> StatDist))
t
            let status :: Status
status = Except -> Status
errStatus Except
err
            if
                    | Status -> Bool
statusIsClientError Status
status ->
                        IO () -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ActionT Except (ReaderT WebState m) ())
-> IO () -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ do
                            StatDist -> IO ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addClientError (WebMetrics -> StatDist
statAll WebMetrics
m)
                            Maybe (WebMetrics -> StatDist)
-> ((WebMetrics -> StatDist) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (WebMetrics -> StatDist)
mM (((WebMetrics -> StatDist) -> IO ()) -> IO ())
-> ((WebMetrics -> StatDist) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebMetrics -> StatDist
f -> StatDist -> IO ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addClientError (WebMetrics -> StatDist
f WebMetrics
m)
                    | Status -> Bool
statusIsServerError Status
status ->
                        IO () -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ActionT Except (ReaderT WebState m) ())
-> IO () -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ do
                            StatDist -> IO ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addServerError (WebMetrics -> StatDist
statAll WebMetrics
m)
                            Maybe (WebMetrics -> StatDist)
-> ((WebMetrics -> StatDist) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (WebMetrics -> StatDist)
mM (((WebMetrics -> StatDist) -> IO ()) -> IO ())
-> ((WebMetrics -> StatDist) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebMetrics -> StatDist
f -> StatDist -> IO ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addServerError (WebMetrics -> StatDist
f WebMetrics
m)
                    | Bool
otherwise ->
                        () -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Except -> WebT m a
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
e -> ActionT e m a
S.raise Except
err

errStatus :: Except -> Status
errStatus :: Except -> Status
errStatus Except
ThingNotFound = Status
status404
errStatus Except
BadRequest = Status
status400
errStatus UserError{} = Status
status400
errStatus StringError{} = Status
status400
errStatus Except
ServerError = Status
status500
errStatus TxIndexConflict{} = Status
status409
errStatus Except
ServerTimeout = Status
status500
errStatus Except
RequestTooLarge = Status
status413

defHandler :: Monad m => Except -> WebT m ()
defHandler :: Except -> WebT m ()
defHandler Except
e = do
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Status -> WebT m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
S.status (Status -> WebT m ()) -> Status -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Except -> Status
errStatus Except
e
    Except -> WebT m ()
forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
S.json Except
e

handlePaths ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    S.ScottyT Except (ReaderT WebState m) ()
handlePaths :: ScottyT Except (ReaderT WebState m) ()
handlePaths = do
    -- Block Paths
    WebT m GetBlock
-> (GetBlock -> WebT m BlockData)
-> (Network -> BlockData -> Encoding)
-> (Network -> BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (BlockHash -> NoTx -> GetBlock
GetBlock (BlockHash -> NoTx -> GetBlock)
-> ActionT Except (ReaderT WebState m) BlockHash
-> ActionT Except (ReaderT WebState m) (NoTx -> GetBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (NoTx -> GetBlock)
-> ActionT Except (ReaderT WebState m) NoTx -> WebT m GetBlock
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        GetBlock -> WebT m BlockData
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlock -> WebT m BlockData
scottyBlock
        Network -> BlockData -> Encoding
blockDataToEncoding
        Network -> BlockData -> Value
blockDataToJSON
    WebT m GetBlocks
-> (GetBlocks -> WebT m (SerialList BlockData))
-> (Network -> SerialList BlockData -> Encoding)
-> (Network -> SerialList BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([BlockHash] -> NoTx -> GetBlocks
GetBlocks ([BlockHash] -> NoTx -> GetBlocks)
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> ActionT Except (ReaderT WebState m) (NoTx -> GetBlocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [BlockHash]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param ActionT Except (ReaderT WebState m) (NoTx -> GetBlocks)
-> ActionT Except (ReaderT WebState m) NoTx -> WebT m GetBlocks
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([BlockData] -> SerialList BlockData)
-> ActionT Except (ReaderT WebState m) [BlockData]
-> WebT m (SerialList BlockData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BlockData] -> SerialList BlockData
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [BlockData]
 -> WebT m (SerialList BlockData))
-> (GetBlocks -> ActionT Except (ReaderT WebState m) [BlockData])
-> GetBlocks
-> WebT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlocks -> ActionT Except (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlocks -> WebT m [BlockData]
scottyBlocks)
        (\Network
n -> (BlockData -> Encoding) -> [BlockData] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BlockData -> Encoding
blockDataToEncoding Network
n) ([BlockData] -> Encoding)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> BlockData -> Value) -> Network -> [BlockData] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> BlockData -> Value
blockDataToJSON Network
n ([BlockData] -> Value)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetBlockRaw
-> (GetBlockRaw -> WebT m (RawResult Block))
-> (Network -> RawResult Block -> Encoding)
-> (Network -> RawResult Block -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (BlockHash -> GetBlockRaw
GetBlockRaw (BlockHash -> GetBlockRaw)
-> ActionT Except (ReaderT WebState m) BlockHash
-> WebT m GetBlockRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetBlockRaw -> WebT m (RawResult Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockRaw -> WebT m (RawResult Block)
scottyBlockRaw
        ((RawResult Block -> Encoding)
-> Network -> RawResult Block -> Encoding
forall a b. a -> b -> a
const RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResult Block -> Value) -> Network -> RawResult Block -> Value
forall a b. a -> b -> a
const RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetBlockBest
-> (GetBlockBest -> WebT m BlockData)
-> (Network -> BlockData -> Encoding)
-> (Network -> BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (NoTx -> GetBlockBest
GetBlockBest (NoTx -> GetBlockBest)
-> ActionT Except (ReaderT WebState m) NoTx -> WebT m GetBlockBest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        GetBlockBest -> WebT m BlockData
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockBest -> WebT m BlockData
scottyBlockBest
        Network -> BlockData -> Encoding
blockDataToEncoding
        Network -> BlockData -> Value
blockDataToJSON
    WebT m GetBlockBestRaw
-> (GetBlockBestRaw -> WebT m (RawResult Block))
-> (Network -> RawResult Block -> Encoding)
-> (Network -> RawResult Block -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (GetBlockBestRaw
GetBlockBestRaw GetBlockBestRaw
-> (GetBlockBestRaw -> WebT m GetBlockBestRaw)
-> WebT m GetBlockBestRaw
forall a b. a -> (a -> b) -> b
& GetBlockBestRaw -> WebT m GetBlockBestRaw
forall (m :: * -> *) a. Monad m => a -> m a
return)
        GetBlockBestRaw -> WebT m (RawResult Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockBestRaw -> WebT m (RawResult Block)
scottyBlockBestRaw
        ((RawResult Block -> Encoding)
-> Network -> RawResult Block -> Encoding
forall a b. a -> b -> a
const RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResult Block -> Value) -> Network -> RawResult Block -> Value
forall a b. a -> b -> a
const RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetBlockLatest
-> (GetBlockLatest -> WebT m (SerialList BlockData))
-> (Network -> SerialList BlockData -> Encoding)
-> (Network -> SerialList BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (NoTx -> GetBlockLatest
GetBlockLatest (NoTx -> GetBlockLatest)
-> ActionT Except (ReaderT WebState m) NoTx
-> WebT m GetBlockLatest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([BlockData] -> SerialList BlockData)
-> ActionT Except (ReaderT WebState m) [BlockData]
-> WebT m (SerialList BlockData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BlockData] -> SerialList BlockData
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [BlockData]
 -> WebT m (SerialList BlockData))
-> (GetBlockLatest
    -> ActionT Except (ReaderT WebState m) [BlockData])
-> GetBlockLatest
-> WebT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlockLatest -> ActionT Except (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockLatest -> WebT m [BlockData]
scottyBlockLatest)
        (\Network
n -> (BlockData -> Encoding) -> [BlockData] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BlockData -> Encoding
blockDataToEncoding Network
n) ([BlockData] -> Encoding)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> BlockData -> Value) -> Network -> [BlockData] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> BlockData -> Value
blockDataToJSON Network
n ([BlockData] -> Value)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetBlockHeight
-> (GetBlockHeight -> WebT m (SerialList BlockData))
-> (Network -> SerialList BlockData -> Encoding)
-> (Network -> SerialList BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (HeightParam -> NoTx -> GetBlockHeight
GetBlockHeight (HeightParam -> NoTx -> GetBlockHeight)
-> ActionT Except (ReaderT WebState m) HeightParam
-> ActionT Except (ReaderT WebState m) (NoTx -> GetBlockHeight)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) HeightParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (NoTx -> GetBlockHeight)
-> ActionT Except (ReaderT WebState m) NoTx
-> WebT m GetBlockHeight
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([BlockData] -> SerialList BlockData)
-> ActionT Except (ReaderT WebState m) [BlockData]
-> WebT m (SerialList BlockData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BlockData] -> SerialList BlockData
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [BlockData]
 -> WebT m (SerialList BlockData))
-> (GetBlockHeight
    -> ActionT Except (ReaderT WebState m) [BlockData])
-> GetBlockHeight
-> WebT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlockHeight -> ActionT Except (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockHeight -> WebT m [BlockData]
scottyBlockHeight)
        (\Network
n -> (BlockData -> Encoding) -> [BlockData] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BlockData -> Encoding
blockDataToEncoding Network
n) ([BlockData] -> Encoding)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> BlockData -> Value) -> Network -> [BlockData] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> BlockData -> Value
blockDataToJSON Network
n ([BlockData] -> Value)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetBlockHeights
-> (GetBlockHeights -> WebT m (SerialList BlockData))
-> (Network -> SerialList BlockData -> Encoding)
-> (Network -> SerialList BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (HeightsParam -> NoTx -> GetBlockHeights
GetBlockHeights (HeightsParam -> NoTx -> GetBlockHeights)
-> ActionT Except (ReaderT WebState m) HeightsParam
-> ActionT Except (ReaderT WebState m) (NoTx -> GetBlockHeights)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) HeightsParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param ActionT Except (ReaderT WebState m) (NoTx -> GetBlockHeights)
-> ActionT Except (ReaderT WebState m) NoTx
-> WebT m GetBlockHeights
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([BlockData] -> SerialList BlockData)
-> ActionT Except (ReaderT WebState m) [BlockData]
-> WebT m (SerialList BlockData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BlockData] -> SerialList BlockData
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [BlockData]
 -> WebT m (SerialList BlockData))
-> (GetBlockHeights
    -> ActionT Except (ReaderT WebState m) [BlockData])
-> GetBlockHeights
-> WebT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlockHeights -> ActionT Except (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockHeights -> WebT m [BlockData]
scottyBlockHeights)
        (\Network
n -> (BlockData -> Encoding) -> [BlockData] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BlockData -> Encoding
blockDataToEncoding Network
n) ([BlockData] -> Encoding)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> BlockData -> Value) -> Network -> [BlockData] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> BlockData -> Value
blockDataToJSON Network
n ([BlockData] -> Value)
-> (SerialList BlockData -> [BlockData])
-> SerialList BlockData
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList BlockData -> [BlockData]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetBlockHeightRaw
-> (GetBlockHeightRaw -> WebT m (RawResultList Block))
-> (Network -> RawResultList Block -> Encoding)
-> (Network -> RawResultList Block -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (HeightParam -> GetBlockHeightRaw
GetBlockHeightRaw (HeightParam -> GetBlockHeightRaw)
-> ActionT Except (ReaderT WebState m) HeightParam
-> WebT m GetBlockHeightRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) HeightParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetBlockHeightRaw -> WebT m (RawResultList Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockHeightRaw -> WebT m (RawResultList Block)
scottyBlockHeightRaw
        ((RawResultList Block -> Encoding)
-> Network -> RawResultList Block -> Encoding
forall a b. a -> b -> a
const RawResultList Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResultList Block -> Value)
-> Network -> RawResultList Block -> Value
forall a b. a -> b -> a
const RawResultList Block -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetBlockTime
-> (GetBlockTime -> WebT m BlockData)
-> (Network -> BlockData -> Encoding)
-> (Network -> BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TimeParam -> NoTx -> GetBlockTime
GetBlockTime (TimeParam -> NoTx -> GetBlockTime)
-> ActionT Except (ReaderT WebState m) TimeParam
-> ActionT Except (ReaderT WebState m) (NoTx -> GetBlockTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (NoTx -> GetBlockTime)
-> ActionT Except (ReaderT WebState m) NoTx -> WebT m GetBlockTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        GetBlockTime -> WebT m BlockData
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTime -> WebT m BlockData
scottyBlockTime
        Network -> BlockData -> Encoding
blockDataToEncoding
        Network -> BlockData -> Value
blockDataToJSON
    WebT m GetBlockTimeRaw
-> (GetBlockTimeRaw -> WebT m (RawResult Block))
-> (Network -> RawResult Block -> Encoding)
-> (Network -> RawResult Block -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TimeParam -> GetBlockTimeRaw
GetBlockTimeRaw (TimeParam -> GetBlockTimeRaw)
-> ActionT Except (ReaderT WebState m) TimeParam
-> WebT m GetBlockTimeRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetBlockTimeRaw -> WebT m (RawResult Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTimeRaw -> WebT m (RawResult Block)
scottyBlockTimeRaw
        ((RawResult Block -> Encoding)
-> Network -> RawResult Block -> Encoding
forall a b. a -> b -> a
const RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResult Block -> Value) -> Network -> RawResult Block -> Value
forall a b. a -> b -> a
const RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetBlockMTP
-> (GetBlockMTP -> WebT m BlockData)
-> (Network -> BlockData -> Encoding)
-> (Network -> BlockData -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TimeParam -> NoTx -> GetBlockMTP
GetBlockMTP (TimeParam -> NoTx -> GetBlockMTP)
-> ActionT Except (ReaderT WebState m) TimeParam
-> ActionT Except (ReaderT WebState m) (NoTx -> GetBlockMTP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (NoTx -> GetBlockMTP)
-> ActionT Except (ReaderT WebState m) NoTx -> WebT m GetBlockMTP
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoTx
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        GetBlockMTP -> WebT m BlockData
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockMTP -> WebT m BlockData
scottyBlockMTP
        Network -> BlockData -> Encoding
blockDataToEncoding
        Network -> BlockData -> Value
blockDataToJSON
    WebT m GetBlockMTPRaw
-> (GetBlockMTPRaw -> WebT m (RawResult Block))
-> (Network -> RawResult Block -> Encoding)
-> (Network -> RawResult Block -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TimeParam -> GetBlockMTPRaw
GetBlockMTPRaw (TimeParam -> GetBlockMTPRaw)
-> ActionT Except (ReaderT WebState m) TimeParam
-> WebT m GetBlockMTPRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetBlockMTPRaw -> WebT m (RawResult Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockMTPRaw -> WebT m (RawResult Block)
scottyBlockMTPRaw
        ((RawResult Block -> Encoding)
-> Network -> RawResult Block -> Encoding
forall a b. a -> b -> a
const RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResult Block -> Value) -> Network -> RawResult Block -> Value
forall a b. a -> b -> a
const RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON)
    -- Transaction Paths
    WebT m GetTx
-> (GetTx -> WebT m Transaction)
-> (Network -> Transaction -> Encoding)
-> (Network -> Transaction -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TxHash -> GetTx
GetTx (TxHash -> GetTx)
-> ActionT Except (ReaderT WebState m) TxHash -> WebT m GetTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TxHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetTx -> WebT m Transaction
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTx -> WebT m Transaction
scottyTx
        Network -> Transaction -> Encoding
transactionToEncoding
        Network -> Transaction -> Value
transactionToJSON
    WebT m GetTxs
-> (GetTxs -> WebT m (SerialList Transaction))
-> (Network -> SerialList Transaction -> Encoding)
-> (Network -> SerialList Transaction -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([TxHash] -> GetTxs
GetTxs ([TxHash] -> GetTxs)
-> ActionT Except (ReaderT WebState m) [TxHash] -> WebT m GetTxs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [TxHash]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param)
        (([Transaction] -> SerialList Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
-> WebT m (SerialList Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Transaction] -> SerialList Transaction
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Transaction]
 -> WebT m (SerialList Transaction))
-> (GetTxs -> ActionT Except (ReaderT WebState m) [Transaction])
-> GetTxs
-> WebT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetTxs -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxs -> WebT m [Transaction]
scottyTxs)
        (\Network
n -> (Transaction -> Encoding) -> [Transaction] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Transaction -> Encoding
transactionToEncoding Network
n) ([Transaction] -> Encoding)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Transaction -> Value)
-> Network -> [Transaction] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Transaction -> Value
transactionToJSON Network
n ([Transaction] -> Value)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetTxRaw
-> (GetTxRaw -> WebT m (RawResult Tx))
-> (Network -> RawResult Tx -> Encoding)
-> (Network -> RawResult Tx -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TxHash -> GetTxRaw
GetTxRaw (TxHash -> GetTxRaw)
-> ActionT Except (ReaderT WebState m) TxHash -> WebT m GetTxRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TxHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetTxRaw -> WebT m (RawResult Tx)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxRaw -> WebT m (RawResult Tx)
scottyTxRaw
        ((RawResult Tx -> Encoding) -> Network -> RawResult Tx -> Encoding
forall a b. a -> b -> a
const RawResult Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResult Tx -> Value) -> Network -> RawResult Tx -> Value
forall a b. a -> b -> a
const RawResult Tx -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetTxsRaw
-> (GetTxsRaw -> WebT m (RawResultList Tx))
-> (Network -> RawResultList Tx -> Encoding)
-> (Network -> RawResultList Tx -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([TxHash] -> GetTxsRaw
GetTxsRaw ([TxHash] -> GetTxsRaw)
-> ActionT Except (ReaderT WebState m) [TxHash] -> WebT m GetTxsRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [TxHash]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param)
        GetTxsRaw -> WebT m (RawResultList Tx)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxsRaw -> WebT m (RawResultList Tx)
scottyTxsRaw
        ((RawResultList Tx -> Encoding)
-> Network -> RawResultList Tx -> Encoding
forall a b. a -> b -> a
const RawResultList Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResultList Tx -> Value) -> Network -> RawResultList Tx -> Value
forall a b. a -> b -> a
const RawResultList Tx -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetTxsBlock
-> (GetTxsBlock -> WebT m (SerialList Transaction))
-> (Network -> SerialList Transaction -> Encoding)
-> (Network -> SerialList Transaction -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (BlockHash -> GetTxsBlock
GetTxsBlock (BlockHash -> GetTxsBlock)
-> ActionT Except (ReaderT WebState m) BlockHash
-> WebT m GetTxsBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        (([Transaction] -> SerialList Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
-> WebT m (SerialList Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Transaction] -> SerialList Transaction
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Transaction]
 -> WebT m (SerialList Transaction))
-> (GetTxsBlock
    -> ActionT Except (ReaderT WebState m) [Transaction])
-> GetTxsBlock
-> WebT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetTxsBlock -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxsBlock -> WebT m [Transaction]
scottyTxsBlock)
        (\Network
n -> (Transaction -> Encoding) -> [Transaction] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Transaction -> Encoding
transactionToEncoding Network
n) ([Transaction] -> Encoding)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Transaction -> Value)
-> Network -> [Transaction] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Transaction -> Value
transactionToJSON Network
n ([Transaction] -> Value)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetTxsBlockRaw
-> (GetTxsBlockRaw -> WebT m (RawResultList Tx))
-> (Network -> RawResultList Tx -> Encoding)
-> (Network -> RawResultList Tx -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (BlockHash -> GetTxsBlockRaw
GetTxsBlockRaw (BlockHash -> GetTxsBlockRaw)
-> ActionT Except (ReaderT WebState m) BlockHash
-> WebT m GetTxsBlockRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetTxsBlockRaw -> WebT m (RawResultList Tx)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxsBlockRaw -> WebT m (RawResultList Tx)
scottyTxsBlockRaw
        ((RawResultList Tx -> Encoding)
-> Network -> RawResultList Tx -> Encoding
forall a b. a -> b -> a
const RawResultList Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((RawResultList Tx -> Value) -> Network -> RawResultList Tx -> Value
forall a b. a -> b -> a
const RawResultList Tx -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetTxAfter
-> (GetTxAfter -> WebT m (GenericResult (Maybe Bool)))
-> (Network -> GenericResult (Maybe Bool) -> Encoding)
-> (Network -> GenericResult (Maybe Bool) -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (TxHash -> HeightParam -> GetTxAfter
GetTxAfter (TxHash -> HeightParam -> GetTxAfter)
-> ActionT Except (ReaderT WebState m) TxHash
-> ActionT Except (ReaderT WebState m) (HeightParam -> GetTxAfter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) TxHash
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (HeightParam -> GetTxAfter)
-> ActionT Except (ReaderT WebState m) HeightParam
-> WebT m GetTxAfter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) HeightParam
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetTxAfter -> WebT m (GenericResult (Maybe Bool))
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxAfter -> WebT m (GenericResult (Maybe Bool))
scottyTxAfter
        ((GenericResult (Maybe Bool) -> Encoding)
-> Network -> GenericResult (Maybe Bool) -> Encoding
forall a b. a -> b -> a
const GenericResult (Maybe Bool) -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((GenericResult (Maybe Bool) -> Value)
-> Network -> GenericResult (Maybe Bool) -> Value
forall a b. a -> b -> a
const GenericResult (Maybe Bool) -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m PostTx
-> (PostTx -> WebT m TxId)
-> (Network -> TxId -> Encoding)
-> (Network -> TxId -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (Tx -> PostTx
PostTx (Tx -> PostTx)
-> ActionT Except (ReaderT WebState m) Tx -> WebT m PostTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) Tx
forall (m :: * -> *) a. (MonadIO m, Serial a) => WebT m a
parseBody)
        PostTx -> WebT m TxId
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
PostTx -> WebT m TxId
scottyPostTx
        ((TxId -> Encoding) -> Network -> TxId -> Encoding
forall a b. a -> b -> a
const TxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((TxId -> Value) -> Network -> TxId -> Value
forall a b. a -> b -> a
const TxId -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetMempool
-> (GetMempool -> WebT m (SerialList TxHash))
-> (Network -> SerialList TxHash -> Encoding)
-> (Network -> SerialList TxHash -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (Maybe LimitParam -> OffsetParam -> GetMempool
GetMempool (Maybe LimitParam -> OffsetParam -> GetMempool)
-> ActionT Except (ReaderT WebState m) (Maybe LimitParam)
-> ActionT Except (ReaderT WebState m) (OffsetParam -> GetMempool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) (Maybe LimitParam)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional ActionT Except (ReaderT WebState m) (OffsetParam -> GetMempool)
-> ActionT Except (ReaderT WebState m) OffsetParam
-> WebT m GetMempool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) OffsetParam
forall (m :: * -> *). MonadIO m => WebT m OffsetParam
parseOffset)
        (([TxHash] -> SerialList TxHash)
-> ActionT Except (ReaderT WebState m) [TxHash]
-> WebT m (SerialList TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TxHash] -> SerialList TxHash
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [TxHash]
 -> WebT m (SerialList TxHash))
-> (GetMempool -> ActionT Except (ReaderT WebState m) [TxHash])
-> GetMempool
-> WebT m (SerialList TxHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetMempool -> ActionT Except (ReaderT WebState m) [TxHash]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetMempool -> WebT m [TxHash]
scottyMempool)
        ((SerialList TxHash -> Encoding)
-> Network -> SerialList TxHash -> Encoding
forall a b. a -> b -> a
const SerialList TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((SerialList TxHash -> Value)
-> Network -> SerialList TxHash -> Value
forall a b. a -> b -> a
const SerialList TxHash -> Value
forall a. ToJSON a => a -> Value
toJSON)
    -- Address Paths
    WebT m GetAddrTxs
-> (GetAddrTxs -> WebT m (SerialList TxRef))
-> (Network -> SerialList TxRef -> Encoding)
-> (Network -> SerialList TxRef -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (Address -> LimitsParam -> GetAddrTxs
GetAddrTxs (Address -> LimitsParam -> GetAddrTxs)
-> ActionT Except (ReaderT WebState m) Address
-> ActionT Except (ReaderT WebState m) (LimitsParam -> GetAddrTxs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (LimitsParam -> GetAddrTxs)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> WebT m GetAddrTxs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits)
        (([TxRef] -> SerialList TxRef)
-> ActionT Except (ReaderT WebState m) [TxRef]
-> WebT m (SerialList TxRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TxRef] -> SerialList TxRef
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [TxRef]
 -> WebT m (SerialList TxRef))
-> (GetAddrTxs -> ActionT Except (ReaderT WebState m) [TxRef])
-> GetAddrTxs
-> WebT m (SerialList TxRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrTxs -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxs -> WebT m [TxRef]
scottyAddrTxs)
        ((SerialList TxRef -> Encoding)
-> Network -> SerialList TxRef -> Encoding
forall a b. a -> b -> a
const SerialList TxRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((SerialList TxRef -> Value) -> Network -> SerialList TxRef -> Value
forall a b. a -> b -> a
const SerialList TxRef -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetAddrsTxs
-> (GetAddrsTxs -> WebT m (SerialList TxRef))
-> (Network -> SerialList TxRef -> Encoding)
-> (Network -> SerialList TxRef -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([Address] -> LimitsParam -> GetAddrsTxs
GetAddrsTxs ([Address] -> LimitsParam -> GetAddrsTxs)
-> ActionT Except (ReaderT WebState m) [Address]
-> ActionT Except (ReaderT WebState m) (LimitsParam -> GetAddrsTxs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param ActionT Except (ReaderT WebState m) (LimitsParam -> GetAddrsTxs)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> WebT m GetAddrsTxs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits)
        (([TxRef] -> SerialList TxRef)
-> ActionT Except (ReaderT WebState m) [TxRef]
-> WebT m (SerialList TxRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TxRef] -> SerialList TxRef
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [TxRef]
 -> WebT m (SerialList TxRef))
-> (GetAddrsTxs -> ActionT Except (ReaderT WebState m) [TxRef])
-> GetAddrsTxs
-> WebT m (SerialList TxRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsTxs -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsTxs -> WebT m [TxRef]
scottyAddrsTxs)
        ((SerialList TxRef -> Encoding)
-> Network -> SerialList TxRef -> Encoding
forall a b. a -> b -> a
const SerialList TxRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((SerialList TxRef -> Value) -> Network -> SerialList TxRef -> Value
forall a b. a -> b -> a
const SerialList TxRef -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetAddrTxsFull
-> (GetAddrTxsFull -> WebT m (SerialList Transaction))
-> (Network -> SerialList Transaction -> Encoding)
-> (Network -> SerialList Transaction -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (Address -> LimitsParam -> GetAddrTxsFull
GetAddrTxsFull (Address -> LimitsParam -> GetAddrTxsFull)
-> ActionT Except (ReaderT WebState m) Address
-> ActionT
     Except (ReaderT WebState m) (LimitsParam -> GetAddrTxsFull)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (LimitsParam -> GetAddrTxsFull)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> WebT m GetAddrTxsFull
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits)
        (([Transaction] -> SerialList Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
-> WebT m (SerialList Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Transaction] -> SerialList Transaction
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Transaction]
 -> WebT m (SerialList Transaction))
-> (GetAddrTxsFull
    -> ActionT Except (ReaderT WebState m) [Transaction])
-> GetAddrTxsFull
-> WebT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrTxsFull -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxsFull -> WebT m [Transaction]
scottyAddrTxsFull)
        (\Network
n -> (Transaction -> Encoding) -> [Transaction] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Transaction -> Encoding
transactionToEncoding Network
n) ([Transaction] -> Encoding)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Transaction -> Value)
-> Network -> [Transaction] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Transaction -> Value
transactionToJSON Network
n ([Transaction] -> Value)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetAddrsTxsFull
-> (GetAddrsTxsFull -> WebT m (SerialList Transaction))
-> (Network -> SerialList Transaction -> Encoding)
-> (Network -> SerialList Transaction -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([Address] -> LimitsParam -> GetAddrsTxsFull
GetAddrsTxsFull ([Address] -> LimitsParam -> GetAddrsTxsFull)
-> ActionT Except (ReaderT WebState m) [Address]
-> ActionT
     Except (ReaderT WebState m) (LimitsParam -> GetAddrsTxsFull)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param ActionT
  Except (ReaderT WebState m) (LimitsParam -> GetAddrsTxsFull)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> WebT m GetAddrsTxsFull
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits)
        (([Transaction] -> SerialList Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
-> WebT m (SerialList Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Transaction] -> SerialList Transaction
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Transaction]
 -> WebT m (SerialList Transaction))
-> (GetAddrsTxsFull
    -> ActionT Except (ReaderT WebState m) [Transaction])
-> GetAddrsTxsFull
-> WebT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsTxsFull
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsTxsFull -> WebT m [Transaction]
scottyAddrsTxsFull)
        (\Network
n -> (Transaction -> Encoding) -> [Transaction] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Transaction -> Encoding
transactionToEncoding Network
n) ([Transaction] -> Encoding)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Transaction -> Value)
-> Network -> [Transaction] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Transaction -> Value
transactionToJSON Network
n ([Transaction] -> Value)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetAddrBalance
-> (GetAddrBalance -> WebT m Balance)
-> (Network -> Balance -> Encoding)
-> (Network -> Balance -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (Address -> GetAddrBalance
GetAddrBalance (Address -> GetAddrBalance)
-> ActionT Except (ReaderT WebState m) Address
-> WebT m GetAddrBalance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy)
        GetAddrBalance -> WebT m Balance
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrBalance -> WebT m Balance
scottyAddrBalance
        Network -> Balance -> Encoding
balanceToEncoding
        Network -> Balance -> Value
balanceToJSON
    WebT m GetAddrsBalance
-> (GetAddrsBalance -> WebT m (SerialList Balance))
-> (Network -> SerialList Balance -> Encoding)
-> (Network -> SerialList Balance -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([Address] -> GetAddrsBalance
GetAddrsBalance ([Address] -> GetAddrsBalance)
-> ActionT Except (ReaderT WebState m) [Address]
-> WebT m GetAddrsBalance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param)
        (([Balance] -> SerialList Balance)
-> ActionT Except (ReaderT WebState m) [Balance]
-> WebT m (SerialList Balance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Balance] -> SerialList Balance
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Balance]
 -> WebT m (SerialList Balance))
-> (GetAddrsBalance
    -> ActionT Except (ReaderT WebState m) [Balance])
-> GetAddrsBalance
-> WebT m (SerialList Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsBalance -> ActionT Except (ReaderT WebState m) [Balance]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsBalance -> WebT m [Balance]
scottyAddrsBalance)
        (\Network
n -> (Balance -> Encoding) -> [Balance] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Balance -> Encoding
balanceToEncoding Network
n) ([Balance] -> Encoding)
-> (SerialList Balance -> [Balance])
-> SerialList Balance
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Balance -> [Balance]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Balance -> Value) -> Network -> [Balance] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Balance -> Value
balanceToJSON Network
n ([Balance] -> Value)
-> (SerialList Balance -> [Balance]) -> SerialList Balance -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Balance -> [Balance]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetAddrUnspent
-> (GetAddrUnspent -> WebT m (SerialList Unspent))
-> (Network -> SerialList Unspent -> Encoding)
-> (Network -> SerialList Unspent -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (Address -> LimitsParam -> GetAddrUnspent
GetAddrUnspent (Address -> LimitsParam -> GetAddrUnspent)
-> ActionT Except (ReaderT WebState m) Address
-> ActionT
     Except (ReaderT WebState m) (LimitsParam -> GetAddrUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (LimitsParam -> GetAddrUnspent)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> WebT m GetAddrUnspent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits)
        (([Unspent] -> SerialList Unspent)
-> ActionT Except (ReaderT WebState m) [Unspent]
-> WebT m (SerialList Unspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Unspent] -> SerialList Unspent
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Unspent]
 -> WebT m (SerialList Unspent))
-> (GetAddrUnspent
    -> ActionT Except (ReaderT WebState m) [Unspent])
-> GetAddrUnspent
-> WebT m (SerialList Unspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrUnspent -> ActionT Except (ReaderT WebState m) [Unspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrUnspent -> WebT m [Unspent]
scottyAddrUnspent)
        (\Network
n -> (Unspent -> Encoding) -> [Unspent] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Unspent -> Encoding
unspentToEncoding Network
n) ([Unspent] -> Encoding)
-> (SerialList Unspent -> [Unspent])
-> SerialList Unspent
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Unspent -> [Unspent]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Unspent -> Value) -> Network -> [Unspent] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Unspent -> Value
unspentToJSON Network
n ([Unspent] -> Value)
-> (SerialList Unspent -> [Unspent]) -> SerialList Unspent -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Unspent -> [Unspent]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetAddrsUnspent
-> (GetAddrsUnspent -> WebT m (SerialList Unspent))
-> (Network -> SerialList Unspent -> Encoding)
-> (Network -> SerialList Unspent -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        ([Address] -> LimitsParam -> GetAddrsUnspent
GetAddrsUnspent ([Address] -> LimitsParam -> GetAddrsUnspent)
-> ActionT Except (ReaderT WebState m) [Address]
-> ActionT
     Except (ReaderT WebState m) (LimitsParam -> GetAddrsUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param ActionT
  Except (ReaderT WebState m) (LimitsParam -> GetAddrsUnspent)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> WebT m GetAddrsUnspent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits)
        (([Unspent] -> SerialList Unspent)
-> ActionT Except (ReaderT WebState m) [Unspent]
-> WebT m (SerialList Unspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Unspent] -> SerialList Unspent
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Unspent]
 -> WebT m (SerialList Unspent))
-> (GetAddrsUnspent
    -> ActionT Except (ReaderT WebState m) [Unspent])
-> GetAddrsUnspent
-> WebT m (SerialList Unspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsUnspent -> ActionT Except (ReaderT WebState m) [Unspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsUnspent -> WebT m [Unspent]
scottyAddrsUnspent)
        (\Network
n -> (Unspent -> Encoding) -> [Unspent] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Unspent -> Encoding
unspentToEncoding Network
n) ([Unspent] -> Encoding)
-> (SerialList Unspent -> [Unspent])
-> SerialList Unspent
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Unspent -> [Unspent]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Unspent -> Value) -> Network -> [Unspent] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Unspent -> Value
unspentToJSON Network
n ([Unspent] -> Value)
-> (SerialList Unspent -> [Unspent]) -> SerialList Unspent -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Unspent -> [Unspent]
forall a. SerialList a -> [a]
getSerialList)
    -- XPubs
    WebT m GetXPub
-> (GetXPub -> WebT m XPubSummary)
-> (Network -> XPubSummary -> Encoding)
-> (Network -> XPubSummary -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (XPubKey -> DeriveType -> NoCache -> GetXPub
GetXPub (XPubKey -> DeriveType -> NoCache -> GetXPub)
-> ActionT Except (ReaderT WebState m) XPubKey
-> ActionT
     Except (ReaderT WebState m) (DeriveType -> NoCache -> GetXPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT
  Except (ReaderT WebState m) (DeriveType -> NoCache -> GetXPub)
-> ActionT Except (ReaderT WebState m) DeriveType
-> ActionT Except (ReaderT WebState m) (NoCache -> GetXPub)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) DeriveType
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef ActionT Except (ReaderT WebState m) (NoCache -> GetXPub)
-> ActionT Except (ReaderT WebState m) NoCache -> WebT m GetXPub
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoCache
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        GetXPub -> WebT m XPubSummary
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPub -> WebT m XPubSummary
scottyXPub
        ((XPubSummary -> Encoding) -> Network -> XPubSummary -> Encoding
forall a b. a -> b -> a
const XPubSummary -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((XPubSummary -> Value) -> Network -> XPubSummary -> Value
forall a b. a -> b -> a
const XPubSummary -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetXPubTxs
-> (GetXPubTxs -> WebT m (SerialList TxRef))
-> (Network -> SerialList TxRef -> Encoding)
-> (Network -> SerialList TxRef -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxs
GetXPubTxs (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxs)
-> ActionT Except (ReaderT WebState m) XPubKey
-> ActionT
     Except
     (ReaderT WebState m)
     (DeriveType -> LimitsParam -> NoCache -> GetXPubTxs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT
  Except
  (ReaderT WebState m)
  (DeriveType -> LimitsParam -> NoCache -> GetXPubTxs)
-> ActionT Except (ReaderT WebState m) DeriveType
-> ActionT
     Except (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubTxs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) DeriveType
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef ActionT
  Except (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubTxs)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> ActionT Except (ReaderT WebState m) (NoCache -> GetXPubTxs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits ActionT Except (ReaderT WebState m) (NoCache -> GetXPubTxs)
-> ActionT Except (ReaderT WebState m) NoCache -> WebT m GetXPubTxs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoCache
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([TxRef] -> SerialList TxRef)
-> ActionT Except (ReaderT WebState m) [TxRef]
-> WebT m (SerialList TxRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [TxRef] -> SerialList TxRef
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [TxRef]
 -> WebT m (SerialList TxRef))
-> (GetXPubTxs -> ActionT Except (ReaderT WebState m) [TxRef])
-> GetXPubTxs
-> WebT m (SerialList TxRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubTxs -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubTxs -> WebT m [TxRef]
scottyXPubTxs)
        ((SerialList TxRef -> Encoding)
-> Network -> SerialList TxRef -> Encoding
forall a b. a -> b -> a
const SerialList TxRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((SerialList TxRef -> Value) -> Network -> SerialList TxRef -> Value
forall a b. a -> b -> a
const SerialList TxRef -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetXPubTxsFull
-> (GetXPubTxsFull -> WebT m (SerialList Transaction))
-> (Network -> SerialList Transaction -> Encoding)
-> (Network -> SerialList Transaction -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull
GetXPubTxsFull (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull)
-> ActionT Except (ReaderT WebState m) XPubKey
-> ActionT
     Except
     (ReaderT WebState m)
     (DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT
  Except
  (ReaderT WebState m)
  (DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull)
-> ActionT Except (ReaderT WebState m) DeriveType
-> ActionT
     Except
     (ReaderT WebState m)
     (LimitsParam -> NoCache -> GetXPubTxsFull)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) DeriveType
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef ActionT
  Except
  (ReaderT WebState m)
  (LimitsParam -> NoCache -> GetXPubTxsFull)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> ActionT Except (ReaderT WebState m) (NoCache -> GetXPubTxsFull)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits ActionT Except (ReaderT WebState m) (NoCache -> GetXPubTxsFull)
-> ActionT Except (ReaderT WebState m) NoCache
-> WebT m GetXPubTxsFull
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoCache
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([Transaction] -> SerialList Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
-> WebT m (SerialList Transaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Transaction] -> SerialList Transaction
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [Transaction]
 -> WebT m (SerialList Transaction))
-> (GetXPubTxsFull
    -> ActionT Except (ReaderT WebState m) [Transaction])
-> GetXPubTxsFull
-> WebT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubTxsFull -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubTxsFull -> WebT m [Transaction]
scottyXPubTxsFull)
        (\Network
n -> (Transaction -> Encoding) -> [Transaction] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> Transaction -> Encoding
transactionToEncoding Network
n) ([Transaction] -> Encoding)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> Transaction -> Value)
-> Network -> [Transaction] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> Transaction -> Value
transactionToJSON Network
n ([Transaction] -> Value)
-> (SerialList Transaction -> [Transaction])
-> SerialList Transaction
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList Transaction -> [Transaction]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetXPubBalances
-> (GetXPubBalances -> WebT m (SerialList XPubBal))
-> (Network -> SerialList XPubBal -> Encoding)
-> (Network -> SerialList XPubBal -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (XPubKey -> DeriveType -> NoCache -> GetXPubBalances
GetXPubBalances (XPubKey -> DeriveType -> NoCache -> GetXPubBalances)
-> ActionT Except (ReaderT WebState m) XPubKey
-> ActionT
     Except
     (ReaderT WebState m)
     (DeriveType -> NoCache -> GetXPubBalances)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT
  Except
  (ReaderT WebState m)
  (DeriveType -> NoCache -> GetXPubBalances)
-> ActionT Except (ReaderT WebState m) DeriveType
-> ActionT Except (ReaderT WebState m) (NoCache -> GetXPubBalances)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) DeriveType
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef ActionT Except (ReaderT WebState m) (NoCache -> GetXPubBalances)
-> ActionT Except (ReaderT WebState m) NoCache
-> WebT m GetXPubBalances
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoCache
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([XPubBal] -> SerialList XPubBal)
-> ActionT Except (ReaderT WebState m) [XPubBal]
-> WebT m (SerialList XPubBal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [XPubBal] -> SerialList XPubBal
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [XPubBal]
 -> WebT m (SerialList XPubBal))
-> (GetXPubBalances
    -> ActionT Except (ReaderT WebState m) [XPubBal])
-> GetXPubBalances
-> WebT m (SerialList XPubBal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubBalances -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubBalances -> WebT m [XPubBal]
scottyXPubBalances)
        (\Network
n -> (XPubBal -> Encoding) -> [XPubBal] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> XPubBal -> Encoding
xPubBalToEncoding Network
n) ([XPubBal] -> Encoding)
-> (SerialList XPubBal -> [XPubBal])
-> SerialList XPubBal
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList XPubBal -> [XPubBal]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> XPubBal -> Value) -> Network -> [XPubBal] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> XPubBal -> Value
xPubBalToJSON Network
n ([XPubBal] -> Value)
-> (SerialList XPubBal -> [XPubBal]) -> SerialList XPubBal -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList XPubBal -> [XPubBal]
forall a. SerialList a -> [a]
getSerialList)
    WebT m GetXPubUnspent
-> (GetXPubUnspent -> WebT m (SerialList XPubUnspent))
-> (Network -> SerialList XPubUnspent -> Encoding)
-> (Network -> SerialList XPubUnspent -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent
GetXPubUnspent (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent)
-> ActionT Except (ReaderT WebState m) XPubKey
-> ActionT
     Except
     (ReaderT WebState m)
     (DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT
  Except
  (ReaderT WebState m)
  (DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent)
-> ActionT Except (ReaderT WebState m) DeriveType
-> ActionT
     Except
     (ReaderT WebState m)
     (LimitsParam -> NoCache -> GetXPubUnspent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) DeriveType
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef ActionT
  Except
  (ReaderT WebState m)
  (LimitsParam -> NoCache -> GetXPubUnspent)
-> ActionT Except (ReaderT WebState m) LimitsParam
-> ActionT Except (ReaderT WebState m) (NoCache -> GetXPubUnspent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadIO m => WebT m LimitsParam
parseLimits ActionT Except (ReaderT WebState m) (NoCache -> GetXPubUnspent)
-> ActionT Except (ReaderT WebState m) NoCache
-> WebT m GetXPubUnspent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) NoCache
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        (([XPubUnspent] -> SerialList XPubUnspent)
-> ActionT Except (ReaderT WebState m) [XPubUnspent]
-> WebT m (SerialList XPubUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [XPubUnspent] -> SerialList XPubUnspent
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [XPubUnspent]
 -> WebT m (SerialList XPubUnspent))
-> (GetXPubUnspent
    -> ActionT Except (ReaderT WebState m) [XPubUnspent])
-> GetXPubUnspent
-> WebT m (SerialList XPubUnspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubUnspent -> ActionT Except (ReaderT WebState m) [XPubUnspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubUnspent -> WebT m [XPubUnspent]
scottyXPubUnspent)
        (\Network
n -> (XPubUnspent -> Encoding) -> [XPubUnspent] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> XPubUnspent -> Encoding
xPubUnspentToEncoding Network
n) ([XPubUnspent] -> Encoding)
-> (SerialList XPubUnspent -> [XPubUnspent])
-> SerialList XPubUnspent
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList XPubUnspent -> [XPubUnspent]
forall a. SerialList a -> [a]
getSerialList)
        (\Network
n -> (Network -> XPubUnspent -> Value)
-> Network -> [XPubUnspent] -> Value
forall a t a. ToJSON a => (t -> a -> a) -> t -> [a] -> Value
json_list Network -> XPubUnspent -> Value
xPubUnspentToJSON Network
n ([XPubUnspent] -> Value)
-> (SerialList XPubUnspent -> [XPubUnspent])
-> SerialList XPubUnspent
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialList XPubUnspent -> [XPubUnspent]
forall a. SerialList a -> [a]
getSerialList)
    WebT m DelCachedXPub
-> (DelCachedXPub -> WebT m (GenericResult Bool))
-> (Network -> GenericResult Bool -> Encoding)
-> (Network -> GenericResult Bool -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (XPubKey -> DeriveType -> DelCachedXPub
DelCachedXPub (XPubKey -> DeriveType -> DelCachedXPub)
-> ActionT Except (ReaderT WebState m) XPubKey
-> ActionT
     Except (ReaderT WebState m) (DeriveType -> DelCachedXPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy ActionT Except (ReaderT WebState m) (DeriveType -> DelCachedXPub)
-> ActionT Except (ReaderT WebState m) DeriveType
-> WebT m DelCachedXPub
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) DeriveType
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef)
        DelCachedXPub -> WebT m (GenericResult Bool)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
DelCachedXPub -> WebT m (GenericResult Bool)
scottyDelXPub
        ((GenericResult Bool -> Encoding)
-> Network -> GenericResult Bool -> Encoding
forall a b. a -> b -> a
const GenericResult Bool -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((GenericResult Bool -> Value)
-> Network -> GenericResult Bool -> Value
forall a b. a -> b -> a
const GenericResult Bool -> Value
forall a. ToJSON a => a -> Value
toJSON)
    -- Network
    WebT m GetPeers
-> (GetPeers -> WebT m (SerialList PeerInformation))
-> (Network -> SerialList PeerInformation -> Encoding)
-> (Network -> SerialList PeerInformation -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (GetPeers
GetPeers GetPeers -> (GetPeers -> WebT m GetPeers) -> WebT m GetPeers
forall a b. a -> (a -> b) -> b
& GetPeers -> WebT m GetPeers
forall (m :: * -> *) a. Monad m => a -> m a
return)
        (([PeerInformation] -> SerialList PeerInformation)
-> ActionT Except (ReaderT WebState m) [PeerInformation]
-> WebT m (SerialList PeerInformation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [PeerInformation] -> SerialList PeerInformation
forall a. [a] -> SerialList a
SerialList (ActionT Except (ReaderT WebState m) [PeerInformation]
 -> WebT m (SerialList PeerInformation))
-> (GetPeers
    -> ActionT Except (ReaderT WebState m) [PeerInformation])
-> GetPeers
-> WebT m (SerialList PeerInformation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPeers -> ActionT Except (ReaderT WebState m) [PeerInformation]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetPeers -> WebT m [PeerInformation]
scottyPeers)
        ((SerialList PeerInformation -> Encoding)
-> Network -> SerialList PeerInformation -> Encoding
forall a b. a -> b -> a
const SerialList PeerInformation -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((SerialList PeerInformation -> Value)
-> Network -> SerialList PeerInformation -> Value
forall a b. a -> b -> a
const SerialList PeerInformation -> Value
forall a. ToJSON a => a -> Value
toJSON)
    WebT m GetHealth
-> (GetHealth -> WebT m HealthCheck)
-> (Network -> HealthCheck -> Encoding)
-> (Network -> HealthCheck -> Value)
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact
        (GetHealth
GetHealth GetHealth -> (GetHealth -> WebT m GetHealth) -> WebT m GetHealth
forall a b. a -> (a -> b) -> b
& GetHealth -> WebT m GetHealth
forall (m :: * -> *) a. Monad m => a -> m a
return)
        GetHealth -> WebT m HealthCheck
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetHealth -> WebT m HealthCheck
scottyHealth
        ((HealthCheck -> Encoding) -> Network -> HealthCheck -> Encoding
forall a b. a -> b -> a
const HealthCheck -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding)
        ((HealthCheck -> Value) -> Network -> HealthCheck -> Value
forall a b. a -> b -> a
const HealthCheck -> Value
forall a. ToJSON a => a -> Value
toJSON)
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/events" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyEvents
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/dbstats" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyDbStats
    -- Blockchain.info
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.post RoutePattern
"/blockchain/multiaddr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyMultiAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/multiaddr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyMultiAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/balance" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyShortBal
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.post RoutePattern
"/blockchain/balance" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyShortBal
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/rawaddr/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyRawAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/address/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyRawAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/xpub/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyRawAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.post RoutePattern
"/blockchain/unspent" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoUnspent
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/unspent" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoUnspent
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/rawtx/:txid" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoTx
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/rawblock/:block" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoBlock
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/latestblock" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoLatest
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/unconfirmed-transactions" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoMempool
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/block-height/:height" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoBlockHeight
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/blocks/:milliseconds" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoBlocksDay
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/export-history" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoHistory
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.post RoutePattern
"/blockchain/export-history" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoHistory
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/addresstohash/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoAddrToHash
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/hashtoaddress/:hash" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoHashToAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/addrpubkey/:pubkey" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoAddrPubkey
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/pubkeyaddr/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoPubKeyAddr
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/hashpubkey/:pubkey" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoHashPubkey
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/getblockcount" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoGetBlockCount
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/latesthash" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoLatestHash
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/bcperblock" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoSubsidy
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/txtotalbtcoutput/:txid" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoTotalOut
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/txtotalbtcinput/:txid" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoTotalInput
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/txfee/:txid" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoTxFees
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/txresult/:txid/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoTxResult
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/getreceivedbyaddress/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoReceived
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/getsentbyaddress/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoSent
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/addressbalance/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoAddrBalance
    RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
RoutePattern -> ActionT e m () -> ScottyT e m ()
S.get RoutePattern
"/blockchain/q/addressfirstseen/:addr" ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyFirstSeen
  where
    json_list :: (t -> a -> a) -> t -> [a] -> Value
json_list t -> a -> a
f t
net = [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList ([a] -> Value) -> ([a] -> [a]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (t -> a -> a
f t
net)

pathCompact ::
    (ApiResource a b, MonadIO m) =>
    WebT m a ->
    (a -> WebT m b) ->
    (Network -> b -> Encoding) ->
    (Network -> b -> Value) ->
    S.ScottyT Except (ReaderT WebState m) ()
pathCompact :: WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact WebT m a
parser a -> WebT m b
action Network -> b -> Encoding
encJson Network -> b -> Value
encValue =
    WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> Bool
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> Bool
-> ScottyT Except (ReaderT WebState m) ()
pathCommon WebT m a
parser a -> WebT m b
action Network -> b -> Encoding
encJson Network -> b -> Value
encValue Bool
False

pathCommon ::
    (ApiResource a b, MonadIO m) =>
    WebT m a ->
    (a -> WebT m b) ->
    (Network -> b -> Encoding) ->
    (Network -> b -> Value) ->
    Bool ->
    S.ScottyT Except (ReaderT WebState m) ()
pathCommon :: WebT m a
-> (a -> WebT m b)
-> (Network -> b -> Encoding)
-> (Network -> b -> Value)
-> Bool
-> ScottyT Except (ReaderT WebState m) ()
pathCommon WebT m a
parser a -> WebT m b
action Network -> b -> Encoding
encJson Network -> b -> Value
encValue Bool
pretty =
    StdMethod
-> RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
S.addroute (Proxy a -> StdMethod
forall a b. ApiResource a b => Proxy a -> StdMethod
resourceMethod Proxy a
proxy) (Proxy a -> RoutePattern
forall a b. ApiResource a b => Proxy a -> RoutePattern
capturePath Proxy a
proxy) (ActionT Except (ReaderT WebState m) ()
 -> ScottyT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ do
        ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
        SerialAs
proto <- Bool -> ActionT Except (ReaderT WebState m) SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupContentType Bool
pretty
        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        a
apiRes <- WebT m a
parser
        b
res <- a -> WebT m b
action a
apiRes
        ByteString -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
S.raw (ByteString -> ActionT Except (ReaderT WebState m) ())
-> ByteString -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ SerialAs -> (b -> Encoding) -> (b -> Value) -> b -> ByteString
forall a.
Serial a =>
SerialAs -> (a -> Encoding) -> (a -> Value) -> a -> ByteString
protoSerial SerialAs
proto (Network -> b -> Encoding
encJson Network
net) (Network -> b -> Value
encValue Network
net) b
res
  where
    toProxy :: WebT m a -> Proxy a
    toProxy :: WebT m a -> Proxy a
toProxy = Proxy a -> WebT m a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall k (t :: k). Proxy t
Proxy
    proxy :: Proxy a
proxy = WebT m a -> Proxy a
forall (m :: * -> *) a. WebT m a -> Proxy a
toProxy WebT m a
parser

streamEncoding :: Monad m => Encoding -> WebT m ()
streamEncoding :: Encoding -> WebT m ()
streamEncoding Encoding
e = do
    Text -> Text -> WebT m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
S.setHeader Text
"Content-Type" Text
"application/json; charset=utf-8"
    ByteString -> WebT m ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
S.raw (Encoding -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString Encoding
e)

protoSerial ::
    Serial a =>
    SerialAs ->
    (a -> Encoding) ->
    (a -> Value) ->
    a ->
    L.ByteString
protoSerial :: SerialAs -> (a -> Encoding) -> (a -> Value) -> a -> ByteString
protoSerial SerialAs
SerialAsBinary a -> Encoding
_ a -> Value
_ = Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
protoSerial SerialAs
SerialAsJSON a -> Encoding
f a -> Value
_ = Encoding -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
f
protoSerial SerialAs
SerialAsPrettyJSON a -> Encoding
_ a -> Value
g =
    Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig{confTrailingNewline :: Bool
confTrailingNewline = Bool
True} (Value -> ByteString) -> (a -> Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
g

setHeaders :: (Monad m, S.ScottyError e) => ActionT e m ()
setHeaders :: ActionT e m ()
setHeaders = Text -> Text -> ActionT e m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
S.setHeader Text
"Access-Control-Allow-Origin" Text
"*"

waiExcept :: Status -> Except -> Response
waiExcept :: Status -> Except -> Response
waiExcept Status
s Except
e =
    Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
s ResponseHeaders
hs ByteString
e'
  where
    hs :: ResponseHeaders
hs =
        [ (HeaderName
"Access-Control-Allow-Origin", ByteString
"*")
        , (HeaderName
"Content-Type", ByteString
"application/json")
        ]
    e' :: ByteString
e' = Except -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Except
e

setupJSON :: Monad m => Bool -> ActionT Except m SerialAs
setupJSON :: Bool -> ActionT Except m SerialAs
setupJSON Bool
pretty = do
    Text -> Text -> ActionT Except m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
S.setHeader Text
"Content-Type" Text
"application/json"
    Bool
p <- Text -> ActionT Except m Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"pretty" ActionT Except m Bool
-> (Except -> ActionT Except m Bool) -> ActionT Except m Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except m Bool -> Except -> ActionT Except m Bool
forall a b. a -> b -> a
const (Bool -> ActionT Except m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
pretty)
    SerialAs -> ActionT Except m SerialAs
forall (m :: * -> *) a. Monad m => a -> m a
return (SerialAs -> ActionT Except m SerialAs)
-> SerialAs -> ActionT Except m SerialAs
forall a b. (a -> b) -> a -> b
$ if Bool
p then SerialAs
SerialAsPrettyJSON else SerialAs
SerialAsJSON

setupBinary :: Monad m => ActionT Except m SerialAs
setupBinary :: ActionT Except m SerialAs
setupBinary = do
    Text -> Text -> ActionT Except m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
S.setHeader Text
"Content-Type" Text
"application/octet-stream"
    SerialAs -> ActionT Except m SerialAs
forall (m :: * -> *) a. Monad m => a -> m a
return SerialAs
SerialAsBinary

setupContentType :: Monad m => Bool -> ActionT Except m SerialAs
setupContentType :: Bool -> ActionT Except m SerialAs
setupContentType Bool
pretty = do
    Maybe Text
accept <- Text -> ActionT Except m (Maybe Text)
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m (Maybe Text)
S.header Text
"accept"
    ActionT Except m SerialAs
-> (Text -> ActionT Except m SerialAs)
-> Maybe Text
-> ActionT Except m SerialAs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> ActionT Except m SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupJSON Bool
pretty) Text -> ActionT Except m SerialAs
forall a (m :: * -> *).
(Eq a, IsString a, Monad m) =>
a -> ActionT Except m SerialAs
setType Maybe Text
accept
  where
    setType :: a -> ActionT Except m SerialAs
setType a
"application/octet-stream" = ActionT Except m SerialAs
forall (m :: * -> *). Monad m => ActionT Except m SerialAs
setupBinary
    setType a
_ = Bool -> ActionT Except m SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupJSON Bool
pretty

-- GET Block / GET Blocks --

scottyBlock ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetBlock -> WebT m BlockData
scottyBlock :: GetBlock -> WebT m BlockData
scottyBlock (GetBlock BlockHash
h (NoTx Bool
noTx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m BlockData) -> WebT m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing ->
            Except -> WebT m BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            BlockData -> WebT m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> WebT m BlockData) -> BlockData -> WebT m BlockData
forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
noTx BlockData
b

getBlocks ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    [H.BlockHash] ->
    Bool ->
    WebT m [BlockData]
getBlocks :: [BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
hs Bool
notx =
    (Bool -> BlockData -> BlockData
pruneTx Bool
notx (BlockData -> BlockData) -> [BlockData] -> [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([BlockData] -> [BlockData])
-> ([Maybe BlockData] -> [BlockData])
-> [Maybe BlockData]
-> [BlockData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> WebT m [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock ([BlockHash] -> [BlockHash]
forall a. Eq a => [a] -> [a]
nub [BlockHash]
hs)

scottyBlocks ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetBlocks -> WebT m [BlockData]
scottyBlocks :: GetBlocks -> WebT m [BlockData]
scottyBlocks (GetBlocks [BlockHash]
hs (NoTx Bool
notx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    [BlockData]
bs <- [BlockHash] -> Bool -> WebT m [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
hs Bool
notx
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
bs)
    [BlockData] -> WebT m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
bs

pruneTx :: Bool -> BlockData -> BlockData
pruneTx :: Bool -> BlockData -> BlockData
pruneTx Bool
False BlockData
b = BlockData
b
pruneTx Bool
True BlockData
b = BlockData
b{blockDataTxs :: [TxHash]
blockDataTxs = Int -> [TxHash] -> [TxHash]
forall a. Int -> [a] -> [a]
take Int
1 (BlockData -> [TxHash]
blockDataTxs BlockData
b)}

-- GET BlockRaw --

scottyBlockRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockRaw ->
    WebT m (RawResult H.Block)
scottyBlockRaw :: GetBlockRaw -> WebT m (RawResult Block)
scottyBlockRaw (GetBlockRaw BlockHash
h) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
    Block
b <- BlockHash -> WebT m Block
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock BlockHash
h
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    RawResult Block -> WebT m (RawResult Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> WebT m (RawResult Block))
-> RawResult Block -> WebT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ Block -> RawResult Block
forall a. a -> RawResult a
RawResult Block
b

getRawBlock ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    H.BlockHash ->
    WebT m H.Block
getRawBlock :: BlockHash -> WebT m Block
getRawBlock BlockHash
h = do
    BlockData
b <- BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT Except (ReaderT WebState m) BlockData
-> (BlockData -> ActionT Except (ReaderT WebState m) BlockData)
-> Maybe BlockData
-> ActionT Except (ReaderT WebState m) BlockData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound) BlockData -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return
    ReaderT WebState m Block -> WebT m Block
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BlockData -> ReaderT WebState m Block
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
BlockData -> m Block
toRawBlock BlockData
b)

toRawBlock :: (MonadUnliftIO m, StoreReadBase m) => BlockData -> m H.Block
toRawBlock :: BlockData -> m Block
toRawBlock BlockData
b = do
    let ths :: [TxHash]
ths = BlockData -> [TxHash]
blockDataTxs BlockData
b
    [Tx]
txs <- (TxHash -> m Tx) -> [TxHash] -> m [Tx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> m Tx
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Tx
f [TxHash]
ths
    Block -> m Block
forall (m :: * -> *) a. Monad m => a -> m a
return Block :: BlockHeader -> [Tx] -> Block
H.Block{blockHeader :: BlockHeader
H.blockHeader = BlockData -> BlockHeader
blockDataHeader BlockData
b, blockTxns :: [Tx]
H.blockTxns = [Tx]
txs}
  where
    f :: TxHash -> m Tx
f TxHash
x = ((forall a. m a -> IO a) -> IO Tx) -> m Tx
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Tx) -> m Tx)
-> ((forall a. m a -> IO a) -> IO Tx) -> m Tx
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        IO Tx -> IO Tx
forall a. IO a -> IO a
unsafeInterleaveIO (IO Tx -> IO Tx) -> (m Tx -> IO Tx) -> m Tx -> IO Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Tx -> IO Tx
forall a. m a -> IO a
run (m Tx -> IO Tx) -> m Tx -> IO Tx
forall a b. (a -> b) -> a -> b
$
            TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x m (Maybe Transaction) -> (Maybe Transaction -> m Tx) -> m Tx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe Transaction
Nothing -> m Tx
forall a. HasCallStack => a
undefined
                Just Transaction
t -> Tx -> m Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> m Tx) -> Tx -> m Tx
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData Transaction
t

-- GET BlockBest / BlockBestRaw --

scottyBlockBest ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetBlockBest -> WebT m BlockData
scottyBlockBest :: GetBlockBest -> WebT m BlockData
scottyBlockBest (GetBlockBest (NoTx Bool
notx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash -> WebT m BlockData) -> WebT m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> Except -> WebT m BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockHash
bb ->
            BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bb ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m BlockData) -> WebT m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe BlockData
Nothing -> Except -> WebT m BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
                Just BlockData
b -> do
                    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
                    BlockData -> WebT m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> WebT m BlockData) -> BlockData -> WebT m BlockData
forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
notx BlockData
b

scottyBlockBestRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockBestRaw ->
    WebT m (RawResult H.Block)
scottyBlockBestRaw :: GetBlockBestRaw -> WebT m (RawResult Block)
scottyBlockBestRaw GetBlockBestRaw
_ = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
    ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash -> WebT m (RawResult Block))
-> WebT m (RawResult Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> Except -> WebT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockHash
bb -> do
            Block
b <- BlockHash -> WebT m Block
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock BlockHash
bb
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            RawResult Block -> WebT m (RawResult Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> WebT m (RawResult Block))
-> RawResult Block -> WebT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ Block -> RawResult Block
forall a. a -> RawResult a
RawResult Block
b

-- GET BlockLatest --

scottyBlockLatest ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockLatest ->
    WebT m [BlockData]
scottyBlockLatest :: GetBlockLatest -> WebT m [BlockData]
scottyBlockLatest (GetBlockLatest (NoTx Bool
noTx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    [BlockData]
blocks <-
        ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
            ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash -> WebT m [BlockData]) -> WebT m [BlockData]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WebT m [BlockData]
-> (BlockHash -> WebT m [BlockData])
-> Maybe BlockHash
-> WebT m [BlockData]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (Except -> WebT m [BlockData]
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound)
                ([BlockData] -> Maybe BlockData -> WebT m [BlockData]
forall (m :: * -> *).
StoreReadBase m =>
[BlockData] -> Maybe BlockData -> m [BlockData]
go [] (Maybe BlockData -> WebT m [BlockData])
-> (BlockHash
    -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> BlockHash
-> WebT m [BlockData]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
    [BlockData] -> WebT m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
blocks
  where
    go :: [BlockData] -> Maybe BlockData -> m [BlockData]
go [BlockData]
acc Maybe BlockData
Nothing = [BlockData] -> m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockData] -> m [BlockData]) -> [BlockData] -> m [BlockData]
forall a b. (a -> b) -> a -> b
$ [BlockData] -> [BlockData]
forall a. [a] -> [a]
reverse [BlockData]
acc
    go [BlockData]
acc (Just BlockData
b)
        | BlockData -> Word32
blockDataHeight BlockData
b Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0 = [BlockData] -> m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockData] -> m [BlockData]) -> [BlockData] -> m [BlockData]
forall a b. (a -> b) -> a -> b
$ [BlockData] -> [BlockData]
forall a. [a] -> [a]
reverse [BlockData]
acc
        | [BlockData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
99 = [BlockData] -> m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockData] -> m [BlockData])
-> ([BlockData] -> [BlockData]) -> [BlockData] -> m [BlockData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockData] -> [BlockData]
forall a. [a] -> [a]
reverse ([BlockData] -> m [BlockData]) -> [BlockData] -> m [BlockData]
forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
noTx BlockData
b BlockData -> [BlockData] -> [BlockData]
forall a. a -> [a] -> [a]
: [BlockData]
acc
        | Bool
otherwise = do
            let prev :: BlockHash
prev = BlockHeader -> BlockHash
H.prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
b)
            [BlockData] -> Maybe BlockData -> m [BlockData]
go (Bool -> BlockData -> BlockData
pruneTx Bool
noTx BlockData
b BlockData -> [BlockData] -> [BlockData]
forall a. a -> [a] -> [a]
: [BlockData]
acc) (Maybe BlockData -> m [BlockData])
-> m (Maybe BlockData) -> m [BlockData]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
prev

-- GET BlockHeight / BlockHeights / BlockHeightRaw --

scottyBlockHeight ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetBlockHeight -> WebT m [BlockData]
scottyBlockHeight :: GetBlockHeight -> WebT m [BlockData]
scottyBlockHeight (GetBlockHeight HeightParam
h (NoTx Bool
notx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    [BlockData]
blocks <- ([BlockHash] -> Bool -> WebT m [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
`getBlocks` Bool
notx) ([BlockHash] -> WebT m [BlockData])
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> WebT m [BlockData]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (HeightParam -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
h)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
    [BlockData] -> WebT m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
blocks

scottyBlockHeights ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockHeights ->
    WebT m [BlockData]
scottyBlockHeights :: GetBlockHeights -> WebT m [BlockData]
scottyBlockHeights (GetBlockHeights (HeightsParam [Natural]
heights) (NoTx Bool
notx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    [BlockHash]
bhs <- [[BlockHash]] -> [BlockHash]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BlockHash]] -> [BlockHash])
-> ActionT Except (ReaderT WebState m) [[BlockHash]]
-> ActionT Except (ReaderT WebState m) [BlockHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> ActionT Except (ReaderT WebState m) [BlockHash])
-> [Word32] -> ActionT Except (ReaderT WebState m) [[BlockHash]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32) -> [Natural] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural]
heights)
    [BlockData]
blocks <- [BlockHash] -> Bool -> WebT m [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
bhs Bool
notx
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
    [BlockData] -> WebT m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
blocks

scottyBlockHeightRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockHeightRaw ->
    WebT m (RawResultList H.Block)
scottyBlockHeightRaw :: GetBlockHeightRaw -> WebT m (RawResultList Block)
scottyBlockHeightRaw (GetBlockHeightRaw HeightParam
h) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
    [Block]
blocks <- (BlockHash -> ActionT Except (ReaderT WebState m) Block)
-> [BlockHash] -> ActionT Except (ReaderT WebState m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockHash -> ActionT Except (ReaderT WebState m) Block
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock ([BlockHash] -> ActionT Except (ReaderT WebState m) [Block])
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> ActionT Except (ReaderT WebState m) [Block]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (HeightParam -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
h)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Block] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
blocks)
    RawResultList Block -> WebT m (RawResultList Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResultList Block -> WebT m (RawResultList Block))
-> RawResultList Block -> WebT m (RawResultList Block)
forall a b. (a -> b) -> a -> b
$ [Block] -> RawResultList Block
forall a. [a] -> RawResultList a
RawResultList [Block]
blocks

-- GET BlockTime / BlockTimeRaw --

scottyBlockTime ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockTime ->
    WebT m BlockData
scottyBlockTime :: GetBlockTime -> WebT m BlockData
scottyBlockTime (GetBlockTime (TimeParam Word64
t) (NoTx Bool
notx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m BlockData) -> WebT m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> Except -> WebT m BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            BlockData -> WebT m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> WebT m BlockData) -> BlockData -> WebT m BlockData
forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
notx BlockData
b

scottyBlockMTP ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockMTP ->
    WebT m BlockData
scottyBlockMTP :: GetBlockMTP -> WebT m BlockData
scottyBlockMTP (GetBlockMTP (TimeParam Word64
t) (NoTx Bool
notx)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfterMTP Chain
ch Word64
t ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m BlockData) -> WebT m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> Except -> WebT m BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            BlockData -> WebT m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> WebT m BlockData) -> BlockData -> WebT m BlockData
forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
notx BlockData
b

scottyBlockTimeRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockTimeRaw ->
    WebT m (RawResult H.Block)
scottyBlockTimeRaw :: GetBlockTimeRaw -> WebT m (RawResult Block)
scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam Word64
t)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m (RawResult Block))
-> WebT m (RawResult Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> Except -> WebT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
            Block
raw <- ReaderT WebState m Block
-> ActionT Except (ReaderT WebState m) Block
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Block
 -> ActionT Except (ReaderT WebState m) Block)
-> ReaderT WebState m Block
-> ActionT Except (ReaderT WebState m) Block
forall a b. (a -> b) -> a -> b
$ BlockData -> ReaderT WebState m Block
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
BlockData -> m Block
toRawBlock BlockData
b
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            RawResult Block -> WebT m (RawResult Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> WebT m (RawResult Block))
-> RawResult Block -> WebT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ Block -> RawResult Block
forall a. a -> RawResult a
RawResult Block
raw

scottyBlockMTPRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetBlockMTPRaw ->
    WebT m (RawResult H.Block)
scottyBlockMTPRaw :: GetBlockMTPRaw -> WebT m (RawResult Block)
scottyBlockMTPRaw (GetBlockMTPRaw (TimeParam Word64
t)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfterMTP Chain
ch Word64
t ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m (RawResult Block))
-> WebT m (RawResult Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> Except -> WebT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
            Block
raw <- ReaderT WebState m Block
-> ActionT Except (ReaderT WebState m) Block
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Block
 -> ActionT Except (ReaderT WebState m) Block)
-> ReaderT WebState m Block
-> ActionT Except (ReaderT WebState m) Block
forall a b. (a -> b) -> a -> b
$ BlockData -> ReaderT WebState m Block
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
BlockData -> m Block
toRawBlock BlockData
b
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            RawResult Block -> WebT m (RawResult Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> WebT m (RawResult Block))
-> RawResult Block -> WebT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ Block -> RawResult Block
forall a. a -> RawResult a
RawResult Block
raw

-- GET Transactions --

scottyTx :: (MonadUnliftIO m, MonadLoggerIO m) => GetTx -> WebT m Transaction
scottyTx :: GetTx -> WebT m Transaction
scottyTx (GetTx TxHash
txid) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransaction
    TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
txid ActionT Except (ReaderT WebState m) (Maybe Transaction)
-> (Maybe Transaction -> WebT m Transaction) -> WebT m Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Transaction
Nothing -> Except -> WebT m Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just Transaction
tx -> do
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            Transaction -> WebT m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
tx

scottyTxs ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetTxs -> WebT m [Transaction]
scottyTxs :: GetTxs -> WebT m [Transaction]
scottyTxs (GetTxs [TxHash]
txids) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransaction
    [Transaction]
txs <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxHash]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, MonadUnliftIO m, StoreReadBase m) =>
TxHash -> t m (Maybe Transaction)
f ([TxHash] -> [TxHash]
forall a. Eq a => [a] -> [a]
nub [TxHash]
txids)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
    [Transaction] -> WebT m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
txs
  where
    f :: TxHash -> t m (Maybe Transaction)
f TxHash
x = m (Maybe Transaction) -> t m (Maybe Transaction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Transaction) -> t m (Maybe Transaction))
-> m (Maybe Transaction) -> t m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$
        ((forall a. m a -> IO a) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Maybe Transaction))
 -> m (Maybe Transaction))
-> ((forall a. m a -> IO a) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
            IO (Maybe Transaction) -> IO (Maybe Transaction)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe Transaction) -> IO (Maybe Transaction))
-> (m (Maybe Transaction) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
-> IO (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Transaction) -> IO (Maybe Transaction)
forall a. m a -> IO a
run (m (Maybe Transaction) -> IO (Maybe Transaction))
-> m (Maybe Transaction) -> IO (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$
                TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x

scottyTxRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetTxRaw -> WebT m (RawResult Tx)
scottyTxRaw :: GetTxRaw -> WebT m (RawResult Tx)
scottyTxRaw (GetTxRaw TxHash
txid) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionRaw
    TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
txid ActionT Except (ReaderT WebState m) (Maybe Transaction)
-> (Maybe Transaction -> WebT m (RawResult Tx))
-> WebT m (RawResult Tx)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Transaction
Nothing -> Except -> WebT m (RawResult Tx)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just Transaction
tx -> do
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            RawResult Tx -> WebT m (RawResult Tx)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Tx -> WebT m (RawResult Tx))
-> RawResult Tx -> WebT m (RawResult Tx)
forall a b. (a -> b) -> a -> b
$ Tx -> RawResult Tx
forall a. a -> RawResult a
RawResult (Transaction -> Tx
transactionData Transaction
tx)

scottyTxsRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetTxsRaw ->
    WebT m (RawResultList Tx)
scottyTxsRaw :: GetTxsRaw -> WebT m (RawResultList Tx)
scottyTxsRaw (GetTxsRaw [TxHash]
txids) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionRaw
    [Transaction]
txs <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxHash]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, MonadUnliftIO m, StoreReadBase m) =>
TxHash -> t m (Maybe Transaction)
f ([TxHash] -> [TxHash]
forall a. Eq a => [a] -> [a]
nub [TxHash]
txids)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
    RawResultList Tx -> WebT m (RawResultList Tx)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResultList Tx -> WebT m (RawResultList Tx))
-> RawResultList Tx -> WebT m (RawResultList Tx)
forall a b. (a -> b) -> a -> b
$ [Tx] -> RawResultList Tx
forall a. [a] -> RawResultList a
RawResultList ([Tx] -> RawResultList Tx) -> [Tx] -> RawResultList Tx
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData (Transaction -> Tx) -> [Transaction] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Transaction]
txs
  where
    f :: TxHash -> t m (Maybe Transaction)
f TxHash
x = m (Maybe Transaction) -> t m (Maybe Transaction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Transaction) -> t m (Maybe Transaction))
-> m (Maybe Transaction) -> t m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$
        ((forall a. m a -> IO a) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Maybe Transaction))
 -> m (Maybe Transaction))
-> ((forall a. m a -> IO a) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
            IO (Maybe Transaction) -> IO (Maybe Transaction)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe Transaction) -> IO (Maybe Transaction))
-> (m (Maybe Transaction) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
-> IO (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Transaction) -> IO (Maybe Transaction)
forall a. m a -> IO a
run (m (Maybe Transaction) -> IO (Maybe Transaction))
-> m (Maybe Transaction) -> IO (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$
                TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x

getTxsBlock ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    H.BlockHash ->
    WebT m [Transaction]
getTxsBlock :: BlockHash -> WebT m [Transaction]
getTxsBlock BlockHash
h =
    BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m [Transaction])
-> WebT m [Transaction]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> Except -> WebT m [Transaction]
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
            [Transaction]
txs <- (TxHash -> ActionT Except (ReaderT WebState m) Transaction)
-> [TxHash] -> WebT m [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ActionT Except (ReaderT WebState m) Transaction
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadTrans t, MonadUnliftIO m, StoreReadBase m) =>
TxHash -> t m Transaction
f (BlockData -> [TxHash]
blockDataTxs BlockData
b)
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
            [Transaction] -> WebT m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
txs
  where
    f :: TxHash -> t m Transaction
f TxHash
x = m Transaction -> t m Transaction
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Transaction -> t m Transaction)
-> m Transaction -> t m Transaction
forall a b. (a -> b) -> a -> b
$
        ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Transaction) -> m Transaction)
-> ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
            IO Transaction -> IO Transaction
forall a. IO a -> IO a
unsafeInterleaveIO (IO Transaction -> IO Transaction)
-> (m Transaction -> IO Transaction)
-> m Transaction
-> IO Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Transaction -> IO Transaction
forall a. m a -> IO a
run (m Transaction -> IO Transaction)
-> m Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
                TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x m (Maybe Transaction)
-> (Maybe Transaction -> m Transaction) -> m Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe Transaction
Nothing -> m Transaction
forall a. HasCallStack => a
undefined
                    Just Transaction
t -> Transaction -> m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t

scottyTxsBlock ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetTxsBlock ->
    WebT m [Transaction]
scottyTxsBlock :: GetTxsBlock -> WebT m [Transaction]
scottyTxsBlock (GetTxsBlock BlockHash
h) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionsBlock
    [Transaction]
txs <- BlockHash -> WebT m [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m [Transaction]
getTxsBlock BlockHash
h
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
    [Transaction] -> WebT m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
txs

scottyTxsBlockRaw ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetTxsBlockRaw ->
    WebT m (RawResultList Tx)
scottyTxsBlockRaw :: GetTxsBlockRaw -> WebT m (RawResultList Tx)
scottyTxsBlockRaw (GetTxsBlockRaw BlockHash
h) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionsBlockRaw
    [Tx]
txs <- (Transaction -> Tx) -> [Transaction] -> [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transaction -> Tx
transactionData ([Transaction] -> [Tx])
-> ActionT Except (ReaderT WebState m) [Transaction]
-> ActionT Except (ReaderT WebState m) [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockHash -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m [Transaction]
getTxsBlock BlockHash
h
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs)
    RawResultList Tx -> WebT m (RawResultList Tx)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResultList Tx -> WebT m (RawResultList Tx))
-> RawResultList Tx -> WebT m (RawResultList Tx)
forall a b. (a -> b) -> a -> b
$ [Tx] -> RawResultList Tx
forall a. [a] -> RawResultList a
RawResultList [Tx]
txs

-- GET TransactionAfterHeight --

scottyTxAfter ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetTxAfter ->
    WebT m (GenericResult (Maybe Bool))
scottyTxAfter :: GetTxAfter -> WebT m (GenericResult (Maybe Bool))
scottyTxAfter (GetTxAfter TxHash
txid HeightParam
height) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionAfter
    (Maybe Bool
result, Int
count) <- Word32
-> TxHash -> ActionT Except (ReaderT WebState m) (Maybe Bool, Int)
forall (m :: * -> *).
(MonadIO m, StoreReadBase m) =>
Word32 -> TxHash -> m (Maybe Bool, Int)
cbAfterHeight (HeightParam -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
height) TxHash
txid
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
count
    GenericResult (Maybe Bool) -> WebT m (GenericResult (Maybe Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericResult (Maybe Bool) -> WebT m (GenericResult (Maybe Bool)))
-> GenericResult (Maybe Bool)
-> WebT m (GenericResult (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Maybe Bool -> GenericResult (Maybe Bool)
forall a. a -> GenericResult a
GenericResult Maybe Bool
result

{- | Check if any of the ancestors of this transaction is a coinbase after the
 specified height. Returns 'Nothing' if answer cannot be computed before
 hitting limits.
-}
cbAfterHeight ::
    (MonadIO m, StoreReadBase m) =>
    H.BlockHeight ->
    TxHash ->
    m (Maybe Bool, Int)
cbAfterHeight :: Word32 -> TxHash -> m (Maybe Bool, Int)
cbAfterHeight Word32
height TxHash
txid =
    Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
forall (m :: * -> *).
StoreReadBase m =>
Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
n HashSet TxHash
forall a. HashSet a
HashSet.empty HashSet TxHash
forall a. HashSet a
HashSet.empty [TxHash
txid]
  where
    n :: Int
n = Int
10000
    inputs :: Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
0 HashSet TxHash
_ HashSet TxHash
_ [] = (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool
forall a. Maybe a
Nothing, Int
10000)
    inputs Int
i HashSet TxHash
is HashSet TxHash
ns [] =
        let is' :: HashSet TxHash
is' = HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet TxHash
is HashSet TxHash
ns
            ns' :: HashSet a
ns' = HashSet a
forall a. HashSet a
HashSet.empty
            ts :: [TxHash]
ts = HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList (HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
ns HashSet TxHash
is)
         in case [TxHash]
ts of
                [] -> (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
                [TxHash]
_ -> Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
i HashSet TxHash
is' HashSet TxHash
forall a. HashSet a
ns' [TxHash]
ts
    inputs Int
i HashSet TxHash
is HashSet TxHash
ns (TxHash
t : [TxHash]
ts) =
        TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
t m (Maybe Transaction)
-> (Maybe Transaction -> m (Maybe Bool, Int))
-> m (Maybe Bool, Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Transaction
Nothing -> (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool
forall a. Maybe a
Nothing, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
            Just Transaction
tx
                | Transaction -> Bool
height_check Transaction
tx ->
                    if Transaction -> Bool
cb_check Transaction
tx
                        then (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        else
                            let ns' :: HashSet TxHash
ns' = HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union (Transaction -> HashSet TxHash
ins Transaction
tx) HashSet TxHash
ns
                             in Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) HashSet TxHash
is HashSet TxHash
ns' [TxHash]
ts
                | Bool
otherwise -> Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) HashSet TxHash
is HashSet TxHash
ns [TxHash]
ts
    cb_check :: Transaction -> Bool
cb_check = (StoreInput -> Bool) -> [StoreInput] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StoreInput -> Bool
isCoinbase ([StoreInput] -> Bool)
-> (Transaction -> [StoreInput]) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [StoreInput]
transactionInputs
    ins :: Transaction -> HashSet TxHash
ins = [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> (Transaction -> [TxHash]) -> Transaction -> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> TxHash) -> [StoreInput] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (OutPoint -> TxHash
outPointHash (OutPoint -> TxHash)
-> (StoreInput -> OutPoint) -> StoreInput -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreInput -> OutPoint
inputPoint) ([StoreInput] -> [TxHash])
-> (Transaction -> [StoreInput]) -> Transaction -> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [StoreInput]
transactionInputs
    height_check :: Transaction -> Bool
height_check Transaction
tx =
        case Transaction -> BlockRef
transactionBlock Transaction
tx of
            BlockRef Word32
h Word32
_ -> Word32
h Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
height
            BlockRef
_ -> Bool
True

-- POST Transaction --

scottyPostTx :: (MonadUnliftIO m, MonadLoggerIO m) => PostTx -> WebT m TxId
scottyPostTx :: PostTx -> WebT m TxId
scottyPostTx (PostTx Tx
tx) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionPost
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    ReaderT WebState m WebConfig
-> ActionT Except (ReaderT WebState m) WebConfig
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> WebConfig) -> ReaderT WebState m WebConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> WebConfig
webConfig) ActionT Except (ReaderT WebState m) WebConfig
-> (WebConfig -> WebT m TxId) -> WebT m TxId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WebConfig
cfg ->
        ReaderT WebState m (Either PubExcept ())
-> ActionT Except (ReaderT WebState m) (Either PubExcept ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WebConfig -> Tx -> ReaderT WebState m (Either PubExcept ())
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> Tx -> m (Either PubExcept ())
publishTx WebConfig
cfg Tx
tx) ActionT Except (ReaderT WebState m) (Either PubExcept ())
-> (Either PubExcept () -> WebT m TxId) -> WebT m TxId
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right () -> TxId -> WebT m TxId
forall (m :: * -> *) a. Monad m => a -> m a
return (TxHash -> TxId
TxId (Tx -> TxHash
txHash Tx
tx))
            Left e :: PubExcept
e@(PubReject RejectCode
_) -> Except -> WebT m TxId
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> WebT m TxId) -> Except -> WebT m TxId
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError (PubExcept -> String
forall a. Show a => a -> String
show PubExcept
e)
            Either PubExcept ()
_ -> Except -> WebT m TxId
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ServerError

-- | Publish a new transaction to the network.
publishTx ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    WebConfig ->
    Tx ->
    m (Either PubExcept ())
publishTx :: WebConfig -> Tx -> m (Either PubExcept ())
publishTx WebConfig
cfg Tx
tx =
    Publisher StoreEvent
-> (Inbox StoreEvent -> m (Either PubExcept ()))
-> m (Either PubExcept ())
forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub ((Inbox StoreEvent -> m (Either PubExcept ()))
 -> m (Either PubExcept ()))
-> (Inbox StoreEvent -> m (Either PubExcept ()))
-> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
s ->
        TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (Tx -> TxHash
txHash Tx
tx) m (Maybe Transaction)
-> (Maybe Transaction -> m (Either PubExcept ()))
-> m (Either PubExcept ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just Transaction
_ -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ () -> Either PubExcept ()
forall a b. b -> Either a b
Right ()
            Maybe Transaction
Nothing -> Inbox StoreEvent -> m (Either PubExcept ())
forall (m :: * -> *) (mbox :: * -> *).
(MonadIO m, InChan mbox) =>
mbox StoreEvent -> m (Either PubExcept ())
go Inbox StoreEvent
s
  where
    pub :: Publisher StoreEvent
pub = Store -> Publisher StoreEvent
storePublisher (WebConfig -> Store
webStore WebConfig
cfg)
    mgr :: PeerManager
mgr = Store -> PeerManager
storeManager (WebConfig -> Store
webStore WebConfig
cfg)
    net :: Network
net = Store -> Network
storeNetwork (WebConfig -> Store
webStore WebConfig
cfg)
    go :: mbox StoreEvent -> m (Either PubExcept ())
go mbox StoreEvent
s =
        PeerManager -> m [OnlinePeer]
forall (m :: * -> *). MonadIO m => PeerManager -> m [OnlinePeer]
getPeers PeerManager
mgr m [OnlinePeer]
-> ([OnlinePeer] -> m (Either PubExcept ()))
-> m (Either PubExcept ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            [] -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ PubExcept -> Either PubExcept ()
forall a b. a -> Either a b
Left PubExcept
PubNoPeers
            OnlinePeer{onlinePeerMailbox :: OnlinePeer -> Peer
onlinePeerMailbox = Peer
p} : [OnlinePeer]
_ -> do
                Tx -> Message
MTx Tx
tx Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
`sendMessage` Peer
p
                let v :: InvType
v =
                        if Network -> Bool
getSegWit Network
net
                            then InvType
InvWitnessTx
                            else InvType
InvTx
                Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
sendMessage
                    (GetData -> Message
MGetData ([InvVector] -> GetData
GetData [InvType -> Hash256 -> InvVector
InvVector InvType
v (TxHash -> Hash256
getTxHash (Tx -> TxHash
txHash Tx
tx))]))
                    Peer
p
                Peer -> mbox StoreEvent -> m (Either PubExcept ())
forall (m :: * -> *) (mbox :: * -> *).
(MonadIO m, InChan mbox) =>
Peer -> mbox StoreEvent -> m (Either PubExcept ())
f Peer
p mbox StoreEvent
s
    t :: Int
t = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
    f :: Peer -> mbox StoreEvent -> m (Either PubExcept ())
f Peer
p mbox StoreEvent
s
        | WebConfig -> Bool
webNoMempool WebConfig
cfg = Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ () -> Either PubExcept ()
forall a b. b -> Either a b
Right ()
        | Bool
otherwise =
            IO (Maybe (Either PubExcept ())) -> m (Maybe (Either PubExcept ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO (Either PubExcept ()) -> IO (Maybe (Either PubExcept ()))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
t (Peer -> mbox StoreEvent -> IO (Either PubExcept ())
forall (m :: * -> *) (mbox :: * -> *).
(InChan mbox, MonadIO m) =>
Peer -> mbox StoreEvent -> m (Either PubExcept ())
g Peer
p mbox StoreEvent
s)) m (Maybe (Either PubExcept ()))
-> (Maybe (Either PubExcept ()) -> m (Either PubExcept ()))
-> m (Either PubExcept ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe (Either PubExcept ())
Nothing -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ PubExcept -> Either PubExcept ()
forall a b. a -> Either a b
Left PubExcept
PubTimeout
                Just (Left PubExcept
e) -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ PubExcept -> Either PubExcept ()
forall a b. a -> Either a b
Left PubExcept
e
                Just (Right ()) -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ () -> Either PubExcept ()
forall a b. b -> Either a b
Right ()
    g :: Peer -> mbox StoreEvent -> m (Either PubExcept ())
g Peer
p mbox StoreEvent
s =
        mbox StoreEvent -> m StoreEvent
forall (mbox :: * -> *) (m :: * -> *) msg.
(InChan mbox, MonadIO m) =>
mbox msg -> m msg
receive mbox StoreEvent
s m StoreEvent
-> (StoreEvent -> m (Either PubExcept ()))
-> m (Either PubExcept ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            StoreTxReject Peer
p' TxHash
h' RejectCode
c ByteString
_
                | Peer
p Peer -> Peer -> Bool
forall a. Eq a => a -> a -> Bool
== Peer
p' Bool -> Bool -> Bool
&& TxHash
h' TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== Tx -> TxHash
txHash Tx
tx -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> (PubExcept -> Either PubExcept ())
-> PubExcept
-> m (Either PubExcept ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubExcept -> Either PubExcept ()
forall a b. a -> Either a b
Left (PubExcept -> m (Either PubExcept ()))
-> PubExcept -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ RejectCode -> PubExcept
PubReject RejectCode
c
            StorePeerDisconnected Peer
p'
                | Peer
p Peer -> Peer -> Bool
forall a. Eq a => a -> a -> Bool
== Peer
p' -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ PubExcept -> Either PubExcept ()
forall a b. a -> Either a b
Left PubExcept
PubPeerDisconnected
            StoreMempoolNew TxHash
h'
                | TxHash
h' TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== Tx -> TxHash
txHash Tx
tx -> Either PubExcept () -> m (Either PubExcept ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PubExcept () -> m (Either PubExcept ()))
-> Either PubExcept () -> m (Either PubExcept ())
forall a b. (a -> b) -> a -> b
$ () -> Either PubExcept ()
forall a b. b -> Either a b
Right ()
            StoreEvent
_ -> Peer -> mbox StoreEvent -> m (Either PubExcept ())
g Peer
p mbox StoreEvent
s

-- GET Mempool / Events --

scottyMempool ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetMempool -> WebT m [TxHash]
scottyMempool :: GetMempool -> WebT m [TxHash]
scottyMempool (GetMempool Maybe LimitParam
limitM (OffsetParam Natural
o)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statMempool
    WebLimits
wl <- ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m WebLimits
 -> ActionT Except (ReaderT WebState m) WebLimits)
-> ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall a b. (a -> b) -> a -> b
$ (WebState -> WebLimits) -> ReaderT WebState m WebLimits
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebConfig -> WebLimits
webMaxLimits (WebConfig -> WebLimits)
-> (WebState -> WebConfig) -> WebState -> WebLimits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    let wl' :: WebLimits
wl' = WebLimits
wl{maxLimitCount :: Word32
maxLimitCount = Word32
0}
        l :: Limits
l = Word32 -> Word32 -> Maybe Start -> Limits
Limits (WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit WebLimits
wl' Bool
False Maybe LimitParam
limitM) (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
o) Maybe Start
forall a. Maybe a
Nothing
    [TxHash]
ths <- ((Word64, TxHash) -> TxHash) -> [(Word64, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(Word64, TxHash)] -> [TxHash])
-> ([(Word64, TxHash)] -> [(Word64, TxHash)])
-> [(Word64, TxHash)]
-> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Limits -> [(Word64, TxHash)] -> [(Word64, TxHash)]
forall a. Limits -> [a] -> [a]
applyLimits Limits
l ([(Word64, TxHash)] -> [TxHash])
-> ActionT Except (ReaderT WebState m) [(Word64, TxHash)]
-> WebT m [TxHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxHash] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxHash]
ths)
    [TxHash] -> WebT m [TxHash]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxHash]
ths

webSocketEvents :: WebState -> Middleware
webSocketEvents :: WebState -> Middleware
webSocketEvents WebState
s =
    ConnectionOptions -> ServerApp -> Middleware
websocketsOr ConnectionOptions
defaultConnectionOptions ServerApp
events
  where
    pub :: Publisher StoreEvent
pub = (Store -> Publisher StoreEvent
storePublisher (Store -> Publisher StoreEvent)
-> (WebState -> Store) -> WebState -> Publisher StoreEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig) WebState
s
    gauge :: Maybe Gauge
gauge = WebMetrics -> Gauge
statEvents (WebMetrics -> Gauge) -> Maybe WebMetrics -> Maybe Gauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebState -> Maybe WebMetrics
webMetrics WebState
s
    events :: ServerApp
events PendingConnection
pending = Publisher StoreEvent -> (Inbox StoreEvent -> IO ()) -> IO ()
forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub ((Inbox StoreEvent -> IO ()) -> IO ())
-> (Inbox StoreEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
sub -> do
        let path :: ByteString
path = RequestHead -> ByteString
requestPath (RequestHead -> ByteString) -> RequestHead -> ByteString
forall a b. (a -> b) -> a -> b
$ PendingConnection -> RequestHead
pendingRequest PendingConnection
pending
        if ByteString
path ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"/events"
            then do
                Connection
conn <- PendingConnection -> IO Connection
acceptRequest PendingConnection
pending
                IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    Inbox StoreEvent -> IO (Maybe Event)
receiveEvent Inbox StoreEvent
sub IO (Maybe Event) -> (Maybe Event -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Maybe Event
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just Event
event -> Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
conn (Event -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Event
event)
            else
                PendingConnection -> RejectRequest -> IO ()
rejectRequestWith
                    PendingConnection
pending
                    RejectRequest
WebSockets.defaultRejectRequest
                        { rejectBody :: ByteString
WebSockets.rejectBody = ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Except -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Except
ThingNotFound
                        , rejectCode :: Int
WebSockets.rejectCode = Int
404
                        , rejectMessage :: ByteString
WebSockets.rejectMessage = ByteString
"Not Found"
                        , rejectHeaders :: ResponseHeaders
WebSockets.rejectHeaders = [(HeaderName
"Content-Type", ByteString
"application/json")]
                        }

scottyEvents :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyEvents :: WebT m ()
scottyEvents =
    (WebMetrics -> Gauge) -> WebT m () -> WebT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> Gauge) -> WebT m a -> WebT m a
withGaugeIncrease WebMetrics -> Gauge
statEvents (WebT m () -> WebT m ()) -> WebT m () -> WebT m ()
forall a b. (a -> b) -> a -> b
$ do
        WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
        SerialAs
proto <- Bool -> ActionT Except (ReaderT WebState m) SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupContentType Bool
False
        Publisher StoreEvent
pub <- ReaderT WebState m (Publisher StoreEvent)
-> ActionT Except (ReaderT WebState m) (Publisher StoreEvent)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Publisher StoreEvent)
 -> ActionT Except (ReaderT WebState m) (Publisher StoreEvent))
-> ReaderT WebState m (Publisher StoreEvent)
-> ActionT Except (ReaderT WebState m) (Publisher StoreEvent)
forall a b. (a -> b) -> a -> b
$ (WebState -> Publisher StoreEvent)
-> ReaderT WebState m (Publisher StoreEvent)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Publisher StoreEvent
storePublisher (Store -> Publisher StoreEvent)
-> (WebState -> Store) -> WebState -> Publisher StoreEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        StreamingBody -> WebT m ()
forall (m :: * -> *) e. Monad m => StreamingBody -> ActionT e m ()
S.stream (StreamingBody -> WebT m ()) -> StreamingBody -> WebT m ()
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
io IO ()
flush' ->
            Publisher StoreEvent -> (Inbox StoreEvent -> IO ()) -> IO ()
forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub ((Inbox StoreEvent -> IO ()) -> IO ())
-> (Inbox StoreEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
sub ->
                IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    IO ()
flush' IO () -> IO (Maybe Event) -> IO (Maybe Event)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inbox StoreEvent -> IO (Maybe Event)
receiveEvent Inbox StoreEvent
sub IO (Maybe Event) -> (Maybe Event -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (Event -> IO ()) -> Maybe Event -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Builder -> IO ()
io (Builder -> IO ()) -> (Event -> Builder) -> Event -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialAs -> Event -> Builder
forall a. (Serial a, ToJSON a) => SerialAs -> a -> Builder
serial SerialAs
proto)
  where
    serial :: SerialAs -> a -> Builder
serial SerialAs
proto a
e =
        ByteString -> Builder
lazyByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ SerialAs -> (a -> Encoding) -> (a -> Value) -> a -> ByteString
forall a.
Serial a =>
SerialAs -> (a -> Encoding) -> (a -> Value) -> a -> ByteString
protoSerial SerialAs
proto a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding a -> Value
forall a. ToJSON a => a -> Value
toJSON a
e ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SerialAs -> ByteString
forall p. (Monoid p, IsString p) => SerialAs -> p
newLine SerialAs
proto
    newLine :: SerialAs -> p
newLine SerialAs
SerialAsBinary = p
forall a. Monoid a => a
mempty
    newLine SerialAs
SerialAsJSON = p
"\n"
    newLine SerialAs
SerialAsPrettyJSON = p
forall a. Monoid a => a
mempty

receiveEvent :: Inbox StoreEvent -> IO (Maybe Event)
receiveEvent :: Inbox StoreEvent -> IO (Maybe Event)
receiveEvent Inbox StoreEvent
sub =
    StoreEvent -> Maybe Event
go (StoreEvent -> Maybe Event) -> IO StoreEvent -> IO (Maybe Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Inbox StoreEvent -> IO StoreEvent
forall (mbox :: * -> *) (m :: * -> *) msg.
(InChan mbox, MonadIO m) =>
mbox msg -> m msg
receive Inbox StoreEvent
sub
  where
    go :: StoreEvent -> Maybe Event
go = \case
        StoreBestBlock BlockHash
b -> Event -> Maybe Event
forall a. a -> Maybe a
Just (BlockHash -> Event
EventBlock BlockHash
b)
        StoreMempoolNew TxHash
t -> Event -> Maybe Event
forall a. a -> Maybe a
Just (TxHash -> Event
EventTx TxHash
t)
        StoreMempoolDelete TxHash
t -> Event -> Maybe Event
forall a. a -> Maybe a
Just (TxHash -> Event
EventTx TxHash
t)
        StoreEvent
_ -> Maybe Event
forall a. Maybe a
Nothing

-- GET Address Transactions --

scottyAddrTxs ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetAddrTxs -> WebT m [TxRef]
scottyAddrTxs :: GetAddrTxs -> WebT m [TxRef]
scottyAddrTxs (GetAddrTxs Address
addr LimitsParam
pLimits) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressTransactions
    [TxRef]
txs <- Address -> Limits -> WebT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr (Limits -> WebT m [TxRef])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
    [TxRef] -> WebT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs

scottyAddrsTxs ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsTxs -> WebT m [TxRef]
scottyAddrsTxs :: GetAddrsTxs -> WebT m [TxRef]
scottyAddrsTxs (GetAddrsTxs [Address]
addrs LimitsParam
pLimits) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressTransactions
    [TxRef]
txs <- [Address] -> Limits -> WebT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs (Limits -> WebT m [TxRef])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
    [TxRef] -> WebT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs

scottyAddrTxsFull ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetAddrTxsFull ->
    WebT m [Transaction]
scottyAddrTxsFull :: GetAddrTxsFull -> WebT m [Transaction]
scottyAddrTxsFull (GetAddrTxsFull Address
addr LimitsParam
pLimits) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressTransactionsFull
    [TxRef]
txs <- Address -> Limits -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr (Limits -> ActionT Except (ReaderT WebState m) [TxRef])
-> ActionT Except (ReaderT WebState m) Limits
-> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
True LimitsParam
pLimits
    [Transaction]
ts <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxRef -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxRef]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxRef -> TxHash
txRefHash) [TxRef]
txs
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts)
    [Transaction] -> WebT m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
ts

scottyAddrsTxsFull ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetAddrsTxsFull ->
    WebT m [Transaction]
scottyAddrsTxsFull :: GetAddrsTxsFull -> WebT m [Transaction]
scottyAddrsTxsFull (GetAddrsTxsFull [Address]
addrs LimitsParam
pLimits) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressTransactionsFull
    [TxRef]
txs <- [Address] -> Limits -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs (Limits -> ActionT Except (ReaderT WebState m) [TxRef])
-> ActionT Except (ReaderT WebState m) Limits
-> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
True LimitsParam
pLimits
    [Transaction]
ts <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxRef -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxRef]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxRef -> TxHash
txRefHash) [TxRef]
txs
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts)
    [Transaction] -> WebT m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
ts

scottyAddrBalance ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetAddrBalance ->
    WebT m Balance
scottyAddrBalance :: GetAddrBalance -> WebT m Balance
scottyAddrBalance (GetAddrBalance Address
addr) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressBalance
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Address -> WebT m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
addr

scottyAddrsBalance ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsBalance -> WebT m [Balance]
scottyAddrsBalance :: GetAddrsBalance -> WebT m [Balance]
scottyAddrsBalance (GetAddrsBalance [Address]
addrs) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressBalance
    [Balance]
balances <- [Address] -> WebT m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances [Address]
addrs
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Balance] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Balance]
balances)
    [Balance] -> WebT m [Balance]
forall (m :: * -> *) a. Monad m => a -> m a
return [Balance]
balances

scottyAddrUnspent ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetAddrUnspent -> WebT m [Unspent]
scottyAddrUnspent :: GetAddrUnspent -> WebT m [Unspent]
scottyAddrUnspent (GetAddrUnspent Address
addr LimitsParam
pLimits) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressUnspent
    [Unspent]
unspents <- Address -> Limits -> WebT m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
addr (Limits -> WebT m [Unspent])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [Unspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Unspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
unspents)
    [Unspent] -> WebT m [Unspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
unspents

scottyAddrsUnspent ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsUnspent -> WebT m [Unspent]
scottyAddrsUnspent :: GetAddrsUnspent -> WebT m [Unspent]
scottyAddrsUnspent (GetAddrsUnspent [Address]
addrs LimitsParam
pLimits) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statAddressUnspent
    [Unspent]
unspents <- [Address] -> Limits -> WebT m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
addrs (Limits -> WebT m [Unspent])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [Unspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Unspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
unspents)
    [Unspent] -> WebT m [Unspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
unspents

-- GET XPubs --

scottyXPub ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetXPub -> WebT m XPubSummary
scottyXPub :: GetXPub -> WebT m XPubSummary
scottyXPub (GetXPub XPubKey
xpub DeriveType
deriv (NoCache Bool
noCache)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpub
    let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
    [XPubBal]
xbals <- ReaderT WebState m [XPubBal]
-> ActionT Except (ReaderT WebState m) [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubBal]
 -> ActionT Except (ReaderT WebState m) [XPubBal])
-> (ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal])
-> ReaderT WebState m [XPubBal]
-> ActionT Except (ReaderT WebState m) [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache (ReaderT WebState m [XPubBal]
 -> ActionT Except (ReaderT WebState m) [XPubBal])
-> ReaderT WebState m [XPubBal]
-> ActionT Except (ReaderT WebState m) [XPubBal]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> ReaderT WebState m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
    XPubSummary -> WebT m XPubSummary
forall (m :: * -> *) a. Monad m => a -> m a
return (XPubSummary -> WebT m XPubSummary)
-> XPubSummary -> WebT m XPubSummary
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary XPubSpec
xspec [XPubBal]
xbals

scottyDelXPub ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    DelCachedXPub ->
    WebT m (GenericResult Bool)
scottyDelXPub :: DelCachedXPub -> WebT m (GenericResult Bool)
scottyDelXPub (DelCachedXPub XPubKey
xpub DeriveType
deriv) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpubDelete
    let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
    Maybe CacheConfig
cacheM <- ReaderT WebState m (Maybe CacheConfig)
-> ActionT Except (ReaderT WebState m) (Maybe CacheConfig)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Maybe CacheConfig)
-> ReaderT WebState m (Maybe CacheConfig)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Maybe CacheConfig
storeCache (Store -> Maybe CacheConfig)
-> (WebState -> Store) -> WebState -> Maybe CacheConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
    Integer
n <- ReaderT WebState m Integer
-> ActionT Except (ReaderT WebState m) Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Integer
 -> ActionT Except (ReaderT WebState m) Integer)
-> ReaderT WebState m Integer
-> ActionT Except (ReaderT WebState m) Integer
forall a b. (a -> b) -> a -> b
$ Maybe CacheConfig
-> CacheT (ReaderT WebState m) Integer
-> ReaderT WebState m Integer
forall (m :: * -> *) a.
StoreReadBase m =>
Maybe CacheConfig -> CacheT m a -> m a
withCache Maybe CacheConfig
cacheM ([XPubSpec] -> CacheT (ReaderT WebState m) Integer
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheT m Integer
cacheDelXPubs [XPubSpec
xspec])
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
    GenericResult Bool -> WebT m (GenericResult Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> GenericResult Bool
forall a. a -> GenericResult a
GenericResult (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0))

getXPubTxs ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    XPubKey ->
    DeriveType ->
    LimitsParam ->
    Bool ->
    WebT m [TxRef]
getXPubTxs :: XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache = do
    Limits
limits <- Bool -> LimitsParam -> WebT m Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
plimits
    let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
    [XPubBal]
xbals <- XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
    [TxRef]
txs <- ReaderT WebState m [TxRef] -> WebT m [TxRef]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> WebT m [TxRef])
-> (ReaderT WebState m [TxRef] -> ReaderT WebState m [TxRef])
-> ReaderT WebState m [TxRef]
-> WebT m [TxRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ReaderT WebState m [TxRef] -> ReaderT WebState m [TxRef]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
nocache (ReaderT WebState m [TxRef] -> WebT m [TxRef])
-> ReaderT WebState m [TxRef] -> WebT m [TxRef]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
xspec [XPubBal]
xbals Limits
limits
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
    [TxRef] -> WebT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs

scottyXPubTxs ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetXPubTxs -> WebT m [TxRef]
scottyXPubTxs :: GetXPubTxs -> WebT m [TxRef]
scottyXPubTxs (GetXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits (NoCache Bool
nocache)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpubTransactions
    [TxRef]
txs <- XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
    [TxRef] -> WebT m [TxRef]
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
txs

scottyXPubTxsFull ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetXPubTxsFull ->
    WebT m [Transaction]
scottyXPubTxsFull :: GetXPubTxsFull -> WebT m [Transaction]
scottyXPubTxsFull (GetXPubTxsFull XPubKey
xpub DeriveType
deriv LimitsParam
plimits (NoCache Bool
nocache)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpubTransactionsFull
    [TxRef]
refs <- XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache
    [Transaction]
txs <-
        ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes (ActionT Except (ReaderT WebState m) [Maybe Transaction]
 -> WebT m [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall a b. (a -> b) -> a -> b
$
            ReaderT WebState m [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Maybe Transaction]
 -> ActionT Except (ReaderT WebState m) [Maybe Transaction])
-> (ReaderT WebState m [Maybe Transaction]
    -> ReaderT WebState m [Maybe Transaction])
-> ReaderT WebState m [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT WebState m [Maybe Transaction]
-> ReaderT WebState m [Maybe Transaction]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
nocache (ReaderT WebState m [Maybe Transaction]
 -> ActionT Except (ReaderT WebState m) [Maybe Transaction])
-> ReaderT WebState m [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall a b. (a -> b) -> a -> b
$
                (TxRef -> ReaderT WebState m (Maybe Transaction))
-> [TxRef] -> ReaderT WebState m [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxHash -> ReaderT WebState m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ReaderT WebState m (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ReaderT WebState m (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxRef -> TxHash
txRefHash) [TxRef]
refs
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
    [Transaction] -> WebT m [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
txs

scottyXPubBalances ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetXPubBalances -> WebT m [XPubBal]
scottyXPubBalances :: GetXPubBalances -> WebT m [XPubBal]
scottyXPubBalances (GetXPubBalances XPubKey
xpub DeriveType
deriv (NoCache Bool
noCache)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpubBalances
    [XPubBal]
balances <- (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
f ([XPubBal] -> [XPubBal]) -> WebT m [XPubBal] -> WebT m [XPubBal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m [XPubBal] -> WebT m [XPubBal]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Bool
-> ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache (XPubSpec -> ReaderT WebState m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
spec))
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
balances)
    [XPubBal] -> WebT m [XPubBal]
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubBal]
balances
  where
    spec :: XPubSpec
spec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
    f :: XPubBal -> Bool
f = Bool -> Bool
not (Bool -> Bool) -> (XPubBal -> Bool) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal

scottyXPubUnspent ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetXPubUnspent ->
    WebT m [XPubUnspent]
scottyXPubUnspent :: GetXPubUnspent -> WebT m [XPubUnspent]
scottyXPubUnspent (GetXPubUnspent XPubKey
xpub DeriveType
deriv LimitsParam
pLimits (NoCache Bool
noCache)) = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpubUnspent
    Limits
limits <- Bool -> LimitsParam -> WebT m Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
    let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
    [XPubBal]
xbals <- XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
    [XPubUnspent]
unspents <- ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent])
-> (ReaderT WebState m [XPubUnspent]
    -> ReaderT WebState m [XPubUnspent])
-> ReaderT WebState m [XPubUnspent]
-> WebT m [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT WebState m [XPubUnspent]
-> ReaderT WebState m [XPubUnspent]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache (ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent])
-> ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xspec [XPubBal]
xbals Limits
limits
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubUnspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
unspents)
    [XPubUnspent] -> WebT m [XPubUnspent]
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubUnspent]
unspents

---------------------------------------
-- Blockchain.info API Compatibility --
---------------------------------------

netBinfoSymbol :: Network -> BinfoSymbol
netBinfoSymbol :: Network -> BinfoSymbol
netBinfoSymbol Network
net
    | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
btc =
        BinfoSymbol :: Text -> Text -> Text -> Double -> Bool -> Bool -> BinfoSymbol
BinfoSymbol
            { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
"BTC"
            , getBinfoSymbolString :: Text
getBinfoSymbolString = Text
"BTC"
            , getBinfoSymbolName :: Text
getBinfoSymbolName = Text
"Bitcoin"
            , getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000
            , getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
True
            , getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
False
            }
    | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch =
        BinfoSymbol :: Text -> Text -> Text -> Double -> Bool -> Bool -> BinfoSymbol
BinfoSymbol
            { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
"BCH"
            , getBinfoSymbolString :: Text
getBinfoSymbolString = Text
"BCH"
            , getBinfoSymbolName :: Text
getBinfoSymbolName = Text
"Bitcoin Cash"
            , getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000
            , getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
True
            , getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
False
            }
    | Bool
otherwise =
        BinfoSymbol :: Text -> Text -> Text -> Double -> Bool -> Bool -> BinfoSymbol
BinfoSymbol
            { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
"XTS"
            , getBinfoSymbolString :: Text
getBinfoSymbolString = Text
"¤"
            , getBinfoSymbolName :: Text
getBinfoSymbolName = Text
"Test"
            , getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000
            , getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
False
            , getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
False
            }

binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol
binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol
binfoTickerToSymbol Text
code BinfoTicker{Double
Text
binfoTicker15m :: BinfoTicker -> Double
binfoTickerLast :: BinfoTicker -> Double
binfoTickerBuy :: BinfoTicker -> Double
binfoTickerSell :: BinfoTicker -> Double
binfoTickerSymbol :: BinfoTicker -> Text
binfoTickerSymbol :: Text
binfoTickerSell :: Double
binfoTickerBuy :: Double
binfoTickerLast :: Double
binfoTicker15m :: Double
..} =
    BinfoSymbol :: Text -> Text -> Text -> Double -> Bool -> Bool -> BinfoSymbol
BinfoSymbol
        { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
code
        , getBinfoSymbolString :: Text
getBinfoSymbolString = Text
binfoTickerSymbol
        , getBinfoSymbolName :: Text
getBinfoSymbolName = Text
name
        , getBinfoSymbolConversion :: Double
getBinfoSymbolConversion =
            Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
binfoTicker15m -- sat/usd
        , getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
False
        , getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
True
        }
  where
    name :: Text
name = case Text
code of
        Text
"EUR" -> Text
"Euro"
        Text
"USD" -> Text
"U.S. dollar"
        Text
"GBP" -> Text
"British pound"
        Text
x -> Text
x

getBinfoAddrsParam ::
    MonadIO m =>
    Text ->
    WebT m (HashSet BinfoAddr)
getBinfoAddrsParam :: Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
name = do
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
    Text
p <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
name) ActionT Except (ReaderT WebState m) Text
-> (Except -> ActionT Except (ReaderT WebState m) Text)
-> ActionT Except (ReaderT WebState m) Text
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Text
-> Except -> ActionT Except (ReaderT WebState m) Text
forall a b. a -> b -> a
const (Text -> ActionT Except (ReaderT WebState m) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"")
    if Text -> Bool
T.null Text
p
        then HashSet BinfoAddr -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return HashSet BinfoAddr
forall a. HashSet a
HashSet.empty
        else case Network -> Text -> Maybe [BinfoAddr]
parseBinfoAddr Network
net Text
p of
            Maybe [BinfoAddr]
Nothing -> Except -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (String -> Except
UserError String
"invalid address")
            Just [BinfoAddr]
xs -> HashSet BinfoAddr -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet BinfoAddr -> WebT m (HashSet BinfoAddr))
-> HashSet BinfoAddr -> WebT m (HashSet BinfoAddr)
forall a b. (a -> b) -> a -> b
$ [BinfoAddr] -> HashSet BinfoAddr
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [BinfoAddr]
xs

getBinfoActive ::
    MonadIO m =>
    WebT m (HashMap XPubKey XPubSpec, HashSet Address)
getBinfoActive :: WebT m (HashMap XPubKey XPubSpec, HashSet Address)
getBinfoActive = do
    HashSet BinfoAddr
active <- Text -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"active"
    HashSet BinfoAddr
p2sh <- Text -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"activeP2SH"
    HashSet BinfoAddr
bech32 <- Text -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"activeBech32"
    let xspec :: DeriveType -> BinfoAddr -> Maybe (XPubKey, XPubSpec)
xspec DeriveType
d BinfoAddr
b = (\XPubKey
x -> (XPubKey
x, XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
x DeriveType
d)) (XPubKey -> (XPubKey, XPubSpec))
-> Maybe XPubKey -> Maybe (XPubKey, XPubSpec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinfoAddr -> Maybe XPubKey
xpub BinfoAddr
b
        xspecs :: HashMap XPubKey XPubSpec
xspecs =
            [(XPubKey, XPubSpec)] -> HashMap XPubKey XPubSpec
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(XPubKey, XPubSpec)] -> HashMap XPubKey XPubSpec)
-> [(XPubKey, XPubSpec)] -> HashMap XPubKey XPubSpec
forall a b. (a -> b) -> a -> b
$
                [[(XPubKey, XPubSpec)]] -> [(XPubKey, XPubSpec)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    [ (BinfoAddr -> Maybe (XPubKey, XPubSpec))
-> [BinfoAddr] -> [(XPubKey, XPubSpec)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DeriveType -> BinfoAddr -> Maybe (XPubKey, XPubSpec)
xspec DeriveType
DeriveNormal) (HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
active)
                    , (BinfoAddr -> Maybe (XPubKey, XPubSpec))
-> [BinfoAddr] -> [(XPubKey, XPubSpec)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DeriveType -> BinfoAddr -> Maybe (XPubKey, XPubSpec)
xspec DeriveType
DeriveP2SH) (HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
p2sh)
                    , (BinfoAddr -> Maybe (XPubKey, XPubSpec))
-> [BinfoAddr] -> [(XPubKey, XPubSpec)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DeriveType -> BinfoAddr -> Maybe (XPubKey, XPubSpec)
xspec DeriveType
DeriveP2WPKH) (HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
bech32)
                    ]
        addrs :: HashSet Address
addrs = [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address)
-> ([BinfoAddr] -> [Address]) -> [BinfoAddr] -> HashSet Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinfoAddr -> Maybe Address) -> [BinfoAddr] -> [Address]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe Address
addr ([BinfoAddr] -> HashSet Address) -> [BinfoAddr] -> HashSet Address
forall a b. (a -> b) -> a -> b
$ HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
active
    (HashMap XPubKey XPubSpec, HashSet Address)
-> WebT m (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap XPubKey XPubSpec
xspecs, HashSet Address
addrs)
  where
    addr :: BinfoAddr -> Maybe Address
addr (BinfoAddr Address
a) = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
a
    addr (BinfoXpub XPubKey
_) = Maybe Address
forall a. Maybe a
Nothing
    xpub :: BinfoAddr -> Maybe XPubKey
xpub (BinfoXpub XPubKey
x) = XPubKey -> Maybe XPubKey
forall a. a -> Maybe a
Just XPubKey
x
    xpub (BinfoAddr Address
_) = Maybe XPubKey
forall a. Maybe a
Nothing

getNumTxId :: MonadIO m => WebT m Bool
getNumTxId :: WebT m Bool
getNumTxId = (Bool -> Bool) -> WebT m Bool -> WebT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (WebT m Bool -> WebT m Bool) -> WebT m Bool -> WebT m Bool
forall a b. (a -> b) -> a -> b
$ Text -> WebT m Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txidindex" WebT m Bool -> (Except -> WebT m Bool) -> WebT m Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` WebT m Bool -> Except -> WebT m Bool
forall a b. a -> b -> a
const (Bool -> WebT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

getChainHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m H.BlockHeight
getChainHeight :: WebT m Word32
getChainHeight = do
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    BlockNode -> Word32
H.nodeHeight (BlockNode -> Word32)
-> ActionT Except (ReaderT WebState m) BlockNode -> WebT m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch

scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoUnspent :: WebT m ()
scottyBinfoUnspent =
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainUnspent
        WebT m ()
-> ActionT
     Except
     (ReaderT WebState m)
     (HashMap XPubKey XPubSpec, HashSet Address)
-> ActionT
     Except
     (ReaderT WebState m)
     (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActionT
  Except
  (ReaderT WebState m)
  (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashMap XPubKey XPubSpec, HashSet Address)
getBinfoActive ActionT
  Except
  (ReaderT WebState m)
  (HashMap XPubKey XPubSpec, HashSet Address)
-> ((HashMap XPubKey XPubSpec, HashSet Address) -> WebT m ())
-> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(HashMap XPubKey XPubSpec
xspecs, HashSet Address
addrs) ->
            WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId WebT m Bool -> (Bool -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
numtxid ->
                ActionT Except (ReaderT WebState m) Int
get_limit ActionT Except (ReaderT WebState m) Int
-> (Int -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
limit ->
                    ActionT Except (ReaderT WebState m) Int32
get_min_conf ActionT Except (ReaderT WebState m) Int32
-> (Int32 -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int32
min_conf -> do
                        let len :: Int
len = HashSet Address -> Int
forall a. HashSet a -> Int
HashSet.size HashSet Address
addrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HashMap XPubKey XPubSpec -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap XPubKey XPubSpec
xspecs
                        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
                        Word32
height <- WebT m Word32
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Word32
getChainHeight
                        let mn :: BinfoUnspent -> Bool
mn BinfoUnspent{Int32
Maybe BinfoXPubPath
Word32
Word64
ByteString
TxHash
BinfoTxId
getBinfoUnspentHash :: BinfoUnspent -> TxHash
getBinfoUnspentOutputIndex :: BinfoUnspent -> Word32
getBinfoUnspentScript :: BinfoUnspent -> ByteString
getBinfoUnspentValue :: BinfoUnspent -> Word64
getBinfoUnspentConfirmations :: BinfoUnspent -> Int32
getBinfoUnspentTxIndex :: BinfoUnspent -> BinfoTxId
getBinfoUnspentXPub :: BinfoUnspent -> Maybe BinfoXPubPath
getBinfoUnspentXPub :: Maybe BinfoXPubPath
getBinfoUnspentTxIndex :: BinfoTxId
getBinfoUnspentConfirmations :: Int32
getBinfoUnspentValue :: Word64
getBinfoUnspentScript :: ByteString
getBinfoUnspentOutputIndex :: Word32
getBinfoUnspentHash :: TxHash
..} = Int32
min_conf Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
getBinfoUnspentConfirmations
                            xspecs' :: HashSet XPubSpec
xspecs' = [XPubSpec] -> HashSet XPubSpec
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([XPubSpec] -> HashSet XPubSpec) -> [XPubSpec] -> HashSet XPubSpec
forall a b. (a -> b) -> a -> b
$ HashMap XPubKey XPubSpec -> [XPubSpec]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubKey XPubSpec
xspecs
                        [BinfoUnspent]
bus <-
                            ReaderT WebState m [BinfoUnspent]
-> ActionT Except (ReaderT WebState m) [BinfoUnspent]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoUnspent]
 -> ActionT Except (ReaderT WebState m) [BinfoUnspent])
-> (ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
    -> ReaderT WebState m [BinfoUnspent])
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ActionT Except (ReaderT WebState m) [BinfoUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ReaderT WebState m [BinfoUnspent]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
 -> ActionT Except (ReaderT WebState m) [BinfoUnspent])
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ActionT Except (ReaderT WebState m) [BinfoUnspent]
forall a b. (a -> b) -> a -> b
$
                                Bool
-> Word32
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
Bool
-> Word32
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent m ()
getBinfoUnspents Bool
numtxid Word32
height HashSet XPubSpec
xspecs' HashSet Address
addrs
                                    ConduitT () BinfoUnspent (ReaderT WebState m) ()
-> ConduitM BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((BinfoUnspent -> Bool)
-> ConduitT BinfoUnspent Void (ReaderT WebState m) ()
forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC BinfoUnspent -> Bool
mn ConduitT BinfoUnspent Void (ReaderT WebState m) ()
-> ConduitM BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
-> ConduitM BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoUnspent BinfoUnspent (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
limit ConduitT BinfoUnspent BinfoUnspent (ReaderT WebState m) ()
-> ConduitM BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
-> ConduitM BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
                        WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
                        Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BinfoUnspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoUnspent]
bus)
                        Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Network -> BinfoUnspents -> Encoding
binfoUnspentsToEncoding Network
net ([BinfoUnspent] -> BinfoUnspents
BinfoUnspents [BinfoUnspent]
bus))
  where
    get_limit :: ActionT Except (ReaderT WebState m) Int
get_limit = (Int -> Int)
-> ActionT Except (ReaderT WebState m) Int
-> ActionT Except (ReaderT WebState m) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1000) (ActionT Except (ReaderT WebState m) Int
 -> ActionT Except (ReaderT WebState m) Int)
-> ActionT Except (ReaderT WebState m) Int
-> ActionT Except (ReaderT WebState m) Int
forall a b. (a -> b) -> a -> b
$ Text -> ActionT Except (ReaderT WebState m) Int
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"limit" ActionT Except (ReaderT WebState m) Int
-> (Except -> ActionT Except (ReaderT WebState m) Int)
-> ActionT Except (ReaderT WebState m) Int
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Int
-> Except -> ActionT Except (ReaderT WebState m) Int
forall a b. a -> b -> a
const (Int -> ActionT Except (ReaderT WebState m) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
250)
    get_min_conf :: ActionT Except (ReaderT WebState m) Int32
get_min_conf = Text -> ActionT Except (ReaderT WebState m) Int32
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"confirmations" ActionT Except (ReaderT WebState m) Int32
-> (Except -> ActionT Except (ReaderT WebState m) Int32)
-> ActionT Except (ReaderT WebState m) Int32
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Int32
-> Except -> ActionT Except (ReaderT WebState m) Int32
forall a b. a -> b -> a
const (Int32 -> ActionT Except (ReaderT WebState m) Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0)

getBinfoUnspents ::
    (StoreReadExtra m, MonadIO m) =>
    Bool ->
    H.BlockHeight ->
    HashSet XPubSpec ->
    HashSet Address ->
    ConduitT () BinfoUnspent m ()
getBinfoUnspents :: Bool
-> Word32
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent m ()
getBinfoUnspents Bool
numtxid Word32
height HashSet XPubSpec
xspecs HashSet Address
addrs = do
    [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
cs' <- ConduitT
  () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
conduits
    [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitM () (Unspent, Maybe BinfoXPubPath) m ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
cs' ConduitM () (Unspent, Maybe BinfoXPubPath) m ()
-> ConduitM (Unspent, Maybe BinfoXPubPath) BinfoUnspent m ()
-> ConduitT () BinfoUnspent m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((Unspent, Maybe BinfoXPubPath) -> BinfoUnspent)
-> ConduitM (Unspent, Maybe BinfoXPubPath) BinfoUnspent m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ((Unspent -> Maybe BinfoXPubPath -> BinfoUnspent)
-> (Unspent, Maybe BinfoXPubPath) -> BinfoUnspent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Unspent -> Maybe BinfoXPubPath -> BinfoUnspent
binfo)
  where
    binfo :: Unspent -> Maybe BinfoXPubPath -> BinfoUnspent
binfo Unspent{Maybe Address
Word64
ByteString
OutPoint
BlockRef
unspentBlock :: Unspent -> BlockRef
unspentPoint :: Unspent -> OutPoint
unspentAmount :: Unspent -> Word64
unspentScript :: Unspent -> ByteString
unspentAddress :: Unspent -> Maybe Address
unspentAddress :: Maybe Address
unspentScript :: ByteString
unspentAmount :: Word64
unspentPoint :: OutPoint
unspentBlock :: BlockRef
..} Maybe BinfoXPubPath
xp =
        let conf :: Word32
conf = case BlockRef
unspentBlock of
                MemRef{} -> Word32
0
                BlockRef Word32
h Word32
_ -> Word32
height Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
            hash :: TxHash
hash = OutPoint -> TxHash
outPointHash OutPoint
unspentPoint
            idx :: Word32
idx = OutPoint -> Word32
outPointIndex OutPoint
unspentPoint
            val :: Word64
val = Word64
unspentAmount
            script :: ByteString
script = ByteString
unspentScript
            txi :: BinfoTxId
txi = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid TxHash
hash
         in BinfoUnspent :: TxHash
-> Word32
-> ByteString
-> Word64
-> Int32
-> BinfoTxId
-> Maybe BinfoXPubPath
-> BinfoUnspent
BinfoUnspent
                { getBinfoUnspentHash :: TxHash
getBinfoUnspentHash = TxHash
hash
                , getBinfoUnspentOutputIndex :: Word32
getBinfoUnspentOutputIndex = Word32
idx
                , getBinfoUnspentScript :: ByteString
getBinfoUnspentScript = ByteString
script
                , getBinfoUnspentValue :: Word64
getBinfoUnspentValue = Word64
val
                , getBinfoUnspentConfirmations :: Int32
getBinfoUnspentConfirmations = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
conf
                , getBinfoUnspentTxIndex :: BinfoTxId
getBinfoUnspentTxIndex = BinfoTxId
txi
                , getBinfoUnspentXPub :: Maybe BinfoXPubPath
getBinfoUnspentXPub = Maybe BinfoXPubPath
xp
                }
    conduits :: ConduitT
  () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
conduits = [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall a. Semigroup a => a -> a -> a
(<>) ([ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
 -> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
 -> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()])
-> ConduitT
     () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     ()
     BinfoUnspent
     m
     ([ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
      -> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT
  () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
xconduits ConduitT
  ()
  BinfoUnspent
  m
  ([ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
   -> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()])
-> ConduitT
     () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall a. [ConduitM () (Unspent, Maybe a) m ()]
acounduits
    xconduits :: ConduitT
  () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
xconduits = m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
 -> ConduitT
      ()
      BinfoUnspent
      m
      [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()])
-> m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall a b. (a -> b) -> a -> b
$ do
        let f :: XPubSpec -> XPubUnspent -> (Unspent, Maybe BinfoXPubPath)
f XPubSpec
x (XPubUnspent Unspent
u [Word32]
p) =
                let path :: Maybe SoftPath
path = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPathI AnyDeriv
listToPath [Word32]
p)
                    xp :: Maybe BinfoXPubPath
xp = XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
x) (SoftPath -> BinfoXPubPath)
-> Maybe SoftPath -> Maybe BinfoXPubPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SoftPath
path
                 in (Unspent
u, Maybe BinfoXPubPath
xp)
            g :: XPubSpec -> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ())
g XPubSpec
x = do
                [XPubBal]
bs <- XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
x
                ConduitM () (Unspent, Maybe BinfoXPubPath) m ()
-> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitM () (Unspent, Maybe BinfoXPubPath) m ()
 -> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ()))
-> ConduitM () (Unspent, Maybe BinfoXPubPath) m ()
-> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ())
forall a b. (a -> b) -> a -> b
$
                    (Limits -> m [XPubUnspent])
-> Maybe (XPubUnspent -> TxHash)
-> Limits
-> ConduitT () XPubUnspent m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
                        (XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
x [XPubBal]
bs)
                        Maybe (XPubUnspent -> TxHash)
forall a. Maybe a
Nothing
                        Limits
forall a. Default a => a
def{limit :: Word32
limit = Word32
250}
                        ConduitT () XPubUnspent m ()
-> ConduitM XPubUnspent (Unspent, Maybe BinfoXPubPath) m ()
-> ConduitM () (Unspent, Maybe BinfoXPubPath) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (XPubUnspent -> (Unspent, Maybe BinfoXPubPath))
-> ConduitM XPubUnspent (Unspent, Maybe BinfoXPubPath) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (XPubSpec -> XPubUnspent -> (Unspent, Maybe BinfoXPubPath)
f XPubSpec
x)
        (XPubSpec -> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ()))
-> [XPubSpec]
-> m [ConduitM () (Unspent, Maybe BinfoXPubPath) m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XPubSpec -> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ())
forall (m :: * -> *) (m :: * -> *).
(StoreReadExtra m, StoreReadExtra m) =>
XPubSpec -> m (ConduitM () (Unspent, Maybe BinfoXPubPath) m ())
g (HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
xspecs)
    acounduits :: [ConduitM () (Unspent, Maybe a) m ()]
acounduits =
        let f :: a -> (a, Maybe a)
f a
u = (a
u, Maybe a
forall a. Maybe a
Nothing)
            g :: Address -> ConduitM () (Unspent, Maybe a) m ()
g Address
a =
                (Limits -> m [Unspent])
-> Maybe (Unspent -> TxHash) -> Limits -> ConduitT () Unspent m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
                    (Address -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
a)
                    Maybe (Unspent -> TxHash)
forall a. Maybe a
Nothing
                    Limits
forall a. Default a => a
def{limit :: Word32
limit = Word32
250}
                    ConduitT () Unspent m ()
-> ConduitM Unspent (Unspent, Maybe a) m ()
-> ConduitM () (Unspent, Maybe a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Unspent -> (Unspent, Maybe a))
-> ConduitM Unspent (Unspent, Maybe a) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC Unspent -> (Unspent, Maybe a)
forall a a. a -> (a, Maybe a)
f
         in (Address -> ConduitM () (Unspent, Maybe a) m ())
-> [Address] -> [ConduitM () (Unspent, Maybe a) m ()]
forall a b. (a -> b) -> [a] -> [b]
map Address -> ConduitM () (Unspent, Maybe a) m ()
forall (m :: * -> *) a.
StoreReadExtra m =>
Address -> ConduitM () (Unspent, Maybe a) m ()
g (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)

getBinfoTxs ::
    (StoreReadExtra m, MonadIO m) =>
    HashMap Address (Maybe BinfoXPubPath) -> -- address book
    HashSet XPubSpec -> -- show xpubs
    HashSet Address -> -- show addrs
    HashSet Address -> -- balance addresses
    BinfoFilter ->
    Bool -> -- numtxid
    Bool -> -- prune outputs
    Int64 -> -- starting balance
    ConduitT () BinfoTx m ()
getBinfoTxs :: HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs HashMap Address (Maybe BinfoXPubPath)
abook HashSet XPubSpec
sxspecs HashSet Address
saddrs HashSet Address
baddrs BinfoFilter
bfilter Bool
numtxid Bool
prune Int64
bal = do
    [ConduitT () TxRef m ()]
cs' <- ConduitT () BinfoTx m [ConduitT () TxRef m ()]
conduits
    [ConduitT () TxRef m ()] -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () TxRef m ()]
cs' ConduitT () TxRef m ()
-> ConduitM TxRef BinfoTx m () -> ConduitT () BinfoTx m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Int64 -> ConduitM TxRef BinfoTx m ()
forall (m :: * -> *).
StoreReadBase m =>
Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
bal
  where
    sxspecs_ls :: [XPubSpec]
sxspecs_ls = HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
sxspecs
    saddrs_ls :: [Address]
saddrs_ls = HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
saddrs
    conduits :: ConduitT () BinfoTx m [ConduitT () TxRef m ()]
conduits = [ConduitT () TxRef m ()]
-> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()]
forall a. Semigroup a => a -> a -> a
(<>) ([ConduitT () TxRef m ()]
 -> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
-> ConduitT
     () BinfoTx m ([ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPubSpec -> ConduitT () BinfoTx m (ConduitT () TxRef m ()))
-> [XPubSpec] -> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM XPubSpec -> ConduitT () BinfoTx m (ConduitT () TxRef m ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) (m :: * -> *).
(MonadTrans t, StoreReadExtra m, StoreReadExtra m) =>
XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c [XPubSpec]
sxspecs_ls ConduitT
  () BinfoTx m ([ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ConduitT () TxRef m ()]
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Address -> ConduitT () TxRef m ())
-> [Address] -> [ConduitT () TxRef m ()]
forall a b. (a -> b) -> [a] -> [b]
map Address -> ConduitT () TxRef m ()
forall (m :: * -> *).
StoreReadExtra m =>
Address -> ConduitT () TxRef m ()
addr_c [Address]
saddrs_ls)
    xpub_c :: XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c XPubSpec
x = m (ConduitT () TxRef m ()) -> t m (ConduitT () TxRef m ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ConduitT () TxRef m ()) -> t m (ConduitT () TxRef m ()))
-> m (ConduitT () TxRef m ()) -> t m (ConduitT () TxRef m ())
forall a b. (a -> b) -> a -> b
$ do
        [XPubBal]
bs <- XPubSpec -> m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
x
        ConduitT () TxRef m () -> m (ConduitT () TxRef m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT () TxRef m () -> m (ConduitT () TxRef m ()))
-> ConduitT () TxRef m () -> m (ConduitT () TxRef m ())
forall a b. (a -> b) -> a -> b
$ (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
x [XPubBal]
bs) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash) Limits
forall a. Default a => a
def{limit :: Word32
limit = Word32
50}
    addr_c :: Address -> ConduitT () TxRef m ()
addr_c Address
a = (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash) Limits
forall a. Default a => a
def{limit :: Word32
limit = Word32
50}
    binfo_tx :: Int64 -> Transaction -> BinfoTx
binfo_tx Int64
b = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Int64
-> Transaction
-> BinfoTx
toBinfoTx Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Bool
prune Int64
b
    compute_bal_change :: BinfoTx -> a
compute_bal_change BinfoTx{Bool
[BinfoTxInput]
[BinfoTxOutput]
Maybe Word32
Maybe (Int64, Int64)
Word32
Word64
ByteString
TxHash
BinfoTxId
getBinfoTxHash :: BinfoTx -> TxHash
getBinfoTxVer :: BinfoTx -> Word32
getBinfoTxVinSz :: BinfoTx -> Word32
getBinfoTxVoutSz :: BinfoTx -> Word32
getBinfoTxSize :: BinfoTx -> Word32
getBinfoTxWeight :: BinfoTx -> Word32
getBinfoTxFee :: BinfoTx -> Word64
getBinfoTxRelayedBy :: BinfoTx -> ByteString
getBinfoTxLockTime :: BinfoTx -> Word32
getBinfoTxIndex :: BinfoTx -> BinfoTxId
getBinfoTxDoubleSpend :: BinfoTx -> Bool
getBinfoTxRBF :: BinfoTx -> Bool
getBinfoTxResultBal :: BinfoTx -> Maybe (Int64, Int64)
getBinfoTxTime :: BinfoTx -> Word64
getBinfoTxBlockIndex :: BinfoTx -> Maybe Word32
getBinfoTxBlockHeight :: BinfoTx -> Maybe Word32
getBinfoTxInputs :: BinfoTx -> [BinfoTxInput]
getBinfoTxOutputs :: BinfoTx -> [BinfoTxOutput]
getBinfoTxOutputs :: [BinfoTxOutput]
getBinfoTxInputs :: [BinfoTxInput]
getBinfoTxBlockHeight :: Maybe Word32
getBinfoTxBlockIndex :: Maybe Word32
getBinfoTxTime :: Word64
getBinfoTxResultBal :: Maybe (Int64, Int64)
getBinfoTxRBF :: Bool
getBinfoTxDoubleSpend :: Bool
getBinfoTxIndex :: BinfoTxId
getBinfoTxLockTime :: Word32
getBinfoTxRelayedBy :: ByteString
getBinfoTxFee :: Word64
getBinfoTxWeight :: Word32
getBinfoTxSize :: Word32
getBinfoTxVoutSz :: Word32
getBinfoTxVinSz :: Word32
getBinfoTxVer :: Word32
getBinfoTxHash :: TxHash
..} =
        let ins :: [BinfoTxOutput]
ins = (BinfoTxInput -> BinfoTxOutput)
-> [BinfoTxInput] -> [BinfoTxOutput]
forall a b. (a -> b) -> [a] -> [b]
map BinfoTxInput -> BinfoTxOutput
getBinfoTxInputPrevOut [BinfoTxInput]
getBinfoTxInputs
            out :: [BinfoTxOutput]
out = [BinfoTxOutput]
getBinfoTxOutputs
            f :: Bool -> BinfoTxOutput -> a
f Bool
b BinfoTxOutput{Bool
Int
[BinfoSpender]
Maybe Address
Maybe BinfoXPubPath
Word32
Word64
ByteString
BinfoTxId
getBinfoTxOutputType :: BinfoTxOutput -> Int
getBinfoTxOutputSpent :: BinfoTxOutput -> Bool
getBinfoTxOutputValue :: BinfoTxOutput -> Word64
getBinfoTxOutputIndex :: BinfoTxOutput -> Word32
getBinfoTxOutputTxIndex :: BinfoTxOutput -> BinfoTxId
getBinfoTxOutputScript :: BinfoTxOutput -> ByteString
getBinfoTxOutputSpenders :: BinfoTxOutput -> [BinfoSpender]
getBinfoTxOutputAddress :: BinfoTxOutput -> Maybe Address
getBinfoTxOutputXPub :: BinfoTxOutput -> Maybe BinfoXPubPath
getBinfoTxOutputXPub :: Maybe BinfoXPubPath
getBinfoTxOutputAddress :: Maybe Address
getBinfoTxOutputSpenders :: [BinfoSpender]
getBinfoTxOutputScript :: ByteString
getBinfoTxOutputTxIndex :: BinfoTxId
getBinfoTxOutputIndex :: Word32
getBinfoTxOutputValue :: Word64
getBinfoTxOutputSpent :: Bool
getBinfoTxOutputType :: Int
..} =
                let val :: a
val = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
getBinfoTxOutputValue
                 in case Maybe Address
getBinfoTxOutputAddress of
                        Maybe Address
Nothing -> a
0
                        Just Address
a
                            | Address
a Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
baddrs ->
                                if Bool
b then a
val else a -> a
forall a. Num a => a -> a
negate a
val
                            | Bool
otherwise -> a
0
         in [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (BinfoTxOutput -> a) -> [BinfoTxOutput] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BinfoTxOutput -> a
forall a. Num a => Bool -> BinfoTxOutput -> a
f Bool
False) [BinfoTxOutput]
ins [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> (BinfoTxOutput -> a) -> [BinfoTxOutput] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BinfoTxOutput -> a
forall a. Num a => Bool -> BinfoTxOutput -> a
f Bool
True) [BinfoTxOutput]
out
    go :: Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b =
        ConduitT TxRef BinfoTx m (Maybe TxRef)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT TxRef BinfoTx m (Maybe TxRef)
-> (Maybe TxRef -> ConduitT TxRef BinfoTx m ())
-> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe TxRef
Nothing -> () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just (TxRef BlockRef
_ TxHash
t) ->
                m (Maybe Transaction)
-> ConduitT TxRef BinfoTx m (Maybe Transaction)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
t) ConduitT TxRef BinfoTx m (Maybe Transaction)
-> (Maybe Transaction -> ConduitT TxRef BinfoTx m ())
-> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe Transaction
Nothing -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b
                    Just Transaction
x -> do
                        let a :: BinfoTx
a = Int64 -> Transaction -> BinfoTx
binfo_tx Int64
b Transaction
x
                            b' :: Int64
b' = Int64
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- BinfoTx -> Int64
forall a. Num a => BinfoTx -> a
compute_bal_change BinfoTx
a
                            c :: Bool
c = Maybe Word32 -> Bool
forall a. Maybe a -> Bool
isJust (BinfoTx -> Maybe Word32
getBinfoTxBlockHeight BinfoTx
a)
                            Just (Int64
d, Int64
_) = BinfoTx -> Maybe (Int64, Int64)
getBinfoTxResultBal BinfoTx
a
                            r :: Int64
r = Int64
d Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BinfoTx -> Word64
getBinfoTxFee BinfoTx
a)
                        case BinfoFilter
bfilter of
                            BinfoFilter
BinfoFilterAll ->
                                BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                            BinfoFilter
BinfoFilterSent
                                | Int64
0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
r -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                                | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                            BinfoFilter
BinfoFilterReceived
                                | Int64
r Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                                | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                            BinfoFilter
BinfoFilterMoved
                                | Int64
r Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                                | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                            BinfoFilter
BinfoFilterConfirmed
                                | Bool
c -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                                | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                            BinfoFilter
BinfoFilterMempool
                                | Bool
c -> () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                | Bool
otherwise -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'

getCashAddr :: Monad m => WebT m Bool
getCashAddr :: WebT m Bool
getCashAddr = Text -> WebT m Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"cashaddr" WebT m Bool -> (Except -> WebT m Bool) -> WebT m Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` WebT m Bool -> Except -> WebT m Bool
forall a b. a -> b -> a
const (Bool -> WebT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

getAddress :: (Monad m, MonadUnliftIO m) => TL.Text -> WebT m Address
getAddress :: Text -> WebT m Address
getAddress Text
param' = do
    Text
txt <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
param'
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    case Network -> Text -> Maybe Address
textToAddr Network
net Text
txt of
        Maybe Address
Nothing -> Except -> WebT m Address
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just Address
a -> Address -> WebT m Address
forall (m :: * -> *) a. Monad m => a -> m a
return Address
a

getBinfoAddr :: Monad m => TL.Text -> WebT m BinfoAddr
getBinfoAddr :: Text -> WebT m BinfoAddr
getBinfoAddr Text
param' = do
    Text
txt <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
param'
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    let x :: Maybe BinfoAddr
x =
            Address -> BinfoAddr
BinfoAddr (Address -> BinfoAddr) -> Maybe Address -> Maybe BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Text -> Maybe Address
textToAddr Network
net Text
txt
                Maybe BinfoAddr -> Maybe BinfoAddr -> Maybe BinfoAddr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XPubKey -> BinfoAddr
BinfoXpub (XPubKey -> BinfoAddr) -> Maybe XPubKey -> Maybe BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Text -> Maybe XPubKey
xPubImport Network
net Text
txt
    WebT m BinfoAddr
-> (BinfoAddr -> WebT m BinfoAddr)
-> Maybe BinfoAddr
-> WebT m BinfoAddr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WebT m BinfoAddr
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next BinfoAddr -> WebT m BinfoAddr
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BinfoAddr
x

scottyBinfoHistory :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoHistory :: WebT m ()
scottyBinfoHistory =
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainExportHistory
        WebT m ()
-> ActionT
     Except
     (ReaderT WebState m)
     (HashMap XPubKey XPubSpec, HashSet Address)
-> ActionT
     Except
     (ReaderT WebState m)
     (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActionT
  Except
  (ReaderT WebState m)
  (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashMap XPubKey XPubSpec, HashSet Address)
getBinfoActive ActionT
  Except
  (ReaderT WebState m)
  (HashMap XPubKey XPubSpec, HashSet Address)
-> ((HashMap XPubKey XPubSpec, HashSet Address) -> WebT m ())
-> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(HashMap XPubKey XPubSpec
xspecs, HashSet Address
addrs) ->
            ActionT
  Except (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
get_dates ActionT
  Except (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
-> ((Maybe BlockData, Maybe BlockData) -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Maybe BlockData
startM, Maybe BlockData
endM) -> do
                (Text
code, BinfoTicker
price') <- WebT m (Text, BinfoTicker)
forall (m :: * -> *). MonadIO m => WebT m (Text, BinfoTicker)
getPrice
                [(XPubSpec, [XPubBal])]
xpubs <- (XPubSpec
 -> ActionT Except (ReaderT WebState m) (XPubSpec, [XPubBal]))
-> [XPubSpec]
-> ActionT Except (ReaderT WebState m) [(XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\XPubSpec
x -> (,) XPubSpec
x ([XPubBal] -> (XPubSpec, [XPubBal]))
-> ActionT Except (ReaderT WebState m) [XPubBal]
-> ActionT Except (ReaderT WebState m) (XPubSpec, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
x) (HashMap XPubKey XPubSpec -> [XPubSpec]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubKey XPubSpec
xspecs)
                let xaddrs :: HashSet Address
xaddrs = [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address) -> [Address] -> HashSet Address
forall a b. (a -> b) -> a -> b
$ ((XPubSpec, [XPubBal]) -> [Address])
-> [(XPubSpec, [XPubBal])] -> [Address]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> Address
get_addr ([XPubBal] -> [Address])
-> ((XPubSpec, [XPubBal]) -> [XPubBal])
-> (XPubSpec, [XPubBal])
-> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubSpec, [XPubBal]) -> [XPubBal]
forall a b. (a, b) -> b
snd) [(XPubSpec, [XPubBal])]
xpubs
                    aaddrs :: HashSet Address
aaddrs = HashSet Address
xaddrs HashSet Address -> HashSet Address -> HashSet Address
forall a. Semigroup a => a -> a -> a
<> HashSet Address
addrs
                    cur :: Double
cur = BinfoTicker -> Double
binfoTicker15m BinfoTicker
price'
                    cs' :: [ConduitT () TxRef (ReaderT WebState m) ()]
cs' = [(XPubSpec, [XPubBal])]
-> HashSet Address
-> Maybe BlockData
-> [ConduitT () TxRef (ReaderT WebState m) ()]
forall (m :: * -> *).
StoreReadExtra m =>
[(XPubSpec, [XPubBal])]
-> HashSet Address -> Maybe BlockData -> [ConduitT () TxRef m ()]
conduits [(XPubSpec, [XPubBal])]
xpubs HashSet Address
addrs Maybe BlockData
endM
                [Transaction]
txs <-
                    ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> (ConduitT () Void (ReaderT WebState m) [Transaction]
    -> ReaderT WebState m [Transaction])
-> ConduitT () Void (ReaderT WebState m) [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [Transaction]
-> ReaderT WebState m [Transaction]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> ConduitT () Void (ReaderT WebState m) [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b. (a -> b) -> a -> b
$
                        [ConduitT () TxRef (ReaderT WebState m) ()]
-> ConduitT () TxRef (ReaderT WebState m) ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () TxRef (ReaderT WebState m) ()]
cs'
                            ConduitT () TxRef (ReaderT WebState m) ()
-> ConduitM TxRef Void (ReaderT WebState m) [Transaction]
-> ConduitT () Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (TxRef -> Bool) -> ConduitT TxRef TxRef (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
takeWhileC (Maybe BlockData -> TxRef -> Bool
is_newer Maybe BlockData
startM)
                            ConduitT TxRef TxRef (ReaderT WebState m) ()
-> ConduitM TxRef Void (ReaderT WebState m) [Transaction]
-> ConduitM TxRef Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (TxRef -> ReaderT WebState m (Maybe Transaction))
-> ConduitT
     TxRef (Element (Maybe Transaction)) (ReaderT WebState m) ()
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> m mono) -> ConduitT a (Element mono) m ()
concatMapMC TxRef -> ReaderT WebState m (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxRef -> m (Maybe Transaction)
get_transaction
                            ConduitT TxRef Transaction (ReaderT WebState m) ()
-> ConduitM Transaction Void (ReaderT WebState m) [Transaction]
-> ConduitM TxRef Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Transaction Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
                let times :: [Word64]
times = (Transaction -> Word64) -> [Transaction] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Word64
transactionTime [Transaction]
txs
                Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
                String
url <- ReaderT WebState m String
-> ActionT Except (ReaderT WebState m) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m String
 -> ActionT Except (ReaderT WebState m) String)
-> ReaderT WebState m String
-> ActionT Except (ReaderT WebState m) String
forall a b. (a -> b) -> a -> b
$ (WebState -> String) -> ReaderT WebState m String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebConfig -> String
webHistoryURL (WebConfig -> String)
-> (WebState -> WebConfig) -> WebState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
                Session
session <- ReaderT WebState m Session
-> ActionT Except (ReaderT WebState m) Session
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Session
 -> ActionT Except (ReaderT WebState m) Session)
-> ReaderT WebState m Session
-> ActionT Except (ReaderT WebState m) Session
forall a b. (a -> b) -> a -> b
$ (WebState -> Session) -> ReaderT WebState m Session
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Session
webWreqSession
                [Double]
rates <- (BinfoRate -> Double) -> [BinfoRate] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map BinfoRate -> Double
binfoRatePrice ([BinfoRate] -> [Double])
-> ActionT Except (ReaderT WebState m) [BinfoRate]
-> ActionT Except (ReaderT WebState m) [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m [BinfoRate]
-> ActionT Except (ReaderT WebState m) [BinfoRate]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Network
-> Session
-> String
-> Text
-> [Word64]
-> ReaderT WebState m [BinfoRate]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network -> Session -> String -> Text -> [Word64] -> m [BinfoRate]
getRates Network
net Session
session String
url Text
code [Word64]
times)
                let hs :: [BinfoHistory]
hs = (Transaction -> Double -> BinfoHistory)
-> [Transaction] -> [Double] -> [BinfoHistory]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Double -> HashSet Address -> Transaction -> Double -> BinfoHistory
convert Double
cur HashSet Address
aaddrs) [Transaction]
txs ([Double]
rates [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> Double -> [Double]
forall a. a -> [a]
repeat Double
0.0)
                WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
                Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BinfoHistory] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoHistory]
hs)
                Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ [BinfoHistory] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [BinfoHistory]
hs
  where
    is_newer :: Maybe BlockData -> TxRef -> Bool
is_newer (Just BlockData{Bool
Integer
[TxHash]
Word32
Word64
BlockHeader
blockDataMainChain :: BlockData -> Bool
blockDataWork :: BlockData -> Integer
blockDataSize :: BlockData -> Word32
blockDataWeight :: BlockData -> Word32
blockDataOutputs :: BlockData -> Word64
blockDataFees :: BlockData -> Word64
blockDataSubsidy :: BlockData -> Word64
blockDataSubsidy :: Word64
blockDataFees :: Word64
blockDataOutputs :: Word64
blockDataTxs :: [TxHash]
blockDataWeight :: Word32
blockDataSize :: Word32
blockDataHeader :: BlockHeader
blockDataWork :: Integer
blockDataMainChain :: Bool
blockDataHeight :: Word32
blockDataHeight :: BlockData -> Word32
blockDataHeader :: BlockData -> BlockHeader
blockDataTxs :: BlockData -> [TxHash]
..}) TxRef{txRefBlock :: TxRef -> BlockRef
txRefBlock = BlockRef{Word32
blockRefHeight :: BlockRef -> Word32
blockRefPos :: BlockRef -> Word32
blockRefPos :: Word32
blockRefHeight :: Word32
..}} =
        Word32
blockRefHeight Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
blockDataHeight
    is_newer Maybe BlockData
_ TxRef
_ = Bool
True
    get_addr :: XPubBal -> Address
get_addr = Balance -> Address
balanceAddress (Balance -> Address) -> (XPubBal -> Balance) -> XPubBal -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal
    get_transaction :: TxRef -> m (Maybe Transaction)
get_transaction TxRef{txRefHash :: TxRef -> TxHash
txRefHash = TxHash
h} =
        TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h
    convert :: Double -> HashSet Address -> Transaction -> Double -> BinfoHistory
convert Double
cur HashSet Address
addrs Transaction
tx Double
rate =
        let ins :: [StoreInput]
ins = Transaction -> [StoreInput]
transactionInputs Transaction
tx
            outs :: [StoreOutput]
outs = Transaction -> [StoreOutput]
transactionOutputs Transaction
tx
            fins :: [StoreInput]
fins = (StoreInput -> Bool) -> [StoreInput] -> [StoreInput]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet Address -> StoreInput -> Bool
input_addr HashSet Address
addrs) [StoreInput]
ins
            fouts :: [StoreOutput]
fouts = (StoreOutput -> Bool) -> [StoreOutput] -> [StoreOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet Address -> StoreOutput -> Bool
output_addr HashSet Address
addrs) [StoreOutput]
outs
            vin :: Int64
vin = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> ([Word64] -> Word64) -> [Word64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Int64) -> [Word64] -> Int64
forall a b. (a -> b) -> a -> b
$ (StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Word64
inputAmount [StoreInput]
fins
            vout :: Int64
vout = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> ([Word64] -> Word64) -> [Word64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Int64) -> [Word64] -> Int64
forall a b. (a -> b) -> a -> b
$ (StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> Word64
outputAmount [StoreOutput]
fouts
            v :: Int64
v = Int64
vout Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
vin
            t :: Word64
t = Transaction -> Word64
transactionTime Transaction
tx
            h :: TxHash
h = Tx -> TxHash
txHash (Tx -> TxHash) -> Tx -> TxHash
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData Transaction
tx
         in Int64 -> Word64 -> Double -> Double -> TxHash -> BinfoHistory
toBinfoHistory Int64
v Word64
t Double
rate Double
cur TxHash
h
    input_addr :: HashSet Address -> StoreInput -> Bool
input_addr HashSet Address
addrs' StoreInput{inputAddress :: StoreInput -> Maybe Address
inputAddress = Just Address
a} =
        Address
a Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
addrs'
    input_addr HashSet Address
_ StoreInput
_ = Bool
False
    output_addr :: HashSet Address -> StoreOutput -> Bool
output_addr HashSet Address
addrs' StoreOutput{outputAddr :: StoreOutput -> Maybe Address
outputAddr = Just Address
a} =
        Address
a Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
addrs'
    output_addr HashSet Address
_ StoreOutput
_ = Bool
False
    get_dates :: ActionT
  Except (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
get_dates = do
        BinfoDate Word64
start <- Text -> ActionT Except (ReaderT WebState m) BinfoDate
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"start"
        BinfoDate Word64
end' <- Text -> ActionT Except (ReaderT WebState m) BinfoDate
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"end"
        let end :: Word64
end = Word64
end' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60
        Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        Maybe BlockData
startM <- Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfter Chain
ch Word64
start
        Maybe BlockData
endM <- Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
end
        (Maybe BlockData, Maybe BlockData)
-> ActionT
     Except (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockData
startM, Maybe BlockData
endM)
    conduits :: [(XPubSpec, [XPubBal])]
-> HashSet Address -> Maybe BlockData -> [ConduitT () TxRef m ()]
conduits [(XPubSpec, [XPubBal])]
xpubs HashSet Address
addrs Maybe BlockData
endM =
        ((XPubSpec, [XPubBal]) -> ConduitT () TxRef m ())
-> [(XPubSpec, [XPubBal])] -> [ConduitT () TxRef m ()]
forall a b. (a -> b) -> [a] -> [b]
map ((XPubSpec -> [XPubBal] -> ConduitT () TxRef m ())
-> (XPubSpec, [XPubBal]) -> ConduitT () TxRef m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe BlockData -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
forall (m :: * -> *).
StoreReadExtra m =>
Maybe BlockData -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
xpub_c Maybe BlockData
endM)) [(XPubSpec, [XPubBal])]
xpubs
            [ConduitT () TxRef m ()]
-> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()]
forall a. Semigroup a => a -> a -> a
<> (Address -> ConduitT () TxRef m ())
-> [Address] -> [ConduitT () TxRef m ()]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe BlockData -> Address -> ConduitT () TxRef m ()
forall (m :: * -> *).
StoreReadExtra m =>
Maybe BlockData -> Address -> ConduitT () TxRef m ()
addr_c Maybe BlockData
endM) (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
    addr_c :: Maybe BlockData -> Address -> ConduitT () TxRef m ()
addr_c Maybe BlockData
endM Address
a =
        (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
            (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a)
            ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash)
            Limits
forall a. Default a => a
def
                { limit :: Word32
limit = Word32
50
                , start :: Maybe Start
start = Word32 -> Start
AtBlock (Word32 -> Start) -> (BlockData -> Word32) -> BlockData -> Start
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> Word32
blockDataHeight (BlockData -> Start) -> Maybe BlockData -> Maybe Start
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BlockData
endM
                }
    xpub_c :: Maybe BlockData -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
xpub_c Maybe BlockData
endM XPubSpec
x [XPubBal]
bs =
        (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
            (XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
x [XPubBal]
bs)
            ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash)
            Limits
forall a. Default a => a
def
                { limit :: Word32
limit = Word32
50
                , start :: Maybe Start
start = Word32 -> Start
AtBlock (Word32 -> Start) -> (BlockData -> Word32) -> BlockData -> Start
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> Word32
blockDataHeight (BlockData -> Start) -> Maybe BlockData -> Maybe Start
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BlockData
endM
                }

getPrice :: MonadIO m => WebT m (Text, BinfoTicker)
getPrice :: WebT m (Text, BinfoTicker)
getPrice = do
    Text
code <- Text -> Text
T.toUpper (Text -> Text)
-> ActionT Except (ReaderT WebState m) Text
-> ActionT Except (ReaderT WebState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"currency" ActionT Except (ReaderT WebState m) Text
-> (Except -> ActionT Except (ReaderT WebState m) Text)
-> ActionT Except (ReaderT WebState m) Text
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Text
-> Except -> ActionT Except (ReaderT WebState m) Text
forall a b. a -> b -> a
const (Text -> ActionT Except (ReaderT WebState m) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"USD")
    TVar (HashMap Text BinfoTicker)
ticker <- ReaderT WebState m (TVar (HashMap Text BinfoTicker))
-> ActionT
     Except (ReaderT WebState m) (TVar (HashMap Text BinfoTicker))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (TVar (HashMap Text BinfoTicker))
 -> ActionT
      Except (ReaderT WebState m) (TVar (HashMap Text BinfoTicker)))
-> ReaderT WebState m (TVar (HashMap Text BinfoTicker))
-> ActionT
     Except (ReaderT WebState m) (TVar (HashMap Text BinfoTicker))
forall a b. (a -> b) -> a -> b
$ (WebState -> TVar (HashMap Text BinfoTicker))
-> ReaderT WebState m (TVar (HashMap Text BinfoTicker))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> TVar (HashMap Text BinfoTicker)
webTicker
    HashMap Text BinfoTicker
prices <- TVar (HashMap Text BinfoTicker)
-> ActionT Except (ReaderT WebState m) (HashMap Text BinfoTicker)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (HashMap Text BinfoTicker)
ticker
    case Text -> HashMap Text BinfoTicker -> Maybe BinfoTicker
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
code HashMap Text BinfoTicker
prices of
        Maybe BinfoTicker
Nothing -> (Text, BinfoTicker) -> WebT m (Text, BinfoTicker)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
code, BinfoTicker
forall a. Default a => a
def)
        Just BinfoTicker
p -> (Text, BinfoTicker) -> WebT m (Text, BinfoTicker)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
code, BinfoTicker
p)

getSymbol :: MonadIO m => WebT m BinfoSymbol
getSymbol :: WebT m BinfoSymbol
getSymbol = (Text -> BinfoTicker -> BinfoSymbol)
-> (Text, BinfoTicker) -> BinfoSymbol
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> BinfoTicker -> BinfoSymbol
binfoTickerToSymbol ((Text, BinfoTicker) -> BinfoSymbol)
-> ActionT Except (ReaderT WebState m) (Text, BinfoTicker)
-> WebT m BinfoSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) (Text, BinfoTicker)
forall (m :: * -> *). MonadIO m => WebT m (Text, BinfoTicker)
getPrice

scottyBinfoBlocksDay :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoBlocksDay :: WebT m ()
scottyBinfoBlocksDay = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainBlocks
    Word64
t <- Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
h (Word64 -> Word64) -> (Word64 -> Word64) -> Word64 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
1000) (Word64 -> Word64)
-> ActionT Except (ReaderT WebState m) Word64
-> ActionT Except (ReaderT WebState m) Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) Word64
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"milliseconds"
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Maybe BlockData
m <- Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t
    [BlockData]
bs <- Word64
-> Maybe BlockData
-> ActionT Except (ReaderT WebState m) [BlockData]
forall (m :: * -> *) t.
(Integral t, StoreReadBase m) =>
t -> Maybe BlockData -> m [BlockData]
go (Word64 -> Word64
d Word64
t) Maybe BlockData
m
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
bs)
    Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ [BinfoBlockInfo] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([BinfoBlockInfo] -> Encoding) -> [BinfoBlockInfo] -> Encoding
forall a b. (a -> b) -> a -> b
$ (BlockData -> BinfoBlockInfo) -> [BlockData] -> [BinfoBlockInfo]
forall a b. (a -> b) -> [a] -> [b]
map BlockData -> BinfoBlockInfo
toBinfoBlockInfo [BlockData]
bs
  where
    h :: Word64
h = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: H.Timestamp)
    d :: Word64 -> Word64
d = Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
subtract (Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
3600)
    go :: t -> Maybe BlockData -> m [BlockData]
go t
_ Maybe BlockData
Nothing = [BlockData] -> m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go t
t (Just BlockData
b)
        | BlockHeader -> Word32
H.blockTimestamp (BlockData -> BlockHeader
blockDataHeader BlockData
b) Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= t -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
t =
            [BlockData] -> m [BlockData]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        | Bool
otherwise = do
            Maybe BlockData
b' <- BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHeader -> BlockHash
H.prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
b))
            (BlockData
b BlockData -> [BlockData] -> [BlockData]
forall a. a -> [a] -> [a]
:) ([BlockData] -> [BlockData]) -> m [BlockData] -> m [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Maybe BlockData -> m [BlockData]
go t
t Maybe BlockData
b'

scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyMultiAddr :: WebT m ()
scottyMultiAddr = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainMultiaddr
    (HashSet Address
addrs', HashSet XPubKey
_, HashSet Address
saddrs, HashSet XPubKey
sxpubs, HashMap XPubKey XPubSpec
xspecs) <- ActionT
  Except
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashMap XPubKey XPubSpec)
get_addrs
    Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
    Bool
cashaddr <- WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr
    BinfoSymbol
local' <- WebT m BinfoSymbol
forall (m :: * -> *). MonadIO m => WebT m BinfoSymbol
getSymbol
    Int
offset <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
    Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"n"
    Bool
prune <- WebT m Bool
get_prune
    BinfoFilter
fltr <- ActionT Except (ReaderT WebState m) BinfoFilter
get_filter
    HashMap XPubKey [XPubBal]
xbals <- HashMap XPubKey XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubKey [XPubBal])
get_xbals HashMap XPubKey XPubSpec
xspecs
    HashMap XPubKey Int
xtxns <- HashMap XPubKey [XPubBal]
-> HashMap XPubKey XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubKey Int)
forall (f :: * -> *) k v.
(Num v, StoreReadExtra f, Eq k, Hashable k) =>
HashMap k [XPubBal] -> HashMap k XPubSpec -> f (HashMap k v)
get_xpub_tx_count HashMap XPubKey [XPubBal]
xbals HashMap XPubKey XPubSpec
xspecs
    let sxbals :: HashMap XPubKey [XPubBal]
sxbals = HashSet XPubKey
-> HashMap XPubKey [XPubBal] -> HashMap XPubKey [XPubBal]
forall a v.
(Eq a, Hashable a) =>
HashSet a -> HashMap a v -> HashMap a v
subset HashSet XPubKey
sxpubs HashMap XPubKey [XPubBal]
xbals
        xabals :: HashMap Address Balance
xabals = HashMap XPubKey [XPubBal] -> HashMap Address Balance
forall k. HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals HashMap XPubKey [XPubBal]
xbals
        addrs :: HashSet Address
addrs = HashSet Address
addrs' HashSet Address -> HashSet Address -> HashSet Address
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HashSet.difference` HashMap Address Balance -> HashSet Address
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap Address Balance
xabals
    HashMap Address Balance
abals <- HashSet Address
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
get_abals HashSet Address
addrs
    let sxspecs :: HashSet XPubSpec
sxspecs = HashSet XPubKey -> HashMap XPubKey XPubSpec -> HashSet XPubSpec
forall a k.
(Eq a, Eq k, Hashable a, Hashable k) =>
HashSet k -> HashMap k a -> HashSet a
compute_sxspecs HashSet XPubKey
sxpubs HashMap XPubKey XPubSpec
xspecs
        sxabals :: HashMap Address Balance
sxabals = HashMap XPubKey [XPubBal] -> HashMap Address Balance
forall k. HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals HashMap XPubKey [XPubBal]
sxbals
        sabals :: HashMap Address Balance
sabals = HashSet Address
-> HashMap Address Balance -> HashMap Address Balance
forall a v.
(Eq a, Hashable a) =>
HashSet a -> HashMap a v -> HashMap a v
subset HashSet Address
saddrs HashMap Address Balance
abals
        sallbals :: HashMap Address Balance
sallbals = HashMap Address Balance
sabals HashMap Address Balance
-> HashMap Address Balance -> HashMap Address Balance
forall a. Semigroup a => a -> a -> a
<> HashMap Address Balance
sxabals
        sbal :: Word64
sbal = HashMap Address Balance -> Word64
forall k. HashMap k Balance -> Word64
compute_bal HashMap Address Balance
sallbals
        allbals :: HashMap Address Balance
allbals = HashMap Address Balance
abals HashMap Address Balance
-> HashMap Address Balance -> HashMap Address Balance
forall a. Semigroup a => a -> a -> a
<> HashMap Address Balance
xabals
        abook :: HashMap Address (Maybe BinfoXPubPath)
abook = HashSet Address
-> HashMap XPubKey [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
compute_abook HashSet Address
addrs HashMap XPubKey [XPubBal]
xbals
        sxaddrs :: HashSet Address
sxaddrs = HashMap XPubKey [XPubBal] -> HashSet Address
forall k. HashMap k [XPubBal] -> HashSet Address
compute_xaddrs HashMap XPubKey [XPubBal]
sxbals
        salladdrs :: HashSet Address
salladdrs = HashSet Address
saddrs HashSet Address -> HashSet Address -> HashSet Address
forall a. Semigroup a => a -> a -> a
<> HashSet Address
sxaddrs
        bal :: Word64
bal = HashMap Address Balance -> Word64
forall k. HashMap k Balance -> Word64
compute_bal HashMap Address Balance
allbals
    let ibal :: Int64
ibal = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sbal
    [BinfoTx]
ftxs <-
        ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> (ConduitT () Void (ReaderT WebState m) [BinfoTx]
    -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
            HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs HashMap Address (Maybe BinfoXPubPath)
abook HashSet XPubSpec
sxspecs HashSet Address
saddrs HashSet Address
salladdrs BinfoFilter
fltr Bool
numtxid Bool
prune Int64
ibal
                ConduitT () BinfoTx (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Int -> ConduitT BinfoTx Void (ReaderT WebState m) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
offset ConduitT BinfoTx Void (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
    BlockData
best <- ActionT Except (ReaderT WebState m) BlockData
get_best_block
    Word32
peers <- ActionT Except (ReaderT WebState m) Word32
get_peers
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    let baddrs :: [BinfoBalance]
baddrs = HashMap Address Balance
-> HashMap XPubKey [XPubBal]
-> HashMap XPubKey Int
-> [BinfoBalance]
toBinfoAddrs HashMap Address Balance
sabals HashMap XPubKey [XPubBal]
sxbals HashMap XPubKey Int
xtxns
        abaddrs :: [BinfoBalance]
abaddrs = HashMap Address Balance
-> HashMap XPubKey [XPubBal]
-> HashMap XPubKey Int
-> [BinfoBalance]
toBinfoAddrs HashMap Address Balance
abals HashMap XPubKey [XPubBal]
xbals HashMap XPubKey Int
xtxns
        recv :: Word64
recv = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (BinfoBalance -> Word64) -> [BinfoBalance] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map BinfoBalance -> Word64
getBinfoAddrReceived [BinfoBalance]
abaddrs
        sent' :: Word64
sent' = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (BinfoBalance -> Word64) -> [BinfoBalance] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map BinfoBalance -> Word64
getBinfoAddrSent [BinfoBalance]
abaddrs
        txn :: Word64
txn = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
ftxs
        wallet :: BinfoWallet
wallet =
            BinfoWallet :: Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> BinfoWallet
BinfoWallet
                { getBinfoWalletBalance :: Word64
getBinfoWalletBalance = Word64
bal
                , getBinfoWalletTxCount :: Word64
getBinfoWalletTxCount = Word64
txn
                , getBinfoWalletFilteredCount :: Word64
getBinfoWalletFilteredCount = Word64
txn
                , getBinfoWalletTotalReceived :: Word64
getBinfoWalletTotalReceived = Word64
recv
                , getBinfoWalletTotalSent :: Word64
getBinfoWalletTotalSent = Word64
sent'
                }
        coin :: BinfoSymbol
coin = Network -> BinfoSymbol
netBinfoSymbol Network
net
        block :: BinfoBlockInfo
block =
            BinfoBlockInfo :: BlockHash -> Word32 -> Word32 -> Word32 -> BinfoBlockInfo
BinfoBlockInfo
                { getBinfoBlockInfoHash :: BlockHash
getBinfoBlockInfoHash = BlockHeader -> BlockHash
H.headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
best)
                , getBinfoBlockInfoHeight :: Word32
getBinfoBlockInfoHeight = BlockData -> Word32
blockDataHeight BlockData
best
                , getBinfoBlockInfoTime :: Word32
getBinfoBlockInfoTime = BlockHeader -> Word32
H.blockTimestamp (BlockData -> BlockHeader
blockDataHeader BlockData
best)
                , getBinfoBlockInfoIndex :: Word32
getBinfoBlockInfoIndex = BlockData -> Word32
blockDataHeight BlockData
best
                }
        info :: BinfoInfo
info =
            BinfoInfo :: Word32
-> Double
-> BinfoSymbol
-> BinfoSymbol
-> BinfoBlockInfo
-> BinfoInfo
BinfoInfo
                { getBinfoConnected :: Word32
getBinfoConnected = Word32
peers
                , getBinfoConversion :: Double
getBinfoConversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000
                , getBinfoLocal :: BinfoSymbol
getBinfoLocal = BinfoSymbol
local'
                , getBinfoBTC :: BinfoSymbol
getBinfoBTC = BinfoSymbol
coin
                , getBinfoLatestBlock :: BinfoBlockInfo
getBinfoLatestBlock = BinfoBlockInfo
block
                }
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (HashMap Address (Maybe BinfoXPubPath) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Address (Maybe BinfoXPubPath)
abook Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
ftxs)
    Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$
        Network -> BinfoMultiAddr -> Encoding
binfoMultiAddrToEncoding
            Network
net
            BinfoMultiAddr :: [BinfoBalance]
-> BinfoWallet
-> [BinfoTx]
-> BinfoInfo
-> Bool
-> Bool
-> BinfoMultiAddr
BinfoMultiAddr
                { getBinfoMultiAddrAddresses :: [BinfoBalance]
getBinfoMultiAddrAddresses = [BinfoBalance]
baddrs
                , getBinfoMultiAddrWallet :: BinfoWallet
getBinfoMultiAddrWallet = BinfoWallet
wallet
                , getBinfoMultiAddrTxs :: [BinfoTx]
getBinfoMultiAddrTxs = [BinfoTx]
ftxs
                , getBinfoMultiAddrInfo :: BinfoInfo
getBinfoMultiAddrInfo = BinfoInfo
info
                , getBinfoMultiAddrRecommendFee :: Bool
getBinfoMultiAddrRecommendFee = Bool
True
                , getBinfoMultiAddrCashAddr :: Bool
getBinfoMultiAddrCashAddr = Bool
cashaddr
                }
  where
    get_xpub_tx_count :: HashMap k [XPubBal] -> HashMap k XPubSpec -> f (HashMap k v)
get_xpub_tx_count HashMap k [XPubBal]
xbals =
        let f :: (k, XPubSpec) -> m (k, b)
f (k
k, XPubSpec
s) =
                case k -> HashMap k [XPubBal] -> Maybe [XPubBal]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
k HashMap k [XPubBal]
xbals of
                    Maybe [XPubBal]
Nothing -> (k, b) -> m (k, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (k
k, b
0)
                    Just [XPubBal]
bs -> do
                        Word32
n <- XPubSpec -> [XPubBal] -> m Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
s [XPubBal]
bs
                        (k, b) -> m (k, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (k
k, Word32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n)
         in ([(k, v)] -> HashMap k v) -> f [(k, v)] -> f (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (f [(k, v)] -> f (HashMap k v))
-> (HashMap k XPubSpec -> f [(k, v)])
-> HashMap k XPubSpec
-> f (HashMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, XPubSpec) -> f (k, v)) -> [(k, XPubSpec)] -> f [(k, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (k, XPubSpec) -> f (k, v)
forall (m :: * -> *) b.
(Num b, StoreReadExtra m) =>
(k, XPubSpec) -> m (k, b)
f ([(k, XPubSpec)] -> f [(k, v)])
-> (HashMap k XPubSpec -> [(k, XPubSpec)])
-> HashMap k XPubSpec
-> f [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k XPubSpec -> [(k, XPubSpec)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    get_filter :: ActionT Except (ReaderT WebState m) BinfoFilter
get_filter = Text -> ActionT Except (ReaderT WebState m) BinfoFilter
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"filter" ActionT Except (ReaderT WebState m) BinfoFilter
-> (Except -> ActionT Except (ReaderT WebState m) BinfoFilter)
-> ActionT Except (ReaderT WebState m) BinfoFilter
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) BinfoFilter
-> Except -> ActionT Except (ReaderT WebState m) BinfoFilter
forall a b. a -> b -> a
const (BinfoFilter -> ActionT Except (ReaderT WebState m) BinfoFilter
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterAll)
    get_best_block :: ActionT Except (ReaderT WebState m) BlockData
get_best_block =
        ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockHash
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockHash
bh ->
                BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
                    Just BlockData
b -> BlockData -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
    get_prune :: WebT m Bool
get_prune =
        (Bool -> Bool) -> WebT m Bool -> WebT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (WebT m Bool -> WebT m Bool) -> WebT m Bool -> WebT m Bool
forall a b. (a -> b) -> a -> b
$
            Text -> WebT m Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"no_compact"
                WebT m Bool -> (Except -> WebT m Bool) -> WebT m Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` WebT m Bool -> Except -> WebT m Bool
forall a b. a -> b -> a
const (Bool -> WebT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
    subset :: HashSet a -> HashMap a v -> HashMap a v
subset HashSet a
ks =
        (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\a
k v
_ -> a
k a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet a
ks)
    compute_sxspecs :: HashSet k -> HashMap k a -> HashSet a
compute_sxspecs HashSet k
sxpubs =
        [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([a] -> HashSet a)
-> (HashMap k a -> [a]) -> HashMap k a -> HashSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k a -> [a]
forall k v. HashMap k v -> [v]
HashMap.elems (HashMap k a -> [a])
-> (HashMap k a -> HashMap k a) -> HashMap k a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet k -> HashMap k a -> HashMap k a
forall a v.
(Eq a, Hashable a) =>
HashSet a -> HashMap a v -> HashMap a v
subset HashSet k
sxpubs
    addr :: BinfoAddr -> Maybe Address
addr (BinfoAddr Address
a) = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
a
    addr (BinfoXpub XPubKey
_) = Maybe Address
forall a. Maybe a
Nothing
    xpub :: BinfoAddr -> Maybe XPubKey
xpub (BinfoXpub XPubKey
x) = XPubKey -> Maybe XPubKey
forall a. a -> Maybe a
Just XPubKey
x
    xpub (BinfoAddr Address
_) = Maybe XPubKey
forall a. Maybe a
Nothing
    get_addrs :: ActionT
  Except
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashMap XPubKey XPubSpec)
get_addrs = do
        (HashMap XPubKey XPubSpec
xspecs, HashSet Address
addrs) <- WebT m (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashMap XPubKey XPubSpec, HashSet Address)
getBinfoActive
        HashSet BinfoAddr
sh <- Text -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"onlyShow"
        let xpubs :: HashSet XPubKey
xpubs = HashMap XPubKey XPubSpec -> HashSet XPubKey
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap XPubKey XPubSpec
xspecs
            actives :: HashSet BinfoAddr
actives =
                (Address -> BinfoAddr) -> HashSet Address -> HashSet BinfoAddr
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map Address -> BinfoAddr
BinfoAddr HashSet Address
addrs
                    HashSet BinfoAddr -> HashSet BinfoAddr -> HashSet BinfoAddr
forall a. Semigroup a => a -> a -> a
<> (XPubKey -> BinfoAddr) -> HashSet XPubKey -> HashSet BinfoAddr
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map XPubKey -> BinfoAddr
BinfoXpub HashSet XPubKey
xpubs
            sh' :: HashSet BinfoAddr
sh' = if HashSet BinfoAddr -> Bool
forall a. HashSet a -> Bool
HashSet.null HashSet BinfoAddr
sh then HashSet BinfoAddr
actives else HashSet BinfoAddr
sh
            saddrs :: HashSet Address
saddrs = [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address)
-> ([BinfoAddr] -> [Address]) -> [BinfoAddr] -> HashSet Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinfoAddr -> Maybe Address) -> [BinfoAddr] -> [Address]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe Address
addr ([BinfoAddr] -> HashSet Address) -> [BinfoAddr] -> HashSet Address
forall a b. (a -> b) -> a -> b
$ HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
sh'
            sxpubs :: HashSet XPubKey
sxpubs = [XPubKey] -> HashSet XPubKey
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([XPubKey] -> HashSet XPubKey)
-> ([BinfoAddr] -> [XPubKey]) -> [BinfoAddr] -> HashSet XPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinfoAddr -> Maybe XPubKey) -> [BinfoAddr] -> [XPubKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe XPubKey
xpub ([BinfoAddr] -> HashSet XPubKey) -> [BinfoAddr] -> HashSet XPubKey
forall a b. (a -> b) -> a -> b
$ HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
sh'
        (HashSet Address, HashSet XPubKey, HashSet Address,
 HashSet XPubKey, HashMap XPubKey XPubSpec)
-> ActionT
     Except
     (ReaderT WebState m)
     (HashSet Address, HashSet XPubKey, HashSet Address,
      HashSet XPubKey, HashMap XPubKey XPubSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet Address
addrs, HashSet XPubKey
xpubs, HashSet Address
saddrs, HashSet XPubKey
sxpubs, HashMap XPubKey XPubSpec
xspecs)
    get_xbals :: HashMap XPubKey XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubKey [XPubBal])
get_xbals =
        let f :: XPubBal -> Bool
f = Bool -> Bool
not (Bool -> Bool) -> (XPubBal -> Bool) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal
            g :: [(XPubKey, [XPubBal])] -> HashMap XPubKey [XPubBal]
g = [(XPubKey, [XPubBal])] -> HashMap XPubKey [XPubBal]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(XPubKey, [XPubBal])] -> HashMap XPubKey [XPubBal])
-> ([(XPubKey, [XPubBal])] -> [(XPubKey, [XPubBal])])
-> [(XPubKey, [XPubBal])]
-> HashMap XPubKey [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((XPubKey, [XPubBal]) -> (XPubKey, [XPubBal]))
-> [(XPubKey, [XPubBal])] -> [(XPubKey, [XPubBal])]
forall a b. (a -> b) -> [a] -> [b]
map (([XPubBal] -> [XPubBal])
-> (XPubKey, [XPubBal]) -> (XPubKey, [XPubBal])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
f))
            h :: (a, XPubSpec) -> f (a, [XPubBal])
h (a
k, XPubSpec
s) = (,) a
k ([XPubBal] -> (a, [XPubBal])) -> f [XPubBal] -> f (a, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> f [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
s
         in ([(XPubKey, [XPubBal])] -> HashMap XPubKey [XPubBal])
-> ActionT Except (ReaderT WebState m) [(XPubKey, [XPubBal])]
-> ActionT Except (ReaderT WebState m) (HashMap XPubKey [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(XPubKey, [XPubBal])] -> HashMap XPubKey [XPubBal]
g (ActionT Except (ReaderT WebState m) [(XPubKey, [XPubBal])]
 -> ActionT Except (ReaderT WebState m) (HashMap XPubKey [XPubBal]))
-> (HashMap XPubKey XPubSpec
    -> ActionT Except (ReaderT WebState m) [(XPubKey, [XPubBal])])
-> HashMap XPubKey XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubKey [XPubBal])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((XPubKey, XPubSpec)
 -> ActionT Except (ReaderT WebState m) (XPubKey, [XPubBal]))
-> [(XPubKey, XPubSpec)]
-> ActionT Except (ReaderT WebState m) [(XPubKey, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (XPubKey, XPubSpec)
-> ActionT Except (ReaderT WebState m) (XPubKey, [XPubBal])
forall (f :: * -> *) a.
StoreReadExtra f =>
(a, XPubSpec) -> f (a, [XPubBal])
h ([(XPubKey, XPubSpec)]
 -> ActionT Except (ReaderT WebState m) [(XPubKey, [XPubBal])])
-> (HashMap XPubKey XPubSpec -> [(XPubKey, XPubSpec)])
-> HashMap XPubKey XPubSpec
-> ActionT Except (ReaderT WebState m) [(XPubKey, [XPubBal])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap XPubKey XPubSpec -> [(XPubKey, XPubSpec)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
    get_abals :: HashSet Address
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
get_abals =
        let f :: Balance -> (Address, Balance)
f Balance
b = (Balance -> Address
balanceAddress Balance
b, Balance
b)
            g :: [Balance] -> HashMap Address Balance
g = [(Address, Balance)] -> HashMap Address Balance
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Balance)] -> HashMap Address Balance)
-> ([Balance] -> [(Address, Balance)])
-> [Balance]
-> HashMap Address Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> (Address, Balance))
-> [Balance] -> [(Address, Balance)]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> (Address, Balance)
f
         in ([Balance] -> HashMap Address Balance)
-> ActionT Except (ReaderT WebState m) [Balance]
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Balance] -> HashMap Address Balance
g (ActionT Except (ReaderT WebState m) [Balance]
 -> ActionT Except (ReaderT WebState m) (HashMap Address Balance))
-> (HashSet Address
    -> ActionT Except (ReaderT WebState m) [Balance])
-> HashSet Address
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> ActionT Except (ReaderT WebState m) [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances ([Address] -> ActionT Except (ReaderT WebState m) [Balance])
-> (HashSet Address -> [Address])
-> HashSet Address
-> ActionT Except (ReaderT WebState m) [Balance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList
    get_peers :: ActionT Except (ReaderT WebState m) Word32
get_peers = do
        [PeerInformation]
ps <-
            ReaderT WebState m [PeerInformation]
-> ActionT Except (ReaderT WebState m) [PeerInformation]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [PeerInformation]
 -> ActionT Except (ReaderT WebState m) [PeerInformation])
-> ReaderT WebState m [PeerInformation]
-> ActionT Except (ReaderT WebState m) [PeerInformation]
forall a b. (a -> b) -> a -> b
$
                PeerManager -> ReaderT WebState m [PeerInformation]
forall (m :: * -> *).
MonadLoggerIO m =>
PeerManager -> m [PeerInformation]
getPeersInformation
                    (PeerManager -> ReaderT WebState m [PeerInformation])
-> ReaderT WebState m PeerManager
-> ReaderT WebState m [PeerInformation]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WebState -> PeerManager) -> ReaderT WebState m PeerManager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> PeerManager
storeManager (Store -> PeerManager)
-> (WebState -> Store) -> WebState -> PeerManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        Word32 -> ActionT Except (ReaderT WebState m) Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([PeerInformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PeerInformation]
ps))
    compute_xabals :: HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals =
        let f :: XPubBal -> (Address, Balance)
f XPubBal
b = (Balance -> Address
balanceAddress (XPubBal -> Balance
xPubBal XPubBal
b), XPubBal -> Balance
xPubBal XPubBal
b)
         in [(Address, Balance)] -> HashMap Address Balance
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Balance)] -> HashMap Address Balance)
-> (HashMap k [XPubBal] -> [(Address, Balance)])
-> HashMap k [XPubBal]
-> HashMap Address Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> [(Address, Balance)])
-> [[XPubBal]] -> [(Address, Balance)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubBal -> (Address, Balance))
-> [XPubBal] -> [(Address, Balance)]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, Balance)
f) ([[XPubBal]] -> [(Address, Balance)])
-> (HashMap k [XPubBal] -> [[XPubBal]])
-> HashMap k [XPubBal]
-> [(Address, Balance)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems
    compute_bal :: HashMap k Balance -> Word64
compute_bal =
        let f :: Balance -> Word64
f Balance
b = Balance -> Word64
balanceAmount Balance
b Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Balance -> Word64
balanceZero Balance
b
         in [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> (HashMap k Balance -> [Word64]) -> HashMap k Balance -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> Word64) -> [Balance] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> Word64
f ([Balance] -> [Word64])
-> (HashMap k Balance -> [Balance])
-> HashMap k Balance
-> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k Balance -> [Balance]
forall k v. HashMap k v -> [v]
HashMap.elems
    compute_abook :: HashSet Address
-> HashMap XPubKey [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
compute_abook HashSet Address
addrs HashMap XPubKey [XPubBal]
xbals =
        let f :: XPubKey -> XPubBal -> (Address, Maybe BinfoXPubPath)
f XPubKey
k XPubBal{[Word32]
Balance
xPubBalPath :: XPubBal -> [Word32]
xPubBal :: Balance
xPubBalPath :: [Word32]
xPubBal :: XPubBal -> Balance
..} =
                let a :: Address
a = Balance -> Address
balanceAddress Balance
xPubBal
                    e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"lions and tigers and bears"
                    s :: Maybe SoftPath
s = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPathI AnyDeriv
listToPath [Word32]
xPubBalPath)
                    m :: SoftPath
m = SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall a. a
e Maybe SoftPath
s
                 in (Address
a, BinfoXPubPath -> Maybe BinfoXPubPath
forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath XPubKey
k SoftPath
m))
            g :: XPubKey -> [XPubBal] -> [(Address, Maybe BinfoXPubPath)]
g XPubKey
k = (XPubBal -> (Address, Maybe BinfoXPubPath))
-> [XPubBal] -> [(Address, Maybe BinfoXPubPath)]
forall a b. (a -> b) -> [a] -> [b]
map (XPubKey -> XPubBal -> (Address, Maybe BinfoXPubPath)
f XPubKey
k)
            amap :: HashMap Address (Maybe a)
amap =
                (() -> Maybe a) -> HashMap Address () -> HashMap Address (Maybe a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (HashMap Address () -> HashMap Address (Maybe a))
-> HashMap Address () -> HashMap Address (Maybe a)
forall a b. (a -> b) -> a -> b
$
                    HashSet Address -> HashMap Address ()
forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet Address
addrs
            xmap :: HashMap Address (Maybe BinfoXPubPath)
xmap =
                [(Address, Maybe BinfoXPubPath)]
-> HashMap Address (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
                    ([(Address, Maybe BinfoXPubPath)]
 -> HashMap Address (Maybe BinfoXPubPath))
-> ([(XPubKey, [XPubBal])] -> [(Address, Maybe BinfoXPubPath)])
-> [(XPubKey, [XPubBal])]
-> HashMap Address (Maybe BinfoXPubPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((XPubKey, [XPubBal]) -> [(Address, Maybe BinfoXPubPath)])
-> [(XPubKey, [XPubBal])] -> [(Address, Maybe BinfoXPubPath)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubKey -> [XPubBal] -> [(Address, Maybe BinfoXPubPath)])
-> (XPubKey, [XPubBal]) -> [(Address, Maybe BinfoXPubPath)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubKey -> [XPubBal] -> [(Address, Maybe BinfoXPubPath)]
g)
                    ([(XPubKey, [XPubBal])] -> HashMap Address (Maybe BinfoXPubPath))
-> [(XPubKey, [XPubBal])] -> HashMap Address (Maybe BinfoXPubPath)
forall a b. (a -> b) -> a -> b
$ HashMap XPubKey [XPubBal] -> [(XPubKey, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubKey [XPubBal]
xbals
         in HashMap Address (Maybe BinfoXPubPath)
forall a. HashMap Address (Maybe a)
amap HashMap Address (Maybe BinfoXPubPath)
-> HashMap Address (Maybe BinfoXPubPath)
-> HashMap Address (Maybe BinfoXPubPath)
forall a. Semigroup a => a -> a -> a
<> HashMap Address (Maybe BinfoXPubPath)
xmap
    compute_xaddrs :: HashMap k [XPubBal] -> HashSet Address
compute_xaddrs =
        let f :: [XPubBal] -> [Address]
f = (XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Address
balanceAddress (Balance -> Address) -> (XPubBal -> Balance) -> XPubBal -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal)
         in [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address)
-> (HashMap k [XPubBal] -> [Address])
-> HashMap k [XPubBal]
-> HashSet Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> [Address]) -> [[XPubBal]] -> [Address]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [XPubBal] -> [Address]
f ([[XPubBal]] -> [Address])
-> (HashMap k [XPubBal] -> [[XPubBal]])
-> HashMap k [XPubBal]
-> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems

getBinfoCount :: (MonadUnliftIO m, MonadLoggerIO m) => TL.Text -> WebT m Int
getBinfoCount :: Text -> WebT m Int
getBinfoCount Text
str = do
    Word32
d <- ReaderT WebState m Word32
-> ActionT Except (ReaderT WebState m) Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Word32) -> ReaderT WebState m Word32
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebLimits -> Word32
maxLimitDefault (WebLimits -> Word32)
-> (WebState -> WebLimits) -> WebState -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> WebLimits
webMaxLimits (WebConfig -> WebLimits)
-> (WebState -> WebConfig) -> WebState -> WebLimits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
    Word32
x <- ReaderT WebState m Word32
-> ActionT Except (ReaderT WebState m) Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Word32) -> ReaderT WebState m Word32
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebLimits -> Word32
maxLimitFull (WebLimits -> Word32)
-> (WebState -> WebLimits) -> WebState -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> WebLimits
webMaxLimits (WebConfig -> WebLimits)
-> (WebState -> WebConfig) -> WebState -> WebLimits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
    Word32
i <- Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
x (Word32 -> Word32)
-> ActionT Except (ReaderT WebState m) Word32
-> ActionT Except (ReaderT WebState m) Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ActionT Except (ReaderT WebState m) Word32
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
str ActionT Except (ReaderT WebState m) Word32
-> (Except -> ActionT Except (ReaderT WebState m) Word32)
-> ActionT Except (ReaderT WebState m) Word32
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Word32
-> Except -> ActionT Except (ReaderT WebState m) Word32
forall a b. a -> b -> a
const (Word32 -> ActionT Except (ReaderT WebState m) Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
d))
    Int -> WebT m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i :: Int)

getBinfoOffset ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    WebT m Int
getBinfoOffset :: WebT m Int
getBinfoOffset = do
    Word32
x <- ReaderT WebState m Word32
-> ActionT Except (ReaderT WebState m) Word32
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Word32) -> ReaderT WebState m Word32
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebLimits -> Word32
maxLimitOffset (WebLimits -> Word32)
-> (WebState -> WebLimits) -> WebState -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> WebLimits
webMaxLimits (WebConfig -> WebLimits)
-> (WebState -> WebConfig) -> WebState -> WebLimits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
    Word32
o <- Text -> ActionT Except (ReaderT WebState m) Word32
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"offset" ActionT Except (ReaderT WebState m) Word32
-> (Except -> ActionT Except (ReaderT WebState m) Word32)
-> ActionT Except (ReaderT WebState m) Word32
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Word32
-> Except -> ActionT Except (ReaderT WebState m) Word32
forall a b. a -> b -> a
const (Word32 -> ActionT Except (ReaderT WebState m) Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0)
    Bool
-> ActionT Except (ReaderT WebState m) ()
-> ActionT Except (ReaderT WebState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
o Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
x) (ActionT Except (ReaderT WebState m) ()
 -> ActionT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
        Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> ActionT Except (ReaderT WebState m) ())
-> Except -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
            String -> Except
UserError (String -> Except) -> String -> Except
forall a b. (a -> b) -> a -> b
$ String
"offset exceeded: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" > " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
x
    Int -> WebT m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
o :: Int)

scottyRawAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyRawAddr :: WebT m ()
scottyRawAddr =
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainRawaddr
        WebT m ()
-> ActionT Except (ReaderT WebState m) BinfoAddr
-> ActionT Except (ReaderT WebState m) BinfoAddr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ActionT Except (ReaderT WebState m) BinfoAddr
forall (m :: * -> *). Monad m => Text -> WebT m BinfoAddr
getBinfoAddr Text
"addr" ActionT Except (ReaderT WebState m) BinfoAddr
-> (BinfoAddr -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            BinfoAddr Address
addr -> Address -> WebT m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Address -> ActionT Except (ReaderT WebState m) ()
do_addr Address
addr
            BinfoXpub XPubKey
xpub -> XPubKey -> WebT m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> ActionT Except (ReaderT WebState m) ()
do_xpub XPubKey
xpub
  where
    do_xpub :: XPubKey -> ActionT Except (ReaderT WebState m) ()
do_xpub XPubKey
xpub = do
        Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
        DeriveType
derive <- Text -> ActionT Except (ReaderT WebState m) DeriveType
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"derive" ActionT Except (ReaderT WebState m) DeriveType
-> (Except -> ActionT Except (ReaderT WebState m) DeriveType)
-> ActionT Except (ReaderT WebState m) DeriveType
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) DeriveType
-> Except -> ActionT Except (ReaderT WebState m) DeriveType
forall a b. a -> b -> a
const (DeriveType -> ActionT Except (ReaderT WebState m) DeriveType
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
DeriveNormal)
        let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
derive
        Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"limit"
        Int
off <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
        [XPubBal]
xbals <- XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        let summary :: XPubSummary
summary = XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary XPubSpec
xspec [XPubBal]
xbals
            abook :: HashMap Address (Maybe BinfoXPubPath)
abook = XPubKey -> [XPubBal] -> HashMap Address (Maybe BinfoXPubPath)
compute_abook XPubKey
xpub [XPubBal]
xbals
            xspecs :: HashSet XPubSpec
xspecs = XPubSpec -> HashSet XPubSpec
forall a. Hashable a => a -> HashSet a
HashSet.singleton XPubSpec
xspec
            saddrs :: HashSet a
saddrs = HashSet a
forall a. HashSet a
HashSet.empty
            baddrs :: HashSet Address
baddrs = HashMap Address (Maybe BinfoXPubPath) -> HashSet Address
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap Address (Maybe BinfoXPubPath)
abook
            bfilter :: BinfoFilter
bfilter = BinfoFilter
BinfoFilterAll
            amnt :: Word64
amnt =
                XPubSummary -> Word64
xPubSummaryConfirmed XPubSummary
summary
                    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ XPubSummary -> Word64
xPubSummaryZero XPubSummary
summary
        [BinfoTx]
txs <-
            ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> (ConduitT () Void (ReaderT WebState m) [BinfoTx]
    -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
                HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
                    HashMap Address (Maybe BinfoXPubPath)
abook
                    HashSet XPubSpec
xspecs
                    HashSet Address
forall a. HashSet a
saddrs
                    HashSet Address
baddrs
                    BinfoFilter
bfilter
                    Bool
numtxid
                    Bool
False
                    (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt)
                    ConduitT () BinfoTx (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Int -> ConduitT BinfoTx Void (ReaderT WebState m) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
off ConduitT BinfoTx Void (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
        let ra :: BinfoRawAddr
ra =
                BinfoRawAddr :: BinfoAddr
-> Word64
-> Word64
-> Word64
-> Word64
-> Int64
-> [BinfoTx]
-> BinfoRawAddr
BinfoRawAddr
                    { binfoRawAddr :: BinfoAddr
binfoRawAddr = XPubKey -> BinfoAddr
BinfoXpub XPubKey
xpub
                    , binfoRawBalance :: Word64
binfoRawBalance = Word64
amnt
                    , binfoRawTxCount :: Word64
binfoRawTxCount = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
txs
                    , binfoRawUnredeemed :: Word64
binfoRawUnredeemed = XPubSummary -> Word64
xPubUnspentCount XPubSummary
summary
                    , binfoRawReceived :: Word64
binfoRawReceived = XPubSummary -> Word64
xPubSummaryReceived XPubSummary
summary
                    , binfoRawSent :: Int64
binfoRawSent =
                        Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (XPubSummary -> Word64
xPubSummaryReceived XPubSummary
summary)
                            Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt
                    , binfoRawTxs :: [BinfoTx]
binfoRawTxs = [BinfoTx]
txs
                    }
        ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
        Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (HashMap Address (Maybe BinfoXPubPath) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Address (Maybe BinfoXPubPath)
abook Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
txs)
        Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Network -> BinfoRawAddr -> Encoding
binfoRawAddrToEncoding Network
net BinfoRawAddr
ra
    compute_abook :: XPubKey -> [XPubBal] -> HashMap Address (Maybe BinfoXPubPath)
compute_abook XPubKey
xpub [XPubBal]
xbals =
        let f :: XPubBal -> (Address, Maybe BinfoXPubPath)
f XPubBal{[Word32]
Balance
xPubBal :: Balance
xPubBalPath :: [Word32]
xPubBalPath :: XPubBal -> [Word32]
xPubBal :: XPubBal -> Balance
..} =
                let a :: Address
a = Balance -> Address
balanceAddress Balance
xPubBal
                    e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"black hole swallows all your code"
                    s :: Maybe SoftPath
s = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPathI AnyDeriv
listToPath [Word32]
xPubBalPath)
                    m :: SoftPath
m = SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall a. a
e Maybe SoftPath
s
                 in (Address
a, BinfoXPubPath -> Maybe BinfoXPubPath
forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath XPubKey
xpub SoftPath
m))
         in [(Address, Maybe BinfoXPubPath)]
-> HashMap Address (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Maybe BinfoXPubPath)]
 -> HashMap Address (Maybe BinfoXPubPath))
-> [(Address, Maybe BinfoXPubPath)]
-> HashMap Address (Maybe BinfoXPubPath)
forall a b. (a -> b) -> a -> b
$ (XPubBal -> (Address, Maybe BinfoXPubPath))
-> [XPubBal] -> [(Address, Maybe BinfoXPubPath)]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, Maybe BinfoXPubPath)
f [XPubBal]
xbals
    do_addr :: Address -> ActionT Except (ReaderT WebState m) ()
do_addr Address
addr = do
        Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
        Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"limit"
        Int
off <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
        Balance
bal <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
addr) (Maybe Balance -> Balance)
-> ActionT Except (ReaderT WebState m) (Maybe Balance)
-> ActionT Except (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT Except (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
addr
        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        let abook :: HashMap Address (Maybe a)
abook = Address -> Maybe a -> HashMap Address (Maybe a)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Address
addr Maybe a
forall a. Maybe a
Nothing
            xspecs :: HashSet a
xspecs = HashSet a
forall a. HashSet a
HashSet.empty
            saddrs :: HashSet Address
saddrs = Address -> HashSet Address
forall a. Hashable a => a -> HashSet a
HashSet.singleton Address
addr
            bfilter :: BinfoFilter
bfilter = BinfoFilter
BinfoFilterAll
            amnt :: Word64
amnt = Balance -> Word64
balanceAmount Balance
bal Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Balance -> Word64
balanceZero Balance
bal
        [BinfoTx]
txs <-
            ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> (ConduitT () Void (ReaderT WebState m) [BinfoTx]
    -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
                HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
                    HashMap Address (Maybe BinfoXPubPath)
forall a. HashMap Address (Maybe a)
abook
                    HashSet XPubSpec
forall a. HashSet a
xspecs
                    HashSet Address
saddrs
                    HashSet Address
saddrs
                    BinfoFilter
bfilter
                    Bool
numtxid
                    Bool
False
                    (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt)
                    ConduitT () BinfoTx (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Int -> ConduitT BinfoTx Void (ReaderT WebState m) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
off ConduitT BinfoTx Void (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
        let ra :: BinfoRawAddr
ra =
                BinfoRawAddr :: BinfoAddr
-> Word64
-> Word64
-> Word64
-> Word64
-> Int64
-> [BinfoTx]
-> BinfoRawAddr
BinfoRawAddr
                    { binfoRawAddr :: BinfoAddr
binfoRawAddr = Address -> BinfoAddr
BinfoAddr Address
addr
                    , binfoRawBalance :: Word64
binfoRawBalance = Word64
amnt
                    , binfoRawTxCount :: Word64
binfoRawTxCount = Balance -> Word64
balanceTxCount Balance
bal
                    , binfoRawUnredeemed :: Word64
binfoRawUnredeemed = Balance -> Word64
balanceUnspentCount Balance
bal
                    , binfoRawReceived :: Word64
binfoRawReceived = Balance -> Word64
balanceTotalReceived Balance
bal
                    , binfoRawSent :: Int64
binfoRawSent =
                        Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Balance -> Word64
balanceTotalReceived Balance
bal)
                            Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt
                    , binfoRawTxs :: [BinfoTx]
binfoRawTxs = [BinfoTx]
txs
                    }
        ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
        Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
txs)
        Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Network -> BinfoRawAddr -> Encoding
binfoRawAddrToEncoding Network
net BinfoRawAddr
ra

scottyBinfoReceived :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoReceived :: WebT m ()
scottyBinfoReceived = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQgetreceivedbyaddress
    Address
a <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    Balance
b <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
a) (Maybe Balance -> Balance)
-> ActionT Except (ReaderT WebState m) (Maybe Balance)
-> ActionT Except (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT Except (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Word64 -> Text) -> Word64 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> WebT m ()) -> Word64 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Balance -> Word64
balanceTotalReceived Balance
b

scottyBinfoSent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoSent :: WebT m ()
scottyBinfoSent = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQgetsentbyaddress
    Address
a <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    Balance
b <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
a) (Maybe Balance -> Balance)
-> ActionT Except (ReaderT WebState m) (Maybe Balance)
-> ActionT Except (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT Except (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Word64 -> Text) -> Word64 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> WebT m ()) -> Word64 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Balance -> Word64
balanceTotalReceived Balance
b Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Balance -> Word64
balanceAmount Balance
b Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Balance -> Word64
balanceZero Balance
b

scottyBinfoAddrBalance :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoAddrBalance :: WebT m ()
scottyBinfoAddrBalance = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQaddressbalance
    Address
a <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    Balance
b <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
a) (Maybe Balance -> Balance)
-> ActionT Except (ReaderT WebState m) (Maybe Balance)
-> ActionT Except (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT Except (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Word64 -> Text) -> Word64 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> WebT m ()) -> Word64 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Balance -> Word64
balanceAmount Balance
b Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Balance -> Word64
balanceZero Balance
b

scottyFirstSeen :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyFirstSeen :: WebT m ()
scottyFirstSeen = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQaddressfirstseen
    Address
a <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    BlockNode
bb <- Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    let top :: Word32
top = BlockNode -> Word32
H.nodeHeight BlockNode
bb
        bot :: Word32
bot = Word32
0
    Word32
i <- Chain
-> BlockNode
-> Address
-> Word32
-> Word32
-> ActionT Except (ReaderT WebState m) Word32
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
Chain -> BlockNode -> Address -> Word32 -> Word32 -> m Word32
go Chain
ch BlockNode
bb Address
a Word32
bot Word32
top
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (String -> Text) -> String -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> WebT m ()) -> String -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
i
  where
    go :: Chain -> BlockNode -> Address -> Word32 -> Word32 -> m Word32
go Chain
ch BlockNode
bb Address
a Word32
bot Word32
top = do
        let mid :: Word32
mid = Word32
bot Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
top Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
bot) Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
2
            n :: Bool
n = Word32
top Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
bot Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
2
        Bool
x <- Address -> Word32 -> m Bool
forall (f :: * -> *).
StoreReadExtra f =>
Address -> Word32 -> f Bool
hasone Address
a Word32
bot
        Bool
y <- Address -> Word32 -> m Bool
forall (f :: * -> *).
StoreReadExtra f =>
Address -> Word32 -> f Bool
hasone Address
a Word32
mid
        Bool
z <- Address -> Word32 -> m Bool
forall (f :: * -> *).
StoreReadExtra f =>
Address -> Word32 -> f Bool
hasone Address
a Word32
top
        if
                | Bool
x -> Chain -> BlockNode -> Word32 -> m Word32
forall (f :: * -> *).
MonadIO f =>
Chain -> BlockNode -> Word32 -> f Word32
getblocktime Chain
ch BlockNode
bb Word32
bot
                | Bool
n -> Chain -> BlockNode -> Word32 -> m Word32
forall (f :: * -> *).
MonadIO f =>
Chain -> BlockNode -> Word32 -> f Word32
getblocktime Chain
ch BlockNode
bb Word32
top
                | Bool
y -> Chain -> BlockNode -> Address -> Word32 -> Word32 -> m Word32
go Chain
ch BlockNode
bb Address
a Word32
bot Word32
mid
                | Bool
z -> Chain -> BlockNode -> Address -> Word32 -> Word32 -> m Word32
go Chain
ch BlockNode
bb Address
a Word32
mid Word32
top
                | Bool
otherwise -> Word32 -> m Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
    getblocktime :: Chain -> BlockNode -> Word32 -> f Word32
getblocktime Chain
ch BlockNode
bb Word32
h =
        BlockHeader -> Word32
H.blockTimestamp (BlockHeader -> Word32)
-> (Maybe BlockNode -> BlockHeader) -> Maybe BlockNode -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
H.nodeHeader (BlockNode -> BlockHeader)
-> (Maybe BlockNode -> BlockNode) -> Maybe BlockNode -> BlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe BlockNode -> BlockNode
forall a. HasCallStack => Maybe a -> a
fromJust
            (Maybe BlockNode -> Word32) -> f (Maybe BlockNode) -> f Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> BlockNode -> Chain -> f (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
Word32 -> BlockNode -> Chain -> m (Maybe BlockNode)
chainGetAncestor Word32
h BlockNode
bb Chain
ch
    hasone :: Address -> Word32 -> f Bool
hasone Address
a Word32
h = do
        let l :: Limits
l = Word32 -> Word32 -> Maybe Start -> Limits
Limits Word32
1 Word32
0 (Start -> Maybe Start
forall a. a -> Maybe a
Just (Word32 -> Start
AtBlock Word32
h))
        Bool -> Bool
not (Bool -> Bool) -> ([TxRef] -> Bool) -> [TxRef] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxRef] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TxRef] -> Bool) -> f [TxRef] -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> Limits -> f [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a Limits
l

scottyShortBal :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyShortBal :: WebT m ()
scottyShortBal = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainBalance
    (HashMap XPubKey XPubSpec
xspecs, HashSet Address
addrs) <- WebT m (HashMap XPubKey XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashMap XPubKey XPubSpec, HashSet Address)
getBinfoActive
    Bool
cashaddr <- WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    [(Text, BinfoShortBal)]
abals <-
        [Maybe (Text, BinfoShortBal)] -> [(Text, BinfoShortBal)]
forall a. [Maybe a] -> [a]
catMaybes
            ([Maybe (Text, BinfoShortBal)] -> [(Text, BinfoShortBal)])
-> ActionT
     Except (ReaderT WebState m) [Maybe (Text, BinfoShortBal)]
-> ActionT Except (ReaderT WebState m) [(Text, BinfoShortBal)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address
 -> ActionT
      Except (ReaderT WebState m) (Maybe (Text, BinfoShortBal)))
-> [Address]
-> ActionT
     Except (ReaderT WebState m) [Maybe (Text, BinfoShortBal)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network
-> Bool
-> Address
-> ActionT
     Except (ReaderT WebState m) (Maybe (Text, BinfoShortBal))
forall (m :: * -> *).
StoreReadBase m =>
Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
get_addr_balance Network
net Bool
cashaddr) (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
    [(Text, BinfoShortBal)]
xbals <- (XPubSpec
 -> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal))
-> [XPubSpec]
-> ActionT Except (ReaderT WebState m) [(Text, BinfoShortBal)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
get_xspec_balance Network
net) (HashMap XPubKey XPubSpec -> [XPubSpec]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubKey XPubSpec
xspecs)
    let res :: HashMap Text BinfoShortBal
res = [(Text, BinfoShortBal)] -> HashMap Text BinfoShortBal
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, BinfoShortBal)]
abals [(Text, BinfoShortBal)]
-> [(Text, BinfoShortBal)] -> [(Text, BinfoShortBal)]
forall a. Semigroup a => a -> a -> a
<> [(Text, BinfoShortBal)]
xbals)
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([(Text, BinfoShortBal)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, BinfoShortBal)]
abals)
    Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ HashMap Text BinfoShortBal -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding HashMap Text BinfoShortBal
res
  where
    to_short_bal :: Balance -> BinfoShortBal
to_short_bal Balance{Word64
Address
balanceTotalReceived :: Word64
balanceTxCount :: Word64
balanceUnspentCount :: Word64
balanceZero :: Word64
balanceAmount :: Word64
balanceAddress :: Address
balanceTotalReceived :: Balance -> Word64
balanceUnspentCount :: Balance -> Word64
balanceTxCount :: Balance -> Word64
balanceZero :: Balance -> Word64
balanceAmount :: Balance -> Word64
balanceAddress :: Balance -> Address
..} =
        BinfoShortBal :: Word64 -> Word64 -> Word64 -> BinfoShortBal
BinfoShortBal
            { binfoShortBalFinal :: Word64
binfoShortBalFinal = Word64
balanceAmount Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
balanceZero
            , binfoShortBalTxCount :: Word64
binfoShortBalTxCount = Word64
balanceTxCount
            , binfoShortBalReceived :: Word64
binfoShortBalReceived = Word64
balanceTotalReceived
            }
    get_addr_balance :: Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
get_addr_balance Network
net Bool
cashaddr Address
a =
        let net' :: Network
net' =
                if
                        | Bool
cashaddr -> Network
net
                        | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch -> Network
btc
                        | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bchTest -> Network
btcTest
                        | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bchTest4 -> Network
btcTest
                        | Bool
otherwise -> Network
net
         in case Network -> Address -> Maybe Text
addrToText Network
net' Address
a of
                Maybe Text
Nothing -> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, BinfoShortBal)
forall a. Maybe a
Nothing
                Just Text
a' ->
                    Address -> m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a m (Maybe Balance)
-> (Maybe Balance -> m (Maybe (Text, BinfoShortBal)))
-> m (Maybe (Text, BinfoShortBal))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Maybe Balance
Nothing -> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal)))
-> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a b. (a -> b) -> a -> b
$ (Text, BinfoShortBal) -> Maybe (Text, BinfoShortBal)
forall a. a -> Maybe a
Just (Text
a', Balance -> BinfoShortBal
to_short_bal (Address -> Balance
zeroBalance Address
a))
                        Just Balance
b -> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal)))
-> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a b. (a -> b) -> a -> b
$ (Text, BinfoShortBal) -> Maybe (Text, BinfoShortBal)
forall a. a -> Maybe a
Just (Text
a', Balance -> BinfoShortBal
to_short_bal Balance
b)
    is_ext :: XPubBal -> Bool
is_ext XPubBal{xPubBalPath :: XPubBal -> [Word32]
xPubBalPath = Word32
0 : [Word32]
_} = Bool
True
    is_ext XPubBal
_ = Bool
False
    get_xspec_balance :: Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
get_xspec_balance Network
net XPubSpec
xpub = do
        [XPubBal]
xbals <- XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
        Word32
xts <- XPubSpec -> [XPubBal] -> ActionT Except (ReaderT WebState m) Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
        let val :: Word64
val = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceAmount (Balance -> Word64) -> (XPubBal -> Balance) -> XPubBal -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
            zro :: Word64
zro = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceZero (Balance -> Word64) -> (XPubBal -> Balance) -> XPubBal -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
            exs :: [XPubBal]
exs = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
is_ext [XPubBal]
xbals
            rcv :: Word64
rcv = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceTotalReceived (Balance -> Word64) -> (XPubBal -> Balance) -> XPubBal -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
exs
            sbl :: BinfoShortBal
sbl =
                BinfoShortBal :: Word64 -> Word64 -> Word64 -> BinfoShortBal
BinfoShortBal
                    { binfoShortBalFinal :: Word64
binfoShortBalFinal = Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
zro
                    , binfoShortBalTxCount :: Word64
binfoShortBalTxCount = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
xts
                    , binfoShortBalReceived :: Word64
binfoShortBalReceived = Word64
rcv
                    }
        Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
        (Text, BinfoShortBal)
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Network -> XPubKey -> Text
xPubExport Network
net (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
xpub), BinfoShortBal
sbl)

getBinfoHex :: Monad m => WebT m Bool
getBinfoHex :: WebT m Bool
getBinfoHex =
    (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"hex" :: Text))
        (Text -> Bool)
-> ActionT Except (ReaderT WebState m) Text -> WebT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"format" ActionT Except (ReaderT WebState m) Text
-> (Except -> ActionT Except (ReaderT WebState m) Text)
-> ActionT Except (ReaderT WebState m) Text
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Text
-> Except -> ActionT Except (ReaderT WebState m) Text
forall a b. a -> b -> a
const (Text -> ActionT Except (ReaderT WebState m) Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"json")

scottyBinfoBlockHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoBlockHeight :: WebT m ()
scottyBinfoBlockHeight =
    WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId WebT m Bool -> (Bool -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
numtxid ->
        Text -> ActionT Except (ReaderT WebState m) Word32
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"height" ActionT Except (ReaderT WebState m) Word32
-> (Word32 -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word32
height ->
            (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainBlockHeight
                WebT m ()
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
height ActionT Except (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[BlockHash]
block_hashes -> do
                    [BlockData]
block_headers <- [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock [BlockHash]
block_hashes
                    [BlockHash]
next_block_hashes <- Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (Word32
height Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
                    [BlockData]
next_block_headers <- [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock [BlockHash]
next_block_hashes
                    [BinfoBlock]
binfo_blocks <-
                        (BlockData -> ActionT Except (ReaderT WebState m) BinfoBlock)
-> [BlockData] -> ActionT Except (ReaderT WebState m) [BinfoBlock]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> [BlockData]
-> BlockData
-> ActionT Except (ReaderT WebState m) BinfoBlock
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool
-> [BlockData]
-> BlockData
-> ActionT Except (ReaderT WebState m) BinfoBlock
get_binfo_blocks Bool
numtxid [BlockData]
next_block_headers) [BlockData]
block_headers
                    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
                    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
                    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BinfoBlock] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoBlock]
binfo_blocks)
                    Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Network -> [BinfoBlock] -> Encoding
binfoBlocksToEncoding Network
net [BinfoBlock]
binfo_blocks
  where
    get_tx :: TxHash -> m Transaction
get_tx TxHash
th =
        ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Transaction) -> m Transaction)
-> ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
            IO Transaction -> IO Transaction
forall a. IO a -> IO a
unsafeInterleaveIO (IO Transaction -> IO Transaction)
-> IO Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
                m Transaction -> IO Transaction
forall a. m a -> IO a
run (m Transaction -> IO Transaction)
-> m Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$ Maybe Transaction -> Transaction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Transaction -> Transaction)
-> m (Maybe Transaction) -> m Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
th
    get_binfo_blocks :: Bool
-> [BlockData]
-> BlockData
-> ActionT Except (ReaderT WebState m) BinfoBlock
get_binfo_blocks Bool
numtxid [BlockData]
next_block_headers BlockData
block_header = do
        let my_hash :: BlockHash
my_hash = BlockHeader -> BlockHash
H.headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
block_header)
            get_prev :: BlockData -> BlockHash
get_prev = BlockHeader -> BlockHash
H.prevBlock (BlockHeader -> BlockHash)
-> (BlockData -> BlockHeader) -> BlockData -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHeader
blockDataHeader
            get_hash :: BlockData -> BlockHash
get_hash = BlockHeader -> BlockHash
H.headerHash (BlockHeader -> BlockHash)
-> (BlockData -> BlockHeader) -> BlockData -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHeader
blockDataHeader
        [Transaction]
txs <- ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b. (a -> b) -> a -> b
$ (TxHash -> ReaderT WebState m Transaction)
-> [TxHash] -> ReaderT WebState m [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ReaderT WebState m Transaction
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Transaction
get_tx (BlockData -> [TxHash]
blockDataTxs BlockData
block_header)
        Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
        let next_blocks :: [BlockHash]
next_blocks =
                (BlockData -> BlockHash) -> [BlockData] -> [BlockHash]
forall a b. (a -> b) -> [a] -> [b]
map BlockData -> BlockHash
get_hash ([BlockData] -> [BlockHash]) -> [BlockData] -> [BlockHash]
forall a b. (a -> b) -> a -> b
$
                    (BlockData -> Bool) -> [BlockData] -> [BlockData]
forall a. (a -> Bool) -> [a] -> [a]
filter
                        ((BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
my_hash) (BlockHash -> Bool)
-> (BlockData -> BlockHash) -> BlockData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHash
get_prev)
                        [BlockData]
next_block_headers
        let binfo_txs :: [BinfoTx]
binfo_txs = (Transaction -> BinfoTx) -> [Transaction] -> [BinfoTx]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
            binfo_block :: BinfoBlock
binfo_block = BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock BlockData
block_header [BinfoTx]
binfo_txs [BlockHash]
next_blocks
        BinfoBlock -> ActionT Except (ReaderT WebState m) BinfoBlock
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoBlock
binfo_block

scottyBinfoLatest :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoLatest :: WebT m ()
scottyBinfoLatest = do
    Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainLatestblock
    BlockData
best <- ActionT Except (ReaderT WebState m) BlockData
get_best_block
    let binfoTxIndices :: [BinfoTxId]
binfoTxIndices = (TxHash -> BinfoTxId) -> [TxHash] -> [BinfoTxId]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid) (BlockData -> [TxHash]
blockDataTxs BlockData
best)
        binfoHeaderHash :: BlockHash
binfoHeaderHash = BlockHeader -> BlockHash
H.headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
best)
        binfoHeaderTime :: Word32
binfoHeaderTime = BlockHeader -> Word32
H.blockTimestamp (BlockData -> BlockHeader
blockDataHeader BlockData
best)
        binfoHeaderIndex :: Word32
binfoHeaderIndex = Word32
binfoHeaderTime
        binfoHeaderHeight :: Word32
binfoHeaderHeight = BlockData -> Word32
blockDataHeight BlockData
best
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ BinfoHeader -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoHeader :: BlockHash
-> Word32 -> Word32 -> Word32 -> [BinfoTxId] -> BinfoHeader
BinfoHeader{[BinfoTxId]
Word32
BlockHash
binfoHeaderHash :: BlockHash
binfoHeaderTime :: Word32
binfoHeaderIndex :: Word32
binfoHeaderHeight :: Word32
binfoTxIndices :: [BinfoTxId]
binfoHeaderHeight :: Word32
binfoHeaderIndex :: Word32
binfoHeaderTime :: Word32
binfoHeaderHash :: BlockHash
binfoTxIndices :: [BinfoTxId]
..}
  where
    get_best_block :: ActionT Except (ReaderT WebState m) BlockData
get_best_block =
        ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockHash
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockHash
bh ->
                BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
                    Just BlockData
b -> BlockData -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b

scottyBinfoBlock :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoBlock :: WebT m ()
scottyBinfoBlock =
    WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId WebT m Bool -> (Bool -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
numtxid ->
        WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getBinfoHex WebT m Bool -> (Bool -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
hex ->
            (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainRawblock
                WebT m ()
-> ActionT Except (ReaderT WebState m) BinfoBlockId
-> ActionT Except (ReaderT WebState m) BinfoBlockId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ActionT Except (ReaderT WebState m) BinfoBlockId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"block" ActionT Except (ReaderT WebState m) BinfoBlockId
-> (BinfoBlockId -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    BinfoBlockHash BlockHash
bh -> Bool -> Bool -> BlockHash -> WebT m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
                    BinfoBlockIndex Word32
i ->
                        Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
i ActionT Except (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> WebT m ()) -> WebT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            [] -> Except -> WebT m ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
                            BlockHash
bh : [BlockHash]
_ -> Bool -> Bool -> BlockHash -> WebT m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
  where
    get_tx :: TxHash -> m Transaction
get_tx TxHash
th =
        ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Transaction) -> m Transaction)
-> ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
            IO Transaction -> IO Transaction
forall a. IO a -> IO a
unsafeInterleaveIO (IO Transaction -> IO Transaction)
-> IO Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
                m Transaction -> IO Transaction
forall a. m a -> IO a
run (m Transaction -> IO Transaction)
-> m Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$ Maybe Transaction -> Transaction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Transaction -> Transaction)
-> m (Maybe Transaction) -> m Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
th
    go :: Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh =
        BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> ActionT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockData
b -> do
                [Transaction]
txs <- ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b. (a -> b) -> a -> b
$ (TxHash -> ReaderT WebState m Transaction)
-> [TxHash] -> ReaderT WebState m [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ReaderT WebState m Transaction
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Transaction
get_tx (BlockData -> [TxHash]
blockDataTxs BlockData
b)
                let my_hash :: BlockHash
my_hash = BlockHeader -> BlockHash
H.headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
b)
                    get_prev :: BlockData -> BlockHash
get_prev = BlockHeader -> BlockHash
H.prevBlock (BlockHeader -> BlockHash)
-> (BlockData -> BlockHeader) -> BlockData -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHeader
blockDataHeader
                    get_hash :: BlockData -> BlockHash
get_hash = BlockHeader -> BlockHash
H.headerHash (BlockHeader -> BlockHash)
-> (BlockData -> BlockHeader) -> BlockData -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHeader
blockDataHeader
                [BlockData]
nxt_headers <-
                    ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes (ActionT Except (ReaderT WebState m) [Maybe BlockData]
 -> ActionT Except (ReaderT WebState m) [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall a b. (a -> b) -> a -> b
$
                        (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
                            ([BlockHash]
 -> ActionT Except (ReaderT WebState m) [Maybe BlockData])
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (BlockData -> Word32
blockDataHeight BlockData
b Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
                let nxt :: [BlockHash]
nxt =
                        (BlockData -> BlockHash) -> [BlockData] -> [BlockHash]
forall a b. (a -> b) -> [a] -> [b]
map BlockData -> BlockHash
get_hash ([BlockData] -> [BlockHash]) -> [BlockData] -> [BlockHash]
forall a b. (a -> b) -> a -> b
$
                            (BlockData -> Bool) -> [BlockData] -> [BlockData]
forall a. (a -> Bool) -> [a] -> [a]
filter
                                ((BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
my_hash) (BlockHash -> Bool)
-> (BlockData -> BlockHash) -> BlockData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHash
get_prev)
                                [BlockData]
nxt_headers
                if Bool
hex
                    then do
                        let x :: Block
x = BlockHeader -> [Tx] -> Block
H.Block (BlockData -> BlockHeader
blockDataHeader BlockData
b) ((Transaction -> Tx) -> [Transaction] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Tx
transactionData [Transaction]
txs)
                        ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
                        Text -> ActionT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> ActionT Except (ReaderT WebState m) ())
-> (Put -> Text) -> Put -> ActionT Except (ReaderT WebState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy (ByteString -> Text) -> (Put -> ByteString) -> Put -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ActionT Except (ReaderT WebState m) ())
-> Put -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Block -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Block
x
                    else do
                        let btxs :: [BinfoTx]
btxs = (Transaction -> BinfoTx) -> [Transaction] -> [BinfoTx]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
                            y :: BinfoBlock
y = BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock BlockData
b [BinfoTx]
btxs [BlockHash]
nxt
                        ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
                        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
                        Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
btxs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Network -> BinfoBlock -> Encoding
binfoBlockToEncoding Network
net BinfoBlock
y

getBinfoTx ::
    (MonadLoggerIO m, MonadUnliftIO m) =>
    BinfoTxId ->
    WebT m (Either Except Transaction)
getBinfoTx :: BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid = do
    [Transaction]
tx <- case BinfoTxId
txid of
        BinfoTxIdHash TxHash
h -> Maybe Transaction -> [Transaction]
forall a. Maybe a -> [a]
maybeToList (Maybe Transaction -> [Transaction])
-> ActionT Except (ReaderT WebState m) (Maybe Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h
        BinfoTxIdIndex Word64
i -> Word64 -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(Monad m, StoreReadExtra m) =>
Word64 -> m [Transaction]
getNumTransaction Word64
i
    case [Transaction]
tx of
        [Transaction
t] -> Either Except Transaction -> WebT m (Either Except Transaction)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction -> WebT m (Either Except Transaction))
-> Either Except Transaction -> WebT m (Either Except Transaction)
forall a b. (a -> b) -> a -> b
$ Transaction -> Either Except Transaction
forall a b. b -> Either a b
Right Transaction
t
        [] -> Either Except Transaction -> WebT m (Either Except Transaction)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction -> WebT m (Either Except Transaction))
-> Either Except Transaction -> WebT m (Either Except Transaction)
forall a b. (a -> b) -> a -> b
$ Except -> Either Except Transaction
forall a b. a -> Either a b
Left Except
ThingNotFound
        [Transaction]
ts ->
            let tids :: [TxHash]
tids = (Transaction -> TxHash) -> [Transaction] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Tx -> TxHash
txHash (Tx -> TxHash) -> (Transaction -> Tx) -> Transaction -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Tx
transactionData) [Transaction]
ts
             in Either Except Transaction -> WebT m (Either Except Transaction)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction -> WebT m (Either Except Transaction))
-> Either Except Transaction -> WebT m (Either Except Transaction)
forall a b. (a -> b) -> a -> b
$ Except -> Either Except Transaction
forall a b. a -> Either a b
Left ([TxHash] -> Except
TxIndexConflict [TxHash]
tids)

scottyBinfoTx :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoTx :: WebT m ()
scottyBinfoTx = do
    Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
    Bool
hex <- WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getBinfoHex
    BinfoTxId
txid <- Text -> ActionT Except (ReaderT WebState m) BinfoTxId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txid"
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainRawtx
    Transaction
tx <-
        BinfoTxId -> WebT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid WebT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT Except (ReaderT WebState m) Transaction)
-> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right Transaction
t -> Transaction -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
            Left Except
e -> Except -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
e
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    if Bool
hex then Transaction -> WebT m ()
forall (m :: * -> *) e.
(Monad m, ScottyError e) =>
Transaction -> ActionT e m ()
hx Transaction
tx else Bool -> Transaction -> WebT m ()
forall (m :: * -> *).
Monad m =>
Bool -> Transaction -> ActionT Except (ReaderT WebState m) ()
js Bool
numtxid Transaction
tx
  where
    js :: Bool -> Transaction -> ActionT Except (ReaderT WebState m) ()
js Bool
numtxid Transaction
t = do
        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
        Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Network -> BinfoTx -> Encoding
binfoTxToEncoding Network
net (BinfoTx -> Encoding) -> BinfoTx -> Encoding
forall a b. (a -> b) -> a -> b
$ Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid Transaction
t
    hx :: Transaction -> ActionT e m ()
hx Transaction
t = do
        ActionT e m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
        Text -> ActionT e m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> ActionT e m ()) -> (Tx -> Text) -> Tx -> ActionT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy (ByteString -> Text) -> (Tx -> ByteString) -> Tx -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (Tx -> Put) -> Tx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Tx -> ActionT e m ()) -> Tx -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData Transaction
t

scottyBinfoTotalOut :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoTotalOut :: WebT m ()
scottyBinfoTotalOut = do
    BinfoTxId
txid <- Text -> ActionT Except (ReaderT WebState m) BinfoTxId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txid"
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQtxtotalbtcoutput
    Transaction
tx <-
        BinfoTxId -> WebT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid WebT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT Except (ReaderT WebState m) Transaction)
-> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right Transaction
t -> Transaction -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
            Left Except
e -> Except -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
e
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ())
-> ([StoreOutput] -> Text) -> [StoreOutput] -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text)
-> ([StoreOutput] -> String) -> [StoreOutput] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String)
-> ([StoreOutput] -> Word64) -> [StoreOutput] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> ([StoreOutput] -> [Word64]) -> [StoreOutput] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> Word64
outputAmount ([StoreOutput] -> WebT m ()) -> [StoreOutput] -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Transaction -> [StoreOutput]
transactionOutputs Transaction
tx

scottyBinfoTxFees :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoTxFees :: WebT m ()
scottyBinfoTxFees = do
    BinfoTxId
txid <- Text -> ActionT Except (ReaderT WebState m) BinfoTxId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txid"
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQtxfee
    Transaction
tx <-
        BinfoTxId -> WebT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid WebT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT Except (ReaderT WebState m) Transaction)
-> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right Transaction
t -> Transaction -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
            Left Except
e -> Except -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
e
    let i :: Word64
i =
            [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> ([StoreInput] -> [Word64]) -> [StoreInput] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Word64
inputAmount ([StoreInput] -> [Word64])
-> ([StoreInput] -> [StoreInput]) -> [StoreInput] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> Bool) -> [StoreInput] -> [StoreInput]
forall a. (a -> Bool) -> [a] -> [a]
filter StoreInput -> Bool
f ([StoreInput] -> Word64) -> [StoreInput] -> Word64
forall a b. (a -> b) -> a -> b
$
                Transaction -> [StoreInput]
transactionInputs Transaction
tx
        o :: Word64
o = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> ([StoreOutput] -> [Word64]) -> [StoreOutput] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> Word64
outputAmount ([StoreOutput] -> Word64) -> [StoreOutput] -> Word64
forall a b. (a -> b) -> a -> b
$ Transaction -> [StoreOutput]
transactionOutputs Transaction
tx
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Word64 -> Text) -> Word64 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> WebT m ()) -> Word64 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
o
  where
    f :: StoreInput -> Bool
f StoreInput{} = Bool
True
    f StoreCoinbase{} = Bool
False

scottyBinfoTxResult :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoTxResult :: WebT m ()
scottyBinfoTxResult = do
    BinfoTxId
txid <- Text -> ActionT Except (ReaderT WebState m) BinfoTxId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txid"
    Address
addr <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQtxresult
    Transaction
tx <-
        BinfoTxId -> WebT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid WebT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT Except (ReaderT WebState m) Transaction)
-> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right Transaction
t -> Transaction -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
            Left Except
e -> Except -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
e
    let i :: Integer
i =
            Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer)
-> ([StoreInput] -> Word64) -> [StoreInput] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> ([StoreInput] -> [Word64]) -> [StoreInput] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Word64
inputAmount ([StoreInput] -> [Word64])
-> ([StoreInput] -> [StoreInput]) -> [StoreInput] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> Bool) -> [StoreInput] -> [StoreInput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Address -> StoreInput -> Bool
f Address
addr) ([StoreInput] -> Integer) -> [StoreInput] -> Integer
forall a b. (a -> b) -> a -> b
$
                Transaction -> [StoreInput]
transactionInputs Transaction
tx
        o :: Integer
o =
            Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer)
-> ([StoreOutput] -> Word64) -> [StoreOutput] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> ([StoreOutput] -> [Word64]) -> [StoreOutput] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> Word64
outputAmount ([StoreOutput] -> [Word64])
-> ([StoreOutput] -> [StoreOutput]) -> [StoreOutput] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreOutput -> Bool) -> [StoreOutput] -> [StoreOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Address -> StoreOutput -> Bool
g Address
addr) ([StoreOutput] -> Integer) -> [StoreOutput] -> Integer
forall a b. (a -> b) -> a -> b
$
                Transaction -> [StoreOutput]
transactionOutputs Transaction
tx
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Integer -> Text) -> Integer -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> WebT m ()) -> Integer -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Integer
o Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i
  where
    f :: Address -> StoreInput -> Bool
f Address
addr StoreInput{inputAddress :: StoreInput -> Maybe Address
inputAddress = Just Address
a} = Address
a Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr
    f Address
_ StoreInput
_ = Bool
False
    g :: Address -> StoreOutput -> Bool
g Address
addr StoreOutput{outputAddr :: StoreOutput -> Maybe Address
outputAddr = Just Address
a} = Address
a Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr
    g Address
_ StoreOutput
_ = Bool
False

scottyBinfoTotalInput :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoTotalInput :: WebT m ()
scottyBinfoTotalInput = do
    BinfoTxId
txid <- Text -> ActionT Except (ReaderT WebState m) BinfoTxId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txid"
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQtxtotalbtcinput
    Transaction
tx <-
        BinfoTxId -> WebT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid WebT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT Except (ReaderT WebState m) Transaction)
-> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right Transaction
t -> Transaction -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
            Left Except
e -> Except -> ActionT Except (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
e
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ())
-> ([StoreInput] -> Text) -> [StoreInput] -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text)
-> ([StoreInput] -> String) -> [StoreInput] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String)
-> ([StoreInput] -> Word64) -> [StoreInput] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> ([StoreInput] -> [Word64]) -> [StoreInput] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Word64
inputAmount ([StoreInput] -> [Word64])
-> ([StoreInput] -> [StoreInput]) -> [StoreInput] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> Bool) -> [StoreInput] -> [StoreInput]
forall a. (a -> Bool) -> [a] -> [a]
filter StoreInput -> Bool
f ([StoreInput] -> WebT m ()) -> [StoreInput] -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Transaction -> [StoreInput]
transactionInputs Transaction
tx
  where
    f :: StoreInput -> Bool
f StoreInput{} = Bool
True
    f StoreCoinbase{} = Bool
False

scottyBinfoMempool :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoMempool :: WebT m ()
scottyBinfoMempool = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainMempool
    Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
    Int
offset <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
    Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"limit"
    [(Word64, TxHash)]
mempool <- ActionT Except (ReaderT WebState m) [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
    let txids :: [TxHash]
txids = ((Word64, TxHash) -> TxHash) -> [(Word64, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(Word64, TxHash)] -> [TxHash]) -> [(Word64, TxHash)] -> [TxHash]
forall a b. (a -> b) -> a -> b
$ Int -> [(Word64, TxHash)] -> [(Word64, TxHash)]
forall a. Int -> [a] -> [a]
take Int
n ([(Word64, TxHash)] -> [(Word64, TxHash)])
-> [(Word64, TxHash)] -> [(Word64, TxHash)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Word64, TxHash)] -> [(Word64, TxHash)]
forall a. Int -> [a] -> [a]
drop Int
offset [(Word64, TxHash)]
mempool
    [Transaction]
txs <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxHash]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction [TxHash]
txids
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    let mem :: BinfoMempool
mem = [BinfoTx] -> BinfoMempool
BinfoMempool ([BinfoTx] -> BinfoMempool) -> [BinfoTx] -> BinfoMempool
forall a b. (a -> b) -> a -> b
$ (Transaction -> BinfoTx) -> [Transaction] -> [BinfoTx]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
    Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Network -> BinfoMempool -> Encoding
binfoMempoolToEncoding Network
net BinfoMempool
mem

scottyBinfoGetBlockCount :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoGetBlockCount :: WebT m ()
scottyBinfoGetBlockCount = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQgetblockcount
    Chain
ch <- (WebState -> Chain) -> ActionT Except (ReaderT WebState m) Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    BlockNode
bn <- Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Word32 -> Text) -> Word32 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Word32 -> String) -> Word32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> String
forall a. Show a => a -> String
show (Word32 -> WebT m ()) -> Word32 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ BlockNode -> Word32
H.nodeHeight BlockNode
bn

scottyBinfoLatestHash :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoLatestHash :: WebT m ()
scottyBinfoLatestHash = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQlatesthash
    Chain
ch <- (WebState -> Chain) -> ActionT Except (ReaderT WebState m) Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    BlockNode
bn <- Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ())
-> (BlockHeader -> Text) -> BlockHeader -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict (Text -> Text) -> (BlockHeader -> Text) -> BlockHeader -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Text
H.blockHashToHex (BlockHash -> Text)
-> (BlockHeader -> BlockHash) -> BlockHeader -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> BlockHash
H.headerHash (BlockHeader -> WebT m ()) -> BlockHeader -> WebT m ()
forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
H.nodeHeader BlockNode
bn

scottyBinfoSubsidy :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoSubsidy :: WebT m ()
scottyBinfoSubsidy = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQbcperblock
    Chain
ch <- (WebState -> Chain) -> ActionT Except (ReaderT WebState m) Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Network
net <- (WebState -> Network)
-> ActionT Except (ReaderT WebState m) Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    BlockNode
bn <- Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Word64 -> Text) -> Word64 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (Word64 -> String) -> Word64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> String) -> (Word64 -> Double) -> Word64 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 :: Double)) (Double -> Double) -> (Word64 -> Double) -> Word64 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> WebT m ()) -> Word64 -> WebT m ()
forall a b. (a -> b) -> a -> b
$
        Network -> Word32 -> Word64
H.computeSubsidy Network
net (BlockNode -> Word32
H.nodeHeight BlockNode
bn Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)

scottyBinfoAddrToHash :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoAddrToHash :: WebT m ()
scottyBinfoAddrToHash = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQaddresstohash
    Address
addr <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Hash160 -> Text) -> Hash160 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy (ByteString -> Text) -> (Hash160 -> ByteString) -> Hash160 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (Hash160 -> Put) -> Hash160 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Hash160 -> WebT m ()) -> Hash160 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Address -> Hash160
getAddrHash160 Address
addr

scottyBinfoHashToAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoHashToAddr :: WebT m ()
scottyBinfoHashToAddr = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQhashtoaddress
    ByteString
bs <- ActionT Except (ReaderT WebState m) ByteString
-> (ByteString -> ActionT Except (ReaderT WebState m) ByteString)
-> Maybe ByteString
-> ActionT Except (ReaderT WebState m) ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT Except (ReaderT WebState m) ByteString
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next ByteString -> ActionT Except (ReaderT WebState m) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
 -> ActionT Except (ReaderT WebState m) ByteString)
-> (Text -> Maybe ByteString)
-> Text
-> ActionT Except (ReaderT WebState m) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> ActionT Except (ReaderT WebState m) ByteString)
-> ActionT Except (ReaderT WebState m) Text
-> ActionT Except (ReaderT WebState m) ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"hash"
    Network
net <- (WebState -> Network)
-> ActionT Except (ReaderT WebState m) Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Hash160
hash <- (String -> ActionT Except (ReaderT WebState m) Hash160)
-> (Hash160 -> ActionT Except (ReaderT WebState m) Hash160)
-> Either String Hash160
-> ActionT Except (ReaderT WebState m) Hash160
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT Except (ReaderT WebState m) Hash160
-> String -> ActionT Except (ReaderT WebState m) Hash160
forall a b. a -> b -> a
const ActionT Except (ReaderT WebState m) Hash160
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next) Hash160 -> ActionT Except (ReaderT WebState m) Hash160
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String Hash160
forall a. Serialize a => ByteString -> Either String a
decode ByteString
bs)
    Text
addr <- ActionT Except (ReaderT WebState m) Text
-> (Text -> ActionT Except (ReaderT WebState m) Text)
-> Maybe Text
-> ActionT Except (ReaderT WebState m) Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT Except (ReaderT WebState m) Text
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next Text -> ActionT Except (ReaderT WebState m) Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Network -> Address -> Maybe Text
addrToText Network
net (Hash160 -> Address
PubKeyAddress Hash160
hash))
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
addr

scottyBinfoAddrPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoAddrPubkey :: WebT m ()
scottyBinfoAddrPubkey = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQaddrpubkey
    Text
hex <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"pubkey"
    Address
pubkey <-
        ActionT Except (ReaderT WebState m) Address
-> (PubKeyI -> ActionT Except (ReaderT WebState m) Address)
-> Maybe PubKeyI
-> ActionT Except (ReaderT WebState m) Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT Except (ReaderT WebState m) Address
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next (Address -> ActionT Except (ReaderT WebState m) Address
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> ActionT Except (ReaderT WebState m) Address)
-> (PubKeyI -> Address)
-> PubKeyI
-> ActionT Except (ReaderT WebState m) Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Address
pubKeyAddr) (Maybe PubKeyI -> ActionT Except (ReaderT WebState m) Address)
-> Maybe PubKeyI -> ActionT Except (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$
            Either String PubKeyI -> Maybe PubKeyI
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String PubKeyI -> Maybe PubKeyI)
-> (ByteString -> Either String PubKeyI)
-> ByteString
-> Maybe PubKeyI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get PubKeyI -> ByteString -> Either String PubKeyI
forall a. Get a -> ByteString -> Either String a
runGetS Get PubKeyI
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Maybe PubKeyI) -> Maybe ByteString -> Maybe PubKeyI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString
decodeHex Text
hex
    Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    case Network -> Address -> Maybe Text
addrToText Network
net Address
pubkey of
        Maybe Text
Nothing -> Except -> WebT m ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just Text
a -> do
            Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
            Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
a

scottyBinfoPubKeyAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoPubKeyAddr :: WebT m ()
scottyBinfoPubKeyAddr = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQpubkeyaddr
    Address
addr <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
    Maybe StoreInput
mi <- Address -> ActionT Except (ReaderT WebState m) (Maybe StoreInput)
forall (m :: * -> *).
StoreReadExtra m =>
Address -> m (Maybe StoreInput)
strm Address
addr
    StoreInput
i <- case Maybe StoreInput
mi of
        Maybe StoreInput
Nothing -> Except -> ActionT Except (ReaderT WebState m) StoreInput
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just StoreInput
i -> StoreInput -> ActionT Except (ReaderT WebState m) StoreInput
forall (m :: * -> *) a. Monad m => a -> m a
return StoreInput
i
    ByteString
pk <- case Address -> StoreInput -> Either String ByteString
extr Address
addr StoreInput
i of
        Left String
e -> Except -> ActionT Except (ReaderT WebState m) ByteString
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> ActionT Except (ReaderT WebState m) ByteString)
-> Except -> ActionT Except (ReaderT WebState m) ByteString
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
e
        Right ByteString
t -> ByteString -> ActionT Except (ReaderT WebState m) ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
t
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHexLazy (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
pk
  where
    strm :: Address -> m (Maybe StoreInput)
strm Address
addr =
        ConduitT () Void m (Maybe StoreInput) -> m (Maybe StoreInput)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m (Maybe StoreInput) -> m (Maybe StoreInput))
-> ConduitT () Void m (Maybe StoreInput) -> m (Maybe StoreInput)
forall a b. (a -> b) -> a -> b
$
            (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash) Limits
forall a. Default a => a
def{limit :: Word32
limit = Word32
50}
                ConduitT () TxRef m ()
-> ConduitM TxRef Void m (Maybe StoreInput)
-> ConduitT () Void m (Maybe StoreInput)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (TxRef -> m (Maybe Transaction))
-> ConduitT TxRef (Element (Maybe Transaction)) m ()
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> m mono) -> ConduitT a (Element mono) m ()
concatMapMC (TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> m (Maybe Transaction))
-> (TxRef -> TxHash) -> TxRef -> m (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxRef -> TxHash
txRefHash)
                ConduitT TxRef Transaction m ()
-> ConduitM Transaction Void m (Maybe StoreInput)
-> ConduitM TxRef Void m (Maybe StoreInput)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Transaction -> [StoreInput])
-> ConduitT Transaction (Element [StoreInput]) m ()
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> mono) -> ConduitT a (Element mono) m ()
concatMapC ((StoreInput -> Bool) -> [StoreInput] -> [StoreInput]
forall a. (a -> Bool) -> [a] -> [a]
filter (Address -> StoreInput -> Bool
inp Address
addr) ([StoreInput] -> [StoreInput])
-> (Transaction -> [StoreInput]) -> Transaction -> [StoreInput]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [StoreInput]
transactionInputs)
                ConduitT Transaction StoreInput m ()
-> ConduitM StoreInput Void m (Maybe StoreInput)
-> ConduitM Transaction Void m (Maybe StoreInput)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM StoreInput Void m (Maybe StoreInput)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC
    inp :: Address -> StoreInput -> Bool
inp Address
addr StoreInput{inputAddress :: StoreInput -> Maybe Address
inputAddress = Just Address
a} = Address
a Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr
    inp Address
_ StoreInput
_ = Bool
False
    extr :: Address -> StoreInput -> Either String ByteString
extr Address
addr StoreInput{ByteString
inputSigScript :: StoreInput -> ByteString
inputSigScript :: ByteString
inputSigScript, ByteString
inputPkScript :: StoreInput -> ByteString
inputPkScript :: ByteString
inputPkScript, WitnessStack
inputWitness :: StoreInput -> WitnessStack
inputWitness :: WitnessStack
inputWitness} = do
        Script [ScriptOp]
sig <- ByteString -> Either String Script
forall a. Serialize a => ByteString -> Either String a
decode ByteString
inputSigScript
        Script [ScriptOp]
pks <- ByteString -> Either String Script
forall a. Serialize a => ByteString -> Either String a
decode ByteString
inputPkScript
        case Address
addr of
            PubKeyAddress{} ->
                case [ScriptOp]
sig of
                    [OP_PUSHDATA ByteString
_ PushDataType
_, OP_PUSHDATA ByteString
pub PushDataType
_] ->
                        ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
pub
                    [OP_PUSHDATA ByteString
_ PushDataType
_] ->
                        case [ScriptOp]
pks of
                            [OP_PUSHDATA ByteString
pub PushDataType
_, ScriptOp
OP_CHECKSIG] ->
                                ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
pub
                            [ScriptOp]
_ -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Could not parse scriptPubKey"
                    [ScriptOp]
_ -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Could not parse scriptSig"
            WitnessPubKeyAddress{} ->
                case WitnessStack
inputWitness of
                    [ByteString
_, ByteString
pub] -> ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
pub
                    WitnessStack
_ -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Could not parse scriptPubKey"
            Address
_ -> String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Address does not have public key"
    extr Address
_ StoreInput
_ = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Incorrect input type"

scottyBinfoHashPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoHashPubkey :: WebT m ()
scottyBinfoHashPubkey = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQhashpubkey
    Maybe PubKeyI
pkm <- (Either String PubKeyI -> Maybe PubKeyI
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String PubKeyI -> Maybe PubKeyI)
-> (ByteString -> Either String PubKeyI)
-> ByteString
-> Maybe PubKeyI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get PubKeyI -> ByteString -> Either String PubKeyI
forall a. Get a -> ByteString -> Either String a
runGetS Get PubKeyI
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Maybe PubKeyI)
-> (Text -> Maybe ByteString) -> Text -> Maybe PubKeyI
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex) (Text -> Maybe PubKeyI)
-> ActionT Except (ReaderT WebState m) Text
-> ActionT Except (ReaderT WebState m) (Maybe PubKeyI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"pubkey"
    Address
addr <- case Maybe PubKeyI
pkm of
        Maybe PubKeyI
Nothing -> Except -> ActionT Except (ReaderT WebState m) Address
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> ActionT Except (ReaderT WebState m) Address)
-> Except -> ActionT Except (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
"Could not decode public key"
        Just PubKeyI
pk -> Address -> ActionT Except (ReaderT WebState m) Address
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> ActionT Except (ReaderT WebState m) Address)
-> Address -> ActionT Except (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$ PubKeyI -> Address
pubKeyAddr PubKeyI
pk
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> (Hash160 -> Text) -> Hash160 -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy (ByteString -> Text) -> (Hash160 -> ByteString) -> Hash160 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (Hash160 -> Put) -> Hash160 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Hash160 -> WebT m ()) -> Hash160 -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Address -> Hash160
getAddrHash160 Address
addr

-- GET Network Information --

scottyPeers ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    GetPeers ->
    WebT m [PeerInformation]
scottyPeers :: GetPeers -> WebT m [PeerInformation]
scottyPeers GetPeers
_ = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statPeers
    [PeerInformation]
ps <-
        ReaderT WebState m [PeerInformation] -> WebT m [PeerInformation]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [PeerInformation] -> WebT m [PeerInformation])
-> ReaderT WebState m [PeerInformation] -> WebT m [PeerInformation]
forall a b. (a -> b) -> a -> b
$
            PeerManager -> ReaderT WebState m [PeerInformation]
forall (m :: * -> *).
MonadLoggerIO m =>
PeerManager -> m [PeerInformation]
getPeersInformation
                (PeerManager -> ReaderT WebState m [PeerInformation])
-> ReaderT WebState m PeerManager
-> ReaderT WebState m [PeerInformation]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WebState -> PeerManager) -> ReaderT WebState m PeerManager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> PeerManager
storeManager (Store -> PeerManager)
-> (WebState -> Store) -> WebState -> PeerManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([PeerInformation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PeerInformation]
ps)
    [PeerInformation] -> WebT m [PeerInformation]
forall (m :: * -> *) a. Monad m => a -> m a
return [PeerInformation]
ps

-- | Obtain information about connected peers from peer manager process.
getPeersInformation ::
    MonadLoggerIO m => PeerManager -> m [PeerInformation]
getPeersInformation :: PeerManager -> m [PeerInformation]
getPeersInformation PeerManager
mgr =
    (OnlinePeer -> Maybe PeerInformation)
-> [OnlinePeer] -> [PeerInformation]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe OnlinePeer -> Maybe PeerInformation
toInfo ([OnlinePeer] -> [PeerInformation])
-> m [OnlinePeer] -> m [PeerInformation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerManager -> m [OnlinePeer]
forall (m :: * -> *). MonadIO m => PeerManager -> m [OnlinePeer]
getPeers PeerManager
mgr
  where
    toInfo :: OnlinePeer -> Maybe PeerInformation
toInfo OnlinePeer
op = do
        Version
ver <- OnlinePeer -> Maybe Version
onlinePeerVersion OnlinePeer
op
        let as :: SockAddr
as = OnlinePeer -> SockAddr
onlinePeerAddress OnlinePeer
op
            ua :: ByteString
ua = VarString -> ByteString
getVarString (VarString -> ByteString) -> VarString -> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> VarString
userAgent Version
ver
            vs :: Word32
vs = Version -> Word32
version Version
ver
            sv :: Word64
sv = Version -> Word64
services Version
ver
            rl :: Bool
rl = Version -> Bool
relay Version
ver
        PeerInformation -> Maybe PeerInformation
forall (m :: * -> *) a. Monad m => a -> m a
return
            PeerInformation :: ByteString -> String -> Word32 -> Word64 -> Bool -> PeerInformation
PeerInformation
                { peerUserAgent :: ByteString
peerUserAgent = ByteString
ua
                , peerAddress :: String
peerAddress = SockAddr -> String
forall a. Show a => a -> String
show SockAddr
as
                , peerVersion :: Word32
peerVersion = Word32
vs
                , peerServices :: Word64
peerServices = Word64
sv
                , peerRelay :: Bool
peerRelay = Bool
rl
                }

scottyHealth ::
    (MonadUnliftIO m, MonadLoggerIO m) => GetHealth -> WebT m HealthCheck
scottyHealth :: GetHealth -> WebT m HealthCheck
scottyHealth GetHealth
_ = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statHealth
    HealthCheck
h <- ReaderT WebState m HealthCheck -> WebT m HealthCheck
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m HealthCheck -> WebT m HealthCheck)
-> ReaderT WebState m HealthCheck -> WebT m HealthCheck
forall a b. (a -> b) -> a -> b
$ (WebState -> WebConfig) -> ReaderT WebState m WebConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> WebConfig
webConfig ReaderT WebState m WebConfig
-> (WebConfig -> ReaderT WebState m HealthCheck)
-> ReaderT WebState m HealthCheck
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WebConfig -> ReaderT WebState m HealthCheck
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m HealthCheck
healthCheck
    Bool -> WebT m () -> WebT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h) (WebT m () -> WebT m ()) -> WebT m () -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Status -> WebT m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
S.status Status
status503
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    HealthCheck -> WebT m HealthCheck
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
h

blockHealthCheck ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    WebConfig ->
    m BlockHealth
blockHealthCheck :: WebConfig -> m BlockHealth
blockHealthCheck WebConfig
cfg = do
    let ch :: Chain
ch = Store -> Chain
storeChain (Store -> Chain) -> Store -> Chain
forall a b. (a -> b) -> a -> b
$ WebConfig -> Store
webStore WebConfig
cfg
        blockHealthMaxDiff :: Int32
blockHealthMaxDiff = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ WebConfig -> Int
webMaxDiff WebConfig
cfg
    Word32
blockHealthHeaders <-
        BlockNode -> Word32
H.nodeHeight (BlockNode -> Word32) -> m BlockNode -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    Word32
blockHealthBlocks <-
        Word32 -> (BlockData -> Word32) -> Maybe BlockData -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 BlockData -> Word32
blockDataHeight
            (Maybe BlockData -> Word32) -> m (Maybe BlockData) -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m BlockData -> m (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (m (Maybe BlockHash) -> MaybeT m BlockHash
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock MaybeT m BlockHash
-> (BlockHash -> MaybeT m BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> (BlockHash -> m (Maybe BlockData))
-> BlockHash
-> MaybeT m BlockData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock)
    BlockHealth -> m BlockHealth
forall (m :: * -> *) a. Monad m => a -> m a
return BlockHealth :: Word32 -> Word32 -> Int32 -> BlockHealth
BlockHealth{Int32
Word32
blockHealthHeaders :: Word32
blockHealthBlocks :: Word32
blockHealthMaxDiff :: Int32
blockHealthBlocks :: Word32
blockHealthHeaders :: Word32
blockHealthMaxDiff :: Int32
..}

lastBlockHealthCheck ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    Chain ->
    WebTimeouts ->
    m TimeHealth
lastBlockHealthCheck :: Chain -> WebTimeouts -> m TimeHealth
lastBlockHealthCheck Chain
ch WebTimeouts
tos = do
    Int64
n <- Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (SystemTime -> Int64) -> SystemTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds (SystemTime -> Int64) -> m SystemTime -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
    Int64
t <- Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (BlockNode -> Word32) -> BlockNode -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> Word32
H.blockTimestamp (BlockHeader -> Word32)
-> (BlockNode -> BlockHeader) -> BlockNode -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
H.nodeHeader (BlockNode -> Int64) -> m BlockNode -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    let timeHealthAge :: Int64
timeHealthAge = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
t
        timeHealthMax :: Int64
timeHealthMax = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ WebTimeouts -> Word64
blockTimeout WebTimeouts
tos
    TimeHealth -> m TimeHealth
forall (m :: * -> *) a. Monad m => a -> m a
return TimeHealth :: Int64 -> Int64 -> TimeHealth
TimeHealth{Int64
timeHealthAge :: Int64
timeHealthMax :: Int64
timeHealthMax :: Int64
timeHealthAge :: Int64
..}

lastTxHealthCheck ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    WebConfig ->
    m TimeHealth
lastTxHealthCheck :: WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig{Bool
Int
String
Maybe Store
Store
WebTimeouts
WebLimits
webHistoryURL :: String
webTickerURL :: String
webPriceGet :: Int
webStats :: Maybe Store
webNoMempool :: Bool
webVersion :: String
webTimeouts :: WebTimeouts
webMaxLimits :: WebLimits
webMaxPending :: Int
webMaxDiff :: Int
webStore :: Store
webPort :: Int
webHost :: String
webHistoryURL :: WebConfig -> String
webTickerURL :: WebConfig -> String
webPriceGet :: WebConfig -> Int
webStats :: WebConfig -> Maybe Store
webNoMempool :: WebConfig -> Bool
webVersion :: WebConfig -> String
webTimeouts :: WebConfig -> WebTimeouts
webMaxLimits :: WebConfig -> WebLimits
webMaxPending :: WebConfig -> Int
webMaxDiff :: WebConfig -> Int
webStore :: WebConfig -> Store
webPort :: WebConfig -> Int
webHost :: WebConfig -> String
..} = do
    Int64
n <- Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (SystemTime -> Int64) -> SystemTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds (SystemTime -> Int64) -> m SystemTime -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> m SystemTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
    Int64
b <- Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (BlockNode -> Word32) -> BlockNode -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> Word32
H.blockTimestamp (BlockHeader -> Word32)
-> (BlockNode -> BlockHeader) -> BlockNode -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
H.nodeHeader (BlockNode -> Int64) -> m BlockNode -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    Int64
t <-
        m [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool m [(Word64, TxHash)] -> ([(Word64, TxHash)] -> m Int64) -> m Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            (Word64, TxHash)
t : [(Word64, TxHash)]
_ ->
                let x :: Int64
x = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ (Word64, TxHash) -> Word64
forall a b. (a, b) -> a
fst (Word64, TxHash)
t
                 in Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> m Int64) -> Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
x Int64
b
            [] -> Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
b
    let timeHealthAge :: Int64
timeHealthAge = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
t
        timeHealthMax :: Int64
timeHealthMax = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
to
    TimeHealth -> m TimeHealth
forall (m :: * -> *) a. Monad m => a -> m a
return TimeHealth :: Int64 -> Int64 -> TimeHealth
TimeHealth{Int64
timeHealthMax :: Int64
timeHealthAge :: Int64
timeHealthAge :: Int64
timeHealthMax :: Int64
..}
  where
    ch :: Chain
ch = Store -> Chain
storeChain Store
webStore
    to :: Word64
to =
        if Bool
webNoMempool
            then WebTimeouts -> Word64
blockTimeout WebTimeouts
webTimeouts
            else WebTimeouts -> Word64
txTimeout WebTimeouts
webTimeouts

pendingTxsHealthCheck ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    WebConfig ->
    m MaxHealth
pendingTxsHealthCheck :: WebConfig -> m MaxHealth
pendingTxsHealthCheck WebConfig
cfg = do
    let maxHealthMax :: Int64
maxHealthMax = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ WebConfig -> Int
webMaxPending WebConfig
cfg
    Int64
maxHealthNum <-
        Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            (Int -> Int64) -> m Int -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockStore -> m Int
forall (m :: * -> *). MonadIO m => BlockStore -> m Int
blockStorePendingTxs (Store -> BlockStore
storeBlock (WebConfig -> Store
webStore WebConfig
cfg))
    MaxHealth -> m MaxHealth
forall (m :: * -> *) a. Monad m => a -> m a
return MaxHealth :: Int64 -> Int64 -> MaxHealth
MaxHealth{Int64
maxHealthNum :: Int64
maxHealthMax :: Int64
maxHealthNum :: Int64
maxHealthMax :: Int64
..}

peerHealthCheck ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    PeerManager ->
    m CountHealth
peerHealthCheck :: PeerManager -> m CountHealth
peerHealthCheck PeerManager
mgr = do
    let countHealthMin :: Int64
countHealthMin = Int64
1
    Int64
countHealthNum <- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> ([OnlinePeer] -> Int) -> [OnlinePeer] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OnlinePeer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OnlinePeer] -> Int64) -> m [OnlinePeer] -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerManager -> m [OnlinePeer]
forall (m :: * -> *). MonadIO m => PeerManager -> m [OnlinePeer]
getPeers PeerManager
mgr
    CountHealth -> m CountHealth
forall (m :: * -> *) a. Monad m => a -> m a
return CountHealth :: Int64 -> Int64 -> CountHealth
CountHealth{Int64
countHealthNum :: Int64
countHealthMin :: Int64
countHealthNum :: Int64
countHealthMin :: Int64
..}

healthCheck ::
    (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
    WebConfig ->
    m HealthCheck
healthCheck :: WebConfig -> m HealthCheck
healthCheck cfg :: WebConfig
cfg@WebConfig{Bool
Int
String
Maybe Store
Store
WebTimeouts
WebLimits
webHistoryURL :: String
webTickerURL :: String
webPriceGet :: Int
webStats :: Maybe Store
webNoMempool :: Bool
webVersion :: String
webTimeouts :: WebTimeouts
webMaxLimits :: WebLimits
webMaxPending :: Int
webMaxDiff :: Int
webStore :: Store
webPort :: Int
webHost :: String
webHistoryURL :: WebConfig -> String
webTickerURL :: WebConfig -> String
webPriceGet :: WebConfig -> Int
webStats :: WebConfig -> Maybe Store
webNoMempool :: WebConfig -> Bool
webVersion :: WebConfig -> String
webTimeouts :: WebConfig -> WebTimeouts
webMaxLimits :: WebConfig -> WebLimits
webMaxPending :: WebConfig -> Int
webMaxDiff :: WebConfig -> Int
webStore :: WebConfig -> Store
webPort :: WebConfig -> Int
webHost :: WebConfig -> String
..} = do
    BlockHealth
healthBlocks <- WebConfig -> m BlockHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m BlockHealth
blockHealthCheck WebConfig
cfg
    TimeHealth
healthLastBlock <- Chain -> WebTimeouts -> m TimeHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
Chain -> WebTimeouts -> m TimeHealth
lastBlockHealthCheck (Store -> Chain
storeChain Store
webStore) WebTimeouts
webTimeouts
    TimeHealth
healthLastTx <- WebConfig -> m TimeHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig
cfg
    MaxHealth
healthPendingTxs <- WebConfig -> m MaxHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m MaxHealth
pendingTxsHealthCheck WebConfig
cfg
    CountHealth
healthPeers <- PeerManager -> m CountHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
PeerManager -> m CountHealth
peerHealthCheck (Store -> PeerManager
storeManager Store
webStore)
    let healthNetwork :: String
healthNetwork = Network -> String
getNetworkName (Store -> Network
storeNetwork Store
webStore)
        healthVersion :: String
healthVersion = String
webVersion
        hc :: HealthCheck
hc = HealthCheck :: BlockHealth
-> TimeHealth
-> TimeHealth
-> MaxHealth
-> CountHealth
-> String
-> String
-> HealthCheck
HealthCheck{String
BlockHealth
TimeHealth
CountHealth
MaxHealth
healthBlocks :: BlockHealth
healthLastBlock :: TimeHealth
healthLastTx :: TimeHealth
healthPendingTxs :: MaxHealth
healthPeers :: CountHealth
healthNetwork :: String
healthVersion :: String
healthVersion :: String
healthNetwork :: String
healthPeers :: CountHealth
healthPendingTxs :: MaxHealth
healthLastTx :: TimeHealth
healthLastBlock :: TimeHealth
healthBlocks :: BlockHealth
..}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
hc) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        let t :: Text
t = Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HealthCheck -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText HealthCheck
hc
        $(Text -> Text -> m ()
logErrorS) Text
"Web" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Health check failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    HealthCheck -> m HealthCheck
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
hc

scottyDbStats :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyDbStats :: WebT m ()
scottyDbStats = do
    (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statDbstats
    WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    DB
db <- ReaderT WebState m DB -> ActionT Except (ReaderT WebState m) DB
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m DB -> ActionT Except (ReaderT WebState m) DB)
-> ReaderT WebState m DB -> ActionT Except (ReaderT WebState m) DB
forall a b. (a -> b) -> a -> b
$ (WebState -> DB) -> ReaderT WebState m DB
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (DatabaseReader -> DB
databaseHandle (DatabaseReader -> DB)
-> (WebState -> DatabaseReader) -> WebState -> DB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store -> DatabaseReader
storeDB (Store -> DatabaseReader)
-> (WebState -> Store) -> WebState -> DatabaseReader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Maybe ByteString
statsM <- ReaderT WebState m (Maybe ByteString)
-> ActionT Except (ReaderT WebState m) (Maybe ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DB -> Property -> ReaderT WebState m (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
DB -> Property -> m (Maybe ByteString)
getProperty DB
db Property
Stats)
    Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
    Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Could not get stats" ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Maybe ByteString
statsM

-----------------------
-- Parameter Parsing --
-----------------------

{- | Returns @Nothing@ if the parameter is not supplied. Raises an exception on
 parse failure.
-}
paramOptional :: (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional :: WebT m (Maybe a)
paramOptional = Proxy a -> WebT m (Maybe a)
forall a (m :: * -> *).
(Param a, MonadIO m) =>
Proxy a -> WebT m (Maybe a)
go Proxy a
forall k (t :: k). Proxy t
Proxy
  where
    go :: (Param a, MonadIO m) => Proxy a -> WebT m (Maybe a)
    go :: Proxy a -> WebT m (Maybe a)
go Proxy a
proxy = do
        Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork (Store -> Network) -> (WebState -> Store) -> WebState -> Network
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        Maybe [Text]
tsM :: Maybe [Text] <- ActionT Except (ReaderT WebState m) (Maybe [Text])
p ActionT Except (ReaderT WebState m) (Maybe [Text])
-> (Except -> ActionT Except (ReaderT WebState m) (Maybe [Text]))
-> ActionT Except (ReaderT WebState m) (Maybe [Text])
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) (Maybe [Text])
-> Except -> ActionT Except (ReaderT WebState m) (Maybe [Text])
forall a b. a -> b -> a
const (Maybe [Text] -> ActionT Except (ReaderT WebState m) (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
forall a. Maybe a
Nothing)
        case Maybe [Text]
tsM of
            Maybe [Text]
Nothing -> Maybe a -> WebT m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing -- Parameter was not supplied
            Just [Text]
ts -> WebT m (Maybe a)
-> (a -> WebT m (Maybe a)) -> Maybe a -> WebT m (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> WebT m (Maybe a)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
err) (Maybe a -> WebT m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> WebT m (Maybe a))
-> (a -> Maybe a) -> a -> WebT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Maybe a -> WebT m (Maybe a)) -> Maybe a -> WebT m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Network -> [Text] -> Maybe a
forall a. Param a => Network -> [Text] -> Maybe a
parseParam Network
net [Text]
ts
      where
        l :: Text
l = Proxy a -> Text
forall a. Param a => Proxy a -> Text
proxyLabel Proxy a
proxy
        p :: ActionT Except (ReaderT WebState m) (Maybe [Text])
p = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> ActionT Except (ReaderT WebState m) [Text]
-> ActionT Except (ReaderT WebState m) (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) [Text]
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
l)
        err :: Except
err = String -> Except
UserError (String -> Except) -> String -> Except
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse param " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
l

-- | Raises an exception if the parameter is not supplied
param :: (Param a, MonadIO m) => WebT m a
param :: WebT m a
param = Proxy a -> WebT m a
forall a (m :: * -> *). (Param a, MonadIO m) => Proxy a -> WebT m a
go Proxy a
forall k (t :: k). Proxy t
Proxy
  where
    go :: (Param a, MonadIO m) => Proxy a -> WebT m a
    go :: Proxy a -> WebT m a
go Proxy a
proxy = do
        Maybe a
resM <- WebT m (Maybe a)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional
        case Maybe a
resM of
            Just a
res -> a -> WebT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
            Maybe a
_ ->
                Except -> WebT m a
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> WebT m a) -> (String -> Except) -> String -> WebT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Except
UserError (String -> WebT m a) -> String -> WebT m a
forall a b. (a -> b) -> a -> b
$
                    String
"The param " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Proxy a -> Text
forall a. Param a => Proxy a -> Text
proxyLabel Proxy a
proxy) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was not defined"

{- | Returns the default value of a parameter if it is not supplied. Raises an
 exception on parse failure.
-}
paramDef :: (Default a, Param a, MonadIO m) => WebT m a
paramDef :: WebT m a
paramDef = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Default a => a
def (Maybe a -> a)
-> ActionT Except (ReaderT WebState m) (Maybe a) -> WebT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) (Maybe a)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional

{- | Does not raise exceptions. Will call @Scotty.next@ if the parameter is
 not supplied or if parsing fails.
-}
paramLazy :: (Param a, MonadIO m) => WebT m a
paramLazy :: WebT m a
paramLazy = do
    Maybe a
resM <- WebT m (Maybe a)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional WebT m (Maybe a)
-> (Except -> WebT m (Maybe a)) -> WebT m (Maybe a)
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` WebT m (Maybe a) -> Except -> WebT m (Maybe a)
forall a b. a -> b -> a
const (Maybe a -> WebT m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
    WebT m a -> (a -> WebT m a) -> Maybe a -> WebT m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WebT m a
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next a -> WebT m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
resM

parseBody :: (MonadIO m, Serial a) => WebT m a
parseBody :: WebT m a
parseBody = do
    ByteString
b <- ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> ActionT Except (ReaderT WebState m) ByteString
-> ActionT Except (ReaderT WebState m) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) ByteString
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m ByteString
S.body
    case ByteString -> Either String a
hex ByteString
b Either String a -> Either String a -> Either String a
forall a. Semigroup a => a -> a -> a
<> ByteString -> Either String a
bin ByteString
b of
        Left String
_ -> Except -> WebT m a
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> WebT m a) -> Except -> WebT m a
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
"Failed to parse request body"
        Right a
x -> a -> WebT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  where
    bin :: ByteString -> Either String a
bin = Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
    hex :: ByteString -> Either String a
hex ByteString
b = case ByteString -> Either Text ByteString
B16.decodeBase16 (ByteString -> Either Text ByteString)
-> ByteString -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
C.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) ByteString
b of
        Right ByteString
x -> ByteString -> Either String a
bin ByteString
x
        Left Text
s -> String -> Either String a
forall a b. a -> Either a b
Left (Text -> String
T.unpack Text
s)

parseOffset :: MonadIO m => WebT m OffsetParam
parseOffset :: WebT m OffsetParam
parseOffset = do
    res :: OffsetParam
res@(OffsetParam Natural
o) <- WebT m OffsetParam
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef
    WebLimits
limits <- ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m WebLimits
 -> ActionT Except (ReaderT WebState m) WebLimits)
-> ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall a b. (a -> b) -> a -> b
$ (WebState -> WebLimits) -> ReaderT WebState m WebLimits
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebConfig -> WebLimits
webMaxLimits (WebConfig -> WebLimits)
-> (WebState -> WebConfig) -> WebState -> WebLimits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Bool
-> ActionT Except (ReaderT WebState m) ()
-> ActionT Except (ReaderT WebState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WebLimits -> Word32
maxLimitOffset WebLimits
limits Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0 Bool -> Bool -> Bool
&& Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
o Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> WebLimits -> Word32
maxLimitOffset WebLimits
limits) (ActionT Except (ReaderT WebState m) ()
 -> ActionT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
        Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> ActionT Except (ReaderT WebState m) ())
-> (String -> Except)
-> String
-> ActionT Except (ReaderT WebState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Except
UserError (String -> ActionT Except (ReaderT WebState m) ())
-> String -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
            String
"offset exceeded: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show Natural
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" > " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show (WebLimits -> Word32
maxLimitOffset WebLimits
limits)
    OffsetParam -> WebT m OffsetParam
forall (m :: * -> *) a. Monad m => a -> m a
return OffsetParam
res

parseStart ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    Maybe StartParam ->
    WebT m (Maybe Start)
parseStart :: Maybe StartParam -> WebT m (Maybe Start)
parseStart Maybe StartParam
Nothing = Maybe Start -> WebT m (Maybe Start)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Start
forall a. Maybe a
Nothing
parseStart (Just StartParam
s) =
    MaybeT (ActionT Except (ReaderT WebState m)) Start
-> WebT m (Maybe Start)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ActionT Except (ReaderT WebState m)) Start
 -> WebT m (Maybe Start))
-> MaybeT (ActionT Except (ReaderT WebState m)) Start
-> WebT m (Maybe Start)
forall a b. (a -> b) -> a -> b
$
        case StartParam
s of
            StartParamHash{startParamHash :: StartParam -> Hash256
startParamHash = Hash256
h} -> Hash256 -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall (m :: * -> *). StoreReadBase m => Hash256 -> MaybeT m Start
start_tx Hash256
h MaybeT (ActionT Except (ReaderT WebState m)) Start
-> MaybeT (ActionT Except (ReaderT WebState m)) Start
-> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash256 -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall (m :: * -> *). StoreReadBase m => Hash256 -> MaybeT m Start
start_block Hash256
h
            StartParamHeight{startParamHeight :: StartParam -> Natural
startParamHeight = Natural
h} -> Natural -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall (m :: * -> *) a. (Monad m, Integral a) => a -> m Start
start_height Natural
h
            StartParamTime{startParamTime :: StartParam -> Word64
startParamTime = Word64
q} -> Word64 -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall (m :: * -> *).
(MonadReader WebState m, MonadIO m, StoreReadExtra m) =>
Word64 -> MaybeT m Start
start_time Word64
q
  where
    start_height :: a -> m Start
start_height a
h = Start -> m Start
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> m Start) -> Start -> m Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock (Word32 -> Start) -> Word32 -> Start
forall a b. (a -> b) -> a -> b
$ a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h
    start_block :: Hash256 -> MaybeT m Start
start_block Hash256
h = do
        BlockData
b <- m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (Hash256 -> BlockHash
H.BlockHash Hash256
h)
        Start -> MaybeT m Start
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT m Start) -> Start -> MaybeT m Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock (BlockData -> Word32
blockDataHeight BlockData
b)
    start_tx :: Hash256 -> MaybeT m Start
start_tx Hash256
h = do
        TxData
_ <- m (Maybe TxData) -> MaybeT m TxData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe TxData) -> MaybeT m TxData)
-> m (Maybe TxData) -> MaybeT m TxData
forall a b. (a -> b) -> a -> b
$ TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData (Hash256 -> TxHash
TxHash Hash256
h)
        Start -> MaybeT m Start
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT m Start) -> Start -> MaybeT m Start
forall a b. (a -> b) -> a -> b
$ TxHash -> Start
AtTx (Hash256 -> TxHash
TxHash Hash256
h)
    start_time :: Word64 -> MaybeT m Start
start_time Word64
q = do
        Chain
ch <- m Chain -> MaybeT m Chain
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Chain -> MaybeT m Chain) -> m Chain -> MaybeT m Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain (Store -> Chain) -> (WebState -> Store) -> WebState -> Chain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
        BlockData
b <- m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ Chain -> Word64 -> m (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
q
        let g :: Word32
g = BlockData -> Word32
blockDataHeight BlockData
b
        Start -> MaybeT m Start
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT m Start) -> Start -> MaybeT m Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock Word32
g

parseLimits :: MonadIO m => WebT m LimitsParam
parseLimits :: WebT m LimitsParam
parseLimits = Maybe LimitParam -> OffsetParam -> Maybe StartParam -> LimitsParam
LimitsParam (Maybe LimitParam
 -> OffsetParam -> Maybe StartParam -> LimitsParam)
-> ActionT Except (ReaderT WebState m) (Maybe LimitParam)
-> ActionT
     Except
     (ReaderT WebState m)
     (OffsetParam -> Maybe StartParam -> LimitsParam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) (Maybe LimitParam)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional ActionT
  Except
  (ReaderT WebState m)
  (OffsetParam -> Maybe StartParam -> LimitsParam)
-> ActionT Except (ReaderT WebState m) OffsetParam
-> ActionT
     Except (ReaderT WebState m) (Maybe StartParam -> LimitsParam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) OffsetParam
forall (m :: * -> *). MonadIO m => WebT m OffsetParam
parseOffset ActionT
  Except (ReaderT WebState m) (Maybe StartParam -> LimitsParam)
-> ActionT Except (ReaderT WebState m) (Maybe StartParam)
-> WebT m LimitsParam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT Except (ReaderT WebState m) (Maybe StartParam)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional

paramToLimits ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    Bool ->
    LimitsParam ->
    WebT m Limits
paramToLimits :: Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
full (LimitsParam Maybe LimitParam
limitM OffsetParam
o Maybe StartParam
startM) = do
    WebLimits
wl <- ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m WebLimits
 -> ActionT Except (ReaderT WebState m) WebLimits)
-> ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall a b. (a -> b) -> a -> b
$ (WebState -> WebLimits) -> ReaderT WebState m WebLimits
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebConfig -> WebLimits
webMaxLimits (WebConfig -> WebLimits)
-> (WebState -> WebConfig) -> WebState -> WebLimits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Word32 -> Word32 -> Maybe Start -> Limits
Limits (WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit WebLimits
wl Bool
full Maybe LimitParam
limitM) (OffsetParam -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral OffsetParam
o) (Maybe Start -> Limits)
-> ActionT Except (ReaderT WebState m) (Maybe Start)
-> WebT m Limits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StartParam
-> ActionT Except (ReaderT WebState m) (Maybe Start)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Maybe StartParam -> WebT m (Maybe Start)
parseStart Maybe StartParam
startM

validateLimit :: WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit :: WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit WebLimits
wl Bool
full Maybe LimitParam
limitM =
    Word32 -> Word32 -> Word32
forall a. (Num a, Ord a) => a -> a -> a
f Word32
m (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> (LimitParam -> Word32) -> Maybe LimitParam -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
d (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LimitParam -> Natural) -> LimitParam -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LimitParam -> Natural
getLimitParam) Maybe LimitParam
limitM
  where
    m :: Word32
m
        | Bool
full Bool -> Bool -> Bool
&& WebLimits -> Word32
maxLimitFull WebLimits
wl Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0 = WebLimits -> Word32
maxLimitFull WebLimits
wl
        | Bool
otherwise = WebLimits -> Word32
maxLimitCount WebLimits
wl
    d :: Word32
d = WebLimits -> Word32
maxLimitDefault WebLimits
wl
    f :: a -> a -> a
f a
a a
0 = a
a
    f a
0 a
b = a
b
    f a
a a
b = a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
b

---------------
-- Utilities --
---------------

runInWebReader ::
    MonadIO m =>
    CacheT (DatabaseReaderT m) a ->
    ReaderT WebState m a
runInWebReader :: CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader CacheT (DatabaseReaderT m) a
f = do
    DatabaseReader
bdb <- (WebState -> DatabaseReader) -> ReaderT WebState m DatabaseReader
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> DatabaseReader
storeDB (Store -> DatabaseReader)
-> (WebState -> Store) -> WebState -> DatabaseReader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    Maybe CacheConfig
mc <- (WebState -> Maybe CacheConfig)
-> ReaderT WebState m (Maybe CacheConfig)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Maybe CacheConfig
storeCache (Store -> Maybe CacheConfig)
-> (WebState -> Store) -> WebState -> Maybe CacheConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore (WebConfig -> Store)
-> (WebState -> WebConfig) -> WebState -> Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    m a -> ReaderT WebState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT WebState m a) -> m a -> ReaderT WebState m a
forall a b. (a -> b) -> a -> b
$ ReaderT DatabaseReader m a -> DatabaseReader -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Maybe CacheConfig
-> CacheT (DatabaseReaderT m) a -> ReaderT DatabaseReader m a
forall (m :: * -> *) a.
StoreReadBase m =>
Maybe CacheConfig -> CacheT m a -> m a
withCache Maybe CacheConfig
mc CacheT (DatabaseReaderT m) a
f) DatabaseReader
bdb

runNoCache :: MonadIO m => Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache :: Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
False ReaderT WebState m a
f = ReaderT WebState m a
f
runNoCache Bool
True ReaderT WebState m a
f = (WebState -> WebState)
-> ReaderT WebState m a -> ReaderT WebState m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WebState -> WebState
g ReaderT WebState m a
f
  where
    g :: WebState -> WebState
g WebState
s = WebState
s{webConfig :: WebConfig
webConfig = WebConfig -> WebConfig
h (WebState -> WebConfig
webConfig WebState
s)}
    h :: WebConfig -> WebConfig
h WebConfig
c = WebConfig
c{webStore :: Store
webStore = Store -> Store
i (WebConfig -> Store
webStore WebConfig
c)}
    i :: Store -> Store
i Store
s = Store
s{storeCache :: Maybe CacheConfig
storeCache = Maybe CacheConfig
forall a. Maybe a
Nothing}

logIt ::
    (MonadUnliftIO m, MonadLoggerIO m) =>
    Maybe WebMetrics ->
    m Middleware
logIt :: Maybe WebMetrics -> m Middleware
logIt Maybe WebMetrics
metrics = do
    m () -> IO ()
runner <- m (m () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
    Middleware -> m Middleware
forall (m :: * -> *) a. Monad m => a -> m a
return (Middleware -> m Middleware) -> Middleware -> m Middleware
forall a b. (a -> b) -> a -> b
$ \Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
app Request
req Response -> IO ResponseReceived
respond -> do
        TVar ByteString
var <- ByteString -> IO (TVar ByteString)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO ByteString
B.empty
        Request
req' <-
            let rb :: IO ByteString
rb = TVar ByteString -> IO ByteString -> IO ByteString
forall (m :: * -> *).
MonadIO m =>
TVar ByteString -> m ByteString -> m ByteString
req_body TVar ByteString
var (Request -> IO ByteString
getRequestBodyChunk Request
req)
                rq :: Request
rq = Request
req{requestBody :: IO ByteString
requestBody = IO ByteString
rb}
             in case Maybe WebMetrics
metrics of
                    Maybe WebMetrics
Nothing -> Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
rq
                    Just WebMetrics
m -> do
                        TVar (Maybe (WebMetrics -> StatDist))
stat_var <- Maybe (WebMetrics -> StatDist)
-> IO (TVar (Maybe (WebMetrics -> StatDist)))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Maybe (WebMetrics -> StatDist)
forall a. Maybe a
Nothing
                        let vt :: Vault
vt =
                                Key (TVar (Maybe (WebMetrics -> StatDist)))
-> TVar (Maybe (WebMetrics -> StatDist)) -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
V.insert (WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey WebMetrics
m) TVar (Maybe (WebMetrics -> StatDist))
stat_var (Vault -> Vault) -> Vault -> Vault
forall a b. (a -> b) -> a -> b
$
                                    Request -> Vault
vault Request
rq
                        Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return Request
rq{vault :: Vault
vault = Vault
vt}
        IO UTCTime
-> (UTCTime -> IO ())
-> (UTCTime -> IO ResponseReceived)
-> IO ResponseReceived
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO UTCTime
start (TVar ByteString -> (m () -> IO ()) -> Request -> UTCTime -> IO ()
forall (m :: * -> *).
MonadLogger m =>
TVar ByteString -> (m () -> IO ()) -> Request -> UTCTime -> IO ()
end TVar ByteString
var m () -> IO ()
runner Request
req') ((UTCTime -> IO ResponseReceived) -> IO ResponseReceived)
-> (UTCTime -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \UTCTime
_ ->
            Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
app Request
req' ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
                ByteString
b <- TVar ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar ByteString
var
                let s :: Status
s = Response -> Status
responseStatus Response
res
                    msg :: Text
msg = ByteString -> Request -> Text
fmtReq ByteString
b Request
req' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Status -> Text
fmtStatus Status
s
                if Status -> Bool
statusIsSuccessful Status
s
                    then m () -> IO ()
runner (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(Text -> Text -> m ()
logDebugS) Text
"Web" Text
msg
                    else m () -> IO ()
runner (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(Text -> Text -> m ()
logErrorS) Text
"Web" Text
msg
                Response -> IO ResponseReceived
respond Response
res
  where
    start :: IO UTCTime
start = SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> IO SystemTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime
    req_body :: TVar ByteString -> m ByteString -> m ByteString
req_body TVar ByteString
var m ByteString
old_body = do
        ByteString
b <- m ByteString
old_body
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
b) (m () -> m ()) -> (STM () -> m ()) -> STM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar ByteString -> (ByteString -> ByteString) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar ByteString
var (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b)
        ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
    add_stat :: Int64 -> StatDist -> m ()
add_stat Int64
d StatDist
s = do
        StatDist -> m ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addStatQuery StatDist
s
        StatDist -> Int64 -> m ()
forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatTime StatDist
s Int64
d
    end :: TVar ByteString -> (m () -> IO ()) -> Request -> UTCTime -> IO ()
end TVar ByteString
var m () -> IO ()
runner Request
req UTCTime
t1 = do
        UTCTime
t2 <- SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> IO SystemTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime
        let diff :: Int64
diff = NominalDiffTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> Int64) -> NominalDiffTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t2 UTCTime
t1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000
        case Maybe WebMetrics
metrics of
            Maybe WebMetrics
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just WebMetrics
m -> do
                let m_stat_var :: Maybe (TVar (Maybe (WebMetrics -> StatDist)))
m_stat_var = Key (TVar (Maybe (WebMetrics -> StatDist)))
-> Vault -> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
forall a. Key a -> Vault -> Maybe a
V.lookup (WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey WebMetrics
m) (Request -> Vault
vault Request
req)
                Int64 -> StatDist -> IO ()
forall (m :: * -> *). MonadIO m => Int64 -> StatDist -> m ()
add_stat Int64
diff (WebMetrics -> StatDist
statAll WebMetrics
m)
                case Maybe (TVar (Maybe (WebMetrics -> StatDist)))
m_stat_var of
                    Maybe (TVar (Maybe (WebMetrics -> StatDist)))
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just TVar (Maybe (WebMetrics -> StatDist))
stat_var ->
                        TVar (Maybe (WebMetrics -> StatDist))
-> IO (Maybe (WebMetrics -> StatDist))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (WebMetrics -> StatDist))
stat_var IO (Maybe (WebMetrics -> StatDist))
-> (Maybe (WebMetrics -> StatDist) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            Maybe (WebMetrics -> StatDist)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            Just WebMetrics -> StatDist
f -> Int64 -> StatDist -> IO ()
forall (m :: * -> *). MonadIO m => Int64 -> StatDist -> m ()
add_stat Int64
diff (WebMetrics -> StatDist
f WebMetrics
m)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
diff Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
10000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            ByteString
b <- TVar ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar ByteString
var
            m () -> IO ()
runner (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$
                $(Text -> Text -> m ()
logWarnS) Text
"Web" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
                    Text
"Slow [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int64 -> String
forall a. Show a => a -> String
show Int64
diff) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ms]: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Request -> Text
fmtReq ByteString
b Request
req

reqSizeLimit :: Integral i => i -> Middleware
reqSizeLimit :: i -> Middleware
reqSizeLimit i
i = RequestSizeLimitSettings -> Middleware
requestSizeLimitMiddleware RequestSizeLimitSettings
lim
  where
    max_len :: p -> m (Maybe a)
max_len p
_req = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just (i -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i))
    lim :: RequestSizeLimitSettings
lim =
        (Word64 -> Middleware)
-> RequestSizeLimitSettings -> RequestSizeLimitSettings
setOnLengthExceeded Word64 -> Middleware
forall p p p t. p -> p -> p -> (Response -> t) -> t
too_big (RequestSizeLimitSettings -> RequestSizeLimitSettings)
-> RequestSizeLimitSettings -> RequestSizeLimitSettings
forall a b. (a -> b) -> a -> b
$
            (Request -> IO (Maybe Word64))
-> RequestSizeLimitSettings -> RequestSizeLimitSettings
setMaxLengthForRequest
                Request -> IO (Maybe Word64)
forall (m :: * -> *) a p. (Monad m, Num a) => p -> m (Maybe a)
max_len
                RequestSizeLimitSettings
defaultRequestSizeLimitSettings
    too_big :: p -> p -> p -> (Response -> t) -> t
too_big p
_ = \p
_app p
_req Response -> t
send ->
        Response -> t
send (Response -> t) -> Response -> t
forall a b. (a -> b) -> a -> b
$
            Status -> Except -> Response
waiExcept Status
requestEntityTooLarge413 Except
RequestTooLarge

fmtReq :: ByteString -> Request -> Text
fmtReq :: ByteString -> Request -> Text
fmtReq ByteString
bs Request
req =
    let m :: ByteString
m = Request -> ByteString
requestMethod Request
req
        v :: HttpVersion
v = Request -> HttpVersion
httpVersion Request
req
        p :: ByteString
p = Request -> ByteString
rawPathInfo Request
req
        q :: ByteString
q = Request -> ByteString
rawQueryString Request
req
        txt :: Text
txt = case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
            Left UnicodeException
_ -> Text
" {invalid utf8}"
            Right Text
"" -> Text
""
            Right Text
t -> Text
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
     in ByteString -> Text
T.decodeUtf8 (ByteString
m ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
q ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (HttpVersion -> String
forall a. Show a => a -> String
show HttpVersion
v)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt

fmtStatus :: Status -> Text
fmtStatus :: Status -> Text
fmtStatus Status
s = String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show (Status -> Int
statusCode Status
s)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Status -> ByteString
statusMessage Status
s)