haskoin-store 0.37.5 → 0.38.0
raw patch · 4 files changed
+131/−75 lines, 4 filesdep ~haskoin-storedep ~haskoin-store-data
Dependency ranges changed: haskoin-store, haskoin-store-data
Files
- app/Main.hs +19/−2
- haskoin-store.cabal +7/−7
- src/Haskoin/Store/Common.hs +66/−56
- src/Haskoin/Store/Web.hs +39/−10
app/Main.hs view
@@ -16,6 +16,7 @@ import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.String.Conversions (cs)+import Data.Word (Word32) import Haskoin (Network (..), allNets, bch, bchRegTest, bchTest, btc, btcRegTest, btcTest, eitherToMaybe)@@ -49,6 +50,7 @@ , configHost :: !String , configPort :: !Int , configNetwork :: !Network+ , configAsert :: !Word32 , configDiscover :: !Bool , configPeers :: ![(String, Maybe Int)] , configVersion :: !Bool@@ -75,6 +77,7 @@ , configHost = defHost , configPort = defPort , configNetwork = defNetwork+ , configAsert = defAsert , configDiscover = defDiscover , configPeers = defPeers , configVersion = False@@ -137,6 +140,11 @@ defEnv "NET" bch (eitherToMaybe . networkReader) {-# NOINLINE defNetwork #-} +defAsert :: Word32+defAsert = unsafePerformIO $+ defEnv "ASERT" 0 readMaybe+{-# NOINLINE defAsert #-}+ defRedisMin :: Int defRedisMin = unsafePerformIO $ defEnv "CACHE_MIN" 100 readMaybe@@ -275,6 +283,12 @@ <> 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"@@ -481,6 +495,7 @@ run Config { configHost = host , configPort = port , configNetwork = net+ , configAsert = asert , configDiscover = disc , configPeers = peers , configDir = db_dir@@ -512,7 +527,7 @@ map (second (fromMaybe (getDefaultPort net))) peers , storeConfDiscover = disc , storeConfDB = wd </> "db"- , storeConfNetwork = net+ , storeConfNetwork = net' , storeConfCache = if redis then Just redisurl@@ -543,7 +558,9 @@ , webNoMempool = nomem } where+ net' | asert == 0 = net+ | otherwise = net { getAsertActivationTime = Just asert } l _ lvl | deb = True | otherwise = LevelInfo <= lvl- wd = db_dir </> getNetworkName net+ wd = db_dir </> getNetworkName net'
haskoin-store.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack ----- hash: 6706ddf8dce4c42481f5013333abf722c72156f93f2e540ce10c8c8086eb9d13+-- hash: b1a8d34c8b0abb61f5882a9454a5c93e684db97d46d01e20eb7bc24cfc02c188 name: haskoin-store-version: 0.37.5+version: 0.38.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@@ -53,7 +53,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.6 , haskoin-node >=0.14.1- , haskoin-store-data ==0.37.5+ , haskoin-store-data ==0.38.0 , 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.5+ , haskoin-store-data ==0.38.0 , 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.5- , haskoin-store-data ==0.37.5+ , haskoin-store ==0.38.0+ , haskoin-store-data ==0.38.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Common.hs view
@@ -22,6 +22,7 @@ , xPubBalsUnspents , getTransaction , blockAtOrBefore+ , blockAtOrAfterMTP , deOffset , applyLimits , applyLimitsC@@ -30,45 +31,48 @@ , microseconds ) where -import Conduit (ConduitT, dropC, mapC, takeC)-import Control.DeepSeq (NFData)-import Control.Exception (Exception)-import Control.Monad (mzero)-import Control.Monad.Trans (lift)-import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)-import Data.ByteString (ByteString)-import Data.Default (Default (..))-import Data.Function (on)-import Data.Hashable (Hashable)-import qualified Data.HashSet as H-import Data.IntMap.Strict (IntMap)-import qualified Data.IntMap.Strict as I-import Data.List (sortBy)-import Data.Maybe (catMaybes, listToMaybe)-import Data.Serialize (Serialize (..))-import Data.Time.Clock.System (getSystemTime, systemNanoseconds,- systemSeconds)-import Data.Word (Word32, Word64)-import GHC.Generics (Generic)-import Haskoin (Address, BlockHash,- BlockHeader (..), BlockHeight,- KeyIndex, Network (..),- OutPoint (..), RejectCode (..),- Tx (..), TxHash (..), TxIn (..),- XPubKey (..), deriveAddr,- deriveCompatWitnessAddr,- deriveWitnessAddr, pubSubKey,- txHash)-import Haskoin.Node (Peer)-import Haskoin.Store.Data (Balance (..), BlockData (..),- DeriveType (..), Spender,- Transaction, TxData (..),- TxRef (..), UnixTime, Unspent (..),- XPubBal (..), XPubSpec (..),- XPubSummary (..), XPubUnspent (..),- nullBalance, toTransaction,- zeroBalance)-import UnliftIO (MonadIO, liftIO)+import Conduit (ConduitT, dropC, mapC, takeC)+import Control.DeepSeq (NFData)+import Control.Exception (Exception)+import Control.Monad.Trans (lift)+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)+import Control.Monad.Trans.Reader (runReaderT)+import Data.ByteString (ByteString)+import Data.Default (Default (..))+import Data.Function (on)+import Data.Hashable (Hashable)+import qualified Data.HashSet as H+import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as I+import Data.List (sortBy)+import Data.Maybe (catMaybes)+import Data.Serialize (Serialize (..))+import Data.Time.Clock.System (getSystemTime, systemNanoseconds,+ systemSeconds)+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Haskoin (Address, BlockHash,+ BlockHeader (..), BlockHeight,+ BlockNode (..), KeyIndex,+ Network (..), OutPoint (..),+ RejectCode (..), Tx (..),+ TxHash (..), TxIn (..),+ XPubKey (..), deriveAddr,+ deriveCompatWitnessAddr,+ deriveWitnessAddr,+ firstGreaterOrEqual, headerHash,+ lastSmallerOrEqual, mtp, pubSubKey,+ txHash)+import Haskoin.Node (Chain, Peer)+import Haskoin.Store.Data (Balance (..), BlockData (..),+ DeriveType (..), Spender,+ Transaction, TxData (..),+ TxRef (..), UnixTime, Unspent (..),+ XPubBal (..), XPubSpec (..),+ XPubSummary (..), XPubUnspent (..),+ nullBalance, toTransaction,+ zeroBalance)+import UnliftIO (MonadIO, liftIO) type DeriveAddr = XPubKey -> KeyIndex -> Address @@ -273,25 +277,31 @@ sm <- lift $ getSpenders h return $ toTransaction d sm -blockAtOrBefore :: (Monad m, StoreReadExtra m)- => UnixTime+blockAtOrBefore :: (MonadIO m, StoreReadExtra m)+ => Chain+ -> UnixTime -> m (Maybe BlockData)-blockAtOrBefore q = runMaybeT $ do- a <- g 0- b <- MaybeT getBestBlock >>= MaybeT . getBlock- f a b+blockAtOrBefore ch q = runMaybeT $ do+ net <- lift getNetwork+ x <- MaybeT $ liftIO $ runReaderT (lastSmallerOrEqual net f) ch+ MaybeT $ getBlock (headerHash (nodeHeader x)) where- f a b- | t b <= q = return b- | t a > q = mzero- | h b - h a == 1 = return a- | otherwise = do- let x = h a + (h b - h a) `div` 2- m <- g x- if t m > q then f a m else f m b- g x = MaybeT (listToMaybe <$> getBlocksAtHeight x) >>= MaybeT . getBlock- h = blockDataHeight- t = fromIntegral . blockTimestamp . blockDataHeader+ f x =+ let t = fromIntegral (blockTimestamp (nodeHeader x))+ in return $ t `compare` q++blockAtOrAfterMTP :: (MonadIO m, StoreReadExtra m)+ => Chain+ -> UnixTime+ -> m (Maybe BlockData)+blockAtOrAfterMTP ch q = runMaybeT $ do+ net <- lift getNetwork+ x <- MaybeT $ liftIO $ runReaderT (firstGreaterOrEqual net f) ch+ MaybeT $ getBlock (headerHash (nodeHeader x))+ where+ f x = do+ t <- fromIntegral <$> mtp x+ return $ t `compare` q -- | Events that the store can generate.
src/Haskoin/Store/Web.hs view
@@ -263,6 +263,16 @@ scottyBlockTimeRaw (const toEncoding) (const toJSON)+ pathPretty+ (GetBlockMTP <$> paramLazy <*> paramDef)+ scottyBlockMTP+ blockDataToEncoding+ blockDataToJSON+ pathCompact+ (GetBlockMTPRaw <$> paramLazy)+ scottyBlockMTPRaw+ (const toEncoding)+ (const toJSON) -- Transaction Paths pathPretty (GetTx <$> paramLazy)@@ -566,20 +576,38 @@ -- GET BlockTime / BlockTimeRaw -- -scottyBlockTime ::- (MonadUnliftIO m, MonadLoggerIO m) => GetBlockTime -> WebT m BlockData-scottyBlockTime (GetBlockTime (TimeParam t) (NoTx noTx)) =- maybe (S.raise ThingNotFound) (return . pruneTx noTx) =<< blockAtOrBefore t+scottyBlockTime :: (MonadUnliftIO m, MonadLoggerIO m)+ => GetBlockTime -> WebT m BlockData+scottyBlockTime (GetBlockTime (TimeParam t) (NoTx noTx)) = do+ ch <- lift $ asks (storeChain . webStore)+ m <- blockAtOrBefore ch t+ maybe (S.raise ThingNotFound) (return . pruneTx noTx) m -scottyBlockTimeRaw ::- (MonadUnliftIO m, MonadLoggerIO m)- => GetBlockTimeRaw- -> WebT m (RawResult H.Block)+scottyBlockMTP :: (MonadUnliftIO m, MonadLoggerIO m)+ => GetBlockMTP -> WebT m BlockData+scottyBlockMTP (GetBlockMTP (TimeParam t) (NoTx noTx)) = do+ ch <- lift $ asks (storeChain . webStore)+ m <- blockAtOrAfterMTP ch t+ maybe (S.raise ThingNotFound) (return . pruneTx noTx) m++scottyBlockTimeRaw :: (MonadUnliftIO m, MonadLoggerIO m)+ => GetBlockTimeRaw -> WebT m (RawResult H.Block) scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam t)) = do- b <- maybe (S.raise ThingNotFound) return =<< blockAtOrBefore t+ ch <- lift $ asks (storeChain . webStore)+ m <- blockAtOrBefore ch t+ b <- maybe (S.raise ThingNotFound) return m refuseLargeBlock b RawResult <$> toRawBlock b +scottyBlockMTPRaw :: (MonadUnliftIO m, MonadLoggerIO m)+ => GetBlockMTPRaw -> WebT m (RawResult H.Block)+scottyBlockMTPRaw (GetBlockMTPRaw (TimeParam t)) = do+ ch <- lift $ asks (storeChain . webStore)+ m <- blockAtOrAfterMTP ch t+ b <- maybe (S.raise ThingNotFound) return m+ refuseLargeBlock b+ RawResult <$> toRawBlock b+ -- GET Transactions -- scottyTx :: (MonadUnliftIO m, MonadLoggerIO m) => GetTx -> WebT m Transaction@@ -1037,7 +1065,8 @@ _ <- MaybeT $ getTxData (TxHash h) return $ AtTx (TxHash h) start_time q = do- b <- MaybeT $ blockAtOrBefore q+ ch <- lift $ asks (storeChain . webStore)+ b <- MaybeT $ blockAtOrBefore ch q let g = blockDataHeight b return $ AtBlock g