{-# 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 (..),
    runWeb,
  )
where

import Conduit
  ( ConduitT,
    await,
    concatMapC,
    concatMapMC,
    dropC,
    dropWhileC,
    headC,
    mapC,
    runConduit,
    sinkList,
    takeC,
    takeWhileC,
    yield,
    (.|),
  )
import Control.Applicative ((<|>))
import Control.Lens ((.~), (^.))
import Control.Monad
  ( forM_,
    forever,
    unless,
    when,
    (<=<), void,
  )
import Control.Monad.Logger
  ( MonadLoggerIO,
    logDebugS,
    logErrorS,
  )
import Control.Monad.Reader
  ( MonadReader,
    ReaderT,
    asks,
    local,
    runReaderT,
  )
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Class (MonadTrans)
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.Base16 (decodeBase16, isBase16)
import Data.ByteString.Builder (lazyByteString)
import Data.ByteString.Char8 qualified as C
import Data.ByteString.Lazy qualified as L
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Char (isSpace)
import Data.Default (Default (..))
import Data.Function ((&))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Int (Int64)
import Data.List (nub)
import Data.Maybe
  ( catMaybes,
    fromJust,
    fromMaybe,
    isJust,
    mapMaybe,
    maybeToList,
  )
import Data.Proxy (Proxy (..))
import Data.Serialize (decode)
import Data.String (fromString)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy qualified as TL
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Word (Word32, Word64)
import Database.RocksDB
  ( Property (..),
    getProperty,
  )
import Haskoin.Address
import Haskoin.Block qualified as H
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.WebCommon
import Haskoin.Transaction
import Haskoin.Util
import NQE
  ( Inbox,
    receive,
    withSubscription,
  )
import Network.HTTP.Types
  ( Status (..),
    status400,
    status404,
    status409,
    status413,
    status500,
    status503,
    statusIsClientError,
    statusIsServerError,
    statusIsSuccessful,
  )
import Network.Wai
  ( Middleware,
    Request (..),
    responseStatus,
  )
import Network.Wai.Handler.Warp
  ( defaultSettings,
    setHost,
    setPort,
  )
import Network.Wai.Handler.WebSockets (websocketsOr)
import Network.WebSockets
  ( 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.Metrics.StatsD
import UnliftIO
  ( MonadIO,
    MonadUnliftIO,
    TVar,
    askRunInIO,
    atomically,
    bracket,
    bracket_,
    handleAny,
    liftIO,
    newTVarIO,
    readTVarIO,
    withAsync,
    writeTVar, async,
  )
import UnliftIO.Concurrent (threadDelay)
import Web.Scotty.Trans qualified as S

type ScottyT m = S.ScottyT (ReaderT WebState m)

type ActionT m = S.ActionT (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 -> Word64
txTimeout :: !Word64,
    WebLimits -> Word64
blockTimeout :: !Word64
  }
  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:txTimeout:WebLimits :: Word64
txTimeout = Word64
3600 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2,
        $sel:blockTimeout:WebLimits :: Word64
blockTimeout = Word64
4 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
3600
      }

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 -> String
version :: !String,
    WebConfig -> Bool
noMempool :: !Bool,
    WebConfig -> Maybe Stats
stats :: !(Maybe Stats),
    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
  { -- Addresses
    WebMetrics -> StatTiming
addressTx :: !StatTiming,
    WebMetrics -> StatTiming
addressTxFull :: !StatTiming,
    WebMetrics -> StatTiming
addressBalance :: !StatTiming,
    WebMetrics -> StatTiming
addressUnspent :: !StatTiming,
    WebMetrics -> StatTiming
xpub :: !StatTiming,
    WebMetrics -> StatTiming
xpubDelete :: !StatTiming,
    WebMetrics -> StatTiming
xpubTxFull :: !StatTiming,
    WebMetrics -> StatTiming
xpubTx :: !StatTiming,
    WebMetrics -> StatTiming
xpubBalance :: !StatTiming,
    WebMetrics -> StatTiming
xpubUnspent :: !StatTiming,
    -- Transactions
    WebMetrics -> StatTiming
tx :: !StatTiming,
    WebMetrics -> StatTiming
txRaw :: !StatTiming,
    WebMetrics -> StatTiming
txAfter :: !StatTiming,
    WebMetrics -> StatTiming
txBlock :: !StatTiming,
    WebMetrics -> StatTiming
txBlockRaw :: !StatTiming,
    WebMetrics -> StatTiming
txPost :: !StatTiming,
    WebMetrics -> StatTiming
mempool :: !StatTiming,
    -- Blocks
    WebMetrics -> StatTiming
block :: !StatTiming,
    WebMetrics -> StatTiming
blockRaw :: !StatTiming,
    -- Blockchain
    WebMetrics -> StatTiming
binfoMultiaddr :: !StatTiming,
    WebMetrics -> StatTiming
binfoBalance :: !StatTiming,
    WebMetrics -> StatTiming
binfoAddressRaw :: !StatTiming,
    WebMetrics -> StatTiming
binfoUnspent :: !StatTiming,
    WebMetrics -> StatTiming
binfoTxRaw :: !StatTiming,
    WebMetrics -> StatTiming
binfoBlock :: !StatTiming,
    WebMetrics -> StatTiming
binfoBlockHeight :: !StatTiming,
    WebMetrics -> StatTiming
binfoBlockLatest :: !StatTiming,
    WebMetrics -> StatTiming
binfoBlockRaw :: !StatTiming,
    WebMetrics -> StatTiming
binfoMempool :: !StatTiming,
    WebMetrics -> StatTiming
binfoExportHistory :: !StatTiming,
    -- Blockchain /q endpoints
    WebMetrics -> StatTiming
binfoQaddresstohash :: !StatTiming,
    WebMetrics -> StatTiming
binfoQhashtoaddress :: !StatTiming,
    WebMetrics -> StatTiming
binfoQaddrpubkey :: !StatTiming,
    WebMetrics -> StatTiming
binfoQpubkeyaddr :: !StatTiming,
    WebMetrics -> StatTiming
binfoQhashpubkey :: !StatTiming,
    WebMetrics -> StatTiming
binfoQgetblockcount :: !StatTiming,
    WebMetrics -> StatTiming
binfoQlatesthash :: !StatTiming,
    WebMetrics -> StatTiming
binfoQbcperblock :: !StatTiming,
    WebMetrics -> StatTiming
binfoQtxtotalbtcoutput :: !StatTiming,
    WebMetrics -> StatTiming
binfoQtxtotalbtcinput :: !StatTiming,
    WebMetrics -> StatTiming
binfoQtxfee :: !StatTiming,
    WebMetrics -> StatTiming
binfoQtxresult :: !StatTiming,
    WebMetrics -> StatTiming
binfoQgetreceivedbyaddress :: !StatTiming,
    WebMetrics -> StatTiming
binfoQgetsentbyaddress :: !StatTiming,
    WebMetrics -> StatTiming
binfoQaddressbalance :: !StatTiming,
    WebMetrics -> StatTiming
binfoQaddressfirstseen :: !StatTiming,
    -- Errors
    WebMetrics -> StatCounter
serverErrors :: StatCounter,
    WebMetrics -> StatCounter
clientErrors :: StatCounter,
    -- Others
    WebMetrics -> StatTiming
health :: !StatTiming,
    WebMetrics -> StatTiming
peers :: !StatTiming,
    WebMetrics -> StatTiming
db :: !StatTiming,
    WebMetrics -> StatGauge
events :: !StatGauge
  }

createMetrics :: (MonadIO m) => Stats -> m WebMetrics
createMetrics :: forall (m :: * -> *). MonadIO m => Stats -> m WebMetrics
createMetrics Stats
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
  -- Addresses
  StatTiming
addressTx <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"address_transactions"
  StatTiming
addressTxFull <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"address_transactions_full"
  StatTiming
addressBalance <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"address_balance"
  StatTiming
addressUnspent <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"address_unspent"
  StatTiming
xpub <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"xpub"
  StatTiming
xpubDelete <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"xpub_delete"
  StatTiming
xpubTxFull <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"xpub_transactions_full"
  StatTiming
xpubTx <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"xpub_transactions"
  StatTiming
xpubBalance <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"xpub_balances"
  StatTiming
xpubUnspent <- String -> IO StatTiming
forall {m :: * -> *}. MonadIO m => String -> m StatTiming
d String
"xpub_unspent"

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

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

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

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

  -- Errors
  StatCounter
serverErrors <- String -> IO StatCounter
forall {m :: * -> *}. MonadIO m => String -> m StatCounter
c String
"server_errors"
  StatCounter
clientErrors <- String -> IO StatCounter
forall {m :: * -> *}. MonadIO m => String -> m StatCounter
c String
"client_errors"

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

  StatGauge
events <- String -> IO StatGauge
forall {m :: * -> *}. MonadIO m => String -> m StatGauge
g String
"events_connected"
  WebMetrics -> IO WebMetrics
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WebMetrics {StatTiming
StatGauge
StatCounter
$sel:addressTx:WebMetrics :: StatTiming
$sel:addressTxFull:WebMetrics :: StatTiming
$sel:addressBalance:WebMetrics :: StatTiming
$sel:addressUnspent:WebMetrics :: StatTiming
$sel:xpub:WebMetrics :: StatTiming
$sel:xpubDelete:WebMetrics :: StatTiming
$sel:xpubTxFull:WebMetrics :: StatTiming
$sel:xpubTx:WebMetrics :: StatTiming
$sel:xpubBalance:WebMetrics :: StatTiming
$sel:xpubUnspent:WebMetrics :: StatTiming
$sel:tx:WebMetrics :: StatTiming
$sel:txRaw:WebMetrics :: StatTiming
$sel:txAfter:WebMetrics :: StatTiming
$sel:txBlock:WebMetrics :: StatTiming
$sel:txBlockRaw:WebMetrics :: StatTiming
$sel:txPost:WebMetrics :: StatTiming
$sel:mempool:WebMetrics :: StatTiming
$sel:block:WebMetrics :: StatTiming
$sel:blockRaw:WebMetrics :: StatTiming
$sel:binfoMultiaddr:WebMetrics :: StatTiming
$sel:binfoBalance:WebMetrics :: StatTiming
$sel:binfoAddressRaw:WebMetrics :: StatTiming
$sel:binfoUnspent:WebMetrics :: StatTiming
$sel:binfoTxRaw:WebMetrics :: StatTiming
$sel:binfoBlock:WebMetrics :: StatTiming
$sel:binfoBlockHeight:WebMetrics :: StatTiming
$sel:binfoBlockLatest:WebMetrics :: StatTiming
$sel:binfoBlockRaw:WebMetrics :: StatTiming
$sel:binfoMempool:WebMetrics :: StatTiming
$sel:binfoExportHistory:WebMetrics :: StatTiming
$sel:binfoQaddresstohash:WebMetrics :: StatTiming
$sel:binfoQhashtoaddress:WebMetrics :: StatTiming
$sel:binfoQaddrpubkey:WebMetrics :: StatTiming
$sel:binfoQpubkeyaddr:WebMetrics :: StatTiming
$sel:binfoQhashpubkey:WebMetrics :: StatTiming
$sel:binfoQgetblockcount:WebMetrics :: StatTiming
$sel:binfoQlatesthash:WebMetrics :: StatTiming
$sel:binfoQbcperblock:WebMetrics :: StatTiming
$sel:binfoQtxtotalbtcoutput:WebMetrics :: StatTiming
$sel:binfoQtxtotalbtcinput:WebMetrics :: StatTiming
$sel:binfoQtxfee:WebMetrics :: StatTiming
$sel:binfoQtxresult:WebMetrics :: StatTiming
$sel:binfoQgetreceivedbyaddress:WebMetrics :: StatTiming
$sel:binfoQgetsentbyaddress:WebMetrics :: StatTiming
$sel:binfoQaddressbalance:WebMetrics :: StatTiming
$sel:binfoQaddressfirstseen:WebMetrics :: StatTiming
$sel:serverErrors:WebMetrics :: StatCounter
$sel:clientErrors:WebMetrics :: StatCounter
$sel:health:WebMetrics :: StatTiming
$sel:peers:WebMetrics :: StatTiming
$sel:db:WebMetrics :: StatTiming
$sel:events:WebMetrics :: StatGauge
addressTx :: StatTiming
addressTxFull :: StatTiming
addressBalance :: StatTiming
addressUnspent :: StatTiming
xpub :: StatTiming
xpubDelete :: StatTiming
xpubTxFull :: StatTiming
xpubTx :: StatTiming
xpubBalance :: StatTiming
xpubUnspent :: StatTiming
tx :: StatTiming
txRaw :: StatTiming
txAfter :: StatTiming
txPost :: StatTiming
txBlock :: StatTiming
txBlockRaw :: StatTiming
mempool :: StatTiming
block :: StatTiming
blockRaw :: StatTiming
binfoMultiaddr :: StatTiming
binfoBalance :: StatTiming
binfoAddressRaw :: StatTiming
binfoUnspent :: StatTiming
binfoTxRaw :: StatTiming
binfoBlock :: StatTiming
binfoBlockHeight :: StatTiming
binfoBlockLatest :: StatTiming
binfoBlockRaw :: StatTiming
binfoMempool :: StatTiming
binfoExportHistory :: StatTiming
binfoQaddresstohash :: StatTiming
binfoQhashtoaddress :: StatTiming
binfoQaddrpubkey :: StatTiming
binfoQpubkeyaddr :: StatTiming
binfoQhashpubkey :: StatTiming
binfoQgetblockcount :: StatTiming
binfoQlatesthash :: StatTiming
binfoQbcperblock :: StatTiming
binfoQtxtotalbtcoutput :: StatTiming
binfoQtxtotalbtcinput :: StatTiming
binfoQtxfee :: StatTiming
binfoQtxresult :: StatTiming
binfoQgetreceivedbyaddress :: StatTiming
binfoQgetsentbyaddress :: StatTiming
binfoQaddressbalance :: StatTiming
binfoQaddressfirstseen :: StatTiming
serverErrors :: StatCounter
clientErrors :: StatCounter
health :: StatTiming
peers :: StatTiming
db :: StatTiming
events :: StatGauge
..}
  where
    d :: String -> m StatTiming
d String
x = Stats -> String -> Int -> m StatTiming
forall (m :: * -> *).
MonadIO m =>
Stats -> String -> Int -> m StatTiming
newStatTiming Stats
s (String
"web." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x) Int
10
    g :: String -> m StatGauge
g String
x = Stats -> String -> Int -> m StatGauge
forall (m :: * -> *).
MonadIO m =>
Stats -> String -> Int -> m StatGauge
newStatGauge Stats
s (String
"web." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x) Int
0
    c :: String -> m StatCounter
c String
x = Stats -> String -> Int -> m StatCounter
forall (m :: * -> *).
MonadIO m =>
Stats -> String -> Int -> m StatCounter
newStatCounter Stats
s (String
"web." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x) Int
10

withGaugeIO :: (MonadUnliftIO m) => StatGauge -> m a -> m a
withGaugeIO :: forall (m :: * -> *) a. MonadUnliftIO m => StatGauge -> m a -> m a
withGaugeIO StatGauge
g = m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (StatGauge -> Int -> m ()
forall (m :: * -> *). MonadIO m => StatGauge -> Int -> m ()
incrementGauge StatGauge
g Int
1) (StatGauge -> Int -> m ()
forall (m :: * -> *). MonadIO m => StatGauge -> Int -> m ()
decrementGauge StatGauge
g Int
1)

withGaugeIncrease ::
  (MonadUnliftIO m) =>
  (WebMetrics -> StatGauge) ->
  ActionT m a ->
  ActionT m a
withGaugeIncrease :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatGauge) -> ActionT m a -> ActionT m a
withGaugeIncrease WebMetrics -> StatGauge
gf ActionT m a
go =
  (WebState -> Maybe WebMetrics)
-> ActionT (ReaderT WebState m) (Maybe WebMetrics)
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.metrics) ActionT (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> ActionT m a) -> ActionT m a
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WebMetrics
Nothing -> ActionT m a
go
    Just WebMetrics
m -> do
      a
s <- (Run ActionT -> ReaderT WebState m a) -> ActionT m a
forall (m :: * -> *) a.
Monad m =>
(Run ActionT -> m a) -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run ActionT -> ReaderT WebState m a) -> ActionT m a)
-> (Run ActionT -> ReaderT WebState m a) -> ActionT m a
forall a b. (a -> b) -> a -> b
$ \Run ActionT
run -> StatGauge -> ReaderT WebState m a -> ReaderT WebState m a
forall (m :: * -> *) a. MonadUnliftIO m => StatGauge -> m a -> m a
withGaugeIO (WebMetrics -> StatGauge
gf WebMetrics
m) (ActionT m a -> ReaderT WebState m (StT ActionT a)
Run ActionT
run ActionT m a
go)
      ReaderT WebState m (StT ActionT a) -> ActionT m a
forall (m :: * -> *) a. Monad m => m (StT ActionT a) -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (ReaderT WebState m (StT ActionT a) -> ActionT m a)
-> ReaderT WebState m (StT ActionT a) -> ActionT m a
forall a b. (a -> b) -> a -> b
$ a -> ReaderT WebState m a
forall a. a -> ReaderT WebState m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
s

withMetrics ::
  (MonadUnliftIO m) => (WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics WebMetrics -> StatTiming
df ActionT m a
go =
  (WebState -> Maybe WebMetrics)
-> ActionT (ReaderT WebState m) (Maybe WebMetrics)
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.metrics) ActionT (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> ActionT m a) -> ActionT m a
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WebMetrics
Nothing -> ActionT m a
go
    Just WebMetrics
m ->
      ReaderT WebState m a -> ActionT m a
ReaderT WebState m (StT ActionT a) -> ActionT m a
forall (m :: * -> *) a. Monad m => m (StT ActionT a) -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (ReaderT WebState m a -> ActionT m a)
-> (a -> ReaderT WebState m a) -> a -> ActionT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT WebState m a
forall a. a -> ReaderT WebState m a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (a -> ActionT m a) -> ActionT m a -> ActionT m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Run ActionT -> ReaderT WebState m a) -> ActionT m a
forall (m :: * -> *) a.
Monad m =>
(Run ActionT -> m a) -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run ActionT
run -> ReaderT WebState m Int
-> (Int -> ReaderT WebState m ())
-> (Int -> ReaderT WebState m a)
-> ReaderT WebState m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ReaderT WebState m Int
time (WebMetrics -> Int -> ReaderT WebState m ()
stop WebMetrics
m) (ReaderT WebState m a -> Int -> ReaderT WebState m a
forall a b. a -> b -> a
const (ActionT m a -> ReaderT WebState m (StT ActionT a)
Run ActionT
run ActionT m a
go)))
  where
    time :: ReaderT WebState m Int
time = POSIXTime -> Int
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int) -> (POSIXTime -> POSIXTime) -> POSIXTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1000) (POSIXTime -> Int)
-> ReaderT WebState m POSIXTime -> ReaderT WebState m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime -> ReaderT WebState m POSIXTime
forall a. IO a -> ReaderT WebState m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
    stop :: WebMetrics -> Int -> ReaderT WebState m ()
stop WebMetrics
m Int
t1 = do
      Int
t2 <- ReaderT WebState m Int
time
      let ms :: Int
ms = Int
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t1
      IO () -> ReaderT WebState m ()
forall a. IO a -> ReaderT WebState m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT WebState m ()) -> IO () -> ReaderT WebState m ()
forall a b. (a -> b) -> a -> b
$ StatTiming -> Int -> IO ()
forall (m :: * -> *). MonadIO m => StatTiming -> Int -> m ()
addTiming (WebMetrics -> StatTiming
df WebMetrics
m) Int
ms

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
  (MonadUnliftIO 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) => StoreReadBase (ActionT m) where
  getCtx :: ActionT m Ctx
getCtx = ReaderT WebState m Ctx -> ActionT m Ctx
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 :: ActionT m Network
getNetwork = ReaderT WebState m Network -> ActionT m Network
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 :: ActionT m (Maybe BlockHash)
getBestBlock = ReaderT WebState m (Maybe BlockHash) -> ActionT m (Maybe BlockHash)
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 -> ActionT m [BlockHash]
getBlocksAtHeight = ReaderT WebState m [BlockHash] -> ActionT m [BlockHash]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BlockHash] -> ActionT m [BlockHash])
-> (Word32 -> ReaderT WebState m [BlockHash])
-> Word32
-> ActionT 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 -> ActionT m (Maybe BlockData)
getBlock = ReaderT WebState m (Maybe BlockData) -> ActionT m (Maybe BlockData)
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe BlockData)
 -> ActionT m (Maybe BlockData))
-> (BlockHash -> ReaderT WebState m (Maybe BlockData))
-> BlockHash
-> ActionT 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 -> ActionT m (Maybe TxData)
getTxData = ReaderT WebState m (Maybe TxData) -> ActionT m (Maybe TxData)
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe TxData) -> ActionT m (Maybe TxData))
-> (TxHash -> ReaderT WebState m (Maybe TxData))
-> TxHash
-> ActionT 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 -> ActionT m (Maybe Spender)
getSpender = ReaderT WebState m (Maybe Spender) -> ActionT m (Maybe Spender)
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe Spender) -> ActionT m (Maybe Spender))
-> (OutPoint -> ReaderT WebState m (Maybe Spender))
-> OutPoint
-> ActionT 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 -> ActionT m (Maybe Unspent)
getUnspent = ReaderT WebState m (Maybe Unspent) -> ActionT m (Maybe Unspent)
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe Unspent) -> ActionT m (Maybe Unspent))
-> (OutPoint -> ReaderT WebState m (Maybe Unspent))
-> OutPoint
-> ActionT 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 -> ActionT m (Maybe Balance)
getBalance = ReaderT WebState m (Maybe Balance) -> ActionT m (Maybe Balance)
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (Maybe Balance) -> ActionT m (Maybe Balance))
-> (Address -> ReaderT WebState m (Maybe Balance))
-> Address
-> ActionT 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 :: ActionT m [(Word64, TxHash)]
getMempool = ReaderT WebState m [(Word64, TxHash)]
-> ActionT m [(Word64, TxHash)]
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 (ActionT m) where
  getBalances :: [Address] -> ActionT m [Balance]
getBalances = ReaderT WebState m [Balance] -> ActionT m [Balance]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Balance] -> ActionT m [Balance])
-> ([Address] -> ReaderT WebState m [Balance])
-> [Address]
-> ActionT 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 -> ActionT m [TxRef]
getAddressesTxs [Address]
as = ReaderT WebState m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> ActionT m [TxRef])
-> (Limits -> ReaderT WebState m [TxRef])
-> Limits
-> ActionT 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 -> ActionT m [TxRef]
getAddressTxs Address
a = ReaderT WebState m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> ActionT m [TxRef])
-> (Limits -> ReaderT WebState m [TxRef])
-> Limits
-> ActionT 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 -> ActionT m [Unspent]
getAddressUnspents Address
a = ReaderT WebState m [Unspent] -> ActionT m [Unspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Unspent] -> ActionT m [Unspent])
-> (Limits -> ReaderT WebState m [Unspent])
-> Limits
-> ActionT 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 -> ActionT m [Unspent]
getAddressesUnspents [Address]
as = ReaderT WebState m [Unspent] -> ActionT m [Unspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Unspent] -> ActionT m [Unspent])
-> (Limits -> ReaderT WebState m [Unspent])
-> Limits
-> ActionT 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 -> ActionT m [XPubBal]
xPubBals = ReaderT WebState m [XPubBal] -> ActionT m [XPubBal]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubBal] -> ActionT m [XPubBal])
-> (XPubSpec -> ReaderT WebState m [XPubBal])
-> XPubSpec
-> ActionT 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 -> ActionT m [XPubUnspent]
xPubUnspents XPubSpec
xpub [XPubBal]
xbals = ReaderT WebState m [XPubUnspent] -> ActionT m [XPubUnspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubUnspent] -> ActionT m [XPubUnspent])
-> (Limits -> ReaderT WebState m [XPubUnspent])
-> Limits
-> ActionT 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 -> ActionT m [TxRef]
xPubTxs XPubSpec
xpub [XPubBal]
xbals = ReaderT WebState m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> ActionT m [TxRef])
-> (Limits -> ReaderT WebState m [TxRef])
-> Limits
-> ActionT 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] -> ActionT m Word32
xPubTxCount XPubSpec
xpub = ReaderT WebState m Word32 -> ActionT m Word32
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m Word32 -> ActionT m Word32)
-> ([XPubBal] -> ReaderT WebState m Word32)
-> [XPubBal]
-> ActionT 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 :: ActionT m Word32
getMaxGap = ReaderT WebState m Word32 -> ActionT m Word32
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 :: ActionT m Word32
getInitialGap = ReaderT WebState m Word32 -> ActionT m Word32
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 -> ActionT m [TxData]
getNumTxData = ReaderT WebState m [TxData] -> ActionT m [TxData]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxData] -> ActionT m [TxData])
-> (Word64 -> ReaderT WebState m [TxData])
-> Word64
-> ActionT 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 <- (Stats -> m WebMetrics) -> Maybe Stats -> 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 Stats -> m WebMetrics
forall (m :: * -> *). MonadIO m => Stats -> m WebMetrics
createMetrics WebConfig
config.stats
  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 <- m Middleware
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
m Middleware
logIt
      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 (ReaderT WebState m) ()
