haskoin-store 0.61.1 → 0.62.0

raw patch · 4 files changed

+85/−35 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)

Files

• CHANGELOG.md +5/−0
• app/Main.hs +33/−0
• haskoin-store.cabal +4/−4
• src/Haskoin/Store/Web.hs +43/−31

@@ -4,6 +4,11 @@ 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.62.0+### Added+- Configurable Blockchain price URLs.+- Reuse HTTP connections with wreq sessions.+ ## 0.61.1 ### Changed - Upstream improvements on Base58 performance.

@@ -80,6 +80,8 @@     , configStatsdPort      :: !Int     , configStatsdPrefix    :: !String     , configWebPriceGet     :: !Int+    , configWebTickerURL    :: !String+    , configWebHistoryURL   :: !String     }  instance Default Config where@@ -112,6 +114,8 @@                  , configStatsdPort      = defStatsdPort                  , configStatsdPrefix    = defStatsdPrefix                  , configWebPriceGet     = defWebPriceGet+                 , configWebTickerURL    = defWebTickerURL+                 , configWebHistoryURL   = defWebHistoryURL                  }  defEnv :: MonadIO m => String -> a -> (String -> Maybe a) -> m a@@ -273,6 +277,17 @@     defEnv "WEB_PRICE_GET" (90 * 1000 * 1000) readMaybe {-# NOINLINE defWebPriceGet #-} +defWebTickerURL :: String+defWebTickerURL = unsafePerformIO $+    defEnv "PRICE_TICKER_URL" "https://api.blockchain.info/ticker" pure+{-# NOINLINE defWebTickerURL #-}+++defWebHistoryURL :: String+defWebHistoryURL = unsafePerformIO $+    defEnv "PRICE_HISTORY_URL" "https://api.blockchain.info/price/index-series" pure+{-# NOINLINE defWebHistoryURL #-}+ defStatsdPrefix :: String defStatsdPrefix =     unsafePerformIO $@@ -536,6 +551,20 @@         <> help "How often to retrieve price information"         <> showDefault         <> value (configWebPriceGet def)+    configWebTickerURL <-+        strOption $+        metavar "URL"+        <> long "price-ticker-url"+        <> help "Blockchain.info price ticker URL"+        <> showDefault+        <> value (configWebTickerURL def)+    configWebHistoryURL <-+        strOption $+        metavar "URL"+        <> long "price-history-url"+        <> help "Blockchain.info price history URL"+        <> showDefault+        <> value (configWebHistoryURL def)     pure         Config             { configWebLimits = WebLimits {..}@@ -614,6 +643,8 @@            , configStatsdPort = statsdport            , configStatsdPrefix = statsdpfx            , configWebPriceGet = wpget+           , configWebTickerURL = wturl+           , configWebHistoryURL = whurl            } =     runStderrLoggingT . filterLogger l . with_stats $ \stats -> do         net <- case networkReader net_str of@@ -662,6 +693,8 @@                     , webNoMempool = nomem                     , webStats = stats                     , webPriceGet = wpget+                    , webTickerURL = wturl+                    , webHistoryURL = whurl                     }   where     with_stats go

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-version:        0.61.1+version:        0.62.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@@ -60,7 +60,7 @@     , hashable >=1.3.0.0     , haskoin-core >=0.21.1     , haskoin-node >=0.17.0-    , haskoin-store-data ==0.61.1+    , haskoin-store-data ==0.62.0     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -116,7 +116,7 @@     , haskoin-core >=0.21.1     , haskoin-node >=0.17.0     , haskoin-store-    , haskoin-store-data ==0.61.1+    , haskoin-store-data ==0.62.0     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -177,7 +177,7 @@     , haskoin-core >=0.21.1     , haskoin-node >=0.17.0     , haskoin-store-    , haskoin-store-data ==0.61.1+    , haskoin-store-data ==0.62.0     , hedis >=0.12.13     , hspec >=2.7.1     , http-types >=0.12.3

@@ -140,6 +140,8 @@                                                           sendTextData) import qualified Network.WebSockets                      as WebSockets import qualified Network.Wreq                            as Wreq+import           Network.Wreq.Session                    as Wreq (Session)+import qualified Network.Wreq.Session                    as Wreq.Session import           System.IO.Unsafe                        (unsafeInterleaveIO) import qualified System.Metrics                          as Metrics import qualified System.Metrics.Gauge                    as Metrics (Gauge)@@ -195,12 +197,15 @@     , webNoMempool  :: !Bool     , webStats      :: !(Maybe Metrics.Store)     , webPriceGet   :: !Int+    , webTickerURL  :: !String+    , webHistoryURL :: !String     }  data WebState = WebState-    { webConfig  :: !WebConfig-    , webTicker  :: !(TVar (HashMap Text BinfoTicker))-    , webMetrics :: !(Maybe WebMetrics)+    { webConfig      :: !WebConfig+    , webTicker      :: !(TVar (HashMap Text BinfoTicker))+    , webMetrics     :: !(Maybe WebMetrics)+    , webWreqSession :: !Wreq.Session     }  data WebMetrics = WebMetrics@@ -453,35 +458,38 @@                     , webStore = store'                     , webStats = stats                     , webPriceGet = pget+                    , webTickerURL = turl                     , webMaxLimits = WebLimits{..}                     } = do     ticker <- newTVarIO HashMap.empty     metrics <- mapM createMetrics stats+    session <- liftIO Wreq.Session.newAPISession     let st = WebState              { webConfig = cfg              , webTicker = ticker              , webMetrics = metrics+             , webWreqSession = session              }         net = storeNetwork store'-    withAsync (price net pget ticker) $ \_ -> do-        reqLogger <- logIt metrics-        runner <- askRunInIO-        S.scottyOptsT opts (runner . (`runReaderT` st)) $ do-            S.middleware (webSocketEvents st)-            S.middleware reqLogger-            S.middleware (reqSizeLimit maxLimitBody)-            S.defaultHandler defHandler-            handlePaths-            S.notFound $ raise ThingNotFound+    withAsync (price net session turl pget ticker) $ const $ do+            reqLogger <- logIt metrics+            runner <- askRunInIO+            S.scottyOptsT opts (runner . (`runReaderT` st)) $ do+                S.middleware (webSocketEvents st)+                S.middleware reqLogger+                S.middleware (reqSizeLimit maxLimitBody)+                S.defaultHandler defHandler+                handlePaths+                S.notFound $ raise ThingNotFound   where     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+         => Network -> Wreq.Session -> String -> Text -> [Word64] -> m [BinfoRate]+getRates net session url currency times = do     handleAny err $ do-        r <- liftIO $ Wreq.asJSON =<< Wreq.postWith opts url body+        r <- liftIO $ Wreq.asJSON =<< Wreq.Session.postWith opts session url body         return $ r ^. Wreq.responseBody   where     err _ = do@@ -491,28 +499,30 @@     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+      -> Wreq.Session+      -> String       -> Int       -> TVar (HashMap Text BinfoTicker)       -> m ()-price net pget v =-    forM_ code go+price net session url pget v = forM_ purl $ \u -> forever $ do+    let err e = $(logErrorS) "Price" $ cs (show e)+    handleAny err $ do+        r <- liftIO $ Wreq.asJSON =<< Wreq.Session.get session u+        atomically . writeTVar v $ r ^. Wreq.responseBody+    threadDelay pget   where-    code | net == btc = Just "btc"-         | net == bch = Just "bch"-         | otherwise = Nothing-    go s = forever $ do-        let err e = $(logErrorS) "Price" $ cs (show e)-            url = "https://api.blockchain.info/ticker" <> "?" <>-                  "base" <> "=" <> s-        handleAny err $ do-            r <- liftIO $ Wreq.asJSON =<< Wreq.get url-            atomically . writeTVar v $ r ^. Wreq.responseBody-        threadDelay pget+    purl = case code of+             Nothing -> Nothing+             Just x  -> Just (url <> "?base=" <> x)+      where+        code | net == btc = Just "btc"+             | net == bch = Just "bch"+             | otherwise  = Nothing + raise :: MonadIO m => Except -> WebT m a raise err = lift (asks webMetrics) >>= \case     Nothing -> S.raise err@@ -1668,7 +1678,9 @@         .| sinkList     let times = map transactionTime txs     net <- lift $ asks (storeNetwork . webStore . webConfig)-    rates <- map binfoRatePrice <$> lift (getRates net code times)+    url <- lift $ asks (webHistoryURL . webConfig)+    session <- lift $ asks webWreqSession+    rates <- map binfoRatePrice <$> lift (getRates net session url code times)     let hs = zipWith (convert cur aaddrs) txs (rates <> repeat 0.0)     setHeaders     streamEncoding $ toEncoding hs