{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# 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.Base16.Types (assertBase16)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Base16 (decodeBase16, isBase16)
import Data.ByteString.Builder (byteString, 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, getCurrentTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
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.Crypto.Hash (Hash160 (..))
import Haskoin.Crypto.Keys
import Haskoin.Network
import Haskoin.Node
  ( Chain,
    OnlinePeer (..),
    PeerMgr,
    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 qualified as S
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,
    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
maxItemCount :: !Word32,
    WebLimits -> Word32
maxFullItemCount :: !Word32,
    WebLimits -> Word32
maxOffset :: !Word32,
    WebLimits -> Word32
defItemCount :: !Word32,
    WebLimits -> Word32
xpubGap :: !Word32,
    WebLimits -> Word32
xpubGapInit :: !Word32,
    WebLimits -> Word32
maxBodySize :: !Word32,
    WebLimits -> Word32
requestTimeout :: !Word32
  }
  deriving (WebLimits -> WebLimits -> Bool
(WebLimits -> WebLimits -> Bool)
-> (WebLimits -> WebLimits -> Bool) -> Eq WebLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebLimits -> WebLimits -> Bool
== :: WebLimits -> WebLimits -> Bool
$c/= :: WebLimits -> WebLimits -> Bool
/= :: WebLimits -> WebLimits -> Bool
Eq, Int -> WebLimits -> ShowS
[WebLimits] -> ShowS
WebLimits -> String
(Int -> WebLimits -> ShowS)
-> (WebLimits -> String)
-> ([WebLimits] -> ShowS)
-> Show WebLimits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WebLimits -> ShowS
showsPrec :: Int -> WebLimits -> ShowS
$cshow :: WebLimits -> String
show :: WebLimits -> String
$cshowList :: [WebLimits] -> ShowS
showList :: [WebLimits] -> ShowS
Show)

instance Default WebLimits where
  def :: WebLimits
def =
    WebLimits
      { $sel:maxItemCount:WebLimits :: Word32
maxItemCount = Word32
200000,
        $sel:maxFullItemCount:WebLimits :: Word32
maxFullItemCount = Word32
5000,
        $sel:maxOffset:WebLimits :: Word32
maxOffset = Word32
50000,
        $sel:defItemCount:WebLimits :: Word32
defItemCount = Word32
100,
        $sel:xpubGap:WebLimits :: Word32
xpubGap = Word32
32,
        $sel:xpubGapInit:WebLimits :: Word32
xpubGapInit = Word32
20,
        $sel:maxBodySize:WebLimits :: Word32
maxBodySize = Word32
1024 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024,
        $sel:requestTimeout:WebLimits :: Word32
requestTimeout = Word32
0
      }

data WebConfig = WebConfig
  { WebConfig -> String
host :: !String,
    WebConfig -> Int
port :: !Int,
    WebConfig -> Store
store :: !Store,
    WebConfig -> Int
maxLaggingBlocks :: !Int,
    WebConfig -> Int
maxPendingTxs :: !Int,
    WebConfig -> Int
minPeers :: !Int,
    WebConfig -> WebLimits
limits :: !WebLimits,
    WebConfig -> WebTimeouts
timeouts :: !WebTimeouts,
    WebConfig -> String
version :: !String,
    WebConfig -> Bool
noMempool :: !Bool,
    WebConfig -> Maybe Store
statsStore :: !(Maybe Metrics.Store),
    WebConfig -> Int
tickerRefresh :: !Int,
    WebConfig -> String
tickerURL :: !String,
    WebConfig -> String
priceHistoryURL :: !String,
    WebConfig -> Bool
noSlow :: !Bool,
    WebConfig -> Bool
noBlockchainInfo :: !Bool,
    WebConfig -> Int
healthCheckInterval :: !Int
  }

data WebState = WebState
  { WebState -> WebConfig
config :: !WebConfig,
    WebState -> TVar (HashMap Text BinfoTicker)
ticker :: !(TVar (HashMap Text BinfoTicker)),
    WebState -> Maybe WebMetrics
metrics :: !(Maybe WebMetrics),
    WebState -> Session
session :: !Wreq.Session,
    WebState -> TVar HealthCheck
health :: !(TVar HealthCheck)
  }

data WebMetrics = WebMetrics
  { WebMetrics -> StatDist
all :: !StatDist,
    -- Addresses
    WebMetrics -> StatDist
addressTx :: !StatDist,
    WebMetrics -> StatDist
addressTxFull :: !StatDist,
    WebMetrics -> StatDist
addressBalance :: !StatDist,
    WebMetrics -> StatDist
addressUnspent :: !StatDist,
    WebMetrics -> StatDist
xpub :: !StatDist,
    WebMetrics -> StatDist
xpubDelete :: !StatDist,
    WebMetrics -> StatDist
xpubTxFull :: !StatDist,
    WebMetrics -> StatDist
xpubTx :: !StatDist,
    WebMetrics -> StatDist
xpubBalance :: !StatDist,
    WebMetrics -> StatDist
xpubUnspent :: !StatDist,
    -- Transactions
    WebMetrics -> StatDist
tx :: !StatDist,
    WebMetrics -> StatDist
txRaw :: !StatDist,
    WebMetrics -> StatDist
txAfter :: !StatDist,
    WebMetrics -> StatDist
txBlock :: !StatDist,
    WebMetrics -> StatDist
txBlockRaw :: !StatDist,
    WebMetrics -> StatDist
txPost :: !StatDist,
    WebMetrics -> StatDist
mempool :: !StatDist,
    -- Blocks
    WebMetrics -> StatDist
block :: !StatDist,
    WebMetrics -> StatDist
blockRaw :: !StatDist,
    -- Blockchain
    WebMetrics -> StatDist
binfoMultiaddr :: !StatDist,
    WebMetrics -> StatDist
binfoBalance :: !StatDist,
    WebMetrics -> StatDist
binfoAddressRaw :: !StatDist,
    WebMetrics -> StatDist
binfoUnspent :: !StatDist,
    WebMetrics -> StatDist
binfoTxRaw :: !StatDist,
    WebMetrics -> StatDist
binfoBlock :: !StatDist,
    WebMetrics -> StatDist
binfoBlockHeight :: !StatDist,
    WebMetrics -> StatDist
binfoBlockLatest :: !StatDist,
    WebMetrics -> StatDist
binfoBlockRaw :: !StatDist,
    WebMetrics -> StatDist
binfoMempool :: !StatDist,
    WebMetrics -> StatDist
binfoExportHistory :: !StatDist,
    -- Blockchain /q endpoints
    WebMetrics -> StatDist
binfoQaddresstohash :: !StatDist,
    WebMetrics -> StatDist
binfoQhashtoaddress :: !StatDist,
    WebMetrics -> StatDist
binfoQaddrpubkey :: !StatDist,
    WebMetrics -> StatDist
binfoQpubkeyaddr :: !StatDist,
    WebMetrics -> StatDist
binfoQhashpubkey :: !StatDist,
    WebMetrics -> StatDist
binfoQgetblockcount :: !StatDist,
    WebMetrics -> StatDist
binfoQlatesthash :: !StatDist,
    WebMetrics -> StatDist
binfoQbcperblock :: !StatDist,
    WebMetrics -> StatDist
binfoQtxtotalbtcoutput :: !StatDist,
    WebMetrics -> StatDist
binfoQtxtotalbtcinput :: !StatDist,
    WebMetrics -> StatDist
binfoQtxfee :: !StatDist,
    WebMetrics -> StatDist
binfoQtxresult :: !StatDist,
    WebMetrics -> StatDist
binfoQgetreceivedbyaddress :: !StatDist,
    WebMetrics -> StatDist
binfoQgetsentbyaddress :: !StatDist,
    WebMetrics -> StatDist
binfoQaddressbalance :: !StatDist,
    WebMetrics -> StatDist
binfoQaddressfirstseen :: !StatDist,
    -- Others
    WebMetrics -> StatDist
health :: !StatDist,
    WebMetrics -> StatDist
peers :: !StatDist,
    WebMetrics -> StatDist
db :: !StatDist,
    WebMetrics -> Gauge
events :: !Metrics.Gauge.Gauge,
    -- Request
    WebMetrics -> Key (TVar (Maybe (WebMetrics -> StatDist)))
key :: !(V.Key (TVar (Maybe (WebMetrics -> StatDist))))
  }

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

  -- Addresses
  StatDist
addressTx <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"address_transactions"
  StatDist
addressTxFull <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"address_transactions_full"
  StatDist
addressBalance <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"address_balance"
  StatDist
addressUnspent <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"address_unspent"
  StatDist
xpub <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"xpub"
  StatDist
xpubDelete <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"xpub_delete"
  StatDist
xpubTxFull <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"xpub_transactions_full"
  StatDist
xpubTx <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"xpub_transactions"
  StatDist
xpubBalance <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"xpub_balances"
  StatDist
xpubUnspent <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"xpub_unspent"

  -- Transactions
  StatDist
tx <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"transaction"
  StatDist
txRaw <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"transaction_raw"
  StatDist
txAfter <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"transaction_after"
  StatDist
txPost <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"transaction_post"
  StatDist
txBlock <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"transactions_block"
  StatDist
txBlockRaw <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"transactions_block_raw"
  StatDist
mempool <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"mempool"

  -- Blocks
  StatDist
block <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"block"
  StatDist
blockRaw <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"block_raw"

  -- Blockchain
  StatDist
binfoMultiaddr <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_multiaddr"
  StatDist
binfoBalance <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_balance"
  StatDist
binfoAddressRaw <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_rawaddr"
  StatDist
binfoUnspent <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_unspent"
  StatDist
binfoTxRaw <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_rawtx"
  StatDist
binfoBlock <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_blocks"
  StatDist
binfoBlockHeight <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_block_height"
  StatDist
binfoBlockLatest <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_latestblock"
  StatDist
binfoBlockRaw <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_rawblock"
  StatDist
binfoMempool <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_mempool"
  StatDist
binfoExportHistory <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_export_history"

  -- Blockchain /q endpoints
  StatDist
binfoQaddresstohash <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_addresstohash"
  StatDist
binfoQhashtoaddress <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_hashtoaddress"
  StatDist
binfoQaddrpubkey <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockckhain_q_addrpubkey"
  StatDist
binfoQpubkeyaddr <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_pubkeyaddr"
  StatDist
binfoQhashpubkey <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_hashpubkey"
  StatDist
binfoQgetblockcount <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_getblockcount"
  StatDist
binfoQlatesthash <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_latesthash"
  StatDist
binfoQbcperblock <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_bcperblock"
  StatDist
binfoQtxtotalbtcoutput <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txtotalbtcoutput"
  StatDist
binfoQtxtotalbtcinput <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txtotalbtcinput"
  StatDist
binfoQtxfee <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txfee"
  StatDist
binfoQtxresult <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_txresult"
  StatDist
binfoQgetreceivedbyaddress <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_getreceivedbyaddress"
  StatDist
binfoQgetsentbyaddress <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_getsentbyaddress"
  StatDist
binfoQaddressbalance <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_addressbalance"
  StatDist
binfoQaddressfirstseen <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"blockchain_q_addressfirstseen"

  -- Others
  StatDist
health <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"health"
  StatDist
peers <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"peers"
  StatDist
db <- Text -> IO StatDist
forall {m :: * -> *}. MonadIO m => Text -> m StatDist
d Text
"dbstats"

  Gauge
events <- Text -> IO Gauge
g Text
"events_connected"
  Key (TVar (Maybe (WebMetrics -> StatDist)))
key <- IO (Key (TVar (Maybe (WebMetrics -> StatDist))))
forall a. IO (Key a)
V.newKey
  WebMetrics -> IO WebMetrics
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebMetrics {Gauge
Key (TVar (Maybe (WebMetrics -> StatDist)))
StatDist
$sel:all:WebMetrics :: StatDist
$sel:addressTx:WebMetrics :: StatDist
$sel:addressTxFull:WebMetrics :: StatDist
$sel:addressBalance:WebMetrics :: StatDist
$sel:addressUnspent:WebMetrics :: StatDist
$sel:xpub:WebMetrics :: StatDist
$sel:xpubDelete:WebMetrics :: StatDist
$sel:xpubTxFull:WebMetrics :: StatDist
$sel:xpubTx:WebMetrics :: StatDist
$sel:xpubBalance:WebMetrics :: StatDist
$sel:xpubUnspent:WebMetrics :: StatDist
$sel:tx:WebMetrics :: StatDist
$sel:txRaw:WebMetrics :: StatDist
$sel:txAfter:WebMetrics :: StatDist
$sel:txBlock:WebMetrics :: StatDist
$sel:txBlockRaw:WebMetrics :: StatDist
$sel:txPost:WebMetrics :: StatDist
$sel:mempool:WebMetrics :: StatDist
$sel:block:WebMetrics :: StatDist
$sel:blockRaw:WebMetrics :: StatDist
$sel:binfoMultiaddr:WebMetrics :: StatDist
$sel:binfoBalance:WebMetrics :: StatDist
$sel:binfoAddressRaw:WebMetrics :: StatDist
$sel:binfoUnspent:WebMetrics :: StatDist
$sel:binfoTxRaw:WebMetrics :: StatDist
$sel:binfoBlock:WebMetrics :: StatDist
$sel:binfoBlockHeight:WebMetrics :: StatDist
$sel:binfoBlockLatest:WebMetrics :: StatDist
$sel:binfoBlockRaw:WebMetrics :: StatDist
$sel:binfoMempool:WebMetrics :: StatDist
$sel:binfoExportHistory:WebMetrics :: StatDist
$sel:binfoQaddresstohash:WebMetrics :: StatDist
$sel:binfoQhashtoaddress:WebMetrics :: StatDist
$sel:binfoQaddrpubkey:WebMetrics :: StatDist
$sel:binfoQpubkeyaddr:WebMetrics :: StatDist
$sel:binfoQhashpubkey:WebMetrics :: StatDist
$sel:binfoQgetblockcount:WebMetrics :: StatDist
$sel:binfoQlatesthash:WebMetrics :: StatDist
$sel:binfoQbcperblock:WebMetrics :: StatDist
$sel:binfoQtxtotalbtcoutput:WebMetrics :: StatDist
$sel:binfoQtxtotalbtcinput:WebMetrics :: StatDist
$sel:binfoQtxfee:WebMetrics :: StatDist
$sel:binfoQtxresult:WebMetrics :: StatDist
$sel:binfoQgetreceivedbyaddress:WebMetrics :: StatDist
$sel:binfoQgetsentbyaddress:WebMetrics :: StatDist
$sel:binfoQaddressbalance:WebMetrics :: StatDist
$sel:binfoQaddressfirstseen:WebMetrics :: StatDist
$sel:health:WebMetrics :: StatDist
$sel:peers:WebMetrics :: StatDist
$sel:db:WebMetrics :: StatDist
$sel:events:WebMetrics :: Gauge
$sel:key:WebMetrics :: Key (TVar (Maybe (WebMetrics -> StatDist)))
all :: StatDist
addressTx :: StatDist
addressTxFull :: StatDist
addressBalance :: StatDist
addressUnspent :: StatDist
xpub :: StatDist
xpubDelete :: StatDist
xpubTxFull :: StatDist
xpubTx :: StatDist
xpubBalance :: StatDist
xpubUnspent :: StatDist
tx :: StatDist
txRaw :: StatDist
txAfter :: StatDist
txPost :: StatDist
txBlock :: StatDist
txBlockRaw :: StatDist
mempool :: StatDist
block :: StatDist
blockRaw :: StatDist
binfoMultiaddr :: StatDist
binfoBalance :: StatDist
binfoAddressRaw :: StatDist
binfoUnspent :: StatDist
binfoTxRaw :: StatDist
binfoBlock :: StatDist
binfoBlockHeight :: StatDist
binfoBlockLatest :: StatDist
binfoBlockRaw :: StatDist
binfoMempool :: StatDist
binfoExportHistory :: StatDist
binfoQaddresstohash :: StatDist
binfoQhashtoaddress :: StatDist
binfoQaddrpubkey :: StatDist
binfoQpubkeyaddr :: StatDist
binfoQhashpubkey :: StatDist
binfoQgetblockcount :: StatDist
binfoQlatesthash :: StatDist
binfoQbcperblock :: StatDist
binfoQtxtotalbtcoutput :: StatDist
binfoQtxtotalbtcinput :: StatDist
binfoQtxfee :: StatDist
binfoQtxresult :: StatDist
binfoQgetreceivedbyaddress :: StatDist
binfoQgetsentbyaddress :: StatDist
binfoQaddressbalance :: StatDist
binfoQaddressfirstseen :: StatDist
health :: StatDist
peers :: StatDist
db :: StatDist
events :: Gauge
key :: Key (TVar (Maybe (WebMetrics -> StatDist)))
..}
  where
    d :: Text -> m StatDist
d Text
x = Text -> Store -> m StatDist
forall (m :: * -> *). MonadIO m => Text -> Store -> m StatDist
createStatDist (Text
"web." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) Store
s
    g :: Text -> IO Gauge
g Text
x = Text -> Store -> IO Gauge
Metrics.createGauge (Text
"web." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x) Store
s

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

withGaugeIncrease ::
  (MonadUnliftIO m) =>
  (WebMetrics -> Metrics.Gauge) ->
  WebT m a ->
  WebT m a
withGaugeIncrease :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> Gauge) -> WebT m a -> WebT m a
withGaugeIncrease WebMetrics -> Gauge
gf WebT m a
go =
  ReaderT WebState m (Maybe WebMetrics)
-> ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> Maybe WebMetrics)
-> ReaderT WebState m (Maybe WebMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.metrics)) ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> WebT m a) -> WebT m a
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WebMetrics
Nothing -> WebT m a
go
    Just WebMetrics
m -> do
      (Either (ActionError Except) a, ScottyResponse)
s <- (Run (ActionT Except)
 -> ReaderT
      WebState m (Either (ActionError Except) a, ScottyResponse))
-> ActionT
     Except
     (ReaderT WebState m)
     (Either (ActionError Except) a, ScottyResponse)
forall (m :: * -> *) a.
Monad m =>
(Run (ActionT Except) -> m a) -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (ActionT Except)
  -> ReaderT
       WebState m (Either (ActionError Except) a, ScottyResponse))
 -> ActionT
      Except
      (ReaderT WebState m)
      (Either (ActionError Except) a, ScottyResponse))
-> (Run (ActionT Except)
    -> ReaderT
         WebState m (Either (ActionError Except) a, ScottyResponse))
-> ActionT
     Except
     (ReaderT WebState m)
     (Either (ActionError Except) a, ScottyResponse)
forall a b. (a -> b) -> a -> b
$ \Run (ActionT Except)
run -> Gauge
-> ReaderT
     WebState m (Either (ActionError Except) a, ScottyResponse)
-> ReaderT
     WebState m (Either (ActionError Except) a, ScottyResponse)
forall (m :: * -> *) a. MonadUnliftIO m => Gauge -> m a -> m a
withGaugeIO (WebMetrics -> Gauge
gf WebMetrics
m) (WebT m a -> ReaderT WebState m (StT (ActionT Except) a)
Run (ActionT Except)
run WebT m a
go)
      ReaderT WebState m (StT (ActionT Except) a) -> WebT m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ActionT Except) a) -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (ReaderT WebState m (StT (ActionT Except) a) -> WebT m a)
-> ReaderT WebState m (StT (ActionT Except) a) -> WebT m a
forall a b. (a -> b) -> a -> b
$ (Either (ActionError Except) a, ScottyResponse)
-> ReaderT
     WebState m (Either (ActionError Except) a, ScottyResponse)
forall a. a -> ReaderT WebState m a
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 =
  (WebState -> Maybe WebMetrics)
-> ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.metrics) ActionT Except (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> ActionT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WebMetrics -> ActionT Except (ReaderT WebState m) ())
-> Maybe WebMetrics -> ActionT Except (ReaderT WebState m) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ WebMetrics -> ActionT Except (ReaderT WebState m) ()
forall {m :: * -> *} {e} {p}.
(ScottyError e, MonadIO m,
 HasField "key" p (Key (TVar (Maybe (WebMetrics -> StatDist))))) =>
p -> ActionT e m ()
go
  where
    go :: p -> ActionT e m ()
go p
m = do
      Request
req <- ActionT e m Request
forall (m :: * -> *) e. Monad m => ActionT e m Request
S.request
      let t :: TVar (Maybe (WebMetrics -> StatDist))
t = TVar (Maybe (WebMetrics -> StatDist))
-> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
-> TVar (Maybe (WebMetrics -> StatDist))
forall a. a -> Maybe a -> a
fromMaybe TVar (Maybe (WebMetrics -> StatDist))
forall {a}. a
e (Maybe (TVar (Maybe (WebMetrics -> StatDist)))
 -> TVar (Maybe (WebMetrics -> StatDist)))
-> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
-> TVar (Maybe (WebMetrics -> StatDist))
forall a b. (a -> b) -> a -> b
$ Key (TVar (Maybe (WebMetrics -> StatDist)))
-> Vault -> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
forall a. Key a -> Vault -> Maybe a
V.lookup p
m.key (Request -> Vault
vault Request
req)
      STM () -> ActionT e m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ActionT e m ()) -> STM () -> ActionT e m ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (WebMetrics -> StatDist))
-> Maybe (WebMetrics -> StatDist) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (WebMetrics -> StatDist))
t ((WebMetrics -> StatDist) -> Maybe (WebMetrics -> StatDist)
forall a. a -> Maybe a
Just WebMetrics -> StatDist
df)
    e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"the ways of the warrior are yet to be mastered"

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

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

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

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

instance Default WebTimeouts where
  def :: WebTimeouts
def = WebTimeouts {$sel:tx:WebTimeouts :: Word64
tx = Word64
3600 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2, $sel:block:WebTimeouts :: Word64
block = Word64
4 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
3600}

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

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

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

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

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

runWeb :: (MonadUnliftIO m, MonadLoggerIO m) => WebConfig -> m ()
runWeb :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebConfig -> m ()
runWeb WebConfig
config = do
  TVar (HashMap Text BinfoTicker)
ticker <- HashMap Text BinfoTicker -> m (TVar (HashMap Text BinfoTicker))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO HashMap Text BinfoTicker
forall k v. HashMap k v
HashMap.empty
  Maybe WebMetrics
metrics <- (Store -> m WebMetrics) -> Maybe Store -> m (Maybe WebMetrics)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM Store -> m WebMetrics
forall (m :: * -> *). MonadIO m => Store -> m WebMetrics
createMetrics WebConfig
config.statsStore
  Session
session <- IO Session -> m Session
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Session
Wreq.Session.newAPISession
  TVar HealthCheck
health <- m HealthCheck
runHealthCheck m HealthCheck
-> (HealthCheck -> m (TVar HealthCheck)) -> m (TVar HealthCheck)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HealthCheck -> m (TVar HealthCheck)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO
  let state :: WebState