-> m ()
forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Options -> (m Response -> IO Response) -> ScottyT 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 (ReaderT WebState m) () -> m ())
-> ScottyT (ReaderT WebState m) () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Middleware -> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *). Middleware -> ScottyT m ()
S.middleware (Middleware -> ScottyT (ReaderT WebState m) ())
-> Middleware -> ScottyT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ WebState -> Middleware
webSocketEvents WebState
state
        Middleware -> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *). Middleware -> ScottyT m ()
S.middleware Middleware
logger
        WebConfig -> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebConfig -> ScottyT (ReaderT WebState m) ()
handlePaths WebConfig
config
        ActionT (ReaderT WebState m) () -> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m () -> ScottyT m ()
S.notFound (ActionT (ReaderT WebState m) ()
 -> ScottyT (ReaderT WebState m) ())
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Except -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> ActionT 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
    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 {S.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 -> ActionT m a
raise :: forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
e = do
  (WebState -> Maybe WebMetrics)
-> ActionT (ReaderT WebState m) (Maybe WebMetrics)
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.metrics) ActionT (ReaderT WebState m) (Maybe WebMetrics)
-> (Maybe WebMetrics -> ActionT (ReaderT WebState m) ())
-> ActionT (ReaderT WebState m) ()
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WebMetrics -> ActionT (ReaderT WebState m) ())
-> Maybe WebMetrics -> ActionT (ReaderT WebState m) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \WebMetrics
m -> do
    IO () -> ActionT (ReaderT WebState m) ()
forall a. IO a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ActionT (ReaderT WebState m) ())
-> IO () -> ActionT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
      (StatCounter -> IO ()) -> Maybe StatCounter -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (StatCounter -> Int -> IO ()
forall (m :: * -> *). MonadIO m => StatCounter -> Int -> m ()
`incrementCounter` Int
1) (Maybe StatCounter -> IO ()) -> Maybe StatCounter -> IO ()
forall a b. (a -> b) -> a -> b
$
        if
          | Status -> Bool
statusIsClientError (Except -> Status
errStatus Except
e) -> StatCounter -> Maybe StatCounter
forall a. a -> Maybe a
Just WebMetrics
m.clientErrors
          | Status -> Bool
statusIsServerError (Except -> Status
errStatus Except
e) -> StatCounter -> Maybe StatCounter
forall a. a -> Maybe a
Just WebMetrics
m.serverErrors
          | Bool
otherwise -> Maybe StatCounter
forall a. Maybe a
Nothing
  ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
  Status -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
S.status (Status -> ActionT (ReaderT WebState m) ())
-> Status -> ActionT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Except -> Status
errStatus Except
e
  Except -> ActionT (ReaderT WebState m) ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
S.json Except
e
  ActionT m a
forall (m :: * -> *) a. Monad m => ActionT m a
S.finish

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

handlePaths ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  WebConfig ->
  S.ScottyT (ReaderT WebState m) ()
handlePaths :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
WebConfig -> ScottyT (ReaderT WebState m) ()
handlePaths WebConfig
cfg = do
  -- Block Paths
  ActionT m GetBlockBest
-> (GetBlockBest -> ActionT m BlockData)
-> (BlockData -> Encoding)
-> (BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (NoTx -> GetBlockBest
GetBlockBest (NoTx -> GetBlockBest)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlockBest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
    GetBlockBest -> ActionT m BlockData
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockBest -> ActionT 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)
  ActionT m GetBlockHeight
-> (GetBlockHeight -> ActionT m (SerialList BlockData))
-> (SerialList BlockData -> Encoding)
-> (SerialList BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (HeightParam -> NoTx -> GetBlockHeight
GetBlockHeight (HeightParam -> NoTx -> GetBlockHeight)
-> ActionT (ReaderT WebState m) HeightParam
-> ActionT (ReaderT WebState m) (NoTx -> GetBlockHeight)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) HeightParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (NoTx -> GetBlockHeight)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlockHeight
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
    (([BlockData] -> SerialList BlockData)
-> ActionT (ReaderT WebState m) [BlockData]
-> ActionT m (SerialList BlockData)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [BlockData]
 -> ActionT m (SerialList BlockData))
-> (GetBlockHeight -> ActionT (ReaderT WebState m) [BlockData])
-> GetBlockHeight
-> ActionT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlockHeight -> ActionT (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockHeight -> ActionT 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))
  ActionT m GetBlockTime
-> (GetBlockTime -> ActionT m BlockData)
-> (BlockData -> Encoding)
-> (BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (TimeParam -> NoTx -> GetBlockTime
GetBlockTime (TimeParam -> NoTx -> GetBlockTime)
-> ActionT (ReaderT WebState m) TimeParam
-> ActionT (ReaderT WebState m) (NoTx -> GetBlockTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (NoTx -> GetBlockTime)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlockTime
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
    GetBlockTime -> ActionT m BlockData
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTime -> ActionT 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)
  ActionT m GetBlockMTP
-> (GetBlockMTP -> ActionT m BlockData)
-> (BlockData -> Encoding)
-> (BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (TimeParam -> NoTx -> GetBlockMTP
GetBlockMTP (TimeParam -> NoTx -> GetBlockMTP)
-> ActionT (ReaderT WebState m) TimeParam
-> ActionT (ReaderT WebState m) (NoTx -> GetBlockMTP)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (NoTx -> GetBlockMTP)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlockMTP
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
    GetBlockMTP -> ActionT m BlockData
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockMTP -> ActionT 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)
  ActionT m GetBlock
-> (GetBlock -> ActionT m BlockData)
-> (BlockData -> Encoding)
-> (BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (BlockHash -> NoTx -> GetBlock
GetBlock (BlockHash -> NoTx -> GetBlock)
-> ActionT (ReaderT WebState m) BlockHash
-> ActionT (ReaderT WebState m) (NoTx -> GetBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (NoTx -> GetBlock)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlock
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
    GetBlock -> ActionT m BlockData
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlock -> ActionT 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)
  ActionT m GetTx
-> (GetTx -> ActionT m Transaction)
-> (Transaction -> Encoding)
-> (Transaction -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (TxHash -> GetTx
GetTx (TxHash -> GetTx)
-> ActionT (ReaderT WebState m) TxHash -> ActionT m GetTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TxHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
    GetTx -> ActionT m Transaction
forall (m :: * -> *).
MonadUnliftIO m =>
GetTx -> ActionT 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)
  ActionT m GetTxRaw
-> (GetTxRaw -> ActionT m (RawResult Tx))
-> (RawResult Tx -> Encoding)
-> (RawResult Tx -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (TxHash -> GetTxRaw
GetTxRaw (TxHash -> GetTxRaw)
-> ActionT (ReaderT WebState m) TxHash -> ActionT m GetTxRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TxHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
    GetTxRaw -> ActionT m (RawResult Tx)
forall (m :: * -> *).
MonadUnliftIO m =>
GetTxRaw -> ActionT m (RawResult Tx)
scottyTxRaw
    RawResult Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    RawResult Tx -> Value
forall a. ToJSON a => a -> Value
toJSON
  ActionT m PostTx
-> (PostTx -> ActionT m TxId)
-> (TxId -> Encoding)
-> (TxId -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (Tx -> PostTx
PostTx (Tx -> PostTx)
-> ActionT (ReaderT WebState m) Tx -> ActionT m PostTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) Tx
forall (m :: * -> *) a. (MonadIO m, Serial a) => ActionT m a
parseBody)
    PostTx -> ActionT m TxId
forall (m :: * -> *). MonadUnliftIO m => PostTx -> ActionT m TxId
scottyPostTx
    TxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    TxId -> Value
forall a. ToJSON a => a -> Value
toJSON
  ActionT m GetMempool
-> (GetMempool -> ActionT m (SerialList TxHash))
-> (SerialList TxHash -> Encoding)
-> (SerialList TxHash -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (Maybe LimitParam -> OffsetParam -> GetMempool
GetMempool (Maybe LimitParam -> OffsetParam -> GetMempool)
-> ActionT (ReaderT WebState m) (Maybe LimitParam)
-> ActionT (ReaderT WebState m) (OffsetParam -> GetMempool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) (Maybe LimitParam)
forall a (m :: * -> *).
(Param a, MonadUnliftIO m) =>
ActionT m (Maybe a)
paramOptional ActionT (ReaderT WebState m) (OffsetParam -> GetMempool)
-> ActionT (ReaderT WebState m) OffsetParam -> ActionT m GetMempool
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) OffsetParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m OffsetParam
parseOffset)
    (([TxHash] -> SerialList TxHash)
-> ActionT (ReaderT WebState m) [TxHash]
-> ActionT m (SerialList TxHash)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [TxHash]
 -> ActionT m (SerialList TxHash))
-> (GetMempool -> ActionT (ReaderT WebState m) [TxHash])
-> GetMempool
-> ActionT m (SerialList TxHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetMempool -> ActionT (ReaderT WebState m) [TxHash]
forall (m :: * -> *).
MonadUnliftIO m =>
GetMempool -> ActionT m [TxHash]
scottyMempool)
    SerialList TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    SerialList TxHash -> Value
forall a. ToJSON a => a -> Value
toJSON
  ActionT m GetAddrTxs
-> (GetAddrTxs -> ActionT m (SerialList TxRef))
-> (SerialList TxRef -> Encoding)
-> (SerialList TxRef -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (Address -> LimitsParam -> GetAddrTxs
GetAddrTxs (Address -> LimitsParam -> GetAddrTxs)
-> ActionT (ReaderT WebState m) Address
-> ActionT (ReaderT WebState m) (LimitsParam -> GetAddrTxs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (LimitsParam -> GetAddrTxs)
-> ActionT (ReaderT WebState m) LimitsParam -> ActionT m GetAddrTxs
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits)
    (([TxRef] -> SerialList TxRef)
-> ActionT (ReaderT WebState m) [TxRef]
-> ActionT m (SerialList TxRef)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [TxRef]
 -> ActionT m (SerialList TxRef))
-> (GetAddrTxs -> ActionT (ReaderT WebState m) [TxRef])
-> GetAddrTxs
-> ActionT m (SerialList TxRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrTxs -> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxs -> ActionT m [TxRef]
scottyAddrTxs)
    SerialList TxRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    SerialList TxRef -> Value
forall a. ToJSON a => a -> Value
toJSON
  ActionT m GetAddrBalance
-> (GetAddrBalance -> ActionT m Balance)
-> (Balance -> Encoding)
-> (Balance -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (Address -> GetAddrBalance
GetAddrBalance (Address -> GetAddrBalance)
-> ActionT (ReaderT WebState m) Address -> ActionT m GetAddrBalance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
    GetAddrBalance -> ActionT m Balance
forall (m :: * -> *).
MonadUnliftIO m =>
GetAddrBalance -> ActionT 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)
  ActionT m GetAddrUnspent
-> (GetAddrUnspent -> ActionT m (SerialList Unspent))
-> (SerialList Unspent -> Encoding)
-> (SerialList Unspent -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (Address -> LimitsParam -> GetAddrUnspent
GetAddrUnspent (Address -> LimitsParam -> GetAddrUnspent)
-> ActionT (ReaderT WebState m) Address
-> ActionT (ReaderT WebState m) (LimitsParam -> GetAddrUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (LimitsParam -> GetAddrUnspent)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT m GetAddrUnspent
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits)
    (([Unspent] -> SerialList Unspent)
-> ActionT (ReaderT WebState m) [Unspent]
-> ActionT m (SerialList Unspent)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Unspent]
 -> ActionT m (SerialList Unspent))
-> (GetAddrUnspent -> ActionT (ReaderT WebState m) [Unspent])
-> GetAddrUnspent
-> ActionT m (SerialList Unspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrUnspent -> ActionT (ReaderT WebState m) [Unspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrUnspent -> ActionT 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))
  ActionT m GetPeers
-> (GetPeers -> ActionT m (SerialList PeerInfo))
-> (SerialList PeerInfo -> Encoding)
-> (SerialList PeerInfo -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (GetPeers
GetPeers GetPeers -> (GetPeers -> ActionT m GetPeers) -> ActionT m GetPeers
forall a b. a -> (a -> b) -> b
& GetPeers -> ActionT m GetPeers
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return)
    (([PeerInfo] -> SerialList PeerInfo)
-> ActionT (ReaderT WebState m) [PeerInfo]
-> ActionT m (SerialList PeerInfo)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [PeerInfo]
 -> ActionT m (SerialList PeerInfo))
-> (GetPeers -> ActionT (ReaderT WebState m) [PeerInfo])
-> GetPeers
-> ActionT m (SerialList PeerInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPeers -> ActionT (ReaderT WebState m) [PeerInfo]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetPeers -> ActionT m [PeerInfo]
scottyPeers)
    SerialList PeerInfo -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    SerialList PeerInfo -> Value
forall a. ToJSON a => a -> Value
toJSON
  ActionT m GetHealth
-> (GetHealth -> ActionT m HealthCheck)
-> (HealthCheck -> Encoding)
-> (HealthCheck -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
    (GetHealth
GetHealth GetHealth
-> (GetHealth -> ActionT m GetHealth) -> ActionT m GetHealth
forall a b. a -> (a -> b) -> b
& GetHealth -> ActionT m GetHealth
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return)
    GetHealth -> ActionT m HealthCheck
forall (m :: * -> *).
MonadUnliftIO m =>
GetHealth -> ActionT m HealthCheck
scottyHealth
    HealthCheck -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
    HealthCheck -> Value
forall a. ToJSON a => a -> Value
toJSON
  RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/events" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyEvents
  RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/dbstats" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyDbStats
  Bool
-> ScottyT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless WebConfig
cfg.noSlow (ScottyT (ReaderT WebState m) ()
 -> ScottyT (ReaderT WebState m) ())
-> ScottyT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ do
    ActionT m GetBlocks
-> (GetBlocks -> ActionT m (SerialList BlockData))
-> (SerialList BlockData -> Encoding)
-> (SerialList BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([BlockHash] -> NoTx -> GetBlocks
GetBlocks ([BlockHash] -> NoTx -> GetBlocks)
-> ActionT (ReaderT WebState m) [BlockHash]
-> ActionT (ReaderT WebState m) (NoTx -> GetBlocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [BlockHash]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired ActionT (ReaderT WebState m) (NoTx -> GetBlocks)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlocks
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([BlockData] -> SerialList BlockData)
-> ActionT (ReaderT WebState m) [BlockData]
-> ActionT m (SerialList BlockData)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [BlockData]
 -> ActionT m (SerialList BlockData))
-> (GetBlocks -> ActionT (ReaderT WebState m) [BlockData])
-> GetBlocks
-> ActionT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlocks -> ActionT (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlocks -> ActionT 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))
    ActionT m GetBlockRaw
-> (GetBlockRaw -> ActionT m (RawResult Block))
-> (RawResult Block -> Encoding)
-> (RawResult Block -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (BlockHash -> GetBlockRaw
GetBlockRaw (BlockHash -> GetBlockRaw)
-> ActionT (ReaderT WebState m) BlockHash -> ActionT m GetBlockRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      GetBlockRaw -> ActionT m (RawResult Block)
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockRaw -> ActionT m (RawResult Block)
scottyBlockRaw
      RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetBlockBestRaw
-> (GetBlockBestRaw -> ActionT m (RawResult Block))
-> (RawResult Block -> Encoding)
-> (RawResult Block -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (GetBlockBestRaw
GetBlockBestRaw GetBlockBestRaw
-> (GetBlockBestRaw -> ActionT m GetBlockBestRaw)
-> ActionT m GetBlockBestRaw
forall a b. a -> (a -> b) -> b
& GetBlockBestRaw -> ActionT m GetBlockBestRaw
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return)
      GetBlockBestRaw -> ActionT m (RawResult Block)
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockBestRaw -> ActionT m (RawResult Block)
scottyBlockBestRaw
      RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetBlockLatest
-> (GetBlockLatest -> ActionT m (SerialList BlockData))
-> (SerialList BlockData -> Encoding)
-> (SerialList BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (NoTx -> GetBlockLatest
GetBlockLatest (NoTx -> GetBlockLatest)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlockLatest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([BlockData] -> SerialList BlockData)
-> ActionT (ReaderT WebState m) [BlockData]
-> ActionT m (SerialList BlockData)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [BlockData]
 -> ActionT m (SerialList BlockData))
-> (GetBlockLatest -> ActionT (ReaderT WebState m) [BlockData])
-> GetBlockLatest
-> ActionT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlockLatest -> ActionT (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockLatest -> ActionT 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))
    ActionT m GetBlockHeights
-> (GetBlockHeights -> ActionT m (SerialList BlockData))
-> (SerialList BlockData -> Encoding)
-> (SerialList BlockData -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (HeightsParam -> NoTx -> GetBlockHeights
GetBlockHeights (HeightsParam -> NoTx -> GetBlockHeights)
-> ActionT (ReaderT WebState m) HeightsParam
-> ActionT (ReaderT WebState m) (NoTx -> GetBlockHeights)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) HeightsParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired ActionT (ReaderT WebState m) (NoTx -> GetBlockHeights)
-> ActionT (ReaderT WebState m) NoTx -> ActionT m GetBlockHeights
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoTx
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([BlockData] -> SerialList BlockData)
-> ActionT (ReaderT WebState m) [BlockData]
-> ActionT m (SerialList BlockData)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [BlockData]
 -> ActionT m (SerialList BlockData))
-> (GetBlockHeights -> ActionT (ReaderT WebState m) [BlockData])
-> GetBlockHeights
-> ActionT m (SerialList BlockData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetBlockHeights -> ActionT (ReaderT WebState m) [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockHeights -> ActionT 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))
    ActionT m GetBlockHeightRaw
-> (GetBlockHeightRaw -> ActionT m (RawResultList Block))
-> (RawResultList Block -> Encoding)
-> (RawResultList Block -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (HeightParam -> GetBlockHeightRaw
GetBlockHeightRaw (HeightParam -> GetBlockHeightRaw)
-> ActionT (ReaderT WebState m) HeightParam
-> ActionT m GetBlockHeightRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) HeightParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      GetBlockHeightRaw -> ActionT m (RawResultList Block)
forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockHeightRaw -> ActionT m (RawResultList Block)
scottyBlockHeightRaw
      RawResultList Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResultList Block -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetBlockTimeRaw
-> (GetBlockTimeRaw -> ActionT m (RawResult Block))
-> (RawResult Block -> Encoding)
-> (RawResult Block -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (TimeParam -> GetBlockTimeRaw
GetBlockTimeRaw (TimeParam -> GetBlockTimeRaw)
-> ActionT (ReaderT WebState m) TimeParam
-> ActionT m GetBlockTimeRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      GetBlockTimeRaw -> ActionT m (RawResult Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTimeRaw -> ActionT m (RawResult Block)
scottyBlockTimeRaw
      RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetBlockMTPRaw
-> (GetBlockMTPRaw -> ActionT m (RawResult Block))
-> (RawResult Block -> Encoding)
-> (RawResult Block -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (TimeParam -> GetBlockMTPRaw
GetBlockMTPRaw (TimeParam -> GetBlockMTPRaw)
-> ActionT (ReaderT WebState m) TimeParam
-> ActionT m GetBlockMTPRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TimeParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      GetBlockMTPRaw -> ActionT m (RawResult Block)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockMTPRaw -> ActionT m (RawResult Block)
scottyBlockMTPRaw
      RawResult Block -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResult Block -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetTxs
-> (GetTxs -> ActionT m (SerialList Transaction))
-> (SerialList Transaction -> Encoding)
-> (SerialList Transaction -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([TxHash] -> GetTxs
GetTxs ([TxHash] -> GetTxs)
-> ActionT (ReaderT WebState m) [TxHash] -> ActionT m GetTxs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [TxHash]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired)
      (([Transaction] -> SerialList Transaction)
-> ActionT (ReaderT WebState m) [Transaction]
-> ActionT m (SerialList Transaction)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Transaction]
 -> ActionT m (SerialList Transaction))
-> (GetTxs -> ActionT (ReaderT WebState m) [Transaction])
-> GetTxs
-> ActionT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetTxs -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
MonadUnliftIO m =>
GetTxs -> ActionT 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))
    ActionT m GetTxsRaw
-> (GetTxsRaw -> ActionT m (RawResultList Tx))
-> (RawResultList Tx -> Encoding)
-> (RawResultList Tx -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([TxHash] -> GetTxsRaw
GetTxsRaw ([TxHash] -> GetTxsRaw)
-> ActionT (ReaderT WebState m) [TxHash] -> ActionT m GetTxsRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [TxHash]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired)
      GetTxsRaw -> ActionT m (RawResultList Tx)
forall (m :: * -> *).
MonadUnliftIO m =>
GetTxsRaw -> ActionT m (RawResultList Tx)
scottyTxsRaw
      RawResultList Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResultList Tx -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetTxsBlock
-> (GetTxsBlock -> ActionT m (SerialList Transaction))
-> (SerialList Transaction -> Encoding)
-> (SerialList Transaction -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (BlockHash -> GetTxsBlock
GetTxsBlock (BlockHash -> GetTxsBlock)
-> ActionT (ReaderT WebState m) BlockHash -> ActionT m GetTxsBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      (([Transaction] -> SerialList Transaction)
-> ActionT (ReaderT WebState m) [Transaction]
-> ActionT m (SerialList Transaction)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Transaction]
 -> ActionT m (SerialList Transaction))
-> (GetTxsBlock -> ActionT (ReaderT WebState m) [Transaction])
-> GetTxsBlock
-> ActionT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetTxsBlock -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
MonadUnliftIO m =>
GetTxsBlock -> ActionT 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))
    ActionT m GetTxsBlockRaw
-> (GetTxsBlockRaw -> ActionT m (RawResultList Tx))
-> (RawResultList Tx -> Encoding)
-> (RawResultList Tx -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (BlockHash -> GetTxsBlockRaw
GetTxsBlockRaw (BlockHash -> GetTxsBlockRaw)
-> ActionT (ReaderT WebState m) BlockHash
-> ActionT m GetTxsBlockRaw
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) BlockHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      GetTxsBlockRaw -> ActionT m (RawResultList Tx)
forall (m :: * -> *).
MonadUnliftIO m =>
GetTxsBlockRaw -> ActionT m (RawResultList Tx)
scottyTxsBlockRaw
      RawResultList Tx -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      RawResultList Tx -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetTxAfter
-> (GetTxAfter -> ActionT m (GenericResult (Maybe Bool)))
-> (GenericResult (Maybe Bool) -> Encoding)
-> (GenericResult (Maybe Bool) -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (TxHash -> HeightParam -> GetTxAfter
GetTxAfter (TxHash -> HeightParam -> GetTxAfter)
-> ActionT (ReaderT WebState m) TxHash
-> ActionT (ReaderT WebState m) (HeightParam -> GetTxAfter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) TxHash
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (HeightParam -> GetTxAfter)
-> ActionT (ReaderT WebState m) HeightParam -> ActionT m GetTxAfter
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) HeightParam
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture)
      GetTxAfter -> ActionT m (GenericResult (Maybe Bool))
forall (m :: * -> *).
MonadUnliftIO m =>
GetTxAfter -> ActionT 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
    ActionT m GetAddrsTxs
-> (GetAddrsTxs -> ActionT m (SerialList TxRef))
-> (SerialList TxRef -> Encoding)
-> (SerialList TxRef -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([Address] -> LimitsParam -> GetAddrsTxs
GetAddrsTxs ([Address] -> LimitsParam -> GetAddrsTxs)
-> ActionT (ReaderT WebState m) [Address]
-> ActionT (ReaderT WebState m) (LimitsParam -> GetAddrsTxs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired ActionT (ReaderT WebState m) (LimitsParam -> GetAddrsTxs)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT m GetAddrsTxs
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits)
      (([TxRef] -> SerialList TxRef)
-> ActionT (ReaderT WebState m) [TxRef]
-> ActionT m (SerialList TxRef)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [TxRef]
 -> ActionT m (SerialList TxRef))
-> (GetAddrsTxs -> ActionT (ReaderT WebState m) [TxRef])
-> GetAddrsTxs
-> ActionT m (SerialList TxRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsTxs -> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsTxs -> ActionT m [TxRef]
scottyAddrsTxs)
      SerialList TxRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      SerialList TxRef -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetAddrTxsFull
-> (GetAddrTxsFull -> ActionT m (SerialList Transaction))
-> (SerialList Transaction -> Encoding)
-> (SerialList Transaction -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (Address -> LimitsParam -> GetAddrTxsFull
GetAddrTxsFull (Address -> LimitsParam -> GetAddrTxsFull)
-> ActionT (ReaderT WebState m) Address
-> ActionT (ReaderT WebState m) (LimitsParam -> GetAddrTxsFull)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) Address
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (LimitsParam -> GetAddrTxsFull)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT m GetAddrTxsFull
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits)
      (([Transaction] -> SerialList Transaction)
-> ActionT (ReaderT WebState m) [Transaction]
-> ActionT m (SerialList Transaction)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Transaction]
 -> ActionT m (SerialList Transaction))
-> (GetAddrTxsFull -> ActionT (ReaderT WebState m) [Transaction])
-> GetAddrTxsFull
-> ActionT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrTxsFull -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxsFull -> ActionT 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))
    ActionT m GetAddrsTxsFull
-> (GetAddrsTxsFull -> ActionT m (SerialList Transaction))
-> (SerialList Transaction -> Encoding)
-> (SerialList Transaction -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([Address] -> LimitsParam -> GetAddrsTxsFull
GetAddrsTxsFull ([Address] -> LimitsParam -> GetAddrsTxsFull)
-> ActionT (ReaderT WebState m) [Address]
-> ActionT (ReaderT WebState m) (LimitsParam -> GetAddrsTxsFull)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired ActionT (ReaderT WebState m) (LimitsParam -> GetAddrsTxsFull)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT m GetAddrsTxsFull
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits)
      (([Transaction] -> SerialList Transaction)
-> ActionT (ReaderT WebState m) [Transaction]
-> ActionT m (SerialList Transaction)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Transaction]
 -> ActionT m (SerialList Transaction))
-> (GetAddrsTxsFull -> ActionT (ReaderT WebState m) [Transaction])
-> GetAddrsTxsFull
-> ActionT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsTxsFull -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsTxsFull -> ActionT 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))
    ActionT m GetAddrsBalance
-> (GetAddrsBalance -> ActionT m (SerialList Balance))
-> (SerialList Balance -> Encoding)
-> (SerialList Balance -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([Address] -> GetAddrsBalance
GetAddrsBalance ([Address] -> GetAddrsBalance)
-> ActionT (ReaderT WebState m) [Address]
-> ActionT m GetAddrsBalance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired)
      (([Balance] -> SerialList Balance)
-> ActionT (ReaderT WebState m) [Balance]
-> ActionT m (SerialList Balance)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Balance]
 -> ActionT m (SerialList Balance))
-> (GetAddrsBalance -> ActionT (ReaderT WebState m) [Balance])
-> GetAddrsBalance
-> ActionT m (SerialList Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsBalance -> ActionT (ReaderT WebState m) [Balance]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsBalance -> ActionT 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))
    ActionT m GetAddrsUnspent
-> (GetAddrsUnspent -> ActionT m (SerialList Unspent))
-> (SerialList Unspent -> Encoding)
-> (SerialList Unspent -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      ([Address] -> LimitsParam -> GetAddrsUnspent
GetAddrsUnspent ([Address] -> LimitsParam -> GetAddrsUnspent)
-> ActionT (ReaderT WebState m) [Address]
-> ActionT (ReaderT WebState m) (LimitsParam -> GetAddrsUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [Address]
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired ActionT (ReaderT WebState m) (LimitsParam -> GetAddrsUnspent)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT m GetAddrsUnspent
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits)
      (([Unspent] -> SerialList Unspent)
-> ActionT (ReaderT WebState m) [Unspent]
-> ActionT m (SerialList Unspent)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Unspent]
 -> ActionT m (SerialList Unspent))
-> (GetAddrsUnspent -> ActionT (ReaderT WebState m) [Unspent])
-> GetAddrsUnspent
-> ActionT m (SerialList Unspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetAddrsUnspent -> ActionT (ReaderT WebState m) [Unspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsUnspent -> ActionT 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))
    ActionT m GetXPub
-> (GetXPub -> ActionT m XPubSummary)
-> (XPubSummary -> Encoding)
-> (XPubSummary -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (XPubKey -> DeriveType -> NoCache -> GetXPub
GetXPub (XPubKey -> DeriveType -> NoCache -> GetXPub)
-> ActionT (ReaderT WebState m) XPubKey
-> ActionT (ReaderT WebState m) (DeriveType -> NoCache -> GetXPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (DeriveType -> NoCache -> GetXPub)
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT (ReaderT WebState m) (NoCache -> GetXPub)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) DeriveType
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef ActionT (ReaderT WebState m) (NoCache -> GetXPub)
-> ActionT (ReaderT WebState m) NoCache -> ActionT m GetXPub
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoCache
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      GetXPub -> ActionT m XPubSummary
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPub -> ActionT m XPubSummary
scottyXPub
      XPubSummary -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      XPubSummary -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetXPubTxs
-> (GetXPubTxs -> ActionT m (SerialList TxRef))
-> (SerialList TxRef -> Encoding)
-> (SerialList TxRef -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxs
GetXPubTxs (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxs)
-> ActionT (ReaderT WebState m) XPubKey
-> ActionT
     (ReaderT WebState m)
     (DeriveType -> LimitsParam -> NoCache -> GetXPubTxs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT
  (ReaderT WebState m)
  (DeriveType -> LimitsParam -> NoCache -> GetXPubTxs)
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT
     (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubTxs)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) DeriveType
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef ActionT (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubTxs)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT (ReaderT WebState m) (NoCache -> GetXPubTxs)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits ActionT (ReaderT WebState m) (NoCache -> GetXPubTxs)
-> ActionT (ReaderT WebState m) NoCache -> ActionT m GetXPubTxs
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoCache
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([TxRef] -> SerialList TxRef)
-> ActionT (ReaderT WebState m) [TxRef]
-> ActionT m (SerialList TxRef)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [TxRef]
 -> ActionT m (SerialList TxRef))
-> (GetXPubTxs -> ActionT (ReaderT WebState m) [TxRef])
-> GetXPubTxs
-> ActionT m (SerialList TxRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubTxs -> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubTxs -> ActionT m [TxRef]
scottyXPubTxs)
      SerialList TxRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding
      SerialList TxRef -> Value
forall a. ToJSON a => a -> Value
toJSON
    ActionT m GetXPubTxsFull
-> (GetXPubTxsFull -> ActionT m (SerialList Transaction))
-> (SerialList Transaction -> Encoding)
-> (SerialList Transaction -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull
GetXPubTxsFull (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull)
-> ActionT (ReaderT WebState m) XPubKey
-> ActionT
     (ReaderT WebState m)
     (DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT
  (ReaderT WebState m)
  (DeriveType -> LimitsParam -> NoCache -> GetXPubTxsFull)
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT
     (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubTxsFull)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) DeriveType
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef ActionT
  (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubTxsFull)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT (ReaderT WebState m) (NoCache -> GetXPubTxsFull)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits ActionT (ReaderT WebState m) (NoCache -> GetXPubTxsFull)
-> ActionT (ReaderT WebState m) NoCache -> ActionT m GetXPubTxsFull
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoCache
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([Transaction] -> SerialList Transaction)
-> ActionT (ReaderT WebState m) [Transaction]
-> ActionT m (SerialList Transaction)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Transaction]
 -> ActionT m (SerialList Transaction))
-> (GetXPubTxsFull -> ActionT (ReaderT WebState m) [Transaction])
-> GetXPubTxsFull
-> ActionT m (SerialList Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubTxsFull -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubTxsFull -> ActionT 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))
    ActionT m GetXPubBalances
-> (GetXPubBalances -> ActionT m (SerialList XPubBal))
-> (SerialList XPubBal -> Encoding)
-> (SerialList XPubBal -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (XPubKey -> DeriveType -> NoCache -> GetXPubBalances
GetXPubBalances (XPubKey -> DeriveType -> NoCache -> GetXPubBalances)
-> ActionT (ReaderT WebState m) XPubKey
-> ActionT
     (ReaderT WebState m) (DeriveType -> NoCache -> GetXPubBalances)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT
  (ReaderT WebState m) (DeriveType -> NoCache -> GetXPubBalances)
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT (ReaderT WebState m) (NoCache -> GetXPubBalances)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) DeriveType
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef ActionT (ReaderT WebState m) (NoCache -> GetXPubBalances)
-> ActionT (ReaderT WebState m) NoCache
-> ActionT m GetXPubBalances
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoCache
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([XPubBal] -> SerialList XPubBal)
-> ActionT (ReaderT WebState m) [XPubBal]
-> ActionT m (SerialList XPubBal)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [XPubBal]
 -> ActionT m (SerialList XPubBal))
-> (GetXPubBalances -> ActionT (ReaderT WebState m) [XPubBal])
-> GetXPubBalances
-> ActionT m (SerialList XPubBal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubBalances -> ActionT (ReaderT WebState m) [XPubBal]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubBalances -> ActionT 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))
    ActionT m GetXPubUnspent
-> (GetXPubUnspent -> ActionT m (SerialList XPubUnspent))
-> (SerialList XPubUnspent -> Encoding)
-> (SerialList XPubUnspent -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent
GetXPubUnspent (XPubKey -> DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent)
-> ActionT (ReaderT WebState m) XPubKey
-> ActionT
     (ReaderT WebState m)
     (DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT
  (ReaderT WebState m)
  (DeriveType -> LimitsParam -> NoCache -> GetXPubUnspent)
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT
     (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubUnspent)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) DeriveType
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef ActionT
  (ReaderT WebState m) (LimitsParam -> NoCache -> GetXPubUnspent)
-> ActionT (ReaderT WebState m) LimitsParam
-> ActionT (ReaderT WebState m) (NoCache -> GetXPubUnspent)
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) LimitsParam
forall (m :: * -> *). MonadUnliftIO m => ActionT m LimitsParam
parseLimits ActionT (ReaderT WebState m) (NoCache -> GetXPubUnspent)
-> ActionT (ReaderT WebState m) NoCache -> ActionT m GetXPubUnspent
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) NoCache
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      (([XPubUnspent] -> SerialList XPubUnspent)
-> ActionT (ReaderT WebState m) [XPubUnspent]
-> ActionT m (SerialList XPubUnspent)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [XPubUnspent]
 -> ActionT m (SerialList XPubUnspent))
-> (GetXPubUnspent -> ActionT (ReaderT WebState m) [XPubUnspent])
-> GetXPubUnspent
-> ActionT m (SerialList XPubUnspent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetXPubUnspent -> ActionT (ReaderT WebState m) [XPubUnspent]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubUnspent -> ActionT 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))
    ActionT m DelCachedXPub
-> (DelCachedXPub -> ActionT m (GenericResult Bool))
-> (GenericResult Bool -> Encoding)
-> (GenericResult Bool -> Value)
-> ScottyT (ReaderT WebState m) ()
forall a b (m :: * -> *).
(ApiResource a b, MonadUnliftIO m) =>
ActionT m a
-> (a -> ActionT m b)
-> (b -> Encoding)
-> (b -> Value)
-> ScottyT (ReaderT WebState m) ()
pathCompact
      (XPubKey -> DeriveType -> DelCachedXPub
DelCachedXPub (XPubKey -> DeriveType -> DelCachedXPub)
-> ActionT (ReaderT WebState m) XPubKey
-> ActionT (ReaderT WebState m) (DeriveType -> DelCachedXPub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) XPubKey
forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture ActionT (ReaderT WebState m) (DeriveType -> DelCachedXPub)
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT m DelCachedXPub
forall a b.
ActionT (ReaderT WebState m) (a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ActionT (ReaderT WebState m) DeriveType
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef)
      DelCachedXPub -> ActionT m (GenericResult Bool)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
DelCachedXPub -> ActionT 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 (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless WebConfig
cfg.noBlockchainInfo (ScottyT (ReaderT WebState m) ()
 -> ScottyT (ReaderT WebState m) ())
-> ScottyT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ do
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.post RoutePattern
"/blockchain/multiaddr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyMultiAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/multiaddr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyMultiAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/balance" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyShortBal
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.post RoutePattern
"/blockchain/balance" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyShortBal
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/rawaddr/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyRawAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/address/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyRawAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/xpub/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyRawAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.post RoutePattern
"/blockchain/unspent" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoUnspent
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/unspent" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoUnspent
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/rawtx/:txid" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTx
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/rawblock/:block" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoBlock
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/latestblock" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoLatest
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/unconfirmed-transactions" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoMempool
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/block-height/:height" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoBlockHeight
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/blocks/:milliseconds" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoBlocksDay
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/export-history" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoHistory
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.post RoutePattern
"/blockchain/export-history" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoHistory
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/addresstohash/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoAddrToHash
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/hashtoaddress/:hash" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoHashToAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/addrpubkey/:pubkey" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoAddrPubkey
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/pubkeyaddr/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoPubKeyAddr
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/hashpubkey/:pubkey" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoHashPubkey
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/getblockcount" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoGetBlockCount
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/latesthash" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoLatestHash
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/bcperblock" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoSubsidy
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/txtotalbtcoutput/:txid" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTotalOut
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/txtotalbtcinput/:txid" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTotalInput
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/txfee/:txid" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTxFees
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/txresult/:txid/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTxResult
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/getreceivedbyaddress/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoReceived
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/getsentbyaddress/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoSent
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/addressbalance/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoAddrBalance
      RoutePattern
-> ActionT (ReaderT WebState m) ()
-> ScottyT (ReaderT WebState m) ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
S.get RoutePattern
"/blockchain/q/addressfirstseen/:addr" ActionT (ReaderT WebState m) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT 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 = WebConfig
cfg.store.net

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

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

streamEncoding :: (MonadIO m) => Encoding -> ActionT m ()
streamEncoding :: forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding Encoding
e = do
  Text -> Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> Text -> ActionT m ()
S.setHeader Text
"Content-Type" Text
"application/json; charset=utf-8"
  ByteString -> ActionT m ()
forall (m :: * -> *). MonadIO m => ByteString -> ActionT 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 = True} (Value -> ByteString) -> (a -> Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
g

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

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

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

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

-- GET Block / GET Blocks --

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

getBlocks ::
  (MonadUnliftIO m) =>
  [H.BlockHash] ->
  Bool ->
  ActionT m [BlockData]
getBlocks :: forall (m :: * -> *).
MonadUnliftIO m =>
[BlockHash] -> Bool -> ActionT 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 (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash] -> ActionT (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 (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) => GetBlocks -> ActionT m [BlockData]
scottyBlocks :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlocks -> ActionT m [BlockData]
scottyBlocks (GetBlocks [BlockHash]
hs (NoTx Bool
notx)) =
  (WebMetrics -> StatTiming)
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.block) (ActionT m [BlockData] -> ActionT m [BlockData])
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall a b. (a -> b) -> a -> b
$
    [BlockHash] -> Bool -> ActionT m [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
[BlockHash] -> Bool -> ActionT m [BlockData]
getBlocks [BlockHash]
hs Bool
notx

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) =>
  GetBlockRaw ->
  ActionT m (RawResult H.Block)
scottyBlockRaw :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockRaw -> ActionT m (RawResult Block)
scottyBlockRaw (GetBlockRaw BlockHash
h) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.blockRaw) (ActionT m (RawResult Block) -> ActionT m (RawResult Block))
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$
    Block -> RawResult Block
forall a. a -> RawResult a
RawResult (Block -> RawResult Block)
-> ActionT (ReaderT WebState m) Block
-> ActionT m (RawResult Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockHash -> ActionT (ReaderT WebState m) Block
forall (m :: * -> *).
MonadUnliftIO m =>
BlockHash -> ActionT m Block
getRawBlock BlockHash
h

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

toRawBlock :: (StoreReadBase m) => BlockData -> m H.Block
toRawBlock :: forall (m :: * -> *). StoreReadBase m => BlockData -> m Block
toRawBlock BlockData
b = do
  [Tx]
txs <- (Transaction -> Tx) -> [Transaction] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Tx
transactionData ([Transaction] -> [Tx])
-> ([Maybe Transaction] -> [Transaction])
-> [Maybe Transaction]
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Tx]) -> m [Maybe Transaction] -> m [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> m (Maybe Transaction))
-> [TxHash] -> 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 -> m (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction BlockData
b.txs
  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}

-- GET BlockBest / BlockBestRaw --

scottyBlockBest ::
  (MonadUnliftIO m) => GetBlockBest -> ActionT m BlockData
scottyBlockBest :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockBest -> ActionT m BlockData
scottyBlockBest (GetBlockBest (NoTx Bool
notx)) =
  (WebMetrics -> StatTiming)
-> ActionT m BlockData -> ActionT m BlockData
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.block) (ActionT m BlockData -> ActionT m BlockData)
-> ActionT m BlockData -> ActionT m BlockData
forall a b. (a -> b) -> a -> b
$
    ActionT m BlockData
-> (BlockData -> ActionT m BlockData)
-> Maybe BlockData
-> ActionT m BlockData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT m BlockData
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound) (BlockData -> ActionT m BlockData
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData -> ActionT m BlockData)
-> (BlockData -> BlockData) -> BlockData -> ActionT m BlockData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BlockData -> BlockData
pruneTx Bool
notx) (Maybe BlockData -> ActionT m BlockData)
-> (MaybeT (ActionT (ReaderT WebState m)) BlockData
    -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
-> ActionT m BlockData
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MaybeT (ActionT (ReaderT WebState m)) BlockData
-> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ActionT (ReaderT WebState m)) BlockData
 -> ActionT m BlockData)
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
-> ActionT m BlockData
forall a b. (a -> b) -> a -> b
$
      ActionT (ReaderT WebState m) (Maybe BlockHash)
-> MaybeT (ActionT (ReaderT WebState m)) BlockHash
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ActionT (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock MaybeT (ActionT (ReaderT WebState m)) BlockHash
-> (BlockHash -> MaybeT (ActionT (ReaderT WebState m)) BlockData)
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
forall a b.
MaybeT (ActionT (ReaderT WebState m)) a
-> (a -> MaybeT (ActionT (ReaderT WebState m)) b)
-> MaybeT (ActionT (ReaderT WebState m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT (ReaderT WebState m) (Maybe BlockData)
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ActionT (ReaderT WebState m) (Maybe BlockData)
 -> MaybeT (ActionT (ReaderT WebState m)) BlockData)
-> (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> BlockHash
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock

scottyBlockBestRaw ::
  (MonadUnliftIO m) =>
  GetBlockBestRaw ->
  ActionT m (RawResult H.Block)
scottyBlockBestRaw :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockBestRaw -> ActionT m (RawResult Block)
scottyBlockBestRaw GetBlockBestRaw
_ =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.blockRaw) (ActionT m (RawResult Block) -> ActionT m (RawResult Block))
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$
    ActionT m (RawResult Block)
-> (Block -> ActionT m (RawResult Block))
-> Maybe Block
-> ActionT m (RawResult Block)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound) (RawResult Block -> ActionT m (RawResult Block)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Block -> ActionT m (RawResult Block))
-> (Block -> RawResult Block)
-> Block
-> ActionT m (RawResult Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> RawResult Block
forall a. a -> RawResult a
RawResult) (Maybe Block -> ActionT m (RawResult Block))
-> (MaybeT (ActionT (ReaderT WebState m)) Block
    -> ActionT (ReaderT WebState m) (Maybe Block))
-> MaybeT (ActionT (ReaderT WebState m)) Block
-> ActionT m (RawResult Block)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< MaybeT (ActionT (ReaderT WebState m)) Block
-> ActionT (ReaderT WebState m) (Maybe Block)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ActionT (ReaderT WebState m)) Block
 -> ActionT m (RawResult Block))
-> MaybeT (ActionT (ReaderT WebState m)) Block
-> ActionT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$
      ActionT (ReaderT WebState m) (Maybe BlockHash)
-> MaybeT (ActionT (ReaderT WebState m)) BlockHash
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ActionT (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock MaybeT (ActionT (ReaderT WebState m)) BlockHash
-> (BlockHash -> MaybeT (ActionT (ReaderT WebState m)) Block)
-> MaybeT (ActionT (ReaderT WebState m)) Block
forall a b.
MaybeT (ActionT (ReaderT WebState m)) a
-> (a -> MaybeT (ActionT (ReaderT WebState m)) b)
-> MaybeT (ActionT (ReaderT WebState m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT (ReaderT WebState m) Block
-> MaybeT (ActionT (ReaderT WebState m)) Block
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 (ReaderT WebState m) Block
 -> MaybeT (ActionT (ReaderT WebState m)) Block)
-> (BlockHash -> ActionT (ReaderT WebState m) Block)
-> BlockHash
-> MaybeT (ActionT (ReaderT WebState m)) Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> ActionT (ReaderT WebState m) Block
forall (m :: * -> *).
MonadUnliftIO m =>
BlockHash -> ActionT m Block
getRawBlock

-- GET BlockLatest --

scottyBlockLatest ::
  (MonadUnliftIO m) =>
  GetBlockLatest ->
  ActionT m [BlockData]
scottyBlockLatest :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockLatest -> ActionT m [BlockData]
scottyBlockLatest (GetBlockLatest (NoTx Bool
noTx)) =
  (WebMetrics -> StatTiming)
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.block) (ActionT m [BlockData] -> ActionT m [BlockData])
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall a b. (a -> b) -> a -> b
$
    ActionT (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash -> ActionT m [BlockData])
-> ActionT m [BlockData]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT m [BlockData]
-> (BlockHash -> ActionT m [BlockData])
-> Maybe BlockHash
-> ActionT m [BlockData]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT m [BlockData]
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound) ([BlockData] -> Maybe BlockData -> ActionT m [BlockData]
forall {m :: * -> *}.
StoreReadBase m =>
[BlockData] -> Maybe BlockData -> m [BlockData]
go [] (Maybe BlockData -> ActionT m [BlockData])
-> (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> BlockHash
-> ActionT m [BlockData]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock)
  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) => GetBlockHeight -> ActionT m [BlockData]
scottyBlockHeight :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockHeight -> ActionT m [BlockData]
scottyBlockHeight (GetBlockHeight HeightParam
h (NoTx Bool
notx)) =
  (WebMetrics -> StatTiming)
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.block) (ActionT m [BlockData] -> ActionT m [BlockData])
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall a b. (a -> b) -> a -> b
$
    Word32 -> ActionT (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)
      ActionT (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> ActionT m [BlockData]) -> ActionT m [BlockData]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([BlockHash] -> Bool -> ActionT m [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
[BlockHash] -> Bool -> ActionT m [BlockData]
`getBlocks` Bool
notx)

scottyBlockHeights ::
  (MonadUnliftIO m) =>
  GetBlockHeights ->
  ActionT m [BlockData]
scottyBlockHeights :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockHeights -> ActionT m [BlockData]
scottyBlockHeights (GetBlockHeights (HeightsParam [Natural]
heights) (NoTx Bool
notx)) =
  (WebMetrics -> StatTiming)
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.block) (ActionT m [BlockData] -> ActionT m [BlockData])
-> ActionT m [BlockData] -> ActionT m [BlockData]
forall a b. (a -> b) -> a -> b
$
    (Natural -> ActionT (ReaderT WebState m) [BlockHash])
-> [Natural] -> ActionT (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 (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (Word32 -> ActionT (ReaderT WebState m) [BlockHash])
-> (Natural -> Word32)
-> Natural
-> ActionT (ReaderT WebState m) [BlockHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Natural]
heights
      ActionT (ReaderT WebState m) [[BlockHash]]
-> ([[BlockHash]] -> ActionT m [BlockData])
-> ActionT m [BlockData]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([BlockHash] -> Bool -> ActionT m [BlockData]
forall (m :: * -> *).
MonadUnliftIO m =>
[BlockHash] -> Bool -> ActionT m [BlockData]
`getBlocks` Bool
notx) ([BlockHash] -> ActionT m [BlockData])
-> ([[BlockHash]] -> [BlockHash])
-> [[BlockHash]]
-> ActionT m [BlockData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[BlockHash]] -> [BlockHash]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

scottyBlockHeightRaw ::
  (MonadUnliftIO m) =>
  GetBlockHeightRaw ->
  ActionT m (RawResultList H.Block)
scottyBlockHeightRaw :: forall (m :: * -> *).
MonadUnliftIO m =>
GetBlockHeightRaw -> ActionT m (RawResultList Block)
scottyBlockHeightRaw (GetBlockHeightRaw HeightParam
h) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResultList Block)
-> ActionT m (RawResultList Block)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.blockRaw) (ActionT m (RawResultList Block)
 -> ActionT m (RawResultList Block))
-> ActionT m (RawResultList Block)
-> ActionT m (RawResultList Block)
forall a b. (a -> b) -> a -> b
$
    ([Block] -> RawResultList Block)
-> ActionT (ReaderT WebState m) [Block]
-> ActionT m (RawResultList Block)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Block] -> RawResultList Block
forall a. [a] -> RawResultList a
RawResultList (ActionT (ReaderT WebState m) [Block]
 -> ActionT m (RawResultList Block))
-> ActionT (ReaderT WebState m) [Block]
-> ActionT m (RawResultList Block)
forall a b. (a -> b) -> a -> b
$
      (BlockHash -> ActionT (ReaderT WebState m) Block)
-> [BlockHash] -> ActionT (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 (ReaderT WebState m) Block
forall (m :: * -> *).
MonadUnliftIO m =>
BlockHash -> ActionT m Block
getRawBlock ([BlockHash] -> ActionT (ReaderT WebState m) [Block])
-> ActionT (ReaderT WebState m) [BlockHash]
-> ActionT (ReaderT WebState m) [Block]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Word32 -> ActionT (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)

-- GET BlockTime / BlockTimeRaw --

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

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

scottyBlockTimeRaw ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetBlockTimeRaw ->
  ActionT m (RawResult H.Block)
scottyBlockTimeRaw :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockTimeRaw -> ActionT m (RawResult Block)
scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam Word64
t)) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.blockRaw) (ActionT m (RawResult Block) -> ActionT m (RawResult Block))
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ do
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    Chain -> Word64 -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
t ActionT (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> ActionT m (RawResult Block))
-> ActionT m (RawResult Block)
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe BlockData
Nothing -> Except -> ActionT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
      Just BlockData
b -> Block -> RawResult Block
forall a. a -> RawResult a
RawResult (Block -> RawResult Block)
-> ActionT (ReaderT WebState m) Block
-> ActionT m (RawResult Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m Block -> ActionT (ReaderT WebState m) Block
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BlockData -> ReaderT WebState m Block
forall (m :: * -> *). StoreReadBase m => BlockData -> m Block
toRawBlock BlockData
b)

scottyBlockMTPRaw ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetBlockMTPRaw ->
  ActionT m (RawResult H.Block)
scottyBlockMTPRaw :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetBlockMTPRaw -> ActionT m (RawResult Block)
scottyBlockMTPRaw (GetBlockMTPRaw (TimeParam Word64
t)) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.blockRaw) (ActionT m (RawResult Block) -> ActionT m (RawResult Block))
-> ActionT m (RawResult Block) -> ActionT m (RawResult Block)
forall a b. (a -> b) -> a -> b
$ do
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    Chain -> Word64 -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrAfterMTP Chain
ch Word64
t ActionT (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> ActionT m (RawResult Block))
-> ActionT m (RawResult Block)
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe BlockData
Nothing -> Except -> ActionT m (RawResult Block)
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
      Just BlockData
b -> Block -> RawResult Block
forall a. a -> RawResult a
RawResult (Block -> RawResult Block)
-> ActionT (ReaderT WebState m) Block
-> ActionT m (RawResult Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m Block -> ActionT (ReaderT WebState m) Block
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (BlockData -> ReaderT WebState m Block
forall (m :: * -> *). StoreReadBase m => BlockData -> m Block
toRawBlock BlockData
b)

-- GET Transactions --

scottyTx :: (MonadUnliftIO m) => GetTx -> ActionT m Transaction
scottyTx :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTx -> ActionT m Transaction
scottyTx (GetTx TxHash
txid) =
  (WebMetrics -> StatTiming)
-> ActionT m Transaction -> ActionT m Transaction
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.tx) (ActionT m Transaction -> ActionT m Transaction)
-> ActionT m Transaction -> ActionT m Transaction
forall a b. (a -> b) -> a -> b
$
    TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
txid ActionT (ReaderT WebState m) (Maybe Transaction)
-> (Maybe Transaction -> ActionT m Transaction)
-> ActionT m Transaction
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT m Transaction
-> (Transaction -> ActionT m Transaction)
-> Maybe Transaction
-> ActionT m Transaction
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT m Transaction
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound) Transaction -> ActionT m Transaction
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return

scottyTxs ::
  (MonadUnliftIO m) => GetTxs -> ActionT m [Transaction]
scottyTxs :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTxs -> ActionT m [Transaction]
scottyTxs (GetTxs [TxHash]
txids) =
  (WebMetrics -> StatTiming)
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.tx) (ActionT m [Transaction] -> ActionT m [Transaction])
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall a b. (a -> b) -> a -> b
$
    [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxHash] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction ([TxHash] -> [TxHash]
forall a. Eq a => [a] -> [a]
nub [TxHash]
txids)

scottyTxRaw ::
  (MonadUnliftIO m) => GetTxRaw -> ActionT m (RawResult Tx)
scottyTxRaw :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTxRaw -> ActionT m (RawResult Tx)
scottyTxRaw (GetTxRaw TxHash
txid) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResult Tx) -> ActionT m (RawResult Tx)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.txRaw) (ActionT m (RawResult Tx) -> ActionT m (RawResult Tx))
-> ActionT m (RawResult Tx) -> ActionT m (RawResult Tx)
forall a b. (a -> b) -> a -> b
$
    TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
txid
      ActionT (ReaderT WebState m) (Maybe Transaction)
-> (Maybe Transaction -> ActionT m (RawResult Tx))
-> ActionT m (RawResult Tx)
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Transaction
Nothing -> Except -> ActionT m (RawResult Tx)
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
        Just Transaction
tx -> RawResult Tx -> ActionT m (RawResult Tx)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult Tx -> ActionT m (RawResult Tx))
-> RawResult Tx -> ActionT 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) =>
  GetTxsRaw ->
  ActionT m (RawResultList Tx)
scottyTxsRaw :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTxsRaw -> ActionT m (RawResultList Tx)
scottyTxsRaw (GetTxsRaw [TxHash]
txids) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResultList Tx) -> ActionT m (RawResultList Tx)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.txRaw) (ActionT m (RawResultList Tx) -> ActionT m (RawResultList Tx))
-> ActionT m (RawResultList Tx) -> ActionT m (RawResultList Tx)
forall a b. (a -> b) -> a -> b
$
    [Tx] -> RawResultList Tx
forall a. [a] -> RawResultList a
RawResultList ([Tx] -> RawResultList Tx)
-> ([Maybe Transaction] -> [Tx])
-> [Maybe Transaction]
-> RawResultList Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Tx) -> [Transaction] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Tx
transactionData ([Transaction] -> [Tx])
-> ([Maybe Transaction] -> [Transaction])
-> [Maybe Transaction]
-> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes
      ([Maybe Transaction] -> RawResultList Tx)
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT m (RawResultList Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxHash] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction ([TxHash] -> [TxHash]
forall a. Eq a => [a] -> [a]
nub [TxHash]
txids)

getTxsBlock ::
  (MonadUnliftIO m) =>
  H.BlockHash ->
  ActionT m [Transaction]
getTxsBlock :: forall (m :: * -> *).
MonadUnliftIO m =>
BlockHash -> ActionT m [Transaction]
getTxsBlock BlockHash
h =
  BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h ActionT (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> ActionT (ReaderT WebState m) [Transaction])
-> ActionT (ReaderT WebState m) [Transaction]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe BlockData
Nothing -> Except -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
    Just BlockData
b -> [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxHash] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction BlockData
b.txs

scottyTxsBlock ::
  (MonadUnliftIO m) =>
  GetTxsBlock ->
  ActionT m [Transaction]
scottyTxsBlock :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTxsBlock -> ActionT m [Transaction]
scottyTxsBlock (GetTxsBlock BlockHash
h) =
  (WebMetrics -> StatTiming)
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.txBlock) (ActionT m [Transaction] -> ActionT m [Transaction])
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall a b. (a -> b) -> a -> b
$ BlockHash -> ActionT m [Transaction]
forall (m :: * -> *).
MonadUnliftIO m =>
BlockHash -> ActionT m [Transaction]
getTxsBlock BlockHash
h

scottyTxsBlockRaw ::
  (MonadUnliftIO m) =>
  GetTxsBlockRaw ->
  ActionT m (RawResultList Tx)
scottyTxsBlockRaw :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTxsBlockRaw -> ActionT m (RawResultList Tx)
scottyTxsBlockRaw (GetTxsBlockRaw BlockHash
h) =
  (WebMetrics -> StatTiming)
-> ActionT m (RawResultList Tx) -> ActionT m (RawResultList Tx)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.txBlockRaw) (ActionT m (RawResultList Tx) -> ActionT m (RawResultList Tx))
-> ActionT m (RawResultList Tx) -> ActionT m (RawResultList Tx)
forall a b. (a -> b) -> a -> b
$
    [Tx] -> RawResultList Tx
forall a. [a] -> RawResultList a
RawResultList ([Tx] -> RawResultList Tx)
-> ([Transaction] -> [Tx]) -> [Transaction] -> RawResultList Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Tx) -> [Transaction] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Tx
transactionData ([Transaction] -> RawResultList Tx)
-> ActionT (ReaderT WebState m) [Transaction]
-> ActionT m (RawResultList Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockHash -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *).
MonadUnliftIO m =>
BlockHash -> ActionT m [Transaction]
getTxsBlock BlockHash
h

-- GET TransactionAfterHeight --

scottyTxAfter ::
  (MonadUnliftIO m) =>
  GetTxAfter ->
  ActionT m (GenericResult (Maybe Bool))
scottyTxAfter :: forall (m :: * -> *).
MonadUnliftIO m =>
GetTxAfter -> ActionT m (GenericResult (Maybe Bool))
scottyTxAfter (GetTxAfter TxHash
txid HeightParam
height) =
  (WebMetrics -> StatTiming)
-> ActionT m (GenericResult (Maybe Bool))
-> ActionT m (GenericResult (Maybe Bool))
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.txAfter) (ActionT m (GenericResult (Maybe Bool))
 -> ActionT m (GenericResult (Maybe Bool)))
-> ActionT m (GenericResult (Maybe Bool))
-> ActionT m (GenericResult (Maybe Bool))
forall a b. (a -> b) -> a -> b
$
    Maybe Bool -> GenericResult (Maybe Bool)
forall a. a -> GenericResult a
GenericResult (Maybe Bool -> GenericResult (Maybe Bool))
-> ((Maybe Bool, Int) -> Maybe Bool)
-> (Maybe Bool, Int)
-> GenericResult (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool, Int) -> Maybe Bool
forall a b. (a, b) -> a
fst ((Maybe Bool, Int) -> GenericResult (Maybe Bool))
-> ActionT (ReaderT WebState m) (Maybe Bool, Int)
-> ActionT m (GenericResult (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> TxHash -> ActionT (ReaderT WebState m) (Maybe Bool, Int)
forall (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

-- | 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 ::
  (StoreReadBase m) =>
  H.BlockHeight ->
  TxHash ->
  m (Maybe Bool, Int)
cbAfterHeight :: forall (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 => 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 :: * -> *).
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 => 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) => PostTx -> ActionT m TxId
scottyPostTx :: forall (m :: * -> *). MonadUnliftIO m => PostTx -> ActionT m TxId
scottyPostTx (PostTx Tx
tx) =
  (WebMetrics -> StatTiming) -> ActionT m TxId -> ActionT m TxId
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.txPost) (ActionT m TxId -> ActionT m TxId)
-> ActionT m TxId -> ActionT m TxId
forall a b. (a -> b) -> a -> b
$ do
    WebConfig
cfg <- (WebState -> WebConfig) -> ActionT (ReaderT WebState m) WebConfig
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config)
    ReaderT WebState m () -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WebConfig -> Tx -> ReaderT WebState m ()
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
WebConfig -> Tx -> m ()
publishTx WebConfig
cfg Tx
tx)
    TxId -> ActionT m TxId
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxHash -> TxId
TxId (Tx -> TxHash
txHash Tx
tx))

-- | Send transaction to all connected peers.
publishTx ::
  (MonadUnliftIO m, StoreReadBase m) =>
  WebConfig ->
  Tx ->
  m ()
publishTx :: forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
WebConfig -> Tx -> m ()
publishTx WebConfig
cfg Tx
tx = do
  [OnlinePeer]
ps <- PeerMgr -> m [OnlinePeer]
forall (m :: * -> *). MonadIO m => PeerMgr -> m [OnlinePeer]
getPeers WebConfig
cfg.store.peerMgr
  let c :: Int
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([OnlinePeer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OnlinePeer]
ps Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
  [OnlinePeer] -> (OnlinePeer -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [OnlinePeer] -> [OnlinePeer]
forall a. Int -> [a] -> [a]
take Int
c [OnlinePeer]
ps) ((OnlinePeer -> m ()) -> m ()) -> (OnlinePeer -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OnlinePeer
p -> do
    Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
sendMessage (Tx -> Message
MTx Tx
tx) OnlinePeer
p.mailbox
    m (Async ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async ()) -> m ()) -> (m () -> m (Async ())) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (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)
      let v :: InvType
v = if WebConfig
cfg.store.net.segWit then InvType
InvWitnessTx else InvType
InvTx
          g :: Message
g = GetData -> Message
MGetData ([InvVector] -> GetData
GetData [InvType -> Hash256 -> InvVector
InvVector InvType
v (Tx -> TxHash
txHash Tx
tx).get])
      Message -> Peer -> m ()
forall (m :: * -> *). MonadIO m => Message -> Peer -> m ()
sendMessage Message
g OnlinePeer
p.mailbox

-- GET Mempool / Events --

scottyMempool ::
  (MonadUnliftIO m) => GetMempool -> ActionT m [TxHash]
scottyMempool :: forall (m :: * -> *).
MonadUnliftIO m =>
GetMempool -> ActionT m [TxHash]
scottyMempool (GetMempool Maybe LimitParam
limitM (OffsetParam Natural
o)) =
  (WebMetrics -> StatTiming)
-> ActionT m [TxHash] -> ActionT m [TxHash]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.mempool) (ActionT m [TxHash] -> ActionT m [TxHash])
-> ActionT m [TxHash] -> ActionT m [TxHash]
forall a b. (a -> b) -> a -> b
$ do
    WebLimits {Word32
Word64
$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:txTimeout:WebLimits :: WebLimits -> Word64
$sel:blockTimeout:WebLimits :: WebLimits -> Word64
maxItemCount :: Word32
maxFullItemCount :: Word32
maxOffset :: Word32
defItemCount :: Word32
xpubGap :: Word32
xpubGapInit :: Word32
txTimeout :: Word64
blockTimeout :: Word64
..} <- (WebState -> WebLimits) -> ActionT (ReaderT WebState m) WebLimits
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.limits)
    let wl' :: WebLimits
wl' = WebLimits {$sel:maxItemCount:WebLimits :: Word32
maxItemCount = Word32
0, Word32
Word64
$sel:maxFullItemCount:WebLimits :: Word32
$sel:maxOffset:WebLimits :: Word32
$sel:defItemCount:WebLimits :: Word32
$sel:xpubGap:WebLimits :: Word32
$sel:xpubGapInit:WebLimits :: Word32
$sel:txTimeout:WebLimits :: Word64
$sel:blockTimeout:WebLimits :: Word64
maxFullItemCount :: Word32
maxOffset :: Word32
defItemCount :: Word32
xpubGap :: Word32
xpubGapInit :: Word32
txTimeout :: Word64
blockTimeout :: Word64
..}
        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
    ((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 (ReaderT WebState m) [(Word64, TxHash)]
-> ActionT m [TxHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) [(Word64, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(Word64, TxHash)]
getMempool

webSocketEvents :: WebState -> Middleware
webSocketEvents :: WebState -> Middleware
webSocketEvents WebState
s =
  ConnectionOptions -> ServerApp -> Middleware
websocketsOr ConnectionOptions
defaultConnectionOptions (IO () -> IO ()
forall {m :: * -> *} {a}. MonadUnliftIO m => m a -> m a
wrap (IO () -> IO ()) -> ServerApp -> ServerApp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerApp
events)
  where
    pub :: Publisher StoreEvent
pub = WebState
s.config.store.pub
    gauge :: Maybe StatGauge
gauge = (.events) (WebMetrics -> StatGauge) -> Maybe WebMetrics -> Maybe StatGauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebState
s.metrics
    wrap :: m a -> m a
wrap m a
f = case Maybe StatGauge
gauge of
      Maybe StatGauge
Nothing -> m a
f
      Just StatGauge
g -> StatGauge -> m a -> m a
forall (m :: * -> *) a. MonadUnliftIO m => StatGauge -> m a -> m a
withGaugeIO StatGauge
g m a
f
    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
              { WebSockets.rejectBody =
                  L.toStrict $ A.encode ThingNotFound,
                WebSockets.rejectCode =
                  404,
                WebSockets.rejectMessage =
                  "Not Found",
                WebSockets.rejectHeaders =
                  [("Content-Type", "application/json")]
              }

scottyEvents :: (MonadUnliftIO m) => ActionT m ()
scottyEvents :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyEvents =
  (WebMetrics -> StatGauge) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatGauge) -> ActionT m a -> ActionT m a
withGaugeIncrease (.events) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    SerialAs
proto <- Bool -> ActionT (ReaderT WebState m) SerialAs
forall (m :: * -> *). MonadUnliftIO m => Bool -> ActionT m SerialAs
setupContentType Bool
False
    Publisher StoreEvent
pub <- (WebState -> Publisher StoreEvent)
-> ActionT (ReaderT WebState m) (Publisher StoreEvent)
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.pub)
    StreamingBody -> ActionT m ()
forall (m :: * -> *). MonadIO m => StreamingBody -> ActionT m ()
S.stream (StreamingBody -> ActionT m ()) -> StreamingBody -> ActionT 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 -> ActionT m [TxRef]
scottyAddrTxs :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxs -> ActionT m [TxRef]
scottyAddrTxs (GetAddrTxs Address
addr LimitsParam
pLimits) =
  (WebMetrics -> StatTiming)
-> ActionT m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressTx) (ActionT m [TxRef] -> ActionT m [TxRef])
-> ActionT m [TxRef] -> ActionT m [TxRef]
forall a b. (a -> b) -> a -> b
$
    Address -> Limits -> ActionT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr (Limits -> ActionT m [TxRef])
-> ActionT (ReaderT WebState m) Limits -> ActionT m [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
False LimitsParam
pLimits

scottyAddrsTxs ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsTxs -> ActionT m [TxRef]
scottyAddrsTxs :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsTxs -> ActionT m [TxRef]
scottyAddrsTxs (GetAddrsTxs [Address]
addrs LimitsParam
pLimits) =
  (WebMetrics -> StatTiming)
-> ActionT m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressTx) (ActionT m [TxRef] -> ActionT m [TxRef])
-> ActionT m [TxRef] -> ActionT m [TxRef]
forall a b. (a -> b) -> a -> b
$
    [Address] -> Limits -> ActionT m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs (Limits -> ActionT m [TxRef])
-> ActionT (ReaderT WebState m) Limits -> ActionT m [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
False LimitsParam
pLimits

scottyAddrTxsFull ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetAddrTxsFull ->
  ActionT m [Transaction]
scottyAddrTxsFull :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrTxsFull -> ActionT m [Transaction]
scottyAddrTxsFull (GetAddrTxsFull Address
addr LimitsParam
pLimits) =
  (WebMetrics -> StatTiming)
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressTxFull) (ActionT m [Transaction] -> ActionT m [Transaction])
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall a b. (a -> b) -> a -> b
$ do
    [TxRef]
txs <- Address -> Limits -> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr (Limits -> ActionT (ReaderT WebState m) [TxRef])
-> ActionT (ReaderT WebState m) Limits
-> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
True LimitsParam
pLimits
    [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxRef -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxRef] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ActionT (ReaderT WebState m) (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txid)) [TxRef]
txs

scottyAddrsTxsFull ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetAddrsTxsFull ->
  ActionT m [Transaction]
scottyAddrsTxsFull :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsTxsFull -> ActionT m [Transaction]
scottyAddrsTxsFull (GetAddrsTxsFull [Address]
addrs LimitsParam
pLimits) =
  (WebMetrics -> StatTiming)
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressTxFull) (ActionT m [Transaction] -> ActionT m [Transaction])
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall a b. (a -> b) -> a -> b
$ do
    [TxRef]
txs <- [Address] -> Limits -> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [TxRef]
getAddressesTxs [Address]
addrs (Limits -> ActionT (ReaderT WebState m) [TxRef])
-> ActionT (ReaderT WebState m) Limits
-> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
True LimitsParam
pLimits
    [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxRef -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxRef] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> (TxRef -> TxHash)
-> TxRef
-> ActionT (ReaderT WebState m) (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txid)) [TxRef]
txs

