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

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

import Conduit
  ( ConduitT,
    await,
    concatMapC,
    concatMapMC,
    dropC,
    dropWhileC,
    headC,
    iterMC,
    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 Data.Aeson qualified 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 Data.ByteString qualified as B
import Data.ByteString.Base16 qualified as B16
import Data.ByteString.Builder (lazyByteString)
import Data.ByteString.Char8 qualified as C
import Data.ByteString.Lazy qualified 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 Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified 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 Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy qualified as TL
import Data.Time.Clock (diffUTCTime)
import Data.Time.Clock.System
  ( getSystemTime,
    systemSeconds,
    systemToUTCTime,
  )
import Data.Vault.Lazy qualified as V
import Data.Word (Word32, Word64)
import Database.RocksDB
  ( Property (..),
    getProperty,
  )
import GHC.RTS.Flags (ConcFlags (ConcFlags))
import Haskoin.Address
import Haskoin.Block qualified 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 (..),
    hContentType,
    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.Wai.Middleware.Timeout
import Network.WebSockets
  ( ServerApp,
    acceptRequest,
    defaultConnectionOptions,
    pendingRequest,
    rejectRequestWith,
    requestPath,
    sendTextData,
  )
import Network.WebSockets qualified as WebSockets
import Network.Wreq qualified as Wreq
import Network.Wreq.Session as Wreq (Session)
import Network.Wreq.Session qualified as Wreq.Session
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Metrics qualified as Metrics
import System.Metrics.Gauge qualified as Metrics (Gauge)
import System.Metrics.Gauge qualified as Metrics.Gauge
import UnliftIO
  ( MonadIO,
    MonadUnliftIO,
    TVar,
    askRunInIO,
    async,
    atomically,
    bracket,
    bracket_,
    handleAny,
    liftIO,
    modifyTVar,
    newTVarIO,
    readTVarIO,
    timeout,
    withAsync,
    withRunInIO,
    writeTVar,
  )
import UnliftIO.Concurrent (threadDelay)
import Web.Scotty.Internal.Types (ActionT)
import Web.Scotty.Trans qualified 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,
    WebLimits -> Word32
maxLimitTimeout :: !Word32
  }
  deriving (WebLimits -> WebLimits -> Bool
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
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
      { 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 forall a. Num a => a -> a -> a
* Word32
1024,
        maxLimitTimeout :: Word32
maxLimitTimeout = Word32
0
      }

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,
    WebConfig -> Bool
webSlow :: !Bool,
    WebConfig -> Bool
webBlockchain :: !Bool,
    WebConfig -> Int
webHealthCheckInterval :: !Int
  }

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,
    WebState -> TVar HealthCheck
webHealthCheck :: !(TVar HealthCheck)
  }

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 :: forall (m :: * -> *). MonadIO m => Store -> m WebMetrics
createMetrics Store
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  StatDist
statAll <- forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"all"

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

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

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

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

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

  -- Others
  StatDist
statHealth <- forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"health"
  StatDist
statPeers <- forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"peers"
  StatDist
statDbstats <- 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 <- forall a. IO (Key a)
V.newKey
  forall (m :: * -> *) a. Monad m => a -> m a
return WebMetrics {Gauge
StatDist
Key (TVar (Maybe (WebMetrics -> 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 = forall (m :: * -> *). MonadIO m => Text -> Store -> m StatDist
createStatDist (Text
"web." 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." forall a. Semigroup a => a -> a -> a
<> Text
x) Store
s

withGaugeIO :: MonadUnliftIO m => Metrics.Gauge -> m a -> m a
withGaugeIO :: forall (m :: * -> *) a. MonadUnliftIO m => Gauge -> m a -> m a
withGaugeIO Gauge
g =
  forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
Metrics.Gauge.inc Gauge
g)
    (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> Gauge) -> WebT m a -> WebT m a
withGaugeIncrease WebMetrics -> Gauge
gf WebT m a
go =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics) 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \Run (ActionT Except)
run -> forall (m :: * -> *) a. MonadUnliftIO m => Gauge -> m a -> m a
withGaugeIO (WebMetrics -> Gauge
gf WebMetrics
m) (Run (ActionT Except)
run WebT m a
go)
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ActionError Except) a, ScottyResponse)
s

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

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

getItemCounter :: (MonadIO m, MonadIO n) => WebT m (Int -> n ())
getItemCounter :: forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter =
  forall a. a -> Maybe a -> a
fromMaybe (\Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    Request
q <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) e. Monad m => ActionT e m Request
S.request
    WebMetrics
m <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics
    TVar (Maybe (WebMetrics -> StatDist))
t <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Key a -> Vault -> Maybe a
V.lookup (WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
statKey WebMetrics
m) (Request -> Vault
vault Request
q)
    WebMetrics -> StatDist
s <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (WebMetrics -> StatDist))
t
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatItems (WebMetrics -> StatDist
s WebMetrics
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

data WebTimeouts = WebTimeouts
  { WebTimeouts -> Word64
txTimeout :: !Word64,
    WebTimeouts -> Word64
blockTimeout :: !Word64
  }
  deriving (WebTimeouts -> WebTimeouts -> Bool
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
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
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
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 {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 = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
  getBestBlock :: ReaderT WebState m (Maybe BlockHash)
getBestBlock = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
  getBlocksAtHeight :: Word32 -> ReaderT WebState m [BlockHash]
getBlocksAtHeight Word32
height = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
height)
  getBlock :: BlockHash -> ReaderT WebState m (Maybe BlockData)
getBlock BlockHash
bh = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh)
  getTxData :: TxHash -> ReaderT WebState m (Maybe TxData)
getTxData TxHash
th = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th)
  getSpender :: OutPoint -> ReaderT WebState m (Maybe Spender)
getSpender OutPoint
op = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender OutPoint
op)
  getUnspent :: OutPoint -> ReaderT WebState m (Maybe Unspent)
getUnspent OutPoint
op = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op)
  getBalance :: Address -> ReaderT WebState m (Maybe Balance)
getBalance Address
a = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader (forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a)
  getMempool :: ReaderT WebState m [(Word64, TxHash)]
getMempool = forall (m :: * -> *) a.
MonadIO m =>
CacheT (DatabaseReaderT m) a -> ReaderT WebState m a
runInWebReader forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool

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

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

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

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

runWeb :: (MonadUnliftIO m, MonadLoggerIO m) => WebConfig -> m ()
runWeb :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
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
maxLimitTimeout :: Word32
maxLimitBody :: Word32
maxLimitInitialGap :: Word32
maxLimitGap :: Word32
maxLimitDefault :: Word32
maxLimitOffset :: Word32
maxLimitFull :: Word32
maxLimitCount :: Word32
maxLimitTimeout :: WebLimits -> Word32
maxLimitBody :: WebLimits -> Word32
maxLimitInitialGap :: WebLimits -> Word32
maxLimitGap :: WebLimits -> Word32
maxLimitDefault :: WebLimits -> Word32
maxLimitOffset :: WebLimits -> Word32
maxLimitFull :: WebLimits -> Word32
maxLimitCount :: WebLimits -> Word32
..},
      webSlow :: WebConfig -> Bool
webSlow = Bool
slow,
      webBlockchain :: WebConfig -> Bool
webBlockchain = Bool
blockchain,
      webHealthCheckInterval :: WebConfig -> Int
webHealthCheckInterval = Int
healthint
    } = do
    TVar (HashMap Text BinfoTicker)
ticker <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO forall k v. HashMap k v
HashMap.empty
    Maybe WebMetrics
metrics <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadIO m => Store -> m WebMetrics
createMetrics Maybe Store
stats
    Session
session <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Session
Wreq.Session.newAPISession
    TVar HealthCheck
health' <- m HealthCheck
hcheck forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO
    let st :: WebState
st =
          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,
              webHealthCheck :: TVar HealthCheck
webHealthCheck = TVar HealthCheck
health'
            }
        net :: Network
net = Store -> Network
storeNetwork Store
store'
    forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