state = WebState {Maybe WebMetrics
TVar (HashMap Text BinfoTicker)
TVar HealthCheck
Session
WebConfig
$sel:config:WebState :: WebConfig
$sel:ticker:WebState :: TVar (HashMap Text BinfoTicker)
$sel:metrics:WebState :: Maybe WebMetrics
$sel:session:WebState :: Session
$sel:health:WebState :: TVar HealthCheck
config :: WebConfig
ticker :: TVar (HashMap Text BinfoTicker)
metrics :: Maybe WebMetrics
session :: Session
health :: TVar HealthCheck
..}
  m () -> (Async () -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (Session -> TVar (HashMap Text BinfoTicker) -> m ()
forall {f :: * -> *}.
(MonadLoggerIO f, MonadUnliftIO f) =>
Session -> TVar (HashMap Text BinfoTicker) -> f ()
priceUpdater Session
session TVar (HashMap Text BinfoTicker)
ticker) ((Async () -> m ()) -> m ()) -> (Async () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Async ()
_a1 ->
    m Any -> (Async Any -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (TVar HealthCheck -> m Any
forall {b}. TVar HealthCheck -> m b
healthCheckLoop TVar HealthCheck
health) ((Async Any -> m ()) -> m ()) -> (Async Any -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Async Any
_a2 -> do
      Middleware
logger <- Maybe WebMetrics -> m Middleware
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Maybe WebMetrics -> m Middleware
logIt Maybe WebMetrics
metrics
      m Response -> IO Response
runner <- m (m Response -> IO Response)
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
      Options
-> (ReaderT WebState m Response -> IO Response)
-> ScottyT Except (ReaderT WebState m) ()
-> m ()
forall (m :: * -> *) (n :: * -> *) e.
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT e m () -> n ()
S.scottyOptsT Options
opts (m Response -> IO Response
runner (m Response -> IO Response)
-> (ReaderT WebState m Response -> m Response)
-> ReaderT WebState m Response
-> IO Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT WebState m Response -> WebState -> m Response)
-> WebState -> ReaderT WebState m Response -> m Response
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT WebState m Response -> WebState -> m Response
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WebState
state) (ScottyT Except (ReaderT WebState m) () -> m ())
-> ScottyT Except (ReaderT WebState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Middleware -> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (Middleware -> ScottyT Except (ReaderT WebState m) ())
-> Middleware -> ScottyT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ WebState -> Middleware
webSocketEvents WebState
state
        Middleware -> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware Middleware
logger
        Middleware -> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (Middleware -> ScottyT Except (ReaderT WebState m) ())
-> Middleware -> ScottyT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Middleware
forall i. Integral i => i -> Middleware
reqSizeLimit WebConfig
config.limits.maxBodySize
        ScottyT Except (ReaderT WebState m) ()
forall {e} {m :: * -> *}. ScottyT e m ()
timeoutMiddleware
        (Except -> ActionT Except (ReaderT WebState m) ())
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
(e -> ActionT e m ()) -> ScottyT e m ()
S.defaultHandler Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Except -> WebT m ()
defHandler
        WebConfig -> ScottyT Except (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebConfig -> ScottyT Except (ReaderT WebState m) ()
handlePaths WebConfig
config
        ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m () -> ScottyT e m ()
S.notFound (ActionT Except (ReaderT WebState m) ()
 -> ScottyT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
  where
    priceUpdater :: Session -> TVar (HashMap Text BinfoTicker) -> f ()
priceUpdater Session
session =
      Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WebConfig
config.noSlow Bool -> Bool -> Bool
|| WebConfig
config.noBlockchainInfo)
        (f () -> f ())
-> (TVar (HashMap Text BinfoTicker) -> f ())
-> TVar (HashMap Text BinfoTicker)
-> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network
-> Session
-> String
-> Int
-> TVar (HashMap Text BinfoTicker)
-> f ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network
-> Session
-> String
-> Int
-> TVar (HashMap Text BinfoTicker)
-> m ()
price
          WebConfig
config.store.net
          Session
session
          WebConfig
config.tickerURL
          WebConfig
config.tickerRefresh
    timeoutMiddleware :: ScottyT e m ()
timeoutMiddleware =
      Bool -> ScottyT e m () -> ScottyT e m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WebConfig
config.limits.requestTimeout Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0) (ScottyT e m () -> ScottyT e m ())
-> ScottyT e m () -> ScottyT e m ()
forall a b. (a -> b) -> a -> b
$
        Middleware -> ScottyT e m ()
forall e (m :: * -> *). Middleware -> ScottyT e m ()
S.middleware (Middleware -> ScottyT e m ()) -> Middleware -> ScottyT e m ()
forall a b. (a -> b) -> a -> b
$
          Word32 -> Middleware
forall i. Integral i => i -> Middleware
reqTimeout WebConfig
config.limits.requestTimeout
    runHealthCheck :: m HealthCheck
runHealthCheck = ReaderT DatabaseReader m HealthCheck
-> DatabaseReader -> m HealthCheck
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WebConfig -> ReaderT DatabaseReader m HealthCheck
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m HealthCheck
healthCheck WebConfig
config) WebConfig
config.store.db
    healthCheckLoop :: TVar HealthCheck -> m b
healthCheckLoop TVar HealthCheck
v = m () -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m b) -> m () -> m b
forall a b. (a -> b) -> a -> b
$ do
      Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (WebConfig
config.healthCheckInterval Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
      m HealthCheck
runHealthCheck m HealthCheck -> (HealthCheck -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> (HealthCheck -> STM ()) -> HealthCheck -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar HealthCheck -> HealthCheck -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar HealthCheck
v
    opts :: Options
opts = Options
forall a. Default a => a
def {settings :: Settings
S.settings = Settings -> Settings
settings Settings
defaultSettings}
    settings :: Settings -> Settings
settings = Int -> Settings -> Settings
setPort WebConfig
config.port (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostPreference -> Settings -> Settings
setHost (String -> HostPreference
forall a. IsString a => String -> a
fromString WebConfig
config.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
  (SomeException -> m [BinfoRate]) -> m [BinfoRate] -> m [BinfoRate]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny SomeException -> m [BinfoRate]
forall {m :: * -> *} {p} {a}. MonadLogger m => p -> m [a]
err (m [BinfoRate] -> m [BinfoRate]) -> m [BinfoRate] -> m [BinfoRate]
forall a b. (a -> b) -> a -> b
$ do
    Response [BinfoRate]
r <-
      IO (Response [BinfoRate]) -> m (Response [BinfoRate])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response [BinfoRate]) -> m (Response [BinfoRate]))
-> IO (Response [BinfoRate]) -> m (Response [BinfoRate])
forall a b. (a -> b) -> a -> b
$
        Response ByteString -> IO (Response [BinfoRate])
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Response ByteString -> m (Response a)
Wreq.asJSON
          (Response ByteString -> IO (Response [BinfoRate]))
-> IO (Response ByteString) -> IO (Response [BinfoRate])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> Session -> String -> Value -> IO (Response ByteString)
forall a.
Postable a =>
Options -> Session -> String -> a -> IO (Response ByteString)
Wreq.Session.postWith Options
opts Session
session String
url Value
body
    [BinfoRate] -> m [BinfoRate]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BinfoRate] -> m [BinfoRate]) -> [BinfoRate] -> m [BinfoRate]
forall a b. (a -> b) -> a -> b
$ Response [BinfoRate]
r Response [BinfoRate]
-> Getting [BinfoRate] (Response [BinfoRate]) [BinfoRate]
-> [BinfoRate]
forall s a. s -> Getting a s a -> a
^. Getting [BinfoRate] (Response [BinfoRate]) [BinfoRate]
forall body0 body1 (f :: * -> *).
Functor f =>
(body0 -> f body1) -> Response body0 -> f (Response body1)
Wreq.responseBody
  where
    err :: p -> m [a]
err p
_ = do
      $(logErrorS) Text
"Web" Text
"Could not get historic prices"
      [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    body :: Value
body = [Word64] -> Value
forall a. ToJSON a => a -> Value
toJSON [Word64]
times
    base :: Options
base =
      Options
Wreq.defaults
        Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
Wreq.param Text
"base" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack Network
net.name]
    opts :: Options
opts = Options
base Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& Text -> Lens' Options [Text]
Wreq.param Text
"quote" (([Text] -> Identity [Text]) -> Options -> Identity Options)
-> [Text] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text
currency]

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

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

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

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

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

pathCompact ::
  (ApiResource a b, MonadIO m) =>
  WebT m a ->
  (a -> WebT m b) ->
  (b -> Encoding) ->
  (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)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT Except (ReaderT WebState m) ()
pathCompact WebT m a
parser a -> WebT m b
action b -> Encoding
encJson b -> Value
encValue =
  WebT m a
-> (a -> WebT m b)
-> (b -> Encoding)
-> (b -> Value)
-> Bool
-> ScottyT Except (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadIO m) =>
WebT m a
-> (a -> WebT m b)
-> (b -> Encoding)
-> (b -> Value)
-> Bool
-> ScottyT Except (ReaderT WebState m) ()
pathCommon WebT m a
parser a -> WebT m b
action b -> Encoding
encJson b -> Value
encValue Bool
False

pathCommon ::
  (ApiResource a b, MonadIO m) =>
  WebT m a ->
  (a -> WebT m b) ->
  (b -> Encoding) ->
  (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)
-> (b -> Encoding)
-> (b -> Value)
-> Bool
-> ScottyT Except (ReaderT WebState m) ()
pathCommon WebT m a
parser a -> WebT m b
action b -> Encoding
encJson b -> Value
encValue Bool
pretty =
  StdMethod
-> RoutePattern
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
StdMethod -> RoutePattern -> ActionT e m () -> ScottyT e m ()
S.addroute (Proxy a -> StdMethod
forall a b. ApiResource a b => Proxy a -> StdMethod
resourceMethod Proxy a
proxy) (Proxy a -> RoutePattern
forall a b. ApiResource a b => Proxy a -> RoutePattern
capturePath Proxy a
proxy) (ActionT Except (ReaderT WebState m) ()
 -> ScottyT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ScottyT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ do
    ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
    SerialAs
proto <- Bool -> ActionT Except (ReaderT WebState m) SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupContentType Bool
pretty
    a
apiRes <- WebT m a
parser
    b
res <- a -> WebT m b
action a
apiRes
    ByteString -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. Monad m => ByteString -> ActionT e m ()
S.raw (ByteString -> ActionT Except (ReaderT WebState m) ())
-> ByteString -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ SerialAs -> (b -> Encoding) -> (b -> Value) -> b -> ByteString
forall a.
Serial a =>
SerialAs -> (a -> Encoding) -> (a -> Value) -> a -> ByteString
protoSerial SerialAs
proto b -> Encoding
encJson b -> Value
encValue b
res
  where
    toProxy :: WebT m a -> Proxy a
    toProxy :: forall (m :: * -> *) a. WebT m a -> Proxy a
toProxy = Proxy a -> WebT m a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy
    proxy :: Proxy a
proxy = WebT m a -> Proxy a
forall (m :: * -> *) a. WebT m a -> Proxy a
toProxy WebT m a
parser

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

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

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

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

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

setupBinary :: (Monad m) => ActionT Except m SerialAs
setupBinary :: forall (m :: * -> *). Monad m => ActionT Except m SerialAs
setupBinary = do
  Text -> Text -> ActionT Except m ()
forall (m :: * -> *) e. Monad m => Text -> Text -> ActionT e m ()
S.setHeader Text
"Content-Type" Text
"application/octet-stream"
  SerialAs -> ActionT Except m SerialAs
forall a. a -> ActionT Except m a
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 <- Text -> ActionT Except m (Maybe Text)
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m (Maybe Text)
S.header Text
"accept"
  ActionT Except m SerialAs
-> (Text -> ActionT Except m SerialAs)
-> Maybe Text
-> ActionT Except m SerialAs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> ActionT Except m SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupJSON Bool
pretty) Text -> ActionT Except m SerialAs
forall {a} {m :: * -> *}.
(Eq a, IsString a, Monad m) =>
a -> ActionT Except m SerialAs
setType Maybe Text
accept
  where
    setType :: a -> ActionT Except m SerialAs
setType a
"application/octet-stream" = ActionT Except m SerialAs
forall (m :: * -> *). Monad m => ActionT Except m SerialAs
setupBinary
    setType a
_ = Bool -> ActionT Except m SerialAs
forall (m :: * -> *). Monad m => Bool -> ActionT Except m SerialAs
setupJSON Bool
pretty

-- GET Block / GET Blocks --

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

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

scottyBlocks ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetBlocks -> WebT m [BlockData]
scottyBlocks :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlocks -> WebT m [BlockData]
scottyBlocks (GetBlocks [BlockHash]
hs (NoTx Bool
notx)) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.block)
  [BlockData]
bs <- [BlockHash] -> Bool -> WebT m [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
hs Bool
notx
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
bs)
  [BlockData] -> WebT m [BlockData]
forall a. a -> ActionT Except (ReaderT WebState m) a
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 {Bool
Integer
[TxHash]
Word32
Word64
BlockHeader
height :: Word32
main :: Bool
work :: Integer
header :: BlockHeader
size :: Word32
weight :: Word32
txs :: [TxHash]
outputs :: Word64
fee :: Word64
subsidy :: Word64
$sel:height:BlockData :: BlockData -> Word32
$sel:main:BlockData :: BlockData -> Bool
$sel:work:BlockData :: BlockData -> Integer
$sel:header:BlockData :: BlockData -> BlockHeader
$sel:size:BlockData :: BlockData -> Word32
$sel:weight:BlockData :: BlockData -> Word32
$sel:txs:BlockData :: BlockData -> [TxHash]
$sel:outputs:BlockData :: BlockData -> Word64
$sel:fee:BlockData :: BlockData -> Word64
$sel:subsidy:BlockData :: BlockData -> Word64
..} = BlockData {$sel:txs:BlockData :: [TxHash]
txs = Int -> [TxHash] -> [TxHash]
forall a. Int -> [a] -> [a]
take Int
1 [TxHash]
txs, Bool
Integer
Word32
Word64
BlockHeader
height :: Word32
main :: Bool
work :: Integer
header :: BlockHeader
size :: Word32
weight :: Word32
outputs :: Word64
fee :: Word64
subsidy :: Word64
$sel:height:BlockData :: Word32
$sel:main:BlockData :: Bool
$sel:work:BlockData :: Integer
$sel:header:BlockData :: BlockHeader
$sel:size:BlockData :: Word32
$sel:weight:BlockData :: Word32
$sel:outputs:BlockData :: Word64
$sel:fee:BlockData :: Word64
$sel:subsidy:BlockData :: Word64
..}

-- 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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.blockRaw)
  Block
b <- BlockHash -> WebT m Block
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock BlockHash
h
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Block
b.txs)
  RawResult Block -> WebT m (RawResult Block)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> WebT m (RawResult Block))
-> RawResult Block -> WebT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ Block -> RawResult Block
forall a. a -> RawResult a
RawResult Block
b

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

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

-- GET BlockBest / BlockBestRaw --

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

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

-- GET BlockLatest --

scottyBlockLatest ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetBlockLatest ->
  WebT m [BlockData]
scottyBlockLatest :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockLatest -> WebT m [BlockData]
scottyBlockLatest (GetBlockLatest (NoTx Bool
noTx)) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.block)
  [BlockData]
blocks <-
    ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
      ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash -> WebT m [BlockData]) -> WebT m [BlockData]
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WebT m [BlockData]
-> (BlockHash -> WebT m [BlockData])
-> Maybe BlockHash
-> WebT m [BlockData]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Except -> WebT m [BlockData]
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound)
        ([BlockData] -> Maybe BlockData -> WebT m [BlockData]
forall {m :: * -> *}.
StoreReadBase m =>
[BlockData] -> Maybe BlockData -> m [BlockData]
go [] (Maybe BlockData -> WebT m [BlockData])
-> (BlockHash
    -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> BlockHash
-> WebT m [BlockData]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
  [BlockData] -> WebT m [BlockData]
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [BlockData]
blocks
  where
    go :: [BlockData] -> Maybe BlockData -> m [BlockData]
go [BlockData]
acc Maybe BlockData
Nothing = [BlockData] -> m [BlockData]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockData] -> m [BlockData]) -> [BlockData] -> m [BlockData]
forall a b. (a -> b) -> a -> b
$ [BlockData] -> [BlockData]
forall a. [a] -> [a]
reverse [BlockData]
acc
    go [BlockData]
acc (Just BlockData
b)
      | BlockData
b.height Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0 = [BlockData] -> m [BlockData]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockData] -> m [BlockData]) -> [BlockData] -> m [BlockData]
forall a b. (a -> b) -> a -> b
$ [BlockData] -> [BlockData]
forall a. [a] -> [a]
reverse [BlockData]
acc
      | [BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
acc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
99 = [BlockData] -> m [BlockData]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlockData] -> m [BlockData])
-> ([BlockData] -> [BlockData]) -> [BlockData] -> m [BlockData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockData] -> [BlockData]
forall a. [a] -> [a]
reverse ([BlockData] -> m [BlockData]) -> [BlockData] -> m [BlockData]
forall a b. (a -> b) -> a -> b
$ Bool -> BlockData -> BlockData
pruneTx Bool
noTx BlockData
b BlockData -> [BlockData] -> [BlockData]
forall a. a -> [a] -> [a]
: [BlockData]
acc
      | Bool
otherwise = [BlockData] -> Maybe BlockData -> m [BlockData]
go (Bool -> BlockData -> BlockData
pruneTx Bool
noTx BlockData
b BlockData -> [BlockData] -> [BlockData]
forall a. a -> [a] -> [a]
: [BlockData]
acc) (Maybe BlockData -> m [BlockData])
-> m (Maybe BlockData) -> m [BlockData]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockData
b.header.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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.block)
  [BlockData]
blocks <- ([BlockHash] -> Bool -> WebT m [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
`getBlocks` Bool
notx) ([BlockHash] -> WebT m [BlockData])
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> WebT m [BlockData]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (HeightParam -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
h)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
  [BlockData] -> WebT m [BlockData]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.block)
  [BlockHash]
bhs <- [[BlockHash]] -> [BlockHash]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BlockHash]] -> [BlockHash])
-> ActionT Except (ReaderT WebState m) [[BlockHash]]
-> ActionT Except (ReaderT WebState m) [BlockHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> ActionT Except (ReaderT WebState m) [BlockHash])
-> [Word32] -> ActionT Except (ReaderT WebState m) [[BlockHash]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32) -> [Natural] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Natural]
heights)
  [BlockData]
blocks <- [BlockHash] -> Bool -> WebT m [BlockData]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
[BlockHash] -> Bool -> WebT m [BlockData]
getBlocks [BlockHash]
bhs Bool
notx
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks)
  [BlockData] -> WebT m [BlockData]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.blockRaw)
  [Block]
blocks <- (BlockHash -> ActionT Except (ReaderT WebState m) Block)
-> [BlockHash] -> ActionT Except (ReaderT WebState m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BlockHash -> ActionT Except (ReaderT WebState m) Block
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m Block
getRawBlock ([BlockHash] -> ActionT Except (ReaderT WebState m) [Block])
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> ActionT Except (ReaderT WebState m) [Block]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (HeightParam -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral HeightParam
h)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Block] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
blocks Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Block -> Int) -> [Block] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Tx] -> Int) -> (Block -> [Tx]) -> Block -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txs)) [Block]
blocks))
  RawResultList Block -> WebT m (RawResultList Block)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResultList Block -> WebT m (RawResultList Block))
-> RawResultList Block -> WebT m (RawResultList Block)
forall a b. (a -> b) -> a -> b
$ [Block] -> RawResultList Block
forall a. [a] -> RawResultList a
RawResultList [Block]
blocks

-- GET BlockTime / BlockTimeRaw --

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

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

scottyBlockTimeRaw ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetBlockTimeRaw ->
  WebT m (RawResult H.Block)
scottyBlockTimeRaw :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTimeRaw -> WebT m (RawResult Block)
scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam Word64
t)) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.blockRaw)
  Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.chain)
  Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> WebT m (RawResult Block))
-> WebT m (RawResult Block)
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing -> Except -> WebT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockData
b -> do
      Block
raw <- ReaderT WebState m Block
-> ActionT Except (ReaderT WebState m) Block
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Block
 -> ActionT Except (ReaderT WebState m) Block)
-> ReaderT WebState m Block
-> ActionT Except (ReaderT WebState m) Block
forall a b. (a -> b) -> a -> b
$ BlockData -> ReaderT WebState m Block
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
BlockData -> m Block
toRawBlock BlockData
b
      Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Block
raw.txs)
      RawResult Block -> WebT m (RawResult Block)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> WebT m (RawResult Block))
-> RawResult Block -> WebT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ Block -> RawResult Block
forall a. a -> RawResult a
RawResult Block
raw

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

-- GET Transactions --

scottyTx :: (MonadUnliftIO m, MonadLoggerIO m) => GetTx -> WebT m Transaction
scottyTx :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetTx -> WebT m Transaction
scottyTx (GetTx TxHash
txid) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.tx)
  TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
txid ActionT Except (ReaderT WebState m) (Maybe Transaction)
-> (Maybe Transaction -> WebT m Transaction) -> WebT m Transaction
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Transaction
Nothing -> Except -> WebT m Transaction
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just Transaction
tx -> do
      Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
      Transaction -> WebT m Transaction
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.tx)
  [Transaction]
txs <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxHash]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, MonadUnliftIO m, StoreReadBase m) =>
TxHash -> t m (Maybe Transaction)
f ([TxHash] -> [TxHash]
forall a. Eq a => [a] -> [a]
nub [TxHash]
txids)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
  [Transaction] -> WebT m [Transaction]
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
txs
  where
    f :: TxHash -> t m (Maybe Transaction)
f TxHash
x = m (Maybe Transaction) -> t m (Maybe Transaction)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Transaction) -> t m (Maybe Transaction))
-> m (Maybe Transaction) -> t m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$
      ((forall a. m a -> IO a) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (Maybe Transaction))
 -> m (Maybe Transaction))
-> ((forall a. m a -> IO a) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        IO (Maybe Transaction) -> IO (Maybe Transaction)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe Transaction) -> IO (Maybe Transaction))
-> (m (Maybe Transaction) -> IO (Maybe Transaction))
-> m (Maybe Transaction)
-> IO (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Transaction) -> IO (Maybe Transaction)
forall a. m a -> IO a
run (m (Maybe Transaction) -> IO (Maybe Transaction))
-> m (Maybe Transaction) -> IO (Maybe Transaction)
forall a b. (a -> b) -> a -> b
$
          TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x

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

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

getTxsBlock ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  H.BlockHash ->
  WebT m [Transaction]
getTxsBlock :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m [Transaction]
getTxsBlock BlockHash
h =
  BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData
    -> ActionT Except (ReaderT WebState m) [Transaction])
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just BlockData
b -> do
      [Transaction]
txs <- (TxHash -> ActionT Except (ReaderT WebState m) Transaction)
-> [TxHash] -> ActionT Except (ReaderT WebState m) [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxHash -> ActionT Except (ReaderT WebState m) Transaction
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, MonadUnliftIO m, StoreReadBase m) =>
TxHash -> t m Transaction
f BlockData
b.txs
      Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
      [Transaction] -> ActionT Except (ReaderT WebState m) [Transaction]
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Transaction]
txs
  where
    f :: TxHash -> t m Transaction
f TxHash
x = m Transaction -> t m Transaction
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Transaction -> t m Transaction)
-> m Transaction -> t m Transaction
forall a b. (a -> b) -> a -> b
$
      ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Transaction) -> m Transaction)
-> ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        IO Transaction -> IO Transaction
forall a. IO a -> IO a
unsafeInterleaveIO (IO Transaction -> IO Transaction)
-> (m Transaction -> IO Transaction)
-> m Transaction
-> IO Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Transaction -> IO Transaction
forall a. m a -> IO a
run (m Transaction -> IO Transaction)
-> m Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
          TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
x m (Maybe Transaction)
-> (Maybe Transaction -> m Transaction) -> m Transaction
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Transaction
Nothing -> m Transaction
forall a. HasCallStack => a
undefined
            Just Transaction
t -> Transaction -> m Transaction
forall a. a -> m a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.txBlock)
  [Transaction]
txs <- BlockHash -> WebT m [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m [Transaction]
getTxsBlock BlockHash
h
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
  [Transaction] -> WebT m [Transaction]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.txBlockRaw)
  [Tx]
txs <- (Transaction -> Tx) -> [Transaction] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transaction -> Tx
transactionData ([Transaction] -> [Tx])
-> ActionT Except (ReaderT WebState m) [Transaction]
-> ActionT Except (ReaderT WebState m) [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockHash -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
BlockHash -> WebT m [Transaction]
getTxsBlock BlockHash
h
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs)
  RawResultList Tx -> WebT m (RawResultList Tx)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResultList Tx -> WebT m (RawResultList Tx))
-> RawResultList Tx -> WebT m (RawResultList Tx)
forall a b. (a -> b) -> a -> b
$ [Tx] -> RawResultList Tx
forall a. [a] -> RawResultList a
RawResultList [Tx]
txs

-- GET TransactionAfterHeight --

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

-- | Check if any of the ancestors of this transaction is a coinbase after the
-- specified height. Returns 'Nothing' if answer cannot be computed before
-- hitting limits.
cbAfterHeight ::
  (MonadIO m, StoreReadBase m) =>
  H.BlockHeight ->
  TxHash ->
  m (Maybe Bool, Int)
cbAfterHeight :: forall (m :: * -> *).
(MonadIO m, StoreReadBase m) =>
Word32 -> TxHash -> m (Maybe Bool, Int)
cbAfterHeight Word32
height TxHash
txid =
  Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
forall {m :: * -> *}.
StoreReadBase m =>
Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
n HashSet TxHash
forall a. HashSet a
HashSet.empty HashSet TxHash
forall a. HashSet a
HashSet.empty [TxHash
txid]
  where
    n :: Int
n = Int
10000
    inputs :: Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
0 HashSet TxHash
_ HashSet TxHash
_ [] = (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool
forall a. Maybe a
Nothing, Int
10000)
    inputs Int
i HashSet TxHash
is HashSet TxHash
ns [] =
      let is' :: HashSet TxHash
is' = HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union HashSet TxHash
is HashSet TxHash
ns
          ns' :: HashSet a
ns' = HashSet a
forall a. HashSet a
HashSet.empty
          ts :: [TxHash]
ts = HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList (HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.difference HashSet TxHash
ns HashSet TxHash
is)
       in case [TxHash]
ts of
            [] -> (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
            [TxHash]
_ -> Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs Int
i HashSet TxHash
is' HashSet TxHash
forall a. HashSet a
ns' [TxHash]
ts
    inputs Int
i HashSet TxHash
is HashSet TxHash
ns (TxHash
t : [TxHash]
ts) =
      TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
t m (Maybe Transaction)
-> (Maybe Transaction -> m (Maybe Bool, Int))
-> m (Maybe Bool, Int)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Transaction
Nothing -> (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool
forall a. Maybe a
Nothing, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
        Just Transaction
tx
          | Transaction -> Bool
forall {r}. HasField "block" r BlockRef => r -> Bool
height_check Transaction
tx ->
              if Transaction -> Bool
cb_check Transaction
tx
                then (Maybe Bool, Int) -> m (Maybe Bool, Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                else
                  let ns' :: HashSet TxHash
ns' = HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union (Transaction -> HashSet TxHash
ins Transaction
tx) HashSet TxHash
ns
                   in Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) HashSet TxHash
is HashSet TxHash
ns' [TxHash]
ts
          | Bool
otherwise -> Int
-> HashSet TxHash
-> HashSet TxHash
-> [TxHash]
-> m (Maybe Bool, Int)
inputs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) HashSet TxHash
is HashSet TxHash
ns [TxHash]
ts
    cb_check :: Transaction -> Bool
cb_check = (StoreInput -> Bool) -> [StoreInput] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StoreInput -> Bool
isCoinbase ([StoreInput] -> Bool)
-> (Transaction -> [StoreInput]) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.inputs)
    ins :: Transaction -> HashSet TxHash
ins = [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> (Transaction -> [TxHash]) -> Transaction -> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreInput -> TxHash) -> [StoreInput] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (.outpoint.hash) ([StoreInput] -> [TxHash])
-> (Transaction -> [StoreInput]) -> Transaction -> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.inputs)
    height_check :: r -> Bool
height_check r
tx =
      case r
tx.block of
        BlockRef Word32
h Word32
_ -> Word32
h Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
height
        MemRef Word64
_ -> 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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.txPost)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  ReaderT WebState m WebConfig
-> ActionT Except (ReaderT WebState m) WebConfig
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((WebState -> WebConfig) -> ReaderT WebState m WebConfig
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config)) ActionT Except (ReaderT WebState m) WebConfig
-> (WebConfig -> WebT m TxId) -> WebT m TxId
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WebConfig
cfg ->
    ReaderT WebState m (Either PubExcept ())
-> ActionT Except (ReaderT WebState m) (Either PubExcept ())
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WebConfig -> Tx -> ReaderT WebState m (Either PubExcept ())
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> Tx -> m (Either PubExcept ())
publishTx WebConfig
cfg Tx
tx) ActionT Except (ReaderT WebState m) (Either PubExcept ())
-> (Either PubExcept () -> WebT m TxId) -> WebT m TxId
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right () -> TxId -> WebT m TxId
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxHash -> TxId
TxId (Tx -> TxHash
txHash Tx
tx))
      Left e :: PubExcept
e@(PubReject RejectCode
_) -> Except -> WebT m TxId
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> WebT m TxId) -> Except -> WebT m TxId
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError (PubExcept -> String
forall a. Show a => a -> String
show PubExcept
e)
      Either PubExcept ()
_ -> Except -> WebT m TxId
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ServerError

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

-- GET Mempool / Events --

scottyMempool ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetMempool -> WebT m [TxHash]
scottyMempool :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetMempool -> WebT m [TxHash]
scottyMempool (GetMempool Maybe LimitParam
limitM (OffsetParam Natural
o)) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.mempool)
  WebLimits {Word32
$sel:maxItemCount:WebLimits :: WebLimits -> Word32
$sel:maxFullItemCount:WebLimits :: WebLimits -> Word32
$sel:maxOffset:WebLimits :: WebLimits -> Word32
$sel:defItemCount:WebLimits :: WebLimits -> Word32
$sel:xpubGap:WebLimits :: WebLimits -> Word32
$sel:xpubGapInit:WebLimits :: WebLimits -> Word32
$sel:maxBodySize:WebLimits :: WebLimits -> Word32
$sel:requestTimeout:WebLimits :: WebLimits -> Word32
maxItemCount :: Word32
maxFullItemCount :: Word32
maxOffset :: Word32
defItemCount :: Word32
xpubGap :: Word32
xpubGapInit :: Word32
maxBodySize :: Word32
requestTimeout :: Word32
..} <- ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m WebLimits
 -> ActionT Except (ReaderT WebState m) WebLimits)
-> ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall a b. (a -> b) -> a -> b
$ (WebState -> WebLimits) -> ReaderT WebState m WebLimits
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.limits)
  let wl' :: WebLimits
wl' = WebLimits {$sel:maxItemCount:WebLimits :: Word32
maxItemCount = Word32
0, Word32
$sel:maxFullItemCount:WebLimits :: Word32
$sel:maxOffset:WebLimits :: Word32
$sel:defItemCount:WebLimits :: Word32
$sel:xpubGap:WebLimits :: Word32
$sel:xpubGapInit:WebLimits :: Word32
$sel:maxBodySize:WebLimits :: Word32
$sel:requestTimeout:WebLimits :: Word32
maxFullItemCount :: Word32
maxOffset :: Word32
defItemCount :: Word32
xpubGap :: Word32
xpubGapInit :: Word32
maxBodySize :: Word32
requestTimeout :: Word32
..}
      l :: Limits
l = Word32 -> Word32 -> Maybe Start -> Limits
Limits (WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit WebLimits
wl' Bool
False Maybe LimitParam
limitM) (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
o) Maybe Start
forall a. Maybe a
Nothing
  [TxHash]
ths <- ((Word64, TxHash) -> TxHash) -> [(Word64, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(Word64, TxHash)] -> [TxHash])
-> ([(Word64, TxHash)] -> [(Word64, TxHash)])
-> [(Word64, TxHash)]
-> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Limits -> [(Word64, TxHash)] -> [(Word64, TxHash)]
forall a. Limits -> [a] -> [a]
applyLimits Limits
l ([(Word64, TxHash)] -> [TxHash])
-> ActionT Except (ReaderT WebState m) [(Word64, TxHash)]
-> WebT m [TxHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  [TxHash] -> WebT m [TxHash]
forall a. a -> ActionT Except (ReaderT WebState m) a
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 = WebState
s.config.store.pub
    gauge :: Maybe Gauge
gauge = (.events) (WebMetrics -> Gauge) -> Maybe WebMetrics -> Maybe Gauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebState
s.metrics
    events :: ServerApp
events PendingConnection
pending = Publisher StoreEvent -> (Inbox StoreEvent -> IO ()) -> IO ()
forall (m :: * -> *) msg a.
MonadUnliftIO m =>
Publisher msg -> (Inbox msg -> m a) -> m a
withSubscription Publisher StoreEvent
pub ((Inbox StoreEvent -> IO ()) -> IO ())
-> (Inbox StoreEvent -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Inbox StoreEvent
sub -> do
      let path :: ByteString
path = RequestHead -> ByteString
requestPath (RequestHead -> ByteString) -> RequestHead -> ByteString
forall a b. (a -> b) -> a -> b
$ PendingConnection -> RequestHead
pendingRequest PendingConnection
pending
      if ByteString
path ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"/events"
        then do
          Connection
conn <- PendingConnection -> IO Connection
acceptRequest PendingConnection
pending
          IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Inbox StoreEvent -> IO (Maybe Event)
receiveEvent Inbox StoreEvent
sub IO (Maybe Event) -> (Maybe Event -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe Event
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just Event
event -> Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
sendTextData Connection
conn (Event -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Event
event)
        else
          PendingConnection -> RejectRequest -> IO ()
rejectRequestWith
            PendingConnection
pending
            RejectRequest
WebSockets.defaultRejectRequest
              { rejectBody :: ByteString
WebSockets.rejectBody =
                  ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Except -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Except
ThingNotFound,
                rejectCode :: Int
WebSockets.rejectCode =
                  Int
404,
                rejectMessage :: ByteString
WebSockets.rejectMessage =
                  ByteString
"Not Found",
                rejectHeaders :: ResponseHeaders
WebSockets.rejectHeaders =
                  [(HeaderName
"Content-Type", ByteString
"application/json")]
              }

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

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

-- GET Address Transactions --

scottyAddrTxs ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrTxs -> WebT m [TxRef]
scottyAddrTxs :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxs -> WebT m [TxRef]
scottyAddrTxs (GetAddrTxs Address
addr LimitsParam
pLimits) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressTx)
  [TxRef]
txs <- Address -> Limits -> WebT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr (Limits -> WebT m [TxRef])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
  [TxRef] -> WebT m [TxRef]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressTx)
  [TxRef]
txs <- [Address] -> Limits -> WebT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs (Limits -> WebT m [TxRef])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
  [TxRef] -> WebT m [TxRef]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressTxFull)
  [TxRef]
txs <- Address -> Limits -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr (Limits -> ActionT Except (ReaderT WebState m) [TxRef])
-> ActionT Except (ReaderT WebState m) Limits
-> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
True LimitsParam
pLimits
  [Transaction]
ts <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxRef -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxRef]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txid)) [TxRef]
txs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts)
  [Transaction] -> WebT m [Transaction]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressTxFull)
  [TxRef]
txs <- [Address] -> Limits -> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs (Limits -> ActionT Except (ReaderT WebState m) [TxRef])
-> ActionT Except (ReaderT WebState m) Limits
-> ActionT Except (ReaderT WebState m) [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
True LimitsParam
pLimits
  [Transaction]
ts <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxRef -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> [TxRef]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txid)) [TxRef]
txs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
ts)
  [Transaction] -> WebT m [Transaction]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressBalance)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Address -> WebT m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
addr

scottyAddrsBalance ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsBalance -> WebT m [Balance]
scottyAddrsBalance :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsBalance -> WebT m [Balance]
scottyAddrsBalance (GetAddrsBalance [Address]
addrs) = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressBalance)
  [Balance]
balances <- [Address] -> WebT m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances [Address]
addrs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Balance] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Balance]
balances)
  [Balance] -> WebT m [Balance]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressUnspent)
  [Unspent]
unspents <- Address -> Limits -> WebT m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
addr (Limits -> WebT m [Unspent])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [Unspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Unspent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
unspents)
  [Unspent] -> WebT m [Unspent]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.addressUnspent)
  [Unspent]
unspents <- [Address] -> Limits -> WebT m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
addrs (Limits -> WebT m [Unspent])
-> ActionT Except (ReaderT WebState m) Limits -> WebT m [Unspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT Except (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Unspent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
unspents)
  [Unspent] -> WebT m [Unspent]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.xpub)
  let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
  [XPubBal]
xbals <- ReaderT WebState m [XPubBal]
-> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubBal]
 -> ActionT Except (ReaderT WebState m) [XPubBal])
-> (ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal])
-> ReaderT WebState m [XPubBal]
-> ActionT Except (ReaderT WebState m) [XPubBal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache (ReaderT WebState m [XPubBal]
 -> ActionT Except (ReaderT WebState m) [XPubBal])
-> ReaderT WebState m [XPubBal]
-> ActionT Except (ReaderT WebState m) [XPubBal]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> ReaderT WebState m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
  XPubSummary -> WebT m XPubSummary
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (XPubSummary -> WebT m XPubSummary)
-> XPubSummary -> WebT m XPubSummary
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary XPubSpec
xspec [XPubBal]
xbals

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

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

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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.xpubTx)
  [TxRef]
txs <- XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
txs)
  [TxRef] -> WebT m [TxRef]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.xpubTxFull)
  [TxRef]
refs <- XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache
  [Transaction]
txs <-
    ([Maybe Transaction] -> [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall a b.
(a -> b)
-> ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes (ActionT Except (ReaderT WebState m) [Maybe Transaction]
 -> WebT m [Transaction])
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
-> WebT m [Transaction]
forall a b. (a -> b) -> a -> b
$
      ReaderT WebState m [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Maybe Transaction]
 -> ActionT Except (ReaderT WebState m) [Maybe Transaction])
-> (ReaderT WebState m [Maybe Transaction]
    -> ReaderT WebState m [Maybe Transaction])
-> ReaderT WebState m [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT WebState m [Maybe Transaction]
-> ReaderT WebState m [Maybe Transaction]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
nocache (ReaderT WebState m [Maybe Transaction]
 -> ActionT Except (ReaderT WebState m) [Maybe Transaction])
-> ReaderT WebState m [Maybe Transaction]
-> ActionT Except (ReaderT WebState m) [Maybe Transaction]
forall a b. (a -> b) -> a -> b
$
        (TxRef -> ReaderT WebState m (Maybe Transaction))
-> [TxRef] -> ReaderT WebState m [Maybe Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TxHash -> ReaderT WebState m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ReaderT WebState m (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ReaderT WebState m (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txid)) [TxRef]
refs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
  [Transaction] -> WebT m [Transaction]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.xpubBalance)
  [XPubBal]
balances <- ReaderT WebState m [XPubBal] -> WebT m [XPubBal]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Bool
-> ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache (XPubSpec -> ReaderT WebState m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
spec))
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
balances)
  [XPubBal] -> WebT m [XPubBal]
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.xpubUnspent)
  Limits
limits <- Bool -> LimitsParam -> WebT m Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> WebT m Limits
paramToLimits Bool
False LimitsParam
pLimits
  let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
  [XPubBal]
xbals <- XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals)
  [XPubUnspent]
unspents <- ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent])
-> (ReaderT WebState m [XPubUnspent]
    -> ReaderT WebState m [XPubUnspent])
-> ReaderT WebState m [XPubUnspent]
-> WebT m [XPubUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT WebState m [XPubUnspent]
-> ReaderT WebState m [XPubUnspent]
forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
noCache (ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent])
-> ReaderT WebState m [XPubUnspent] -> WebT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ XPubSpec -> [XPubBal] -> Limits -> ReaderT WebState m [XPubUnspent]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
xPubUnspents XPubSpec
xspec [XPubBal]
xbals Limits
limits
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubUnspent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
unspents)
  [XPubUnspent] -> WebT m [XPubUnspent]
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubUnspent]
unspents

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

netBinfoSymbol :: Network -> BinfoSymbol
netBinfoSymbol :: Network -> BinfoSymbol
netBinfoSymbol Network
net
  | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
btc =
      BinfoSymbol
        { $sel:code:BinfoSymbol :: Text
code = Text
"BTC",
          $sel:symbol:BinfoSymbol :: Text
symbol = Text
"BTC",
          $sel:name:BinfoSymbol :: Text
name = Text
"Bitcoin",
          $sel:conversion:BinfoSymbol :: Double
conversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000,
          $sel:after:BinfoSymbol :: Bool
after = Bool
True,
          $sel:local:BinfoSymbol :: Bool
local = Bool
False
        }
  | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch =
      BinfoSymbol
        { $sel:code:BinfoSymbol :: Text
code = Text
"BCH",
          $sel:symbol:BinfoSymbol :: Text
symbol = Text
"BCH",
          $sel:name:BinfoSymbol :: Text
name = Text
"Bitcoin Cash",
          $sel:conversion:BinfoSymbol :: Double
conversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000,
          $sel:after:BinfoSymbol :: Bool
after = Bool
True,
          $sel:local:BinfoSymbol :: Bool
local = Bool
False
        }
  | Bool
otherwise =
      BinfoSymbol
        { $sel:code:BinfoSymbol :: Text
code = Text
"XTS",
          $sel:symbol:BinfoSymbol :: Text
symbol = Text
"¤",
          $sel:name:BinfoSymbol :: Text
name = Text
"Test",
          $sel:conversion:BinfoSymbol :: Double
conversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000,
          $sel:after:BinfoSymbol :: Bool
after = Bool
False,
          $sel:local:BinfoSymbol :: Bool
local = Bool
False
        }

binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol
binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol
binfoTickerToSymbol Text
code BinfoTicker {Double
Text
fifteen :: Double
last :: Double
buy :: Double
sell :: Double
symbol :: Text
$sel:fifteen:BinfoTicker :: BinfoTicker -> Double
$sel:last:BinfoTicker :: BinfoTicker -> Double
$sel:buy:BinfoTicker :: BinfoTicker -> Double
$sel:sell:BinfoTicker :: BinfoTicker -> Double
$sel:symbol:BinfoTicker :: BinfoTicker -> Text
..} =
  BinfoSymbol
    { Text
$sel:code:BinfoSymbol :: Text
code :: Text
code,
      Text
$sel:symbol:BinfoSymbol :: Text
symbol :: Text
symbol,
      Text
$sel:name:BinfoSymbol :: Text
name :: Text
name,
      $sel:conversion:BinfoSymbol :: Double
conversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
fifteen, -- sat/usd
      $sel:after:BinfoSymbol :: Bool
after = Bool
False,
      $sel:local:BinfoSymbol :: Bool
local = 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 <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  Text
p <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
name) ActionT Except (ReaderT WebState m) Text
-> (Except -> ActionT Except (ReaderT WebState m) Text)
-> ActionT Except (ReaderT WebState m) Text
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Text
-> Except -> ActionT Except (ReaderT WebState m) Text
forall a b. a -> b -> a
const (Text -> ActionT Except (ReaderT WebState m) Text
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"")
  if Text -> Bool
T.null Text
p
    then HashSet BinfoAddr -> WebT m (HashSet BinfoAddr)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return HashSet BinfoAddr
forall a. HashSet a
HashSet.empty
    else case Network -> Ctx -> Text -> Maybe [BinfoAddr]
parseBinfoAddr Network
net Ctx
ctx Text
p of
      Maybe [BinfoAddr]
Nothing -> Except -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (String -> Except
UserError String
"invalid address")
      Just [BinfoAddr]
xs -> HashSet BinfoAddr -> WebT m (HashSet BinfoAddr)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet BinfoAddr -> WebT m (HashSet BinfoAddr))
-> HashSet BinfoAddr -> WebT m (HashSet BinfoAddr)
forall a b. (a -> b) -> a -> b
$ [BinfoAddr] -> HashSet BinfoAddr
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [BinfoAddr]
xs

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

getNumTxId :: (MonadIO m) => WebT m Bool
getNumTxId :: forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId = (Bool -> Bool)
-> ActionT Except (ReaderT WebState m) Bool
-> ActionT Except (ReaderT WebState m) Bool
forall a b.
(a -> b)
-> ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (ActionT Except (ReaderT WebState m) Bool
 -> ActionT Except (ReaderT WebState m) Bool)
-> ActionT Except (ReaderT WebState m) Bool
-> ActionT Except (ReaderT WebState m) Bool
forall a b. (a -> b) -> a -> b
$ Text -> ActionT Except (ReaderT WebState m) Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"txidindex" ActionT Except (ReaderT WebState m) Bool
-> (Except -> ActionT Except (ReaderT WebState m) Bool)
-> ActionT Except (ReaderT WebState m) Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Bool
-> Except -> ActionT Except (ReaderT WebState m) Bool
forall a b. a -> b -> a
const (Bool -> ActionT Except (ReaderT WebState m) Bool
forall a. a -> ActionT Except (ReaderT WebState m) a
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 <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.chain)
  (.height) (BlockNode -> Word32)
-> ActionT Except (ReaderT WebState m) BlockNode -> WebT m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch

scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoUnspent :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoUnspent = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoUnspent)
  (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- WebT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
  Bool
numtxid <- WebT m Bool
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 <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  Word32
height <- WebT m Word32
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Word32
getChainHeight
  let mn :: BinfoUnspent -> Bool
mn BinfoUnspent {Int32
Maybe BinfoXPubPath
Word32
Word64
ByteString
TxHash
BinfoTxId
txid :: TxHash
index :: Word32
script :: ByteString
value :: Word64
confirmations :: Int32
txidx :: BinfoTxId
xpub :: Maybe BinfoXPubPath
$sel:txid:BinfoUnspent :: BinfoUnspent -> TxHash
$sel:index:BinfoUnspent :: BinfoUnspent -> Word32
$sel:script:BinfoUnspent :: BinfoUnspent -> ByteString
$sel:value:BinfoUnspent :: BinfoUnspent -> Word64
$sel:confirmations:BinfoUnspent :: BinfoUnspent -> Int32
$sel:txidx:BinfoUnspent :: BinfoUnspent -> BinfoTxId
$sel:xpub:BinfoUnspent :: BinfoUnspent -> Maybe BinfoXPubPath
..} = Int32
min_conf Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
confirmations
  HashMap XPubSpec [XPubBal]
xbals <- ReaderT WebState m (HashMap XPubSpec [XPubBal])
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (HashMap XPubSpec [XPubBal])
 -> ActionT
      Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal]))
-> ReaderT WebState m (HashMap XPubSpec [XPubBal])
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall a b. (a -> b) -> a -> b
$ HashSet XPubSpec -> ReaderT WebState m (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals HashSet XPubSpec
xspecs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int -> WebT m ())
-> ([[XPubBal]] -> Int) -> [[XPubBal]] -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([[XPubBal]] -> [Int]) -> [[XPubBal]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> Int) -> [[XPubBal]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[XPubBal]] -> WebT m ()) -> [[XPubBal]] -> WebT m ()
forall a b. (a -> b) -> a -> b
$ HashMap XPubSpec [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubSpec [XPubBal]
xbals
  Int -> ReaderT WebState m ()
counter <- WebT m (Int -> ReaderT WebState m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter
  [BinfoUnspent]
bus <-
    ReaderT WebState m [BinfoUnspent]
-> ActionT Except (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoUnspent]
 -> ActionT Except (ReaderT WebState m) [BinfoUnspent])
-> (ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
    -> ReaderT WebState m [BinfoUnspent])
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ActionT Except (ReaderT WebState m) [BinfoUnspent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ReaderT WebState m [BinfoUnspent]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
 -> ActionT Except (ReaderT WebState m) [BinfoUnspent])
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ActionT Except (ReaderT WebState m) [BinfoUnspent]
forall a b. (a -> b) -> a -> b
$
      (Int -> ReaderT WebState m ())
-> Bool
-> Word32
-> HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent (ReaderT WebState m) ()
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
        ConduitT () BinfoUnspent (ReaderT WebState m) ()
-> ConduitT BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ((BinfoUnspent -> Bool)
-> ConduitT BinfoUnspent Void (ReaderT WebState m) ()
forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC BinfoUnspent -> Bool
mn ConduitT BinfoUnspent Void (ReaderT WebState m) ()
-> ConduitT BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
-> ConduitT BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
forall a b.
ConduitT BinfoUnspent Void (ReaderT WebState m) a
-> ConduitT BinfoUnspent Void (ReaderT WebState m) b
-> ConduitT BinfoUnspent Void (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoUnspent BinfoUnspent (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
limit ConduitT BinfoUnspent BinfoUnspent (ReaderT WebState m) ()
-> ConduitT BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
-> ConduitT BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT BinfoUnspent Void (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding ((Network, Ctx) -> BinfoUnspents -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) ([BinfoUnspent] -> BinfoUnspents
BinfoUnspents [BinfoUnspent]
bus))
  where
    get_limit :: ActionT Except (ReaderT WebState m) Int
get_limit = (Int -> Int)
-> ActionT Except (ReaderT WebState m) Int
-> ActionT Except (ReaderT WebState m) Int
forall a b.
(a -> b)
-> ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1000) (ActionT Except (ReaderT WebState m) Int
 -> ActionT Except (ReaderT WebState m) Int)
-> ActionT Except (ReaderT WebState m) Int
-> ActionT Except (ReaderT WebState m) Int
forall a b. (a -> b) -> a -> b
$ Text -> ActionT Except (ReaderT WebState m) Int
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"limit" ActionT Except (ReaderT WebState m) Int
-> (Except -> ActionT Except (ReaderT WebState m) Int)
-> ActionT Except (ReaderT WebState m) Int
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Int
-> Except -> ActionT Except (ReaderT WebState m) Int
forall a b. a -> b -> a
const (Int -> ActionT Except (ReaderT WebState m) Int
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
250)
    get_min_conf :: ActionT Except (ReaderT WebState m) Int32
get_min_conf = Text -> ActionT Except (ReaderT WebState m) Int32
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"confirmations" ActionT Except (ReaderT WebState m) Int32
-> (Except -> ActionT Except (ReaderT WebState m) Int32)
-> ActionT Except (ReaderT WebState m) Int32
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Int32
-> Except -> ActionT Except (ReaderT WebState m) Int32
forall a b. a -> b -> a
const (Int32 -> ActionT Except (ReaderT WebState m) Int32
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT () (Unspent, Maybe BinfoXPubPath) m ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
cs' ConduitT () (Unspent, Maybe BinfoXPubPath) m ()
-> ConduitT (Unspent, Maybe BinfoXPubPath) BinfoUnspent m ()
-> ConduitT () BinfoUnspent m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ((Unspent, Maybe BinfoXPubPath) -> BinfoUnspent)
-> ConduitT (Unspent, Maybe BinfoXPubPath) BinfoUnspent m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ((Unspent -> Maybe BinfoXPubPath -> BinfoUnspent)
-> (Unspent, Maybe BinfoXPubPath) -> BinfoUnspent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Unspent -> Maybe BinfoXPubPath -> BinfoUnspent
binfo)
  where
    binfo :: Unspent -> Maybe BinfoXPubPath -> BinfoUnspent
binfo Unspent {Maybe Address
Word64
ByteString
OutPoint
BlockRef
block :: BlockRef
outpoint :: OutPoint
value :: Word64
script :: ByteString
address :: Maybe Address
$sel:block:Unspent :: Unspent -> BlockRef
$sel:outpoint:Unspent :: Unspent -> OutPoint
$sel:value:Unspent :: Unspent -> Word64
$sel:script:Unspent :: Unspent -> ByteString
$sel:address:Unspent :: Unspent -> Maybe Address
..} Maybe BinfoXPubPath
xp =
      let conf :: Word32
conf = case BlockRef
block of
            MemRef Word64
_ -> Word32
0
            BlockRef Word32
h Word32
_ -> Word32
height Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
          hash :: TxHash
hash = OutPoint
outpoint.hash
          idx :: Word32
idx = OutPoint
outpoint.index
          val :: Word64
val = Word64
value
          script :: t
script = t
script
          txi :: BinfoTxId
txi = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid TxHash
hash
       in BinfoUnspent
            { $sel:txid:BinfoUnspent :: TxHash
txid = TxHash
hash,
              $sel:index:BinfoUnspent :: Word32
index = Word32
idx,
              ByteString
forall {a}. a
$sel:script:BinfoUnspent :: ByteString
script :: forall {a}. a
script,
              $sel:value:BinfoUnspent :: Word64
value = Word64
val,
              $sel:confirmations:BinfoUnspent :: Int32
confirmations = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
conf,
              $sel:txidx:BinfoUnspent :: BinfoTxId
txidx = BinfoTxId
txi,
              $sel:xpub:BinfoUnspent :: Maybe BinfoXPubPath
xpub = Maybe BinfoXPubPath
xp
            }
    conduits :: ConduitT
  () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
conduits = [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall a. Semigroup a => a -> a -> a
(<>) ([ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
 -> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
 -> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()])
-> ConduitT
     () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     ()
     BinfoUnspent
     m
     ([ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
      -> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT
  () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
xconduits ConduitT
  ()
  BinfoUnspent
  m
  ([ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
   -> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()])
-> ConduitT
     () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall a b.
ConduitT () BinfoUnspent m (a -> b)
-> ConduitT () BinfoUnspent m a -> ConduitT () BinfoUnspent m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall a. a -> ConduitT () BinfoUnspent m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall {a}. [ConduitT () (Unspent, Maybe a) m ()]
acounduits
    xconduits :: ConduitT
  () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
xconduits = m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT () BinfoUnspent m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
 -> ConduitT
      ()
      BinfoUnspent
      m
      [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()])
-> m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
-> ConduitT
     () BinfoUnspent m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall a b. (a -> b) -> a -> b
$ do
      let f :: p -> XPubUnspent -> (Unspent, Maybe BinfoXPubPath)
f p
x (XPubUnspent Unspent
u [Word32]
p) =
            let path :: Maybe SoftPath
path = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPathI AnyDeriv
listToPath [Word32]
p)
                xp :: Maybe BinfoXPubPath
xp = XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath p
x.key (SoftPath -> BinfoXPubPath)
-> Maybe SoftPath -> Maybe BinfoXPubPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SoftPath
path
             in (Unspent
u, Maybe BinfoXPubPath
xp)
          g :: XPubSpec -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
g XPubSpec
x = do
            let h :: Limits -> m [XPubUnspent]
h Limits
l = do
                  [XPubUnspent]
us <- XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent]
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 ([XPubUnspent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubUnspent]
us)
                  [XPubUnspent] -> m [XPubUnspent]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [XPubUnspent]
us
                l :: Limits
l = let Limits {Maybe Start
Word32
limit :: Word32
offset :: Word32
start :: Maybe Start
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
..} = Limits
forall a. Default a => a
def in Limits {$sel:limit:Limits :: Word32
limit = Word32
16, Maybe Start
Word32
offset :: Word32
start :: Maybe Start
$sel:offset:Limits :: Word32
$sel:start:Limits :: Maybe Start
..}
            ConduitT () (Unspent, Maybe BinfoXPubPath) m ()
-> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT () (Unspent, Maybe BinfoXPubPath) m ()
 -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ()))
-> ConduitT () (Unspent, Maybe BinfoXPubPath) m ()
-> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
forall a b. (a -> b) -> a -> b
$ (Limits -> m [XPubUnspent])
-> Maybe (XPubUnspent -> TxHash)
-> Limits
-> ConduitT () XPubUnspent m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings Limits -> m [XPubUnspent]
h Maybe (XPubUnspent -> TxHash)
forall a. Maybe a
Nothing Limits
l ConduitT () XPubUnspent m ()
-> ConduitT XPubUnspent (Unspent, Maybe BinfoXPubPath) m ()
-> ConduitT () (Unspent, Maybe BinfoXPubPath) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (XPubUnspent -> (Unspent, Maybe BinfoXPubPath))
-> ConduitT XPubUnspent (Unspent, Maybe BinfoXPubPath) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (XPubSpec -> XPubUnspent -> (Unspent, Maybe BinfoXPubPath)
forall {p}.
HasField "key" p XPubKey =>
p -> XPubUnspent -> (Unspent, Maybe BinfoXPubPath)
f XPubSpec
x)
      (XPubSpec -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ()))
-> [XPubSpec]
-> m [ConduitT () (Unspent, Maybe BinfoXPubPath) m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM XPubSpec -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
forall {m :: * -> *}.
Monad m =>
XPubSpec -> m (ConduitT () (Unspent, Maybe BinfoXPubPath) m ())
g (HashSet XPubSpec -> [XPubSpec]
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, Maybe a
forall a. Maybe a
Nothing)
          h :: Address -> Limits -> m [Unspent]
h Address
a Limits
l = do
            [Unspent]
us <- Address -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
a Limits
l
            Int -> m ()
counter ([Unspent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Unspent]
us)
            [Unspent] -> m [Unspent]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Unspent]
us
          l :: Limits
l = let Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Limits
forall a. Default a => a
def in Limits {$sel:limit:Limits :: Word32
limit = Word32
16, Maybe Start
Word32
$sel:offset:Limits :: Word32
$sel:start:Limits :: Maybe Start
offset :: Word32
start :: Maybe Start
..}
          g :: Address -> ConduitT () (Unspent, Maybe a) m ()
g Address
a = (Limits -> m [Unspent])
-> Maybe (Unspent -> TxHash) -> Limits -> ConduitT () Unspent m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (Address -> Limits -> m [Unspent]
h Address
a) Maybe (Unspent -> TxHash)
forall a. Maybe a
Nothing Limits
l ConduitT () Unspent m ()
-> ConduitT Unspent (Unspent, Maybe a) m ()
-> ConduitT () (Unspent, Maybe a) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Unspent -> (Unspent, Maybe a))
-> ConduitT Unspent (Unspent, Maybe a) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC Unspent -> (Unspent, Maybe a)
forall {a} {a}. a -> (a, Maybe a)
f
       in (Address -> ConduitT () (Unspent, Maybe a) m ())
-> [Address] -> [ConduitT () (Unspent, Maybe a) m ()]
forall a b. (a -> b) -> [a] -> [b]
map Address -> ConduitT () (Unspent, Maybe a) m ()
forall {a}. Address -> ConduitT () (Unspent, Maybe a) m ()
g (HashSet Address -> [Address]
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 =
  ([(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal])
-> m [(XPubSpec, [XPubBal])] -> m (HashMap XPubSpec [XPubBal])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(XPubSpec, [XPubBal])] -> HashMap XPubSpec [XPubBal]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (m [(XPubSpec, [XPubBal])] -> m (HashMap XPubSpec [XPubBal]))
-> (HashSet XPubSpec -> m [(XPubSpec, [XPubBal])])
-> HashSet XPubSpec
-> m (HashMap XPubSpec [XPubBal])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubSpec -> m (XPubSpec, [XPubBal]))
-> [XPubSpec] -> m [(XPubSpec, [XPubBal])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM XPubSpec -> m (XPubSpec, [XPubBal])
forall {f :: * -> *}.
StoreReadExtra f =>
XPubSpec -> f (XPubSpec, [XPubBal])
f ([XPubSpec] -> m [(XPubSpec, [XPubBal])])
-> (HashSet XPubSpec -> [XPubSpec])
-> HashSet XPubSpec
-> m [(XPubSpec, [XPubBal])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList
  where
    f :: XPubSpec -> f (XPubSpec, [XPubBal])
f XPubSpec
x = (XPubSpec
x,) ([XPubBal] -> (XPubSpec, [XPubBal]))
-> ([XPubBal] -> [XPubBal]) -> [XPubBal] -> (XPubSpec, [XPubBal])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (XPubBal -> Bool) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Bool
nullBalance (Balance -> Bool) -> (XPubBal -> Balance) -> XPubBal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.balance)) ([XPubBal] -> (XPubSpec, [XPubBal]))
-> f [XPubBal] -> f (XPubSpec, [XPubBal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> f [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
x

xBals :: XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals :: XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals = [XPubBal] -> XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
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
    [ConduitT () TxRef m ()] -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () TxRef m ()]
cs' ConduitT () TxRef m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT () BinfoTx m ()
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 = HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
sxspecs
      saddrs_ls :: [Address]
saddrs_ls = HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
saddrs
      conduits :: ConduitT () BinfoTx m [ConduitT () TxRef m ()]
conduits =
        [ConduitT () TxRef m ()]
-> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()]
forall a. Semigroup a => a -> a -> a
(<>)
          ([ConduitT () TxRef m ()]
 -> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
-> ConduitT
     () BinfoTx m ([ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPubSpec -> ConduitT () BinfoTx m (ConduitT () TxRef m ()))
-> [XPubSpec] -> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM XPubSpec -> ConduitT () BinfoTx m (ConduitT () TxRef m ())
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c [XPubSpec]
sxspecs_ls
          ConduitT
  () BinfoTx m ([ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall a b.
ConduitT () BinfoTx m (a -> b)
-> ConduitT () BinfoTx m a -> ConduitT () BinfoTx m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ConduitT () TxRef m ()]
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall a. a -> ConduitT () BinfoTx m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Address -> ConduitT () TxRef m ())
-> [Address] -> [ConduitT () TxRef m ()]
forall a b. (a -> b) -> [a] -> [b]
map Address -> ConduitT () TxRef m ()
addr_c [Address]
saddrs_ls)
      xpub_c :: XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c XPubSpec
x = do
        let f :: Limits -> m [TxRef]
f Limits
l = do
              [TxRef]
ts <- XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
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 ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
ts)
              [TxRef] -> m [TxRef]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
ts
            l :: Limits
l = let Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Limits
forall a. Default a => a
def in Limits {$sel:limit:Limits :: Word32
limit = Word32
16, Maybe Start
Word32
$sel:offset:Limits :: Word32
$sel:start:Limits :: Maybe Start
offset :: Word32
start :: Maybe Start
..}
        m (ConduitT () TxRef m ()) -> t m (ConduitT () TxRef m ())
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ConduitT () TxRef m ()) -> t m (ConduitT () TxRef m ()))
-> (ConduitT () TxRef m () -> m (ConduitT () TxRef m ()))
-> ConduitT () TxRef m ()
-> t m (ConduitT () TxRef m ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () TxRef m () -> m (ConduitT () TxRef m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT () TxRef m () -> t m (ConduitT () TxRef m ()))
-> ConduitT () TxRef m () -> t m (ConduitT () TxRef m ())
forall a b. (a -> b) -> a -> b
$
          (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings Limits -> m [TxRef]
f ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) Limits
l
      addr_c :: Address -> ConduitT () TxRef m ()
addr_c Address
a = do
        let f :: Limits -> m [TxRef]
f Limits
l = do
              [TxRef]
as <- Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a Limits
l
              Int -> m ()
counter ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
as)
              [TxRef] -> m [TxRef]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
as
            l :: Limits
l = let Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Limits
forall a. Default a => a
def in Limits {$sel:limit:Limits :: Word32
limit = Word32
16, Maybe Start
Word32
$sel:offset:Limits :: Word32
$sel:start:Limits :: Maybe Start
offset :: Word32
start :: Maybe Start
..}
        (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings Limits -> m [TxRef]
f ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) Limits
l
      binfo_tx :: Int64 -> Transaction -> BinfoTx
binfo_tx = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Int64
-> Transaction
-> BinfoTx
toBinfoTx Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Bool
prune
      compute_bal_change :: BinfoTx -> a
compute_bal_change BinfoTx {Bool
[BinfoTxOutput]
[BinfoTxInput]
Maybe Word32
Maybe (Int64, Int64)
Word32
Word64
ByteString
TxHash
BinfoTxId
txid :: TxHash
version :: Word32
inputCount :: Word32
outputCount :: Word32
size :: Word32
weight :: Word32
fee :: Word64
relayed :: ByteString
locktime :: Word32
index :: BinfoTxId
doubleSpend :: Bool
rbf :: Bool
balance :: Maybe (Int64, Int64)
timestamp :: Word64
blockIndex :: Maybe Word32
blockHeight :: Maybe Word32
inputs :: [BinfoTxInput]
outputs :: [BinfoTxOutput]
$sel:txid:BinfoTx :: BinfoTx -> TxHash
$sel:version:BinfoTx :: BinfoTx -> Word32
$sel:inputCount:BinfoTx :: BinfoTx -> Word32
$sel:outputCount:BinfoTx :: BinfoTx -> Word32
$sel:size:BinfoTx :: BinfoTx -> Word32
$sel:weight:BinfoTx :: BinfoTx -> Word32
$sel:fee:BinfoTx :: BinfoTx -> Word64
$sel:relayed:BinfoTx :: BinfoTx -> ByteString
$sel:locktime:BinfoTx :: BinfoTx -> Word32
$sel:index:BinfoTx :: BinfoTx -> BinfoTxId
$sel:doubleSpend:BinfoTx :: BinfoTx -> Bool
$sel:rbf:BinfoTx :: BinfoTx -> Bool
$sel:balance:BinfoTx :: BinfoTx -> Maybe (Int64, Int64)
$sel:timestamp:BinfoTx :: BinfoTx -> Word64
$sel:blockIndex:BinfoTx :: BinfoTx -> Maybe Word32
$sel:blockHeight:BinfoTx :: BinfoTx -> Maybe Word32
$sel:inputs:BinfoTx :: BinfoTx -> [BinfoTxInput]
$sel:outputs:BinfoTx :: BinfoTx -> [BinfoTxOutput]
..} =
        let ins :: [BinfoTxOutput]
ins = (BinfoTxInput -> BinfoTxOutput)
-> [BinfoTxInput] -> [BinfoTxOutput]
forall a b. (a -> b) -> [a] -> [b]
map (.output) [BinfoTxInput]
inputs
            out :: [BinfoTxOutput]
out = [BinfoTxOutput]
outputs
            f :: Bool -> BinfoTxOutput -> a
f Bool
b BinfoTxOutput {Bool
Int
[BinfoSpender]
Maybe Address
Maybe BinfoXPubPath
Word32
Word64
ByteString
BinfoTxId
typ :: Int
spent :: Bool
value :: Word64
index :: Word32
txidx :: BinfoTxId
script :: ByteString
spenders :: [BinfoSpender]
address :: Maybe Address
xpub :: Maybe BinfoXPubPath
$sel:typ:BinfoTxOutput :: BinfoTxOutput -> Int
$sel:spent:BinfoTxOutput :: BinfoTxOutput -> Bool
$sel:value:BinfoTxOutput :: BinfoTxOutput -> Word64
$sel:index:BinfoTxOutput :: BinfoTxOutput -> Word32
$sel:txidx:BinfoTxOutput :: BinfoTxOutput -> BinfoTxId
$sel:script:BinfoTxOutput :: BinfoTxOutput -> ByteString
$sel:spenders:BinfoTxOutput :: BinfoTxOutput -> [BinfoSpender]
$sel:address:BinfoTxOutput :: BinfoTxOutput -> Maybe Address
$sel:xpub:BinfoTxOutput :: BinfoTxOutput -> Maybe BinfoXPubPath
..} =
              let val :: a
val = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value
               in case Maybe Address
address of
                    Maybe Address
Nothing -> a
0
                    Just Address
a
                      | Address
a Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
baddrs ->
                          if Bool
b then a
val else a -> a
forall a. Num a => a -> a
negate a
val
                      | Bool
otherwise -> a
0
         in [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (BinfoTxOutput -> a) -> [BinfoTxOutput] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BinfoTxOutput -> a
forall {a}. Num a => Bool -> BinfoTxOutput -> a
f Bool
False) [BinfoTxOutput]
ins [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> (BinfoTxOutput -> a) -> [BinfoTxOutput] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> BinfoTxOutput -> a
forall {a}. Num a => Bool -> BinfoTxOutput -> a
f Bool
True) [BinfoTxOutput]
out
      go :: Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b =
        ConduitT TxRef BinfoTx m (Maybe TxRef)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT TxRef BinfoTx m (Maybe TxRef)
-> (Maybe TxRef -> ConduitT TxRef BinfoTx m ())
-> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> (a -> ConduitT TxRef BinfoTx m b) -> ConduitT TxRef BinfoTx m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe TxRef
Nothing -> () -> ConduitT TxRef BinfoTx m ()
forall a. a -> ConduitT TxRef BinfoTx m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just (TxRef BlockRef
_ TxHash
t) ->
            m (Maybe Transaction)
-> ConduitT TxRef BinfoTx m (Maybe Transaction)
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT TxRef BinfoTx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
t) ConduitT TxRef BinfoTx m (Maybe Transaction)
-> (Maybe Transaction -> ConduitT TxRef BinfoTx m ())
-> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> (a -> ConduitT TxRef BinfoTx m b) -> ConduitT TxRef BinfoTx m b
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
                m () -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT TxRef BinfoTx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitT TxRef BinfoTx m ())
-> m () -> ConduitT TxRef BinfoTx m ()
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 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- BinfoTx -> Int64
forall {a}. Num a => BinfoTx -> a
compute_bal_change BinfoTx
a
                    c :: Bool
c = Maybe Word32 -> Bool
forall a. Maybe a -> Bool
isJust BinfoTx
a.blockHeight
                    Just (Int64
d, Int64
_) = BinfoTx
a.balance
                    r :: Int64
r = Int64
d Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral BinfoTx
a.fee
                case BinfoFilter
bfilter of
                  BinfoFilter
BinfoFilterAll ->
                    BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> ConduitT TxRef BinfoTx m b -> ConduitT TxRef BinfoTx m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                  BinfoFilter
BinfoFilterSent
                    | Int64
0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
r -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> ConduitT TxRef BinfoTx m b -> ConduitT TxRef BinfoTx m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                    | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                  BinfoFilter
BinfoFilterReceived
                    | Int64
r Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> ConduitT TxRef BinfoTx m b -> ConduitT TxRef BinfoTx m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                    | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                  BinfoFilter
BinfoFilterMoved
                    | Int64
r Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> ConduitT TxRef BinfoTx m b -> ConduitT TxRef BinfoTx m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                    | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                  BinfoFilter
BinfoFilterConfirmed
                    | Bool
c -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> ConduitT TxRef BinfoTx m b -> ConduitT TxRef BinfoTx m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                    | Bool
otherwise -> Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
b'
                  BinfoFilter
BinfoFilterMempool
                    | Bool
c -> () -> ConduitT TxRef BinfoTx m ()
forall a. a -> ConduitT TxRef BinfoTx m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    | Bool
otherwise -> BinfoTx -> ConduitT TxRef BinfoTx m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield BinfoTx
a ConduitT TxRef BinfoTx m ()
-> ConduitT TxRef BinfoTx m () -> ConduitT TxRef BinfoTx m ()
forall a b.
ConduitT TxRef BinfoTx m a
-> ConduitT TxRef BinfoTx m b -> ConduitT TxRef BinfoTx m b
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 = Text -> ActionT Except (ReaderT WebState m) Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"cashaddr" ActionT Except (ReaderT WebState m) Bool
-> (Except -> ActionT Except (ReaderT WebState m) Bool)
-> ActionT Except (ReaderT WebState m) Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Bool
-> Except -> ActionT Except (ReaderT WebState m) Bool
forall a b. a -> b -> a
const (Bool -> ActionT Except (ReaderT WebState m) Bool
forall a. a -> ActionT Except (ReaderT WebState m) a
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 <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
param'
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  case Network -> Text -> Maybe Address
textToAddr Network
net Text
txt of
    Maybe Address
Nothing -> Except -> WebT m Address
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just Address
a -> Address -> WebT m Address
forall a. a -> ActionT Except (ReaderT WebState m) 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 <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
param'
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  let x :: Maybe BinfoAddr
x =
        Address -> BinfoAddr
BinfoAddr
          (Address -> BinfoAddr) -> Maybe Address -> Maybe BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Text -> Maybe Address
textToAddr Network
net Text
txt
          Maybe BinfoAddr -> Maybe BinfoAddr -> Maybe BinfoAddr
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XPubKey -> BinfoAddr
BinfoXpub (XPubKey -> BinfoAddr) -> Maybe XPubKey -> Maybe BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Ctx -> Text -> Maybe XPubKey
xPubImport Network
net Ctx
ctx Text
txt
  WebT m BinfoAddr
-> (BinfoAddr -> WebT m BinfoAddr)
-> Maybe BinfoAddr
-> WebT m BinfoAddr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WebT m BinfoAddr
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next BinfoAddr -> WebT m BinfoAddr
forall a. a -> ActionT Except (ReaderT WebState m) a
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoExportHistory)
  (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- WebT m (HashSet XPubSpec, HashSet Address)
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') <- WebT m (Text, BinfoTicker)
forall (m :: * -> *). MonadIO m => WebT m (Text, BinfoTicker)
getPrice
  HashMap XPubSpec [XPubBal]
xbals <- HashSet XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals HashSet XPubSpec
xspecs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int -> WebT m ())
-> ([[XPubBal]] -> Int) -> [[XPubBal]] -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([[XPubBal]] -> [Int]) -> [[XPubBal]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> Int) -> [[XPubBal]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[XPubBal]] -> WebT m ()) -> [[XPubBal]] -> WebT m ()
forall a b. (a -> b) -> a -> b
$ HashMap XPubSpec [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubSpec [XPubBal]
xbals
  Int -> ReaderT WebState m ()
counter <- WebT m (Int -> ReaderT WebState m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter
  let xaddrs :: HashSet Address
xaddrs = [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address) -> [Address] -> HashSet Address
forall a b. (a -> b) -> a -> b
$ ([XPubBal] -> [Address]) -> [[XPubBal]] -> [Address]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> Address
get_addr) (HashMap XPubSpec [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubSpec [XPubBal]
xbals)
      aaddrs :: HashSet Address
aaddrs = HashSet Address
xaddrs HashSet Address -> HashSet Address -> HashSet Address
forall a. Semigroup a => a -> a -> a
<> HashSet Address
addrs
      cur :: Double
cur = BinfoTicker
price'.fifteen
      cs' :: [ConduitT () TxRef (ReaderT WebState m) ()]
cs' = (Int -> ReaderT WebState m ())
-> [(XPubSpec, [XPubBal])]
-> HashSet Address
-> Maybe BlockData
-> [ConduitT () TxRef (ReaderT WebState m) ()]
forall {a} {m :: * -> *} {a}.
(HasField "height" a Word32, StoreReadExtra m) =>
(Int -> m a)
-> [(XPubSpec, [XPubBal])]
-> HashSet Address
-> Maybe a
-> [ConduitT () TxRef m ()]
conduits Int -> ReaderT WebState m ()
counter (HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [XPubBal]
xbals) HashSet Address
addrs Maybe BlockData
endM
  [Transaction]
txs <-
    ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b. (a -> b) -> a -> b
$
      ConduitT () Void (ReaderT WebState m) [Transaction]
-> ReaderT WebState m [Transaction]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [Transaction]
 -> ReaderT WebState m [Transaction])
-> ConduitT () Void (ReaderT WebState m) [Transaction]
-> ReaderT WebState m [Transaction]
forall a b. (a -> b) -> a -> b
$
        [ConduitT () TxRef (ReaderT WebState m) ()]
-> ConduitT () TxRef (ReaderT WebState m) ()
forall (m :: * -> *) a.
(Monad m, Ord a) =>
[ConduitT () a m ()] -> ConduitT () a m ()
joinDescStreams [ConduitT () TxRef (ReaderT WebState m) ()]
cs'
          ConduitT () TxRef (ReaderT WebState m) ()
-> ConduitT TxRef Void (ReaderT WebState m) [Transaction]
-> ConduitT () Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (TxRef -> Bool) -> ConduitT TxRef TxRef (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
takeWhileC (Maybe BlockData -> TxRef -> Bool
is_newer Maybe BlockData
startM)
          ConduitT TxRef TxRef (ReaderT WebState m) ()
-> ConduitT TxRef Void (ReaderT WebState m) [Transaction]
-> ConduitT TxRef Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (TxRef -> ReaderT WebState m (Maybe Transaction))
-> ConduitT
     TxRef (Element (Maybe Transaction)) (ReaderT WebState m) ()
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> m mono) -> ConduitT a (Element mono) m ()
concatMapMC TxRef -> ReaderT WebState m (Maybe Transaction)
forall {m :: * -> *}.
StoreReadBase m =>
TxRef -> m (Maybe Transaction)
get_transaction
          ConduitT TxRef Transaction (ReaderT WebState m) ()
-> ConduitT Transaction Void (ReaderT WebState m) [Transaction]
-> ConduitT TxRef Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Transaction Void (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
  let times :: [Word64]
times = (Transaction -> Word64) -> [Transaction] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (\Transaction {Bool
[StoreOutput]
[StoreInput]
Word32
Word64
TxHash
BlockRef
block :: BlockRef
version :: Word32
locktime :: Word32
inputs :: [StoreInput]
outputs :: [StoreOutput]
deleted :: Bool
rbf :: Bool
timestamp :: Word64
txid :: TxHash
size :: Word32
weight :: Word32
fee :: Word64
$sel:block:Transaction :: Transaction -> BlockRef
$sel:version:Transaction :: Transaction -> Word32
$sel:locktime:Transaction :: Transaction -> Word32
$sel:inputs:Transaction :: Transaction -> [StoreInput]
$sel:outputs:Transaction :: Transaction -> [StoreOutput]
$sel:deleted:Transaction :: Transaction -> Bool
$sel:rbf:Transaction :: Transaction -> Bool
$sel:timestamp:Transaction :: Transaction -> Word64
$sel:txid:Transaction :: Transaction -> TxHash
$sel:size:Transaction :: Transaction -> Word32
$sel:weight:Transaction :: Transaction -> Word32
$sel:fee:Transaction :: Transaction -> Word64
..} -> Word64
timestamp) [Transaction]
txs
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  String
url <- ReaderT WebState m String
-> ActionT Except (ReaderT WebState m) String
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m String
 -> ActionT Except (ReaderT WebState m) String)
-> ReaderT WebState m String
-> ActionT Except (ReaderT WebState m) String
forall a b. (a -> b) -> a -> b
$ (WebState -> String) -> ReaderT WebState m String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.priceHistoryURL)
  Session
