haskoin-store 0.40.1 → 0.40.2
raw patch · 2 files changed
+43/−45 lines, 2 filesdep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskoin-store-data
API changes (from Hackage documentation)
Files
- haskoin-store.cabal +4/−4
- src/Haskoin/Store/Web.hs +39/−41
haskoin-store.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: haskoin-store-version: 0.40.1+version: 0.40.2 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@@ -50,7 +50,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0- , haskoin-store-data ==0.40.0+ , haskoin-store-data ==0.40.2 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -95,7 +95,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.40.0+ , haskoin-store-data ==0.40.2 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -145,7 +145,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.40.0+ , haskoin-store-data ==0.40.2 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Web.hs view
@@ -40,6 +40,7 @@ import Data.Char (isSpace) import Data.Default (Default (..)) import Data.Function ((&))+import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet import Data.List (nub)@@ -203,7 +204,7 @@ , webPort = port , webReqLog = wl , webStore = store } = do- ticker <- newTVarIO def+ ticker <- newTVarIO HashMap.empty withAsync (price (storeNetwork store) ticker) $ \_ -> do reqLogger <- logIt runner <- askRunInIO@@ -216,26 +217,25 @@ opts = def {S.settings = settings defaultSettings} settings = setPort port . setHost (fromString host) -price :: (MonadUnliftIO m, MonadLoggerIO m) => Network -> TVar BinfoTicker -> m ()+price :: (MonadUnliftIO m, MonadLoggerIO m)+ => Network+ -> TVar (HashMap Text BinfoTicker)+ -> m () price net v =- case sym of+ case code of Nothing -> return () Just s -> go s where- sym | net == btc = Just "BTC-USD"- | net == bch = Just "BCH-USD"- | otherwise = Nothing+ 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 "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+ r <- liftIO $ Wreq.asJSON =<< Wreq.get url+ atomically . writeTVar v $ r ^. Wreq.responseBody threadDelay $ 5 * 60 * 1000 * 1000 -- five minutes @@ -253,7 +253,7 @@ handlePaths :: (MonadUnliftIO m, MonadLoggerIO m)- => TVar BinfoTicker+ => TVar (HashMap Text BinfoTicker) -> S.ScottyT Except (ReaderT WebConfig m) () handlePaths ticker = do -- Block Paths@@ -953,36 +953,25 @@ , getBinfoSymbolLocal = False } -binfoTickerToSymbol :: BinfoTicker -> BinfoSymbol-binfoTickerToSymbol BinfoTicker{..} =+binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol+binfoTickerToSymbol code BinfoTicker{..} = BinfoSymbol{ getBinfoSymbolCode = code- , getBinfoSymbolString = symbol- , getBinfoSymbolName = name- , getBinfoSymbolConversion =- 100 * 1000 * 1000 / binfoTickerPrice24h- , getBinfoSymbolAfter = after- , getBinfoSymbolLocal = True- }+ , getBinfoSymbolString = binfoTickerSymbol+ , getBinfoSymbolName = name+ , getBinfoSymbolConversion =+ 100 * 1000 * 1000 / binfoTicker15m -- sat/usd+ , getBinfoSymbolAfter = False+ , 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+ x -> x scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m)- => TVar BinfoTicker+ => TVar (HashMap Text BinfoTicker) -> WebT m () scottyMultiAddr ticker = do prune <- get_prune@@ -996,7 +985,7 @@ sxtrs <- get_sxtrs sxpubs xspecs sabals <- get_abals saddrs satrs <- get_atrs n offset saddrs- price <- readTVarIO ticker+ local <- get_price ticker let sxtns = HashMap.map length sxtrs sxtrset = Set.fromList . concat $ HashMap.elems sxtrs sxabals = compute_xabals sxbals@@ -1033,7 +1022,6 @@ , getBinfoWalletTotalSent = sent } coin = netBinfoSymbol net- local = binfoTickerToSymbol price block = BinfoBlockInfo { getBinfoBlockInfoHash = H.headerHash (blockDataHeader best)@@ -1049,6 +1037,7 @@ , getBinfoBTC = coin , getBinfoLatestBlock = block }+ setHeaders S.json $ binfoMultiAddrToJSON net BinfoMultiAddr { getBinfoMultiAddrAddresses = addrs@@ -1059,6 +1048,12 @@ , getBinfoMultiAddrCashAddr = cashaddr } where+ get_price ticker = do+ code <- T.toUpper <$> S.param "local" `S.rescue` const (return "USD")+ prices <- readTVarIO ticker+ case HashMap.lookup code prices of+ Nothing -> return def+ Just p -> return $ binfoTickerToSymbol code p get_prune = fmap not $ S.param "no_compact" `S.rescue` const (return False) get_cashaddr = S.param "cashaddr"@@ -1086,7 +1081,7 @@ 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+ Nothing -> ibal Just (_, x) -> ibal - x in b : binfo_txs etxs abook salladdrs prune nbal ts get_addrs = do@@ -1193,8 +1188,11 @@ let f t = (txHash (transactionData t), t) etxs = HashMap.fromList . map f <$> etxs' net <- lift $ asks (storeNetwork . webStore)+ setHeaders S.json . binfoTxToJSON net $ toBinfoTxSimple etxs t- hex = S.text . TL.fromStrict . encodeHex . encode . transactionData+ hex t = do+ setHeaders+ S.text . TL.fromStrict . encodeHex . encode $ transactionData t go num h = getTransaction h >>= \case Nothing -> S.raise ThingNotFound Just t -> get_format >>= \case