haskoin-store-data 0.33.1 → 0.34.0
raw patch · 3 files changed
+205/−83 lines, 3 filesdep ~haskoin-store-data
Dependency ranges changed: haskoin-store-data
Files
- haskoin-store-data.cabal +3/−3
- src/Haskoin/Store/Data.hs +184/−76
- test/Haskoin/Store/DataSpec.hs +18/−4
haskoin-store-data.cabal view
@@ -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 <https://github.com/haskoin/haskoin-store#readme> 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
src/Haskoin/Store/Data.hs view
@@ -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
test/Haskoin/Store/DataSpec.hs view
@@ -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