session <- ReaderT WebState m Session
-> ActionT Except (ReaderT WebState m) Session
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Session
 -> ActionT Except (ReaderT WebState m) Session)
-> ReaderT WebState m Session
-> ActionT Except (ReaderT WebState m) Session
forall a b. (a -> b) -> a -> b
$ (WebState -> Session) -> ReaderT WebState m Session
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.session)
  [Double]
rates <- (BinfoRate -> Double) -> [BinfoRate] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (.price) ([BinfoRate] -> [Double])
-> ActionT Except (ReaderT WebState m) [BinfoRate]
-> ActionT Except (ReaderT WebState m) [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m [BinfoRate]
-> ActionT Except (ReaderT WebState m) [BinfoRate]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Network
-> Session
-> String
-> Text
-> [Word64]
-> ReaderT WebState m [BinfoRate]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Network -> Session -> String -> Text -> [Word64] -> m [BinfoRate]
getRates Network
net Session
session String
url Text
code [Word64]
times)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
rates)
  let hs :: [BinfoHistory]
hs = (Transaction -> Double -> BinfoHistory)
-> [Transaction] -> [Double] -> [BinfoHistory]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Double -> HashSet Address -> Transaction -> Double -> BinfoHistory
convert Double
cur HashSet Address
aaddrs) [Transaction]
txs ([Double]
rates [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> Double -> [Double]
forall a. a -> [a]
repeat Double
0.0)
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ [BinfoHistory] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [BinfoHistory]
hs
  where
    is_newer :: Maybe BlockData -> TxRef -> Bool
is_newer (Just b :: BlockData
b@BlockData {}) TxRef {$sel:block:TxRef :: TxRef -> BlockRef
block = t :: BlockRef
t@BlockRef {}} =
      BlockData
b.height Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= BlockRef
t.height
    is_newer Maybe BlockData
Nothing TxRef {} = Bool
True
    get_addr :: XPubBal -> Address
get_addr = (.balance.address)
    get_transaction :: TxRef -> m (Maybe Transaction)
get_transaction TxRef {$sel:txid:TxRef :: TxRef -> TxHash
txid = TxHash
h} =
      TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h
    convert :: Double -> HashSet Address -> Transaction -> Double -> BinfoHistory
convert Double
cur HashSet Address
addrs Transaction
tx Double
rate =
      let ins :: [StoreInput]
ins = Transaction
tx.inputs
          outs :: [StoreOutput]
outs = Transaction
tx.outputs
          fins :: [StoreInput]
fins = (StoreInput -> Bool) -> [StoreInput] -> [StoreInput]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet Address -> StoreInput -> Bool
input_addr HashSet Address
addrs) [StoreInput]
ins
          fouts :: [StoreOutput]
fouts = (StoreOutput -> Bool) -> [StoreOutput] -> [StoreOutput]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet Address -> StoreOutput -> Bool
output_addr HashSet Address
addrs) [StoreOutput]
outs
          vin :: Int64
vin = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> ([Word64] -> Word64) -> [Word64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Int64) -> [Word64] -> Int64
forall a b. (a -> b) -> a -> b
$ (StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.value) [StoreInput]
fins
          vout :: Int64
vout = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> ([Word64] -> Word64) -> [Word64] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Int64) -> [Word64] -> Int64
forall a b. (a -> b) -> a -> b
$ (StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.value) [StoreOutput]
fouts
          fee :: Word64
fee = Transaction
tx.fee
          v :: Int64
v = Int64
vout Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
vin
          t :: Word64
t = Transaction
tx.timestamp
          h :: TxHash
h = Tx -> TxHash
txHash (Tx -> TxHash) -> Tx -> TxHash
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData Transaction
tx
       in Int64
-> Word64 -> Double -> Double -> 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 {$sel:address:StoreCoinbase :: StoreInput -> Maybe Address
address = Just Address
a} =
      Address
a Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
addrs'
    input_addr HashSet Address
_ StoreInput
_ = Bool
False
    output_addr :: HashSet Address -> StoreOutput -> Bool
output_addr HashSet Address
addrs' StoreOutput {$sel:address:StoreOutput :: StoreOutput -> Maybe Address
address = Just Address
a} =
      Address
a Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet Address
addrs'
    output_addr HashSet Address
_ StoreOutput
_ = Bool
False
    get_dates :: ActionT
  Except (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
get_dates = do
      BinfoDate Word64
start <- Text -> ActionT Except (ReaderT WebState m) BinfoDate
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"start"
      BinfoDate Word64
end' <- Text -> ActionT Except (ReaderT WebState m) BinfoDate
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"end"
      let end :: Word64
end = Word64
end' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60
      Chain
ch <- ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Chain
 -> ActionT Except (ReaderT WebState m) Chain)
-> ReaderT WebState m Chain
-> ActionT Except (ReaderT WebState m) Chain
forall a b. (a -> b) -> a -> b
$ (WebState -> Chain) -> ReaderT WebState m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.chain)
      Maybe BlockData
startM <- Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfter Chain
ch Word64
start
      Maybe BlockData
endM <- Chain
-> Word64 -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
end
      (Maybe BlockData, Maybe BlockData)
-> ActionT
     Except (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockData
startM, Maybe BlockData
endM)
    conduits :: (Int -> m a)
-> [(XPubSpec, [XPubBal])]
-> HashSet Address
-> Maybe a
-> [ConduitT () TxRef m ()]
conduits Int -> m a
counter [(XPubSpec, [XPubBal])]
xpubs HashSet Address
addrs Maybe a
endM =
      ((XPubSpec, [XPubBal]) -> ConduitT () TxRef m ())
-> [(XPubSpec, [XPubBal])] -> [ConduitT () TxRef m ()]
forall a b. (a -> b) -> [a] -> [b]
map ((XPubSpec -> [XPubBal] -> ConduitT () TxRef m ())
-> (XPubSpec, [XPubBal]) -> ConduitT () TxRef m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> m a)
-> Maybe a -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
forall {a} {m :: * -> *} {a}.
(HasField "height" a Word32, StoreReadExtra m) =>
(Int -> m a)
-> Maybe a -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
xpub_c Int -> m a
counter Maybe a
endM)) [(XPubSpec, [XPubBal])]
xpubs
        [ConduitT () TxRef m ()]
-> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()]
forall a. Semigroup a => a -> a -> a
<> (Address -> ConduitT () TxRef m ())
-> [Address] -> [ConduitT () TxRef m ()]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> m a) -> Maybe a -> Address -> ConduitT () TxRef m ()
forall {a} {m :: * -> *} {a}.
(HasField "height" a Word32, StoreReadExtra m) =>
(Int -> m a) -> Maybe a -> Address -> ConduitT () TxRef m ()
addr_c Int -> m a
counter Maybe a
endM) (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
    addr_c :: (Int -> m a) -> Maybe a -> Address -> ConduitT () TxRef m ()
addr_c Int -> m a
counter Maybe a
endM Address
a = do
      let f :: Limits -> m [TxRef]
f Limits
l = do
            [TxRef]
ts <- Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a Limits
l
            Int -> m a
counter ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
ts)
            [TxRef] -> m [TxRef]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
ts
          l :: Limits
l =
            let Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Limits
forall a. Default a => a
def
             in Limits
                  { $sel:limit:Limits :: Word32
limit = Word32
16,
                    $sel:start:Limits :: Maybe Start
start = Word32 -> Start
AtBlock (Word32 -> Start) -> (a -> Word32) -> a -> Start
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.height) (a -> Start) -> Maybe a -> Maybe Start
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
endM,
                    Word32
$sel:offset:Limits :: Word32
offset :: Word32
..
                  }
      (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings Limits -> m [TxRef]
f ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) Limits
l
    xpub_c :: (Int -> m a)
-> Maybe a -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
xpub_c Int -> m a
counter Maybe a
endM XPubSpec
x [XPubBal]
bs = do
      let f :: Limits -> m [TxRef]
f Limits
l = do
            [TxRef]
ts <- XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
x [XPubBal]
bs Limits
l
            Int -> m a
counter ([TxRef] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxRef]
ts)
            [TxRef] -> m [TxRef]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [TxRef]
ts
          l :: Limits
l =
            let Limits {Maybe Start
Word32
$sel:limit:Limits :: Limits -> Word32
$sel:offset:Limits :: Limits -> Word32
$sel:start:Limits :: Limits -> Maybe Start
limit :: Word32
offset :: Word32
start :: Maybe Start
..} = Limits
forall a. Default a => a
def
             in Limits
                  { $sel:limit:Limits :: Word32
limit = Word32
16,
                    $sel:start:Limits :: Maybe Start
start = Word32 -> Start
AtBlock (Word32 -> Start) -> (a -> Word32) -> a -> Start
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.height) (a -> Start) -> Maybe a -> Maybe Start
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
endM,
                    Word32
$sel:offset:Limits :: Word32
offset :: Word32
..
                  }
      (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings Limits -> m [TxRef]
f ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) Limits
l

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

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

scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyMultiAddr :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyMultiAddr = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoMultiaddr)
  (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 <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  Bool
cashaddr <- WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr
  BinfoSymbol
local' <- WebT m BinfoSymbol
forall (m :: * -> *). MonadIO m => WebT m BinfoSymbol
getSymbol
  Int
offset <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
  Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"n"
  Bool
prune <- WebT m Bool
get_prune
  BinfoFilter
fltr <- ActionT Except (ReaderT WebState m) BinfoFilter
get_filter
  HashMap XPubSpec [XPubBal]
xbals <- HashSet XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals HashSet XPubSpec
xspecs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int -> WebT m ())
-> ([[XPubBal]] -> Int) -> [[XPubBal]] -> WebT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([[XPubBal]] -> [Int]) -> [[XPubBal]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> Int) -> [[XPubBal]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[XPubBal]] -> WebT m ()) -> [[XPubBal]] -> WebT m ()
forall a b. (a -> b) -> a -> b
$ HashMap XPubSpec [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubSpec [XPubBal]
xbals
  HashMap XPubSpec Word64
xtxns <- HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec Word64)
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
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (HashMap XPubSpec Word64 -> Int
forall a. HashMap XPubSpec a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap XPubSpec Word64
xtxns)
  let sxbals :: HashMap XPubSpec [XPubBal]
sxbals = HashSet XPubKey
-> HashMap XPubSpec [XPubBal] -> HashMap XPubSpec [XPubBal]
forall {a} {r} {v}.
(Hashable a, HasField "key" r a) =>
HashSet a -> HashMap r v -> HashMap r v
only_show_xbals HashSet XPubKey
sxpubs HashMap XPubSpec [XPubBal]
xbals
      xabals :: HashMap Address Balance
xabals = HashMap XPubSpec [XPubBal] -> HashMap Address Balance
forall {k}. HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals HashMap XPubSpec [XPubBal]
xbals
      addrs :: HashSet Address
addrs = HashSet Address
addrs' HashSet Address -> HashSet Address -> HashSet Address
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HashSet.difference` HashMap Address Balance -> HashSet Address
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap Address Balance
xabals
  HashMap Address Balance
abals <- HashSet Address
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
get_abals HashSet Address
addrs
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (HashMap Address Balance -> Int
forall a. HashMap Address a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashMap Address Balance
abals)
  let sxspecs :: HashSet XPubSpec
sxspecs = HashSet XPubKey -> HashSet XPubSpec -> HashSet XPubSpec
forall {a} {r}.
(Hashable a, HasField "key" r a) =>
HashSet a -> HashSet r -> HashSet r
only_show_xspecs HashSet XPubKey
sxpubs HashSet XPubSpec
xspecs
      sxabals :: HashMap Address Balance
sxabals = HashMap XPubSpec [XPubBal] -> HashMap Address Balance
forall {k}. HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals HashMap XPubSpec [XPubBal]
sxbals
      sabals :: HashMap Address Balance
sabals = HashSet Address
-> HashMap Address Balance -> HashMap Address Balance
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 HashMap Address Balance
-> HashMap Address Balance -> HashMap Address Balance
forall a. Semigroup a => a -> a -> a
<> HashMap Address Balance
sxabals
      sbal :: Word64
sbal = HashMap Address Balance -> Word64
forall {k}. HashMap k Balance -> Word64
compute_bal HashMap Address Balance
sallbals
      allbals :: HashMap Address Balance
allbals = HashMap Address Balance
abals HashMap Address Balance
-> HashMap Address Balance -> HashMap Address Balance
forall a. Semigroup a => a -> a -> a
<> HashMap Address Balance
xabals
      abook :: HashMap Address (Maybe BinfoXPubPath)
abook = HashSet Address
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
compute_abook HashSet Address
addrs HashMap XPubSpec [XPubBal]
xbals
      sxaddrs :: HashSet Address
sxaddrs = HashMap XPubSpec [XPubBal] -> HashSet Address
forall {k}. HashMap k [XPubBal] -> HashSet Address
compute_xaddrs HashMap XPubSpec [XPubBal]
sxbals
      salladdrs :: HashSet Address
salladdrs = HashSet Address
saddrs HashSet Address -> HashSet Address -> HashSet Address
forall a. Semigroup a => a -> a -> a
<> HashSet Address
sxaddrs
      bal :: Word64
bal = HashMap Address Balance -> Word64
forall {k}. HashMap k Balance -> Word64
compute_bal HashMap Address Balance
allbals
      ibal :: Int64
ibal = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sbal
  Int -> ReaderT WebState m ()
counter <- WebT m (Int -> ReaderT WebState m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter
  [BinfoTx]
ftxs <-
    ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> (ConduitT () Void (ReaderT WebState m) [BinfoTx]
    -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
      (Int -> ReaderT WebState m ())
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
(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
        ConduitT () BinfoTx (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Int -> ConduitT BinfoTx Void (ReaderT WebState m) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
offset ConduitT BinfoTx Void (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall a b.
ConduitT BinfoTx Void (ReaderT WebState m) a
-> ConduitT BinfoTx Void (ReaderT WebState m) b
-> ConduitT BinfoTx Void (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  BlockData
best <- ActionT Except (ReaderT WebState m) BlockData
get_best_block
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Word32
peers <- ActionT Except (ReaderT WebState m) Word32
get_peers
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
peers)
  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 = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (BinfoBalance -> Word64) -> [BinfoBalance] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.received) [BinfoBalance]
abaddrs
      sent' :: Word64
sent' = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (BinfoBalance -> Word64) -> [BinfoBalance] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.sent) [BinfoBalance]
abaddrs
      txn :: Word64
txn = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [BinfoTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
ftxs
      wallet :: BinfoWallet
wallet =
        BinfoWallet
          { $sel:balance:BinfoWallet :: Word64
balance = Word64
bal,
            $sel:txs:BinfoWallet :: Word64
txs = Word64
txn,
            $sel:filtered:BinfoWallet :: Word64
filtered = Word64
txn,
            $sel:received:BinfoWallet :: Word64
received = Word64
recv,
            $sel:sent:BinfoWallet :: Word64
sent = Word64
sent'
          }
      coin :: BinfoSymbol
coin = Network -> BinfoSymbol
netBinfoSymbol Network
net
  let block :: BinfoBlockInfo
block =
        BinfoBlockInfo
          { $sel:hash:BinfoBlockInfo :: BlockHash
hash = BlockHeader -> BlockHash
H.headerHash BlockData
best.header,
            $sel:height:BinfoBlockInfo :: Word32
height = BlockData
best.height,
            $sel:timestamp:BinfoBlockInfo :: Word32
timestamp = BlockData
best.header.timestamp,
            $sel:index:BinfoBlockInfo :: Word32
index = BlockData
best.height
          }
  let info :: BinfoInfo
info =
        BinfoInfo
          { $sel:connected:BinfoInfo :: Word32
connected = Word32
peers,
            $sel:conversion:BinfoInfo :: Double
conversion = Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000,
            $sel:fiat:BinfoInfo :: BinfoSymbol
fiat = BinfoSymbol
local',
            $sel:crypto:BinfoInfo :: BinfoSymbol
crypto = BinfoSymbol
coin,
            $sel:head:BinfoInfo :: BinfoBlockInfo
head = BinfoBlockInfo
block
          }
  let multiaddr :: BinfoMultiAddr
multiaddr =
        BinfoMultiAddr
          { $sel:addresses:BinfoMultiAddr :: [BinfoBalance]
addresses = [BinfoBalance]
baddrs,
            $sel:wallet:BinfoMultiAddr :: BinfoWallet
wallet = BinfoWallet
wallet,
            $sel:txs:BinfoMultiAddr :: [BinfoTx]
txs = [BinfoTx]
ftxs,
            $sel:info:BinfoMultiAddr :: BinfoInfo
info = BinfoInfo
info,
            $sel:recommendFee:BinfoMultiAddr :: Bool
recommendFee = Bool
True,
            $sel:cashAddr:BinfoMultiAddr :: Bool
cashAddr = Bool
cashaddr
          }
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ (Network, Ctx) -> BinfoMultiAddr -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoMultiAddr
multiaddr
  where
    get_xpub_tx_count :: HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec -> f (HashMap XPubSpec v)
get_xpub_tx_count HashMap XPubSpec [XPubBal]
xbals =
      ([(XPubSpec, v)] -> HashMap XPubSpec v)
-> f [(XPubSpec, v)] -> f (HashMap XPubSpec v)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(XPubSpec, v)] -> HashMap XPubSpec v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        (f [(XPubSpec, v)] -> f (HashMap XPubSpec v))
-> (HashSet XPubSpec -> f [(XPubSpec, v)])
-> HashSet XPubSpec
-> f (HashMap XPubSpec v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubSpec -> f (XPubSpec, v)) -> [XPubSpec] -> f [(XPubSpec, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
          ( \XPubSpec
x ->
              (XPubSpec
x,)
                (v -> (XPubSpec, v)) -> (Word32 -> v) -> Word32 -> (XPubSpec, v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> v
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                (Word32 -> (XPubSpec, v)) -> f Word32 -> f (XPubSpec, v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> [XPubBal] -> f Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
x (XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]
xBals XPubSpec
x HashMap XPubSpec [XPubBal]
xbals)
          )
        ([XPubSpec] -> f [(XPubSpec, v)])
-> (HashSet XPubSpec -> [XPubSpec])
-> HashSet XPubSpec
-> f [(XPubSpec, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList
    get_filter :: ActionT Except (ReaderT WebState m) BinfoFilter
get_filter =
      Text -> ActionT Except (ReaderT WebState m) BinfoFilter
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"filter" ActionT Except (ReaderT WebState m) BinfoFilter
-> (Except -> ActionT Except (ReaderT WebState m) BinfoFilter)
-> ActionT Except (ReaderT WebState m) BinfoFilter
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) BinfoFilter
-> Except -> ActionT Except (ReaderT WebState m) BinfoFilter
forall a b. a -> b -> a
const (BinfoFilter -> ActionT Except (ReaderT WebState m) BinfoFilter
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterAll)
    get_best_block :: ActionT Except (ReaderT WebState m) BlockData
get_best_block =
      ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockHash
bh ->
          BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockData
b -> BlockData -> ActionT Except (ReaderT WebState m) BlockData
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
    get_prune :: WebT m Bool
get_prune =
      (Bool -> Bool) -> WebT m Bool -> WebT m Bool
forall a b.
(a -> b)
-> ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (WebT m Bool -> WebT m Bool) -> WebT m Bool -> WebT m Bool
forall a b. (a -> b) -> a -> b
$
        Text -> WebT m Bool
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"no_compact"
          WebT m Bool -> (Except -> WebT m Bool) -> WebT m Bool
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` WebT m Bool -> Except -> WebT m Bool
forall a b. a -> b -> a
const (Bool -> WebT m Bool
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
    only_show_xbals :: HashSet a -> HashMap r v -> HashMap r v
only_show_xbals HashSet a
sxpubs =
      (r -> v -> Bool) -> HashMap r v -> HashMap r v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\r
k v
_ -> r
k.key a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet a
sxpubs)
    only_show_xspecs :: HashSet a -> HashSet r -> HashSet r
only_show_xspecs HashSet a
sxpubs =
      (r -> Bool) -> HashSet r -> HashSet r
forall a. (a -> Bool) -> HashSet a -> HashSet a
HashSet.filter (\r
k -> r
k.key a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet a
sxpubs)
    only_show_abals :: HashSet a -> HashMap a v -> HashMap a v
