diff --git a/haskoin-store-data.cabal b/haskoin-store-data.cabal --- a/haskoin-store-data.cabal +++ b/haskoin-store-data.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 7d46f184d37bb73517e4beb44ed8edcc143d20a1f158061254dc4ac39d02bd3e +-- hash: 673e35a73b453ce8509ef026e9e11a225eca239ddd5cfc6301f96b21b702b6dc name: haskoin-store-data -version: 0.33.1 +version: 0.34.0 synopsis: Data for Haskoin Store description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -74,7 +74,7 @@ , deepseq >=1.4.4.0 , hashable >=1.3.0.0 , haskoin-core >=0.13.6 - , haskoin-store-data ==0.33.1 + , haskoin-store-data ==0.34.0 , hspec >=2.7.1 , http-client >=0.6.4.1 , http-types >=0.12.3 diff --git a/src/Haskoin/Store/Data.hs b/src/Haskoin/Store/Data.hs --- a/src/Haskoin/Store/Data.hs +++ b/src/Haskoin/Store/Data.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Haskoin.Store.Data ( -- * Address Balances Balance(..) @@ -71,6 +72,10 @@ , RawResult(..) , RawResultList(..) , PeerInformation(..) + , Healthy(..) + , BlockHealth(..) + , TimeHealth(..) + , CountHealth(..) , HealthCheck(..) , Event(..) , Except(..) @@ -1103,92 +1108,195 @@ , xPubChangeIndex = change } +class Healthy a where + isOK :: a -> Bool + +data BlockHealth = + BlockHealth + { blockHealthHeaders :: !BlockHeight + , blockHealthBlocks :: !BlockHeight + , blockHealthMaxDiff :: !BlockHeight + } + deriving (Show, Eq, Generic, NFData) + +instance Serialize BlockHealth where + put h@BlockHealth {..} = do + put (isOK h) + put blockHealthHeaders + put blockHealthBlocks + put blockHealthMaxDiff + get = do + k <- get + blockHealthHeaders <- get + blockHealthBlocks <- get + blockHealthMaxDiff <- get + let h = BlockHealth {..} + guard (k == isOK h) + return h + +instance Healthy BlockHealth where + isOK BlockHealth {..} = + blockHealthHeaders - blockHealthBlocks <= blockHealthMaxDiff + +instance ToJSON BlockHealth where + toJSON h@BlockHealth {..} = + object + [ "headers" .= blockHealthHeaders + , "blocks" .= blockHealthBlocks + , "diff" .= diff + , "max" .= blockHealthMaxDiff + , "ok" .= isOK h + ] + where + diff = blockHealthHeaders - blockHealthBlocks + +instance FromJSON BlockHealth where + parseJSON = + A.withObject "BlockHealth" $ \o -> do + blockHealthHeaders <- o .: "headers" + blockHealthBlocks <- o .: "blocks" + blockHealthMaxDiff <- o .: "max" + return BlockHealth {..} + +data TimeHealth = + TimeHealth + { timeHealthAge :: !Int + , timeHealthMax :: !Int + } + deriving (Show, Eq, Generic, NFData) + +instance Serialize TimeHealth where + put h@TimeHealth {..} = do + put (isOK h) + put timeHealthAge + put timeHealthMax + get = do + k <- get + timeHealthAge <- get + timeHealthMax <- get + let t = TimeHealth {..} + guard (k == isOK t) + return t + +instance Healthy TimeHealth where + isOK TimeHealth {..} = + timeHealthAge <= timeHealthMax + +instance ToJSON TimeHealth where + toJSON h@TimeHealth {..} = + object + [ "age" .= timeHealthAge + , "max" .= timeHealthMax + , "ok" .= isOK h + ] + +instance FromJSON TimeHealth where + parseJSON = + A.withObject "TimeHealth" $ \o -> do + timeHealthAge <- o .: "age" + timeHealthMax <- o .: "max" + return TimeHealth {..} + +data CountHealth = + CountHealth + { countHealthNum :: !Int + , countHealthMin :: !Int + } + deriving (Show, Eq, Generic, NFData) + +instance Serialize CountHealth where + put h@CountHealth {..} = do + put (isOK h) + put countHealthNum + put countHealthMin + get = do + k <- get + countHealthNum <- get + countHealthMin <- get + let c = CountHealth {..} + guard (k == isOK c) + return c + +instance Healthy CountHealth where + isOK CountHealth {..} = + countHealthMin <= countHealthNum + +instance ToJSON CountHealth where + toJSON h@CountHealth {..} = + object + [ "count" .= countHealthNum + , "min" .= countHealthMin + , "ok" .= isOK h + ] + +instance FromJSON CountHealth where + parseJSON = + A.withObject "CountHealth" $ \o -> do + countHealthNum <- o .: "count" + countHealthMin <- o .: "min" + return CountHealth {..} + data HealthCheck = HealthCheck - { healthHeaderBest :: !(Maybe BlockHash) - , healthHeaderHeight :: !(Maybe BlockHeight) - , healthBlockBest :: !(Maybe BlockHash) - , healthBlockHeight :: !(Maybe BlockHeight) - , healthPeers :: !(Maybe Int) - , healthNetwork :: !String - , healthOK :: !Bool - , healthSynced :: !Bool - , healthLastBlock :: !(Maybe Word64) - , healthLastTx :: !(Maybe Word64) - , healthVersion :: !String + { healthBlocks :: !BlockHealth + , healthLastBlock :: !TimeHealth + , healthLastTx :: !TimeHealth + , healthPeers :: !CountHealth + , healthNetwork :: !String + , healthVersion :: !String } - deriving (Show, Eq, Generic, Serialize, NFData) + deriving (Show, Eq, Generic, NFData) +instance Serialize HealthCheck where + put h@HealthCheck {..} = do + put (isOK h) + put healthBlocks + put healthLastBlock + put healthLastTx + put healthPeers + put healthNetwork + put healthVersion + get = do + k <- get + healthBlocks <- get + healthLastBlock <- get + healthLastTx <- get + healthPeers <- get + healthNetwork <- get + healthVersion <- get + let h = HealthCheck {..} + guard (k == isOK h) + return h + +instance Healthy HealthCheck where + isOK HealthCheck {..} = + isOK healthBlocks && + isOK healthLastBlock && + isOK healthLastTx && + isOK healthPeers + instance ToJSON HealthCheck where - toJSON h = + toJSON h@HealthCheck {..} = object - [ "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 - , "version" .= healthVersion h - , "lastblock" .= healthLastBlock h - , "lasttx" .= healthLastTx h + [ "blocks" .= healthBlocks + , "last-block" .= healthLastBlock + , "last-tx" .= healthLastTx + , "peers" .= healthPeers + , "net" .= healthNetwork + , "version" .= healthVersion + , "ok" .= isOK h ] - toEncoding h = - pairs - ( "headers" `pair` - pairs - ( "hash" .= healthHeaderBest h - <> "height" .= healthHeaderHeight h - ) - <> "blocks" `pair` - pairs - ( "hash" .= healthBlockBest h - <> "height" .= healthBlockHeight h - ) - <> "peers" .= healthPeers h - <> "net" .= healthNetwork h - <> "ok" .= healthOK h - <> "synced" .= healthSynced h - <> "version" .= healthVersion h - <> "lastblock" .= healthLastBlock h - <> "lasttx" .= healthLastTx h - ) instance FromJSON HealthCheck where parseJSON = - A.withObject "healthcheck" $ \o -> do - headers <- o .: "headers" - headers_hash <- headers .: "hash" - headers_height <- headers .: "height" - blocks <- o .: "blocks" - blocks_hash <- blocks .: "hash" - blocks_height <- blocks .: "height" - peers <- o .: "peers" - net <- o .: "net" - ok <- o .: "ok" - synced <- o .: "synced" - lastblock <- o .: "lastblock" - lasttx <- o .: "lasttx" - ver <- o .: "version" - return - HealthCheck - { healthHeaderBest = headers_hash - , healthHeaderHeight = headers_height - , healthBlockBest = blocks_hash - , healthBlockHeight = blocks_height - , healthPeers = peers - , healthNetwork = net - , healthOK = ok - , healthSynced = synced - , healthLastBlock = lastblock - , healthLastTx = lasttx - , healthVersion = ver - } + A.withObject "HealthCheck" $ \o -> do + healthBlocks <- o .: "blocks" + healthLastBlock <- o .: "last-block" + healthLastTx <- o .: "last-tx" + healthPeers <- o .: "peers" + healthNetwork <- o .: "net" + healthVersion <- o .: "version" + return HealthCheck {..} data Event = EventBlock !BlockHash diff --git a/test/Haskoin/Store/DataSpec.hs b/test/Haskoin/Store/DataSpec.hs --- a/test/Haskoin/Store/DataSpec.hs +++ b/test/Haskoin/Store/DataSpec.hs @@ -199,15 +199,29 @@ <*> arbitrary <*> arbitrary -instance Arbitrary HealthCheck where +instance Arbitrary BlockHealth where arbitrary = - HealthCheck - <$> arbitraryMaybe arbitraryBlockHash + BlockHealth + <$> arbitrary <*> arbitrary - <*> arbitraryMaybe arbitraryBlockHash <*> arbitrary + +instance Arbitrary TimeHealth where + arbitrary = + TimeHealth + <$> arbitrary <*> arbitrary + +instance Arbitrary CountHealth where + arbitrary = + CountHealth + <$> arbitrary <*> arbitrary + +instance Arbitrary HealthCheck where + arbitrary = + HealthCheck + <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary