haskoin-store 0.37.4 → 0.37.5
raw patch · 5 files changed
+98/−79 lines, 5 filesdep ~haskoin-storedep ~haskoin-store-data
Dependency ranges changed: haskoin-store, haskoin-store-data
Files
- app/Main.hs +60/−44
- haskoin-store.cabal +6/−6
- src/Haskoin/Store/Cache.hs +6/−6
- src/Haskoin/Store/Manager.hs +25/−23
- test/Haskoin/StoreSpec.hs +1/−0
app/Main.hs view
@@ -45,53 +45,55 @@ #endif data Config = Config- { configDir :: !FilePath- , configHost :: !String- , configPort :: !Int- , configNetwork :: !Network- , configDiscover :: !Bool- , configPeers :: ![(String, Maybe Int)]- , configVersion :: !Bool- , configDebug :: !Bool- , configReqLog :: !Bool- , configMaxPending :: !Int- , configWebLimits :: !WebLimits- , configWebTimeouts :: !WebTimeouts- , configRedis :: !Bool- , configRedisURL :: !String- , configRedisMin :: !Int- , configRedisMax :: !Integer- , configWipeMempool :: !Bool- , configNoMempool :: !Bool- , configPeerTimeout :: !Int- , configPeerMaxLife :: !Int- , configMaxPeers :: !Int- , configMaxDiff :: !Int+ { configDir :: !FilePath+ , configHost :: !String+ , configPort :: !Int+ , configNetwork :: !Network+ , configDiscover :: !Bool+ , configPeers :: ![(String, Maybe Int)]+ , configVersion :: !Bool+ , configDebug :: !Bool+ , configReqLog :: !Bool+ , configMaxPending :: !Int+ , configWebLimits :: !WebLimits+ , configWebTimeouts :: !WebTimeouts+ , configRedis :: !Bool+ , configRedisURL :: !String+ , configRedisMin :: !Int+ , configRedisMax :: !Integer+ , configWipeMempool :: !Bool+ , configNoMempool :: !Bool+ , configPeerTimeout :: !Int+ , configPeerMaxLife :: !Int+ , configMaxPeers :: !Int+ , configMaxDiff :: !Int+ , configCacheRefresh :: !Int } instance Default Config where- def = Config { configDir = defDirectory- , configHost = defHost- , configPort = defPort- , configNetwork = defNetwork- , configDiscover = defDiscover- , configPeers = defPeers- , configVersion = False- , configDebug = defDebug- , configReqLog = defReqLog- , configMaxPending = defMaxPending- , configWebLimits = defWebLimits- , configWebTimeouts = defWebTimeouts- , configRedis = defRedis- , configRedisURL = defRedisURL- , configRedisMin = defRedisMin- , configRedisMax = defRedisMax- , configWipeMempool = defWipeMempool- , configNoMempool = defNoMempool- , configPeerTimeout = defPeerTimeout- , configPeerMaxLife = defPeerMaxLife- , configMaxPeers = defMaxPeers- , configMaxDiff = defMaxDiff+ def = Config { configDir = defDirectory+ , configHost = defHost+ , configPort = defPort+ , configNetwork = defNetwork+ , configDiscover = defDiscover+ , configPeers = defPeers+ , configVersion = False+ , configDebug = defDebug+ , configReqLog = defReqLog+ , configMaxPending = defMaxPending+ , configWebLimits = defWebLimits+ , configWebTimeouts = defWebTimeouts+ , configRedis = defRedis+ , configRedisURL = defRedisURL+ , configRedisMin = defRedisMin+ , configRedisMax = defRedisMax+ , configWipeMempool = defWipeMempool+ , configNoMempool = defNoMempool+ , configPeerTimeout = defPeerTimeout+ , configPeerMaxLife = defPeerMaxLife+ , configMaxPeers = defMaxPeers+ , configMaxDiff = defMaxDiff+ , configCacheRefresh = defCacheRefresh } defEnv :: MonadIO m => String -> a -> (String -> Maybe a) -> m a@@ -99,6 +101,11 @@ ms <- lookupEnv e return $ fromMaybe d $ p =<< ms +defCacheRefresh :: Int+defCacheRefresh = unsafePerformIO $+ defEnv "CACHE_REFRESH" 750 readMaybe+{-# NOINLINE defCacheRefresh #-}+ defMaxPending :: Int defMaxPending = unsafePerformIO $ defEnv "MAX_PENDING_TXS" 100 readMaybe@@ -401,6 +408,13 @@ <> help "Maximum number of keys in Redis xpub cache" <> showDefault <> value (configRedisMax def)+ configCacheRefresh <-+ option auto $+ metavar "MILLISECONDS"+ <> long "cache-refresh"+ <> help "Refresh cache this frequently"+ <> showDefault+ <> value (configCacheRefresh def) configNoMempool <- flag (configNoMempool def) True $ long "no-mempool"@@ -485,6 +499,7 @@ , configMaxPeers = maxpeers , configMaxDiff = maxdiff , configNoMempool = nomem+ , configCacheRefresh = crefresh } = runStderrLoggingT . filterLogger l $ do $(logInfoS) "Main" $@@ -511,6 +526,7 @@ , storeConfPeerTimeout = fromIntegral peertimeout , storeConfPeerMaxLife = fromIntegral peerlife , storeConfConnect = withConnection+ , storeConfCacheRefresh = crefresh } withStore scfg $ \st -> runWeb
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a9cd74aee3b5a5b336b40bb4d2e3a0f823359573cc439ade5a2b32175bfb665b+-- hash: 6706ddf8dce4c42481f5013333abf722c72156f93f2e540ce10c8c8086eb9d13 name: haskoin-store-version: 0.37.4+version: 0.37.5 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@@ -53,7 +53,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.6 , haskoin-node >=0.14.1- , haskoin-store-data ==0.37.4+ , haskoin-store-data ==0.37.5 , hedis >=0.12.13 , http-types >=0.12.3 , monad-logger >=0.3.32@@ -96,7 +96,7 @@ , haskoin-core >=0.13.6 , haskoin-node >=0.14.1 , haskoin-store- , haskoin-store-data ==0.37.4+ , haskoin-store-data ==0.37.5 , monad-logger >=0.3.32 , mtl >=2.2.2 , nqe >=0.6.1@@ -135,8 +135,8 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.6 , haskoin-node >=0.14.1- , haskoin-store ==0.37.4- , haskoin-store-data ==0.37.4+ , haskoin-store ==0.37.5+ , haskoin-store-data ==0.37.5 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Cache.hs view
@@ -87,10 +87,11 @@ throwIO (RedisError e) data CacheConfig = CacheConfig- { cacheConn :: !Connection- , cacheMin :: !Int- , cacheMax :: !Integer- , cacheChain :: !Chain+ { cacheConn :: !Connection+ , cacheMin :: !Int+ , cacheMax :: !Integer+ , cacheChain :: !Chain+ , cacheRefresh :: !Int } type CacheT = ReaderT (Maybe CacheConfig)@@ -912,10 +913,9 @@ Nothing -> return True Just bs -> do let t = read (cs bs)+ cooldown <- toInteger . (* 500) <$> asks cacheRefresh now <- microseconds return (cooldown <= now - t)- where- cooldown = 250000 startCooldown :: (MonadUnliftIO m, MonadLoggerIO m) => CacheX m () startCooldown = do
src/Haskoin/Store/Manager.hs view
@@ -46,10 +46,8 @@ publishSTM, receive, withProcess, withPublisher, withSubscription)-import System.Random (randomRIO) import UnliftIO (MonadIO, MonadUnliftIO, STM,- atomically, liftIO, link,- withAsync)+ atomically, link, withAsync) import UnliftIO.Concurrent (threadDelay) -- | Store mailboxes.@@ -67,36 +65,38 @@ -- | Configuration for a 'Store'. data StoreConfig = StoreConfig- { storeConfMaxPeers :: !Int+ { storeConfMaxPeers :: !Int -- ^ max peers to connect to- , storeConfInitPeers :: ![HostPort]+ , storeConfInitPeers :: ![HostPort] -- ^ static set of peers to connect to- , storeConfDiscover :: !Bool+ , storeConfDiscover :: !Bool -- ^ discover new peers- , storeConfDB :: !FilePath+ , storeConfDB :: !FilePath -- ^ RocksDB database path- , storeConfNetwork :: !Network+ , storeConfNetwork :: !Network -- ^ network constants- , storeConfCache :: !(Maybe String)+ , storeConfCache :: !(Maybe String) -- ^ Redis cache configuration- , storeConfInitialGap :: !Word32+ , storeConfInitialGap :: !Word32 -- ^ gap on extended public key with no transactions- , storeConfGap :: !Word32+ , storeConfGap :: !Word32 -- ^ gap for extended public keys- , storeConfCacheMin :: !Int+ , storeConfCacheMin :: !Int -- ^ cache xpubs with more than this many used addresses- , storeConfMaxKeys :: !Integer+ , storeConfMaxKeys :: !Integer -- ^ maximum number of keys in Redis cache- , storeConfNoMempool :: !Bool+ , storeConfNoMempool :: !Bool -- ^ do not index new mempool transactions- , storeConfWipeMempool :: !Bool+ , storeConfWipeMempool :: !Bool -- ^ wipe mempool when starting- , storeConfPeerTimeout :: !NominalDiffTime+ , storeConfPeerTimeout :: !NominalDiffTime -- ^ disconnect peer if message not received for this many seconds- , storeConfPeerMaxLife :: !NominalDiffTime+ , storeConfPeerMaxLife :: !NominalDiffTime -- ^ disconnect peer if it has been connected this long- , storeConfConnect :: !(SockAddr -> WithConnection)+ , storeConfConnect :: !(SockAddr -> WithConnection) -- ^ connect to peers using the function 'withConnection'+ , storeConfCacheRefresh :: !Int+ -- ^ refresh the cache this often (milliseconds) } withStore :: (MonadLoggerIO m, MonadUnliftIO m)@@ -181,9 +181,10 @@ connectRedis redisurl >>= \conn -> withSubscription pub $ \evts -> withProcess (f conn) $ \p ->- cacheWriterProcesses evts (getProcessMailbox p) $+ cacheWriterProcesses crefresh evts (getProcessMailbox p) $ action (Just (c conn)) where+ crefresh = storeConfCacheRefresh cfg f conn cwinbox = runReaderT (cacheWriter (c conn) cwinbox) db c conn =@@ -192,22 +193,23 @@ , cacheMin = storeConfCacheMin cfg , cacheChain = chain , cacheMax = storeConfMaxKeys cfg+ , cacheRefresh = storeConfCacheRefresh cfg } cacheWriterProcesses :: MonadUnliftIO m- => Inbox StoreEvent+ => Int+ -> Inbox StoreEvent -> CacheWriter -> m a -> m a-cacheWriterProcesses evts cwm action =+cacheWriterProcesses crefresh evts cwm action = withAsync events $ \a1 -> withAsync ping $ \a2 -> link a1 >> link a2 >> action where events = cacheWriterEvents evts cwm ping = forever $ do- time <- liftIO $ randomRIO (600000, 1200000)- threadDelay time+ threadDelay (crefresh * 1000) cachePing cwm cacheWriterEvents :: MonadIO m => Inbox StoreEvent -> CacheWriter -> m ()
test/Haskoin/StoreSpec.hs view
@@ -92,6 +92,7 @@ , storeConfPeerTimeout = 60 , storeConfPeerMaxLife = 48 * 3600 , storeConfConnect = dummyPeerConnect net ad+ , storeConfCacheRefresh = 750 } withStore cfg $ \Store {..} -> withSubscription storePublisher $ \sub ->