only_show_abals HashSet a
saddrs =
      (a -> v -> Bool) -> HashMap a v -> HashMap a v
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\a
k v
_ -> a
k a -> HashSet a -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HashSet.member` HashSet a
saddrs)
    addr :: BinfoAddr -> Maybe Address
addr (BinfoAddr Address
a) = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
a
    addr (BinfoXpub XPubKey
_) = Maybe Address
forall a. Maybe a
Nothing
    xpub :: BinfoAddr -> Maybe XPubKey
xpub (BinfoXpub XPubKey
x) = XPubKey -> Maybe XPubKey
forall a. a -> Maybe a
Just XPubKey
x
    xpub (BinfoAddr Address
_) = Maybe XPubKey
forall a. Maybe a
Nothing
    get_addrs :: ActionT
  Except
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashSet XPubSpec)
get_addrs = do
      (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- WebT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
      HashSet BinfoAddr
sh <- Text -> WebT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadIO m =>
Text -> WebT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"onlyShow"
      let xpubs :: HashSet XPubKey
xpubs = (XPubSpec -> XPubKey) -> HashSet XPubSpec -> HashSet XPubKey
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map (.key) HashSet XPubSpec
xspecs
          actives :: HashSet BinfoAddr
actives =
            (Address -> BinfoAddr) -> HashSet Address -> HashSet BinfoAddr
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map Address -> BinfoAddr
BinfoAddr HashSet Address
addrs
              HashSet BinfoAddr -> HashSet BinfoAddr -> HashSet BinfoAddr
forall a. Semigroup a => a -> a -> a
<> (XPubKey -> BinfoAddr) -> HashSet XPubKey -> HashSet BinfoAddr
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map XPubKey -> BinfoAddr
BinfoXpub HashSet XPubKey
xpubs
          sh' :: HashSet BinfoAddr
sh' = if HashSet BinfoAddr -> Bool
forall a. HashSet a -> Bool
HashSet.null HashSet BinfoAddr
sh then HashSet BinfoAddr
actives else HashSet BinfoAddr
sh
          saddrs :: HashSet Address
saddrs = [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address) -> [Address] -> HashSet Address
forall a b. (a -> b) -> a -> b
$ (BinfoAddr -> Maybe Address) -> [BinfoAddr] -> [Address]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe Address
addr ([BinfoAddr] -> [Address]) -> [BinfoAddr] -> [Address]
forall a b. (a -> b) -> a -> b
$ HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
sh'
          sxpubs :: HashSet XPubKey
sxpubs = [XPubKey] -> HashSet XPubKey
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([XPubKey] -> HashSet XPubKey) -> [XPubKey] -> HashSet XPubKey
forall a b. (a -> b) -> a -> b
$ (BinfoAddr -> Maybe XPubKey) -> [BinfoAddr] -> [XPubKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinfoAddr -> Maybe XPubKey
xpub ([BinfoAddr] -> [XPubKey]) -> [BinfoAddr] -> [XPubKey]
forall a b. (a -> b) -> a -> b
$ HashSet BinfoAddr -> [BinfoAddr]
forall a. HashSet a -> [a]
HashSet.toList HashSet BinfoAddr
sh'
      (HashSet Address, HashSet XPubKey, HashSet Address,
 HashSet XPubKey, HashSet XPubSpec)
-> ActionT
     Except
     (ReaderT WebState m)
     (HashSet Address, HashSet XPubKey, HashSet Address,
      HashSet XPubKey, HashSet XPubSpec)
forall a. a -> ActionT Except (ReaderT WebState m) a
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 :: b -> (a, b)
f b
b = (b
b.address, b
b)
          g :: [Balance] -> HashMap Address Balance
g = [(Address, Balance)] -> HashMap Address Balance
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Balance)] -> HashMap Address Balance)
-> ([Balance] -> [(Address, Balance)])
-> [Balance]
-> HashMap Address Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> (Address, Balance))
-> [Balance] -> [(Address, Balance)]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> (Address, Balance)
forall {b} {a}. HasField "address" b a => b -> (a, b)
f
       in ([Balance] -> HashMap Address Balance)
-> ActionT Except (ReaderT WebState m) [Balance]
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
forall a b.
(a -> b)
-> ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Balance] -> HashMap Address Balance
g (ActionT Except (ReaderT WebState m) [Balance]
 -> ActionT Except (ReaderT WebState m) (HashMap Address Balance))
-> (HashSet Address
    -> ActionT Except (ReaderT WebState m) [Balance])
-> HashSet Address
-> ActionT Except (ReaderT WebState m) (HashMap Address Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> ActionT Except (ReaderT WebState m) [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances ([Address] -> ActionT Except (ReaderT WebState m) [Balance])
-> (HashSet Address -> [Address])
-> HashSet Address
-> ActionT Except (ReaderT WebState m) [Balance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList
    get_peers :: ActionT Except (ReaderT WebState m) Word32
get_peers = do
      [PeerInfo]
ps <- ReaderT WebState m [PeerInfo]
-> ActionT Except (ReaderT WebState m) [PeerInfo]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [PeerInfo]
 -> ActionT Except (ReaderT WebState m) [PeerInfo])
-> ReaderT WebState m [PeerInfo]
-> ActionT Except (ReaderT WebState m) [PeerInfo]
forall a b. (a -> b) -> a -> b
$ PeerMgr -> ReaderT WebState m [PeerInfo]
forall (m :: * -> *). MonadLoggerIO m => PeerMgr -> m [PeerInfo]
getPeersInformation (PeerMgr -> ReaderT WebState m [PeerInfo])
-> ReaderT WebState m PeerMgr -> ReaderT WebState m [PeerInfo]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WebState -> PeerMgr) -> ReaderT WebState m PeerMgr
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.peerMgr)
      Word32 -> ActionT Except (ReaderT WebState m) Word32
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([PeerInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PeerInfo]
ps))
    compute_xabals :: HashMap k [XPubBal] -> HashMap Address Balance
compute_xabals =
      let f :: r -> (a, b)
f r
b = (r
b.balance.address, r
b.balance)
       in [(Address, Balance)] -> HashMap Address Balance
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Balance)] -> HashMap Address Balance)
-> (HashMap k [XPubBal] -> [(Address, Balance)])
-> HashMap k [XPubBal]
-> HashMap Address Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> [(Address, Balance)])
-> [[XPubBal]] -> [(Address, Balance)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubBal -> (Address, Balance))
-> [XPubBal] -> [(Address, Balance)]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, Balance)
forall {r} {b} {a}.
(HasField "balance" r b, HasField "address" b a) =>
r -> (a, b)
f) ([[XPubBal]] -> [(Address, Balance)])
-> (HashMap k [XPubBal] -> [[XPubBal]])
-> HashMap k [XPubBal]
-> [(Address, Balance)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems
    compute_bal :: HashMap k Balance -> Word64
compute_bal =
      let f :: r -> a
f r
b = r
b.confirmed a -> a -> a
forall a. Num a => a -> a -> a
+ r
b.unconfirmed
       in [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64)
-> (HashMap k Balance -> [Word64]) -> HashMap k Balance -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Balance -> Word64) -> [Balance] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> Word64
forall {a} {r}.
(Num a, HasField "confirmed" r a, HasField "unconfirmed" r a) =>
r -> a
f ([Balance] -> [Word64])
-> (HashMap k Balance -> [Balance])
-> HashMap k Balance
-> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k Balance -> [Balance]
forall k v. HashMap k v -> [v]
HashMap.elems
    compute_abook :: HashSet Address
-> HashMap 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
key :: XPubKey
deriv :: DeriveType
$sel:key:XPubSpec :: XPubSpec -> XPubKey
$sel:deriv:XPubSpec :: XPubSpec -> DeriveType
..} XPubBal {[Word32]
Balance
path :: [Word32]
balance :: Balance
$sel:path:XPubBal :: XPubBal -> [Word32]
$sel:balance:XPubBal :: XPubBal -> Balance
..} =
            let a :: Address
a = Balance
balance.address
                e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"lions and tigers and bears"
                s :: Maybe SoftPath
s = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft ([Word32] -> DerivPathI AnyDeriv
listToPath [Word32]
path)
             in (Address
a, BinfoXPubPath -> Maybe BinfoXPubPath
forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath XPubKey
key (SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall {a}. a
e Maybe SoftPath
s)))
          amap :: HashMap Address (Maybe a)
amap =
            (() -> Maybe a) -> HashMap Address () -> HashMap Address (Maybe a)
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (HashMap Address () -> HashMap Address (Maybe a))
-> HashMap Address () -> HashMap Address (Maybe a)
forall a b. (a -> b) -> a -> b
$
              HashSet Address -> HashMap Address ()
forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet Address
addrs
          xmap :: HashMap Address (Maybe BinfoXPubPath)
xmap =
            [(Address, Maybe BinfoXPubPath)]
-> HashMap Address (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
              ([(Address, Maybe BinfoXPubPath)]
 -> HashMap Address (Maybe BinfoXPubPath))
-> ([(XPubSpec, [XPubBal])] -> [(Address, Maybe BinfoXPubPath)])
-> [(XPubSpec, [XPubBal])]
-> HashMap Address (Maybe BinfoXPubPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((XPubSpec, [XPubBal]) -> [(Address, Maybe BinfoXPubPath)])
-> [(XPubSpec, [XPubBal])] -> [(Address, Maybe BinfoXPubPath)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((XPubSpec -> [XPubBal] -> [(Address, Maybe BinfoXPubPath)])
-> (XPubSpec, [XPubBal]) -> [(Address, Maybe BinfoXPubPath)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((XPubBal -> (Address, Maybe BinfoXPubPath))
-> [XPubBal] -> [(Address, Maybe BinfoXPubPath)]
forall a b. (a -> b) -> [a] -> [b]
map ((XPubBal -> (Address, Maybe BinfoXPubPath))
 -> [XPubBal] -> [(Address, Maybe BinfoXPubPath)])
-> (XPubSpec -> XPubBal -> (Address, Maybe BinfoXPubPath))
-> XPubSpec
-> [XPubBal]
-> [(Address, Maybe BinfoXPubPath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubSpec -> XPubBal -> (Address, Maybe BinfoXPubPath)
f))
              ([(XPubSpec, [XPubBal])] -> HashMap Address (Maybe BinfoXPubPath))
-> [(XPubSpec, [XPubBal])] -> HashMap Address (Maybe BinfoXPubPath)
forall a b. (a -> b) -> a -> b
$ HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [XPubBal]
xbals
       in HashMap Address (Maybe BinfoXPubPath)
forall {a}. HashMap Address (Maybe a)
amap HashMap Address (Maybe BinfoXPubPath)
-> HashMap Address (Maybe BinfoXPubPath)
-> HashMap Address (Maybe BinfoXPubPath)
forall a. Semigroup a => a -> a -> a
<> HashMap Address (Maybe BinfoXPubPath)
xmap
    compute_xaddrs :: HashMap k [XPubBal] -> HashSet Address
compute_xaddrs =
      let f :: [XPubBal] -> [Address]
f = (XPubBal -> Address) -> [XPubBal] -> [Address]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.address)
       in [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address)
-> (HashMap k [XPubBal] -> [Address])
-> HashMap k [XPubBal]
-> HashSet Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> [Address]) -> [[XPubBal]] -> [Address]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [XPubBal] -> [Address]
f ([[XPubBal]] -> [Address])
-> (HashMap k [XPubBal] -> [[XPubBal]])
-> HashMap k [XPubBal]
-> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems

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

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

scottyRawAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyRawAddr :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyRawAddr =
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoAddressRaw)
    WebT m ()
-> ActionT Except (ReaderT WebState m) BinfoAddr
-> ActionT Except (ReaderT WebState m) BinfoAddr
forall a b.
ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ActionT Except (ReaderT WebState m) BinfoAddr
forall (m :: * -> *). Monad m => Text -> WebT m BinfoAddr
getBinfoAddr Text
"addr"
    ActionT Except (ReaderT WebState m) BinfoAddr
-> (BinfoAddr -> WebT m ()) -> WebT m ()
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      BinfoAddr Address
addr -> Address -> WebT m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
Address -> ActionT Except (ReaderT WebState m) ()
do_addr Address
addr
      BinfoXpub XPubKey
xpub -> XPubKey -> WebT m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> ActionT Except (ReaderT WebState m) ()
do_xpub XPubKey
xpub
  where
    do_xpub :: XPubKey -> ActionT Except (ReaderT WebState m) ()
do_xpub XPubKey
xpub = do
      Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
      DeriveType
derive <- Text -> ActionT Except (ReaderT WebState m) DeriveType
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"derive" ActionT Except (ReaderT WebState m) DeriveType
-> (Except -> ActionT Except (ReaderT WebState m) DeriveType)
-> ActionT Except (ReaderT WebState m) DeriveType
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) DeriveType
-> Except -> ActionT Except (ReaderT WebState m) DeriveType
forall a b. a -> b -> a
const (DeriveType -> ActionT Except (ReaderT WebState m) DeriveType
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
DeriveNormal)
      let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
derive
      Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"limit"
      Int
off <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
      HashMap XPubSpec [XPubBal]
xbals <- HashSet XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals (HashSet XPubSpec
 -> ActionT
      Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal]))
-> HashSet XPubSpec
-> ActionT Except (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall a b. (a -> b) -> a -> b
$ XPubSpec -> HashSet XPubSpec
forall a. Hashable a => a -> HashSet a
HashSet.singleton XPubSpec
xspec
      Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount (Int -> ActionT Except (ReaderT WebState m) ())
-> ([[XPubBal]] -> Int)
-> [[XPubBal]]
-> ActionT Except (ReaderT WebState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([[XPubBal]] -> [Int]) -> [[XPubBal]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([XPubBal] -> Int) -> [[XPubBal]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[XPubBal]] -> ActionT Except (ReaderT WebState m) ())
-> [[XPubBal]] -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ HashMap XPubSpec [XPubBal] -> [[XPubBal]]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap XPubSpec [XPubBal]
xbals
      Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
      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 = XPubSpec -> HashSet XPubSpec
forall a. Hashable a => a -> HashSet a
HashSet.singleton XPubSpec
xspec
          saddrs :: HashSet a
saddrs = HashSet a
forall a. HashSet a
HashSet.empty
          baddrs :: HashSet Address
baddrs = HashMap Address (Maybe BinfoXPubPath) -> HashSet Address
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap Address (Maybe BinfoXPubPath)
abook
          bfilter :: BinfoFilter
bfilter = BinfoFilter
BinfoFilterAll
          amnt :: Word64
amnt = XPubSummary
summary.confirmed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ XPubSummary
summary.unconfirmed
      Int -> ReaderT WebState m ()
counter <- WebT m (Int -> ReaderT WebState m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter
      [BinfoTx]
txs <-
        ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
          ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoTx]
 -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall a b. (a -> b) -> a -> b
$
            (Int -> ReaderT WebState m ())
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
(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
              HashSet Address
forall a. HashSet a
saddrs
              HashSet Address
baddrs
              BinfoFilter
bfilter
              Bool
numtxid
              Bool
False
              (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt)
              ConduitT () BinfoTx (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Int -> ConduitT BinfoTx Void (ReaderT WebState m) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
off ConduitT BinfoTx Void (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall a b.
ConduitT BinfoTx Void (ReaderT WebState m) a
-> ConduitT BinfoTx Void (ReaderT WebState m) b
-> ConduitT BinfoTx Void (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
      let ra :: BinfoRawAddr
ra =
            BinfoRawAddr
              { $sel:address:BinfoRawAddr :: BinfoAddr
address = XPubKey -> BinfoAddr
BinfoXpub XPubKey
xpub,
                $sel:balance:BinfoRawAddr :: Word64
balance = Word64
amnt,
                $sel:ntx:BinfoRawAddr :: Word64
ntx = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [BinfoTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
txs,
                $sel:utxo:BinfoRawAddr :: Word64
utxo = XPubSummary
summary.utxo,
                $sel:received:BinfoRawAddr :: Word64
received = XPubSummary
summary.received,
                $sel:sent:BinfoRawAddr :: Int64
sent = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral XPubSummary
summary.received Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt,
                $sel:txs:BinfoRawAddr :: [BinfoTx]
txs = [BinfoTx]
txs
              }
      ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
      Ctx
ctx <- (WebState -> Ctx) -> ActionT Except (ReaderT WebState m) Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
      Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ (Network, Ctx) -> BinfoRawAddr -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) 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
$sel:path:XPubBal :: XPubBal -> [Word32]
$sel:balance:XPubBal :: XPubBal -> Balance
path :: [Word32]
balance :: Balance
..} =
            let a :: Address
a = Balance
balance.address
                e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"black hole swallows all your code"
                s :: Maybe SoftPath
s = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft (DerivPathI AnyDeriv -> Maybe SoftPath)
-> DerivPathI AnyDeriv -> Maybe SoftPath
forall a b. (a -> b) -> a -> b
$ [Word32] -> DerivPathI AnyDeriv
listToPath [Word32]
path
                m :: SoftPath
m = SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall {a}. a
e Maybe SoftPath
s
             in (Address
a, BinfoXPubPath -> Maybe BinfoXPubPath
forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath XPubKey
xpub SoftPath
m))
       in [(Address, Maybe BinfoXPubPath)]
-> HashMap Address (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Address, Maybe BinfoXPubPath)]
 -> HashMap Address (Maybe BinfoXPubPath))
-> [(Address, Maybe BinfoXPubPath)]
-> HashMap Address (Maybe BinfoXPubPath)
forall a b. (a -> b) -> a -> b
$ (XPubBal -> (Address, Maybe BinfoXPubPath))
-> [XPubBal] -> [(Address, Maybe BinfoXPubPath)]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> (Address, Maybe BinfoXPubPath)
f [XPubBal]
xbals
    do_addr :: Address -> ActionT Except (ReaderT WebState m) ()
do_addr Address
addr = do
      Bool
numtxid <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
      Int
n <- Text -> WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Text -> WebT m Int
getBinfoCount Text
"limit"
      Int
off <- WebT m Int
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m Int
getBinfoOffset
      Balance
bal <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
addr) (Maybe Balance -> Balance)
-> ActionT Except (ReaderT WebState m) (Maybe Balance)
-> ActionT Except (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT Except (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
addr
      Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
      Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
      let abook :: HashMap Address (Maybe a)
abook = Address -> Maybe a -> HashMap Address (Maybe a)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Address
addr Maybe a
forall a. Maybe a
Nothing
          xspecs :: HashSet a
xspecs = HashSet a
forall a. HashSet a
HashSet.empty
          saddrs :: HashSet Address
saddrs = Address -> HashSet Address
forall a. Hashable a => a -> HashSet a
HashSet.singleton Address
addr
          bfilter :: BinfoFilter
bfilter = BinfoFilter
BinfoFilterAll
          amnt :: Word64
amnt = Balance
bal.confirmed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Balance
bal.unconfirmed
      Int -> ReaderT WebState m ()
counter <- WebT m (Int -> ReaderT WebState m ())
forall (m :: * -> *) (n :: * -> *).
(MonadIO m, MonadIO n) =>
WebT m (Int -> n ())
getItemCounter
      [BinfoTx]
txs <-
        ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT Except (ReaderT WebState m) [BinfoTx])
-> ReaderT WebState m [BinfoTx]
-> ActionT Except (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
          ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ReaderT WebState m) [BinfoTx]
 -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ReaderT WebState m [BinfoTx]
forall a b. (a -> b) -> a -> b
$
            (Int -> ReaderT WebState m ())
-> HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
(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]
forall k v. HashMap k v
HashMap.empty
              HashMap Address (Maybe BinfoXPubPath)
forall {a}. HashMap Address (Maybe a)
abook
              HashSet XPubSpec
forall a. HashSet a
xspecs
              HashSet Address
saddrs
              HashSet Address
saddrs
              BinfoFilter
bfilter
              Bool
numtxid
              Bool
False
              (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt)
              ConduitT () BinfoTx (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Int -> ConduitT BinfoTx Void (ReaderT WebState m) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
off ConduitT BinfoTx Void (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall a b.
ConduitT BinfoTx Void (ReaderT WebState m) a
-> ConduitT BinfoTx Void (ReaderT WebState m) b
-> ConduitT BinfoTx Void (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => Int -> ConduitT a a m ()
takeC Int
n ConduitT BinfoTx BinfoTx (ReaderT WebState m) ()
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
-> ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT BinfoTx Void (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
      let ra :: BinfoRawAddr
ra =
            BinfoRawAddr
              { $sel:address:BinfoRawAddr :: BinfoAddr
address = Address -> BinfoAddr
BinfoAddr Address
addr,
                $sel:balance:BinfoRawAddr :: Word64
balance = Word64
amnt,
                $sel:ntx:BinfoRawAddr :: Word64
ntx = Balance
bal.txs,
                $sel:utxo:BinfoRawAddr :: Word64
utxo = Balance
bal.utxo,
                $sel:received:BinfoRawAddr :: Word64
received = Balance
bal.received,
                $sel:sent:BinfoRawAddr :: Int64
sent = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Balance
bal.received Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
amnt,
                $sel:txs:BinfoRawAddr :: [BinfoTx]
txs = [BinfoTx]
txs
              }
      ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
      Ctx
ctx <- (WebState -> Ctx) -> ActionT Except (ReaderT WebState m) Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
      Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ (Network, Ctx) -> BinfoRawAddr -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoRawAddr
ra

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

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

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

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

scottyShortBal :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyShortBal :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyShortBal = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoBalance)
  (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- WebT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadIO m =>
WebT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
  Bool
cashaddr <- WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getCashAddr
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  [(Text, BinfoShortBal)]
abals <-
    [Maybe (Text, BinfoShortBal)] -> [(Text, BinfoShortBal)]
forall a. [Maybe a] -> [a]
catMaybes
      ([Maybe (Text, BinfoShortBal)] -> [(Text, BinfoShortBal)])
-> ActionT
     Except (ReaderT WebState m) [Maybe (Text, BinfoShortBal)]
-> ActionT Except (ReaderT WebState m) [(Text, BinfoShortBal)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address
 -> ActionT
      Except (ReaderT WebState m) (Maybe (Text, BinfoShortBal)))
-> [Address]
-> ActionT
     Except (ReaderT WebState m) [Maybe (Text, BinfoShortBal)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
        (Network
-> Bool
-> Address
-> ActionT
     Except (ReaderT WebState m) (Maybe (Text, BinfoShortBal))
forall {m :: * -> *}.
StoreReadBase m =>
Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
get_addr_balance Network
net Bool
cashaddr)
        (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([(Text, BinfoShortBal)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, BinfoShortBal)]
abals)
  [(Text, BinfoShortBal)]
xbals <- (XPubSpec
 -> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal))
-> [XPubSpec]
-> ActionT Except (ReaderT WebState m) [(Text, BinfoShortBal)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
forall {m :: * -> *}.
(MonadLoggerIO m, MonadUnliftIO m) =>
Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
get_xspec_balance Network
net) (HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
xspecs)
  let res :: HashMap Text BinfoShortBal
res = [(Text, BinfoShortBal)] -> HashMap Text BinfoShortBal
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Text, BinfoShortBal)]
abals [(Text, BinfoShortBal)]
-> [(Text, BinfoShortBal)] -> [(Text, BinfoShortBal)]
forall a. Semigroup a => a -> a -> a
<> [(Text, BinfoShortBal)]
xbals)
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ HashMap Text BinfoShortBal -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding HashMap Text BinfoShortBal
res
  where
    to_short_bal :: Balance -> BinfoShortBal
to_short_bal Balance {Word64
Address
address :: Address
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
$sel:address:Balance :: Balance -> Address
$sel:confirmed:Balance :: Balance -> Word64
$sel:unconfirmed:Balance :: Balance -> Word64
$sel:utxo:Balance :: Balance -> Word64
$sel:txs:Balance :: Balance -> Word64
$sel:received:Balance :: Balance -> Word64
..} =
      BinfoShortBal
        { $sel:final:BinfoShortBal :: Word64
final = Word64
confirmed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
unconfirmed,
          $sel:ntx:BinfoShortBal :: Word64
ntx = Word64
txs,
          $sel:received:BinfoShortBal :: Word64
received = Word64
received
        }
    get_addr_balance :: Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
get_addr_balance Network
net Bool
cashaddr Address
a =
      let net' :: Network
net' =
            if
                | Bool
cashaddr -> Network
net
                | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch -> Network
btc
                | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bchTest -> Network
btcTest
                | Network
net Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bchTest4 -> Network
btcTest
                | Bool
otherwise -> Network
net
       in case Network -> Address -> Maybe Text
addrToText Network
net' Address
a of
            Maybe Text
Nothing -> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Text, BinfoShortBal)
forall a. Maybe a
Nothing
            Just Text
a' ->
              Address -> m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a m (Maybe Balance)
-> (Maybe Balance -> m (Maybe (Text, BinfoShortBal)))
-> m (Maybe (Text, BinfoShortBal))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe Balance
Nothing -> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal)))
-> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a b. (a -> b) -> a -> b
$ (Text, BinfoShortBal) -> Maybe (Text, BinfoShortBal)
forall a. a -> Maybe a
Just (Text
a', Balance -> BinfoShortBal
to_short_bal (Address -> Balance
zeroBalance Address
a))
                Just Balance
b -> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal)))
-> Maybe (Text, BinfoShortBal) -> m (Maybe (Text, BinfoShortBal))
forall a b. (a -> b) -> a -> b
$ (Text, BinfoShortBal) -> Maybe (Text, BinfoShortBal)
forall a. a -> Maybe a
Just (Text
a', Balance -> BinfoShortBal
to_short_bal Balance
b)
    is_ext :: XPubBal -> Bool
is_ext XPubBal {$sel:path:XPubBal :: XPubBal -> [Word32]
path = Word32
0 : [Word32]
_} = Bool
True
    is_ext XPubBal
_ = Bool
False
    get_xspec_balance :: Network
-> XPubSpec
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
get_xspec_balance Network
net XPubSpec
xpub = do
      [XPubBal]
xbals <- XPubSpec -> ActionT Except (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      Word32
xts <- XPubSpec -> [XPubBal] -> ActionT Except (ReaderT WebState m) Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
      Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([XPubBal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPubBal]
xbals Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      let val :: Word64
val = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.confirmed) [XPubBal]
xbals
          zro :: Word64
zro = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.unconfirmed) [XPubBal]
xbals
          exs :: [XPubBal]
exs = (XPubBal -> Bool) -> [XPubBal] -> [XPubBal]
forall a. (a -> Bool) -> [a] -> [a]
filter XPubBal -> Bool
is_ext [XPubBal]
xbals
          rcv :: Word64
rcv = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.balance.received) [XPubBal]
exs
          sbl :: BinfoShortBal
sbl =
            BinfoShortBal
              { $sel:final:BinfoShortBal :: Word64
final = Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
zro,
                $sel:ntx:BinfoShortBal :: Word64
ntx = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
xts,
                $sel:received:BinfoShortBal :: Word64
received = Word64
rcv
              }
      Ctx
ctx <- (WebState -> Ctx) -> ActionT Except (ReaderT WebState m) Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
      (Text, BinfoShortBal)
-> ActionT Except (ReaderT WebState m) (Text, BinfoShortBal)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Network -> Ctx -> XPubKey -> Text
xPubExport Network
net Ctx
ctx XPubSpec
xpub.key, BinfoShortBal
sbl)

getBinfoHex :: (Monad m) => WebT m Bool
getBinfoHex :: forall (m :: * -> *). Monad m => WebT m Bool
getBinfoHex =
  (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"hex" :: Text))
    (Text -> Bool)
-> ActionT Except (ReaderT WebState m) Text
-> ActionT Except (ReaderT WebState m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"format" ActionT Except (ReaderT WebState m) Text
-> (Except -> ActionT Except (ReaderT WebState m) Text)
-> ActionT Except (ReaderT WebState m) Text
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` ActionT Except (ReaderT WebState m) Text
-> Except -> ActionT Except (ReaderT WebState m) Text
forall a b. a -> b -> a
const (Text -> ActionT Except (ReaderT WebState m) Text
forall a. a -> ActionT Except (ReaderT WebState m) a
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 <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  Word32
height <- Text -> ActionT Except (ReaderT WebState m) Word32
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"height"
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoBlockHeight)
  [BlockHash]
