haskoin-store 0.40.12 → 0.40.13
raw patch · 2 files changed
+39/−61 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- haskoin-store.cabal +1/−1
- src/Haskoin/Store/Cache.hs +38/−60
haskoin-store.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: haskoin-store-version: 0.40.12+version: 0.40.13 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
src/Haskoin/Store/Cache.hs view
@@ -166,26 +166,16 @@ => XPubSpec -> Limits -> CacheX m [TxRef] getXPubTxs xpub limits = do xpubtxt <- xpubText xpub- $(logDebugS) "Cache" $ "Getting xpub txs for " <> xpubtxt isXPubCached xpub >>= \case True -> do txs <- cacheGetXPubTxs xpub limits- $(logDebugS) "Cache" $- "Returning " <> cs (show (length txs)) <>- " transactions for cached xpub: " <>- xpubtxt return txs False -> do- $(logDebugS) "Cache" $ "Caching new xpub " <> xpubtxt newXPubC xpub >>= \(t, bals) -> if t then do- $(logDebugS) "Cache" $- "Successfully cached xpub " <> xpubtxt cacheGetXPubTxs xpub limits else do- $(logDebugS) "Cache" $- "Using DB to return txs for xpub " <> xpubtxt lift $ xPubBalsTxs bals limits getXPubUnspents ::@@ -193,7 +183,6 @@ => XPubSpec -> Limits -> CacheX m [XPubUnspent] getXPubUnspents xpub limits = do xpubtxt <- xpubText xpub- $(logDebugS) "Cache" $ "Getting utxo for xpub " <> xpubtxt isXPubCached xpub >>= \case True -> do bals <- cacheGetXPubBalances xpub@@ -202,12 +191,8 @@ newXPubC xpub >>= \(t, bals) -> if t then do- $(logDebugS) "Cache" $- "Successfully cached xpub " <> xpubtxt process bals else do- $(logDebugS) "Cache" $- "Using DB to return utxo for xpub " <> xpubtxt lift $ xPubBalsUnspents bals limits where process bals = do@@ -230,10 +215,6 @@ (\(a, u) -> (`XPubUnspent` u) <$> Map.lookup a addrmap) addrutxo xpubtxt <- xpubText xpub- $(logDebugS) "Cache" $- "Returning " <> cs (show (length xpubutxo)) <>- " utxos for cached xpub: " <>- xpubtxt return xpubutxo getXPubBalances ::@@ -241,16 +222,11 @@ => XPubSpec -> CacheX m [XPubBal] getXPubBalances xpub = do xpubtxt <- xpubText xpub- $(logDebugS) "Cache" $ "Getting balances for xpub " <> xpubtxt isXPubCached xpub >>= \case True -> do bals <- cacheGetXPubBalances xpub- $(logDebugS) "Cache" $- "Returning " <> cs (show (length bals)) <> " balances for xpub " <>- xpubtxt return bals False -> do- $(logDebugS) "Cache" $ "Caching balances for xpub " <> xpubtxt snd <$> newXPubC xpub isInCache :: MonadLoggerIO m => XPubSpec -> CacheT m Bool@@ -604,37 +580,28 @@ let n = lenNotNull bals if x <= n then inSync >>= \s -> if s then go bals else return (False, bals)- else do- $(logDebugS) "Cache" $ "Not caching xpub: " <> t- return (False, bals)+ else return (False, bals) where op XPubUnspent {xPubUnspent = u} = (unspentPoint u, unspentBlock u) go bals = do xpubtxt <- xpubText xpub $(logDebugS) "Cache" $- "Caching xpub with " <> cs (show (length bals)) <>- " addresses (used: " <>- cs (show (lenNotNull bals)) <>- "): " <>- xpubtxt+ "Caching " <> xpubtxt <> ": " <> cs (show (length bals)) <>+ " addresses / " <> cs (show (lenNotNull bals)) <> " used" utxo <- lift $ xPubUnspents xpub def $(logDebugS) "Cache" $- "Caching xpub with " <> cs (show (length utxo)) <> " utxos: " <>- xpubtxt+ "Caching " <> xpubtxt <> ": " <> cs (show (length utxo)) <> " utxos" xtxs <- lift $ xPubTxs xpub def $(logDebugS) "Cache" $- "Caching xpub with " <> cs (show (length xtxs)) <> " txs: " <>- xpubtxt+ "Caching " <> xpubtxt <> ": " <> cs (show (length xtxs)) <> " txs" now <- systemSeconds <$> liftIO getSystemTime- $(logDebugS) "Cache" $- "Running Redis pipeline to cache xpub: " <> xpubtxt <> "" runRedis $ do b <- redisTouchKeys now [xpub] c <- redisAddXPubBalances xpub bals d <- redisAddXPubUnspents xpub (map op utxo) e <- redisAddXPubTxs xpub xtxs return $ b >> c >> d >> e >> return ()- $(logDebugS) "Cache" $ "Done caching xpub: " <> xpubtxt+ $(logDebugS) "Cache" $ "Cached " <> xpubtxt return (True, bals) inSync :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)@@ -702,27 +669,38 @@ => BlockHash -> CacheX m () importBlockC bh = withLockForever $- lift (getBlock bh) >>= \case- Just bd -> do- let ths = blockDataTxs bd- tds <- sortTxData . catMaybes <$> mapM (lift . getTxData) ths- $(logDebugS) "Cache" $- "Importing " <> cs (show (length tds)) <>- " transactions from block " <>- blockHashToHex bh- importMultiTxC tds- $(logDebugS) "Cache" $- "Done importing " <> cs (show (length tds)) <>- " transactions from block " <>- blockHashToHex bh- cacheSetHead bh- Nothing -> do- $(logErrorS) "Cache" $- "Could not get block: "- <> blockHashToHex bh- throwIO . LogicError . cs $- "Could not get block: "- <> blockHashToHex bh+ cacheGetHead >>= \case+ Nothing -> return ()+ Just cb ->+ asks cacheChain >>= \ch ->+ chainGetBlock bh ch >>= \case+ Nothing -> return ()+ Just bn ->+ if prevBlock (nodeHeader bn) == cb+ then go+ else return ()+ where+ go = lift (getBlock bh) >>= \case+ Just bd -> do+ let ths = blockDataTxs bd+ tds <- sortTxData . catMaybes <$> mapM (lift . getTxData) ths+ $(logDebugS) "Cache" $+ "Importing " <> cs (show (length tds)) <>+ " transactions from block " <>+ blockHashToHex bh+ importMultiTxC tds+ $(logDebugS) "Cache" $+ "Done importing " <> cs (show (length tds)) <>+ " transactions from block " <>+ blockHashToHex bh+ cacheSetHead bh+ Nothing -> do+ $(logErrorS) "Cache" $+ "Could not get block: "+ <> blockHashToHex bh+ throwIO . LogicError . cs $+ "Could not get block: "+ <> blockHashToHex bh removeHeadC :: (StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m) => BlockHash -> CacheX m ()