scottyAddrBalance :: (MonadUnliftIO m) => GetAddrBalance -> ActionT m Balance
scottyAddrBalance :: forall (m :: * -> *).
MonadUnliftIO m =>
GetAddrBalance -> ActionT m Balance
scottyAddrBalance (GetAddrBalance Address
addr) =
  (WebMetrics -> StatTiming)
-> ActionT m Balance -> ActionT m Balance
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressBalance) (ActionT m Balance -> ActionT m Balance)
-> ActionT m Balance -> ActionT m Balance
forall a b. (a -> b) -> a -> b
$ Address -> ActionT m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
addr

scottyAddrsBalance ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsBalance -> ActionT m [Balance]
scottyAddrsBalance :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsBalance -> ActionT m [Balance]
scottyAddrsBalance (GetAddrsBalance [Address]
addrs) =
  (WebMetrics -> StatTiming)
-> ActionT m [Balance] -> ActionT m [Balance]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressBalance) (ActionT m [Balance] -> ActionT m [Balance])
-> ActionT m [Balance] -> ActionT m [Balance]
forall a b. (a -> b) -> a -> b
$ [Address] -> ActionT m [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances [Address]
addrs

scottyAddrUnspent ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrUnspent -> ActionT m [Unspent]
scottyAddrUnspent :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrUnspent -> ActionT m [Unspent]
scottyAddrUnspent (GetAddrUnspent Address
addr LimitsParam
pLimits) =
  (WebMetrics -> StatTiming)
-> ActionT m [Unspent] -> ActionT m [Unspent]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressUnspent) (ActionT m [Unspent] -> ActionT m [Unspent])
-> ActionT m [Unspent] -> ActionT m [Unspent]
forall a b. (a -> b) -> a -> b
$
    Address -> Limits -> ActionT m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents Address
addr (Limits -> ActionT m [Unspent])
-> ActionT (ReaderT WebState m) Limits -> ActionT m [Unspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
False LimitsParam
pLimits

scottyAddrsUnspent ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsUnspent -> ActionT m [Unspent]
scottyAddrsUnspent :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetAddrsUnspent -> ActionT m [Unspent]
scottyAddrsUnspent (GetAddrsUnspent [Address]
addrs LimitsParam
pLimits) =
  (WebMetrics -> StatTiming)
-> ActionT m [Unspent] -> ActionT m [Unspent]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.addressUnspent) (ActionT m [Unspent] -> ActionT m [Unspent])
-> ActionT m [Unspent] -> ActionT m [Unspent]
forall a b. (a -> b) -> a -> b
$
    [Address] -> Limits -> ActionT m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
[Address] -> Limits -> m [Unspent]
getAddressesUnspents [Address]
addrs (Limits -> ActionT m [Unspent])
-> ActionT (ReaderT WebState m) Limits -> ActionT m [Unspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> LimitsParam -> ActionT (ReaderT WebState m) Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
False LimitsParam
pLimits

-- GET XPubs --

scottyXPub ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetXPub -> ActionT m XPubSummary
scottyXPub :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPub -> ActionT m XPubSummary
scottyXPub (GetXPub XPubKey
xpub DeriveType
deriv (NoCache Bool
noCache)) =
  (WebMetrics -> StatTiming)
-> ActionT m XPubSummary -> ActionT m XPubSummary
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.xpub) (ActionT m XPubSummary -> ActionT m XPubSummary)
-> ActionT m XPubSummary -> ActionT m XPubSummary
forall a b. (a -> b) -> a -> b
$
    let xs :: XPubSpec
xs = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
     in XPubSpec -> [XPubBal] -> XPubSummary
xPubSummary XPubSpec
xs ([XPubBal] -> XPubSummary)
-> ActionT (ReaderT WebState m) [XPubBal] -> ActionT m XPubSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m [XPubBal]
-> ActionT (ReaderT WebState m) [XPubBal]
forall (m :: * -> *) a. Monad m => m a -> ActionT 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 (ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal])
-> ReaderT WebState m [XPubBal] -> 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
xs)

scottyDelXPub ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  DelCachedXPub ->
  ActionT m (GenericResult Bool)
scottyDelXPub :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
DelCachedXPub -> ActionT m (GenericResult Bool)
scottyDelXPub (DelCachedXPub XPubKey
xpub DeriveType
deriv) =
  (WebMetrics -> StatTiming)
-> ActionT m (GenericResult Bool) -> ActionT m (GenericResult Bool)
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.xpubDelete) (ActionT m (GenericResult Bool) -> ActionT m (GenericResult Bool))
-> ActionT m (GenericResult Bool) -> ActionT m (GenericResult Bool)
forall a b. (a -> b) -> a -> b
$ do
    Maybe CacheConfig
c <- (WebState -> Maybe CacheConfig)
-> ActionT (ReaderT WebState m) (Maybe CacheConfig)
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.cache)
    Integer
n <- ReaderT WebState m Integer -> ActionT (ReaderT WebState m) Integer
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe CacheConfig
-> CacheT (ReaderT WebState m) Integer
-> ReaderT WebState m Integer
forall (m :: * -> *) a. Maybe CacheConfig -> CacheT m a -> m a
withCache Maybe CacheConfig
c (CacheT (ReaderT WebState m) Integer -> ReaderT WebState m Integer)
-> CacheT (ReaderT WebState m) Integer
-> ReaderT WebState m Integer
forall a b. (a -> b) -> a -> b
$ [XPubSpec] -> CacheT (ReaderT WebState m) Integer
forall (m :: * -> *).
(MonadLoggerIO m, StoreReadBase m) =>
[XPubSpec] -> CacheT m Integer
cacheDelXPubs [XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv])
    GenericResult Bool -> ActionT m (GenericResult Bool)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericResult Bool -> ActionT m (GenericResult Bool))
-> GenericResult Bool -> ActionT m (GenericResult Bool)
forall a b. (a -> b) -> a -> b
$ 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 ->
  ActionT m [TxRef]
getXPubTxs :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> ActionT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache = do
  Limits
limits <- Bool -> LimitsParam -> ActionT m Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
False LimitsParam
plimits
  let xs :: XPubSpec
xs = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
  [XPubBal]
xbals <- XPubSpec -> ActionT (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xs
  ReaderT WebState m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [TxRef] -> ActionT m [TxRef])
-> ReaderT WebState m [TxRef] -> ActionT m [TxRef]
forall a b. (a -> b) -> a -> b
$ 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] -> ReaderT WebState m [TxRef])
-> ReaderT WebState m [TxRef] -> ReaderT WebState 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
xs [XPubBal]
xbals Limits
limits

scottyXPubTxs ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetXPubTxs -> ActionT m [TxRef]
scottyXPubTxs :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubTxs -> ActionT m [TxRef]
scottyXPubTxs (GetXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits (NoCache Bool
nocache)) =
  (WebMetrics -> StatTiming)
-> ActionT m [TxRef] -> ActionT m [TxRef]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.xpubTx) (ActionT m [TxRef] -> ActionT m [TxRef])
-> ActionT m [TxRef] -> ActionT m [TxRef]
forall a b. (a -> b) -> a -> b
$
    XPubKey -> DeriveType -> LimitsParam -> Bool -> ActionT m [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> ActionT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache

scottyXPubTxsFull ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetXPubTxsFull ->
  ActionT m [Transaction]
scottyXPubTxsFull :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubTxsFull -> ActionT m [Transaction]
scottyXPubTxsFull (GetXPubTxsFull XPubKey
xpub DeriveType
deriv LimitsParam
plimits (NoCache Bool
nocache)) =
  (WebMetrics -> StatTiming)
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.xpubTxFull) (ActionT m [Transaction] -> ActionT m [Transaction])
-> ActionT m [Transaction] -> ActionT m [Transaction]
forall a b. (a -> b) -> a -> b
$
    ([Maybe Transaction] -> [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT m [Transaction]
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Maybe Transaction]
 -> ActionT m [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT m [Transaction]
forall a b. (a -> b) -> a -> b
$
      ReaderT WebState m [Maybe Transaction]
-> ActionT (ReaderT WebState m) [Maybe Transaction]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Maybe Transaction]
 -> ActionT (ReaderT WebState m) [Maybe Transaction])
-> ([TxRef] -> ReaderT WebState m [Maybe Transaction])
-> [TxRef]
-> ActionT (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]
 -> ReaderT WebState m [Maybe Transaction])
-> ([TxRef] -> ReaderT WebState m [Maybe Transaction])
-> [TxRef]
-> ReaderT WebState m [Maybe Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 :: * -> *).
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] -> ActionT (ReaderT WebState m) [Maybe Transaction])
-> ActionT (ReaderT WebState m) [TxRef]
-> ActionT (ReaderT WebState m) [Maybe Transaction]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< XPubKey
-> DeriveType
-> LimitsParam
-> Bool
-> ActionT (ReaderT WebState m) [TxRef]
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> DeriveType -> LimitsParam -> Bool -> ActionT m [TxRef]
getXPubTxs XPubKey
xpub DeriveType
deriv LimitsParam
plimits Bool
nocache

scottyXPubBalances ::
  (MonadUnliftIO m, MonadLoggerIO m) => GetXPubBalances -> ActionT m [XPubBal]
scottyXPubBalances :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubBalances -> ActionT m [XPubBal]
scottyXPubBalances (GetXPubBalances XPubKey
xpub DeriveType
deriv (NoCache Bool
noCache)) =
  (WebMetrics -> StatTiming)
-> ActionT m [XPubBal] -> ActionT m [XPubBal]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.xpubBalance) (ActionT m [XPubBal] -> ActionT m [XPubBal])
-> ActionT m [XPubBal] -> ActionT m [XPubBal]
forall a b. (a -> b) -> a -> b
$
    ReaderT WebState m [XPubBal] -> ActionT m [XPubBal]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubBal] -> ActionT m [XPubBal])
-> ReaderT WebState m [XPubBal] -> ActionT m [XPubBal]
forall a b. (a -> b) -> a -> b
$
      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] -> ReaderT WebState m [XPubBal])
-> ReaderT WebState m [XPubBal] -> ReaderT WebState m [XPubBal]
forall a b. (a -> b) -> a -> b
$
        XPubSpec -> ReaderT WebState m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals (XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv)

scottyXPubUnspent ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetXPubUnspent ->
  ActionT m [XPubUnspent]
scottyXPubUnspent :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetXPubUnspent -> ActionT m [XPubUnspent]
scottyXPubUnspent (GetXPubUnspent XPubKey
xpub DeriveType
deriv LimitsParam
pLimits (NoCache Bool
noCache)) =
  (WebMetrics -> StatTiming)
-> ActionT m [XPubUnspent] -> ActionT m [XPubUnspent]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.xpubUnspent) (ActionT m [XPubUnspent] -> ActionT m [XPubUnspent])
-> ActionT m [XPubUnspent] -> ActionT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ do
    Limits
limits <- Bool -> LimitsParam -> ActionT m Limits
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
False LimitsParam
pLimits
    let xspec :: XPubSpec
xspec = XPubKey -> DeriveType -> XPubSpec
XPubSpec XPubKey
xpub DeriveType
deriv
    [XPubBal]
xbals <- XPubSpec -> ActionT (ReaderT WebState m) [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xspec
    ReaderT WebState m [XPubUnspent] -> ActionT m [XPubUnspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [XPubUnspent] -> ActionT m [XPubUnspent])
-> ReaderT WebState m [XPubUnspent] -> ActionT m [XPubUnspent]
forall a b. (a -> b) -> a -> b
$ 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]
 -> ReaderT WebState m [XPubUnspent])
-> ReaderT WebState m [XPubUnspent]
-> ReaderT WebState 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

---------------------------------------
-- 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
t =
  BinfoSymbol
    { Text
$sel:code:BinfoSymbol :: Text
code :: Text
code,
      $sel:symbol:BinfoSymbol :: Text
symbol = BinfoTicker
t.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
/ BinfoTicker
t.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 ::
  (MonadUnliftIO m) =>
  Text ->
  ActionT m (HashSet BinfoAddr)
getBinfoAddrsParam :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
name = do
  Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
  Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
  Text
p <- Text -> ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param (Text -> Text
TL.fromStrict Text
name) ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Text -> ActionT (ReaderT WebState m) Text
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
""
  if Text -> Bool
T.null Text
p
    then HashSet BinfoAddr -> ActionT m (HashSet BinfoAddr)
forall a. a -> ActionT (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 -> ActionT m (HashSet BinfoAddr)
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise (String -> Except
UserError String
"invalid address")
      Just [BinfoAddr]
xs -> HashSet BinfoAddr -> ActionT m (HashSet BinfoAddr)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet BinfoAddr -> ActionT m (HashSet BinfoAddr))
-> HashSet BinfoAddr -> ActionT 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 ::
  (MonadUnliftIO m) =>
  ActionT m (HashSet XPubSpec, HashSet Address)
getBinfoActive :: forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (HashSet XPubSpec, HashSet Address)
getBinfoActive = do
  HashSet BinfoAddr
active <- Text -> ActionT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"active"
  HashSet BinfoAddr
p2sh <- Text -> ActionT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT m (HashSet BinfoAddr)
getBinfoAddrsParam Text
"activeP2SH"
  HashSet BinfoAddr
bech32 <- Text -> ActionT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT 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) -> [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
active
  (HashSet XPubSpec, HashSet Address)
-> ActionT m (HashSet XPubSpec, HashSet Address)
forall a. a -> ActionT (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 :: (MonadUnliftIO m) => ActionT m Bool
getNumTxId :: forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId = (Bool -> Bool)
-> ActionT (ReaderT WebState m) Bool
-> ActionT (ReaderT WebState m) Bool
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (ActionT (ReaderT WebState m) Bool
 -> ActionT (ReaderT WebState m) Bool)
-> ActionT (ReaderT WebState m) Bool
-> ActionT (ReaderT WebState m) Bool
forall a b. (a -> b) -> a -> b
$ Text -> ActionT (ReaderT WebState m) Bool
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"txidindex" ActionT (ReaderT WebState m) Bool
-> ActionT (ReaderT WebState m) Bool
-> ActionT (ReaderT WebState m) Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Bool -> ActionT (ReaderT WebState m) Bool
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

getChainHeight :: (MonadUnliftIO m) => ActionT m H.BlockHeight
getChainHeight :: forall (m :: * -> *). MonadUnliftIO m => ActionT m Word32
getChainHeight =
  (BlockNode -> Word32)
-> ActionT (ReaderT WebState m) BlockNode
-> ActionT (ReaderT WebState m) Word32
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.height) (ActionT (ReaderT WebState m) BlockNode
 -> ActionT (ReaderT WebState m) Word32)
-> ActionT (ReaderT WebState m) BlockNode
-> ActionT (ReaderT WebState m) Word32
forall a b. (a -> b) -> a -> b
$ Chain -> ActionT (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest (Chain -> ActionT (ReaderT WebState m) BlockNode)
-> ActionT (ReaderT WebState m) Chain
-> ActionT (ReaderT WebState m) BlockNode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)

scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => ActionT m ()
scottyBinfoUnspent :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoUnspent =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoUnspent) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- ActionT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Int
limit <- ActionT (ReaderT WebState m) Int
get_limit
    Int32
min_conf <- ActionT (ReaderT WebState m) Int32
get_min_conf
    Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
    Word32
height <- ActionT m Word32
forall (m :: * -> *). MonadUnliftIO m => ActionT m Word32
getChainHeight
    let mn :: r -> Bool
mn r
u = Int32
min_conf Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> r
u.confirmations
    HashMap XPubSpec [XPubBal]
xbals <- ReaderT WebState m (HashMap XPubSpec [XPubBal])
-> ActionT (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m (HashMap XPubSpec [XPubBal])
 -> ActionT (ReaderT WebState m) (HashMap XPubSpec [XPubBal]))
-> ReaderT WebState m (HashMap XPubSpec [XPubBal])
-> ActionT (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
    [BinfoUnspent]
bus <-
      ReaderT WebState m [BinfoUnspent]
-> ActionT (ReaderT WebState m) [BinfoUnspent]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoUnspent]
 -> ActionT (ReaderT WebState m) [BinfoUnspent])
-> (ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
    -> ReaderT WebState m [BinfoUnspent])
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ActionT (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 (ReaderT WebState m) [BinfoUnspent])
-> ConduitT () Void (ReaderT WebState m) [BinfoUnspent]
-> ActionT (ReaderT WebState m) [BinfoUnspent]
forall a b. (a -> b) -> a -> b
$
        Bool
-> Word32
-> HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent (ReaderT WebState m) ()
forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
Bool
-> Word32
-> HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent m ()
getBinfoUnspents 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
forall {r}. HasField "confirmations" r Int32 => r -> 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)
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT 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 (ReaderT WebState m) Int
get_limit = (Int -> Int)
-> ActionT (ReaderT WebState m) Int
-> ActionT (ReaderT WebState m) Int
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) Int
 -> ActionT (ReaderT WebState m) Int)
-> ActionT (ReaderT WebState m) Int
-> ActionT (ReaderT WebState m) Int
forall a b. (a -> b) -> a -> b
$ Text -> ActionT (ReaderT WebState m) Int
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"limit" ActionT (ReaderT WebState m) Int
-> ActionT (ReaderT WebState m) Int
-> ActionT (ReaderT WebState m) Int
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Int -> ActionT (ReaderT WebState m) Int
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
250
    get_min_conf :: ActionT (ReaderT WebState m) Int32
get_min_conf = Text -> ActionT (ReaderT WebState m) Int32
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"confirmations" ActionT (ReaderT WebState m) Int32
-> ActionT (ReaderT WebState m) Int32
-> ActionT (ReaderT WebState m) Int32
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Int32 -> ActionT (ReaderT WebState m) Int32
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0

getBinfoUnspents ::
  (StoreReadExtra m, MonadIO m) =>
  Bool ->
  H.BlockHeight ->
  HashMap XPubSpec [XPubBal] ->
  HashSet XPubSpec ->
  HashSet Address ->
  ConduitT () BinfoUnspent m ()
getBinfoUnspents :: forall (m :: * -> *).
(StoreReadExtra m, MonadIO m) =>
Bool
-> Word32
-> HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> HashSet Address
-> ConduitT () BinfoUnspent m ()
getBinfoUnspents 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
forall {r} {r}.
(HasField "index" r Word32, HasField "value" r Word64,
 HasField "hash" r TxHash, HasField "block" r BlockRef,
 HasField "outpoint" r r, HasField "script" r ByteString) =>
r -> Maybe BinfoXPubPath -> BinfoUnspent
binfo)
  where
    binfo :: r -> Maybe BinfoXPubPath -> BinfoUnspent
binfo r
u Maybe BinfoXPubPath
xp =
      let conf :: Word32
conf = case r
u.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
       in BinfoUnspent
            { $sel:txid:BinfoUnspent :: TxHash
txid = r
u.outpoint.hash,
              $sel:index:BinfoUnspent :: Word32
index = r
u.outpoint.index,
              $sel:script:BinfoUnspent :: ByteString
script = r
u.script,
              $sel:value:BinfoUnspent :: Word64
value = r
u.value,
              $sel:confirmations:BinfoUnspent :: Int32
confirmations = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
conf,
              $sel:txidx:BinfoUnspent :: BinfoTxId
txidx = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid r
u.outpoint.hash,
              $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 = 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)
                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 :: * -> *} {m :: * -> *}.
(StoreReadExtra 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 -> Limits -> m [Unspent]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [Unspent]
getAddressUnspents
          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) =>
  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) =>
HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
  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 ()
forall {m :: * -> *}.
StoreReadBase m =>
Int64 -> ConduitT TxRef BinfoTx m ()
go Int64
bal
    where
      sxspecs_ls :: [XPubSpec]
sxspecs_ls = HashSet XPubSpec -> [XPubSpec]
forall a. HashSet a -> [a]
HashSet.toList HashSet XPubSpec
sxspecs
      saddrs_ls :: [Address]
saddrs_ls = HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
saddrs
      conduits :: ConduitT () BinfoTx m [ConduitT () TxRef m ()]
conduits =
        [ConduitT () TxRef m ()]
-> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()]
forall a. Semigroup a => a -> a -> a
(<>)
          ([ConduitT () TxRef m ()]
 -> [ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
-> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
-> ConduitT
     () BinfoTx m ([ConduitT () TxRef m ()] -> [ConduitT () TxRef m ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XPubSpec -> ConduitT () BinfoTx m (ConduitT () TxRef m ()))
-> [XPubSpec] -> ConduitT () BinfoTx m [ConduitT () TxRef m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM XPubSpec -> ConduitT () BinfoTx m (ConduitT () TxRef m ())
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {m :: * -> *}.
(MonadTrans t, StoreReadExtra m, 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 ()
forall {m :: * -> *}.
StoreReadExtra m =>
Address -> ConduitT () TxRef m ()
addr_c [Address]
saddrs_ls)
      xpub_c :: XPubSpec -> t m (ConduitT () TxRef m ())
xpub_c XPubSpec
x = do
        let f :: Limits -> m [TxRef]
f = 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)
            l :: Limits
l = Limits {$sel:limit:Limits :: Word32
limit = Word32
16, $sel:offset:Limits :: Word32
offset = Word32
0, $sel:start:Limits :: Maybe Start
start = Maybe Start
forall a. Maybe a
Nothing}
        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 l :: Limits
l = Limits {$sel:limit:Limits :: Word32
limit = Word32
16, $sel:offset:Limits :: Word32
offset = Word32
0, $sel:start:Limits :: Maybe Start
start = Maybe Start
forall a. Maybe a
Nothing}
        (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.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 :: p -> a
compute_bal_change p
t =
        let ins :: [BinfoTxOutput]
ins = (a -> BinfoTxOutput) -> [a] -> [BinfoTxOutput]
forall a b. (a -> b) -> [a] -> [b]
map (.output) p
t.inputs
            out :: [BinfoTxOutput]
out = p
t.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 :: * -> *).
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
                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} {a} {p}.
(Num a, HasField "output" a BinfoTxOutput, HasField "inputs" p [a],
 HasField "outputs" p [BinfoTxOutput]) =>
p -> a
compute_bal_change BinfoTx
a
                    c :: Bool
c = Maybe Word32 -> Bool
forall a. Maybe a -> Bool
isJust BinfoTx
a.blockHeight
                    d :: Int64
d = (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Maybe (Int64, Int64) -> (Int64, Int64)
forall a. HasCallStack => Maybe a -> a
fromJust 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 :: (MonadUnliftIO m) => ActionT m Bool
getCashAddr :: forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getCashAddr = Text -> ActionT (ReaderT WebState m) Bool
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"cashaddr" ActionT (ReaderT WebState m) Bool
-> ActionT (ReaderT WebState m) Bool
-> ActionT (ReaderT WebState m) Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Bool -> ActionT (ReaderT WebState m) Bool
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

getAddress :: (MonadUnliftIO m) => Text -> ActionT m Address
getAddress :: forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress Text
txt = do
  Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
  case Network -> Text -> Maybe Address
textToAddr Network
net Text
txt of
    Maybe Address
Nothing -> Except -> ActionT m Address
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
    Just Address
a -> Address -> ActionT m Address
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Address
a

getBinfoAddr :: (MonadUnliftIO m) => TL.Text -> ActionT m BinfoAddr
getBinfoAddr :: forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT m BinfoAddr
getBinfoAddr Text
param' = do
  Text
txt <- Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
param'
  Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
  Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
  let addr :: Maybe BinfoAddr
addr = 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
      xpub :: Maybe BinfoAddr
xpub = 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
  ActionT m BinfoAddr
-> (BinfoAddr -> ActionT m BinfoAddr)
-> Maybe BinfoAddr
-> ActionT m BinfoAddr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT m BinfoAddr
forall (m :: * -> *) a. Monad m => ActionT m a
S.next BinfoAddr -> ActionT m BinfoAddr
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BinfoAddr
addr 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
<|> Maybe BinfoAddr
xpub)

scottyBinfoHistory :: (MonadUnliftIO m, MonadLoggerIO m) => ActionT m ()
scottyBinfoHistory :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoHistory =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoExportHistory) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- ActionT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
    (Maybe BlockData
startM, Maybe BlockData
endM) <- ActionT (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
get_dates
    (Text
code, BinfoTicker
price') <- ActionT m (Text, BinfoTicker)
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (Text, BinfoTicker)
getPrice
    HashMap XPubSpec [XPubBal]
xbals <- HashSet XPubSpec
-> ActionT (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals HashSet XPubSpec
xspecs
    let xaddrs :: HashSet Address
xaddrs = [Address] -> HashSet Address
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Address] -> HashSet Address) -> [Address] -> HashSet Address
forall a b. (a -> b) -> a -> b
$ ([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' = [(XPubSpec, [XPubBal])]
-> HashSet Address
-> Maybe BlockData
-> [ConduitT () TxRef (ReaderT WebState m) ()]
forall {m :: * -> *} {a}.
(StoreReadExtra m, HasField "height" a Word32) =>
[(XPubSpec, [XPubBal])]
-> HashSet Address -> Maybe a -> [ConduitT () TxRef m ()]
conduits (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 (ReaderT WebState m) [Transaction]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [Transaction]
 -> ActionT (ReaderT WebState m) [Transaction])
-> ReaderT WebState m [Transaction]
-> ActionT (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
    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 <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    String
url <- (WebState -> String) -> ActionT (ReaderT WebState m) String
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.priceHistoryURL)
    Session
session <- (WebState -> Session) -> ActionT (ReaderT WebState m) Session
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.session)
    [Double]
rates <- (BinfoRate -> Double) -> [BinfoRate] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (.price) ([BinfoRate] -> [Double])
-> ActionT (ReaderT WebState m) [BinfoRate]
-> ActionT (ReaderT WebState m) [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT WebState m [BinfoRate]
-> ActionT (ReaderT WebState m) [BinfoRate]
forall (m :: * -> *) a. Monad m => m a -> ActionT 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)
    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)
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ [BinfoHistory] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [BinfoHistory]
hs
  where
    is_newer :: Maybe BlockData -> TxRef -> Bool
is_newer
      (Just BlockData {$sel:height:BlockData :: BlockData -> Word32
height = Word32
bh})
      TxRef {$sel:block:TxRef :: TxRef -> BlockRef
block = BlockRef {$sel:height:BlockRef :: BlockRef -> Word32
height = Word32
th}} =
        Word32
bh Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
th
    is_newer Maybe BlockData
Nothing TxRef {} = Bool
True
    is_newer Maybe BlockData
_ TxRef
_ = Bool
forall a. HasCallStack => a
undefined
    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 :: * -> *).
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 (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
get_dates = do
      BinfoDate Word64
start <- Text -> ActionT (ReaderT WebState m) BinfoDate
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"start"
      BinfoDate Word64
end' <- Text -> ActionT (ReaderT WebState m) BinfoDate
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
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 <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
      Maybe BlockData
startM <- Chain -> Word64 -> ActionT (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 (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 (ReaderT WebState m) (Maybe BlockData, Maybe BlockData)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockData
startM, Maybe BlockData
endM)
    conduits :: [(XPubSpec, [XPubBal])]
-> HashSet Address -> Maybe a -> [ConduitT () TxRef m ()]
conduits [(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 (Maybe a -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
forall {m :: * -> *} {a}.
(StoreReadExtra m, HasField "height" a Word32) =>
Maybe a -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
xpub_c 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 (Maybe a -> Address -> ConduitT () TxRef m ()
forall {m :: * -> *} {a}.
(StoreReadExtra m, HasField "height" a Word32) =>
Maybe a -> Address -> ConduitT () TxRef m ()
addr_c Maybe a
endM) (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
    lim :: Maybe a -> Limits
lim Maybe a
endM =
      Limits
        { $sel:limit:Limits :: Word32
limit = Word32
16,
          $sel:offset:Limits :: Word32
offset = Word32
0,
          $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
        }
    addr_c :: Maybe a -> Address -> ConduitT () TxRef m ()
addr_c Maybe a
endM Address
a =
      (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
a) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) (Maybe a -> Limits
forall {a}. HasField "height" a Word32 => Maybe a -> Limits
lim Maybe a
endM)
    xpub_c :: Maybe a -> XPubSpec -> [XPubBal] -> ConduitT () TxRef m ()
xpub_c Maybe a
endM XPubSpec
x [XPubBal]
bs =
      (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> Limits -> m [TxRef]
xPubTxs XPubSpec
x [XPubBal]
bs) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) (Maybe a -> Limits
forall {a}. HasField "height" a Word32 => Maybe a -> Limits
lim Maybe a
endM)

getPrice :: (MonadUnliftIO m) => ActionT m (Text, BinfoTicker)
getPrice :: forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (Text, BinfoTicker)
getPrice = do
  Text
code <- Text -> Text
T.toUpper (Text -> Text)
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"currency" ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Text -> ActionT (ReaderT WebState m) Text
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"USD"
  TVar (HashMap Text BinfoTicker)
ticker <- (WebState -> TVar (HashMap Text BinfoTicker))
-> ActionT (ReaderT WebState m) (TVar (HashMap Text BinfoTicker))
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.ticker)
  HashMap Text BinfoTicker
prices <- TVar (HashMap Text BinfoTicker)
-> ActionT (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) -> ActionT m (Text, BinfoTicker)
forall a. a -> ActionT (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) -> ActionT m (Text, BinfoTicker)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
code, BinfoTicker
p)

getSymbol :: (MonadUnliftIO m) => ActionT m BinfoSymbol
getSymbol :: forall (m :: * -> *). MonadUnliftIO m => ActionT 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 (ReaderT WebState m) (Text, BinfoTicker)
-> ActionT (ReaderT WebState m) BinfoSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) (Text, BinfoTicker)
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (Text, BinfoTicker)
getPrice

scottyBinfoBlocksDay :: (MonadUnliftIO m, MonadLoggerIO m) => ActionT m ()
scottyBinfoBlocksDay :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoBlocksDay =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoBlock) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    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 (ReaderT WebState m) Word64
-> ActionT (ReaderT WebState m) Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT (ReaderT WebState m) Word64
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"milliseconds"
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    Maybe BlockData
m <- Chain -> Word64 -> ActionT (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 (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
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT 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) => ActionT m ()
scottyMultiAddr :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyMultiAddr =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoMultiaddr) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    (HashSet Address
addrs', HashSet XPubKey
_, HashSet Address
saddrs, HashSet XPubKey
sxpubs, HashSet XPubSpec
xspecs) <- ActionT
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashSet XPubSpec)
get_addrs
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Bool
cashaddr <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getCashAddr
    BinfoSymbol
local' <- ActionT m BinfoSymbol
forall (m :: * -> *). MonadUnliftIO m => ActionT m BinfoSymbol
getSymbol
    Int
offset <- ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => ActionT m Int
getBinfoOffset
    Int
n <- Text -> ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Int
getBinfoCount Text
"n"
    Bool
prune <- ActionT m Bool
get_prune
    BinfoFilter
fltr <- ActionT (ReaderT WebState m) BinfoFilter
get_filter
    HashMap XPubSpec [XPubBal]
xbals <- HashSet XPubSpec
-> ActionT (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals HashSet XPubSpec
xspecs
    HashMap XPubSpec Word64
xtxns <- HashMap XPubSpec [XPubBal]
-> HashSet XPubSpec
-> ActionT (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
    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 (ReaderT WebState m) (HashMap Address Balance)
get_abals HashSet Address
addrs
    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)
forall {k} {a} {a} {r}.
(Hashable k, HasField "path" a [Word32], HasField "key" a XPubKey,
 HasField "balance" a r, HasField "address" r k) =>
HashSet k -> HashMap a [a] -> HashMap k (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
    [BinfoTx]
ftxs <-
      ReaderT WebState m [BinfoTx]
-> ActionT (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT (ReaderT WebState m) [BinfoTx])
-> (ConduitT () Void (ReaderT WebState m) [BinfoTx]
    -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT (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 (ReaderT WebState m) [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
        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) =>
HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
          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 <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
    BlockData
best <- ActionT (ReaderT WebState m) BlockData
get_best_block
    Word32
peers <- ActionT (ReaderT WebState m) Word32
get_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
            }
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT 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 (ReaderT WebState m) BinfoFilter
get_filter = Text -> ActionT (ReaderT WebState m) BinfoFilter
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"filter" ActionT (ReaderT WebState m) BinfoFilter
-> ActionT (ReaderT WebState m) BinfoFilter
-> ActionT (ReaderT WebState m) BinfoFilter
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` BinfoFilter -> ActionT (ReaderT WebState m) BinfoFilter
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterAll
    get_best_block :: ActionT (ReaderT WebState m) BlockData
get_best_block =
      ActionT (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock ActionT (ReaderT WebState m) (Maybe BlockHash)
-> (Maybe BlockHash -> ActionT (ReaderT WebState m) BlockData)
-> ActionT (ReaderT WebState m) BlockData
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe BlockHash
Nothing -> Except -> ActionT (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
        Just BlockHash
bh ->
          BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh ActionT (ReaderT WebState m) (Maybe BlockData)
-> (Maybe BlockData -> ActionT (ReaderT WebState m) BlockData)
-> ActionT (ReaderT WebState m) BlockData
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe BlockData
Nothing -> Except -> ActionT (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
            Just BlockData
b -> BlockData -> ActionT (ReaderT WebState m) BlockData
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
    get_prune :: ActionT m Bool
get_prune = (Bool -> Bool) -> ActionT m Bool -> ActionT m Bool
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (ActionT m Bool -> ActionT m Bool)
-> ActionT m Bool -> ActionT m Bool
forall a b. (a -> b) -> a -> b
$ Text -> ActionT m Bool
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"no_compact" ActionT m Bool -> ActionT m Bool -> ActionT m Bool
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Bool -> ActionT m Bool
forall a. a -> ActionT (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
  (ReaderT WebState m)
  (HashSet Address, HashSet XPubKey, HashSet Address,
   HashSet XPubKey, HashSet XPubSpec)
get_addrs = do
      (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- ActionT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
      HashSet BinfoAddr
sh <- Text -> ActionT m (HashSet BinfoAddr)
forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT 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
     (ReaderT WebState m)
     (HashSet Address, HashSet XPubKey, HashSet Address,
      HashSet XPubKey, HashSet XPubSpec)
forall a. a -> ActionT (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 (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 (ReaderT WebState m) [Balance]
-> ActionT (ReaderT WebState m) (HashMap Address Balance)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Balance] -> HashMap Address Balance
g (ActionT (ReaderT WebState m) [Balance]
 -> ActionT (ReaderT WebState m) (HashMap Address Balance))
-> (HashSet Address -> ActionT (ReaderT WebState m) [Balance])
-> HashSet Address
-> ActionT (ReaderT WebState m) (HashMap Address Balance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Address] -> ActionT (ReaderT WebState m) [Balance]
forall (m :: * -> *). StoreReadExtra m => [Address] -> m [Balance]
getBalances ([Address] -> ActionT (ReaderT WebState m) [Balance])
-> (HashSet Address -> [Address])
-> HashSet Address
-> ActionT (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 (ReaderT WebState m) Word32
get_peers = do
      [PeerInfo]
ps <- ReaderT WebState m [PeerInfo]
-> ActionT (ReaderT WebState m) [PeerInfo]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [PeerInfo]
 -> ActionT (ReaderT WebState m) [PeerInfo])
-> ReaderT WebState m [PeerInfo]
-> ActionT (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 (ReaderT WebState m) Word32
forall a. a -> ActionT (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 k -> HashMap a [a] -> HashMap k (Maybe BinfoXPubPath)
compute_abook HashSet k
addrs HashMap a [a]
xbals =
      let f :: r -> p -> (a, Maybe BinfoXPubPath)
f r
xs p
xb =
            let a :: a
a = p
xb.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 p
xb.path)
             in (a
a, BinfoXPubPath -> Maybe BinfoXPubPath
forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath r
xs.key (SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall {a}. a
e Maybe SoftPath
s)))
          amap :: HashMap k (Maybe a)
amap =
            (() -> Maybe a) -> HashMap k () -> HashMap k (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 k () -> HashMap k (Maybe a))
-> HashMap k () -> HashMap k (Maybe a)
forall a b. (a -> b) -> a -> b
$
              HashSet k -> HashMap k ()
forall a. HashSet a -> HashMap a ()
HashSet.toMap HashSet k
addrs
          xmap :: HashMap k (Maybe BinfoXPubPath)
xmap =
            [(k, Maybe BinfoXPubPath)] -> HashMap k (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
              ([(k, Maybe BinfoXPubPath)] -> HashMap k (Maybe BinfoXPubPath))
-> ([(a, [a])] -> [(k, Maybe BinfoXPubPath)])
-> [(a, [a])]
-> HashMap k (Maybe BinfoXPubPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, [a]) -> [(k, Maybe BinfoXPubPath)])
-> [(a, [a])] -> [(k, Maybe BinfoXPubPath)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((a -> [a] -> [(k, Maybe BinfoXPubPath)])
-> (a, [a]) -> [(k, Maybe BinfoXPubPath)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> (k, Maybe BinfoXPubPath))
-> [a] -> [(k, Maybe BinfoXPubPath)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> (k, Maybe BinfoXPubPath))
 -> [a] -> [(k, Maybe BinfoXPubPath)])
-> (a -> a -> (k, Maybe BinfoXPubPath))
-> a
-> [a]
-> [(k, Maybe BinfoXPubPath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> (k, Maybe BinfoXPubPath)
forall {p} {r} {r} {a}.
(HasField "path" p [Word32], HasField "key" r XPubKey,
 HasField "balance" p r, HasField "address" r a) =>
r -> p -> (a, Maybe BinfoXPubPath)
f))
              ([(a, [a])] -> HashMap k (Maybe BinfoXPubPath))
-> [(a, [a])] -> HashMap k (Maybe BinfoXPubPath)
forall a b. (a -> b) -> a -> b
$ HashMap a [a] -> [(a, [a])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap a [a]
xbals
       in HashMap k (Maybe BinfoXPubPath)
forall {a}. HashMap k (Maybe a)
amap HashMap k (Maybe BinfoXPubPath)
-> HashMap k (Maybe BinfoXPubPath)
-> HashMap k (Maybe BinfoXPubPath)
forall a. Semigroup a => a -> a -> a
<> HashMap k (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) => TL.Text -> ActionT m Int
getBinfoCount :: forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Int
getBinfoCount Text
str = do
  Word32
d <- (WebState -> Word32) -> ActionT (ReaderT WebState m) Word32
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.limits.defItemCount)
  Word32
x <- (WebState -> Word32) -> ActionT (ReaderT WebState m) Word32
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.limits.maxFullItemCount)
  Word32
i <- Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
x (Word32 -> Word32)
-> ActionT (ReaderT WebState m) Word32
-> ActionT (ReaderT WebState m) Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ActionT (ReaderT WebState m) Word32
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
str ActionT (ReaderT WebState m) Word32
-> ActionT (ReaderT WebState m) Word32
-> ActionT (ReaderT WebState m) Word32
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Word32 -> ActionT (ReaderT WebState m) Word32
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
d)
  Int -> ActionT m Int
forall a. a -> ActionT (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) =>
  ActionT m Int
getBinfoOffset :: forall (m :: * -> *). MonadUnliftIO m => ActionT m Int
getBinfoOffset = do
  Word32
x <- (WebState -> Word32) -> ActionT (ReaderT WebState m) Word32
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.limits.maxOffset)
  Word32
o <- Text -> ActionT (ReaderT WebState m) Word32
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"offset" ActionT (ReaderT WebState m) Word32
-> ActionT (ReaderT WebState m) Word32
-> ActionT (ReaderT WebState m) Word32
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Word32 -> ActionT (ReaderT WebState m) Word32
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
  Bool
-> ActionT (ReaderT WebState m) ()
-> ActionT (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 (ReaderT WebState m) ()
 -> ActionT (ReaderT WebState m) ())
-> ActionT (ReaderT WebState m) ()
-> ActionT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
    Except -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise (Except -> ActionT (ReaderT WebState m) ())
-> Except -> ActionT (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 -> ActionT m Int
forall a. a -> ActionT (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) => ActionT m ()
scottyRawAddr :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyRawAddr =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoAddressRaw) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$
    Text -> ActionT m BinfoAddr
forall (m :: * -> *).
MonadUnliftIO m =>
Text -> ActionT m BinfoAddr
getBinfoAddr Text
"addr" ActionT m BinfoAddr -> (BinfoAddr -> ActionT m ()) -> ActionT m ()
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      BinfoAddr Address
addr -> Address -> ActionT m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
Address -> ActionT (ReaderT WebState m) ()
do_addr Address
addr
      BinfoXpub XPubKey
xpub -> XPubKey -> ActionT m ()
forall {m :: * -> *}.
(MonadUnliftIO m, MonadLoggerIO m) =>
XPubKey -> ActionT (ReaderT WebState m) ()
do_xpub XPubKey
xpub
  where
    do_xpub :: XPubKey -> ActionT (ReaderT WebState m) ()
do_xpub XPubKey
xpub = do
      Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
      DeriveType
derive <- Text -> ActionT (ReaderT WebState m) DeriveType
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"derive" ActionT (ReaderT WebState m) DeriveType
-> ActionT (ReaderT WebState m) DeriveType
-> ActionT (ReaderT WebState m) DeriveType
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` DeriveType -> ActionT (ReaderT WebState m) DeriveType
forall a. a -> ActionT (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 -> ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Int
getBinfoCount Text
"limit"
      Int
off <- ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => ActionT m Int
getBinfoOffset
      HashMap XPubSpec [XPubBal]
xbals <- HashSet XPubSpec
-> ActionT (ReaderT WebState m) (HashMap XPubSpec [XPubBal])
forall (m :: * -> *).
StoreReadExtra m =>
HashSet XPubSpec -> m (HashMap XPubSpec [XPubBal])
getXBals (HashSet XPubSpec
 -> ActionT (ReaderT WebState m) (HashMap XPubSpec [XPubBal]))
-> HashSet XPubSpec
-> ActionT (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
      Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.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)
forall {k} {a} {r}.
(Hashable k, HasField "path" a [Word32], HasField "balance" a r,
 HasField "address" r k) =>
XPubKey -> [a] -> HashMap k (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
      [BinfoTx]
txs <-
        ReaderT WebState m [BinfoTx]
-> ActionT (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT (ReaderT WebState m) [BinfoTx])
-> ReaderT WebState m [BinfoTx]
-> ActionT (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
$
            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) =>
HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
              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 (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
      Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
      Encoding -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT (ReaderT WebState m) ())
-> Encoding -> ActionT (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 -> [a] -> HashMap k (Maybe BinfoXPubPath)
compute_abook XPubKey
xpub [a]
xbals =
      let f :: p -> (a, Maybe BinfoXPubPath)
f p
xb =
            let a :: a
a = p
xb.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 p
xb.path
                m :: SoftPath
m = SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall {a}. a
e Maybe SoftPath
s
             in (a
a, BinfoXPubPath -> Maybe BinfoXPubPath
forall a. a -> Maybe a
Just (XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath XPubKey
xpub SoftPath
m))
       in [(k, Maybe BinfoXPubPath)] -> HashMap k (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(k, Maybe BinfoXPubPath)] -> HashMap k (Maybe BinfoXPubPath))
-> [(k, Maybe BinfoXPubPath)] -> HashMap k (Maybe BinfoXPubPath)
forall a b. (a -> b) -> a -> b
$ (a -> (k, Maybe BinfoXPubPath))
-> [a] -> [(k, Maybe BinfoXPubPath)]
forall a b. (a -> b) -> [a] -> [b]
map a -> (k, Maybe BinfoXPubPath)
forall {p} {r} {a}.
(HasField "path" p [Word32], HasField "balance" p r,
 HasField "address" r a) =>
p -> (a, Maybe BinfoXPubPath)
f [a]
xbals
    do_addr :: Address -> ActionT (ReaderT WebState m) ()
do_addr Address
addr = do
      Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
      Int
n <- Text -> ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Int
getBinfoCount Text
"limit"
      Int
off <- ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => ActionT 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 (ReaderT WebState m) (Maybe Balance)
-> ActionT (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
addr
      Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.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
          balance :: Word64
balance = Balance
bal.confirmed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Balance
bal.unconfirmed
      [BinfoTx]
txs <-
        ReaderT WebState m [BinfoTx]
-> ActionT (ReaderT WebState m) [BinfoTx]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [BinfoTx]
 -> ActionT (ReaderT WebState m) [BinfoTx])
-> (ConduitT () Void (ReaderT WebState m) [BinfoTx]
    -> ReaderT WebState m [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT (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 (ReaderT WebState m) [BinfoTx])
-> ConduitT () Void (ReaderT WebState m) [BinfoTx]
-> ActionT (ReaderT WebState m) [BinfoTx]
forall a b. (a -> b) -> a -> b
$
          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) =>
HashMap XPubSpec [XPubBal]
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet XPubSpec
-> HashSet Address
-> HashSet Address
-> BinfoFilter
-> Bool
-> Bool
-> Int64
-> ConduitT () BinfoTx m ()
getBinfoTxs
            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
balance)
            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,
                Word64
$sel:balance:BinfoRawAddr :: Word64
balance :: Word64
balance,
                $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
balance,
                [BinfoTx]
$sel:txs:BinfoRawAddr :: [BinfoTx]
txs :: [BinfoTx]
txs
              }
      ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
      Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
      Encoding -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT (ReaderT WebState m) ())
-> Encoding -> ActionT (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) => ActionT m ()
scottyBinfoReceived :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoReceived =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQgetreceivedbyaddress) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Address
a <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    Balance
b <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
a) (Maybe Balance -> Balance)
-> ActionT (ReaderT WebState m) (Maybe Balance)
-> ActionT (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyBinfoSent :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoSent =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQgetsentbyaddress) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Address
a <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    Balance
b <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
a) (Maybe Balance -> Balance)
-> ActionT (ReaderT WebState m) (Maybe Balance)
-> ActionT (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyBinfoAddrBalance :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoAddrBalance =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQaddressbalance) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Address
a <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    Balance
b <- Balance -> Maybe Balance -> Balance
forall a. a -> Maybe a -> a
fromMaybe (Address -> Balance
zeroBalance Address
a) (Maybe Balance -> Balance)
-> ActionT (ReaderT WebState m) (Maybe Balance)
-> ActionT (ReaderT WebState m) Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> ActionT (ReaderT WebState m) (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyFirstSeen :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyFirstSeen =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQaddressfirstseen) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Address
a <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    BlockNode
bb <- Chain -> ActionT (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 (ReaderT WebState m) Word32
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(StoreReadExtra (t m), MonadIO (t m), MonadTrans t,
 MonadLogger m) =>
Chain -> BlockNode -> Address -> Word32 -> Word32 -> t m Word32
go Chain
ch BlockNode
bb Address
a Word32
bot Word32
top
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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 -> t 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 -> t m Bool
forall {f :: * -> *}.
StoreReadExtra f =>
Address -> Word32 -> f Bool
hasone Address
a Word32
bot
      Bool
y <- Address -> Word32 -> t m Bool
forall {f :: * -> *}.
StoreReadExtra f =>
Address -> Word32 -> f Bool
hasone Address
a Word32
mid
      Bool
z <- Address -> Word32 -> t m Bool
forall {f :: * -> *}.
StoreReadExtra f =>
Address -> Word32 -> f Bool
hasone Address
a Word32
top
      if
        | Bool
x -> Chain -> BlockNode -> Word32 -> t m Word32
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadIO (t m), MonadTrans t, MonadLogger m) =>
Chain -> BlockNode -> Word32 -> t m Word32
getblocktime Chain
ch BlockNode
bb Word32
bot
        | Bool