blockchain forall a b. (a -> b) -> a -> b
$ 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)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (forall {b}. TVar HealthCheck -> m b
health TVar HealthCheck
health')
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
      forall a b. (a -> b) -> a -> b
$ do
        Middleware
reqLogger <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Maybe WebMetrics -> m Middleware
logIt Maybe WebMetrics
metrics
        m Response -> IO Response
runner <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
        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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` WebState
st)) forall a b. (a -> b) -> a -> b
$ do
          forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (WebState -> Middleware
webSocketEvents WebState
st)
          forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware Middleware
reqLogger
          forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (forall i. Integral i => i -> Middleware
reqSizeLimit Word32
maxLimitBody)
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
maxLimitTimeout forall a. Ord a => a -> a -> Bool
> Word32
0) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (forall i. Integral i => i -> Middleware
reqTimeout Word32
maxLimitTimeout)
          forall e (m :: * -> *).
(ScottyError e, Monad m) =>
(e -> ActionT e m ()) -> ScottyT e m ()
S.defaultHandler forall (m :: * -> *). Monad m => Except -> WebT m ()
defHandler
          forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> Bool -> ScottyT Except (ReaderT WebState m) ()
handlePaths Bool
slow Bool
blockchain
          forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m () -> ScottyT e m ()
S.notFound forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    where
      hcheck :: m HealthCheck
hcheck = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m HealthCheck
healthCheck WebConfig
cfg) (Store -> DatabaseReader
storeDB Store
store')
      health :: TVar HealthCheck -> m b
health TVar HealthCheck
v = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
healthint forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
* Int
1000)
        m HealthCheck
hcheck forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> a -> STM ()
writeTVar TVar HealthCheck
v
      opts :: Options
opts = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostPreference -> Settings -> Settings
setHost (forall a. IsString a => String -> a
fromString String
host)

getRates ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  Network ->
  Wreq.Session ->
  String ->
  Text ->
  [Word64] ->
  m [BinfoRate]
getRates :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network -> Session -> String -> Text -> [Word64] -> m [BinfoRate]
getRates Network
net Session
session String
url Text
currency [Word64]
times = do
  forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny forall {m :: * -> *} {p} {a}. MonadLogger m => p -> m [a]
err forall a b. (a -> b) -> a -> b
$ do
    Response [BinfoRate]
r <-
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON
          forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
Wreq.Session.postWith Options
opts Session
session String
url Value
body
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Response [BinfoRate]
r forall s a. s -> Getting a s a -> a
^. forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody
  where
    err :: p -> m [a]
err p
_ = do
      $(logErrorS) Text
"Web" Text
"Could not get historic prices"
      forall (m :: * -> *) a. Monad m => a -> m a
return []
    body :: Value
body = forall a. ToJSON a => a -> Value
toJSON [Word64]
times
    base :: Options
base =
      Options
Wreq.defaults
        forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
Wreq.param Text
"base" 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 forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
Wreq.param Text
"quote" 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network
-> Session
-> String
-> Int
-> TVar (HashMap Text BinfoTicker)
-> m ()
price Network
net Session
session String
url Int
pget TVar (HashMap Text BinfoTicker)
v = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe String
purl forall a b. (a -> b) -> a -> b
$ \String
u -> forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
  let err :: a -> m ()
err a
e = $(logErrorS) Text
"Price" forall a b. (a -> b) -> a -> b
$ forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show a
e)
  forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny forall {m :: * -> *} {a}. (MonadLogger m, Show a) => a -> m ()
err forall a b. (a -> b) -> a -> b
$ do
    Response (HashMap Text BinfoTicker)
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON 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
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> a -> STM ()
writeTVar TVar (HashMap Text BinfoTicker)
v forall a b. (a -> b) -> a -> b
$ Response (HashMap Text BinfoTicker)
r forall s a. s -> Getting a s a -> a
^. forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
Wreq.responseBody
  forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
pget
  where
    purl :: Maybe String
purl = case Maybe String
code of
      Maybe String
Nothing -> forall a. Maybe a
Nothing
      Just String
x -> forall a. a -> Maybe a
Just (String
url forall a. Semigroup a => a -> a -> a
<> String
"?base=" forall a. Semigroup a => a -> a -> a
<> String
x)
      where
        code :: Maybe String
code
          | Network
net forall a. Eq a => a -> a -> Bool
== Network
btc = forall a. a -> Maybe a
Just String
"btc"
          | Network
net forall a. Eq a => a -> a -> Bool
== Network
bch = forall a. a -> Maybe a
Just String
"bch"
          | Bool
otherwise = forall a. Maybe a
Nothing

raise :: MonadIO m => Except -> WebT m a
raise :: forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
err =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> Maybe WebMetrics
webMetrics) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WebMetrics
Nothing -> forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
e -> ActionT e m a
S.raise Except
err
    Just WebMetrics
m -> do
      Request
req <- forall (m :: * -> *) e. Monad m => ActionT e m Request
S.request
      Maybe (WebMetrics -> StatDist)
mM <- case 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just TVar (Maybe (WebMetrics -> StatDist))
t -> 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 ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *). MonadIO m => StatDist -> m ()
addClientError (WebMetrics -> StatDist
statAll WebMetrics
m)
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (WebMetrics -> StatDist)
mM forall a b. (a -> b) -> a -> b
$ \WebMetrics -> StatDist
f -> forall (m :: * -> *). MonadIO m => StatDist -> m ()
addClientError (WebMetrics -> StatDist
f WebMetrics
m)
          | Status -> Bool
statusIsServerError Status
status ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *). MonadIO m => StatDist -> m ()
addServerError (WebMetrics -> StatDist
statAll WebMetrics
m)
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (WebMetrics -> StatDist)
mM forall a b. (a -> b) -> a -> b
$ \WebMetrics -> StatDist
f -> forall (m :: * -> *). MonadIO m => StatDist -> m ()
addServerError (WebMetrics -> StatDist
f WebMetrics
m)
          | Bool
otherwise ->
              forall (m :: * -> *) a. Monad m => a -> m a
return ()
      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 :: forall (m :: * -> *). Monad m => Except -> WebT m ()
defHandler Except
e = do
  forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
S.status forall a b. (a -> b) -> a -> b
$ Except -> Status
errStatus Except
e
  forall a e (m :: * -> *).
(ToJSON a, ScottyError e, Monad m) =>
a -> ActionT e m ()
S.json Except
e

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

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

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

setHeaders :: (Monad m, S.ScottyError e) => ActionT e m ()
setHeaders :: forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders = 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' = forall a. ToJSON a => a -> ByteString
A.encode Except
e

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

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

setupContentType :: Monad m => Bool -> ActionT Except m SerialAs
setupContentType :: forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupContentType Bool
pretty = do
  Maybe Text
accept <- forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m (Maybe Text)
S.header Text
"accept"
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupJSON Bool
pretty) 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" = forall (m :: * -> *). Monad m => ActionT Except m SerialAs
setupBinary
    setType a
_ = 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlock -> WebT m BlockData
scottyBlock (GetBlock BlockHash
h (NoTx Bool
noTx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing ->
      forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockData
b -> do
      forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
hs Bool
notx =
  (Bool -> BlockData -> BlockData
pruneTx Bool
notx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (forall a. Eq a => [a] -> [a]
nub [BlockHash]
hs)

scottyBlocks ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetBlocks -> WebT m [BlockData]
scottyBlocks :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlocks -> WebT m [BlockData]
scottyBlocks (GetBlocks [BlockHash]
hs (NoTx Bool
notx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  [BlockData]
bs <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
hs Bool
notx
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
bs)
  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 = 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockRaw -> WebT m (RawResult Block)
scottyBlockRaw (GetBlockRaw BlockHash
h) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
  Block
b <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock BlockHash
h
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (Block -> [Tx]
H.blockTxns Block
b))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> RawResult a
RawResult Block
b

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

toRawBlock :: (MonadUnliftIO m, StoreReadBase m) => BlockData -> m H.Block
toRawBlock :: forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
BlockData -> m Block
toRawBlock BlockData
b = do
  let ths :: [TxHash]
ths = BlockData -> [TxHash]
blockDataTxs BlockData
b
  [Tx]
txs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Tx
f [TxHash]
ths
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
      forall a. IO a -> IO a
unsafeInterleaveIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Transaction
Nothing -> forall a. HasCallStack => a
undefined
          Just Transaction
t -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockBest -> WebT m BlockData
scottyBlockBest (GetBlockBest (NoTx Bool
notx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockHash
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockHash
bb ->
      forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
          forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
          forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockBestRaw -> WebT m (RawResult Block)
scottyBlockBestRaw GetBlockBestRaw
_ = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
  forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockHash
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockHash
bb -> do
      Block
b <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock BlockHash
bb
      forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (Block -> [Tx]
H.blockTxns Block
b))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> RawResult a
RawResult Block
b

-- GET BlockLatest --

scottyBlockLatest ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetBlockLatest ->
  WebT m [BlockData]
scottyBlockLatest :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockLatest -> WebT m [BlockData]
scottyBlockLatest (GetBlockLatest (NoTx Bool
noTx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  [BlockData]
blocks <-
    forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound)
        (forall {m :: * -> *}.
StoreReadBase m =>
[BlockData] -> Maybe BlockData -> m [BlockData]
go [] forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock)
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
  forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
blocks
  where
    go :: [BlockData] -> Maybe BlockData -> m [BlockData]
go [BlockData]
acc Maybe BlockData
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [BlockData]
acc
    go [BlockData]
acc (Just BlockData
b)
      | BlockData -> Word32
blockDataHeight BlockData
b forall a. Ord a => a -> a -> Bool
<= Word32
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [BlockData]
acc
      | forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
acc forall a. Eq a => a -> a -> Bool
== Int
99 = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
noTx BlockData
b 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 forall a. a -> [a] -> [a]
: [BlockData]
acc) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockHeight -> WebT m [BlockData]
scottyBlockHeight (GetBlockHeight HeightParam
h (NoTx Bool
notx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  [BlockData]
blocks <- (forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
`getBlocks` Bool
notx) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
h)
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
  forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
blocks

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

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

-- GET BlockTime / BlockTimeRaw --

scottyBlockTime ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetBlockTime ->
  WebT m BlockData
scottyBlockTime :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTime -> WebT m BlockData
scottyBlockTime (GetBlockTime (TimeParam Word64
t) (NoTx Bool
notx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  Chain
ch <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockData
b -> do
      forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockMTP -> WebT m BlockData
scottyBlockMTP (GetBlockMTP (TimeParam Word64
t) (NoTx Bool
notx)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlock
  Chain
ch <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfterMTP Chain
ch Word64
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockData
b -> do
      forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTimeRaw -> WebT m (RawResult Block)
scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam Word64
t)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockRaw
  Chain
ch <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockData
b -> do
      Block
raw <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
BlockData -> m Block
toRawBlock BlockData
b
      forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (Block -> [Tx]
H.blockTxns Block
raw))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> RawResult a
RawResult Block
raw

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

-- GET Transactions --

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

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

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

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

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

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

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

-- GET TransactionAfterHeight --

scottyTxAfter ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetTxAfter ->
  WebT m (GenericResult (Maybe Bool))
scottyTxAfter :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTxAfter -> WebT m (GenericResult (Maybe Bool))
scottyTxAfter (GetTxAfter TxHash
txid HeightParam
height) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionAfter
  (Maybe Bool
result, Int
count) <- forall (m :: * -> *).
(MonadIO m, StoreReadBase m) =>
Word32 -> TxHash -> m (Maybe Bool, Int)
cbAfterHeight (forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
height) TxHash
txid
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
count
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *).
(MonadIO m, StoreReadBase m) =>
Word32 -> TxHash -> m (Maybe Bool, Int)
cbAfterHeight Word32
height TxHash
txid =
  forall {m :: * -> *}.
StoreReadBase m =>
Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
n forall a. HashSet a
HashSet.empty 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, Int
10000)
    inputs Int
i HashSet TxHash
is HashSet TxHash
ns [] =
      let is' :: HashSet TxHash
is' = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet TxHash
is HashSet TxHash
ns
          ns' :: HashSet a
ns' = forall a. HashSet a
HashSet.empty
          ts :: [TxHash]
ts = forall a. HashSet a -> [a]
HashSet.toList (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
            [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Bool
False, Int
n 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' forall a. HashSet a
ns' [TxHash]
ts
    inputs Int
i HashSet TxHash
is HashSet TxHash
ns (TxHash
t : [TxHash]
ts) =
      forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Transaction
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, Int
n 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 forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Bool
True, Int
n forall a. Num a => a -> a -> a
- Int
i forall a. Num a => a -> a -> a
+ Int
1)
                else
                  let ns' :: HashSet TxHash
ns' = 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 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 forall a. Num a => a -> a -> a
- Int
1) HashSet TxHash
is HashSet TxHash
ns [TxHash]
ts
    cb_check :: Transaction -> Bool
cb_check = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StoreInput -> Bool
isCoinbase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [StoreInput]
transactionInputs
    ins :: Transaction -> HashSet TxHash
ins = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (OutPoint -> TxHash
outPointHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreInput -> OutPoint
inputPoint) 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 forall a. Ord a => a -> a -> Bool
> Word32
height
        BlockRef
_ -> Bool
True

-- POST Transaction --

scottyPostTx :: (MonadUnliftIO m, MonadLoggerIO m) => PostTx -> WebT m TxId
scottyPostTx :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
PostTx -> WebT m TxId
scottyPostTx (PostTx Tx
tx) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statTransactionPost
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> WebConfig
webConfig) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WebConfig
cfg ->
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> Tx -> m (Either PubExcept ())
publishTx WebConfig
cfg Tx
tx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right () -> forall (m :: * -> *) a. Monad m => a -> m a
return (TxHash -> TxId
TxId (Tx -> TxHash
txHash Tx
tx))
      Left e :: PubExcept
e@(PubReject RejectCode
_) -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise forall a b. (a -> b) -> a -> b
$ String -> Except
UserError (forall a. Show a => a -> String
show PubExcept
e)
      Either PubExcept ()
_ -> 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> Tx -> m (Either PubExcept ())
publishTx WebConfig
cfg Tx
tx =
  forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
s ->
    forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (Tx -> TxHash
txHash Tx
tx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Transaction
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
      Maybe Transaction
Nothing -> 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 =
      forall (m :: * -> *). MonadIO m => PeerManager -> m [OnlinePeer]
getPeers PeerManager
mgr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PubExcept
PubNoPeers
        OnlinePeer {onlinePeerMailbox :: OnlinePeer -> Peer
onlinePeerMailbox = Peer
p} : [OnlinePeer]
_ -> do
          Tx -> Message
MTx Tx
tx 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
          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
          forall {m :: * -> *} {mbox :: * -> *}.
(MonadIO m, InChan mbox) =>
Peer -> mbox StoreEvent -> m (Either PubExcept ())
f Peer
p mbox StoreEvent
s
    t :: Int
t = Int
5 forall a. Num a => a -> a -> a
* Int
1000 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
      | Bool
otherwise =
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
UnliftIO.timeout Int
t (forall {m :: * -> *} {mbox :: * -> *}.
(InChan mbox, MonadIO m) =>
Peer -> mbox StoreEvent -> m (Either PubExcept ())
g Peer
p mbox StoreEvent
s)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe (Either PubExcept ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PubExcept
PubTimeout
            Just (Left PubExcept
e) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PubExcept
e
            Just (Right ()) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
    g :: Peer -> mbox StoreEvent -> m (Either PubExcept ())
g Peer
p mbox StoreEvent
s =
      forall (mbox :: * -> *) (m :: * -> *) msg.
(InChan mbox, MonadIO m) =>
mbox msg -> m msg
receive mbox StoreEvent
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        StoreTxReject Peer
p' TxHash
h' RejectCode
c ByteString
_
          | Peer
p forall a. Eq a => a -> a -> Bool
== Peer
p' Bool -> Bool -> Bool
&& TxHash
h' forall a. Eq a => a -> a -> Bool
== Tx -> TxHash
txHash Tx
tx -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ RejectCode -> PubExcept
PubReject RejectCode
c
        StorePeerDisconnected Peer
p'
          | Peer
p forall a. Eq a => a -> a -> Bool
== Peer
p' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left PubExcept
PubPeerDisconnected
        StoreMempoolNew TxHash
h'
          | TxHash
h' forall a. Eq a => a -> a -> Bool
== Tx -> TxHash
txHash Tx
tx -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetMempool -> WebT m [TxHash]
scottyMempool (GetMempool Maybe LimitParam
limitM (OffsetParam Natural
o)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statMempool
  WebLimits
wl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebConfig -> WebLimits
webMaxLimits 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) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
o) forall a. Maybe a
Nothing
  [TxHash]
ths <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Limits -> [a] -> [a]
applyLimits Limits
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig) WebState
s
    gauge :: Maybe Gauge
gauge = WebMetrics -> Gauge
statEvents forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebState -> Maybe WebMetrics
webMetrics WebState
s
    events :: ServerApp
events PendingConnection
pending = forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
sub -> do
      let path :: ByteString
path = RequestHead -> ByteString
requestPath forall a b. (a -> b) -> a -> b
$ PendingConnection -> RequestHead
pendingRequest PendingConnection
pending
      if ByteString
path forall a. Eq a => a -> a -> Bool
== ByteString
"/events"
        then do
          Connection
conn <- PendingConnection -> IO Connection
acceptRequest PendingConnection
pending
          forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
            Inbox StoreEvent -> IO (Maybe Event)
receiveEvent Inbox StoreEvent
sub forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe Event
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just Event
event -> forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
conn (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 forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyEvents =
  forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> Gauge) -> WebT m a -> WebT m a
withGaugeIncrease WebMetrics -> Gauge
statEvents forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    SerialAs
proto <- forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupContentType Bool
False
    Publisher StoreEvent
pub <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Publisher StoreEvent
storePublisher forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
    forall (m :: * -> *) e. Monad m => StreamingBody -> ActionT e m ()
S.stream forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
io IO ()
flush' ->
      forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
sub ->
        forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
          IO ()
flush' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Inbox StoreEvent -> IO (Maybe Event)
receiveEvent Inbox StoreEvent
sub forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Builder -> IO ()
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ forall a.
Serial a =>
SerialAs -> (a -> Encoding) -> (a -> Value) -> a -> ByteString
protoSerial SerialAs
proto forall a. ToJSON a => a -> Encoding
toEncoding forall a. ToJSON a => a -> Value
toJSON a
e forall a. Semigroup a => a -> a -> a
<> forall {a}. (Monoid a, IsString a) => SerialAs -> a
newLine SerialAs
proto
    newLine :: SerialAs -> a
newLine SerialAs
SerialAsBinary = forall a. Monoid a => a
mempty
    newLine SerialAs
SerialAsJSON = a
"\n"
    newLine SerialAs
SerialAsPrettyJSON = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall a. a -> Maybe a
Just (BlockHash -> Event
EventBlock BlockHash
b)
      StoreMempoolNew TxHash
t -> forall a. a -> Maybe a
Just (TxHash -> Event
EventTx TxHash
t)
      StoreMempoolDelete TxHash
t -> forall a. a -> Maybe a
Just (TxHash -> Event
EventTx TxHash
t)
      StoreEvent
_ -> forall a. Maybe a
Nothing

-- GET Address Transactions --

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

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

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

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

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

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

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

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

-- GET XPubs --

scottyXPub ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetXPub -> WebT m XPubSummary
scottyXPub :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPub -> WebT m XPubSummary
scottyXPub (GetXPub XPubKey
xpub DeriveType
deriv (NoCache Bool
noCache)) = do
  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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
DelCachedXPub -> WebT m (GenericResult Bool)
scottyDelXPub (DelCachedXPub XPubKey
xpub DeriveType
deriv) = do
  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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Maybe CacheConfig
storeCache forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
  Integer
n <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
StoreReadBase m =>
Maybe CacheConfig -> CacheT m a -> m a
withCache Maybe CacheConfig
cacheM (forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheT m Integer
cacheDelXPubs [XPubSpec
xspec])
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> GenericResult a
GenericResult (Integer
n forall a. Ord a => a -> a -> Bool
> Integer
0))

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

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

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

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

scottyXPubUnspent ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetXPubUnspent ->
  WebT m [XPubUnspent]
scottyXPubUnspent :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubUnspent -> WebT m [XPubUnspent]
scottyXPubUnspent (GetXPubUnspent XPubKey
xpub DeriveType
deriv LimitsParam
pLimits (NoCache Bool
noCache)) = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statXpubUnspent
  Limits
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 <- forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
  [XPubUnspent]
unspents <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xspec [XPubBal]
xbals Limits
limits
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
unspents)
  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 forall a. Eq a => a -> a -> Bool
== Network
btc =
      BinfoSymbol
        { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
"BTC",
          getBinfoSymbolString :: Text
getBinfoSymbolString = Text
"BTC",
          getBinfoSymbolName :: Text
getBinfoSymbolName = Text
"Bitcoin",
          getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = Double
100 forall a. Num a => a -> a -> a
* Double
1000 forall a. Num a => a -> a -> a
* Double
1000,
          getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
True,
          getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
False
        }
  | Network
net forall a. Eq a => a -> a -> Bool
== Network
bch =
      BinfoSymbol
        { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
"BCH",
          getBinfoSymbolString :: Text
getBinfoSymbolString = Text
"BCH",
          getBinfoSymbolName :: Text
getBinfoSymbolName = Text
"Bitcoin Cash",
          getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = Double
100 forall a. Num a => a -> a -> a
* Double
1000 forall a. Num a => a -> a -> a
* Double
1000,
          getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
True,
          getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
False
        }
  | Bool
otherwise =
      BinfoSymbol
        { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
"XTS",
          getBinfoSymbolString :: Text
getBinfoSymbolString = Text
"¤",
          getBinfoSymbolName :: Text
getBinfoSymbolName = Text
"Test",
          getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = Double
100 forall a. Num a => a -> a -> a
* Double
1000 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
binfoTickerSymbol :: BinfoTicker -> Text
binfoTickerSell :: BinfoTicker -> Double
binfoTickerLast :: BinfoTicker -> Double
binfoTickerBuy :: BinfoTicker -> Double
binfoTicker15m :: BinfoTicker -> Double
binfoTickerSymbol :: Text
binfoTickerSell :: Double
binfoTickerBuy :: Double
binfoTickerLast :: Double
binfoTicker15m :: Double
..} =
  BinfoSymbol
    { getBinfoSymbolCode :: Text
getBinfoSymbolCode = Text
code,
      getBinfoSymbolString :: Text
getBinfoSymbolString = Text
binfoTickerSymbol,
      getBinfoSymbolName :: Text
getBinfoSymbolName = Text
name,
      getBinfoSymbolConversion :: Double
getBinfoSymbolConversion =
        Double
100 forall a. Num a => a -> a -> a
* Double
1000 forall a. Num a => a -> a -> a
* Double
1000 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 :: forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
name = do
  Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig))
  Text
p <- forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param (forall a b. ConvertibleStrings a b => a -> b
cs Text
name) forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Text
"")
  if Text -> Bool
T.null Text
p
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. HashSet a
HashSet.empty
    else case Network -> Text -> Maybe [BinfoAddr]
parseBinfoAddr Network
net Text
p of
      Maybe [BinfoAddr]
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (String -> Except
UserError String
"invalid address")
      Just [BinfoAddr]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [BinfoAddr]
xs

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

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

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

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

getBinfoUnspents ::
  (StoreReadExtra m, MonadIO m) =>
  (Int -> m ()) ->
  Bool ->
  H.BlockHeight ->
  HashMap XPubSpec [XPubBal] ->
  HashSet XPubSpec ->
  HashSet Address ->
  ConduitT () BinfoUnspent m ()
getBinfoUnspents :: forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
(Int -> m ())
-> Bool
-> Word32
-> HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent m ()
getBinfoUnspents Int -> m ()
counter Bool
numtxid Word32
height HashMap XPubSpec [XPubBal]
xbals HashSet XPubSpec
xspecs HashSet Address
addrs = do
  [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
cs' <- ConduitT
  () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
conduits
  forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
cs' forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (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
unspentScript :: Unspent -> ByteString
unspentPoint :: Unspent -> OutPoint
unspentBlock :: Unspent -> BlockRef
unspentAmount :: Unspent -> Word64
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 forall a. Num a => a -> a -> a
- Word32
h 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
            { getBinfoUnspentHash :: TxHash
getBinfoUnspentHash = TxHash
hash,
              getBinfoUnspentOutputIndex :: Word32
getBinfoUnspentOutputIndex = Word32
idx,
              getBinfoUnspentScript :: ByteString
getBinfoUnspentScript = ByteString
script,
              getBinfoUnspentValue :: Word64
getBinfoUnspentValue = Word64
val,
              getBinfoUnspentConfirmations :: Int32
getBinfoUnspentConfirmations = 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 [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
conduits = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT
  () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
xconduits forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {a}. [ConduitT () (Unspent, Maybe a) m ()]
acounduits
    xconduits :: ConduitT
  () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
xconduits = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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 = forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPath
listToPath [Word32]
p)
                xp :: Maybe BinfoXPubPath
xp = XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath (XPubSpec -> XPubKey
xPubSpecKey XPubSpec
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SoftPath
path
             in (Unspent
u, Maybe BinfoXPubPath
xp)
          g :: XPubSpec -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
g XPubSpec
x = do
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
                ( \Limits
l -> do
                    [XPubUnspent]
us <- forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
x (XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals XPubSpec
x HashMap XPubSpec [XPubBal]
xbals) Limits
l
                    Int -> m ()
counter (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
us)
                    forall (m :: * -> *) a. Monad m => a -> m a
return [XPubUnspent]
us
                )
                forall a. Maybe a
Nothing
                forall a. Default a => a
def {limit :: Word32
limit = Word32
16}
                forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (XPubSpec -> XPubUnspent -> (Unspent, Maybe BinfoXPubPath)
f XPubSpec
x)
      forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
Monad m =>
XPubSpec -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
g (forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
xspecs)
    acounduits :: [ConduitT () (Unspent, Maybe a) m ()]
acounduits =
      let f :: a -> (a, Maybe a)
f a
u = (a
u, forall a. Maybe a
Nothing)
          g :: Address -> ConduitT () (Unspent, Maybe a) m ()
g Address
a =
            forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
              ( \Limits
l -> do
                  [Unspent]
us <- forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
a Limits
l
                  Int -> m ()
counter (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
us)
                  forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
us
              )
              forall a. Maybe a
Nothing
              forall a. Default a => a
def {limit :: Word32
limit = Word32
16}
              forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC forall {a} {a}. a -> (a, Maybe a)
f
       in forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Address -> ConduitT () (Unspent, Maybe a) m ()
g (forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)

getXBals :: StoreReadExtra m => HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals :: forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
      ( \XPubSpec
x ->
          (XPubSpec
x,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
x)
      )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
HashSet.toList

xBals :: XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals :: XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals = forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault []

getBinfoTxs ::
  (StoreReadExtra m, MonadIO m) =>
  (Int -> m ()) -> -- counter
  HashMap XPubSpec [XPubBal] -> -- xpub balances
  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 :: forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
(Int -> m ())
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
  Int -> m ()
counter
  HashMap XPubSpec [XPubBal]
xbals
  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
    forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () TxRef m ()]
cs' forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
bal
    where
      sxspecs_ls :: [XPubSpec]
sxspecs_ls = forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
sxspecs
      saddrs_ls :: [Address]
saddrs_ls = forall a. HashSet a -> [a]
HashSet.toList HashSet Address
saddrs
      conduits :: ConduitT () BinfoTx m [ConduitT () TxRef m ()]
conduits = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c [XPubSpec]
sxspecs_ls forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a -> b) -> [a] -> [b]
map Address -> ConduitT () TxRef m ()
addr_c [Address]
saddrs_ls)
      xpub_c :: XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c XPubSpec
x =
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
            ( \Limits
l -> do
                [TxRef]
ts <- forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
x (XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals XPubSpec
x HashMap XPubSpec [XPubBal]
xbals) Limits
l
                Int -> m ()
counter (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
ts)
                forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
ts
            )
            (forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash)
            forall a. Default a => a
def {limit :: Word32
limit = Word32
16}
      addr_c :: Address -> ConduitT () TxRef m ()
addr_c Address
a =
        forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings
          ( \Limits
l -> do
              [TxRef]
as <- forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a Limits
l
              Int -> m ()
counter (forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
as)
              forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
as
          )
          (forall a. a -> Maybe a
Just TxRef -> TxHash
txRefHash)
          forall a. Default a => a
def {limit :: Word32
limit = Word32
16}
      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
getBinfoTxWeight :: BinfoTx -> Word32
getBinfoTxVoutSz :: BinfoTx -> Word32
getBinfoTxVinSz :: BinfoTx -> Word32
getBinfoTxVer :: BinfoTx -> Word32
getBinfoTxTime :: BinfoTx -> Word64
getBinfoTxSize :: BinfoTx -> Word32
getBinfoTxResultBal :: BinfoTx -> Maybe (Int64, Int64)
getBinfoTxRelayedBy :: BinfoTx -> ByteString
getBinfoTxRBF :: BinfoTx -> Bool
getBinfoTxOutputs :: BinfoTx -> [BinfoTxOutput]
getBinfoTxLockTime :: BinfoTx -> Word32
getBinfoTxInputs :: BinfoTx -> [BinfoTxInput]
getBinfoTxIndex :: BinfoTx -> BinfoTxId
getBinfoTxHash :: BinfoTx -> TxHash
getBinfoTxFee :: BinfoTx -> Word64
getBinfoTxDoubleSpend :: BinfoTx -> Bool
getBinfoTxBlockIndex :: BinfoTx -> Maybe Word32
getBinfoTxBlockHeight :: BinfoTx -> Maybe Word32
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 = 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
getBinfoTxOutputXPub :: BinfoTxOutput -> Maybe BinfoXPubPath
getBinfoTxOutputValue :: BinfoTxOutput -> Word64
getBinfoTxOutputType :: BinfoTxOutput -> Int
getBinfoTxOutputTxIndex :: BinfoTxOutput -> BinfoTxId
getBinfoTxOutputSpent :: BinfoTxOutput -> Bool
getBinfoTxOutputSpenders :: BinfoTxOutput -> [BinfoSpender]
getBinfoTxOutputScript :: BinfoTxOutput -> ByteString
getBinfoTxOutputIndex :: BinfoTxOutput -> Word32
getBinfoTxOutputAddress :: BinfoTxOutput -> Maybe Address
getBinfoTxOutputXPub :: Maybe BinfoXPubPath
getBinfoTxOutputAddress :: Maybe Address
getBinfoTxOutputSpenders :: [BinfoSpender]
getBinfoTxOutputScript :: ByteString
getBinfoTxOutputTxIndex :: BinfoTxId
getBinfoTxOutputIndex :: Word32
getBinfoTxOutputValue :: Word64
getBinfoTxOutputSpent :: Bool
getBinfoTxOutputType :: Int
..} =
              let val :: a
val = 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 forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
baddrs ->
                          if Bool
b then a
val else forall a. Num a => a -> a
negate a
val
                      | Bool
otherwise -> a
0
         in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Num a => Bool -> BinfoTxOutput -> a
f Bool
False) [BinfoTxOutput]
ins forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Num a => Bool -> BinfoTxOutput -> a
f Bool
True) [BinfoTxOutput]
out
      go :: Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b =
        forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe TxRef
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TxRef BlockRef
_ TxHash
t) ->
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
t) 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
                forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Int -> m ()
counter Int
1
                let a :: BinfoTx
a = Int64 -> Transaction -> BinfoTx
binfo_tx Int64
b Transaction
x
                    b' :: Int64
b' = Int64
b forall a. Num a => a -> a -> a
- forall {a}. Num a => BinfoTx -> a
compute_bal_change BinfoTx
a
                    c :: Bool
c = 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (BinfoTx -> Word64
getBinfoTxFee BinfoTx
a)
                case BinfoFilter
bfilter of
                  BinfoFilter
BinfoFilterAll ->
                    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                  BinfoFilter
BinfoFilterSent
                    | Int64
0 forall a. Ord a => a -> a -> Bool
> Int64
r -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a 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 forall a. Ord a => a -> a -> Bool
> Int64
0 -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a 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 forall a. Eq a => a -> a -> Bool
== Int64
0 -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a 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 -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    | Bool
otherwise -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a 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 :: forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr = forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"cashaddr" forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

getAddress :: (Monad m, MonadUnliftIO m) => TL.Text -> WebT m Address
getAddress :: forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
param' = do
  Text
txt <- forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
param'
  Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore 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 -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just Address
a -> forall (m :: * -> *) a. Monad m => a -> m a
return Address
a

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

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

getPrice :: MonadIO m => WebT m (Text, BinfoTicker)
getPrice :: forall (m :: * -> *). MonadIO m => WebT m (Text, BinfoTicker)
getPrice = do
  Text
code <- Text -> Text
T.toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"currency" forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Text
"USD")
  TVar (HashMap Text BinfoTicker)
ticker <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> TVar (HashMap Text BinfoTicker)
webTicker
  HashMap Text BinfoTicker
prices <- forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (HashMap Text BinfoTicker)
ticker
  case 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
code, forall a. Default a => a
def)
    Just BinfoTicker
p -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
code, BinfoTicker
p)

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

scottyBinfoBlocksDay :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoBlocksDay :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoBlocksDay = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainBlocks
  Word64
t <- forall a. Ord a => a -> a -> a
min Word64
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`div` Word64
1000) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"milliseconds"
  Chain
ch <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Chain
storeChain forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  Maybe BlockData
m <- forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t
  [BlockData]
bs <- forall {m :: * -> *} {t}.
(Integral t, StoreReadBase m) =>
t -> Maybe BlockData -> m [BlockData]
go (Word64 -> Word64
d Word64
t) Maybe BlockData
m
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
bs)
  forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Encoding
toEncoding forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BlockData -> BinfoBlockInfo
toBinfoBlockInfo [BlockData]
bs
  where
    h :: Word64
h = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: H.Timestamp)
    d :: Word64 -> Word64
d = forall a. Num a => a -> a -> a
subtract (Word64
24 forall a. Num a => a -> a -> a
* Word64
3600)
    go :: t -> Maybe BlockData -> m [BlockData]
go t
_ Maybe BlockData
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return []
    go t
t (Just BlockData
b)
      | BlockHeader -> Word32
H.blockTimestamp (BlockData -> BlockHeader
blockDataHeader BlockData
b) forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral t
t =
          forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Bool
otherwise = do
          Maybe BlockData
b' <- forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (BlockHeader -> BlockHash
H.prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
b))
          (BlockData
b forall a. a -> [a] -> [a]
:) 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyMultiAddr = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainMultiaddr
  (HashSet Address
addrs', HashSet XPubKey
_, HashSet Address
saddrs, HashSet XPubKey
sxpubs, HashSet XPubSpec
xspecs) <- ActionT
  Except
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashSet XPubSpec)
get_addrs
  Bool
numtxid <- forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  Bool
cashaddr <- forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr
  BinfoSymbol
local' <- forall (m :: * -> *). MonadIO m => WebT m BinfoSymbol
getSymbol
  Int
offset <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
  Int
n <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"n"
  Bool
prune <- ActionT Except (ReaderT WebState m) Bool
get_prune
  BinfoFilter
fltr <- ActionT Except (ReaderT WebState m) BinfoFilter
get_filter
  HashMap XPubSpec [XPubBal]
xbals <- forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals HashSet XPubSpec
xspecs
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubSpec [XPubBal]
xbals
  HashMap XPubSpec Word64
xtxns <- forall {f :: * -> *} {v}.
(Num v, StoreReadExtra f) =>
HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec -> f (HashMap XPubSpec v)
get_xpub_tx_count HashMap XPubSpec [XPubBal]
xbals HashSet XPubSpec
xspecs
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap XPubSpec Word64
xtxns)
  let sxbals :: HashMap XPubSpec [XPubBal]
sxbals = forall {v}.
HashSet XPubKey -> HashMap XPubSpec v -> HashMap XPubSpec v
only_show_xbals HashSet XPubKey
sxpubs HashMap XPubSpec [XPubBal]
xbals
      xabals :: HashMap Address Balance
xabals = forall {k}. HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals HashMap XPubSpec [XPubBal]
xbals
      addrs :: HashSet Address
addrs = HashSet Address
addrs' forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HashSet.difference` 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
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Address Balance
abals)
  let sxspecs :: HashSet XPubSpec
