haskoin-store 0.42.0 → 0.42.1
raw patch · 3 files changed
+129/−33 lines, 3 filesdep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskoin-store-data
API changes (from Hackage documentation)
Files
- CHANGELOG.md +7/−0
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/Web.hs +117/−28
CHANGELOG.md view
@@ -4,6 +4,13 @@ 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.42.1+### Added+- Support for Blockchain.info API unspent endpoint.++### Fixed+- Fix RBF transactions on Blockchain.info API.+ ## 0.42.0 ### Removed - No more pruning of old mempool transactions.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 24bfa2396f72b6d1ea3fede4dfa852b1b496fbb0f080a1c2f8f82d0e3694234c+-- hash: 90605dc20883202f81121903fe57fc220e28058ab444ea6da072ddf73a846d63 name: haskoin-store-version: 0.42.0+version: 0.42.1 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@@ -59,7 +59,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0- , haskoin-store-data ==0.41.3+ , haskoin-store-data ==0.42.1 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -109,7 +109,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.41.3+ , haskoin-store-data ==0.42.1 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -164,7 +164,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.41.3+ , haskoin-store-data ==0.42.1 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Web.hs view
@@ -38,14 +38,16 @@ import Data.ByteString.Builder (lazyByteString) import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as C+import Data.ByteString.Short (fromShort) import Data.Char (isSpace) import Data.Default (Default (..))-import Data.Function ((&))+import Data.Function (on, (&)) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap+import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.Int (Int64)-import Data.List (nub)+import Data.List (nub, sortBy) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromJust, fromMaybe, listToMaybe, mapMaybe)@@ -190,6 +192,8 @@ , xPubUnspentResponseTime :: !StatDist , multiaddrResponseTime :: !StatDist , multiaddrErrors :: !ErrorCounter+ , unspentResponseTime :: !StatDist+ , unspentErrors :: !ErrorCounter , rawtxResponseTime :: !StatDist , rawtxErrors :: !ErrorCounter , peerResponseTime :: !StatDist@@ -228,6 +232,8 @@ healthResponseTime <- d "health.response_time_ms" dbStatsResponseTime <- d "dbstats.response_time_ms" eventsConnected <- g "events.connected"+ unspentResponseTime <- d "unspent.response_time_ms"+ unspentErrors <- e "unspent.errors" return WebMetrics{..} where d x = createStatDist ("web." <> x) s@@ -621,6 +627,8 @@ -- Blockchain.info S.post "/blockchain/multiaddr" scottyMultiAddr S.get "/blockchain/multiaddr" scottyMultiAddr+ S.post "/blockchain/unspent" scottyBinfoUnspent+ S.get "/blockchain/unspent" scottyBinfoUnspent S.get "/blockchain/rawtx/:txid" scottyBinfoTx where json_list f net = toJSONList . map (f net)@@ -763,7 +771,7 @@ Nothing -> raise blockErrors ThingNotFound Just bb -> getBlock bb >>= \case Nothing -> raise blockErrors ThingNotFound- Just b -> return $ pruneTx notx b+ Just b -> return $ pruneTx notx b scottyBlockBestRaw :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1192,8 +1200,103 @@ "GBP" -> "British pound" x -> x -scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m)- => WebT m ()+getBinfoAddrsParam :: MonadIO m => Text -> WebT m (HashSet BinfoAddr)+getBinfoAddrsParam name = do+ net <- lift (asks (storeNetwork . webStore . webConfig))+ p <- S.param (cs name) `S.rescue` const (return "")+ case parseBinfoAddr net p of+ Nothing -> raise multiaddrErrors (UserError "invalid active address")+ Just xs -> return $ HashSet.fromList xs++getBinfoActive :: MonadIO m => WebT m (HashMap XPubKey XPubSpec, HashSet Address)+getBinfoActive = do+ active <- getBinfoAddrsParam "active"+ p2sh <- getBinfoAddrsParam "activeP2SH"+ bech32 <- getBinfoAddrsParam "activeBech32"+ 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)+ ]+ addrs = HashSet.fromList . mapMaybe addr $ HashSet.toList active+ return (xspecs, addrs)+ where+ addr (BinfoAddr a) = Just a+ addr (BinfoXpub x) = Nothing+ xpub (BinfoXpub x) = Just x+ xpub (BinfoAddr _) = Nothing++scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoUnspent =+ getBinfoActive >>= \(xspecs, addrs) ->+ 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)+ numtxid <- lift $ asks (webNumTxId . webConfig)+ etxs <- if numtxid then Just <$> get_etxs xuns auns else return Nothing+ height <- get_height+ limit <- get_limit+ min_conf <- get_min_conf+ let g k = map (xpub_unspent etxs height k)+ xbus = concatMap (uncurry g) (HashMap.toList xuns)+ abus = map (unspent etxs height) auns+ f u@BinfoUnspent{..} =+ ((getBinfoUnspentHash, getBinfoUnspentOutputIndex), u)+ busm = HashMap.fromList (map f (xbus ++ abus))+ bus =+ take limit $+ filter ((min_conf <=) . getBinfoUnspentConfirmations) $+ sortBy+ (flip compare `on` getBinfoUnspentConfirmations)+ (HashMap.elems busm)+ setHeaders+ S.json $ binfoUnspentsToJSON 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_etxs xuns auns = do+ let als = map (outPointHash . unspentPoint) auns+ xelems = concat (HashMap.elems xuns)+ xls = map (outPointHash . unspentPoint . xPubUnspent) xelems+ ids = HashSet.fromList (als ++ xls)+ f i = fmap (i,) <$> getTransaction i+ HashMap.fromList . catMaybes <$> mapM f (HashSet.toList ids)+ get_height =+ getBestBlock >>= \case+ Nothing -> raise unspentErrors ThingNotFound+ Just bh -> getBlock bh >>= \case+ Nothing -> raise unspentErrors ThingNotFound+ Just b -> return (blockDataHeight b)+ xpub_unspent etxs height xpub (XPubUnspent p u) =+ let path = toSoft (listToPath p)+ xp = BinfoXPubPath xpub <$> path+ bu = unspent etxs height u+ in bu {getBinfoUnspentXPub = xp}+ unspent etxs height Unspent{..} =+ let conf = case unspentBlock of+ MemRef{} -> 0+ BlockRef h _ -> height - h + 1+ hash = outPointHash unspentPoint+ idx = outPointIndex unspentPoint+ val = unspentAmount+ script = fromShort unspentScript+ txi = getBinfoTxId etxs hash+ in BinfoUnspent+ { getBinfoUnspentHash = hash+ , getBinfoUnspentOutputIndex = idx+ , getBinfoUnspentScript = script+ , getBinfoUnspentValue = val+ , getBinfoUnspentConfirmations = conf+ , getBinfoUnspentTxIndex = txi+ , getBinfoUnspentXPub = Nothing+ }+ get_xpub_unspents = mapM (`xPubUnspents` def)+ get_addr_unspents = (`getAddressesUnspents` def) . HashSet.toList++scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyMultiAddr = get_addrs >>= \(addrs, xpubs, saddrs, sxpubs, xspecs) -> let len = HashSet.size addrs + HashSet.size xpubs@@ -1282,7 +1385,7 @@ Nothing -> raise multiaddrErrors ThingNotFound Just bh -> getBlock bh >>= \case Nothing -> raise multiaddrErrors ThingNotFound- Just b -> return b+ Just b -> return b get_price ticker = do code <- T.toUpper <$> S.param "currency" `S.rescue` const (return "USD") prices <- readTVarIO ticker@@ -1302,12 +1405,6 @@ x <- lift (asks (maxLimitOffset . webMaxLimits . webConfig)) 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 . webConfig))- p <- S.param name `S.rescue` const (return "")- case parseBinfoAddr net p of- Nothing -> raise multiaddrErrors (UserError "invalid active address")- Just xs -> return $ HashSet.fromList xs subset ks = HashMap.filterWithKey (\k _ -> k `HashSet.member` ks) addr (BinfoAddr a) = Just a@@ -1324,19 +1421,11 @@ then b : binfo_txs etxs abook prune nbal ts else binfo_txs etxs abook 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+ (xspecs, addrs) <- getBinfoActive+ sh <- getBinfoAddrsParam "onlyShow"+ let xpubs = HashMap.keysSet xspecs+ actives = HashSet.map BinfoAddr addrs <>+ HashSet.map BinfoXpub xpubs sh' = if HashSet.null sh then actives else sh `HashSet.intersection` actives@@ -1368,12 +1457,12 @@ then ((t, True):) <$> get_txs s (n - 1) is else ((t, False):) <$> get_txs s n is addr_in_set s t =- let f StoreCoinbase{} = False+ let f StoreCoinbase{} = False f StoreInput{inputAddress = Nothing} = False- f StoreInput{inputAddress = Just a} = a `HashSet.member` s+ f StoreInput{inputAddress = Just a} = a `HashSet.member` s g StoreOutput{outputAddress = m} = case m of Nothing -> False- Just a -> a `HashSet.member` s+ Just a -> a `HashSet.member` s i = any f (transactionInputs t) o = any g (transactionOutputs t) in i || o