n -> Chain -> BlockNode -> Word32 -> t m Word32
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadIO (t m), MonadTrans t, MonadLogger m) =>
Chain -> BlockNode -> Word32 -> t m Word32
getblocktime Chain
ch BlockNode
bb Word32
top
        | Bool
y -> Chain -> BlockNode -> Address -> Word32 -> Word32 -> t m Word32
go Chain
ch BlockNode
bb Address
a Word32
bot Word32
mid
        | Bool
z -> Chain -> BlockNode -> Address -> Word32 -> Word32 -> t m Word32
go Chain
ch BlockNode
bb Address
a Word32
mid Word32
top
        | Bool
otherwise -> Word32 -> t m Word32
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
    getblocktime :: Chain -> BlockNode -> Word32 -> t m Word32
getblocktime Chain
ch BlockNode
bb Word32
h =
      Word32 -> BlockNode -> Chain -> t m (Maybe BlockNode)
forall (m :: * -> *).
MonadIO m =>
Word32 -> BlockNode -> Chain -> m (Maybe BlockNode)
chainGetAncestor Word32
h BlockNode
bb Chain
ch t m (Maybe BlockNode)
-> (Maybe BlockNode -> t m Word32) -> t m Word32
forall a b. t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just BlockNode
b -> Word32 -> t m Word32
forall a. a -> t m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockNode
b.header.timestamp
        Maybe BlockNode
Nothing -> do
          m () -> t 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 () -> t m ()) -> (Text -> m ()) -> Text -> t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. $(logErrorS) Text
"Web" (Text -> t m ()) -> Text -> t m ()
forall a b. (a -> b) -> a -> b
$
            Text
"Could not get ancestor at height "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Word32 -> String
forall a. Show a => a -> String
show Word32
h)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for block "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
H.blockHashToHex (BlockHeader -> BlockHash
H.headerHash BlockNode
bb.header)
          String -> t m Word32
forall a. HasCallStack => String -> a
error String
"Block ancestor retreival error"
    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) => ActionT m ()
scottyShortBal :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyShortBal =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoBalance) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    (HashSet XPubSpec
xspecs, HashSet Address
addrs) <- ActionT m (HashSet XPubSpec, HashSet Address)
forall (m :: * -> *).
MonadUnliftIO m =>
ActionT m (HashSet XPubSpec, HashSet Address)
getBinfoActive
    Bool
cashaddr <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getCashAddr
    Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    [(Text, BinfoShortBal)]
abals <- [Maybe (Text, BinfoShortBal)] -> [(Text, BinfoShortBal)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, BinfoShortBal)] -> [(Text, BinfoShortBal)])
-> ActionT (ReaderT WebState m) [Maybe (Text, BinfoShortBal)]
-> ActionT (ReaderT WebState m) [(Text, BinfoShortBal)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Address
 -> ActionT (ReaderT WebState m) (Maybe (Text, BinfoShortBal)))
-> [Address]
-> ActionT (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 (ReaderT WebState m) (Maybe (Text, BinfoShortBal))
forall {m :: * -> *}.
StoreReadBase m =>
Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
getabal Network
net Bool
cashaddr) (HashSet Address -> [Address]
forall a. HashSet a -> [a]
HashSet.toList HashSet Address
addrs)
    [(Text, BinfoShortBal)]
xbals <- (XPubSpec -> ActionT (ReaderT WebState m) (Text, BinfoShortBal))
-> [XPubSpec]
-> ActionT (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 (ReaderT WebState m) (Text, BinfoShortBal)
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {r} {b} {b}.
(StoreReadExtra (t m), MonadTrans t, MonadReader r m,
 HasField "store" b b, HasField "ctx" b Ctx,
 HasField "config" r b) =>
Network -> XPubSpec -> t m (Text, BinfoShortBal)
getxbal 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)
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ HashMap Text BinfoShortBal -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding HashMap Text BinfoShortBal
res
  where
    shorten :: r -> BinfoShortBal
shorten r
bal =
      BinfoShortBal
        { $sel:final:BinfoShortBal :: Word64
final = r
bal.confirmed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ r
bal.unconfirmed,
          $sel:ntx:BinfoShortBal :: Word64
ntx = r
bal.txs,
          $sel:received:BinfoShortBal :: Word64
received = r
bal.received
        }
    getabal :: Network -> Bool -> Address -> m (Maybe (Text, BinfoShortBal))
getabal 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
forall {r}.
(HasField "confirmed" r Word64, HasField "unconfirmed" r Word64,
 HasField "received" r Word64, HasField "txs" r Word64) =>
r -> BinfoShortBal
shorten (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
forall {r}.
(HasField "confirmed" r Word64, HasField "unconfirmed" r Word64,
 HasField "received" r Word64, HasField "txs" r Word64) =>
r -> BinfoShortBal
shorten Balance
b)
    getxbal :: Network -> XPubSpec -> t m (Text, BinfoShortBal)
getxbal Network
net XPubSpec
xpub = do
      [XPubBal]
xbals <- XPubSpec -> t m [XPubBal]
forall (m :: * -> *). StoreReadExtra m => XPubSpec -> m [XPubBal]
xPubBals XPubSpec
xpub
      Word64
ntx <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> t m Word32 -> t m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPubSpec -> [XPubBal] -> t m Word32
forall (m :: * -> *).
StoreReadExtra m =>
XPubSpec -> [XPubBal] -> m Word32
xPubTxCount XPubSpec
xpub [XPubBal]
xbals
      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
x | x :: XPubBal
x@XPubBal {$sel:path:XPubBal :: XPubBal -> [Word32]
path = Word32
0 : [Word32]
_} <- [XPubBal]
xbals]
          final :: Word64
final = Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
zro
          received :: Word64
received = [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 {Word64
$sel:final:BinfoShortBal :: Word64
final :: Word64
final, Word64
$sel:ntx:BinfoShortBal :: Word64
ntx :: Word64
ntx, Word64
$sel:received:BinfoShortBal :: Word64
received :: Word64
received}
      Ctx
ctx <- (r -> Ctx) -> t m Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
      (Text, BinfoShortBal) -> t m (Text, BinfoShortBal)
forall a. a -> t 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 :: (MonadUnliftIO m) => ActionT m Bool
getBinfoHex :: forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getBinfoHex = (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"hex" :: Text)) (Text -> Bool)
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
"format" ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Text -> ActionT (ReaderT WebState m) Text
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"json"

scottyBinfoBlockHeight :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoBlockHeight :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoBlockHeight =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoBlockHeight) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Word32
height <- Text -> ActionT (ReaderT WebState m) Word32
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"height"
    [BlockData]
bs <- ([Maybe BlockData] -> [BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Maybe BlockData]
 -> ActionT (ReaderT WebState m) [BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall a b. (a -> b) -> a -> b
$ Word32 -> ActionT (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
height ActionT (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> ActionT (ReaderT WebState m) [Maybe BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash] -> ActionT (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 (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
    [BlockData]
ns <- ([Maybe BlockData] -> [BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Maybe BlockData]
 -> ActionT (ReaderT WebState m) [BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall a b. (a -> b) -> a -> b
$ Word32 -> ActionT (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) ActionT (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> ActionT (ReaderT WebState m) [Maybe BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash] -> ActionT (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 (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
    [BinfoBlock]
is <- (BlockData -> ActionT (ReaderT WebState m) BinfoBlock)
-> [BlockData] -> ActionT (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 (ReaderT WebState m) BinfoBlock
forall {m :: * -> *} {r}.
(StoreReadBase m, HasField "header" r BlockHeader) =>
Bool -> [r] -> BlockData -> m BinfoBlock
get_binfo_blocks Bool
numtxid [BlockData]
ns) [BlockData]
bs
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT 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]
is
  where
    get_binfo_blocks :: Bool -> [r] -> BlockData -> m BinfoBlock
get_binfo_blocks Bool
numtxid [r]
ns BlockData
b = do
      [Transaction]
txs <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> m [Maybe Transaction] -> m [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> m (Maybe Transaction))
-> [TxHash] -> 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 -> m (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction BlockData
b.txs
      let h :: r -> BlockHash
h r
x = BlockHeader -> BlockHash
H.headerHash r
x.header
          nbs :: [BlockHash]
nbs = [r -> BlockHash
forall {r}. HasField "header" r BlockHeader => r -> BlockHash
h r
n | r
n <- [r]
ns, r
n.header.prev BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockData -> BlockHash
forall {r}. HasField "header" r BlockHeader => r -> BlockHash
h BlockData
b]
          bts :: [BinfoTx]
bts = (Transaction -> BinfoTx) -> [Transaction] -> [BinfoTx]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid) [Transaction]
txs
      BinfoBlock -> m BinfoBlock
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BinfoBlock -> m BinfoBlock) -> BinfoBlock -> m BinfoBlock
forall a b. (a -> b) -> a -> b
$ BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock BlockData
b [BinfoTx]
bts [BlockHash]
nbs

scottyBinfoLatest :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoLatest :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoLatest =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoBlockLatest) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Maybe BlockData
mb <- MaybeT (ActionT (ReaderT WebState m)) BlockData
-> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ActionT (ReaderT WebState m)) BlockData
 -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
-> ActionT (ReaderT WebState m) (Maybe BlockData)
forall a b. (a -> b) -> a -> b
$ ActionT (ReaderT WebState m) (Maybe BlockHash)
-> MaybeT (ActionT (ReaderT WebState m)) BlockHash
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ActionT (ReaderT WebState m) (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock MaybeT (ActionT (ReaderT WebState m)) BlockHash
-> (BlockHash -> MaybeT (ActionT (ReaderT WebState m)) BlockData)
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
forall a b.
MaybeT (ActionT (ReaderT WebState m)) a
-> (a -> MaybeT (ActionT (ReaderT WebState m)) b)
-> MaybeT (ActionT (ReaderT WebState m)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ActionT (ReaderT WebState m) (Maybe BlockData)
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ActionT (ReaderT WebState m) (Maybe BlockData)
 -> MaybeT (ActionT (ReaderT WebState m)) BlockData)
-> (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> BlockHash
-> MaybeT (ActionT (ReaderT WebState m)) BlockData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
    BlockData
b <- ActionT (ReaderT WebState m) BlockData
-> (BlockData -> ActionT (ReaderT WebState m) BlockData)
-> Maybe BlockData
-> ActionT (ReaderT WebState m) BlockData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound) BlockData -> ActionT (ReaderT WebState m) BlockData
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BlockData
mb
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT 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
b.header,
            $sel:timestamp:BinfoHeader :: Word32
timestamp = BlockData
b.header.timestamp,
            $sel:index:BinfoHeader :: Word32
index = BlockData
b.height,
            $sel:height:BinfoHeader :: Word32
height = BlockData
b.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
b.txs
          }

scottyBinfoBlock :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoBlock :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoBlock =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoBlockRaw) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Bool
hex <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getBinfoHex
    Text -> ActionT (ReaderT WebState m) BinfoBlockId
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"block" ActionT (ReaderT WebState m) BinfoBlockId
-> (BinfoBlockId -> ActionT m ()) -> ActionT m ()
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      BinfoBlockHash BlockHash
bh -> Bool -> Bool -> BlockHash -> ActionT m ()
forall {m :: * -> *}.
MonadUnliftIO m =>
Bool -> Bool -> BlockHash -> ActionT (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
      BinfoBlockIndex Word32
i ->
        Word32 -> ActionT (ReaderT WebState m) [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight Word32
i ActionT (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> ActionT m ()) -> ActionT m ()
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          [] -> Except -> ActionT m ()
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
          BlockHash
bh : [BlockHash]
_ -> Bool -> Bool -> BlockHash -> ActionT m ()
forall {m :: * -> *}.
MonadUnliftIO m =>
Bool -> Bool -> BlockHash -> ActionT (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh
  where
    go :: Bool -> Bool -> BlockHash -> ActionT (ReaderT WebState m) ()
go Bool
numtxid Bool
hex BlockHash
bh = do
      BlockData
b <- ActionT (ReaderT WebState m) BlockData
-> (BlockData -> ActionT (ReaderT WebState m) BlockData)
-> Maybe BlockData
-> ActionT (ReaderT WebState m) BlockData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT (ReaderT WebState m) BlockData
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound) BlockData -> ActionT (ReaderT WebState m) BlockData
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BlockData -> ActionT (ReaderT WebState m) BlockData)
-> ActionT (ReaderT WebState m) (Maybe BlockData)
-> ActionT (ReaderT WebState m) BlockData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh
      [Transaction]
txs <- [Maybe Transaction] -> [Transaction]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Transaction] -> [Transaction])
-> ActionT (ReaderT WebState m) [Maybe Transaction]
-> ActionT (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxHash] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction BlockData
b.txs
      [BlockData]
nhs <- ([Maybe BlockData] -> [BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (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 (ReaderT WebState m) [Maybe BlockData]
 -> ActionT (ReaderT WebState m) [BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
-> ActionT (ReaderT WebState m) [BlockData]
forall a b. (a -> b) -> a -> b
$ Word32 -> ActionT (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) ActionT (ReaderT WebState m) [BlockHash]
-> ([BlockHash] -> ActionT (ReaderT WebState m) [Maybe BlockData])
-> ActionT (ReaderT WebState m) [Maybe BlockData]
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (BlockHash -> ActionT (ReaderT WebState m) (Maybe BlockData))
-> [BlockHash] -> ActionT (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 (ReaderT WebState m) (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock
      let h :: r -> BlockHash
h r
x = BlockHeader -> BlockHash
H.headerHash r
x.header
          nxt :: [BlockHash]
nxt = [BlockData -> BlockHash
forall {r}. HasField "header" r BlockHeader => r -> BlockHash
h BlockData
n | BlockData
n <- [BlockData]
nhs, BlockData
n.header.prev BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockData -> BlockHash
forall {r}. HasField "header" r BlockHeader => r -> BlockHash
h BlockData
b]
      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 (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
          Text -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT (ReaderT WebState m) ())
-> (Put -> Text) -> Put -> ActionT (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 (ReaderT WebState m) ())
-> Put -> ActionT (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 bts :: [BinfoTx]
bts = (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]
bts [BlockHash]
nxt
          ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
          Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
          Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
          Encoding -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT (ReaderT WebState m) ())
-> Encoding -> ActionT (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 ->
  ActionT m (Either Except Transaction)
getBinfoTx :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> ActionT 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 (ReaderT WebState m) (Maybe Transaction)
-> ActionT (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction TxHash
h
    BinfoTxIdIndex Word64
i -> Word64 -> ActionT (ReaderT WebState m) [Transaction]
forall (m :: * -> *). StoreReadExtra m => Word64 -> m [Transaction]
getNumTransaction Word64
i
  case [Transaction]
tx of
    [Transaction
t] -> Either Except Transaction -> ActionT m (Either Except Transaction)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction
 -> ActionT m (Either Except Transaction))
-> Either Except Transaction
-> ActionT 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 -> ActionT m (Either Except Transaction)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction
 -> ActionT m (Either Except Transaction))
-> Either Except Transaction
-> ActionT 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 -> ActionT m (Either Except Transaction)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Except Transaction
 -> ActionT m (Either Except Transaction))
-> Either Except Transaction
-> ActionT 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) => ActionT m ()
scottyBinfoTx :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTx =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoTxRaw) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Bool
hex <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getBinfoHex
    BinfoTxId
txid <- Text -> ActionT (ReaderT WebState m) BinfoTxId
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"txid"
    Transaction
tx <-
      BinfoTxId -> ActionT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> ActionT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid ActionT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT (ReaderT WebState m) Transaction)
-> ActionT (ReaderT WebState m) Transaction
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Transaction
t -> Transaction -> ActionT (ReaderT WebState m) Transaction
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
        Left Except
e -> Except -> ActionT (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
e
    if Bool
hex then Transaction -> ActionT m ()
forall {m :: * -> *}. MonadIO m => Transaction -> ActionT m ()
hx Transaction
tx else Bool -> Transaction -> ActionT m ()
forall {m :: * -> *}.
MonadIO m =>
Bool -> Transaction -> ActionT (ReaderT WebState m) ()
js Bool
numtxid Transaction
tx
  where
    js :: Bool -> Transaction -> ActionT (ReaderT WebState m) ()
js Bool
numtxid Transaction
t = do
      Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
      Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
      ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
      Encoding -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT (ReaderT WebState m) ())
-> Encoding -> ActionT (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 m ()
hx Transaction
t = do
      ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
      Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> (Tx -> Text) -> Tx -> ActionT 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 m ()) -> Tx -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData Transaction
t

scottyBinfoTotalOut :: (MonadUnliftIO m, MonadLoggerIO m) => ActionT m ()
scottyBinfoTotalOut :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTotalOut =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQtxtotalbtcoutput) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    BinfoTxId
txid <- Text -> ActionT (ReaderT WebState m) BinfoTxId
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"txid"
    Transaction
tx <-
      BinfoTxId -> ActionT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> ActionT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid ActionT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT (ReaderT WebState m) Transaction)
-> ActionT (ReaderT WebState m) Transaction
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Transaction
t -> Transaction -> ActionT (ReaderT WebState m) Transaction
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
        Left Except
e -> Except -> ActionT (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
e
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyBinfoTxFees :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTxFees =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQtxfee) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    BinfoTxId
txid <- Text -> ActionT (ReaderT WebState m) BinfoTxId
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"txid"
    Transaction
tx <-
      BinfoTxId -> ActionT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> ActionT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid ActionT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT (ReaderT WebState m) Transaction)
-> ActionT (ReaderT WebState m) Transaction
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Transaction
t -> Transaction -> ActionT (ReaderT WebState m) Transaction
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
        Left Except
e -> Except -> ActionT (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> ActionT 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 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) Transaction
tx.outputs
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ())
-> (Word64 -> Text) -> Word64 -> ActionT 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 -> ActionT m ()) -> Word64 -> ActionT 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) => ActionT m ()
scottyBinfoTxResult :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTxResult =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQtxresult) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    BinfoTxId
txid <- Text -> ActionT (ReaderT WebState m) BinfoTxId
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"txid"
    Address
addr <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    Transaction
tx <-
      BinfoTxId -> ActionT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> ActionT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid ActionT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT (ReaderT WebState m) Transaction)
-> ActionT (ReaderT WebState m) Transaction
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Transaction
t -> Transaction -> ActionT (ReaderT WebState m) Transaction
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
        Left Except
e -> Except -> ActionT (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> ActionT 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) 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) Transaction
tx.outputs
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyBinfoTotalInput :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoTotalInput =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQtxtotalbtcinput) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    BinfoTxId
txid <- Text -> ActionT (ReaderT WebState m) BinfoTxId
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"txid"
    Transaction
tx <-
      BinfoTxId -> ActionT m (Either Except Transaction)
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
BinfoTxId -> ActionT m (Either Except Transaction)
getBinfoTx BinfoTxId
txid ActionT m (Either Except Transaction)
-> (Either Except Transaction
    -> ActionT (ReaderT WebState m) Transaction)
-> ActionT (ReaderT WebState m) Transaction
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Transaction
t -> Transaction -> ActionT (ReaderT WebState m) Transaction
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction
t
        Left Except
e -> Except -> ActionT (ReaderT WebState m) Transaction
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
e
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyBinfoMempool :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoMempool =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoMempool) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
numtxid <- ActionT m Bool
forall (m :: * -> *). MonadUnliftIO m => ActionT m Bool
getNumTxId
    Int
offset <- ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => ActionT m Int
getBinfoOffset
    Int
n <- Text -> ActionT m Int
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Int
getBinfoCount Text
"limit"
    [(Word64, TxHash)]
mempool <- ActionT (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 (ReaderT WebState m) [Maybe Transaction]
-> ActionT (ReaderT WebState m) [Transaction]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> ActionT (ReaderT WebState m) (Maybe Transaction))
-> [TxHash] -> ActionT (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 (ReaderT WebState m) (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction [TxHash]
txids
    Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT 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
    Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
    Encoding -> ActionT m ()
forall (m :: * -> *). MonadIO m => Encoding -> ActionT m ()
streamEncoding (Encoding -> ActionT m ()) -> Encoding -> ActionT 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) => ActionT m ()
scottyBinfoGetBlockCount :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoGetBlockCount =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQgetblockcount) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    BlockNode
bn <- Chain -> ActionT (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show BlockNode
bn.height

scottyBinfoLatestHash :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoLatestHash :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoLatestHash =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQlatesthash) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    BlockNode
bn <- Chain -> ActionT (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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 BlockNode
bn.header

scottyBinfoSubsidy :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoSubsidy :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoSubsidy =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQbcperblock) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Chain
ch <- (WebState -> Chain) -> ActionT (ReaderT WebState m) Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
    Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    BlockNode
bn <- Chain -> ActionT (ReaderT WebState m) BlockNode
forall (m :: * -> *). MonadIO m => Chain -> m BlockNode
chainGetBest Chain
ch
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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) => ActionT m ()
scottyBinfoAddrToHash :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoAddrToHash =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQaddresstohash) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Address
addr <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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 Address
addr.hash160

scottyBinfoHashToAddr :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoHashToAddr :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoHashToAddr =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQhashtoaddress) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- ActionT (ReaderT WebState m) ByteString
-> (ByteString -> ActionT (ReaderT WebState m) ByteString)
-> Maybe ByteString
-> ActionT (ReaderT WebState m) ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT (ReaderT WebState m) ByteString
forall (m :: * -> *) a. Monad m => ActionT m a
S.next ByteString -> ActionT (ReaderT WebState m) ByteString
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> ActionT (ReaderT WebState m) ByteString)
-> (Text -> Maybe ByteString)
-> Text
-> ActionT (ReaderT WebState m) ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> ActionT (ReaderT WebState m) ByteString)
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"hash"
    Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    Hash160
hash <- (String -> ActionT (ReaderT WebState m) Hash160)
-> (Hash160 -> ActionT (ReaderT WebState m) Hash160)
-> Either String Hash160
-> ActionT (ReaderT WebState m) Hash160
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ActionT (ReaderT WebState m) Hash160
-> String -> ActionT (ReaderT WebState m) Hash160
forall a b. a -> b -> a
const ActionT (ReaderT WebState m) Hash160
forall (m :: * -> *) a. Monad m => ActionT m a
S.next) Hash160 -> ActionT (ReaderT WebState m) Hash160
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Hash160 -> ActionT (ReaderT WebState m) Hash160)
-> Either String Hash160 -> ActionT (ReaderT WebState m) Hash160
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Hash160
forall a. Serialize a => ByteString -> Either String a
decode ByteString
bs
    Text
addr <- ActionT (ReaderT WebState m) Text
-> (Text -> ActionT (ReaderT WebState m) Text)
-> Maybe Text
-> ActionT (ReaderT WebState m) Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT (ReaderT WebState m) Text
forall (m :: * -> *) a. Monad m => ActionT m a
S.next Text -> ActionT (ReaderT WebState m) Text
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> ActionT (ReaderT WebState m) Text)
-> Maybe Text -> ActionT (ReaderT WebState m) Text
forall a b. (a -> b) -> a -> b
$ Network -> Address -> Maybe Text
addrToText Network
net (Address -> Maybe Text) -> Address -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Hash160 -> Address
PubKeyAddress Hash160
hash
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
addr

scottyBinfoAddrPubkey :: (MonadUnliftIO m) => ActionT m ()
scottyBinfoAddrPubkey :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoAddrPubkey =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQaddrpubkey) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Text
hex <- Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"pubkey"
    Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
    Address
pubkey <-
      ActionT (ReaderT WebState m) Address
