haskoin-store 0.39.0 → 0.40.0
raw patch · 7 files changed
+416/−35 lines, 7 filesdep +lensdep +wreqdep ~haskoin-coredep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependencies added: lens, wreq
Dependency ranges changed: haskoin-core, haskoin-store-data
API changes (from Hackage documentation)
- Haskoin.Store.Database.Types: newtype TxKey
+ Haskoin.Store.Database.Types: data TxKey
+ Haskoin.Store.Web: [webNumTxId] :: WebConfig -> !Bool
- Haskoin.Store.Web: WebConfig :: !String -> !Int -> !Store -> !Int -> !Int -> !WebLimits -> !Bool -> !WebTimeouts -> !String -> !Bool -> WebConfig
+ Haskoin.Store.Web: WebConfig :: !String -> !Int -> !Store -> !Int -> !Int -> !WebLimits -> !Bool -> !WebTimeouts -> !String -> !Bool -> !Bool -> WebConfig
Files
- app/Main.hs +13/−0
- haskoin-store.cabal +13/−9
- src/Haskoin/Store.hs +2/−0
- src/Haskoin/Store/Database/Reader.hs +1/−2
- src/Haskoin/Store/Database/Types.hs +7/−6
- src/Haskoin/Store/Web.hs +375/−17
- test/Haskoin/StoreSpec.hs +5/−1
app/Main.hs view
@@ -70,6 +70,7 @@ , configMaxPeers :: !Int , configMaxDiff :: !Int , configCacheRefresh :: !Int+ , configNumTxId :: !Bool } instance Default Config where@@ -97,6 +98,7 @@ , configMaxPeers = defMaxPeers , configMaxDiff = defMaxDiff , configCacheRefresh = defCacheRefresh+ , configNumTxId = defNumTxId } defEnv :: MonadIO m => String -> a -> (String -> Maybe a) -> m a@@ -175,6 +177,11 @@ defEnv "REQ_LOG" False parseBool {-# NOINLINE defReqLog #-} +defNumTxId :: Bool+defNumTxId = unsafePerformIO $+ defEnv "NUMTXID" False parseBool+{-# NOINLINE defNumTxId #-}+ defWebLimits :: WebLimits defWebLimits = unsafePerformIO $ do max_limit <- defEnv "MAX_LIMIT" (maxLimitCount def) readMaybe@@ -443,6 +450,10 @@ <> long "max-diff" <> help "Maximum difference between headers and blocks" <> value (configMaxDiff def)+ configNumTxId <-+ flag (configNumTxId def) True $+ long "numtxid"+ <> help "Numeric tx_index field" pure Config { configWebLimits = WebLimits {..}@@ -515,6 +526,7 @@ , configMaxDiff = maxdiff , configNoMempool = nomem , configCacheRefresh = crefresh+ , configNumTxId = numtxid } = runStderrLoggingT . filterLogger l $ do $(logInfoS) "Main" $@@ -556,6 +568,7 @@ , webVersion = version , webMaxDiff = maxdiff , webNoMempool = nomem+ , webNumTxId = numtxid } where net' | asert == 0 = net
haskoin-store.cabal view
@@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack------ hash: 1ac7a6be927cf025cc64e6ab89e07165b9f66160e499e7e68deb1ff8d6bf1515 name: haskoin-store-version: 0.39.0+version: 0.40.0 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@@ -51,11 +49,12 @@ , data-default >=0.7.1.1 , deepseq >=1.4.4.0 , hashable >=1.3.0.0- , haskoin-core >=0.17.5+ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0- , haskoin-store-data ==0.38.1+ , haskoin-store-data ==0.40.0 , hedis >=0.12.13 , http-types >=0.12.3+ , lens >=4.18.1 , monad-logger >=0.3.32 , mtl >=2.2.2 , network >=3.1.1.1@@ -72,6 +71,7 @@ , unordered-containers >=0.2.10.0 , wai >=3.2.2.1 , warp >=3.3.10+ , wreq >=0.5.3.2 default-language: Haskell2010 executable haskoin-store@@ -93,12 +93,13 @@ , deepseq >=1.4.4.0 , filepath , hashable >=1.3.0.0- , haskoin-core >=0.17.5+ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.38.1+ , haskoin-store-data ==0.40.0 , hedis >=0.12.13 , http-types >=0.12.3+ , lens >=4.18.1 , monad-logger >=0.3.32 , mtl >=2.2.2 , network >=3.1.1.1@@ -116,6 +117,7 @@ , unordered-containers >=0.2.10.0 , wai >=3.2.2.1 , warp >=3.3.10+ , wreq >=0.5.3.2 default-language: Haskell2010 test-suite haskoin-store-test@@ -141,13 +143,14 @@ , data-default >=0.7.1.1 , deepseq >=1.4.4.0 , hashable >=1.3.0.0- , haskoin-core >=0.17.5+ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.38.1+ , haskoin-store-data ==0.40.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3+ , lens >=4.18.1 , monad-logger >=0.3.32 , mtl >=2.2.2 , network >=3.1.1.1@@ -164,5 +167,6 @@ , unordered-containers >=0.2.10.0 , wai >=3.2.2.1 , warp >=3.3.10+ , wreq >=0.5.3.2 default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover
src/Haskoin/Store.hs view
@@ -6,6 +6,7 @@ , module Haskoin.Store.BlockStore , module Haskoin.Store.Web , module Haskoin.Store.Database.Reader+ , module Haskoin.Store.Database.Types , module Haskoin.Store.Data -- * Cache , CacheConfig(..)@@ -35,5 +36,6 @@ import Haskoin.Store.Common import Haskoin.Store.Data import Haskoin.Store.Database.Reader+import Haskoin.Store.Database.Types import Haskoin.Store.Manager import Haskoin.Store.Web
src/Haskoin/Store/Database/Reader.hs view
@@ -135,8 +135,7 @@ getDatabaseReader h DatabaseReader{databaseHandle = db} = retrieveCF db (blockCF db) (BlockKey h) -getTxDataDB ::- MonadIO m => TxHash -> DatabaseReader -> m (Maybe TxData)+getTxDataDB :: MonadIO m => TxHash -> DatabaseReader -> m (Maybe TxData) getTxDataDB th DatabaseReader{databaseHandle = db} = retrieveCF db (txCF db) (TxKey th)
src/Haskoin/Store/Database/Types.hs view
@@ -26,15 +26,17 @@ import Control.DeepSeq (NFData) import Control.Monad (guard)+import Data.Bits (Bits, shiftL, shiftR, (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as BSS import Data.Default (Default (..))+import Data.Either (fromRight) import Data.Hashable (Hashable)-import Data.Serialize (Serialize (..), getBytes, getWord8,- putWord8)-import Data.Word (Word32, Word64)+import Data.Serialize (Serialize (..), decode, encode,+ getBytes, getWord8, putWord8, runPut)+import Data.Word (Word16, Word32, Word64, Word8) import Database.RocksDB.Query (Key, KeyValue) import GHC.Generics (Generic) import Haskoin (Address, BlockHash, BlockHeight,@@ -134,9 +136,8 @@ instance KeyValue AddrOutKey OutVal -- | Transaction database key.-newtype TxKey = TxKey- { txKey :: TxHash- } deriving (Show, Read, Eq, Ord, Generic, Hashable)+data TxKey = TxKey { txKey :: TxHash }+ deriving (Show, Read, Eq, Ord, Generic, Hashable) instance Serialize TxKey where -- 0x02 · TxHash
src/Haskoin/Store/Web.hs view
@@ -2,10 +2,12 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-} module Haskoin.Store.Web ( -- * Web WebConfig (..)@@ -18,9 +20,11 @@ import Conduit (await, runConduit, takeC, yield, (.|)) import Control.Applicative ((<|>))+import Control.Arrow (second)+import Control.Lens import Control.Monad (forever, unless, when, (<=<))-import Control.Monad.Logger (MonadLoggerIO, logErrorS,- logInfoS)+import Control.Monad.Logger (MonadLoggerIO, logDebugS,+ logErrorS, logInfoS) import Control.Monad.Reader (ReaderT, ask, asks, local, runReaderT) import Control.Monad.Trans (lift)@@ -36,24 +40,31 @@ import Data.Char (isSpace) import Data.Default (Default (..)) import Data.Function ((&))+import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet import Data.List (nub)-import Data.Maybe (catMaybes, fromMaybe,+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes, fromJust, fromMaybe, listToMaybe, mapMaybe) import Data.Proxy (Proxy (..)) import Data.Serialize as Serialize+import qualified Data.Set as Set import Data.String (fromString) import Data.String.Conversions (cs) import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Text.Lazy (toStrict)+import qualified Data.Text.Lazy as TL import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime) import Data.Time.Clock.System (getSystemTime, systemSeconds) import Data.Word (Word32, Word64) import Database.RocksDB (Property (..), getProperty)+import Haskoin.Address import qualified Haskoin.Block as H import Haskoin.Constants+import Haskoin.Keys import Haskoin.Network import Haskoin.Node (Chain, OnlinePeer (..), PeerManager, chainGetBest,@@ -74,12 +85,18 @@ responseStatus) import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort)+import qualified Network.Wreq as Wreq import NQE (Inbox, receive, withSubscription) import Text.Printf (printf)-import UnliftIO (MonadIO, MonadUnliftIO,- askRunInIO, liftIO, timeout)+import UnliftIO (MonadIO, MonadUnliftIO, TVar,+ askRunInIO, atomically,+ handleAny, liftIO, newTVarIO,+ readTVarIO, timeout, withAsync,+ writeTVar)+import UnliftIO.Concurrent (threadDelay) import Web.Scotty.Internal.Types (ActionT)+import Web.Scotty.Trans (Parsable) import qualified Web.Scotty.Trans as S type WebT m = ActionT Except (ReaderT WebConfig m)@@ -116,6 +133,7 @@ , webTimeouts :: !WebTimeouts , webVersion :: !String , webNoMempool :: !Bool+ , webNumTxId :: !Bool } data WebTimeouts = WebTimeouts@@ -180,19 +198,47 @@ -- Path Handlers -- ------------------- -runWeb :: (MonadUnliftIO m , MonadLoggerIO m) => WebConfig -> m ()-runWeb cfg@WebConfig {webHost = host, webPort = port, webReqLog = reqlog} = do- reqLogger <- logIt- runner <- askRunInIO- S.scottyOptsT opts (runner . (`runReaderT` cfg)) $ do- when reqlog $ S.middleware reqLogger- S.defaultHandler defHandler- handlePaths- S.notFound $ S.raise ThingNotFound+runWeb :: (MonadUnliftIO m, MonadLoggerIO m) => WebConfig -> m ()+runWeb cfg@WebConfig{ webHost = host+ , webPort = port+ , webReqLog = wl+ , webStore = store } = do+ ticker <- newTVarIO def+ withAsync (price (storeNetwork store) ticker) $ \_ -> do+ reqLogger <- logIt+ runner <- askRunInIO+ S.scottyOptsT opts (runner . (`runReaderT` cfg)) $ do+ when wl $ S.middleware reqLogger+ S.defaultHandler defHandler+ handlePaths ticker+ S.notFound $ S.raise ThingNotFound where opts = def {S.settings = settings defaultSettings} settings = setPort port . setHost (fromString host) +price :: (MonadUnliftIO m, MonadLoggerIO m) => Network -> TVar BinfoTicker -> m ()+price net v =+ case sym of+ Nothing -> return ()+ Just s -> go s+ where+ sym | net == btc = Just "BTC-USD"+ | net == bch = Just "BCH-USD"+ | otherwise = Nothing+ go s = forever $ do+ let err e = $(logErrorS) "Price" $ cs (show e)+ handleAny err $ do+ r <- liftIO $+ Wreq.asJSON =<<+ Wreq.get "https://api.blockchain.info/v3/exchange/tickers"+ let ts = r ^. Wreq.responseBody+ case listToMaybe $ filter ((== s) . binfoTickerSymbol) ts of+ Nothing -> $(logErrorS) "Price" $+ "No price information for symbol: " <> s+ Just t -> atomically $ writeTVar v t+ threadDelay $ 5 * 60 * 1000 * 1000 -- five minutes++ defHandler :: Monad m => Except -> WebT m () defHandler e = do proto <- setupContentType False@@ -207,8 +253,9 @@ handlePaths :: (MonadUnliftIO m, MonadLoggerIO m)- => S.ScottyT Except (ReaderT WebConfig m) ()-handlePaths = do+ => TVar BinfoTicker+ -> S.ScottyT Except (ReaderT WebConfig m) ()+handlePaths ticker = do -- Block Paths pathPretty (GetBlock <$> paramLazy <*> paramDef)@@ -406,6 +453,9 @@ (const toJSON) S.get "/events" scottyEvents S.get "/dbstats" scottyDbStats+ -- Blockchain.info+ S.post "/blockchain/multiaddr" (scottyMultiAddr ticker)+ S.get "/blockchain/rawtx/:txid" scottyBinfoTx where json_list f net = toJSONList . map (f net) @@ -675,7 +725,7 @@ ts = HashSet.toList (HashSet.difference ns is) in case ts of [] -> return (Just False)- _ -> inputs i is' ns' ts+ _ -> inputs i is' ns' ts inputs i is ns (t:ts) = getTransaction t >>= \case Nothing -> return Nothing Just tx | height_check tx ->@@ -871,6 +921,314 @@ cache <- lift $ asks (storeCache . webStore) lift . withCache cache $ evictFromCache [XPubSpec xpub deriv] return $ GenericResult True++---------------------------------------+-- Blockchain.info API Compatibility --+---------------------------------------++netBinfoSymbol :: Network -> BinfoSymbol+netBinfoSymbol net+ | net == btc =+ BinfoSymbol{ getBinfoSymbolCode = "BTC"+ , getBinfoSymbolString = "BTC"+ , getBinfoSymbolName = "Bitcoin"+ , getBinfoSymbolConversion = 100 * 1000 * 1000+ , getBinfoSymbolAfter = True+ , getBinfoSymbolLocal = False+ }+ | net == bch =+ BinfoSymbol{ getBinfoSymbolCode = "BCH"+ , getBinfoSymbolString = "BCH"+ , getBinfoSymbolName = "Bitcoin Cash"+ , getBinfoSymbolConversion = 100 * 1000 * 1000+ , getBinfoSymbolAfter = True+ , getBinfoSymbolLocal = False+ }+ | otherwise =+ BinfoSymbol{ getBinfoSymbolCode = "XTS"+ , getBinfoSymbolString = "¤"+ , getBinfoSymbolName = "Test"+ , getBinfoSymbolConversion = 100 * 1000 * 1000+ , getBinfoSymbolAfter = False+ , getBinfoSymbolLocal = False+ }++binfoTickerToSymbol :: BinfoTicker -> BinfoSymbol+binfoTickerToSymbol BinfoTicker{..} =+ BinfoSymbol{ getBinfoSymbolCode = code+ , getBinfoSymbolString = symbol+ , getBinfoSymbolName = name+ , getBinfoSymbolConversion =+ 100 * 1000 * 1000 / binfoTickerPrice24h+ , getBinfoSymbolAfter = after+ , getBinfoSymbolLocal = True+ }+ where+ name = case code of+ "EUR" -> "Euro"+ "USD" -> "U.S. dollar"+ "GBP" -> "British pound"+ _ -> code+ symbol = case code of+ "EUR" -> "€"+ "USD" -> "$"+ "GBP" -> "£"+ _ -> code+ after = case code of+ "EUR" -> False+ "USD" -> False+ "GBP" -> False+ _ -> True+ code = T.takeEnd 3 binfoTickerSymbol++scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m)+ => TVar BinfoTicker+ -> WebT m ()+scottyMultiAddr ticker = do+ prune <- get_prune+ n <- get_count+ offset <- get_offset+ cashaddr <- get_cashaddr+ numtxid <- lift $ asks webNumTxId+ (addrs, xpubs, saddrs, sxpubs, xspecs) <- get_addrs+ xbals <- get_xbals xspecs+ let sxbals = compute_sxbals sxpubs xbals+ sxtrs <- get_sxtrs sxpubs xspecs+ sabals <- get_abals saddrs+ satrs <- get_atrs n offset saddrs+ price <- readTVarIO ticker+ let sxtns = HashMap.map length sxtrs+ sxtrset = Set.fromList . concat $ HashMap.elems sxtrs+ sxabals = compute_xabals sxbals+ sallbals = sabals <> sxabals+ abook = compute_abook addrs xbals+ sxaddrs = compute_xaddrs sxbals+ salladdrs = sxaddrs <> saddrs+ bal = compute_bal sallbals+ salltrs = sxtrset <> satrs+ stxids = compute_txids n offset salltrs+ stxs <- get_txs stxids+ let etxids = if numtxid+ then compute_etxids prune abook stxs+ else []+ etxs <- if numtxid+ then Just <$> get_etxs etxids+ else return Nothing+ best <- scottyBlockBest (GetBlockBest (NoTx True))+ peers <- get_peers+ net <- lift $ asks (storeNetwork . webStore)+ let ibal = fromIntegral bal+ btxs = binfo_txs etxs abook salladdrs prune ibal stxs+ ftxs = take n $ drop offset btxs+ addrs = toBinfoAddrs sabals sxbals sxtns+ recv = sum $ map getBinfoAddrReceived addrs+ sent = sum $ map getBinfoAddrSent addrs+ txn = sum $ map getBinfoAddrTxCount addrs+ wallet =+ BinfoWallet+ { getBinfoWalletBalance = bal+ , getBinfoWalletTxCount = txn+ , getBinfoWalletFilteredCount = fromIntegral (length ftxs)+ , getBinfoWalletTotalReceived = recv+ , getBinfoWalletTotalSent = sent+ }+ coin = netBinfoSymbol net+ local = binfoTickerToSymbol price+ block =+ BinfoBlockInfo+ { getBinfoBlockInfoHash = H.headerHash (blockDataHeader best)+ , getBinfoBlockInfoHeight = blockDataHeight best+ , getBinfoBlockInfoTime = H.blockTimestamp (blockDataHeader best)+ , getBinfoBlockInfoIndex = blockDataHeight best+ }+ info =+ BinfoInfo+ { getBinfoConnected = peers+ , getBinfoConversion = 100 * 1000 * 1000+ , getBinfoLocal = local+ , getBinfoBTC = coin+ , getBinfoLatestBlock = block+ }+ S.json $ binfoMultiAddrToJSON net+ BinfoMultiAddr+ { getBinfoMultiAddrAddresses = addrs+ , getBinfoMultiAddrWallet = wallet+ , getBinfoMultiAddrTxs = ftxs+ , getBinfoMultiAddrInfo = info+ , getBinfoMultiAddrRecommendFee = True+ , getBinfoMultiAddrCashAddr = cashaddr+ }+ where+ get_prune = fmap not $ S.param "no_compact"+ `S.rescue` const (return False)+ get_cashaddr = S.param "cashaddr"+ `S.rescue` const (return False)+ get_count = do+ d <- lift (asks (maxLimitDefault . webMaxLimits))+ x <- lift (asks (maxLimitFull . webMaxLimits))+ i <- min x <$> (S.param "n" `S.rescue` const (return d))+ return (fromIntegral i :: Int)+ get_offset = do+ x <- lift (asks (maxLimitOffset . webMaxLimits))+ o <- min x <$> (S.param "offset" `S.rescue` const (return 0))+ return (fromIntegral o :: Int)+ get_addrs_param name = do+ net <- lift (asks (storeNetwork . webStore))+ p <- S.param name `S.rescue` const (return "")+ case parseBinfoAddr net p of+ Nothing -> S.raise (UserError "invalid active address")+ Just xs -> return $ HashSet.fromList xs+ addr (BinfoAddr a) = Just a+ addr (BinfoXpub x) = Nothing+ xpub (BinfoXpub x) = Just x+ xpub (BinfoAddr _) = Nothing+ binfo_txs _ _ _ _ _ [] = []+ binfo_txs etxs abook salladdrs prune ibal (t:ts) =+ let b = toBinfoTx etxs abook salladdrs prune ibal t+ nbal = case getBinfoTxResultBal b of+ Nothing -> ibal+ Just (_, x) -> ibal - x+ in b : binfo_txs etxs abook salladdrs prune nbal ts+ get_addrs = do+ active <- get_addrs_param "active"+ p2sh <- get_addrs_param "activeP2SH"+ bech32 <- get_addrs_param "activeBech32"+ sh <- get_addrs_param "onlyShow"+ let xspec d b = (\x -> (x, XPubSpec x d)) <$> xpub b+ xspecs = HashMap.fromList $ concat+ [ mapMaybe (xspec DeriveNormal) (HashSet.toList active)+ , mapMaybe (xspec DeriveP2SH) (HashSet.toList p2sh)+ , mapMaybe (xspec DeriveP2WPKH) (HashSet.toList bech32)+ ]+ actives = active <> p2sh <> bech32+ addrs = HashSet.fromList . mapMaybe addr $ HashSet.toList actives+ xpubs = HashSet.fromList . mapMaybe xpub $ HashSet.toList actives+ sh' = if HashSet.null sh+ then actives+ else sh `HashSet.intersection` actives+ saddrs = HashSet.fromList . mapMaybe addr $ HashSet.toList sh'+ sxpubs = HashSet.fromList . mapMaybe xpub $ HashSet.toList sh'+ return (addrs, xpubs, saddrs, sxpubs, xspecs)+ get_xbals =+ let f = not . nullBalance . xPubBal+ g = HashMap.fromList . map (second (filter f))+ h (k, s) = (,) k <$> xPubBals s+ in fmap g . mapM h . HashMap.toList+ get_abals =+ let f b = (balanceAddress b, b)+ g = HashMap.fromList . map f+ in fmap g . getBalances . HashSet.toList+ get_sxtrs sxpubs =+ let f (k, s) = (,) k <$> xPubTxs s def+ g = ((`HashSet.member` sxpubs) . fst)+ in fmap HashMap.fromList . mapM f . filter g . HashMap.toList+ get_atrs n offset =+ let i = fromIntegral (n + offset)+ f x = getAddressesTxs x def{limit = i}+ in fmap Set.fromList . f . HashSet.toList+ get_txs = fmap catMaybes . mapM getTransaction+ get_etxs =+ let f t = (txHash (transactionData t), t)+ g = HashMap.fromList . map f . catMaybes+ in fmap g . mapM getTransaction+ get_peers = do+ ps <- lift $ getPeersInformation =<< asks (storeManager . webStore)+ return (fromIntegral (length ps))+ compute_txids n offset = map txRefHash . take (n + offset) . Set.toDescList+ compute_etxids prune abook =+ let f = relevantTxs (HashMap.keysSet abook) prune+ in HashSet.toList . foldl HashSet.union HashSet.empty . map f+ compute_sxbals sxpubs =+ let f k _ = k `HashSet.member` sxpubs+ in HashMap.filterWithKey f+ compute_xabals =+ let f b = (balanceAddress (xPubBal b), xPubBal b)+ in HashMap.fromList . concatMap (map f) . HashMap.elems+ compute_bal =+ let f b = balanceAmount b + balanceZero b+ in sum . map f . HashMap.elems+ compute_abook addrs xbals =+ let f k XPubBal{..} =+ let a = balanceAddress xPubBal+ e = error "lions and tigers and bears"+ s = toSoft (listToPath xPubBalPath)+ m = fromMaybe e s+ in (a, Just (BinfoXPubPath k m))+ g k = map (f k)+ amap = HashMap.map (const Nothing) $+ HashSet.toMap addrs+ xmap = HashMap.fromList .+ concatMap (uncurry g) $+ HashMap.toList xbals+ in amap <> xmap+ compute_xaddrs =+ let f = map (balanceAddress . xPubBal)+ in HashSet.fromList . concatMap f . HashMap.elems+ sent BinfoTx{getBinfoTxResultBal = Just (r, _)}+ | r < 0 = fromIntegral (negate r)+ | otherwise = 0+ sent _ = 0+ received BinfoTx{getBinfoTxResultBal = Just (r, _)}+ | r > 0 = fromIntegral r+ | otherwise = 0+ received _ = 0++scottyBinfoTx :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoTx =+ lift (asks webNumTxId) >>= \num -> S.param "txid" >>= \case+ BinfoTxIdHash h -> go num h+ BinfoTxIdIndex i ->+ if | not num || isBinfoTxIndexNull i -> S.raise ThingNotFound+ | isBinfoTxIndexBlock i -> block i+ | isBinfoTxIndexHash i -> hash i+ where+ get_format = S.param "format" `S.rescue` const (return ("json" :: Text))+ js num t = do+ let etxids = if num+ then HashSet.toList $ relevantTxs HashSet.empty False t+ else []+ etxs' <- if num+ then Just . catMaybes <$> mapM getTransaction etxids+ else return Nothing+ let f t = (txHash (transactionData t), t)+ etxs = HashMap.fromList . map f <$> etxs'+ net <- lift $ asks (storeNetwork . webStore)+ S.json . binfoTxToJSON net $ toBinfoTxSimple etxs t+ hex = S.text . TL.fromStrict . encodeHex . encode . transactionData+ go num h = getTransaction h >>= \case+ Nothing -> S.raise ThingNotFound+ Just t -> get_format >>= \case+ "hex" -> hex t+ _ -> js num t+ block i =+ let Just (height, pos) = binfoTxIndexBlock i+ in getBlocksAtHeight height >>= \case+ [] -> S.raise ThingNotFound+ h:_ -> getBlock h >>= \case+ Nothing -> S.raise ThingNotFound+ Just BlockData{..} ->+ if length blockDataTxs > fromIntegral pos+ then go True (blockDataTxs !! fromIntegral pos)+ else S.raise ThingNotFound+ hmatch h = listToMaybe . filter (matchBinfoTxHash h)+ hmem h = hmatch h . map snd <$> getMempool+ hblock h =+ let g 0 _ = return Nothing+ g i k =+ getBlock k >>= \case+ Nothing -> return Nothing+ Just BlockData{..} ->+ case hmatch h blockDataTxs of+ Nothing -> g (i - 1) (H.prevBlock blockDataHeader)+ Just x -> return (Just x)+ in getBestBlock >>= \case+ Nothing -> return Nothing+ Just k -> g 10 k+ hash h = hmem h >>= \case+ Nothing -> hblock h >>= \case+ Nothing -> S.raise ThingNotFound+ Just x -> go True x+ Just x -> go True x -- GET Network Information --
test/Haskoin/StoreSpec.hs view
@@ -20,10 +20,13 @@ import Haskoin import Haskoin.Node import Haskoin.Store+import Haskoin.Util.Arbitrary import Network.Socket import NQE import System.Random import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck import UnliftIO data TestStore = TestStore@@ -34,7 +37,8 @@ } spec :: Spec-spec = describe "Download" $ do+spec = do+ describe "Download" $ do it "gets 8 blocks" $ withTestStore bchRegTest "eight-blocks" $ \TestStore {..} -> do bs <- replicateM 8 . receiveMatch testStoreEvents $ \case