haskoin-store 0.53.11 → 0.55.0
raw patch · 9 files changed
+142/−95 lines, 9 filesdep +wai-websocketsdep +websocketsdep ~haskoin-coredep ~haskoin-store-dataPVP ok
version bump matches the API change (PVP)
Dependencies added: wai-websockets, websockets
Dependency ranges changed: haskoin-core, haskoin-store-data
API changes (from Hackage documentation)
+ Haskoin.Store: StoreMempoolDelete :: !TxHash -> StoreEvent
+ Haskoin.Store.Common: StoreMempoolDelete :: !TxHash -> StoreEvent
- Haskoin.Store.Logic: newMempoolTx :: MonadImport m => Tx -> UnixTime -> m Bool
+ Haskoin.Store.Logic: newMempoolTx :: MonadImport m => Tx -> UnixTime -> m (Maybe (HashSet TxHash))
Files
- CHANGELOG.md +15/−6
- README.md +6/−5
- app/Main.hs +17/−29
- haskoin-store.cabal +13/−9
- src/Haskoin/Store/BlockStore.hs +11/−10
- src/Haskoin/Store/Common.hs +1/−0
- src/Haskoin/Store/Logic.hs +17/−11
- src/Haskoin/Store/Manager.hs +1/−1
- src/Haskoin/Store/Web.hs +61/−24
CHANGELOG.md view
@@ -4,23 +4,32 @@ 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.35.11+## 0.55.0 ### Changed+- Always have a previous output object in Blockchain inputs.++## 0.54.0+### Added+- WebSocket support.+- Testnet4 support.++## 0.53.11+### Changed - Dummy version increase to signal upstream update of Haskoin Core. -## 0.35.10+## 0.53.10 ### Fixed - Correct test that was reversed in previous version. -## 0.35.9+## 0.53.9 ### Removed - Mempool is no longer synced by default to fix public Bitcoin Core regression. -## 0.35.8+## 0.53.8 ### Changed - Put derivations stat inside database. -## 0.35.7+## 0.53.7 ### Added - Added counters for database retrievals. - Added counter for xpub derivations.@@ -28,7 +37,7 @@ ### Changed - Removed some buggy or unnecessary stats. -## 0.35.6+## 0.53.6 ### Changed - Improve web server statistics.
README.md view
@@ -13,9 +13,9 @@ - RESTful API with JSON and binary serialization. - High performance concurrent architecture. -## Quick Install with Nix Anywhere+## Install with Nix on any distribution -* Get [Nix](https://nixos.org/nix/).+* Get [Nix](https://nixos.org/nix/) ```sh nix-env --install stack@@ -25,12 +25,12 @@ ~/.local/bin/haskoin-store --help ``` -## Install on Ubuntu 20.04 or Debian 10+## Install on Ubuntu or Debian * Get [Stack](https://haskellstack.org/) ```sh-apt install git libsecp256k1-dev librocksdb-dev pkg-config+apt install git zlib1g-dev libsecp256k1-dev librocksdb-dev pkg-config git clone https://github.com/haskoin/haskoin-store.git cd haskoin-store stack build --copy-bins@@ -39,8 +39,9 @@ ## Non-Haskell Dependencies +* [zlib](https://zlib.net/) * [libsecp256k1](https://github.com/Bitcoin-ABC/secp256k1)-* [RocksDB](https://github.com/facebook/rocksdb/)+* [RocksDB](https://github.com/facebook/rocksdb) ## API Documentation
app/Main.hs view
@@ -21,7 +21,7 @@ import qualified Data.Text as T import Data.Word (Word32) import Haskoin (Network (..), allNets, bch,- bchRegTest, bchTest, btc,+ bchRegTest, bchTest, bchTest4, btc, btcRegTest, btcTest, eitherToMaybe) import Haskoin.Node (withConnection) import Haskoin.Store (StoreConfig (..), WebConfig (..),@@ -54,8 +54,7 @@ { configDir :: !FilePath , configHost :: !String , configPort :: !Int- , configNetwork :: !Network- , configAsert :: !Word32+ , configNetwork :: !String , configDiscover :: !Bool , configPeers :: ![(String, Maybe Int)] , configVersion :: !Bool@@ -88,7 +87,6 @@ , configHost = defHost , configPort = defPort , configNetwork = defNetwork- , configAsert = defAsert , configDiscover = defDiscover , configPeers = defPeers , configVersion = False@@ -157,16 +155,11 @@ defEnv "PORT" 3000 readMaybe {-# NOINLINE defPort #-} -defNetwork :: Network+defNetwork :: String defNetwork = unsafePerformIO $- defEnv "NET" bch (eitherToMaybe . networkReader)+ defEnv "NET" "bch" pure {-# NOINLINE defNetwork #-} -defAsert :: Word32-defAsert = unsafePerformIO $- defEnv "ASERT" 0 readMaybe-{-# NOINLINE defAsert #-}- defRedisMin :: Int defRedisMin = unsafePerformIO $ defEnv "CACHE_MIN" 100 readMaybe@@ -335,19 +328,13 @@ <> showDefault <> value (configPort def) configNetwork <-- option (eitherReader networkReader) $+ strOption $ metavar netNames <> long "net" <> short 'n' <> help "Network to connect to" <> showDefault <> value (configNetwork def)- configAsert <-- option auto $- metavar "TIME"- <> long "asert"- <> help "ASERT (axon) activation time"- <> value (configAsert def) configDiscover <- flag (configDiscover def) True $ long "discover"@@ -429,14 +416,14 @@ option auto $ metavar "SECONDS" <> long "block-timeout"- <> help "Last block mined health timeout (0 = inf)"+ <> help "Last block mined health timeout" <> showDefault <> value (blockTimeout (configWebTimeouts def)) txTimeout <- option auto $ metavar "SECONDS" <> long "tx-timeout"- <> help "Last tx recived health timeout (0 = inf)"+ <> help "Last tx recived health timeout" <> showDefault <> value (txTimeout (configWebTimeouts def)) configPeerTimeout <-@@ -563,6 +550,7 @@ | s == getNetworkName btcRegTest = Right btcRegTest | s == getNetworkName bch = Right bch | s == getNetworkName bchTest = Right bchTest+ | s == getNetworkName bchTest4 = Right bchTest4 | s == getNetworkName bchRegTest = Right bchRegTest | otherwise = Left "Network name invalid" @@ -600,8 +588,7 @@ run :: Config -> IO () run Config { configHost = host , configPort = port- , configNetwork = net- , configAsert = asert+ , configNetwork = net_str , configDiscover = disc , configPeers = peers , configDir = db_dir@@ -629,17 +616,20 @@ , configWebPriceGet = wpget } = runStderrLoggingT . filterLogger l . with_stats $ \stats -> do+ net <- case networkReader net_str of+ Right n -> return n+ Left e -> error e $(logInfoS) "Main" $- "Creating working directory if not found: " <> cs wd- createDirectoryIfMissing True wd+ "Creating working directory if not found: " <> cs (wd net)+ createDirectoryIfMissing True (wd net) let scfg = StoreConfig { storeConfMaxPeers = maxpeers , storeConfInitPeers = map (second (fromMaybe (getDefaultPort net))) peers , storeConfDiscover = disc- , storeConfDB = wd </> "db"- , storeConfNetwork = net'+ , storeConfDB = wd net </> "db"+ , storeConfNetwork = net , storeConfCache = if redis then Just redisurl@@ -686,9 +676,7 @@ (T.pack statsdpfx) (go . Just) | otherwise = go Nothing- net' | asert == 0 = net- | otherwise = net { getAsertActivationTime = Just asert } l _ lvl | deb = True | otherwise = LevelInfo <= lvl- wd = db_dir </> getNetworkName net'+ wd net = db_dir </> getNetworkName net
haskoin-store.cabal view
@@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 7cff24e5b6ce01f7b47d7ce31d0eda998fdbe9b56ad028e075dec93d0fe2bd31 name: haskoin-store-version: 0.53.11+version: 0.55.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,9 +58,9 @@ , ekg-statsd >=0.2.5 , foldl >=1.4.10 , hashable >=1.3.0.0- , haskoin-core >=0.20.4+ , haskoin-core >=0.21.0 , haskoin-node >=0.17.0- , haskoin-store-data ==0.53.11+ , haskoin-store-data ==0.55.0 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -85,7 +83,9 @@ , vault >=0.3.1.5 , wai >=3.2.2.1 , wai-extra >=3.1.6+ , wai-websockets >=3.0.1.2 , warp >=3.3.10+ , websockets >=0.12.4 , wreq >=0.5.3.2 default-language: Haskell2010 @@ -113,10 +113,10 @@ , filepath , foldl >=1.4.10 , hashable >=1.3.0.0- , haskoin-core >=0.20.4+ , haskoin-core >=0.21.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.53.11+ , haskoin-store-data ==0.55.0 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1@@ -140,7 +140,9 @@ , vault >=0.3.1.5 , wai >=3.2.2.1 , wai-extra >=3.1.6+ , wai-websockets >=3.0.1.2 , warp >=3.3.10+ , websockets >=0.12.4 , wreq >=0.5.3.2 default-language: Haskell2010 @@ -172,10 +174,10 @@ , ekg-statsd >=0.2.5 , foldl >=1.4.10 , hashable >=1.3.0.0- , haskoin-core >=0.20.4+ , haskoin-core >=0.21.0 , haskoin-node >=0.17.0 , haskoin-store- , haskoin-store-data ==0.53.11+ , haskoin-store-data ==0.55.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3@@ -199,7 +201,9 @@ , vault >=0.3.1.5 , wai >=3.2.2.1 , wai-extra >=3.1.6+ , wai-websockets >=3.0.1.2 , warp >=3.3.10+ , websockets >=0.12.4 , wreq >=0.5.3.2 default-language: Haskell2010 build-tool-depends: hspec-discover:hspec-discover
src/Haskoin/Store/BlockStore.hs view
@@ -610,29 +610,29 @@ => BlockStore -> UTCTime -> Tx- -> WriterT m Bool+ -> WriterT m (Maybe (HashSet TxHash)) importMempoolTx block_read time tx = catchError new_mempool_tx handle_error where tx_hash = txHash tx handle_error Orphan = do newOrphanTx block_read time tx- return False- handle_error _ = return False+ return Nothing+ handle_error _ = return Nothing seconds = floor (utcTimeToPOSIXSeconds time) new_mempool_tx = newMempoolTx tx seconds >>= \case- True -> do+ Just set -> do $(logInfoS) "BlockStore" $ "Import tx " <> txHashToHex (txHash tx) <> ": OK" fulfillOrphans block_read tx_hash- return True- False -> do+ return (Just set)+ Nothing -> do $(logDebugS) "BlockStore" $ "Import tx " <> txHashToHex (txHash tx) <> ": Already imported"- return False+ return Nothing processMempool :: MonadLoggerIO m => BlockT m () processMempool = guardMempool $ do@@ -645,8 +645,8 @@ block_read (pendingTxTime p) (pendingTx p) >>= \case- True -> return $ Just (txHash (pendingTx p))- False -> return Nothing+ Just set -> return $ Just (txHash (pendingTx p), set)+ Nothing -> return Nothing import_txs block_read txs = let r = mapM (run_import block_read) txs in runImport r >>= \case@@ -657,8 +657,9 @@ "Error processing mempool: " <> cs (show e) throwIO e success = mapM_ notify- notify txid = do+ notify (txid, set) = do listener <- asks (blockConfListener . myConfig)+ mapM ((`publish` listener) . StoreMempoolDelete) (HashSet.toList set) publish (StoreMempoolNew txid) listener processTxs ::
src/Haskoin/Store/Common.hs view
@@ -328,6 +328,7 @@ data StoreEvent = StoreBestBlock !BlockHash | StoreMempoolNew !TxHash+ | StoreMempoolDelete !TxHash | StorePeerConnected !Peer | StorePeerDisconnected !Peer | StorePeerPong !Peer !Word64
src/Haskoin/Store/Logic.hs view
@@ -22,6 +22,7 @@ logErrorS) import qualified Data.ByteString as B import Data.Either (rights)+import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import qualified Data.IntMap.Strict as I import Data.List (nub)@@ -91,17 +92,20 @@ $(logDebugS) "BlockStore" "Importing Genesis block" importBlock (genesisBlock net) (genesisNode net) -newMempoolTx :: MonadImport m => Tx -> UnixTime -> m Bool+-- | If it returns 'Nothing', then transaction was not imported because it+-- already exists. Otherwise tranasction was imported successfully. Any deleted+-- transactions will be returned in the set (RBF only).+newMempoolTx :: MonadImport m => Tx -> UnixTime -> m (Maybe (HashSet TxHash)) newMempoolTx tx w = getActiveTxData (txHash tx) >>= \case Just _ ->- return False+ return Nothing Nothing -> do- freeOutputs True True tx+ txids <- freeOutputs True True tx rbf <- isRBF (MemRef w) tx checkNewTx tx importTx (MemRef w) w rbf tx- return True+ return (Just txids) bestBlockData :: MonadImport m => m BlockData bestBlockData = do@@ -385,13 +389,15 @@ => Bool -- ^ only delete transaction if unconfirmed -> Bool -- ^ only delete RBF -> Tx- -> m ()-freeOutputs memonly rbfcheck tx =- forM_ (prevOuts tx) $ \op ->- getUnspent op >>= \u -> when (isNothing u) $- getSpender op >>= \p -> forM_ p $ \s ->- unless (spenderHash s == txHash tx) $- deleteTx memonly rbfcheck (spenderHash s)+ -> m (HashSet TxHash)+freeOutputs memonly rbfcheck tx = do+ let prevs = prevOuts tx+ unspents <- mapM getUnspent prevs+ let spents = map fst $ filter (isNothing . snd) $ zip prevs unspents+ spndrs <- catMaybes <$> mapM getSpender spents+ let txids = HashSet.fromList $ filter (/= txHash tx) $ map spenderHash spndrs+ mapM (deleteTx memonly rbfcheck) $ HashSet.toList txids+ return txids deleteConfirmedTx :: MonadImport m => TxHash -> m () deleteConfirmedTx = deleteTx False False
src/Haskoin/Store/Manager.hs view
@@ -91,7 +91,7 @@ -- ^ do not index new mempool transactions , storeConfWipeMempool :: !Bool -- ^ wipe mempool when starting- , storeConfSyncMempool :: !Bool+ , storeConfSyncMempool :: !Bool -- ^ sync mempool from peers , storeConfPeerTimeout :: !NominalDiffTime -- ^ disconnect peer if message not received for this many seconds
src/Haskoin/Store/Web.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}@@ -91,6 +90,7 @@ import Haskoin.Address import qualified Haskoin.Block as H import Haskoin.Constants+import Haskoin.Data import Haskoin.Keys import Haskoin.Network import Haskoin.Node (Chain,@@ -110,7 +110,8 @@ import Haskoin.Store.WebCommon import Haskoin.Transaction import Haskoin.Util-import NQE (Inbox, receive,+import NQE (Inbox, Publisher,+ receive, withSubscription) import Network.HTTP.Types (Status (..), requestEntityTooLarge413,@@ -128,7 +129,16 @@ responseStatus) import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort)+import Network.Wai.Handler.WebSockets (websocketsOr) import Network.Wai.Middleware.RequestSizeLimit+import Network.WebSockets (ServerApp,+ acceptRequest,+ defaultConnectionOptions,+ pendingRequest,+ rejectRequestWith,+ requestPath,+ sendTextData)+import qualified Network.WebSockets as WebSockets import qualified Network.Wreq as Wreq import System.IO.Unsafe (unsafeInterleaveIO) import qualified System.Metrics as Metrics@@ -342,6 +352,12 @@ d x = createStatDist ("web." <> x) s g x = Metrics.createGauge ("web." <> x) s +withGaugeIO :: MonadUnliftIO m => Metrics.Gauge -> m a -> m a+withGaugeIO g =+ bracket_+ (liftIO $ Metrics.Gauge.inc g)+ (liftIO $ Metrics.Gauge.dec g)+ withGaugeIncrease :: MonadUnliftIO m => (WebMetrics -> Metrics.Gauge) -> WebT m a@@ -350,15 +366,8 @@ lift (asks webMetrics) >>= \case Nothing -> go Just m -> do- s <- liftWith $ \run ->- bracket_- (start m)- (end m)- (run go)+ s <- liftWith $ \run -> withGaugeIO (gf m) (run go) restoreT $ return s- where- start m = liftIO $ Metrics.Gauge.inc (gf m)- end m = liftIO $ Metrics.Gauge.dec (gf m) setMetrics :: MonadUnliftIO m => (WebMetrics -> StatDist)@@ -458,6 +467,7 @@ 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@@ -510,7 +520,7 @@ req <- S.request mM <- case V.lookup (statKey m) (vault req) of Nothing -> return Nothing- Just t -> readTVarIO t+ Just t -> readTVarIO t let status = errStatus err if | statusIsClientError status -> liftIO $ do@@ -1218,6 +1228,31 @@ ths <- map snd . applyLimits l <$> getMempool return ths ++webSocketEvents :: WebState -> Middleware+webSocketEvents s =+ websocketsOr defaultConnectionOptions events+ where+ pub = (storePublisher . webStore . webConfig) s+ gauge = statEvents <$> webMetrics s+ events pending = withSubscription pub $ \sub -> do+ let path = requestPath $ pendingRequest pending+ if path == "/events"+ then do+ conn <- acceptRequest pending+ forever $ receiveEvent sub >>= \case+ Nothing -> return ()+ Just event -> sendTextData conn (A.encode event)+ else+ rejectRequestWith+ pending+ WebSockets.defaultRejectRequest+ { WebSockets.rejectBody = L.toStrict $ A.encode ThingNotFound+ , WebSockets.rejectCode = 404+ , WebSockets.rejectMessage = "Not Found"+ , WebSockets.rejectHeaders = [("Content-Type", "application/json")]+ }+ scottyEvents :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyEvents = withGaugeIncrease statEvents $ do@@ -1240,9 +1275,10 @@ se <- receive sub return $ case se of- StoreBestBlock b -> Just (EventBlock b)- StoreMempoolNew t -> Just (EventTx t)- _ -> Nothing+ StoreBestBlock b -> Just (EventBlock b)+ StoreMempoolNew t -> Just (EventTx t)+ StoreMempoolDelete t -> Just (EventTx t)+ _ -> Nothing -- GET Address Transactions -- @@ -1429,7 +1465,7 @@ if T.null p then return HashSet.empty else case parseBinfoAddr net p of- Nothing -> raise (UserError "invalid active address")+ Nothing -> raise (UserError "invalid address") Just xs -> return $ HashSet.fromList xs getBinfoActive :: MonadIO m@@ -1556,7 +1592,7 @@ addr_c a = streamThings (getAddressTxs a) (Just txRefHash) def{limit = 50} binfo_tx b = toBinfoTx numtxid abook prune b compute_bal_change BinfoTx{..} =- let ins = mapMaybe getBinfoTxInputPrevOut getBinfoTxInputs+ let ins = map getBinfoTxInputPrevOut getBinfoTxInputs out = getBinfoTxOutputs f b BinfoTxOutput{..} = let val = fromIntegral getBinfoTxOutputValue@@ -2049,10 +2085,11 @@ binfoShortBalReceived = balanceTotalReceived } get_addr_balance net cashaddr a =- let net' = if | cashaddr -> net- | net == bch -> btc- | net == bchTest -> btcTest- | otherwise -> net+ let net' = if | cashaddr -> net+ | net == bch -> btc+ | net == bchTest -> btcTest+ | net == bchTest4 -> btcTest+ | otherwise -> net in case addrToText net' a of Nothing -> return Nothing Just a' -> getBalance a >>= \case@@ -2392,9 +2429,7 @@ -> WebT m [PeerInformation] scottyPeers _ = do setMetrics statPeers- peers <- lift $ getPeersInformation =<<- asks (storeManager . webStore . webConfig)- return peers+ lift $ getPeersInformation =<< asks (storeManager . webStore . webConfig) -- | Obtain information about connected peers from peer manager process. getPeersInformation@@ -2461,7 +2496,9 @@ return TimeHealth {..} where ch = storeChain webStore- to = if webNoMempool then blockTimeout webTimeouts else txTimeout webTimeouts+ to = if webNoMempool+ then blockTimeout webTimeouts+ else txTimeout webTimeouts pendingTxsHealthCheck :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) => WebConfig -> m MaxHealth