haskoin-store 0.47.3 → 0.47.4
raw patch · 6 files changed
+315/−137 lines, 6 filesdep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskoin-store-data
API changes (from Hackage documentation)
+ Haskoin.Store: xPubTxCount :: StoreReadExtra m => XPubSpec -> m Word32
+ Haskoin.Store.Common: xPubTxCount :: StoreReadExtra m => XPubSpec -> m Word32
Files
- CHANGELOG.md +13/−0
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/Cache.hs +86/−62
- src/Haskoin/Store/Common.hs +5/−6
- src/Haskoin/Store/Logic.hs +3/−6
- src/Haskoin/Store/Web.hs +203/−58
CHANGELOG.md view
@@ -4,6 +4,19 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html) +## 0.47.4+### Added+- Implement Blockchain.info block height.+- Implement Blockchain.info raw address.+- Implement Blockchain.info balances.++### Fixed+- Make Blockchain.info unspent endpoint more efficient.+- Make Blockchain.info xpubs endpoint more efficient.++### Changed+- Use compact JSON serialization by default everywhere.+ ## 0.47.3 ### Fixed - Fix serialization bug with unspents.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d755d5288e6cafa79a1b58ad901077e5d1c297d75a71bd7654b506751c772719+-- hash: e71c4b84b22cfac8473981ce40d82ce5e538c083b247b7957818865889ce4541 name: haskoin-store-version: 0.47.3+version: 0.47.4 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at <https://github.com/haskoin/haskoin-store#readme> category: Bitcoin, Finance, Network@@ -61,7 +61,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0- , haskoin-store-data ==0.47.3+ , haskoin-store-data ==0.47.4 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -113,7 +113,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.47.3+ , haskoin-store-data ==0.47.4 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -170,7 +170,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.47.3+ , haskoin-store-data ==0.47.4 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Cache.hs view
@@ -222,6 +222,10 @@ ask >>= \case Nothing -> lift (xPubTxs xpub limits) Just cfg -> lift (runReaderT (getXPubTxs xpub limits) cfg)+ xPubTxCount xpub =+ ask >>= \case+ Nothing -> lift (xPubTxCount xpub)+ Just cfg -> lift (runReaderT (getXPubTxCount xpub) cfg) getMaxGap = lift getMaxGap getInitialGap = lift getInitialGap getNumTxData = lift . getNumTxData@@ -241,73 +245,81 @@ getXPubTxs :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) => XPubSpec -> Limits -> CacheX m [TxRef]-getXPubTxs xpub limits = do- xpubtxt <- xpubText xpub- isXPubCached xpub >>= \case+getXPubTxs xpub limits = go Nothing+ where+ go m = isXPubCached xpub >>= \case True -> do- incrementCounter cacheHits- txs <- cacheGetXPubTxs xpub limits- return txs- False -> do- bals <- lift $ xPubBals xpub- newXPubC xpub bals- lift $ xPubBalsTxs bals limits+ when (isNothing m) $ incrementCounter cacheHits+ cacheGetXPubTxs xpub limits+ False ->+ case m of+ Just bals -> lift $ xPubBalsTxs bals limits+ Nothing -> do+ bals <- lift $ xPubBals xpub+ newXPubC xpub bals+ go (Just bals) +getXPubTxCount :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)+ => XPubSpec -> CacheX m Word32+getXPubTxCount xpub = go False+ where+ go t = isXPubCached xpub >>= \case+ True -> do+ unless t $ incrementCounter cacheHits+ cacheGetXPubTxCount xpub+ False ->+ if t+ then lift $ xPubTxCount xpub+ else do+ bals <- lift $ xPubBals xpub+ newXPubC xpub bals+ go True+ getXPubUnspents :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) => XPubSpec -> Limits -> CacheX m [XPubUnspent]-getXPubUnspents xpub limits = do- xpubtxt <- xpubText xpub- isXPubCached xpub >>= \case- True -> do- incrementCounter cacheHits- bals <- cacheGetXPubBalances xpub- process bals- False -> do- bals <- lift $ xPubBals xpub- newXPubC xpub bals- lift $ xPubBalsUnspents bals limits+getXPubUnspents xpub limits = go Nothing where+ go m = isXPubCached xpub >>= \case+ True -> do+ when (isNothing m) $ incrementCounter cacheHits+ process =<< cacheGetXPubBalances xpub+ False -> case m of+ Just bals -> lift $ xPubBalsUnspents bals limits+ Nothing -> do+ bals <- lift $ xPubBals xpub+ newXPubC xpub bals+ go (Just bals) process bals = do ops <- map snd <$> cacheGetXPubUnspents xpub limits uns <- catMaybes <$> lift (mapM getUnspent ops)- let addrmap =- Map.fromList $- map (\b -> (balanceAddress (xPubBal b), xPubBalPath b)) bals- addrutxo =- mapMaybe- (\u ->- either- (const Nothing)- (\a -> Just (a, u))- (scriptToAddressBS (unspentScript u)))- uns- xpubutxo =- mapMaybe- (\(a, u) -> (`XPubUnspent` u) <$> Map.lookup a addrmap)- addrutxo- xpubtxt <- xpubText xpub- return xpubutxo+ let g b = (balanceAddress (xPubBal b), xPubBalPath b)+ addrmap = Map.fromList (map g bals)+ f u = either+ (const Nothing)+ (\a -> Just (a, u))+ (scriptToAddressBS (unspentScript u))+ addrutxo = mapMaybe f uns+ e (a, u) = (`XPubUnspent` u) <$> Map.lookup a addrmap+ return $ mapMaybe e addrutxo getXPubBalances :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) => XPubSpec -> CacheX m [XPubBal]-getXPubBalances xpub = do- xpubtxt <- xpubText xpub- isXPubCached xpub >>= \case- True -> do- incrementCounter cacheHits- cacheGetXPubBalances xpub- False -> do- bals <- lift $ xPubBals xpub- newXPubC xpub bals- return bals+getXPubBalances xpub = isXPubCached xpub >>= \case+ True -> do+ incrementCounter cacheHits+ cacheGetXPubBalances xpub+ False -> do+ bals <- lift $ xPubBals xpub+ newXPubC xpub bals+ return bals isInCache :: MonadLoggerIO m => XPubSpec -> CacheT m Bool isInCache xpub = ask >>= \case- Nothing -> return False- Just cfg -> runReaderT (isXPubCached xpub) cfg+ Nothing -> return False+ Just cfg -> runReaderT (isXPubCached xpub) cfg isXPubCached :: MonadLoggerIO m => XPubSpec -> CacheX m Bool isXPubCached = runRedis . redisIsXPubCached@@ -321,6 +333,16 @@ touchKeys [xpub] return bals +cacheGetXPubTxCount :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)+ => XPubSpec -> CacheX m Word32+cacheGetXPubTxCount xpub = do+ count <- fromInteger <$> runRedis (redisGetXPubTxCount xpub)+ touchKeys [xpub]+ return count++redisGetXPubTxCount :: RedisCtx m f => XPubSpec -> m (f Integer)+redisGetXPubTxCount xpub = Redis.zcard (txSetPfx <> encode xpub)+ cacheGetXPubTxs :: (StoreReadBase m, MonadLoggerIO m) => XPubSpec@@ -355,16 +377,14 @@ -> Limits -> CacheX m [(BlockRef, OutPoint)] cacheGetXPubUnspents xpub limits = do- score <-- case start limits of- Nothing -> return Nothing- Just (AtTx th) ->- lift (getTxData th) >>= \case- Just TxData {txDataBlock = b@BlockRef {}} ->- return (Just (blockRefScore b))- _ -> return Nothing- Just (AtBlock h) ->- return (Just (blockRefScore (BlockRef h maxBound)))+ score <- case start limits of+ Nothing -> return Nothing+ Just (AtTx th) -> lift (getTxData th) >>= \case+ Just TxData {txDataBlock = b@BlockRef {}} ->+ return (Just (blockRefScore b))+ _ -> return Nothing+ Just (AtBlock h) ->+ return (Just (blockRefScore (BlockRef h maxBound))) xs <- runRedis $ getFromSortedSet@@ -881,7 +901,7 @@ getxbals xpubs = do bals <- runRedis . fmap sequence . forM xpubs $ \xpub -> do bs <- redisGetXPubBalances xpub- return $ (xpub, ) <$> bs+ return $ (,) xpub <$> bs return $ HashMap.filter (not . null) (HashMap.fromList bals) allops = map snd $ concatMap txInputs txs <> concatMap txOutputs txs alladdrs =@@ -1258,7 +1278,11 @@ => XPubSpec -> CacheX m Text xpubText xpub = do net <- lift getNetwork- return . cs $ xPubExport net (xPubSpecKey xpub)+ let suffix = case xPubDeriveType xpub of+ DeriveNormal -> ""+ DeriveP2SH -> "/p2sh"+ DeriveP2WPKH -> "/p2wpkh"+ return . cs $ suffix <> xPubExport net (xPubSpecKey xpub) cacheNewBlock :: MonadIO m => CacheWriter -> m () cacheNewBlock = send CacheNewBlock
src/Haskoin/Store/Common.hs view
@@ -81,12 +81,9 @@ type Offset = Word32 type Limit = Word32 -data Start = AtTx- { atTxHash :: !TxHash- }- | AtBlock- { atBlockHeight :: !BlockHeight- }+data Start+ = AtTx{atTxHash :: !TxHash}+ | AtBlock{atBlockHeight :: !BlockHeight} deriving (Eq, Show) data Limits = Limits@@ -191,6 +188,8 @@ bs <- xPubBals xpub let as = map (balanceAddress . xPubBal) bs getAddressesTxs as limits+ xPubTxCount :: XPubSpec -> m Word32+ xPubTxCount xpub = fromIntegral . length <$> xPubTxs xpub def getMaxGap :: m Word32 getInitialGap :: m Word32
src/Haskoin/Store/Logic.hs view
@@ -688,14 +688,11 @@ go (last ls) where go x =- lift (f (Limits 50 0 (Just (AtTx (g x))))) >>= \case+ lift (f (Limits 50 1 (Just (AtTx (g x))))) >>= \case [] -> return () ls -> do- case dropWhile ((== g x) . g) ls of- [] -> return ()- ls' -> do- mapM yield ls'- go (last ls')+ mapM yield ls+ go (last ls) joinStreams :: Monad m => (a -> a -> Ordering)
src/Haskoin/Store/Web.hs view
@@ -18,12 +18,13 @@ ) where import Conduit (ConduitT, await, dropC,- runConduit, sinkList, takeC,- yield, (.|))+ dropWhileC, mapC, runConduit,+ sinkList, takeC, yield, (.|)) import Control.Applicative ((<|>)) import Control.Arrow (second) import Control.Lens-import Control.Monad (forever, unless, when, (<=<))+import Control.Monad (forM, forever, unless, when,+ (<=<)) import Control.Monad.Logger (MonadLoggerIO, logDebugS, logErrorS, logInfoS) import Control.Monad.Reader (ReaderT, ask, asks, local,@@ -38,12 +39,12 @@ import Data.Aeson.Text (encodeToLazyText) import Data.ByteString.Builder (lazyByteString) import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Base16 as BL16 import qualified Data.ByteString.Lazy.Char8 as C import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial import Data.Char (isSpace)-import qualified Data.ByteString.Lazy.Base16 as BL16 import Data.Default (Default (..)) import Data.Function (on, (&)) import Data.HashMap.Strict (HashMap)@@ -199,6 +200,10 @@ , xPubUnspentResponseTime :: !StatDist , multiaddrResponseTime :: !StatDist , multiaddrErrors :: !ErrorCounter+ , rawaddrResponseTime :: !StatDist+ , rawaddrErrors :: !ErrorCounter+ , balanceResponseTime :: !StatDist+ , balanceErrors :: !ErrorCounter , unspentResponseTime :: !StatDist , unspentErrors :: !ErrorCounter , rawtxResponseTime :: !StatDist@@ -231,8 +236,12 @@ xPubTxResponseTime <- d "xpub_tx.response_time_ms" xPubTxFullResponseTime <- d "xpub_tx_full.response_time_ms" xPubUnspentResponseTime <- d "xpub_unspent.response_time_ms"+ rawaddrResponseTime <- d "rawaddr.response_time_ms"+ rawaddrErrors <- e "rawaddr.errors" multiaddrResponseTime <- d "multiaddr.response_time_ms" multiaddrErrors <- e "multiaddr.errors"+ balanceResponseTime <- d "balance.response_time_ms"+ balanceErrors <- e "balance.errors" rawtxResponseTime <- d "rawtx.response_time_ms" rawtxErrors <- e "rawtx.errors" peerResponseTime <- d "peer.response_time_ms"@@ -442,7 +451,7 @@ => S.ScottyT Except (ReaderT WebState m) () handlePaths = do -- Block Paths- pathPretty+ pathCompact (GetBlock <$> paramLazy <*> paramDef) scottyBlock blockDataToEncoding@@ -457,7 +466,7 @@ scottyBlockRaw (const toEncoding) (const toJSON)- pathPretty+ pathCompact (GetBlockBest <$> paramDef) scottyBlockBest blockDataToEncoding@@ -472,7 +481,7 @@ (fmap SerialList . scottyBlockLatest) (\n -> list (blockDataToEncoding n) . getSerialList) (\n -> json_list blockDataToJSON n . getSerialList)- pathPretty+ pathCompact (GetBlockHeight <$> paramLazy <*> paramDef) (fmap SerialList . scottyBlockHeight) (\n -> list (blockDataToEncoding n) . getSerialList)@@ -487,7 +496,7 @@ scottyBlockHeightRaw (const toEncoding) (const toJSON)- pathPretty+ pathCompact (GetBlockTime <$> paramLazy <*> paramDef) scottyBlockTime blockDataToEncoding@@ -497,7 +506,7 @@ scottyBlockTimeRaw (const toEncoding) (const toJSON)- pathPretty+ pathCompact (GetBlockMTP <$> paramLazy <*> paramDef) scottyBlockMTP blockDataToEncoding@@ -508,7 +517,7 @@ (const toEncoding) (const toJSON) -- Transaction Paths- pathPretty+ pathCompact (GetTx <$> paramLazy) scottyTx transactionToEncoding@@ -548,13 +557,13 @@ scottyPostTx (const toEncoding) (const toJSON)- pathPretty+ pathCompact (GetMempool <$> paramOptional <*> parseOffset) (fmap SerialList . scottyMempool) (const toEncoding) (const toJSON) -- Address Paths- pathPretty+ pathCompact (GetAddrTxs <$> paramLazy <*> parseLimits) (fmap SerialList . scottyAddrTxs) (const toEncoding)@@ -574,7 +583,7 @@ (fmap SerialList . scottyAddrsTxsFull) (\n -> list (transactionToEncoding n) . getSerialList) (\n -> json_list transactionToJSON n . getSerialList)- pathPretty+ pathCompact (GetAddrBalance <$> paramLazy) scottyAddrBalance balanceToEncoding@@ -584,7 +593,7 @@ (fmap SerialList . scottyAddrsBalance) (\n -> list (balanceToEncoding n) . getSerialList) (\n -> json_list balanceToJSON n . getSerialList)- pathPretty+ pathCompact (GetAddrUnspent <$> paramLazy <*> parseLimits) (fmap SerialList . scottyAddrUnspent) (\n -> list (unspentToEncoding n) . getSerialList)@@ -595,12 +604,12 @@ (\n -> list (unspentToEncoding n) . getSerialList) (\n -> json_list unspentToJSON n . getSerialList) -- XPubs- pathPretty+ pathCompact (GetXPub <$> paramLazy <*> paramDef <*> paramDef) scottyXPub (const toEncoding) (const toJSON)- pathPretty+ pathCompact (GetXPubTxs <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef) (fmap SerialList . scottyXPubTxs) (const toEncoding)@@ -610,23 +619,23 @@ (fmap SerialList . scottyXPubTxsFull) (\n -> list (transactionToEncoding n) . getSerialList) (\n -> json_list transactionToJSON n . getSerialList)- pathPretty+ pathCompact (GetXPubBalances <$> paramLazy <*> paramDef <*> paramDef) (fmap SerialList . scottyXPubBalances) (\n -> list (xPubBalToEncoding n) . getSerialList) (\n -> json_list xPubBalToJSON n . getSerialList)- pathPretty+ pathCompact (GetXPubUnspent <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef) (fmap SerialList . scottyXPubUnspent) (\n -> list (xPubUnspentToEncoding n) . getSerialList) (\n -> json_list xPubUnspentToJSON n . getSerialList) -- Network- pathPretty+ pathCompact (GetPeers & return) (fmap SerialList . scottyPeers) (const toEncoding) (const toJSON)- pathPretty+ pathCompact (GetHealth & return) scottyHealth (const toEncoding)@@ -636,10 +645,14 @@ -- Blockchain.info S.post "/blockchain/multiaddr" scottyMultiAddr S.get "/blockchain/multiaddr" scottyMultiAddr+ S.get "/blockchain/balance" scottyShortBal+ S.post "/blockchain/balance" scottyShortBal+ S.get "/blockchain/rawaddr/:addr" scottyRawAddr S.post "/blockchain/unspent" scottyBinfoUnspent S.get "/blockchain/unspent" scottyBinfoUnspent- S.get "/blockchain/rawtx/:txid" scottyBinfoTx- S.get "/blockchain/rawblock/:block" scottyBinfoBlock+ S.get "/blockchain/rawtx/:txid" scottyBinfoTx+ S.get "/blockchain/rawblock/:block" scottyBinfoBlock+ S.get "/blockchain/block-height/:height" scottyBinfoBlockHeight where json_list f net = toJSONList . map (f net) @@ -770,7 +783,7 @@ unsafeInterleaveIO . run $ getTransaction x >>= \case Nothing -> undefined- Just t -> return $ transactionData t+ Just t -> return $ transactionData t -- GET BlockBest / BlockBestRaw -- @@ -916,7 +929,7 @@ unsafeInterleaveIO . run $ getTransaction x >>= \case Nothing -> undefined- Just t -> return t+ Just t -> return t scottyTxsBlock :: (MonadUnliftIO m, MonadLoggerIO m) => GetTxsBlock -> WebT m [Transaction]@@ -1253,6 +1266,10 @@ getNumTxId :: MonadIO m => WebT m Bool getNumTxId = fmap not $ S.param "txidindex" `S.rescue` const (return False) +getChainHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m H.BlockHeight+getChainHeight =+ fmap H.nodeHeight $ chainGetBest =<< lift (asks (storeChain . webStore . webConfig))+ scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyBinfoUnspent = getBinfoActive unspentErrors >>= \(xspecs, addrs) ->@@ -1261,39 +1278,29 @@ get_min_conf >>= \min_conf -> let len = HashSet.size addrs + HashMap.size xspecs in withMetrics unspentResponseTime len $ do- xuns <- get_xpub_unspents xspecs- auns <- get_addr_unspents addrs net <- lift $ asks (storeNetwork . webStore . webConfig)- height <- get_height- let g k = map (xpub_unspent numtxid height k)- xbus = concatMap (uncurry g) (HashMap.toList xuns)- abus = map (unspent numtxid height) auns- f u@BinfoUnspent{..} =- ((getBinfoUnspentHash, getBinfoUnspentOutputIndex), u)- busm = HashMap.fromList (map f (xbus ++ abus))- bus =- take limit $- takeWhile ((min_conf <=) . getBinfoUnspentConfirmations) $- sortBy- (flip compare `on` getBinfoUnspentConfirmations)- (HashMap.elems busm)+ height <- getChainHeight+ let mn BinfoUnspent{..} = min_conf > getBinfoUnspentConfirmations+ xspecs' = HashSet.fromList $ HashMap.elems xspecs+ bus <- lift . runConduit $+ getBinfoUnspents numtxid height xspecs' addrs .|+ (dropWhileC mn >> takeC limit .| sinkList) setHeaders streamEncoding (binfoUnspentsToEncoding net (BinfoUnspents bus)) where get_limit = fmap (min 1000) $ S.param "limit" `S.rescue` const (return 250) get_min_conf = S.param "confirmations" `S.rescue` const (return 0)- get_height =- getBestBlock >>= \case- Nothing -> raise unspentErrors ThingNotFound- Just bh -> getBlock bh >>= \case- Nothing -> raise unspentErrors ThingNotFound- Just b -> return (blockDataHeight b)- xpub_unspent numtxid height xpub (XPubUnspent p u) =- let path = toSoft (listToPath p)- xp = BinfoXPubPath xpub <$> path- bu = unspent numtxid height u- in bu {getBinfoUnspentXPub = xp}- unspent numtxid height Unspent{..} =++getBinfoUnspents :: (StoreReadExtra m, MonadIO m)+ => Bool+ -> H.BlockHeight+ -> HashSet XPubSpec+ -> HashSet Address+ -> ConduitT () BinfoUnspent m ()+getBinfoUnspents numtxid height xspecs addrs =+ joinStreams (flip compare `on` fst) conduits .| mapC (uncurry binfo)+ where+ binfo Unspent{..} xp = let conf = case unspentBlock of MemRef{} -> 0 BlockRef h _ -> height - h + 1@@ -1309,10 +1316,25 @@ , getBinfoUnspentValue = val , getBinfoUnspentConfirmations = fromIntegral conf , getBinfoUnspentTxIndex = txi- , getBinfoUnspentXPub = Nothing+ , getBinfoUnspentXPub = xp }- get_xpub_unspents = mapM (`xPubUnspents` def)- get_addr_unspents = (`getAddressesUnspents` def) . HashSet.toList+ point_hash = outPointHash . unspentPoint+ conduits = xconduits <> acounduits+ xconduits =+ let f x (XPubUnspent p u) =+ let path = toSoft (listToPath p)+ xp = BinfoXPubPath (xPubSpecKey x) <$> path+ in (u, xp)+ g x =+ streamThings (xPubUnspents x) (point_hash . xPubUnspent) def .|+ mapC (f x)+ in map g (HashSet.toList xspecs)+ acounduits =+ let f u = (u, Nothing)+ g a =+ streamThings (getAddressUnspents a) point_hash def .|+ mapC f+ in map g (HashSet.toList addrs) getBinfoTxs :: (StoreReadExtra m, MonadIO m) => HashMap Address (Maybe BinfoXPubPath) -- address book@@ -1387,7 +1409,7 @@ let len = HashSet.size addrs' + HashSet.size xpubs in withMetrics multiaddrResponseTime len $ do xbals <- get_xbals xspecs- xtxns <- mapM count_txs xspecs+ xtxns <- mapM (fmap fromIntegral . xPubTxCount) xspecs let sxbals = subset sxpubs xbals xabals = compute_xabals xbals addrs = addrs' `HashSet.difference` HashMap.keysSet xabals@@ -1450,7 +1472,6 @@ , getBinfoMultiAddrCashAddr = cashaddr } where- count_txs xspec = length <$> xPubTxs xspec def get_filter = S.param "filter" `S.rescue` const (return BinfoFilterAll) get_best_block = getBestBlock >>= \case@@ -1557,11 +1578,126 @@ | otherwise = 0 received _ = 0 +scottyRawAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyRawAddr =+ get_addr >>= \addr ->+ getNumTxId >>= \numtxid ->+ get_offset >>= \off ->+ get_count >>= \n ->+ withMetrics rawaddrResponseTime 1 $ do+ bal <- fromMaybe (zeroBalance addr) <$> getBalance addr+ net <- lift $ asks (storeNetwork . webStore . webConfig)+ let abook = HashMap.singleton addr Nothing+ xspecs = HashSet.empty+ saddrs = HashSet.singleton addr+ bfilter = BinfoFilterAll+ b = fromIntegral $ balanceAmount bal + balanceZero bal+ txs <- lift . runConduit $+ getBinfoTxs abook xspecs saddrs saddrs bfilter numtxid False b .|+ (dropC off >> takeC n .| sinkList)+ setHeaders+ streamEncoding $ binfoRawAddrToEncoding net $ BinfoRawAddr bal txs+ where+ get_addr = do+ txt <- S.param "addr"+ net <- lift $ asks (storeNetwork . webStore . webConfig)+ case textToAddr net txt of+ Nothing -> raise rawaddrErrors ThingNotFound+ Just a -> return a+ get_count = do+ d <- lift (asks (maxLimitDefault . webMaxLimits . webConfig))+ x <- lift (asks (maxLimitFull . webMaxLimits . webConfig))+ i <- min x <$> (S.param "n" `S.rescue` const (return d))+ return $ fromIntegral i+ get_offset = do+ x <- lift (asks (maxLimitOffset . webMaxLimits . webConfig))+ o <- S.param "offset" `S.rescue` const (return 0)+ when (o > x) $+ raise rawaddrErrors $+ UserError $ "offset exceeded: " <> show o <> " > " <> show x+ return $ fromIntegral o++scottyShortBal :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyShortBal =+ getBinfoActive balanceErrors >>= \(xspecs, addrs) ->+ getNumTxId >>= \numtxid ->+ withMetrics balanceResponseTime (hl addrs + ml xspecs) $ do+ net <- lift $ asks (storeNetwork . webStore . webConfig)+ abals <- catMaybes <$> mapM (get_addr_balance net) (HashSet.toList addrs)+ xbals <- mapM (get_xspec_balance net) (HashMap.elems xspecs)+ let res = HashMap.fromList (abals <> xbals)+ setHeaders+ streamEncoding $ toEncoding res+ where+ hl = HashSet.size+ ml = HashMap.size+ to_short_bal Balance{..} =+ BinfoShortBal+ {+ binfoShortBalFinal = balanceAmount + balanceZero,+ binfoShortBalTxCount = balanceTxCount,+ binfoShortBalReceived = balanceTotalReceived+ }+ get_addr_balance net a =+ case addrToText net a of+ Nothing -> return Nothing+ Just a' -> getBalance a >>= \case+ Nothing -> return $ Just (a', to_short_bal (zeroBalance a))+ Just b -> return $ Just (a', to_short_bal b)+ is_ext XPubBal{xPubBalPath = 0:_} = True+ is_ext _ = False+ get_xspec_balance net xpub = do+ xbals <- xPubBals xpub+ xts <- xPubTxCount xpub+ let val = sum $ map balanceAmount $ map xPubBal xbals+ zro = sum $ map balanceZero $ map xPubBal xbals+ exs = filter is_ext xbals+ rcv = sum $ map balanceTotalReceived $ map xPubBal exs+ sbl =+ BinfoShortBal+ {+ binfoShortBalFinal = val + zro,+ binfoShortBalTxCount = fromIntegral xts,+ binfoShortBalReceived = rcv+ }+ return (xPubExport net (xPubSpecKey xpub), sbl)+ getBinfoHex :: Monad m => WebT m Bool getBinfoHex = (== ("hex" :: Text)) <$> S.param "format" `S.rescue` const (return "json") +scottyBinfoBlockHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoBlockHeight =+ getNumTxId >>= \numtxid ->+ withMetrics rawBlockResponseTime 1 $+ S.param "height" >>= \height ->+ getBlocksAtHeight height >>= \block_hashes -> do+ block_headers <- catMaybes <$> mapM getBlock block_hashes+ next_block_hashes <- getBlocksAtHeight (height + 1)+ next_block_headers <- catMaybes <$> mapM getBlock next_block_hashes+ binfo_blocks <-+ mapM (get_binfo_blocks numtxid next_block_headers) block_headers+ setHeaders+ net <- lift $ asks (storeNetwork . webStore . webConfig)+ streamEncoding $ binfoBlocksToEncoding net binfo_blocks+ where+ get_tx th =+ withRunInIO $ \run ->+ unsafeInterleaveIO $+ run $ fromJust <$> getTransaction th+ get_binfo_blocks numtxid next_block_headers block_header = do+ let my_hash = H.headerHash (blockDataHeader block_header)+ get_prev = H.prevBlock . blockDataHeader+ get_hash = H.headerHash . blockDataHeader+ txs <- lift $ mapM get_tx (blockDataTxs block_header)+ let next_blocks = map get_hash $+ filter ((== my_hash) . get_prev)+ next_block_headers+ let binfo_txs = map (toBinfoTxSimple numtxid) txs+ binfo_block = toBinfoBlock block_header binfo_txs next_blocks+ return binfo_block+ scottyBinfoBlock :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyBinfoBlock = getNumTxId >>= \numtxid ->@@ -1583,7 +1719,16 @@ Nothing -> raise blockErrors ThingNotFound Just b -> do txs <- lift $ mapM get_tx (blockDataTxs b)- nxt <- getBlocksAtHeight (blockDataHeight b + 1)+ let my_hash = H.headerHash (blockDataHeader b)+ get_prev = H.prevBlock . blockDataHeader+ get_hash = H.headerHash . blockDataHeader+ nxt_headers <-+ fmap catMaybes $+ mapM getBlock =<<+ getBlocksAtHeight (blockDataHeight b + 1)+ let nxt = map get_hash $+ filter ((== my_hash) . get_prev)+ nxt_headers if hex then do let x = H.Block (blockDataHeader b) (map transactionData txs)@@ -1786,7 +1931,7 @@ parseBody = do b <- S.body case hex b <> bin b of- Left _ -> raise_ $ UserError "Failed to parse request body"+ Left _ -> raise_ $ UserError "Failed to parse request body" Right x -> return x where bin = runGetL deserialize