block_hashes <- Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
height
  [BlockData]
block_headers <- [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock [BlockHash]
block_hashes
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
block_headers)
  [BlockHash]
next_block_hashes <- Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (Word32
height Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
  [BlockData]
next_block_headers <- [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock [BlockHash]
next_block_hashes
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
next_block_headers)
  [BinfoBlock]
binfo_blocks <-
    (BlockData -> ActionT Except (ReaderT WebState m) BinfoBlock)
-> [BlockData] -> ActionT Except (ReaderT WebState m) [BinfoBlock]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool
-> [BlockData]
-> BlockData
-> ActionT Except (ReaderT WebState m) BinfoBlock
forall {m :: * -> *} {a}.
(MonadLoggerIO m, MonadUnliftIO m,
 HasField "header" a BlockHeader) =>
Bool
-> [a]
-> BlockData
-> ActionT Except (ReaderT WebState m) BinfoBlock
get_binfo_blocks Bool
numtxid [BlockData]
next_block_headers) [BlockData]
block_headers
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$ (Network, Ctx) -> [BinfoBlock] -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) [BinfoBlock]
binfo_blocks
  where
    get_tx :: TxHash -> m Transaction
get_tx TxHash
th =
      ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Transaction) -> m Transaction)
-> ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        IO Transaction -> IO Transaction
forall a. IO a -> IO a
unsafeInterleaveIO (IO Transaction -> IO Transaction)
-> IO Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
          m Transaction -> IO Transaction
forall a. m a -> IO a
run (m Transaction -> IO Transaction)
-> m Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
            Maybe Transaction -> Transaction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Transaction -> Transaction)
-> m (Maybe Transaction) -> m Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
th
    get_binfo_blocks :: Bool
-> [a]
-> BlockData
-> ActionT Except (ReaderT WebState m) BinfoBlock
get_binfo_blocks Bool
numtxid [a]
next_block_headers BlockData
block_header = do
      let my_hash :: BlockHash
my_hash = BlockHeader -> BlockHash
H.headerHash BlockData
block_header.header
          get_prev :: a -> BlockHash
get_prev = (.header.prev)
          get_hash :: a -> BlockHash
get_hash = BlockHeader -> BlockHash
H.headerHash (BlockHeader -> BlockHash) -> (a -> BlockHeader) -> a -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.header)
      [Transaction]
txs <- ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b. (a -> b) -> a -> b
$ (TxHash -> ReaderT WebState m Transaction)
-> [TxHash] -> ReaderT WebState m [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxHash -> ReaderT WebState m Transaction
forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Transaction
get_tx BlockData
block_header.txs
      Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
      let next_blocks :: [BlockHash]
next_blocks =
            (a -> BlockHash) -> [a] -> [BlockHash]
forall a b. (a -> b) -> [a] -> [b]
map a -> BlockHash
get_hash ([a] -> [BlockHash]) -> [a] -> [BlockHash]
forall a b. (a -> b) -> a -> b
$
              (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter
                ((BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
my_hash) (BlockHash -> Bool) -> (a -> BlockHash) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BlockHash
get_prev)
                [a]
next_block_headers
          binfo_txs :: [BinfoTx]
binfo_txs = (Transaction -> BinfoTx) -> [Transaction] -> [BinfoTx]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
          binfo_block :: BinfoBlock
binfo_block = BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock BlockData
block_header [BinfoTx]
binfo_txs [BlockHash]
next_blocks
      BinfoBlock -> ActionT Except (ReaderT WebState m) BinfoBlock
forall a. a -> ActionT Except (ReaderT WebState m) a
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 <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoBlockLatest)
  BlockData
best <- ActionT Except (ReaderT WebState m) BlockData
get_best_block
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Encoding -> WebT m ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> WebT m ()) -> Encoding -> WebT m ()
forall a b. (a -> b) -> a -> b
$
    BinfoHeader -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      BinfoHeader
        { $sel:hash:BinfoHeader :: BlockHash
hash = BlockHeader -> BlockHash
H.headerHash BlockData
best.header,
          $sel:timestamp:BinfoHeader :: Word32
timestamp = BlockData
best.header.timestamp,
          $sel:index:BinfoHeader :: Word32
index = BlockData
best.height,
          $sel:height:BinfoHeader :: Word32
height = BlockData
best.height,
          $sel:txids:BinfoHeader :: [BinfoTxId]
txids = (TxHash -> BinfoTxId) -> [TxHash] -> [BinfoTxId]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid) BlockData
best.txs
        }
  where
    get_best_block :: ActionT Except (ReaderT WebState m) BlockData
get_best_block =
      ActionT Except (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT Except (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockHash
bh ->
          BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData
    -> ActionT Except (ReaderT WebState m) BlockData)
-> ActionT Except (ReaderT WebState m) BlockData
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
            Just BlockData
b -> BlockData -> ActionT Except (ReaderT WebState m) BlockData
forall a. a -> ActionT Except (ReaderT WebState m) a
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 <- WebT m Bool
forall (m :: * -> *). MonadIO m => WebT m Bool
getNumTxId
  Bool
hex <- WebT m Bool
forall (m :: * -> *). Monad m => WebT m Bool
getBinfoHex
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoBlockRaw)
  Text -> ActionT Except (ReaderT WebState m) BinfoBlockId
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"block" ActionT Except (ReaderT WebState m) BinfoBlockId
-> (BinfoBlockId -> WebT m ()) -> WebT m ()
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    BinfoBlockHash BlockHash
bh -> Bool -> Bool -> BlockHash -> WebT m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
    BinfoBlockIndex Word32
i ->
      Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
i ActionT Except (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> WebT m ()) -> WebT m ()
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> Except -> WebT m ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        BlockHash
bh : [BlockHash]
_ -> Bool -> Bool -> BlockHash -> WebT m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
  where
    get_tx :: TxHash -> m Transaction
get_tx TxHash
th =
      ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO Transaction) -> m Transaction)
-> ((forall a. m a -> IO a) -> IO Transaction) -> m Transaction
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
        IO Transaction -> IO Transaction
forall a. IO a -> IO a
unsafeInterleaveIO (IO Transaction -> IO Transaction)
-> IO Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
          m Transaction -> IO Transaction
forall a. m a -> IO a
run (m Transaction -> IO Transaction)
-> m Transaction -> IO Transaction
forall a b. (a -> b) -> a -> b
$
            Maybe Transaction -> Transaction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Transaction -> Transaction)
-> m (Maybe Transaction) -> m Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
th
    go :: Bool -> Bool -> BlockHash -> ActionT Except (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh =
      BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT Except (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> ActionT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockData
Nothing -> Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
        Just BlockData
b -> do
          Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
          [Transaction]
txs <- ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT Except (ReaderT WebState m) [Transaction])
-> ReaderT WebState m [Transaction]
-> ActionT Except (ReaderT WebState m) [Transaction]
forall a b. (a -> b) -> a -> b
$ (TxHash -> ReaderT WebState m Transaction)
-> [TxHash] -> ReaderT WebState m [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxHash -> ReaderT WebState m Transaction
forall {m :: * -> *}.
(MonadUnliftIO m, StoreReadBase m) =>
TxHash -> m Transaction
get_tx BlockData
b.txs
          Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([Transaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transaction]
txs)
          let my_hash :: BlockHash
my_hash = BlockHeader -> BlockHash
H.headerHash BlockData
b.header
              get_prev :: BlockData -> BlockHash
get_prev = (.header.prev)
              get_hash :: BlockData -> BlockHash
get_hash = BlockHeader -> BlockHash
H.headerHash (BlockHeader -> BlockHash)
-> (BlockData -> BlockHeader) -> BlockData -> BlockHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.header)
          [BlockData]
nxt_headers <-
            ([Maybe BlockData] -> [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall a b.
(a -> b)
-> ActionT Except (ReaderT WebState m) a
-> ActionT Except (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe BlockData] -> [BlockData]
forall a. [Maybe a] -> [a]
catMaybes (ActionT Except (ReaderT WebState m) [Maybe BlockData]
 -> ActionT Except (ReaderT WebState m) [BlockData])
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
-> ActionT Except (ReaderT WebState m) [BlockData]
forall a b. (a -> b) -> a -> b
$
              (BlockHash
 -> ActionT Except (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM BlockHash -> ActionT Except (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
                ([BlockHash]
 -> ActionT Except (ReaderT WebState m) [Maybe BlockData])
-> ActionT Except (ReaderT WebState m) [BlockHash]
-> ActionT Except (ReaderT WebState m) [Maybe BlockData]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT Except (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (BlockData
b.height Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
          Int -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
nxt_headers)
          let nxt :: [BlockHash]
nxt =
                (BlockData -> BlockHash) -> [BlockData] -> [BlockHash]
forall a b. (a -> b) -> [a] -> [b]
map BlockData -> BlockHash
get_hash ([BlockData] -> [BlockHash]) -> [BlockData] -> [BlockHash]
forall a b. (a -> b) -> a -> b
$
                  (BlockData -> Bool) -> [BlockData] -> [BlockData]
forall a. (a -> Bool) -> [a] -> [a]
filter
                    ((BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
my_hash) (BlockHash -> Bool)
-> (BlockData -> BlockHash) -> BlockData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockData -> BlockHash
get_prev)
                    [BlockData]
nxt_headers
          if Bool
hex
            then do
              let x :: Block
x = BlockHeader -> [Tx] -> Block
H.Block BlockData
b.header ((Transaction -> Tx) -> [Transaction] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Tx
transactionData [Transaction]
txs)
              ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
              Text -> ActionT Except (ReaderT WebState m) ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> ActionT Except (ReaderT WebState m) ())
-> (Put -> Text) -> Put -> ActionT Except (ReaderT WebState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHexLazy (ByteString -> Text) -> (Put -> ByteString) -> Put -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ActionT Except (ReaderT WebState m) ())
-> Put -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Block -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Block -> m ()
serialize Block
x
            else do
              let btxs :: [BinfoTx]
btxs = (Transaction -> BinfoTx) -> [Transaction] -> [BinfoTx]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
                  y :: BinfoBlock
y = BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock BlockData
b [BinfoTx]
btxs [BlockHash]
nxt
              ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
              Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
              Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
              Encoding -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *). Monad m => Encoding -> WebT m ()
streamEncoding (Encoding -> ActionT Except (ReaderT WebState m) ())
-> Encoding -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ (Network, Ctx) -> BinfoBlock -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) 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 -> Maybe Transaction -> [Transaction]
forall a. Maybe a -> [a]
maybeToList (Maybe Transaction -> [Transaction])
-> ActionT Except (ReaderT WebState m) (Maybe Transaction)
-> ActionT Except (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> ActionT Except (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
(Monad m, StoreReadBase m) =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h
    BinfoTxIdIndex Word64
i -> Word64 -> ActionT Except (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(Monad m, StoreReadExtra m) =>
Word64 -> m [Transaction]
getNumTransaction Word64
i
  case [Transaction]
tx of
    [Transaction
t] -> Either Except Transaction -> WebT m (Either Except Transaction)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction -> WebT m (Either Except Transaction))
-> Either Except Transaction -> WebT m (Either Except Transaction)
forall a b. (a -> b) -> a -> b
$ Transaction -> Either Except Transaction
forall a b. b -> Either a b
Right Transaction
t
    [] -> Either Except Transaction -> WebT m (Either Except Transaction)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction -> WebT m (Either Except Transaction))
-> Either Except Transaction -> WebT m (Either Except Transaction)
forall a b. (a -> b) -> a -> b
$ Except -> Either Except Transaction
forall a b. a -> Either a b
Left Except
ThingNotFound
    [Transaction]
ts ->
      let tids :: [TxHash]
tids = (Transaction -> TxHash) -> [Transaction] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (Tx -> TxHash
txHash (Tx -> TxHash) -> (Transaction -> Tx) -> Transaction -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Tx
transactionData) [Transaction]
ts
       in Either Except Transaction -> WebT m (Either Except Transaction)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction -> WebT m (Either Except Transaction))
-> Either Except Transaction -> WebT m (Either Except Transaction)
forall a b. (a -> b) -> a -> b
$ Except -> Either Except Transaction
forall a b. a -> Either a b
Left ([TxHash] -> Except
TxIndexConflict [TxHash]
tids)

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

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

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

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

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

scottyBinfoGetBlockCount :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoGetBlockCount :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoGetBlockCount = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoQgetblockcount)
  Chain
ch <- (WebState -> Chain) -> ActionT Except (ReaderT WebState m) Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.chain)
  BlockNode
bn <- Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String) -> Word32 -> String
forall a b. (a -> b) -> a -> b
$ BlockNode
bn.height

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

scottyBinfoSubsidy :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoSubsidy :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoSubsidy = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoQbcperblock)
  Chain
ch <- (WebState -> Chain) -> ActionT Except (ReaderT WebState m) Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.chain)
  Network
net <- (WebState -> Network)
-> ActionT Except (ReaderT WebState m) Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  BlockNode
bn <- Chain -> ActionT Except (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$
    String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
      Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$
        (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000 :: Double)) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$
          Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Double) -> Word64 -> Double
forall a b. (a -> b) -> a -> b
$
            Network -> Word32 -> Word64
H.computeSubsidy Network
net (BlockNode
bn.height Word32 -> Word32 -> Word32
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
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoQaddresstohash)
  Address
addr <- Text -> WebT m Address
forall (m :: * -> *).
(Monad m, MonadUnliftIO m) =>
Text -> WebT m Address
getAddress Text
"addr"
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHexLazy (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutL (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize (Hash160 -> Put) -> Hash160 -> Put
forall a b. (a -> b) -> a -> b
$ Address
addr.hash160

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

scottyBinfoAddrPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoAddrPubkey :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoAddrPubkey = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoQaddrpubkey)
  Text
hex <- Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"pubkey"
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  Address
pubkey <-
    ActionT Except (ReaderT WebState m) Address
-> (PublicKey -> ActionT Except (ReaderT WebState m) Address)
-> Maybe PublicKey
-> ActionT Except (ReaderT WebState m) Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT Except (ReaderT WebState m) Address
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next (Address -> ActionT Except (ReaderT WebState m) Address
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> ActionT Except (ReaderT WebState m) Address)
-> (PublicKey -> Address)
-> PublicKey
-> ActionT Except (ReaderT WebState m) Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx) (Maybe PublicKey -> ActionT Except (ReaderT WebState m) Address)
-> Maybe PublicKey -> ActionT Except (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$
      Either String PublicKey -> Maybe PublicKey
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String PublicKey -> Maybe PublicKey)
-> (ByteString -> Either String PublicKey)
-> ByteString
-> Maybe PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> ByteString -> Either String PublicKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx (ByteString -> Maybe PublicKey)
-> Maybe ByteString -> Maybe PublicKey
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString
decodeHex Text
hex
  Network
net <- ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Network
 -> ActionT Except (ReaderT WebState m) Network)
-> ReaderT WebState m Network
-> ActionT Except (ReaderT WebState m) Network
forall a b. (a -> b) -> a -> b
$ (WebState -> Network) -> ReaderT WebState m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.net)
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  case Network -> Address -> Maybe Text
addrToText Network
net Address
pubkey of
    Maybe Text
Nothing -> Except -> WebT m ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise Except
ThingNotFound
    Just Text
a -> do
      Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
      Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
a

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

scottyBinfoHashPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()
scottyBinfoHashPubkey :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebT m ()
scottyBinfoHashPubkey = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.binfoQhashpubkey)
  Ctx
ctx <- ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Ctx -> ActionT Except (ReaderT WebState m) Ctx)
-> ReaderT WebState m Ctx
-> ActionT Except (ReaderT WebState m) Ctx
forall a b. (a -> b) -> a -> b
$ (WebState -> Ctx) -> ReaderT WebState m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.ctx)
  Maybe PublicKey
pkm <- (Either String PublicKey -> Maybe PublicKey
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String PublicKey -> Maybe PublicKey)
-> (ByteString -> Either String PublicKey)
-> ByteString
-> Maybe PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> ByteString -> Either String PublicKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx (ByteString -> Maybe PublicKey)
-> (Text -> Maybe ByteString) -> Text -> Maybe PublicKey
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex) (Text -> Maybe PublicKey)
-> ActionT Except (ReaderT WebState m) Text
-> ActionT Except (ReaderT WebState m) (Maybe PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT Except (ReaderT WebState m) Text
forall a e (m :: * -> *).
(Parsable a, ScottyError e, Monad m) =>
Text -> ActionT e m a
S.param Text
"pubkey"
  Address
addr <- case Maybe PublicKey
pkm of
    Maybe PublicKey
Nothing -> Except -> ActionT Except (ReaderT WebState m) Address
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> ActionT Except (ReaderT WebState m) Address)
-> Except -> ActionT Except (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
"Could not decode public key"
    Just PublicKey
pk -> Address -> ActionT Except (ReaderT WebState m) Address
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> ActionT Except (ReaderT WebState m) Address)
-> Address -> ActionT Except (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$ Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx PublicKey
pk
  WebT m ()
forall (m :: * -> *) e. (Monad m, ScottyError e) => ActionT e m ()
setHeaders
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  Text -> WebT m ()
forall e (m :: * -> *).
(ScottyError e, Monad m) =>
Text -> ActionT e m ()
S.text (Text -> WebT m ()) -> Text -> WebT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHexLazy (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutL (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize (Hash160 -> Put) -> Hash160 -> Put
forall a b. (a -> b) -> a -> b
$ Address
addr.hash160

-- GET Network Information --

scottyPeers ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetPeers ->
  WebT m [PeerInfo]
scottyPeers :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetPeers -> WebT m [PeerInfo]
scottyPeers GetPeers
_ = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.peers)
  [PeerInfo]
ps <- ReaderT WebState m [PeerInfo] -> WebT m [PeerInfo]
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [PeerInfo] -> WebT m [PeerInfo])
-> ReaderT WebState m [PeerInfo] -> WebT m [PeerInfo]
forall a b. (a -> b) -> a -> b
$ PeerMgr -> ReaderT WebState m [PeerInfo]
forall (m :: * -> *). MonadLoggerIO m => PeerMgr -> m [PeerInfo]
getPeersInformation (PeerMgr -> ReaderT WebState m [PeerInfo])
-> ReaderT WebState m PeerMgr -> ReaderT WebState m [PeerInfo]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WebState -> PeerMgr) -> ReaderT WebState m PeerMgr
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.peerMgr)
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount ([PeerInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PeerInfo]
ps)
  [PeerInfo] -> WebT m [PeerInfo]
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [PeerInfo]
ps

-- | Obtain information about connected peers from peer manager process.
getPeersInformation ::
  (MonadLoggerIO m) => PeerMgr -> m [PeerInfo]
getPeersInformation :: forall (m :: * -> *). MonadLoggerIO m => PeerMgr -> m [PeerInfo]
getPeersInformation PeerMgr
mgr =
  (OnlinePeer -> Maybe PeerInfo) -> [OnlinePeer] -> [PeerInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe OnlinePeer -> Maybe PeerInfo
forall {m :: * -> *} {a} {r} {r} {r}.
(Monad m, Show a, HasField "version" r (m r),
 HasField "version" r Word32, HasField "get" r ByteString,
 HasField "address" r a, HasField "services" r Word64,
 HasField "relay" r Bool, HasField "userAgent" r r) =>
r -> m PeerInfo
toInfo ([OnlinePeer] -> [PeerInfo]) -> m [OnlinePeer] -> m [PeerInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerMgr -> m [OnlinePeer]
forall (m :: * -> *). MonadIO m => PeerMgr -> m [OnlinePeer]
getPeers PeerMgr
mgr
  where
    toInfo :: r -> m PeerInfo
toInfo r
op = do
      r
ver <- r
op.version
      PeerInfo -> m PeerInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
        PeerInfo
          { $sel:userAgent:PeerInfo :: ByteString
userAgent = r
ver.userAgent.get,
            $sel:address:PeerInfo :: String
address = a -> String
forall a. Show a => a -> String
show r
op.address,
            $sel:version:PeerInfo :: Word32
version = r
ver.version,
            $sel:services:PeerInfo :: Word64
services = r
ver.services,
            $sel:relay:PeerInfo :: Bool
relay = r
ver.relay
          }

scottyHealth ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetHealth -> WebT m HealthCheck
scottyHealth :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetHealth -> WebT m HealthCheck
scottyHealth GetHealth
_ = do
  (WebMetrics -> StatDist) -> WebT m ()
forall (m :: * -> *).
MonadUnliftIO m =>
(WebMetrics -> StatDist) -> WebT m ()
setMetrics (.health)
  HealthCheck
h <- (WebState -> TVar HealthCheck)
-> ActionT Except (ReaderT WebState m) (TVar HealthCheck)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.health) ActionT Except (ReaderT WebState m) (TVar HealthCheck)
-> (TVar HealthCheck -> WebT m HealthCheck) -> WebT m HealthCheck
forall a b.
ActionT Except (ReaderT WebState m) a
-> (a -> ActionT Except (ReaderT WebState m) b)
-> ActionT Except (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar HealthCheck -> WebT m HealthCheck
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO
  Bool -> WebT m () -> WebT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h) (WebT m () -> WebT m ()) -> WebT m () -> WebT m ()
forall a b. (a -> b) -> a -> b
$ Status -> WebT m ()
forall (m :: * -> *) e. Monad m => Status -> ActionT e m ()
S.status Status
status503
  Int -> WebT m ()
forall (m :: * -> *). MonadUnliftIO m => Int -> WebT m ()
addItemCount Int
1
  HealthCheck -> WebT m HealthCheck
forall a. a -> ActionT Except (ReaderT WebState m) a
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 = WebConfig
cfg.store.chain
  Word32
headers <- (.height) (BlockNode -> Word32) -> m BlockNode -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
  Word32
blocks <-
    Word32 -> (BlockData -> Word32) -> Maybe BlockData -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 (.height)
      (Maybe BlockData -> Word32) -> m (Maybe BlockData) -> m Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m BlockData -> m (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (m (Maybe BlockHash) -> MaybeT m BlockHash
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock MaybeT m BlockHash
-> (BlockHash -> MaybeT m BlockData) -> MaybeT m BlockData
forall a b. MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> (BlockHash -> m (Maybe BlockData))
-> BlockHash
-> MaybeT m BlockData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock)
  BlockHealth -> m BlockHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    BlockHealth
      { Word32
headers :: Word32
$sel:headers:BlockHealth :: Word32
headers,
        Word32
blocks :: Word32
$sel:blocks:BlockHealth :: Word32
blocks,
        $sel:max:BlockHealth :: Int32
max = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral WebConfig
cfg.maxLaggingBlocks
      }

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 <- Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (SystemTime -> Int64) -> SystemTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds (SystemTime -> Int64) -> m SystemTime -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> m SystemTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
  Int64
t <- Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (BlockNode -> Word32) -> BlockNode -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.header.timestamp) (BlockNode -> Int64) -> m BlockNode -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
  TimeHealth -> m TimeHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    TimeHealth
      { $sel:age:TimeHealth :: Int64
age = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
t,
        $sel:max:TimeHealth :: Int64
max = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WebTimeouts
tos.block
      }

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
$sel:host:WebConfig :: WebConfig -> String
$sel:port:WebConfig :: WebConfig -> Int
$sel:store:WebConfig :: WebConfig -> Store
$sel:maxLaggingBlocks:WebConfig :: WebConfig -> Int
$sel:maxPendingTxs:WebConfig :: WebConfig -> Int
$sel:minPeers:WebConfig :: WebConfig -> Int
$sel:limits:WebConfig :: WebConfig -> WebLimits
$sel:timeouts:WebConfig :: WebConfig -> WebTimeouts
$sel:version:WebConfig :: WebConfig -> String
$sel:noMempool:WebConfig :: WebConfig -> Bool
$sel:statsStore:WebConfig :: WebConfig -> Maybe Store
$sel:tickerRefresh:WebConfig :: WebConfig -> Int
$sel:tickerURL:WebConfig :: WebConfig -> String
$sel:priceHistoryURL:WebConfig :: WebConfig -> String
$sel:noSlow:WebConfig :: WebConfig -> Bool
$sel:noBlockchainInfo:WebConfig :: WebConfig -> Bool
$sel:healthCheckInterval:WebConfig :: WebConfig -> Int
host :: String
port :: Int
store :: Store
maxLaggingBlocks :: Int
maxPendingTxs :: Int
minPeers :: Int
limits :: WebLimits
timeouts :: WebTimeouts
version :: String
noMempool :: Bool
statsStore :: Maybe Store
tickerRefresh :: Int
tickerURL :: String
priceHistoryURL :: String
noSlow :: Bool
noBlockchainInfo :: Bool
healthCheckInterval :: Int
..} = do
  Int64
