haskoin-store 0.8.0 → 0.8.1

raw patch · 5 files changed

+84/−12 lines, 5 files

Files

• CHANGELOG.md +6/−7
• app/Main.hs +9/−0
• haskoin-store.cabal +2/−2
• src/Haskoin/Store.hs +39/−2
• src/Network/Haskoin/Store/Data.hs +28/−1

@@ -4,23 +4,22 @@ 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.8.1+### Added+- Health check endpoint.+ ## 0.8.0 ### Added - Limits and skips. - Add timestamps to transactions. - Add transaction count to address balance object. - Add Merkle root to block data.--### Changed-- Data model update.-- Performance improvement for xpub calls.--## 0.7.0-### Added - Total funds received by an address now shows up in balance. - Balances for any address that ever had funds show up in xpub endpoints.  ### Changed+- Data model update.+- Performance improvement for xpub calls. - Transactions are returned in reverse mempool/block order (highest or most recent first). - Balance objects do not get deleted from database ever. 

@@ -496,6 +496,15 @@                             io (lazyByteString bs)                         _ -> return ()         S.get "/peers" $ getPeersInformation (storeManager st) >>= S.json+        S.get "/health" $ do+            h <-+                liftIO $+                healthCheck+                    net+                    (db, defaultReadOptions)+                    (storeManager st)+                    (storeChain st)+            S.json h         notFound $ raise ThingNotFound   where     parse_limits = do

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2e20622f0a83252b23eb421a058c6f5a84eaff8d86b58117a6c46e5217cdf73b+-- hash: e59ebfda76a739c5ac1d9b30130b098813357c7b5dbf52bf4961d2045739bfb5  name:           haskoin-store-version:        0.8.0+version:        0.8.1 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

@@ -1,9 +1,9 @@ {-# LANGUAGE ConstraintKinds       #-} {-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE GADTs                 #-} {-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiWayIf            #-} module Haskoin.Store     ( Store(..)     , BlockStore@@ -23,6 +23,7 @@     , Balance(..)     , PeerInformation(..)     , PreciseUnixTime(..)+    , HealthCheck(..)     , withStore     , store     , getBestBlock@@ -65,6 +66,7 @@     , xPubUnspentToJSON     , xPubUnspentToEncoding     , cbAfterHeight+    , healthCheck     , mergeSourcesBy     ) where @@ -76,6 +78,7 @@ import           Data.Function import           Data.List import           Data.Maybe+import           Data.Time.Clock.System import           Haskoin import           Haskoin.Node import           Network.Haskoin.Store.Block@@ -178,6 +181,40 @@  storeDispatch _ _ (PeerEvent _) = return () +healthCheck ::+       (MonadUnliftIO m, StoreRead r m)+    => Network+    -> r+    -> Manager+    -> Chain+    -> m HealthCheck+healthCheck net i mgr ch = do+    n <- timeout (5 * 1000 * 1000) $ chainGetBest ch+    b <-+        runMaybeT $ do+            h <- MaybeT $ getBestBlock i+            MaybeT $ getBlock i h+    p <- timeout (5 * 1000 * 1000) $ managerGetPeers mgr+    let k = isNothing n || isNothing b || maybe False (not . null) p+    t <- fromIntegral . systemSeconds <$> liftIO getSystemTime+    let s =+            isJust $ do+                x <- n+                y <- b+                guard $ nodeHeader x == blockDataHeader y+                guard $ blockTimestamp (blockDataHeader y) >= t - 7200+    return+        HealthCheck+            { healthBlockBest = headerHash . blockDataHeader <$> b+            , healthBlockHeight = blockDataHeight <$> b+            , healthHeaderBest = headerHash . nodeHeader <$> n+            , healthHeaderHeight = nodeHeight <$> n+            , healthPeers = length <$> p+            , healthNetwork = getNetworkName net+            , healthOK = k+            , healthSynced = s+            }+ -- | Publish a new transaction to the network. publishTx :: (MonadUnliftIO m, MonadLoggerIO m) => Manager -> Tx -> m Bool publishTx mgr tx =@@ -216,7 +253,7 @@         xs <- catMaybes <$> mapM (uncurry b) (as m n)         case xs of             [] -> return []-            _ -> (xs <>) <$> go m (n + 100)+            _  -> (xs <>) <$> go m (n + 100)     b a p =         g a >>= \case             Nothing -> return Nothing

@@ -281,7 +281,7 @@     , "nonce" .= bhNonce (blockDataHeader bv)     , "size" .= blockDataSize bv     , "tx" .= blockDataTxs bv-    , "merkle" .= TxHash (buildMerkleRoot (blockDataTxs bv))+    , "merkle" .= TxHash (merkleRoot (blockDataHeader bv))     ]  instance ToJSON BlockData where@@ -638,3 +638,30 @@  xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding xPubUnspentToEncoding net = pairs . mconcat . xPubUnspentPairs net++data HealthCheck = HealthCheck+    { healthHeaderBest   :: !(Maybe BlockHash)+    , healthHeaderHeight :: !(Maybe BlockHeight)+    , healthBlockBest    :: !(Maybe BlockHash)+    , healthBlockHeight  :: !(Maybe BlockHeight)+    , healthPeers        :: !(Maybe Int)+    , healthNetwork      :: !String+    , healthOK           :: !Bool+    , healthSynced       :: !Bool+    } deriving (Show, Eq, Generic, Serialize)++healthCheckPairs :: A.KeyValue kv => HealthCheck -> [kv]+healthCheckPairs h =+    [ "headers" .=+      object ["hash" .= healthHeaderBest h, "height" .= healthHeaderHeight h]+    , "blocks" .=+      object ["hash" .= healthBlockBest h, "height" .= healthBlockHeight h]+    , "peers" .= healthPeers h+    , "net" .= healthNetwork h+    , "ok" .= healthOK h+    , "synced" .= healthSynced h+    ]++instance ToJSON HealthCheck where+    toJSON = object . healthCheckPairs+    toEncoding = pairs . mconcat . healthCheckPairs