-> (PublicKey -> ActionT (ReaderT WebState m) Address)
-> Maybe PublicKey
-> ActionT (ReaderT WebState m) Address
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT (ReaderT WebState m) Address
forall (m :: * -> *) a. Monad m => ActionT m a
S.next (Address -> ActionT (ReaderT WebState m) Address
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> ActionT (ReaderT WebState m) Address)
-> (PublicKey -> Address)
-> PublicKey
-> ActionT (ReaderT WebState m) Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx) (Maybe PublicKey -> ActionT (ReaderT WebState m) Address)
-> Maybe PublicKey -> ActionT (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 <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    case Network -> Address -> Maybe Text
addrToText Network
net Address
pubkey of
      Maybe Text
Nothing -> Except -> ActionT m ()
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
      Just Text
a -> Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
a

scottyBinfoPubKeyAddr :: (MonadUnliftIO m, MonadLoggerIO m) => ActionT m ()
scottyBinfoPubKeyAddr :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
ActionT m ()
scottyBinfoPubKeyAddr =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQpubkeyaddr) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Address
addr <- Text -> ActionT m Address
forall (m :: * -> *). MonadUnliftIO m => Text -> ActionT m Address
getAddress (Text -> ActionT m Address)
-> ActionT (ReaderT WebState m) Text -> ActionT m Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"addr"
    Maybe StoreInput
mi <- Address -> ActionT (ReaderT WebState m) (Maybe StoreInput)
forall {m :: * -> *}.
StoreReadExtra m =>
Address -> m (Maybe StoreInput)
strm Address
addr
    StoreInput
i <- case Maybe StoreInput
mi of
      Maybe StoreInput
Nothing -> Except -> ActionT (ReaderT WebState m) StoreInput
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
ThingNotFound
      Just StoreInput
i -> StoreInput -> ActionT (ReaderT WebState m) StoreInput
forall a. a -> ActionT (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 (ReaderT WebState m) ByteString
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise (Except -> ActionT (ReaderT WebState m) ByteString)
-> Except -> ActionT (ReaderT WebState m) ByteString
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
e
      Right ByteString
t -> ByteString -> ActionT (ReaderT WebState m) ByteString
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
t
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHexLazy (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
pk
  where
    strm :: Address -> m (Maybe StoreInput)
strm Address
addr = do
      ConduitT () Void m (Maybe StoreInput) -> m (Maybe StoreInput)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m (Maybe StoreInput) -> m (Maybe StoreInput))
-> ConduitT () Void m (Maybe StoreInput) -> m (Maybe StoreInput)
forall a b. (a -> b) -> a -> b
$ do
        let l :: Limits
l = Limits {$sel:limit:Limits :: Word32
limit = Word32
8, $sel:offset:Limits :: Word32
offset = Word32
0, $sel:start:Limits :: Maybe Start
start = Maybe Start
forall a. Maybe a
Nothing}
        (Limits -> m [TxRef])
-> Maybe (TxRef -> TxHash) -> Limits -> ConduitT () TxRef m ()
forall (m :: * -> *) a.
Monad m =>
(Limits -> m [a])
-> Maybe (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings (Address -> Limits -> m [TxRef]
forall (m :: * -> *).
StoreReadExtra m =>
Address -> Limits -> m [TxRef]
getAddressTxs Address
addr) ((TxRef -> TxHash) -> Maybe (TxRef -> TxHash)
forall a. a -> Maybe a
Just (.txid)) Limits
l
          ConduitT () TxRef m ()
-> ConduitT TxRef Void m (Maybe StoreInput)
-> ConduitT () Void 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 -> m (Maybe Transaction))
-> ConduitT TxRef (Element (Maybe Transaction)) m ()
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> m mono) -> ConduitT a (Element mono) m ()
concatMapMC (TxHash -> m (Maybe Transaction)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (Maybe Transaction)
getTransaction (TxHash -> m (Maybe Transaction))
-> (TxRef -> TxHash) -> TxRef -> m (Maybe Transaction)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.txid))
          ConduitT TxRef Transaction m ()
-> ConduitT Transaction Void m (Maybe StoreInput)
-> ConduitT TxRef Void 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]) 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 m ()
-> ConduitT StoreInput Void m (Maybe StoreInput)
-> ConduitT Transaction Void 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 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) => ActionT m ()
scottyBinfoHashPubkey :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyBinfoHashPubkey =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.binfoQhashpubkey) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
    Maybe PublicKey
pkm <-
      (Text -> Maybe PublicKey)
-> ActionT (ReaderT WebState m) Text
-> ActionT (ReaderT WebState m) (Maybe PublicKey)
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (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 -> ActionT (ReaderT WebState m) Text
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
"pubkey")
    Address
addr <- case Maybe PublicKey
pkm of
      Maybe PublicKey
Nothing -> Except -> ActionT (ReaderT WebState m) Address
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise (Except -> ActionT (ReaderT WebState m) Address)
-> Except -> ActionT (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 (ReaderT WebState m) Address
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address -> ActionT (ReaderT WebState m) Address)
-> Address -> ActionT (ReaderT WebState m) Address
forall a b. (a -> b) -> a -> b
$ Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx PublicKey
pk
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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 Address
addr.hash160

-- GET Network Information --

scottyPeers ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  GetPeers ->
  ActionT m [PeerInfo]
scottyPeers :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
GetPeers -> ActionT m [PeerInfo]
scottyPeers GetPeers
_ =
  (WebMetrics -> StatTiming)
-> ActionT m [PeerInfo] -> ActionT m [PeerInfo]
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.peers) (ActionT m [PeerInfo] -> ActionT m [PeerInfo])
-> ActionT m [PeerInfo] -> ActionT m [PeerInfo]
forall a b. (a -> b) -> a -> b
$ do
    ReaderT WebState m [PeerInfo] -> ActionT m [PeerInfo]
forall (m :: * -> *) a. Monad m => m a -> ActionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT WebState m [PeerInfo] -> ActionT m [PeerInfo])
-> (PeerMgr -> ReaderT WebState m [PeerInfo])
-> PeerMgr
-> ActionT m [PeerInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerMgr -> ReaderT WebState m [PeerInfo]
forall (m :: * -> *). MonadLoggerIO m => PeerMgr -> m [PeerInfo]
getPeersInformation (PeerMgr -> ActionT m [PeerInfo])
-> ActionT (ReaderT WebState m) PeerMgr -> ActionT m [PeerInfo]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (WebState -> PeerMgr) -> ActionT (ReaderT WebState m) PeerMgr
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.peerMgr)

-- | 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) => GetHealth -> ActionT m HealthCheck
scottyHealth :: forall (m :: * -> *).
MonadUnliftIO m =>
GetHealth -> ActionT m HealthCheck
scottyHealth GetHealth
_ =
  (WebMetrics -> StatTiming)
-> ActionT m HealthCheck -> ActionT m HealthCheck
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.health) (ActionT m HealthCheck -> ActionT m HealthCheck)
-> ActionT m HealthCheck -> ActionT m HealthCheck
forall a b. (a -> b) -> a -> b
$ do
    HealthCheck
h <- (WebState -> TVar HealthCheck)
-> ActionT (ReaderT WebState m) (TVar HealthCheck)
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.health) ActionT (ReaderT WebState m) (TVar HealthCheck)
-> (TVar HealthCheck -> ActionT m HealthCheck)
-> ActionT m HealthCheck
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar HealthCheck -> ActionT m HealthCheck
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO
    Bool
-> ActionT (ReaderT WebState m) ()
-> ActionT (ReaderT WebState m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h) (ActionT (ReaderT WebState m) ()
 -> ActionT (ReaderT WebState m) ())
-> ActionT (ReaderT WebState m) ()
-> ActionT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$ Status -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
S.status Status
status503
    HealthCheck -> ActionT m HealthCheck
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
h

blockHealthCheck ::
  (MonadUnliftIO m, StoreReadBase m) =>
  WebConfig ->
  m BlockHealth
blockHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO 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, StoreReadBase m) =>
  Chain ->
  WebLimits ->
  m TimeHealth
lastBlockHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
Chain -> WebLimits -> m TimeHealth
lastBlockHealthCheck Chain
ch WebLimits {Word64
$sel:blockTimeout:WebLimits :: WebLimits -> Word64
blockTimeout :: Word64
blockTimeout} = do
  Int64
n <- POSIXTime -> Int64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> m POSIXTime -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  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 Word64
blockTimeout
      }

lastTxHealthCheck ::
  (MonadUnliftIO m, StoreReadBase m) =>
  WebConfig ->
  m TimeHealth
lastTxHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig {Bool
$sel:noMempool:WebConfig :: WebConfig -> Bool
noMempool :: Bool
noMempool, $sel:store:WebConfig :: WebConfig -> Store
store = Store
store', WebLimits
$sel:limits:WebConfig :: WebConfig -> WebLimits
limits :: WebLimits
limits} = do
  Int64
n <- POSIXTime -> Int64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Int64) -> m POSIXTime -> m Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  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 WebLimits
limits.blockTimeout
        else WebLimits
limits.txTimeout

pendingTxsHealthCheck ::
  (MonadUnliftIO m, StoreReadBase m) =>
  WebConfig ->
  m MaxHealth
pendingTxsHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO 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, StoreReadBase m) =>
  WebConfig ->
  m CountHealth
peerHealthCheck :: forall (m :: * -> *).
(MonadUnliftIO 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, StoreReadBase m) =>
WebConfig -> m BlockHealth
blockHealthCheck WebConfig
cfg
  TimeHealth
lastBlock <- Chain -> WebLimits -> m TimeHealth
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
Chain -> WebLimits -> m TimeHealth
lastBlockHealthCheck WebConfig
cfg.store.chain WebConfig
cfg.limits
  TimeHealth
lastTx <- WebConfig -> m TimeHealth
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
WebConfig -> m TimeHealth
lastTxHealthCheck WebConfig
cfg
  MaxHealth
pendingTxs <- WebConfig -> m MaxHealth
forall (m :: * -> *).
(MonadUnliftIO m, StoreReadBase m) =>
WebConfig -> m MaxHealth
pendingTxsHealthCheck WebConfig
cfg
  CountHealth
peers <- WebConfig -> m CountHealth
forall (m :: * -> *).
(MonadUnliftIO 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) -> m POSIXTime -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  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) => ActionT m ()
scottyDbStats :: forall (m :: * -> *). MonadUnliftIO m => ActionT m ()
scottyDbStats =
  (WebMetrics -> StatTiming) -> ActionT m () -> ActionT m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(WebMetrics -> StatTiming) -> ActionT m a -> ActionT m a
withMetrics (.db) (ActionT m () -> ActionT m ()) -> ActionT m () -> ActionT m ()
forall a b. (a -> b) -> a -> b
$ do
    ActionT m ()
forall (m :: * -> *). MonadIO m => ActionT m ()
setHeaders
    DB
db <- (WebState -> DB) -> ActionT (ReaderT WebState m) DB
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.db.db)
    Maybe ByteString
statsM <- ReaderT WebState m (Maybe ByteString)
-> ActionT (ReaderT WebState m) (Maybe ByteString)
forall (m :: * -> *) a. Monad m => m a -> ActionT 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)
    Text -> ActionT m ()
forall (m :: * -> *). MonadIO m => Text -> ActionT m ()
S.text (Text -> ActionT m ()) -> Text -> ActionT 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 :: forall a m. (Param a, MonadUnliftIO m) => ActionT m (Maybe a)
paramOptional :: forall a (m :: * -> *).
(Param a, MonadUnliftIO m) =>
ActionT m (Maybe a)
paramOptional = do
  Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
  Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
  ([Text] -> Maybe [Text])
-> ActionT (ReaderT WebState m) [Text]
-> ActionT (ReaderT WebState m) (Maybe [Text])
forall a b.
(a -> b)
-> ActionT (ReaderT WebState m) a -> ActionT (ReaderT WebState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (Text -> ActionT (ReaderT WebState m) [Text]
forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
label) ActionT (ReaderT WebState m) (Maybe [Text])
-> ActionT (ReaderT WebState m) (Maybe [Text])
-> ActionT (ReaderT WebState m) (Maybe [Text])
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Maybe [Text] -> ActionT (ReaderT WebState m) (Maybe [Text])
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
forall a. Maybe a
Nothing ActionT (ReaderT WebState m) (Maybe [Text])
-> (Maybe [Text] -> ActionT m (Maybe a)) -> ActionT m (Maybe a)
forall a b.
ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) b)
-> ActionT (ReaderT WebState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe [Text]
Nothing -> Maybe a -> ActionT m (Maybe a)
forall a. a -> ActionT (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 -> ActionT m (Maybe a)
-> (a -> ActionT m (Maybe a)) -> Maybe a -> ActionT m (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT m (Maybe a)
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
err) (Maybe a -> ActionT m (Maybe a)
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ActionT m (Maybe a))
-> (a -> Maybe a) -> a -> ActionT m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) (Network -> Ctx -> [Text] -> Maybe a
forall a. Param a => Network -> Ctx -> [Text] -> Maybe a
parseParam Network
net Ctx
ctx [Text]
ts)
  where
    label :: Text
label = Text -> Text
TL.fromStrict (Proxy a -> Text
forall a. Param a => Proxy a -> Text
proxyLabel (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
    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
TL.unpack Text
label

-- | Raises an exception if the parameter is not supplied
paramRequired :: forall a m. (Param a, MonadUnliftIO m) => ActionT m a
paramRequired :: forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramRequired = ActionT (ReaderT WebState m) a
-> (a -> ActionT (ReaderT WebState m) a)
-> Maybe a
-> ActionT (ReaderT WebState m) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Except -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise Except
err) a -> ActionT (ReaderT WebState m) a
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ActionT (ReaderT WebState m) a)
-> ActionT (ReaderT WebState m) (Maybe a)
-> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ActionT (ReaderT WebState m) (Maybe a)
forall a (m :: * -> *).
(Param a, MonadUnliftIO m) =>
ActionT m (Maybe a)
paramOptional
  where
    label :: String
label = Text -> String
T.unpack (Proxy a -> Text
forall a. Param a => Proxy a -> Text
proxyLabel (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))
    err :: Except
err = String -> Except
UserError (String -> Except) -> String -> Except
forall a b. (a -> b) -> a -> b
$ String
"Param " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
label String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" 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, MonadUnliftIO m) => ActionT m a
paramDef :: forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT 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 (ReaderT WebState m) (Maybe a)
-> ActionT (ReaderT WebState m) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) (Maybe a)
forall a (m :: * -> *).
(Param a, MonadUnliftIO m) =>
ActionT m (Maybe a)
paramOptional

-- | Does not raise exceptions. Will call @Scotty.next@ if the parameter is
-- not supplied or if parsing fails.
paramCapture :: forall a m. (Param a, MonadUnliftIO m) => ActionT m a
paramCapture :: forall a (m :: * -> *). (Param a, MonadUnliftIO m) => ActionT m a
paramCapture = do
  Network
net <- (WebState -> Network) -> ActionT (ReaderT WebState m) Network
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.net)
  Ctx
ctx <- (WebState -> Ctx) -> ActionT (ReaderT WebState m) Ctx
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.ctx)
  [Text]
p <- Text -> ActionT (ReaderT WebState m) [Text]
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.captureParam Text
label ActionT (ReaderT WebState m) [Text]
-> ActionT (ReaderT WebState m) [Text]
-> ActionT (ReaderT WebState m) [Text]
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` ActionT (ReaderT WebState m) [Text]
forall (m :: * -> *) a. Monad m => ActionT m a
S.next
  ActionT m a -> (a -> ActionT m a) -> Maybe a -> ActionT m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ActionT m a
forall (m :: * -> *) a. Monad m => ActionT m a
S.next a -> ActionT m a
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Network -> Ctx -> [Text] -> Maybe a
forall a. Param a => Network -> Ctx -> [Text] -> Maybe a
parseParam Network
net Ctx
ctx [Text]
p)
  where
    label :: Text
label = Text -> Text
TL.fromStrict (Proxy a -> Text
forall a. Param a => Proxy a -> Text
proxyLabel (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

parseBody :: (MonadIO m, Serial a) => ActionT m a
parseBody :: forall (m :: * -> *) a. (MonadIO m, Serial a) => ActionT m a
parseBody = do
  ByteString
b <- ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> ActionT (ReaderT WebState m) ByteString
-> ActionT (ReaderT WebState m) ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionT (ReaderT WebState m) ByteString
forall (m :: * -> *). MonadIO m => ActionT 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 -> ActionT m a
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise (Except -> ActionT m a) -> Except -> ActionT m a
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
"Failed to parse request body"
    Right a
x -> a -> ActionT m a
forall a. a -> ActionT (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 :: (MonadUnliftIO m) => ActionT m OffsetParam
parseOffset :: forall (m :: * -> *). MonadUnliftIO m => ActionT m OffsetParam
parseOffset = do
  res :: OffsetParam
res@(OffsetParam Natural
o) <- ActionT m OffsetParam
forall a (m :: * -> *).
(Default a, Param a, MonadUnliftIO m) =>
ActionT m a
paramDef
  WebLimits
limits <- (WebState -> WebLimits) -> ActionT (ReaderT WebState m) WebLimits
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.limits)
  Bool
-> ActionT (ReaderT WebState m) ()
-> ActionT (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 (ReaderT WebState m) ()
 -> ActionT (ReaderT WebState m) ())
-> ActionT (ReaderT WebState m) ()
-> ActionT (ReaderT WebState m) ()
forall a b. (a -> b) -> a -> b
$
    Except -> ActionT (ReaderT WebState m) ()
forall (m :: * -> *) a. MonadIO m => Except -> ActionT m a
raise (Except -> ActionT (ReaderT WebState m) ())
-> (String -> Except) -> String -> ActionT (ReaderT WebState m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Except
UserError (String -> ActionT (ReaderT WebState m) ())
-> String -> ActionT (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 -> ActionT m OffsetParam
forall a. a -> ActionT (ReaderT WebState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return OffsetParam
res

parseStart ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  Maybe StartParam ->
  ActionT m (Maybe Start)
parseStart :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Maybe StartParam -> ActionT m (Maybe Start)
parseStart Maybe StartParam
Nothing = Maybe Start -> ActionT (ReaderT WebState m) (Maybe Start)
forall a. a -> ActionT (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 (ReaderT WebState m)) Start
-> ActionT (ReaderT WebState m) (Maybe Start)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ActionT (ReaderT WebState m)) Start
 -> ActionT (ReaderT WebState m) (Maybe Start))
-> MaybeT (ActionT (ReaderT WebState m)) Start
-> ActionT (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 (ReaderT WebState m)) Start
forall {m :: * -> *}. StoreReadBase m => Hash256 -> MaybeT m Start
start_tx Hash256
h MaybeT (ActionT (ReaderT WebState m)) Start
-> MaybeT (ActionT (ReaderT WebState m)) Start
-> MaybeT (ActionT (ReaderT WebState m)) Start
forall a.
MaybeT (ActionT (ReaderT WebState m)) a
-> MaybeT (ActionT (ReaderT WebState m)) a
-> MaybeT (ActionT (ReaderT WebState m)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hash256 -> MaybeT (ActionT (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 (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 (ReaderT WebState m)) Start
forall {t :: (* -> *) -> * -> *} {r} {m :: * -> *} {b} {b}.
(MonadTrans t, MonadReader r m, HasField "store" b b,
 HasField "chain" b Chain, HasField "config" r b, MonadIO (t m),
 StoreReadExtra (t m)) =>
Word64 -> MaybeT (t 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 (t m) Start
start_time Word64
q = do
      Chain
ch <- t m Chain -> MaybeT (t 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 (t m Chain -> MaybeT (t m) Chain)
-> t m Chain -> MaybeT (t m) Chain
forall a b. (a -> b) -> a -> b
$ (r -> Chain) -> t m Chain
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.config.store.chain)
      BlockData
b <- t m (Maybe BlockData) -> MaybeT (t m) BlockData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (t m (Maybe BlockData) -> MaybeT (t m) BlockData)
-> t m (Maybe BlockData) -> MaybeT (t m) BlockData
forall a b. (a -> b) -> a -> b
$ Chain -> Word64 -> t m (Maybe BlockData)
forall (m :: * -> *).
(MonadIO m, StoreReadExtra m) =>
Chain -> Word64 -> m (Maybe BlockData)
blockAtOrBefore Chain
ch Word64
q
      Start -> MaybeT (t m) Start
forall a. a -> MaybeT (t m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Start -> MaybeT (t m) Start) -> Start -> MaybeT (t m) Start
forall a b. (a -> b) -> a -> b
$ Word32 -> Start
AtBlock BlockData
b.height

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

paramToLimits ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  Bool ->
  LimitsParam ->
  ActionT m Limits
paramToLimits :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Bool -> LimitsParam -> ActionT m Limits
paramToLimits Bool
full (LimitsParam Maybe LimitParam
limitM OffsetParam
o Maybe StartParam
startM) = do
  WebLimits
wl <- (WebState -> WebLimits) -> ActionT (ReaderT WebState m) WebLimits
forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl (.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 (ReaderT WebState m) (Maybe Start) -> ActionT m Limits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StartParam -> ActionT (ReaderT WebState m) (Maybe Start)
forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
Maybe StartParam -> ActionT 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 (DatabaseReaderT m) a
f = do
  DatabaseReader
bdb <- (WebState -> DatabaseReader) -> ReaderT WebState m DatabaseReader
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.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 (DatabaseReaderT m) a -> ReaderT DatabaseReader m a
forall (m :: * -> *) a. Maybe CacheConfig -> CacheT m a -> m a
withCache Maybe CacheConfig
mc CacheT (DatabaseReaderT m) a
f) DatabaseReader
bdb

runNoCache ::
  (MonadIO m) =>
  Bool ->
  ReaderT WebState m a ->
  ReaderT WebState m a
runNoCache :: forall (m :: * -> *) a.
MonadIO m =>
Bool -> ReaderT WebState m a -> ReaderT WebState m a
runNoCache Bool
False = ReaderT WebState m a -> ReaderT WebState m a
forall a. a -> a
id
runNoCache Bool
True = (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)
 -> ReaderT WebState m a -> ReaderT WebState m a)
-> (WebState -> WebState)
-> ReaderT WebState m a
-> ReaderT WebState m a
forall a b. (a -> b) -> a -> b
$ \WebState
s ->
  WebState
s {config = s.config {store = s.config.store {cache = Nothing}}}

logIt ::
  (MonadUnliftIO m, MonadLoggerIO m) =>
  m Middleware
logIt :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLoggerIO m) =>
m Middleware
logIt = 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 ->
    Application
app Request
req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      let s :: Status
s = Response -> Status
responseStatus Response
res
          msg :: Text
msg = Request -> Text
fmtReq 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

fmtReq :: Request -> Text
fmtReq :: Request -> Text
fmtReq 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
   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))

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)

rescue ::
  (MonadUnliftIO m) =>
  S.ActionT m a ->
  S.ActionT m a ->
  S.ActionT m a
ActionT m a
x rescue :: forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` ActionT m a
y = ActionT m a
x ActionT m a -> (StatusError -> ActionT m a) -> ActionT m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
ActionT m a -> (e -> ActionT m a) -> ActionT m a
`S.rescue` \S.StatusError {} -> ActionT m a
y

param ::
  (MonadUnliftIO m, S.Parsable a) =>
  TL.Text ->
  S.ActionT m a
param :: forall (m :: * -> *) a.
(MonadUnliftIO m, Parsable a) =>
Text -> ActionT m a
param Text
t = Text -> ActionT m a
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.queryParam Text
t ActionT m a -> ActionT m a -> ActionT m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
ActionT m a -> ActionT m a -> ActionT m a
`rescue` Text -> ActionT m a
forall a (m :: * -> *).
(Parsable a, Monad m) =>
Text -> ActionT m a
S.formParam Text
t

askl :: (MonadTrans t, MonadReader r m) => (r -> a) -> t m a
askl :: forall (t :: (* -> *) -> * -> *) r (m :: * -> *) a.
(MonadTrans t, MonadReader r m) =>
(r -> a) -> t m a
askl r -> a
f = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> a
f)