sxspecs = HashSet XPubKey -> HashSet XPubSpec -> HashSet XPubSpec
only_show_xspecs HashSet XPubKey
sxpubs HashSet XPubSpec
xspecs
      sxabals :: HashMap Address Balance
sxabals = forall {k}. HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals HashMap XPubSpec [XPubBal]
sxbals
      sabals :: HashMap Address Balance
sabals = forall {a} {v}.
Hashable a =>
HashSet a -> HashMap a v -> HashMap a v
only_show_abals HashSet Address
saddrs HashMap Address Balance
abals
      sallbals :: HashMap Address Balance
sallbals = HashMap Address Balance
sabals forall a. Semigroup a => a -> a -> a
<> HashMap Address Balance
sxabals
      sbal :: Word64
sbal = forall {k}. HashMap k Balance -> Word64
compute_bal HashMap Address Balance
sallbals
      allbals :: HashMap Address Balance
allbals = HashMap Address Balance
abals forall a. Semigroup a => a -> a -> a
<> HashMap Address Balance
xabals
      abook :: HashMap Address (Maybe BinfoXPubPath)
abook = HashSet Address
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
compute_abook HashSet Address
addrs HashMap XPubSpec [XPubBal]
xbals
      sxaddrs :: HashSet Address
sxaddrs = forall {k}. HashMap k [XPubBal] -> HashSet Address
compute_xaddrs HashMap XPubSpec [XPubBal]
sxbals
      salladdrs :: HashSet Address