n <- Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (SystemTime -> Int64) -> SystemTime -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds (SystemTime -> Int64) -> m SystemTime -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime -> m SystemTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
  Int64
b <- Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> (BlockNode -> Word32) -> BlockNode -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.header.timestamp) (BlockNode -> Int64) -> m BlockNode -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> m BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
  Int64
t <-
    m [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool m [(Word64, TxHash)] -> ([(Word64, TxHash)] -> m Int64) -> m Int64
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Word64, TxHash)
t : [(Word64, TxHash)]
_ ->
        let x :: Int64
x = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ (Word64, TxHash) -> Word64
forall a b. (a, b) -> a
fst (Word64, TxHash)
t
         in Int64 -> m Int64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> m Int64) -> Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
x Int64
b
      [] -> Int64 -> m Int64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
b
  TimeHealth -> m TimeHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    TimeHealth
      { $sel:age:TimeHealth :: Int64
age = Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
t,
        $sel:max:TimeHealth :: Int64
max = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
to
      }
  where
    ch :: Chain
ch = Store
store.chain
    to :: Word64
to =
      if Bool
noMempool
        then WebTimeouts
timeouts.block
        else WebTimeouts
timeouts.tx

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
  Int
n <- BlockStore -> m Int
forall (m :: * -> *). MonadIO m => BlockStore -> m Int
blockStorePendingTxs WebConfig
cfg.store.block
  MaxHealth -> m MaxHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    MaxHealth
      { $sel:max:MaxHealth :: Int64
max = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WebConfig
cfg.maxPendingTxs,
        $sel:count:MaxHealth :: Int64
count = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
      }

peerHealthCheck ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  WebConfig ->
  m CountHealth
peerHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m CountHealth
peerHealthCheck WebConfig
cfg = do
  Int64
count <- Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> ([OnlinePeer] -> Int) -> [OnlinePeer] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OnlinePeer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OnlinePeer] -> Int64) -> m [OnlinePeer] -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerMgr -> m [OnlinePeer]
forall (m :: * -> *). MonadIO m => PeerMgr -> m [OnlinePeer]
getPeers WebConfig
cfg.store.peerMgr
  CountHealth -> m CountHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CountHealth {$sel:min:CountHealth :: Int64
min = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WebConfig
cfg.minPeers, Int64
count :: Int64
$sel:count:CountHealth :: Int64
count}

healthCheck ::
  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
  WebConfig ->
  m HealthCheck
healthCheck :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m HealthCheck
healthCheck WebConfig
cfg = do
  BlockHealth
blocks <- WebConfig -> m BlockHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m BlockHealth
blockHealthCheck WebConfig
cfg
  TimeHealth
lastBlock <- Chain -> WebTimeouts -> m TimeHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
Chain -> WebTimeouts -> m TimeHealth
lastBlockHealthCheck WebConfig
cfg.store.chain WebConfig
cfg.timeouts
  TimeHealth
lastTx <- WebConfig -> m TimeHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig
cfg
  MaxHealth
pendingTxs <- WebConfig -> m MaxHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m MaxHealth
pendingTxsHealthCheck WebConfig
cfg
  CountHealth
peers <- WebConfig -> m CountHealth
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>
WebConfig -> m CountHealth
peerHealthCheck WebConfig
cfg
  Word64
time <- POSIXTime -> Word64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Word64)
-> (UTCTime -> POSIXTime) -> UTCTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> Word64) -> m UTCTime -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let check :: HealthCheck
check =
        HealthCheck
          { $sel:network:HealthCheck :: String
network = WebConfig
cfg.store.net.name,
            $sel:version:HealthCheck :: String
version = WebConfig
cfg.version,
            Word64
MaxHealth
CountHealth
TimeHealth
BlockHealth
blocks :: BlockHealth
lastBlock :: TimeHealth
lastTx :: TimeHealth
pendingTxs :: MaxHealth
peers :: CountHealth
time :: Word64
$sel:blocks:HealthCheck :: BlockHealth
$sel:lastBlock:HealthCheck :: TimeHealth
$sel:lastTx:HealthCheck :: TimeHealth
$sel:pendingTxs:HealthCheck :: MaxHealth
$sel:peers:HealthCheck :: CountHealth
$sel:time:HealthCheck :: Word64
..
          }
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
check) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let t :: Text
t = Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HealthCheck -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText HealthCheck
check
    $(logErrorS) Text
"Web" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Health check failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  HealthCheck -> m HealthCheck
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
check

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

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

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

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

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

-- | Does not raise exceptions. Will call @Scotty.next@ if the parameter is
-- not supplied or if parsing fails.
paramLazy :: (Param a, MonadIO m) => WebT m a
paramLazy :: forall a (m :: * -> *). (Param a, MonadIO m) => WebT m a
paramLazy = do
  Maybe a
resM <- WebT m (Maybe a)
forall a (m :: * -> *). (Param a, MonadIO m) => WebT m (Maybe a)
paramOptional WebT m (Maybe a)
-> (Except -> WebT m (Maybe a)) -> WebT m (Maybe a)
forall e (m :: * -> *) a.
(ScottyError e, Monad m) =>
ActionT e m a -> (e -> ActionT e m a) -> ActionT e m a
`S.rescue` WebT m (Maybe a) -> Except -> WebT m (Maybe a)
forall a b. a -> b -> a
const (Maybe a -> WebT m (Maybe a)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
  WebT m a -> (a -> WebT m a) -> Maybe a -> WebT m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WebT m a
forall e (m :: * -> *) a. (ScottyError e, Monad m) => ActionT e m a
S.next a -> WebT m a
forall a. a -> ActionT Except (ReaderT WebState m) a
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 (ByteString -> ByteString)
-> ActionT Except (ReaderT WebState m) ByteString
-> ActionT Except (ReaderT WebState m) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT Except (ReaderT WebState m) ByteString
forall e (m :: * -> *).
(ScottyError e, MonadIO m) =>
ActionT e m ByteString
S.body
  case ByteString -> Either String a
hex ByteString
b Either String a -> Either String a -> Either String a
forall a. Semigroup a => a -> a -> a
<> ByteString -> Either String a
bin ByteString
b of
    Left String
_ -> Except -> WebT m a
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> WebT m a) -> Except -> WebT m a
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
"Failed to parse request body"
    Right a
x -> a -> WebT m a
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  where
    bin :: ByteString -> Either String a
bin = Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize
    hex :: ByteString -> Either String a
hex ByteString
b =
      let ns :: ByteString
ns = (Char -> Bool) -> ByteString -> ByteString
C.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) ByteString
b
       in if ByteString -> Bool
isBase16 ByteString
ns
            then ByteString -> Either String a
bin (ByteString -> Either String a)
-> (Base16 ByteString -> ByteString)
-> Base16 ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base16 ByteString -> ByteString
decodeBase16 (Base16 ByteString -> Either String a)
-> Base16 ByteString -> Either String a
forall a b. (a -> b) -> a -> b
$ ByteString -> Base16 ByteString
forall a. a -> Base16 a
assertBase16 ByteString
ns
            else String -> Either String a
forall a b. a -> Either a b
Left String
"Invalid hex input"

parseOffset :: (MonadIO m) => WebT m OffsetParam
parseOffset :: forall (m :: * -> *). MonadIO m => WebT m OffsetParam
parseOffset = do
  res :: OffsetParam
res@(OffsetParam Natural
o) <- WebT m OffsetParam
forall a (m :: * -> *). (Default a, Param a, MonadIO m) => WebT m a
paramDef
  WebLimits
limits <- ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall (m :: * -> *) a. Monad m => m a -> ActionT Except m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m WebLimits
 -> ActionT Except (ReaderT WebState m) WebLimits)
-> ReaderT WebState m WebLimits
-> ActionT Except (ReaderT WebState m) WebLimits
forall a b. (a -> b) -> a -> b
$ (WebState -> WebLimits) -> ReaderT WebState m WebLimits
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.limits)
  Bool
-> ActionT Except (ReaderT WebState m) ()
-> ActionT Except (ReaderT WebState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WebLimits
limits.maxOffset Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0 Bool -> Bool -> Bool
&& Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
o Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> WebLimits
limits.maxOffset) (ActionT Except (ReaderT WebState m) ()
 -> ActionT Except (ReaderT WebState m) ())
-> ActionT Except (ReaderT WebState m) ()
-> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
    Except -> ActionT Except (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> WebT m a
raise (Except -> ActionT Except (ReaderT WebState m) ())
-> (String -> Except)
-> String
-> ActionT Except (ReaderT WebState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Except
UserError (String -> ActionT Except (ReaderT WebState m) ())
-> String -> ActionT Except (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
      String
"offset exceeded: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Natural -> String
forall a. Show a => a -> String
show Natural
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" > " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show WebLimits
limits.maxOffset
  OffsetParam -> WebT m OffsetParam
forall a. a -> ActionT Except (ReaderT WebState m) a
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 = Maybe Start -> ActionT Except (ReaderT WebState m) (Maybe Start)
forall a. a -> ActionT Except (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Start
forall a. Maybe a
Nothing
parseStart (Just StartParam
s) =
  MaybeT (ActionT Except (ReaderT WebState m)) Start
-> ActionT Except (ReaderT WebState m) (Maybe Start)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ActionT Except (ReaderT WebState m)) Start
 -> ActionT Except (ReaderT WebState m) (Maybe Start))
-> MaybeT (ActionT Except (ReaderT WebState m)) Start
-> ActionT Except (ReaderT WebState m) (Maybe Start)
forall a b. (a -> b) -> a -> b
$
    case StartParam
s of
      StartParamHash {$sel:hash:StartParamHash :: StartParam -> Hash256
hash = Hash256
h} -> Hash256 -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall {m :: * -> *}. StoreReadBase m => Hash256 -> MaybeT m Start
start_tx Hash256
h MaybeT (ActionT Except (ReaderT WebState m)) Start
-> MaybeT (ActionT Except (ReaderT WebState m)) Start
-> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall a.
MaybeT (ActionT Except (ReaderT WebState m)) a
-> MaybeT (ActionT Except (ReaderT WebState m)) a
-> MaybeT (ActionT Except (ReaderT WebState m)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash256 -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall {m :: * -> *}. StoreReadBase m => Hash256 -> MaybeT m Start
start_block Hash256
h
      StartParamHeight {$sel:height:StartParamHash :: StartParam -> Natural
height = Natural
h} -> Natural -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall {m :: * -> *} {a}. (Monad m, Integral a) => a -> m Start
start_height Natural
h
      StartParamTime {$sel:time:StartParamHash :: StartParam -> Word64
time = Word64
q} -> Word64 -> MaybeT (ActionT Except (ReaderT WebState m)) Start
forall {m :: * -> *} {r} {b} {b}.
(MonadReader r m, HasField "store" b b, HasField "chain" b Chain,
 HasField "config" r b, MonadIO m, StoreReadExtra m) =>
Word64 -> MaybeT m Start
start_time Word64
q
  where
    start_height :: a -> m Start
start_height a
h = Start -> m Start
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> m Start) -> Start -> m Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock (Word32 -> Start) -> Word32 -> Start
forall a b. (a -> b) -> a -> b
$ a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h
    start_block :: Hash256 -> MaybeT m Start
start_block Hash256
h = do
      BlockData
b <- m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock (Hash256 -> BlockHash
H.BlockHash Hash256
h)
      Start -> MaybeT m Start
forall a. a -> MaybeT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT m Start) -> Start -> MaybeT m Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock BlockData
b.height
    start_tx :: Hash256 -> MaybeT m Start
start_tx Hash256
h = do
      TxData
_ <- m (Maybe TxData) -> MaybeT m TxData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe TxData) -> MaybeT m TxData)
-> m (Maybe TxData) -> MaybeT m TxData
forall a b. (a -> b) -> a -> b
$ TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData (Hash256 -> TxHash
TxHash Hash256
h)
      Start -> MaybeT m Start
forall a. a -> MaybeT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT m Start) -> Start -> MaybeT m Start
forall a b. (a -> b) -> a -> b
$ TxHash -> Start
AtTx (Hash256 -> TxHash
TxHash Hash256
h)
    start_time :: Word64 -> MaybeT m Start
start_time Word64
q = do
      Chain
ch <- m Chain -> MaybeT m Chain
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Chain -> MaybeT m Chain) -> m Chain -> MaybeT m Chain
forall a b. (a -> b) -> a -> b
$ (r -> Chain) -> m Chain
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.chain)
      BlockData
b <- m (Maybe BlockData) -> MaybeT m BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe BlockData) -> MaybeT m BlockData)
-> m (Maybe BlockData) -> MaybeT m BlockData
forall a b. (a -> b) -> a -> b
$ Chain -> Word64 -> m (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
q
      Start -> MaybeT m Start
forall a. a -> MaybeT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT m Start) -> Start -> MaybeT m Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock BlockData
b.height

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

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

validateLimit :: WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit :: WebLimits -> Bool -> Maybe LimitParam -> Word32
validateLimit WebLimits
wl Bool
full Maybe LimitParam
limitM =
  Word32 -> Word32 -> Word32
forall {p}. (Num p, Ord p) => p -> p -> p
f Word32
m (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> (LimitParam -> Word32) -> Maybe LimitParam -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
d (Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LimitParam -> Natural) -> LimitParam -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)) Maybe LimitParam
limitM
  where
    m :: Word32
m
      | Bool
full Bool -> Bool -> Bool
&& WebLimits
wl.maxFullItemCount Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0 = WebLimits
wl.maxFullItemCount
      | Bool
otherwise = WebLimits
wl.maxItemCount
    d :: Word32
d = WebLimits
wl.defItemCount
    f :: p -> p -> p
f p
a p
0 = p
a
    f p
0 p
b = p
b
    f p
a p
b = p -> p -> p
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 <- (WebState -> DatabaseReader) -> ReaderT WebState m DatabaseReader
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.db)
  Maybe CacheConfig
mc <- (WebState -> Maybe CacheConfig)
-> ReaderT WebState m (Maybe CacheConfig)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.config.store.cache)
  m a -> ReaderT WebState m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT WebState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT WebState m a) -> m a -> ReaderT WebState m a
forall a b. (a -> b) -> a -> b
$ ReaderT DatabaseReader m a -> DatabaseReader -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Maybe CacheConfig
-> CacheT (ReaderT DatabaseReader m) a
-> ReaderT DatabaseReader m a
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 = (WebState -> WebState)
-> ReaderT WebState m a -> ReaderT WebState m a
forall a.
(WebState -> WebState)
-> ReaderT WebState m a -> ReaderT WebState m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local WebState -> WebState
g ReaderT WebState m a
f
  where
    g :: WebState -> WebState
g WebState
s = WebState
s {$sel:config:WebState :: WebConfig
config = WebConfig -> WebConfig
h WebState
s.config}
    h :: WebConfig -> WebConfig
h WebConfig
c = WebConfig
c {$sel:store:WebConfig :: Store
store = Store -> Store
i WebConfig
c.store}
    i :: Store -> Store
i Store
s = Store
s {$sel:cache:Store :: Maybe CacheConfig
cache = Maybe CacheConfig
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 <- m (m () -> IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
  Middleware -> m Middleware
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Middleware -> m Middleware) -> Middleware -> m Middleware
forall a b. (a -> b) -> a -> b
$ \Application
app Request
req Response -> IO ResponseReceived
respond -> do
    TVar ByteString
var <- ByteString -> IO (TVar ByteString)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO ByteString
B.empty
    Request
req' <-
      let rb :: IO ByteString
rb = TVar ByteString -> IO ByteString -> IO ByteString
forall {m :: * -> *}.
MonadIO m =>
TVar ByteString -> m ByteString -> m ByteString
req_body TVar ByteString
var (Request -> IO ByteString
getRequestBodyChunk Request
req)
          rq :: Request
rq = Request
req {requestBody :: IO ByteString
requestBody = IO ByteString
rb}
       in case Maybe WebMetrics
metrics of
            Maybe WebMetrics
Nothing -> Request -> IO Request
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
rq
            Just WebMetrics
m -> do
              TVar (Maybe (WebMetrics -> StatDist))
stat_var <- Maybe (WebMetrics -> StatDist)
-> IO (TVar (Maybe (WebMetrics -> StatDist)))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Maybe (WebMetrics -> StatDist)
forall a. Maybe a
Nothing
              let vt :: Vault
vt =
                    Key (TVar (Maybe (WebMetrics -> StatDist)))
-> TVar (Maybe (WebMetrics -> StatDist)) -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
V.insert WebMetrics
m.key TVar (Maybe (WebMetrics -> StatDist))
stat_var (Vault -> Vault) -> Vault -> Vault
forall a b. (a -> b) -> a -> b
$
                      Request -> Vault
vault Request
rq
              Request -> IO Request
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Request
rq {vault :: Vault
vault = Vault
vt}
    IO UTCTime
-> (UTCTime -> IO ())
-> (UTCTime -> IO ResponseReceived)
-> IO ResponseReceived
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket IO UTCTime
start (TVar ByteString -> (m () -> IO ()) -> Request -> UTCTime -> IO ()
forall {m :: * -> *}.
MonadLogger m =>
TVar ByteString -> (m () -> IO ()) -> Request -> UTCTime -> IO ()
end TVar ByteString
var m () -> IO ()
runner Request
req') ((UTCTime -> IO ResponseReceived) -> IO ResponseReceived)
-> (UTCTime -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \UTCTime
_ ->
      Application
app Request
req' ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        ByteString
b <- TVar ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar ByteString
var
        let s :: Status
s = Response -> Status
responseStatus Response
res
            msg :: Text
msg = ByteString -> Request -> Text
fmtReq ByteString
b Request
req' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Status -> Text
fmtStatus Status
s
        if Status -> Bool
statusIsSuccessful Status
s
          then m () -> IO ()
runner (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ $(logDebugS) Text
"Web" Text
msg
          else m () -> IO ()
runner (m () -> IO ()) -> m () -> IO ()
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 (SystemTime -> UTCTime) -> IO SystemTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime
    req_body :: TVar ByteString -> m ByteString -> m ByteString
req_body TVar ByteString
var m ByteString
old_body = do
      ByteString
b <- m ByteString
old_body
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
b) (m () -> m ()) -> (STM () -> m ()) -> STM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar ByteString -> (ByteString -> ByteString) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar ByteString
var (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b)
      ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
    add_stat :: Int64 -> StatDist -> m ()
add_stat Int64
d StatDist
s = do
      StatDist -> m ()
forall (m :: * -> *). MonadIO m => StatDist -> m ()
addStatQuery StatDist
s
      StatDist -> Int64 -> m ()
forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatTime StatDist
s Int64
d
    end :: TVar ByteString -> (m () -> IO ()) -> Request -> UTCTime -> IO ()
end TVar ByteString
var m () -> IO ()
runner Request
req UTCTime
t1 = do
      UTCTime
t2 <- SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> IO SystemTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime
      let diff :: Int64
diff = POSIXTime -> Int64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> POSIXTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> POSIXTime
diffUTCTime UTCTime
t2 UTCTime
t1 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1000
      case Maybe WebMetrics
metrics of
        Maybe WebMetrics
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just WebMetrics
m -> do
          let m_stat_var :: Maybe (TVar (Maybe (WebMetrics -> StatDist)))
m_stat_var = Key (TVar (Maybe (WebMetrics -> StatDist)))
-> Vault -> Maybe (TVar (Maybe (WebMetrics -> StatDist)))
forall a. Key a -> Vault -> Maybe a
V.lookup WebMetrics
m.key (Request -> Vault
vault Request
req)
          Int64 -> StatDist -> IO ()
forall {m :: * -> *}. MonadIO m => Int64 -> StatDist -> m ()
add_stat Int64
diff WebMetrics
m.all
          case Maybe (TVar (Maybe (WebMetrics -> StatDist)))
m_stat_var of
            Maybe (TVar (Maybe (WebMetrics -> StatDist)))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just TVar (Maybe (WebMetrics -> StatDist))
stat_var ->
              TVar (Maybe (WebMetrics -> StatDist))
-> IO (Maybe (WebMetrics -> StatDist))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (WebMetrics -> StatDist))
stat_var IO (Maybe (WebMetrics -> StatDist))
-> (Maybe (WebMetrics -> StatDist) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe (WebMetrics -> StatDist)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just WebMetrics -> StatDist
f -> Int64 -> StatDist -> IO ()
forall {m :: * -> *}. MonadIO m => Int64 -> StatDist -> m ()
add_stat Int64
diff (WebMetrics -> StatDist
f WebMetrics
m)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
diff Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
10000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
b <- TVar ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar ByteString
var
        m () -> IO ()
runner (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$
          $(logWarnS) Text
"Web" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Text
"Slow [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int64 -> String
forall a. Show a => a -> String
show Int64
diff) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ms]: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Request -> Text
fmtReq ByteString
b Request
req

reqSizeLimit :: (Integral i) => i -> Middleware
reqSizeLimit :: 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 = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just (i -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
i))
    lim :: RequestSizeLimitSettings
lim =
      (Word64 -> Middleware)
-> RequestSizeLimitSettings -> RequestSizeLimitSettings
setOnLengthExceeded Word64 -> Middleware
forall {p} {p} {p} {b}. p -> p -> p -> (Response -> b) -> b
too_big (RequestSizeLimitSettings -> RequestSizeLimitSettings)
-> RequestSizeLimitSettings -> RequestSizeLimitSettings
forall a b. (a -> b) -> a -> b
$
        (Request -> IO (Maybe Word64))
-> RequestSizeLimitSettings -> RequestSizeLimitSettings
setMaxLengthForRequest
          Request -> IO (Maybe Word64)
forall {m :: * -> *} {a} {p}. (Monad m, Num a) => p -> m (Maybe a)
max_len
          RequestSizeLimitSettings
defaultRequestSizeLimitSettings
    too_big :: p -> p -> p -> (Response -> b) -> b
too_big p
_ p
_app p
_req Response -> b
send =
      Response -> b
send (Response -> b) -> Response -> b
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 (Int -> Middleware) -> (i -> Int) -> i -> Middleware
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
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] (Except -> ByteString
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
" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
   in ByteString -> Text
T.decodeUtf8 (ByteString
m ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
q ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (HttpVersion -> String
forall a. Show a => a -> String
show HttpVersion
v)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt

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