haskoin-store 0.3.1 → 0.4.0

raw patch · 4 files changed

+44/−41 lines, 4 files

Files

• CHANGELOG.md +5/−0
• app/Main.hs +4/−2
• haskoin-store.cabal +2/−2
• src/Network/Haskoin/Store/Block.hs +33/−37

@@ -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.4.0+### Changed+- Generate events for mempool transactions.+- Respond with entire block data when querying blocks by height.+ ## 0.3.1 ### Changed - Do not import transactions to mempool while not synced.

@@ -238,14 +238,16 @@             res <-                 withSnapshot db $ \s -> do                     let d = (db, defaultReadOptions {useSnapshot = Just s})-                    getBlocksAtHeight d height+                    bs <- getBlocksAtHeight d height+                    catMaybes <$> mapM (getBlock d) bs             S.json res         S.get "/block/heights" $ do             heights <- param "heights"             res <-                 withSnapshot db $ \s -> do                     let d = (db, defaultReadOptions {useSnapshot = Just s})-                    mapM (getBlocksAtHeight d) (nub heights)+                    bs <- mapM (getBlocksAtHeight d) (nub heights)+                    mapM (fmap catMaybes . mapM (getBlock d)) bs             S.json res         S.get "/blocks" $ do             blocks <- param "blocks"

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 11d766bffcea41fc9045490d7e0850478e76fa23b2c2a4e48f992589d3164854+-- hash: 074c9fad62ed21c9c8caa339b60a8922c460e86895ca2968a25f38a8a9275421  name:           haskoin-store-version:        0.3.1+version:        0.4.0 synopsis:       Storage and index for Bitcoin and Bitcoin Cash description:    Store blocks, transactions, and balances for Bitcoin or Bitcoin Cash, and make that information via REST API. category:       Bitcoin, Finance, Network

@@ -86,14 +86,8 @@             chainGetBest ch >>= \cb -> return (headerHash (nodeHeader cb) == bb)  mempool ::-       (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m) => m ()-mempool = do-    mgr <- blockConfManager <$> asks myConfig-    managerGetPeers mgr >>= \case-        [] -> return ()-        p:_ -> do-            $(logDebugS) "Block" "Syncing mempool against first available peer"-            MMempool `sendMessage` onlinePeerMailbox p+       (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m) => Peer -> m ()+mempool p = MMempool `sendMessage` p  processBlock ::        (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m)@@ -117,7 +111,7 @@             Right () -> do                 l <- blockConfListener <$> asks myConfig                 atomically $ l (StoreBestBlock (headerHash (blockHeader b)))-                lift $ isSynced >>= \x -> when x mempool+                lift $ isSynced >>= \x -> when x (mempool p)             Left e -> do                 $(logErrorS) "Block" $                     "Error importing block " <>@@ -169,18 +163,20 @@     -> Tx     -> m () processTx _p tx =-    void . runMaybeT $ do-        guard =<< lift isSynced-        $(logInfoS) "Block" $ "Incoming tx: " <> txHashToHex (txHash tx)-        now <- preciseUnixTime <$> liftIO getSystemTime-        net <- blockConfNet <$> asks myConfig-        db <- blockConfDB <$> asks myConfig-        runExceptT (runImportDB db $ \i -> newMempoolTx net i tx now) >>= \case-            Left e ->-                $(logErrorS) "Block" $-                "Error importing tx: " <> txHashToHex (txHash tx) <> ": " <>-                fromString (show e)-            Right () -> return ()+    isSynced >>= \x ->+        when x $ do+            $(logInfoS) "Block" $ "Incoming tx: " <> txHashToHex (txHash tx)+            now <- preciseUnixTime <$> liftIO getSystemTime+            net <- blockConfNet <$> asks myConfig+            db <- blockConfDB <$> asks myConfig+            runExceptT (runImportDB db $ \i -> newMempoolTx net i tx now) >>= \case+                Left e ->+                    $(logErrorS) "Block" $+                    "Error importing tx: " <> txHashToHex (txHash tx) <> ": " <>+                    fromString (show e)+                Right () -> do+                    l <- blockConfListener <$> asks myConfig+                    atomically $ l (StoreMempoolNew (txHash tx))  processTxs ::        (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m)@@ -188,22 +184,22 @@     -> [TxHash]     -> m () processTxs p hs =-    void . runMaybeT $ do-        guard =<< lift isSynced-        db <- blockConfDB <$> asks myConfig-        $(logDebugS) "Block" $-            "Received " <> fromString (show (length hs)) <>-            " tranasaction inventory"-        xs <--            fmap catMaybes . forM hs $ \h ->-                runMaybeT $ do-                    t <- getTransaction (db, defaultReadOptions) h-                    guard (isNothing t)-                    return (getTxHash h)-        $(logDebugS) "Block" $-            "Requesting " <> fromString (show (length xs)) <>-            " new transactions"-        MGetData (GetData (map (InvVector InvTx) xs)) `sendMessage` p+    isSynced >>= \x ->+        when x $ do+            db <- blockConfDB <$> asks myConfig+            $(logDebugS) "Block" $+                "Received " <> fromString (show (length hs)) <>+                " tranasaction inventory"+            xs <-+                fmap catMaybes . forM hs $ \h ->+                    runMaybeT $ do+                        t <- getTransaction (db, defaultReadOptions) h+                        guard (isNothing t)+                        return (getTxHash h)+            $(logDebugS) "Block" $+                "Requesting " <> fromString (show (length xs)) <>+                " new transactions"+            MGetData (GetData (map (InvVector InvTx) xs)) `sendMessage` p  checkTime :: (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m) => m () checkTime =