salladdrs = HashSet Address
saddrs forall a. Semigroup a => a -> a -> a
<> HashSet Address
sxaddrs
      bal :: Word64
bal = forall {k}. HashMap k Balance -> Word64
compute_bal HashMap Address Balance
allbals
      ibal :: Int64
ibal = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sbal
  Int -> ReaderT WebState m ()
counter <- forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter
  [BinfoTx]
ftxs <-
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
(Int -> m ())
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
        Int -> ReaderT WebState m ()
counter
        HashMap XPubSpec [XPubBal]
xbals
        HashMap Address (Maybe BinfoXPubPath)
abook
        HashSet XPubSpec
sxspecs
        HashSet Address
saddrs
        HashSet Address
salladdrs
        BinfoFilter
fltr
        Bool
numtxid
        Bool
prune
        Int64
ibal
        forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
offset forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
  BlockData
best <- ActionT Except (ReaderT WebState m) BlockData
get_best_block
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Word32
peers <- ActionT Except (ReaderT WebState m) Word32
get_peers
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
peers)
  Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  let baddrs :: [BinfoBalance]
baddrs = HashMap Address Balance
-> HashMap XPubSpec [XPubBal]
-> HashMap XPubSpec Word64
-> [BinfoBalance]
toBinfoAddrs HashMap Address Balance
sabals HashMap XPubSpec [XPubBal]
sxbals HashMap XPubSpec Word64
xtxns
      abaddrs :: [BinfoBalance]
