haskoin-store 0.52.4 → 0.52.5
raw patch · 4 files changed
+141/−19 lines, 4 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.Common: blockAtOrAfter :: (MonadIO m, StoreReadExtra m) => Chain -> UnixTime -> m (Maybe BlockData)
Files
- CHANGELOG.md +7/−0
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/Common.hs +15/−3
- src/Haskoin/Store/Web.hs +114/−11
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.52.5+### Added+- Support for Blockchain.info export-history endpoint.++### Fixed+- Use strict bytestring decoder for HTTP API client.+ ## 0.52.4 ### Fixed - Use Base58 addresses by default in Blockchain.info balance querios.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c16fdfbfaeb6b0c31ab673c5c9bb78d75c36fb522954b9d2675fcabff47dd2ed+-- hash: 0c15a0b65526707734b070de3a84432ae82ec165726454c0b956cbb1754fb5ab name: haskoin-store-version: 0.52.4+version: 0.52.5 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.52.0+ , haskoin-store-data ==0.52.5 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -115,7 +115,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.52.0+ , haskoin-store-data ==0.52.5 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -174,7 +174,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.52.0+ , haskoin-store-data ==0.52.5 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Common.hs view
@@ -20,6 +20,7 @@ , getSpenders , getTransaction , getNumTransaction+ , blockAtOrAfter , blockAtOrBefore , blockAtOrAfterMTP , deOffset@@ -268,6 +269,18 @@ sm <- getSpenders (txHash (txData d)) return $ toTransaction d sm +blockAtOrAfter :: (MonadIO m, StoreReadExtra m)+ => Chain+ -> UnixTime+ -> m (Maybe BlockData)+blockAtOrAfter ch q = runMaybeT $ do+ net <- lift getNetwork+ x <- MaybeT $ liftIO $ runReaderT (firstGreaterOrEqual net f) ch+ MaybeT $ getBlock (headerHash (nodeHeader x))+ where+ f x = let t = fromIntegral (blockTimestamp (nodeHeader x))+ in return $ t `compare` q+ blockAtOrBefore :: (MonadIO m, StoreReadExtra m) => Chain -> UnixTime@@ -277,9 +290,8 @@ x <- MaybeT $ liftIO $ runReaderT (lastSmallerOrEqual net f) ch MaybeT $ getBlock (headerHash (nodeHeader x)) where- f x =- let t = fromIntegral (blockTimestamp (nodeHeader x))- in return $ t `compare` q+ f x = let t = fromIntegral (blockTimestamp (nodeHeader x))+ in return $ t `compare` q blockAtOrAfterMTP :: (MonadIO m, StoreReadExtra m) => Chain
src/Haskoin/Store/Web.hs view
@@ -19,14 +19,15 @@ ) where import Conduit (ConduitT, await,- dropC, dropWhileC,- mapC, runConduit,- sinkList, takeC,+ concatMapMC, dropC,+ dropWhileC, mapC,+ runConduit, sinkList,+ takeC, takeWhileC, yield, (.|)) import Control.Applicative ((<|>)) import Control.Arrow (second) import Control.Concurrent.STM (check)-import Control.Lens ((^.))+import Control.Lens ((.~), (^.)) import Control.Monad (forM, forever, unless, when, (<=<)) import Control.Monad.Logger (MonadLoggerIO,@@ -217,6 +218,7 @@ , balanceStat :: !StatDist , unspentStat :: !StatDist , rawtxStat :: !StatDist+ , historyStat :: !StatDist , peerStat :: !StatDist , healthStat :: !StatDist , dbStatsStat :: !StatDist@@ -247,6 +249,7 @@ multiaddrStat <- d "multiaddr" balanceStat <- d "balance" rawtxStat <- d "rawtx"+ historyStat <- d "history" unspentStat <- d "unspent" peerStat <- d "peer" healthStat <- d "health"@@ -387,6 +390,22 @@ opts = def {S.settings = settings defaultSettings} settings = setPort port . setHost (fromString host) +getRates :: (MonadUnliftIO m, MonadLoggerIO m)+ => Network -> Text -> [Word64] -> m [BinfoRate]+getRates net currency times = do+ handleAny err $ do+ r <- liftIO $ Wreq.asJSON =<< Wreq.postWith opts url body+ return $ r ^. Wreq.responseBody+ where+ err e = do+ $(logErrorS) "Web" "Could not get historic prices"+ return []+ body = toJSON times+ base = Wreq.defaults &+ Wreq.param "base" .~ [T.toUpper (T.pack (getNetworkName net))]+ opts = base & Wreq.param "quote" .~ [currency]+ url = "https://api.blockchain.info/price/index-series"+ price :: (MonadUnliftIO m, MonadLoggerIO m) => Network -> Int@@ -662,6 +681,8 @@ S.get "/blockchain/rawtx/:txid" scottyBinfoTx S.get "/blockchain/rawblock/:block" scottyBinfoBlock S.get "/blockchain/block-height/:height" scottyBinfoBlockHeight+ S.get "/blockchain/export-history" scottyBinfoHistory+ S.post "/blockchain/export-history" scottyBinfoHistory where json_list f net = toJSONList . map (f net) @@ -1307,8 +1328,9 @@ 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))+getChainHeight = do+ ch <- lift $ asks (storeChain . webStore . webConfig)+ fmap H.nodeHeight $ chainGetBest ch scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyBinfoUnspent =@@ -1449,13 +1471,96 @@ getCashAddr :: Monad m => WebT m Bool getCashAddr = S.param "cashaddr" `S.rescue` const (return False) +scottyBinfoHistory :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoHistory =+ getBinfoActive historyStat >>= \(xspecs, addrs) ->+ get_dates >>= \(startM, endM) -> do+ setMetrics historyStat (HashSet.size addrs + HashMap.size xspecs)+ (code, price) <- getPrice+ xpubs <- mapM (\x -> (,) x <$> xPubBals x) (HashMap.elems xspecs)+ let xaddrs = HashSet.fromList $ concatMap (map get_addr . snd) xpubs+ aaddrs = xaddrs <> addrs+ cur = binfoTicker15m price+ cs = conduits xpubs addrs endM+ txs <- lift . runConduit $+ joinDescStreams cs+ .| takeWhileC (is_newer startM)+ .| concatMapMC get_transaction+ .| sinkList+ let times = map transactionTime txs+ net <- lift $ asks (storeNetwork . webStore . webConfig)+ rates <- map binfoRatePrice <$> lift (getRates net code times)+ let hs = zipWith (convert cur aaddrs) txs (rates <> repeat 0.0)+ setHeaders+ streamEncoding $ toEncoding hs+ where+ is_newer (Just BlockData{..}) TxRef{txRefBlock = BlockRef{..}} =+ blockRefHeight >= blockDataHeight+ is_newer _ _ = True+ get_addr = balanceAddress . xPubBal+ get_transaction TxRef{txRefHash = h, txRefBlock = BlockRef{..}} =+ getTransaction h+ convert cur addrs tx rate =+ let ins = transactionInputs tx+ outs = transactionOutputs tx+ fins = filter (input_addr addrs) ins+ fouts = filter (output_addr addrs) outs+ vin = fromIntegral . sum $ map inputAmount fins+ vout = fromIntegral . sum $ map outputAmount fouts+ v = vout - vin+ t = transactionTime tx+ h = txHash $ transactionData tx+ in toBinfoHistory v t rate cur h+ input_addr addrs' StoreInput{inputAddress = Just a} =+ a `HashSet.member` addrs'+ input_addr _ _ = False+ output_addr addrs' StoreOutput{outputAddr = Just a} =+ a `HashSet.member` addrs'+ output_addr _ _ = False+ get_dates = do+ BinfoDate start <- S.param "start"+ BinfoDate end' <- S.param "end"+ let end = end' + 24 * 60 * 60+ ch <- lift $ asks (storeChain . webStore . webConfig)+ startM <- blockAtOrAfter ch start+ endM <- blockAtOrBefore ch end+ return (startM, endM)+ conduits xpubs addrs endM =+ map (uncurry (xpub_c endM)) xpubs+ <>+ map (addr_c endM) (HashSet.toList addrs)+ addr_c endM a =+ streamThings (getAddressTxs a)+ (Just txRefHash)+ def{ limit = 50+ , start = AtBlock . blockDataHeight <$> endM+ }+ xpub_c endM x bs =+ streamThings+ (xPubTxs x bs)+ (Just txRefHash)+ def{ limit = 50+ , start = AtBlock . blockDataHeight <$> endM+ }++getPrice :: MonadIO m => WebT m (Text, BinfoTicker)+getPrice = do+ code <- T.toUpper <$> S.param "currency" `S.rescue` const (return "USD")+ ticker <- lift $ asks webTicker+ prices <- readTVarIO ticker+ case HashMap.lookup code prices of+ Nothing -> return (code, def)+ Just p -> return (code, p)++getSymbol :: MonadIO m => WebT m BinfoSymbol+getSymbol = uncurry binfoTickerToSymbol <$> getPrice+ scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyMultiAddr = get_addrs >>= \(addrs', xpubs, saddrs, sxpubs, xspecs) -> getNumTxId >>= \numtxid -> getCashAddr >>= \cashaddr ->- lift (asks webTicker) >>= \ticker ->- get_price ticker >>= \local ->+ getSymbol >>= \local -> get_offset >>= \offset -> get_count >>= \n -> get_prune >>= \prune ->@@ -1683,7 +1788,7 @@ getBinfoActive balanceStat >>= \(xspecs, addrs) -> getCashAddr >>= \cashaddr -> getNumTxId >>= \numtxid -> do- setMetrics balanceStat (hl addrs + ml xspecs)+ setMetrics balanceStat (HashSet.size addrs + HashMap.size xspecs) net <- lift $ asks (storeNetwork . webStore . webConfig) abals <- catMaybes <$> mapM (get_addr_balance net cashaddr) (HashSet.toList addrs)@@ -1692,8 +1797,6 @@ setHeaders streamEncoding $ toEncoding res where- hl = HashSet.size- ml = HashMap.size to_short_bal Balance{..} = BinfoShortBal {