abaddrs = HashMap Address Balance
-> HashMap XPubSpec [XPubBal]
-> HashMap XPubSpec Word64
-> [BinfoBalance]
toBinfoAddrs HashMap Address Balance
abals HashMap XPubSpec [XPubBal]
xbals HashMap XPubSpec Word64
xtxns
      recv :: Word64
recv = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BinfoBalance -> Word64
getBinfoAddrReceived [BinfoBalance]
abaddrs
      sent' :: Word64
sent' = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BinfoBalance -> Word64
getBinfoAddrSent [BinfoBalance]
abaddrs
      txn :: Word64
txn = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
ftxs
      wallet :: BinfoWallet
wallet =
        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
          { 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
          { getBinfoConnected :: Word32
getBinfoConnected = Word32
peers,
            getBinfoConversion :: Double
getBinfoConversion = Double
100 forall a. Num a => a -> a -> a
* Double
1000 forall a. Num a => a -> a -> a
* Double
1000,
            getBinfoLocal :: BinfoSymbol
getBinfoLocal = BinfoSymbol
local',
            getBinfoBTC :: BinfoSymbol
getBinfoBTC = BinfoSymbol
coin,
            getBinfoLatestBlock :: BinfoBlockInfo
getBinfoLatestBlock = BinfoBlockInfo
block
          }
  forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding forall a b. (a -> b) -> a -> b
$
    Network -> BinfoMultiAddr -> Encoding
binfoMultiAddrToEncoding
      Network
net
      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 XPubSpec [XPubBal]
-> HashSet XPubSpec -> f (HashMap XPubSpec v)
get_xpub_tx_count HashMap XPubSpec [XPubBal]
xbals =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
          ( \XPubSpec
x ->
              (XPubSpec
x,)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
x (XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals XPubSpec
x HashMap XPubSpec [XPubBal]
xbals)
          )
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
HashSet.toList
    get_filter :: ActionT Except (ReaderT WebState m) BinfoFilter
get_filter = forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"filter" forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterAll)
    get_best_block :: ActionT Except (ReaderT WebState m) BlockData
get_best_block =
      forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockHash
bh ->
          forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockData
b -> forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
    get_prune :: ActionT Except (ReaderT WebState m) Bool
get_prune =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall a b. (a -> b) -> a -> b
$
        forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"no_compact"
          forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
    only_show_xbals :: HashSet XPubKey -> HashMap XPubSpec v -> HashMap XPubSpec v
only_show_xbals HashSet XPubKey
sxpubs = forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\XPubSpec
k v
_ -> XPubSpec -> XPubKey
xPubSpecKey XPubSpec
k forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet XPubKey
sxpubs)
    only_show_xspecs :: HashSet XPubKey -> HashSet XPubSpec -> HashSet XPubSpec
only_show_xspecs HashSet XPubKey
sxpubs = forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter (\XPubSpec
k -> XPubSpec -> XPubKey
xPubSpecKey XPubSpec
k forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet XPubKey
sxpubs)
    only_show_abals :: HashSet a -> HashMap a v -> HashMap a v
only_show_abals HashSet a
saddrs = forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\a
k v
_ -> a
k forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet a
saddrs)
    addr :: BinfoAddr -> Maybe Address
addr (BinfoAddr Address
a) = forall a. a -> Maybe a
Just Address
a
    addr (BinfoXpub XPubKey
_) = forall a. Maybe a
Nothing
    xpub :: BinfoAddr -> Maybe XPubKey
xpub (BinfoXpub XPubKey
x) = forall a. a -> Maybe a
Just XPubKey
x
    xpub (BinfoAddr Address
_) = forall a. Maybe a
Nothing
    get_addrs :: ActionT
  Except
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashSet XPubSpec)
get_addrs = do
      (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- forall (m :: * -> *).
MonadIO m =>
WebT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
      HashSet BinfoAddr
sh <- forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"onlyShow"
      let xpubs :: HashSet XPubKey
xpubs = forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map XPubSpec -> XPubKey
xPubSpecKey HashSet XPubSpec
xspecs
          actives :: HashSet BinfoAddr
actives =
            forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map Address -> BinfoAddr
BinfoAddr HashSet Address
addrs
              forall a. Semigroup a => a -> a -> a
<> 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 forall a. HashSet a -> Bool
HashSet.null HashSet BinfoAddr
sh then HashSet BinfoAddr
actives else HashSet BinfoAddr
sh
          saddrs :: HashSet Address
saddrs = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe Address
addr forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
sh'
          sxpubs :: HashSet XPubKey
sxpubs = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe XPubKey
xpub forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
sh'
      forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet Address
addrs, HashSet XPubKey
xpubs, HashSet Address
saddrs, HashSet XPubKey
sxpubs, HashSet XPubSpec
xspecs)
    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 = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Balance -> (Address, Balance)
f
       in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Balance] -> HashMap Address Balance
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
HashSet.toList
    get_peers :: ActionT Except (ReaderT WebState m) Word32
get_peers = do
      [PeerInformation]
ps <-
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *).
MonadLoggerIO m =>
PeerManager -> m [PeerInformation]
getPeersInformation
            forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> PeerManager
storeManager forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, Balance)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Num a => a -> a -> a
+ Balance -> Word64
balanceZero Balance
b
       in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Balance -> Word64
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [v]
HashMap.elems
    compute_abook :: HashSet Address
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
compute_abook HashSet Address
addrs HashMap XPubSpec [XPubBal]
xbals =
      let f :: XPubSpec -> XPubBal -> (Address, Maybe BinfoXPubPath)
f XPubSpec {XPubKey
DeriveType
xPubDeriveType :: XPubSpec -> DeriveType
xPubDeriveType :: DeriveType
xPubSpecKey :: XPubKey
xPubSpecKey :: XPubSpec -> XPubKey
..} 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 = forall a. HasCallStack => String -> a
error String
"lions and tigers and bears"
                s :: Maybe SoftPath
s = forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPath
listToPath [Word32]
xPubBalPath)
             in (Address
a, forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath XPubKey
xPubSpecKey (forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e Maybe SoftPath
s)))
          amap :: HashMap Address (Maybe a)
amap =
            forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
              forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet Address
addrs
          xmap :: HashMap Address (Maybe BinfoXPubPath)
xmap =
            forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> XPubBal -> (Address, Maybe BinfoXPubPath)
f))
              forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [XPubBal]
xbals
       in forall {a}. HashMap Address (Maybe a)
amap 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 = forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Address
balanceAddress forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal)
       in forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [XPubBal] -> [Address]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [v]
HashMap.elems

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

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

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

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

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

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

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

scottyShortBal :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyShortBal :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyShortBal = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainBalance
  (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- forall (m :: * -> *).
MonadIO m =>
WebT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
  Bool
cashaddr <- forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr
  Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  [(Text, BinfoShortBal)]
abals <-
    forall a. [Maybe a] -> [a]
catMaybes
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
StoreReadBase m =>
Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
get_addr_balance Network
net Bool
cashaddr) (forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, BinfoShortBal)]
abals)
  [(Text, BinfoShortBal)]
xbals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
get_xspec_balance Network
net) (forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
xspecs)
  let res :: HashMap Text BinfoShortBal
res = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, BinfoShortBal)]
abals forall a. Semigroup a => a -> a -> a
<> [(Text, BinfoShortBal)]
xbals)
  forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding forall a b. (a -> b) -> a -> b
$ 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
        { binfoShortBalFinal :: Word64
binfoShortBalFinal = Word64
balanceAmount 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 forall a. Eq a => a -> a -> Bool
== Network
bch -> Network
btc
                | Network
net forall a. Eq a => a -> a -> Bool
== Network
bchTest -> Network
btcTest
                | Network
net 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            Just Text
a' ->
              forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe Balance
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
a', Balance -> BinfoShortBal
to_short_bal (Address -> Balance
zeroBalance Address
a))
                Just Balance
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      Word32
xts <- forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
      forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals forall a. Num a => a -> a -> a
+ Int
1)
      let val :: Word64
val = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
          zro :: Word64
zro = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
xbals
          exs :: [XPubBal]
exs = forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
is_ext [XPubBal]
xbals
          rcv :: Word64
rcv = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Balance -> Word64
balanceTotalReceived forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubBal -> Balance
xPubBal) [XPubBal]
exs
          sbl :: BinfoShortBal
sbl =
            BinfoShortBal
              { binfoShortBalFinal :: Word64
binfoShortBalFinal = Word64
val forall a. Num a => a -> a -> a
+ Word64
zro,
                binfoShortBalTxCount :: Word64
binfoShortBalTxCount = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
xts,
                binfoShortBalReceived :: Word64
binfoShortBalReceived = Word64
rcv
              }
      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 :: forall (m :: * -> *). Monad m => WebT m Bool
getBinfoHex =
  (forall a. Eq a => a -> a -> Bool
== (Text
"hex" :: Text))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"format" forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Text
"json")

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

scottyBinfoLatest :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoLatest :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoLatest = do
  Bool
numtxid <- forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  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 = 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
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Encoding
toEncoding BinfoHeader {[BinfoTxId]
Word32
BlockHash
binfoTxIndices :: [BinfoTxId]
binfoHeaderTime :: Word32
binfoHeaderIndex :: Word32
binfoHeaderHeight :: Word32
binfoHeaderHash :: BlockHash
binfoHeaderHeight :: Word32
binfoHeaderIndex :: Word32
binfoHeaderTime :: Word32
binfoHeaderHash :: BlockHash
binfoTxIndices :: [BinfoTxId]
..}
  where
    get_best_block :: ActionT Except (ReaderT WebState m) BlockData
get_best_block =
      forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockHash
bh ->
          forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockData
b -> forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b

scottyBinfoBlock :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoBlock :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoBlock = do
  Bool
numtxid <- forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  Bool
hex <- forall (m :: * -> *). Monad m => WebT m Bool
getBinfoHex
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainRawblock
  forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"block" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    BinfoBlockHash BlockHash
bh -> forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
    BinfoBlockIndex Word32
i ->
      forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        BlockHash
bh : [BlockHash]
_ -> 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 (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$
          forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$
            forall a. HasCallStack => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =
      forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
          forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
          [Transaction]
txs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Transaction
get_tx (BlockData -> [TxHash]
blockDataTxs BlockData
b)
          forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
          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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHeader
blockDataHeader
              get_hash :: BlockData -> BlockHash
get_hash = BlockHeader -> BlockHash
H.headerHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHeader
blockDataHeader
          [BlockData]
nxt_headers <-
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
              forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
                forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (BlockData -> Word32
blockDataHeight BlockData
b forall a. Num a => a -> a -> a
+ Word32
1)
          forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
nxt_headers)
          let nxt :: [BlockHash]
nxt =
                forall a b. (a -> b) -> [a] -> [b]
map BlockData -> BlockHash
get_hash forall a b. (a -> b) -> a -> b
$
                  forall a. (a -> Bool) -> [a] -> [a]
filter
                    ((forall a. Eq a => a -> a -> Bool
== BlockHash
my_hash) 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) (forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Tx
transactionData [Transaction]
txs)
              forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
              forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Block
x
            else do
              let btxs :: [BinfoTx]
btxs = 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
              forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
              Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
              forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding 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 :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid = do
  [Transaction]
tx <- case BinfoTxId
txid of
    BinfoTxIdHash TxHash
h -> forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h
    BinfoTxIdIndex Word64
i -> forall (m :: * -> *).
(Monad m, StoreReadExtra m) =>
Word64 -> m [Transaction]
getNumTransaction Word64
i
  case [Transaction]
tx of
    [Transaction
t] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Transaction
t
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Except
ThingNotFound
    [Transaction]
ts ->
      let tids :: [TxHash]
tids = forall a b. (a -> b) -> [a] -> [b]
map (Tx -> TxHash
txHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Tx
transactionData) [Transaction]
ts
       in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([TxHash] -> Except
TxIndexConflict [TxHash]
tids)

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

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

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

scottyBinfoTotalInput :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoTotalInput :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoTotalInput = do
  BinfoTxId
txid <- forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txid"
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQtxtotalbtcinput
  Transaction
tx <-
    forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> WebT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right Transaction
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
      Left Except
e -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
e
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Word64
inputAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter StoreInput -> Bool
f 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoMempool = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainMempool
  Bool
numtxid <- forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  Int
offset <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
  Int
n <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"limit"
  [(Word64, TxHash)]
mempool <- forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
  let txids :: [TxHash]
txids = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
offset [(Word64, TxHash)]
mempool
  [Transaction]
txs <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction [TxHash]
txids
  Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  let mem :: BinfoMempool
mem = [BinfoTx] -> BinfoMempool
BinfoMempool forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
  forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding forall a b. (a -> b) -> a -> b
$ Network -> BinfoMempool -> Encoding
binfoMempoolToEncoding Network
net BinfoMempool
mem

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

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

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

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

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

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

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

scottyBinfoHashPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoHashPubkey :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoHashPubkey = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statBlockchainQhashpubkey
  Maybe PubKeyI
pkm <- (forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
"Could not decode public key"
    Just PubKeyI
pk -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PubKeyI -> Address
pubKeyAddr PubKeyI
pk
  forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetPeers -> WebT m [PeerInformation]
scottyPeers GetPeers
_ = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statPeers
  [PeerInformation]
ps <-
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *).
MonadLoggerIO m =>
PeerManager -> m [PeerInformation]
getPeersInformation
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> PeerManager
storeManager forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [PeerInformation]
ps)
  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 :: forall (m :: * -> *).
MonadLoggerIO m =>
PeerManager -> m [PeerInformation]
getPeersInformation PeerManager
mgr =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe OnlinePeer -> Maybe PeerInformation
toInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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
      forall (m :: * -> *) a. Monad m => a -> m a
return
        PeerInformation
          { peerUserAgent :: ByteString
peerUserAgent = ByteString
ua,
            peerAddress :: String
peerAddress = 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetHealth -> WebT m HealthCheck
scottyHealth GetHealth
_ = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statHealth
  HealthCheck
h <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WebState -> TVar HealthCheck
webHealthCheck forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Healthy a => a -> Bool
isOK HealthCheck
h) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
S.status Status
status503
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
h

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

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

lastTxHealthCheck ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  WebConfig ->
  m TimeHealth
lastTxHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig {Bool
Int
String
Maybe Store
Store
WebTimeouts
WebLimits
webHealthCheckInterval :: Int
webBlockchain :: Bool
webSlow :: Bool
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
webHealthCheckInterval :: WebConfig -> Int
webBlockchain :: WebConfig -> Bool
webSlow :: WebConfig -> Bool
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 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
  Int64
b <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> Word32
H.blockTimestamp forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockNode -> BlockHeader
H.nodeHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
  Int64
t <-
    forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Word64, TxHash)
t : [(Word64, TxHash)]
_ ->
        let x :: Int64
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Word64, TxHash)
t
         in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int64
x Int64
b
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Int64
b
  let timeHealthAge :: Int64
timeHealthAge = Int64
n forall a. Num a => a -> a -> a
- Int64
t
      timeHealthMax :: Int64
timeHealthMax = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
to
  forall (m :: * -> *) a. Monad m => a -> m a
return TimeHealth {Int64
timeHealthMax :: Int64
timeHealthAge :: Int64
timeHealthMax :: Int64
timeHealthAge :: 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 :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m MaxHealth
pendingTxsHealthCheck WebConfig
cfg = do
  let maxHealthMax :: Int64
maxHealthMax = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WebConfig -> Int
webMaxPending WebConfig
cfg
  Int64
maxHealthNum <-
    forall a b. (Integral a, Num b) => a -> b
fromIntegral
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => BlockStore -> m Int
blockStorePendingTxs (Store -> BlockStore
storeBlock (WebConfig -> Store
webStore WebConfig
cfg))
  forall (m :: * -> *) a. Monad m => a -> m a
return MaxHealth {Int64
maxHealthNum :: Int64
maxHealthMax :: Int64
maxHealthNum :: Int64
maxHealthMax :: Int64
..}

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

healthCheck ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  WebConfig ->
  m HealthCheck
healthCheck :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m HealthCheck
healthCheck cfg :: WebConfig
cfg@WebConfig {Bool
Int
String
Maybe Store
Store
WebTimeouts
WebLimits
webHealthCheckInterval :: Int
webBlockchain :: Bool
webSlow :: Bool
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
webHealthCheckInterval :: WebConfig -> Int
webBlockchain :: WebConfig -> Bool
webSlow :: WebConfig -> Bool
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 <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m BlockHealth
blockHealthCheck WebConfig
cfg
  TimeHealth
healthLastBlock <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
Chain -> WebTimeouts -> m TimeHealth
lastBlockHealthCheck (Store -> Chain
storeChain Store
webStore) WebTimeouts
webTimeouts
  TimeHealth
healthLastTx <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig
cfg
  MaxHealth
healthPendingTxs <- forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m MaxHealth
pendingTxsHealthCheck WebConfig
cfg
  CountHealth
healthPeers <- 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 {String
BlockHealth
CountHealth
MaxHealth
TimeHealth
healthVersion :: String
healthPendingTxs :: MaxHealth
healthPeers :: CountHealth
healthNetwork :: String
healthLastTx :: TimeHealth
healthLastBlock :: TimeHealth
healthBlocks :: BlockHealth
healthVersion :: String
healthNetwork :: String
healthPeers :: CountHealth
healthPendingTxs :: MaxHealth
healthLastTx :: TimeHealth
healthLastBlock :: TimeHealth
healthBlocks :: BlockHealth
..}
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Healthy a => a -> Bool
isOK HealthCheck
hc) forall a b. (a -> b) -> a -> b
$ do
    let t :: Text
t = Text -> Text
toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText HealthCheck
hc
    $(logErrorS) Text
"Web" forall a b. (a -> b) -> a -> b
$ Text
"Health check failed: " forall a. Semigroup a => a -> a -> a
<> Text
t
  forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
hc

scottyDbStats :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyDbStats :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyDbStats = do
  forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics WebMetrics -> StatDist
statDbstats
  forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  DB
db <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (DatabaseReader -> DB
databaseHandle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store -> DatabaseReader
storeDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebState -> WebConfig
webConfig)
  Maybe ByteString
statsM <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
MonadIO m =>
DB -> Property -> m (Maybe ByteString)
getProperty DB
db Property
Stats)
  forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Could not get stats" 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 :: forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional = forall a (m :: * -> *).
(Param a, MonadIO m) =>
Proxy a -> WebT m (Maybe a)
go forall {k} (t :: k). Proxy t
Proxy
  where
    go :: (Param a, MonadIO m) => Proxy a -> WebT m (Maybe a)
    go :: forall a (m :: * -> *).
(Param a, MonadIO m) =>
Proxy a -> WebT m (Maybe a)
go Proxy a
proxy = do
      Network
net <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Store -> Network
storeNetwork forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebConfig -> Store
webStore 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 forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
      case Maybe [Text]
tsM of
        Maybe [Text]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing -- Parameter was not supplied
        Just [Text]
ts -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
err) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$ forall a. Param a => Network -> [Text] -> Maybe a
parseParam Network
net [Text]
ts
      where
        l :: Text
l = forall a. Param a => Proxy a -> Text
proxyLabel Proxy a
proxy
        p :: ActionT Except (ReaderT WebState m) (Maybe [Text])
p = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param (forall a b. ConvertibleStrings a b => a -> b
cs Text
l)
        err :: Except
err = String -> Except
UserError forall a b. (a -> b) -> a -> b
$ String
"Unable to parse param " forall a. Semigroup a => a -> a -> a
<> 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 :: forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
param = forall a (m :: * -> *). (Param a, MonadIO m) => Proxy a -> WebT m a
go forall {k} (t :: k). Proxy t
Proxy
  where
    go :: (Param a, MonadIO m) => Proxy a -> WebT m a
    go :: forall a (m :: * -> *). (Param a, MonadIO m) => Proxy a -> WebT m a
go Proxy a
proxy = do
      Maybe a
resM <- forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional
      case Maybe a
resM of
        Just a
res -> forall (m :: * -> *) a. Monad m => a -> m a
return a
res
        Maybe a
_ ->
          forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Except
UserError forall a b. (a -> b) -> a -> b
$
            String
"The param " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Param a => Proxy a -> Text
proxyLabel Proxy a
proxy) 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 :: forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy = do
  Maybe a
resM <- forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
resM

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

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

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

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

paramToLimits ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  Bool ->
  LimitsParam ->
  WebT m Limits
paramToLimits :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
full (LimitsParam Maybe LimitParam
limitM OffsetParam
o Maybe StartParam
startM) = do
  WebLimits
wl <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (WebConfig -> WebLimits
webMaxLimits 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) (forall a b. (Integral a, Num b) => a -> b
fromIntegral OffsetParam
o) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =
  forall {p}. (Num p, Ord p) => p -> p -> p
f Word32
m forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 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 :: p -> p -> p
f p
a p
0 = p
a
    f p
0 p
b = p
b
    f p
a p
b = forall a. Ord a => a -> a -> a
min p
a p
b

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

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

runNoCache :: MonadIO m => Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache :: forall (m :: * -> *) a.
MonadIO m =>
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 = 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 = forall a. Maybe a
Nothing}

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

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

reqTimeout :: Integral i => i -> Middleware
reqTimeout :: forall i. Integral i => i -> Middleware
reqTimeout = Response -> Int -> Middleware
timeoutAs Response
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  where
    err :: Except
err = Except
ServerTimeout
    res :: Response
res = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
sta [(HeaderName, ByteString)
hdr] (forall a. ToJSON a => a -> ByteString
A.encode Except
err)
    sta :: Status
sta = Except -> Status
errStatus Except
err
    hdr :: (HeaderName, ByteString)
hdr = (HeaderName
hContentType, ByteString
"application/json")

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
" [" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"]"
   in ByteString -> Text
T.decodeUtf8 (ByteString
m forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> ByteString
p forall a. Semigroup a => a -> a -> a
<> ByteString
q forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs (forall a. Show a => a -> String
show HttpVersion
v)) forall a. Semigroup a => a -> a -> a
<> Text
txt

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