haskoin-store-data (empty) → 0.25.0
raw patch · 6 files changed
+1635/−0 lines, 6 filesdep +QuickCheckdep +aesondep +basesetup-changed
Dependencies added: QuickCheck, aeson, base, bytestring, cereal, containers, deepseq, hashable, haskoin-core, hspec, network, scotty, string-conversions, text
Files
- Setup.hs +2/−0
- UNLICENSE +24/−0
- haskoin-store-data.cabal +74/−0
- src/Haskoin/Store/Data.hs +1189/−0
- test/Haskoin/Store/DataSpec.hs +345/−0
- test/Spec.hs +1/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ haskoin-store-data.cabal view
@@ -0,0 +1,74 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 29a625aa392b51b11b2748f657106ea091e81d146b899f31aaf6d45de6ac97d1++name: haskoin-store-data+version: 0.25.0+synopsis: Data for Haskoin Store+category: Bitcoin, Finance, Network+homepage: http://github.com/haskoin/haskoin-store#readme+bug-reports: http://github.com/haskoin/haskoin-store/issues+author: Jean-Pierre Rupp+maintainer: jprupp@protonmail.ch+license: PublicDomain+license-file: UNLICENSE+build-type: Simple++source-repository head+ type: git+ location: https://github.com/haskoin/haskoin-store.git++library+ exposed-modules:+ Haskoin.Store.Data+ other-modules:+ Paths_haskoin_store_data+ hs-source-dirs:+ src+ build-depends:+ aeson >=1.4.7.1+ , base >=4.9 && <5+ , bytestring >=0.10.10.0+ , cereal >=0.5.8.1+ , containers >=0.6.2.1+ , deepseq >=1.4.4.0+ , hashable >=1.3.0.0+ , haskoin-core >=0.13.3+ , network >=3.1.1.1+ , scotty >=0.11.5+ , string-conversions >=0.4.0.1+ , text >=1.2.4.0+ default-language: Haskell2010++test-suite haskoin-store-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Haskoin.Store.DataSpec+ Haskoin.Store.Data+ Paths_haskoin_store_data+ hs-source-dirs:+ test+ src+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.13.2+ , aeson >=1.4.7.1+ , base >=4.9 && <5+ , bytestring >=0.10.10.0+ , cereal >=0.5.8.1+ , containers >=0.6.2.1+ , deepseq >=1.4.4.0+ , hashable >=1.3.0.0+ , haskoin-core >=0.13.3+ , hspec >=2.7.1+ , network >=3.1.1.1+ , scotty >=0.11.5+ , string-conversions >=0.4.0.1+ , text >=1.2.4.0+ default-language: Haskell2010+ build-tool-depends: hspec-discover:hspec-discover
+ src/Haskoin/Store/Data.hs view
@@ -0,0 +1,1189 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Store.Data+ ( -- * Address Balances+ Balance(..)+ , balanceToJSON+ , balanceToEncoding+ , balanceParseJSON+ , zeroBalance+ , nullBalance++ -- * Block Data+ , BlockData(..)+ , confirmed++ -- * Transactions+ , BlockTx(..)+ , TxData(..)+ , Transaction(..)+ , transactionToJSON+ , transactionToEncoding+ , transactionData+ , fromTransaction+ , toTransaction+ , StoreInput(..)+ , storeInputToJSON+ , storeInputToEncoding+ , isCoinbase+ , StoreOutput(..)+ , storeOutputToJSON+ , storeOutputToEncoding+ , Prev(..)+ , Spender(..)+ , BlockRef(..)+ , UnixTime+ , getUnixTime+ , putUnixTime+ , BlockPos++ -- * Unspent Outputs+ , Unspent(..)+ , unspentToJSON+ , unspentToEncoding++ -- * Extended Public Keys+ , XPubSpec(..)+ , XPubBal(..)+ , xPubBalToJSON+ , xPubBalToEncoding+ , xPubBalParseJSON+ , XPubUnspent(..)+ , xPubUnspentToJSON+ , xPubUnspentToEncoding+ , XPubSummary(..)+ , DeriveType(..)++ -- * Other Data+ , TxId(..)+ , GenericResult(..)+ , PeerInformation(..)+ , HealthCheck(..)+ , Event(..)+ , Except(..)+ ) where++import Control.Applicative ((<|>))+import Control.DeepSeq (NFData)+import Control.Exception (Exception)+import Control.Monad (guard, join)+import Data.Aeson (Encoding, FromJSON (..), ToJSON (..),+ Value (..), object, pairs, (.!=),+ (.:), (.:?), (.=))+import qualified Data.Aeson as A+import Data.Aeson.Encoding (list, null_, pair, text)+import Data.Aeson.Types (Parser)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as BSS+import Data.Hashable (Hashable (..))+import qualified Data.IntMap as I+import Data.IntMap.Strict (IntMap)+import Data.Maybe (catMaybes, isJust, mapMaybe)+import Data.Serialize (Get, Put, Serialize (..), getWord32be,+ getWord64be, getWord8, putWord32be,+ putWord64be, putWord8)+import qualified Data.Serialize as S+import Data.String.Conversions (cs)+import Data.Text (Text)+import qualified Data.Text.Lazy as TL+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Haskoin (Address, BlockHash, BlockHeader (..),+ BlockHeight, BlockWork, KeyIndex,+ Network (..), OutPoint (..),+ PubKeyI (..), Tx (..), TxHash (..),+ TxIn (..), TxOut (..), WitnessStack,+ XPubKey (..), addrFromJSON,+ addrToEncoding, addrToJSON,+ blockHashToHex, decodeHex, encodeHex,+ headerHash, scriptToAddressBS, txHash,+ txHashToHex, wrapPubKey)+import Web.Scotty.Trans (ScottyError (..))++data DeriveType+ = DeriveNormal+ | DeriveP2SH+ | DeriveP2WPKH+ deriving (Show, Eq, Generic, NFData, Serialize)++data XPubSpec =+ XPubSpec+ { xPubSpecKey :: !XPubKey+ , xPubDeriveType :: !DeriveType+ } deriving (Show, Eq, Generic, NFData)++instance Hashable XPubSpec where+ hashWithSalt i XPubSpec {xPubSpecKey = XPubKey {xPubKey = pubkey}} =+ hashWithSalt i pubkey++instance Serialize XPubSpec where+ put XPubSpec {xPubSpecKey = k, xPubDeriveType = t} = do+ put (xPubDepth k)+ put (xPubParent k)+ put (xPubIndex k)+ put (xPubChain k)+ put (wrapPubKey True (xPubKey k))+ put t+ get = do+ d <- get+ p <- get+ i <- get+ c <- get+ k <- get+ t <- get+ let x =+ XPubKey+ { xPubDepth = d+ , xPubParent = p+ , xPubIndex = i+ , xPubChain = c+ , xPubKey = pubKeyPoint k+ }+ return XPubSpec {xPubSpecKey = x, xPubDeriveType = t}++type UnixTime = Word64+type BlockPos = Word32++-- | Serialize such that ordering is inverted.+putUnixTime :: Word64 -> Put+putUnixTime w = putWord64be $ maxBound - w++getUnixTime :: Get Word64+getUnixTime = (maxBound -) <$> getWord64be++-- | Reference to a block where a transaction is stored.+data BlockRef+ = BlockRef+ { blockRefHeight :: !BlockHeight+ -- ^ block height in the chain+ , blockRefPos :: !Word32+ -- ^ position of transaction within the block+ }+ | MemRef+ { memRefTime :: !UnixTime+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++-- | Serialized entities will sort in reverse order.+instance Serialize BlockRef where+ put MemRef {memRefTime = t} = do+ putWord8 0x00+ putUnixTime t+ put BlockRef {blockRefHeight = h, blockRefPos = p} = do+ putWord8 0x01+ putWord32be (maxBound - h)+ putWord32be (maxBound - p)+ get = getmemref <|> getblockref+ where+ getmemref = do+ guard . (== 0x00) =<< getWord8+ MemRef <$> getUnixTime+ getblockref = do+ guard . (== 0x01) =<< getWord8+ h <- (maxBound -) <$> getWord32be+ p <- (maxBound -) <$> getWord32be+ return BlockRef {blockRefHeight = h, blockRefPos = p}++confirmed :: BlockRef -> Bool+confirmed BlockRef {} = True+confirmed MemRef {} = False++instance ToJSON BlockRef where+ toJSON BlockRef {blockRefHeight = h, blockRefPos = p} =+ object ["height" .= h, "position" .= p]+ toJSON MemRef {memRefTime = t} = object ["mempool" .= t]+ toEncoding BlockRef {blockRefHeight = h, blockRefPos = p} =+ pairs ("height" .= h <> "position" .= p)+ toEncoding MemRef {memRefTime = t} = pairs ("mempool" .= t)++instance FromJSON BlockRef where+ parseJSON = A.withObject "blockref" $ \o -> b o <|> m o+ where+ b o = do+ height <- o .: "height"+ position <- o .: "position"+ return BlockRef {blockRefHeight = height, blockRefPos = position}+ m o = do+ mempool <- o .: "mempool"+ return MemRef {memRefTime = mempool}++-- | Transaction in relation to an address.+data BlockTx = BlockTx+ { blockTxBlock :: !BlockRef+ -- ^ block information+ , blockTxHash :: !TxHash+ -- ^ transaction hash+ } deriving (Show, Eq, Ord, Generic, Serialize, Hashable, NFData)++instance ToJSON BlockTx where+ toJSON btx = object ["txid" .= blockTxHash btx, "block" .= blockTxBlock btx]+ toEncoding btx =+ pairs+ ( "txid" .= blockTxHash btx+ <> "block" .= blockTxBlock btx+ )++instance FromJSON BlockTx where+ parseJSON =+ A.withObject "blocktx" $ \o -> do+ txid <- o .: "txid"+ block <- o .: "block"+ return BlockTx {blockTxBlock = block, blockTxHash = txid}++-- | Address balance information.+data Balance =+ Balance+ { balanceAddress :: !Address+ -- ^ address balance+ , balanceAmount :: !Word64+ -- ^ confirmed balance+ , balanceZero :: !Word64+ -- ^ unconfirmed balance+ , balanceUnspentCount :: !Word64+ -- ^ number of unspent outputs+ , balanceTxCount :: !Word64+ -- ^ number of transactions+ , balanceTotalReceived :: !Word64+ -- ^ total amount from all outputs in this address+ }+ deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)++zeroBalance :: Address -> Balance+zeroBalance a =+ Balance+ { balanceAddress = a+ , balanceAmount = 0+ , balanceUnspentCount = 0+ , balanceZero = 0+ , balanceTxCount = 0+ , balanceTotalReceived = 0+ }++nullBalance :: Balance -> Bool+nullBalance Balance { balanceAmount = 0+ , balanceUnspentCount = 0+ , balanceZero = 0+ , balanceTxCount = 0+ , balanceTotalReceived = 0+ } = True+nullBalance _ = False++balanceToJSON :: Network -> Balance -> Value+balanceToJSON net b =+ object $+ [ "address" .= addrToJSON net (balanceAddress b)+ , "confirmed" .= balanceAmount b+ , "unconfirmed" .= balanceZero b+ , "utxo" .= balanceUnspentCount b+ , "txs" .= balanceTxCount b+ , "received" .= balanceTotalReceived b+ ]++balanceToEncoding :: Network -> Balance -> Encoding+balanceToEncoding net b =+ pairs+ ( "address" `pair` addrToEncoding net (balanceAddress b)+ <> "confirmed" .= balanceAmount b+ <> "unconfirmed" .= balanceZero b+ <> "utxo" .= balanceUnspentCount b+ <> "txs" .= balanceTxCount b+ <> "received" .= balanceTotalReceived b+ )++balanceParseJSON :: Network -> Value -> Parser Balance+balanceParseJSON net =+ A.withObject "balance" $ \o -> do+ amount <- o .: "confirmed"+ unconfirmed <- o .: "unconfirmed"+ utxo <- o .: "utxo"+ txs <- o .: "txs"+ received <- o .: "received"+ address <- addrFromJSON net =<< o .: "address"+ return+ Balance+ { balanceAddress = address+ , balanceAmount = amount+ , balanceUnspentCount = utxo+ , balanceZero = unconfirmed+ , balanceTxCount = txs+ , balanceTotalReceived = received+ }++-- | Unspent output.+data Unspent = Unspent+ { unspentBlock :: !BlockRef+ , unspentPoint :: !OutPoint+ , unspentAmount :: !Word64+ , unspentScript :: !ShortByteString+ } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)++unspentToJSON :: Network -> Unspent -> Value+unspentToJSON net u =+ object+ [ "address" .= scriptToAddrJSON net bsscript+ , "block" .= unspentBlock u+ , "txid" .= outPointHash (unspentPoint u)+ , "index" .= outPointIndex (unspentPoint u)+ , "pkscript" .= script+ , "value" .= unspentAmount u+ ]+ where+ bsscript = BSS.fromShort (unspentScript u)+ script = encodeHex bsscript++unspentToEncoding :: Network -> Unspent -> Encoding+unspentToEncoding net u =+ pairs+ ( "address" `pair` scriptToAddrEncoding net bsscript+ <> "block" .= unspentBlock u+ <> "txid" .= outPointHash (unspentPoint u)+ <> "index" .= outPointIndex (unspentPoint u)+ <> "pkscript" `pair` text script+ <> "value" .= unspentAmount u+ )+ where+ bsscript = BSS.fromShort (unspentScript u)+ script = encodeHex bsscript++instance FromJSON Unspent where+ parseJSON =+ A.withObject "unspent" $ \o -> do+ block <- o .: "block"+ txid <- o .: "txid"+ index <- o .: "index"+ value <- o .: "value"+ script <- BSS.toShort <$> (o .: "pkscript" >>= jsonHex)+ return+ Unspent+ { unspentBlock = block+ , unspentPoint = OutPoint txid index+ , unspentAmount = value+ , unspentScript = script+ }++-- | Database value for a block entry.+data BlockData = BlockData+ { blockDataHeight :: !BlockHeight+ -- ^ height of the block in the chain+ , blockDataMainChain :: !Bool+ -- ^ is this block in the main chain?+ , blockDataWork :: !BlockWork+ -- ^ accumulated work in that block+ , blockDataHeader :: !BlockHeader+ -- ^ block header+ , blockDataSize :: !Word32+ -- ^ size of the block including witnesses+ , blockDataWeight :: !Word32+ -- ^ weight of this block (for segwit networks)+ , blockDataTxs :: ![TxHash]+ -- ^ block transactions+ , blockDataOutputs :: !Word64+ -- ^ sum of all transaction outputs+ , blockDataFees :: !Word64+ -- ^ sum of all transaction fees+ , blockDataSubsidy :: !Word64+ -- ^ block subsidy+ } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)++instance ToJSON BlockData where+ toJSON bv =+ object+ [ "hash" .= headerHash (blockDataHeader bv)+ , "height" .= blockDataHeight bv+ , "mainchain" .= blockDataMainChain bv+ , "previous" .= prevBlock (blockDataHeader bv)+ , "time" .= blockTimestamp (blockDataHeader bv)+ , "version" .= blockVersion (blockDataHeader bv)+ , "bits" .= blockBits (blockDataHeader bv)+ , "nonce" .= bhNonce (blockDataHeader bv)+ , "size" .= blockDataSize bv+ , "tx" .= blockDataTxs bv+ , "merkle" .= TxHash (merkleRoot (blockDataHeader bv))+ , "subsidy" .= blockDataSubsidy bv+ , "fees" .= blockDataFees bv+ , "outputs" .= blockDataOutputs bv+ , "work" .= show (blockDataWork bv)+ , "weight" .= blockDataWeight bv+ ]+ toEncoding bv =+ pairs+ ( "hash" `pair` text (blockHashToHex (headerHash (blockDataHeader bv)))+ <> "height" .= blockDataHeight bv+ <> "mainchain" .= blockDataMainChain bv+ <> "previous" .= prevBlock (blockDataHeader bv)+ <> "time" .= blockTimestamp (blockDataHeader bv)+ <> "version" .= blockVersion (blockDataHeader bv)+ <> "bits" .= blockBits (blockDataHeader bv)+ <> "nonce" .= bhNonce (blockDataHeader bv)+ <> "size" .= blockDataSize bv+ <> "tx" .= blockDataTxs bv+ <> "merkle" `pair` text (txHashToHex (TxHash (merkleRoot (blockDataHeader bv))))+ <> "subsidy" .= blockDataSubsidy bv+ <> "fees" .= blockDataFees bv+ <> "outputs" .= blockDataOutputs bv+ <> "work" .= blockDataWork bv+ <> "weight" .= blockDataWeight bv)++instance FromJSON BlockData where+ parseJSON =+ A.withObject "blockdata" $ \o -> do+ height <- o .: "height"+ mainchain <- o .: "mainchain"+ previous <- o .: "previous"+ time <- o .: "time"+ version <- o .: "version"+ bits <- o .: "bits"+ nonce <- o .: "nonce"+ size <- o .: "size"+ tx <- o .: "tx"+ TxHash merkle <- o .: "merkle"+ subsidy <- o .: "subsidy"+ fees <- o .: "fees"+ outputs <- o .: "outputs"+ work <- o .: "work"+ weight <- o .: "weight"+ return+ BlockData+ { blockDataHeader =+ BlockHeader+ { prevBlock = previous+ , blockTimestamp = time+ , blockVersion = version+ , blockBits = bits+ , bhNonce = nonce+ , merkleRoot = merkle+ }+ , blockDataMainChain = mainchain+ , blockDataWork = work+ , blockDataSize = size+ , blockDataWeight = weight+ , blockDataTxs = tx+ , blockDataOutputs = outputs+ , blockDataFees = fees+ , blockDataHeight = height+ , blockDataSubsidy = subsidy+ }++data StoreInput+ = StoreCoinbase { inputPoint :: !OutPoint+ , inputSequence :: !Word32+ , inputSigScript :: !ByteString+ , inputWitness :: !(Maybe WitnessStack)+ }+ | StoreInput { inputPoint :: !OutPoint+ , inputSequence :: !Word32+ , inputSigScript :: !ByteString+ , inputPkScript :: !ByteString+ , inputAmount :: !Word64+ , inputWitness :: !(Maybe WitnessStack)+ }+ deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)++isCoinbase :: StoreInput -> Bool+isCoinbase StoreCoinbase {} = True+isCoinbase StoreInput {} = False++storeInputToJSON :: Network -> StoreInput -> Value+storeInputToJSON net StoreInput { inputPoint = OutPoint oph opi+ , inputSequence = sq+ , inputSigScript = ss+ , inputPkScript = ps+ , inputAmount = val+ , inputWitness = wit+ } =+ object+ [ "coinbase" .= False+ , "txid" .= oph+ , "output" .= opi+ , "sigscript" .= String (encodeHex ss)+ , "sequence" .= sq+ , "pkscript" .= String (encodeHex ps)+ , "value" .= val+ , "address" .= scriptToAddrJSON net ps+ , "witness" .= fmap (map encodeHex) wit+ ]+storeInputToJSON _ StoreCoinbase { inputPoint = OutPoint oph opi+ , inputSequence = sq+ , inputSigScript = ss+ , inputWitness = wit+ } =+ object+ [ "coinbase" .= True+ , "txid" .= oph+ , "output" .= opi+ , "sigscript" .= String (encodeHex ss)+ , "sequence" .= sq+ , "pkscript" .= Null+ , "value" .= Null+ , "address" .= Null+ , "witness" .= fmap (map encodeHex) wit+ ]++storeInputToEncoding :: Network -> StoreInput -> Encoding+storeInputToEncoding net StoreInput { inputPoint = OutPoint oph opi+ , inputSequence = sq+ , inputSigScript = ss+ , inputPkScript = ps+ , inputAmount = val+ , inputWitness = wit+ } =+ pairs+ ( "coinbase" .= False+ <> "txid" .= oph+ <> "output" .= opi+ <> "sigscript" `pair` text (encodeHex ss)+ <> "sequence" .= sq+ <> "pkscript" `pair` text (encodeHex ps)+ <> "value" .= val+ <> "address" `pair` scriptToAddrEncoding net ps+ <> "witness" .= fmap (map encodeHex) wit+ )++storeInputToEncoding _ StoreCoinbase { inputPoint = OutPoint oph opi+ , inputSequence = sq+ , inputSigScript = ss+ , inputWitness = wit+ } =+ pairs+ ( "coinbase" .= True+ <> "txid" `pair` text (txHashToHex oph)+ <> "output" .= opi+ <> "sigscript" `pair` text (encodeHex ss)+ <> "sequence" .= sq+ <> "pkscript" `pair` null_+ <> "value" `pair` null_+ <> "address" `pair` null_+ <> "witness" .= fmap (map encodeHex) wit+ )++instance FromJSON StoreInput where+ parseJSON =+ A.withObject "storeinput" $ \o -> do+ coinbase <- o .: "coinbase"+ outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"+ sequ <- o .: "sequence"+ witness <-+ o .:? "witness" >>= \mmxs ->+ case join mmxs of+ Nothing -> return Nothing+ Just xs -> Just <$> mapM jsonHex xs+ sigscript <- o .: "sigscript" >>= jsonHex+ if coinbase+ then return+ StoreCoinbase+ { inputPoint = outpoint+ , inputSequence = sequ+ , inputSigScript = sigscript+ , inputWitness = witness+ }+ else do+ pkscript <- o .: "pkscript" >>= jsonHex+ value <- o .: "value"+ return+ StoreInput+ { inputPoint = outpoint+ , inputSequence = sequ+ , inputSigScript = sigscript+ , inputPkScript = pkscript+ , inputAmount = value+ , inputWitness = witness+ }++jsonHex :: Text -> Parser ByteString+jsonHex s =+ case decodeHex s of+ Nothing -> fail "Could not decode hex"+ Just b -> return b++-- | Information about input spending output.+data Spender = Spender+ { spenderHash :: !TxHash+ -- ^ input transaction hash+ , spenderIndex :: !Word32+ -- ^ input position in transaction+ } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)++instance ToJSON Spender where+ toJSON n = object ["txid" .= txHashToHex (spenderHash n), "input" .= spenderIndex n]+ toEncoding n = pairs ("txid" .= txHashToHex (spenderHash n) <> "input" .= spenderIndex n)++instance FromJSON Spender where+ parseJSON =+ A.withObject "spender" $ \o -> Spender <$> o .: "txid" <*> o .: "input"++-- | Output information.+data StoreOutput = StoreOutput+ { outputAmount :: !Word64+ , outputScript :: !ByteString+ , outputSpender :: !(Maybe Spender)+ } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)++storeOutputToJSON :: Network -> StoreOutput -> Value+storeOutputToJSON net d =+ object+ [ "address" .= scriptToAddrJSON net (outputScript d)+ , "pkscript" .= encodeHex (outputScript d)+ , "value" .= outputAmount d+ , "spent" .= isJust (outputSpender d)+ , "spender" .= outputSpender d+ ]++storeOutputToEncoding :: Network -> StoreOutput -> Encoding+storeOutputToEncoding net d =+ pairs+ ( "address" `pair` scriptToAddrEncoding net (outputScript d)+ <> "pkscript" `pair` text (encodeHex (outputScript d))+ <> "value" .= outputAmount d+ <> "spent" .= isJust (outputSpender d)+ <> "spender" .= outputSpender d+ )++instance FromJSON StoreOutput where+ parseJSON =+ A.withObject "storeoutput" $ \o -> do+ value <- o .: "value"+ pkscript <- o .: "pkscript" >>= jsonHex+ spender <- o .: "spender"+ return+ StoreOutput+ { outputAmount = value+ , outputScript = pkscript+ , outputSpender = spender+ }++data Prev = Prev+ { prevScript :: !ByteString+ , prevAmount :: !Word64+ } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)++toInput :: TxIn -> Maybe Prev -> Maybe WitnessStack -> StoreInput+toInput i Nothing w =+ StoreCoinbase+ { inputPoint = prevOutput i+ , inputSequence = txInSequence i+ , inputSigScript = scriptInput i+ , inputWitness = w+ }+toInput i (Just p) w =+ StoreInput+ { inputPoint = prevOutput i+ , inputSequence = txInSequence i+ , inputSigScript = scriptInput i+ , inputPkScript = prevScript p+ , inputAmount = prevAmount p+ , inputWitness = w+ }++toOutput :: TxOut -> Maybe Spender -> StoreOutput+toOutput o s =+ StoreOutput+ { outputAmount = outValue o+ , outputScript = scriptOutput o+ , outputSpender = s+ }++data TxData = TxData+ { txDataBlock :: !BlockRef+ , txData :: !Tx+ , txDataPrevs :: !(IntMap Prev)+ , txDataDeleted :: !Bool+ , txDataRBF :: !Bool+ , txDataTime :: !Word64+ } deriving (Show, Eq, Ord, Generic, Serialize, NFData)++toTransaction :: TxData -> IntMap Spender -> Transaction+toTransaction t sm =+ Transaction+ { transactionBlock = txDataBlock t+ , transactionVersion = txVersion (txData t)+ , transactionLockTime = txLockTime (txData t)+ , transactionInputs = ins+ , transactionOutputs = outs+ , transactionDeleted = txDataDeleted t+ , transactionRBF = txDataRBF t+ , transactionTime = txDataTime t+ }+ where+ ws =+ take (length (txIn (txData t))) $+ map Just (txWitness (txData t)) <> repeat Nothing+ f n i = toInput i (I.lookup n (txDataPrevs t)) (ws !! n)+ ins = zipWith f [0 ..] (txIn (txData t))+ g n o = toOutput o (I.lookup n sm)+ outs = zipWith g [0 ..] (txOut (txData t))++fromTransaction :: Transaction -> (TxData, IntMap Spender)+fromTransaction t = (d, sm)+ where+ d =+ TxData+ { txDataBlock = transactionBlock t+ , txData = transactionData t+ , txDataPrevs = ps+ , txDataDeleted = transactionDeleted t+ , txDataRBF = transactionRBF t+ , txDataTime = transactionTime t+ }+ f _ StoreCoinbase {} = Nothing+ f n StoreInput {inputPkScript = s, inputAmount = v} =+ Just (n, Prev {prevScript = s, prevAmount = v})+ ps = I.fromList . catMaybes $ zipWith f [0 ..] (transactionInputs t)+ g _ StoreOutput {outputSpender = Nothing} = Nothing+ g n StoreOutput {outputSpender = Just s} = Just (n, s)+ sm = I.fromList . catMaybes $ zipWith g [0 ..] (transactionOutputs t)++-- | Detailed transaction information.+data Transaction = Transaction+ { transactionBlock :: !BlockRef+ -- ^ block information for this transaction+ , transactionVersion :: !Word32+ -- ^ transaction version+ , transactionLockTime :: !Word32+ -- ^ lock time+ , transactionInputs :: ![StoreInput]+ -- ^ transaction inputs+ , transactionOutputs :: ![StoreOutput]+ -- ^ transaction outputs+ , transactionDeleted :: !Bool+ -- ^ this transaction has been deleted and is no longer valid+ , transactionRBF :: !Bool+ -- ^ this transaction can be replaced in the mempool+ , transactionTime :: !Word64+ -- ^ time the transaction was first seen or time of block+ } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)++transactionData :: Transaction -> Tx+transactionData t =+ Tx+ { txVersion = transactionVersion t+ , txIn = map i (transactionInputs t)+ , txOut = map o (transactionOutputs t)+ , txWitness = mapMaybe inputWitness (transactionInputs t)+ , txLockTime = transactionLockTime t+ }+ where+ i StoreCoinbase {inputPoint = p, inputSequence = q, inputSigScript = s} =+ TxIn {prevOutput = p, scriptInput = s, txInSequence = q}+ i StoreInput {inputPoint = p, inputSequence = q, inputSigScript = s} =+ TxIn {prevOutput = p, scriptInput = s, txInSequence = q}+ o StoreOutput {outputAmount = v, outputScript = s} =+ TxOut {outValue = v, scriptOutput = s}++transactionToJSON :: Network -> Transaction -> Value+transactionToJSON net dtx =+ object+ [ "txid" .= txHash (transactionData dtx)+ , "size" .= B.length (S.encode (transactionData dtx))+ , "version" .= transactionVersion dtx+ , "locktime" .= transactionLockTime dtx+ , "fee" .=+ if any isCoinbase (transactionInputs dtx)+ then 0+ else inv - outv+ , "inputs" .= map (storeInputToJSON net) (transactionInputs dtx)+ , "outputs" .= map (storeOutputToJSON net) (transactionOutputs dtx)+ , "block" .= transactionBlock dtx+ , "deleted" .= transactionDeleted dtx+ , "time" .= transactionTime dtx+ , "rbf" .= transactionRBF dtx+ , "weight" .= w+ ]+ where+ inv = sum (map inputAmount (transactionInputs dtx))+ outv = sum (map outputAmount (transactionOutputs dtx))+ w =+ let b = B.length $ S.encode (transactionData dtx) {txWitness = []}+ x = B.length $ S.encode (transactionData dtx)+ in b * 3 + x++transactionToEncoding :: Network -> Transaction -> Encoding+transactionToEncoding net dtx =+ pairs+ ( "txid" `pair` text (txHashToHex (txHash (transactionData dtx)))+ <> "size" .= B.length (S.encode (transactionData dtx))+ <> "version" .= transactionVersion dtx+ <> "locktime" .= transactionLockTime dtx+ <> "fee" .= (if any isCoinbase (transactionInputs dtx) then 0 else inv - outv)+ <> "inputs" `pair` list (storeInputToEncoding net) (transactionInputs dtx)+ <> "outputs" `pair` list (storeOutputToEncoding net) (transactionOutputs dtx)+ <> "block" .= transactionBlock dtx+ <> "deleted" .= transactionDeleted dtx+ <> "time" .= transactionTime dtx+ <> "rbf" .= transactionRBF dtx+ <> "weight" .= w+ )+ where+ inv = sum (map inputAmount (transactionInputs dtx))+ outv = sum (map outputAmount (transactionOutputs dtx))+ w =+ let b = B.length $ S.encode (transactionData dtx) {txWitness = []}+ x = B.length $ S.encode (transactionData dtx)+ in b * 3 + x++instance FromJSON Transaction where+ parseJSON =+ A.withObject "transaction" $ \o -> do+ version <- o .: "version"+ locktime <- o .: "locktime"+ inputs <- o .: "inputs"+ outputs <- o .: "outputs"+ block <- o .: "block"+ deleted <- o .: "deleted"+ time <- o .: "time"+ rbf <- o .:? "rbf" .!= False+ return+ Transaction+ { transactionBlock = block+ , transactionVersion = version+ , transactionLockTime = locktime+ , transactionInputs = inputs+ , transactionOutputs = outputs+ , transactionDeleted = deleted+ , transactionTime = time+ , transactionRBF = rbf+ }++-- | Information about a connected peer.+data PeerInformation+ = PeerInformation { peerUserAgent :: !ByteString+ -- ^ user agent string+ , peerAddress :: !String+ -- ^ network address+ , peerVersion :: !Word32+ -- ^ version number+ , peerServices :: !Word64+ -- ^ services field+ , peerRelay :: !Bool+ -- ^ will relay transactions+ }+ deriving (Show, Eq, Ord, Generic, NFData, Serialize)++instance ToJSON PeerInformation where+ toJSON p = object+ [ "useragent" .= String (cs (peerUserAgent p))+ , "address" .= peerAddress p+ , "version" .= peerVersion p+ , "services" .= String (encodeHex (S.encode (peerServices p)))+ , "relay" .= peerRelay p+ ]+ toEncoding p = pairs+ ( "useragent" `pair` text (cs (peerUserAgent p))+ <> "address" .= peerAddress p+ <> "version" .= peerVersion p+ <> "services" `pair` text (encodeHex (S.encode (peerServices p)))+ <> "relay" .= peerRelay p+ )++instance FromJSON PeerInformation where+ parseJSON =+ A.withObject "peerinformation" $ \o -> do+ String useragent <- o .: "useragent"+ address <- o .: "address"+ version <- o .: "version"+ services <-+ o .: "services" >>= jsonHex >>= \b ->+ case S.decode b of+ Left e -> fail $ "Could not decode services: " <> e+ Right s -> return s+ relay <- o .: "relay"+ return+ PeerInformation+ { peerUserAgent = cs useragent+ , peerAddress = address+ , peerVersion = version+ , peerServices = services+ , peerRelay = relay+ }++-- | Address balances for an extended public key.+data XPubBal = XPubBal+ { xPubBalPath :: ![KeyIndex]+ , xPubBal :: !Balance+ } deriving (Show, Ord, Eq, Generic, Serialize, NFData)++xPubBalToJSON :: Network -> XPubBal -> Value+xPubBalToJSON net XPubBal {xPubBalPath = p, xPubBal = b} =+ object ["path" .= p, "balance" .= balanceToJSON net b]++xPubBalToEncoding :: Network -> XPubBal -> Encoding+xPubBalToEncoding net XPubBal {xPubBalPath = p, xPubBal = b} =+ pairs ("path" .= p <> "balance" `pair` balanceToEncoding net b)++xPubBalParseJSON :: Network -> Value -> Parser XPubBal+xPubBalParseJSON net =+ A.withObject "xpubbal" $ \o -> do+ path <- o .: "path"+ balance <- balanceParseJSON net =<< o .: "balance"+ return XPubBal {xPubBalPath = path, xPubBal = balance}++-- | Unspent transaction for extended public key.+data XPubUnspent = XPubUnspent+ { xPubUnspentPath :: ![KeyIndex]+ , xPubUnspent :: !Unspent+ } deriving (Show, Eq, Generic, Serialize, NFData)++xPubUnspentToJSON :: Network -> XPubUnspent -> Value+xPubUnspentToJSON net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =+ object ["path" .= p, "unspent" .= unspentToJSON net u]++xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding+xPubUnspentToEncoding net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =+ pairs ("path" .= p <> "unspent" `pair` unspentToEncoding net u)++instance FromJSON XPubUnspent where+ parseJSON =+ A.withObject "xpubunspent" $ \o -> do+ p <- o .: "path"+ u <- o .: "unspent"+ return XPubUnspent {xPubUnspentPath = p, xPubUnspent = u}++data XPubSummary =+ XPubSummary+ { xPubSummaryConfirmed :: !Word64+ , xPubSummaryZero :: !Word64+ , xPubSummaryReceived :: !Word64+ , xPubUnspentCount :: !Word64+ , xPubExternalIndex :: !Word32+ , xPubChangeIndex :: !Word32+ }+ deriving (Eq, Show, Generic, Serialize, NFData)++instance ToJSON XPubSummary where+ toJSON XPubSummary { xPubSummaryConfirmed = c+ , xPubSummaryZero = z+ , xPubSummaryReceived = r+ , xPubUnspentCount = u+ , xPubExternalIndex = ext+ , xPubChangeIndex = ch+ } =+ object+ [ "balance" .=+ object+ [ "confirmed" .= c+ , "unconfirmed" .= z+ , "received" .= r+ , "utxo" .= u+ ]+ , "indices" .= object ["change" .= ch, "external" .= ext]+ ]+ toEncoding XPubSummary { xPubSummaryConfirmed = c+ , xPubSummaryZero = z+ , xPubSummaryReceived = r+ , xPubUnspentCount = u+ , xPubExternalIndex = ext+ , xPubChangeIndex = ch+ } =+ pairs+ ( "balance" `pair` pairs+ ( "confirmed" .= c+ <> "unconfirmed" .= z+ <> "received" .= r+ <> "utxo" .= u+ )+ <> "indices" `pair` pairs+ ( "change" .= ch+ <> "external" .= ext+ )+ )++instance FromJSON XPubSummary where+ parseJSON =+ A.withObject "xpubsummary" $ \o -> do+ b <- o .: "balance"+ i <- o .: "indices"+ conf <- b .: "confirmed"+ unconfirmed <- b .: "unconfirmed"+ received <- b .: "received"+ utxo <- b .: "utxo"+ change <- i .: "change"+ external <- i .: "external"+ return+ XPubSummary+ { xPubSummaryConfirmed = conf+ , xPubSummaryZero = unconfirmed+ , xPubSummaryReceived = received+ , xPubUnspentCount = utxo+ , xPubExternalIndex = external+ , xPubChangeIndex = change+ }++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+ }+ deriving (Show, Eq, Generic, Serialize, NFData)++instance ToJSON HealthCheck where+ toJSON h =+ 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+ ]+ 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+ }++data Event+ = EventBlock BlockHash+ | EventTx TxHash+ deriving (Show, Eq, Generic, Serialize, NFData)++instance ToJSON Event where+ toJSON (EventTx h) = object ["type" .= String "tx", "id" .= h]+ toJSON (EventBlock h) = object ["type" .= String "block", "id" .= h]+ toEncoding (EventTx h) =+ pairs ("type" `pair` text "tx" <> "id" `pair` text (txHashToHex h))+ toEncoding (EventBlock h) =+ pairs+ ("type" `pair` text "block" <> "id" `pair` text (blockHashToHex h))++instance FromJSON Event where+ parseJSON =+ A.withObject "event" $ \o -> do+ t <- o .: "type"+ case t of+ "tx" -> do+ i <- o .: "id"+ return $ EventTx i+ "block" -> do+ i <- o .: "id"+ return $ EventBlock i+ _ -> fail $ "Could not recognize event type: " <> t++newtype GenericResult a = GenericResult+ { getResult :: a+ } deriving (Show, Eq, Generic, Serialize, NFData)++instance ToJSON a => ToJSON (GenericResult a) where+ toJSON (GenericResult b) = object ["result" .= b]+ toEncoding (GenericResult b) = pairs ("result" .= b)++instance FromJSON a => FromJSON (GenericResult a) where+ parseJSON =+ A.withObject "result" $ \o -> GenericResult <$> o .: "result"++newtype TxId =+ TxId TxHash+ deriving (Show, Eq, Generic, Serialize, NFData)++instance ToJSON TxId where+ toJSON (TxId h) = object ["txid" .= h]+ toEncoding (TxId h) = pairs ("txid" `pair` text (txHashToHex h))++instance FromJSON TxId where+ parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid"++scriptToAddrJSON :: Network -> ByteString -> Value+scriptToAddrJSON net bs =+ case scriptToAddressBS bs of+ Left _ -> Null+ Right a -> addrToJSON net a++scriptToAddrEncoding :: Network -> ByteString -> Encoding+scriptToAddrEncoding net bs =+ case scriptToAddressBS bs of+ Left _ -> null_+ Right a -> addrToEncoding net a++data Except+ = ThingNotFound+ | ServerError+ | BadRequest+ | UserError String+ | StringError String+ | BlockTooLarge+ deriving (Eq, Ord, Serialize, Generic, NFData)++instance Show Except where+ show ThingNotFound = "not found"+ show ServerError = "you made me kill a unicorn"+ show BadRequest = "bad request"+ show (UserError s) = s+ show (StringError _) = "you killed the dragon with your bare hands"+ show BlockTooLarge = "block too large"++instance Exception Except++instance ScottyError Except where+ stringError = StringError+ showError = TL.pack . show++instance ToJSON Except where+ toJSON e = object ["error" .= TL.pack (show e)]
+ test/Haskoin/Store/DataSpec.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Haskoin.Store.DataSpec+ ( spec+ ) where++import Data.Aeson (Encoding, FromJSON (..), ToJSON (..),+ Value)+import qualified Data.Aeson as A+import Data.Aeson.Encoding (encodingToLazyByteString)+import Data.Aeson.Parser (decodeWith, json)+import Data.Aeson.Types (Parser, parse)+import Data.ByteString (pack)+import qualified Data.ByteString.Short as BSS+import Data.Serialize (Serialize (..), decode, encode)+import Data.String.Conversions (cs)+import Haskoin (Address (..), BlockHash (..),+ BlockHeader (..), Hash160 (..),+ Hash256 (..), Network (..),+ OutPoint (..), RejectCode (..),+ Tx (..), TxHash (..), TxIn (..),+ TxOut (..), XPubKey (..), bch,+ bchRegTest, bchTest, btc, btcRegTest,+ btcTest, ripemd160, sha256)+import Haskoin.Store.Data (Balance (..), BlockData (..),+ BlockRef (..), BlockTx (..),+ DeriveType (..), Event (..),+ HealthCheck (..),+ PeerInformation (..), Prev (..),+ Spender (..), StoreInput (..),+ StoreOutput (..), Transaction (..),+ TxData (..), TxId (..), Unspent (..),+ XPubBal (..), XPubSpec (..),+ XPubSummary (..), XPubUnspent (..),+ balanceParseJSON, balanceToEncoding,+ balanceToJSON, transactionToEncoding,+ transactionToJSON, unspentToEncoding,+ unspentToJSON, xPubUnspentToEncoding,+ xPubUnspentToJSON)+import Test.Hspec (Expectation, Spec, describe, shouldBe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary (..), Gen,+ arbitraryPrintableChar,+ arbitraryUnicodeChar, elements,+ forAll, listOf, listOf1, oneof)++spec :: Spec+spec = do+ describe "Binary serialization" $ do+ prop "identity for derivation type" $ \x -> testSerial (x :: DeriveType)+ prop "identity for xpub spec" $ \x -> testSerial (x :: XPubSpec)+ prop "identity for block ref" $ \x -> testSerial (x :: BlockRef)+ prop "identity for block tx" $ \x -> testSerial (x :: BlockTx)+ prop "identity for balance" $ \x -> testSerial (x :: Balance)+ prop "identity for unspent" $ \x -> testSerial (x :: Unspent)+ prop "identity for block data" $ \x -> testSerial (x :: BlockData)+ prop "identity for input" $ \x -> testSerial (x :: StoreInput)+ prop "identity for spender" $ \x -> testSerial (x :: Spender)+ prop "identity for output" $ \x -> testSerial (x :: StoreOutput)+ prop "identity for previous output" $ \x -> testSerial (x :: Prev)+ prop "identity for tx data" $ \x -> testSerial (x :: TxData)+ prop "identity for transaction" $ \x -> testSerial (x :: Transaction)+ prop "identity for xpub balance" $ \x -> testSerial (x :: XPubBal)+ prop "identity for xpub unspent" $ \x -> testSerial (x :: XPubUnspent)+ prop "identity for xpub summary" $ \x -> testSerial (x :: XPubSummary)+ prop "identity for health check" $ \x -> testSerial (x :: HealthCheck)+ prop "identity for event" $ \x -> testSerial (x :: Event)+ prop "identity for txid" $ \x -> testSerial (x :: TxId)+ prop "identity for peer info" $ \x -> testSerial (x :: PeerInformation)+ describe "JSON serialization" $ do+ prop "identity for balance" . forAll arbitraryNetData $ \(net, x) ->+ testNetJSON+ (balanceParseJSON net)+ (balanceToJSON net)+ (balanceToEncoding net)+ x+ prop "identity for block tx" $ \x -> testJSON (x :: BlockTx)+ prop "identity for block ref" $ \x -> testJSON (x :: BlockRef)+ prop "identity for unspent" . forAll arbitraryNetData $ \(net, x) ->+ testNetJSON parseJSON (unspentToJSON net) (unspentToEncoding net) x+ prop "identity for block data" $ \x -> testJSON (x :: BlockData)+ prop "identity for spender" $ \x -> testJSON (x :: Spender)+ prop "identity for transaction" . forAll arbitraryNetData $ \(net, x) ->+ testNetJSON+ parseJSON+ (transactionToJSON net)+ (transactionToEncoding net)+ x+ prop "identity for xpub summary" $ \x -> testJSON (x :: XPubSummary)+ prop "identity for xpub unspent" . forAll arbitraryNetData $ \(net, x) ->+ testNetJSON+ parseJSON+ (xPubUnspentToJSON net)+ (xPubUnspentToEncoding net)+ x+ prop "identity for health check" $ \x -> testJSON (x :: HealthCheck)+ prop "identity for event" $ \x -> testJSON (x :: Event)+ prop "identity for txid" $ \x -> testJSON (x :: TxId)+ prop "identity for peer information" $ \x ->+ testJSON (x :: PeerInformation)++testJSON :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Expectation+testJSON input = (A.decode . A.encode) input `shouldBe` Just input++testNetJSON ::+ (Eq a, Show a)+ => (Value -> Parser a)+ -> (a -> Value)+ -> (a -> Encoding)+ -> a+ -> Expectation+testNetJSON parsejson tojson toenc x =+ let encval = A.encode (tojson x)+ encenc = encodingToLazyByteString (toenc x)+ decval = decodeWith json (parse parsejson) encval+ decenc = decodeWith json (parse parsejson) encenc+ in do+ decval `shouldBe` Just x+ decenc `shouldBe` Just x++testSerial :: (Eq a, Show a, Serialize a) => a -> Expectation+testSerial input = (decode . encode) input `shouldBe` Right input++arbitraryNetwork :: Gen Network+arbitraryNetwork = elements [bch, btc, bchTest, btcTest, bchRegTest, btcRegTest]++arbitraryNetData :: Arbitrary a => Gen (Network, a)+arbitraryNetData = do+ net <- arbitraryNetwork+ x <- arbitrary+ return (net, x)++instance Arbitrary BlockRef where+ arbitrary =+ oneof [BlockRef <$> arbitrary <*> arbitrary, MemRef <$> arbitrary]++instance Arbitrary Hash256 where+ arbitrary = sha256 . pack <$> listOf1 arbitrary++instance Arbitrary TxHash where+ arbitrary = TxHash <$> arbitrary++instance Arbitrary OutPoint where+ arbitrary = OutPoint <$> arbitrary <*> arbitrary++instance Arbitrary TxIn where+ arbitrary =+ TxIn <$> arbitrary <*> (pack <$> listOf1 arbitrary) <*>+ arbitrary++instance Arbitrary TxOut where+ arbitrary = TxOut <$> arbitrary <*> (pack <$> listOf1 arbitrary)++instance Arbitrary Tx where+ arbitrary = do+ ver <- arbitrary+ txin <- listOf1 arbitrary+ txout <- listOf1 arbitrary+ txlock <- arbitrary+ return+ Tx+ { txVersion = ver+ , txIn = txin+ , txOut = txout+ , txWitness = []+ , txLockTime = txlock+ }++instance Arbitrary Prev where+ arbitrary = Prev <$> (pack <$> listOf1 arbitrary) <*> arbitrary++instance Arbitrary TxData where+ arbitrary =+ TxData+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary StoreInput where+ arbitrary =+ oneof+ [ StoreCoinbase <$> arbitrary <*> arbitrary <*>+ (pack <$> listOf1 arbitrary) <*>+ (oneof+ [ Just <$> (listOf $ pack <$> listOf1 arbitrary)+ , return Nothing+ ])+ , StoreInput <$> arbitrary <*> arbitrary <*>+ (pack <$> listOf1 arbitrary) <*>+ (pack <$> listOf1 arbitrary) <*>+ arbitrary <*>+ (oneof+ [ Just <$> (listOf $ pack <$> listOf1 arbitrary)+ , return Nothing+ ])+ ]++instance Arbitrary Spender where+ arbitrary = Spender <$> arbitrary <*> arbitrary++instance Arbitrary StoreOutput where+ arbitrary =+ StoreOutput <$> arbitrary <*> (pack <$> listOf1 arbitrary) <*> arbitrary++instance Arbitrary Transaction where+ arbitrary =+ Transaction+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary PeerInformation where+ arbitrary = do+ PeerInformation+ <$> (cs <$> listOf arbitraryUnicodeChar)+ <*> listOf arbitraryPrintableChar+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary BlockHash where+ arbitrary = BlockHash <$> arbitrary++instance Arbitrary HealthCheck where+ arbitrary = do+ bh <- arbitrary+ hh <- arbitrary+ let mb = elements [Nothing, Just bh]+ mh = elements [Nothing, Just hh]+ HealthCheck+ <$> mb+ <*> arbitrary+ <*> mh+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary RejectCode where+ arbitrary =+ elements+ [ RejectMalformed+ , RejectInvalid+ , RejectObsolete+ , RejectDuplicate+ , RejectNonStandard+ , RejectDust+ , RejectInsufficientFee+ , RejectCheckpoint+ ]++instance Arbitrary XPubKey where+ arbitrary =+ XPubKey <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>+ arbitrary++instance Arbitrary XPubSpec where+ arbitrary = XPubSpec <$> arbitrary <*> arbitrary++instance Arbitrary DeriveType where+ arbitrary = elements [DeriveNormal, DeriveP2SH, DeriveP2WPKH]++instance Arbitrary TxId where+ arbitrary = TxId <$> arbitrary++instance Arbitrary BlockTx where+ arbitrary = BlockTx <$> arbitrary <*> arbitrary++instance Arbitrary Hash160 where+ arbitrary = ripemd160 . pack <$> listOf1 arbitrary++instance Arbitrary Address where+ arbitrary =+ oneof+ [ PubKeyAddress <$> arbitrary+ , ScriptAddress <$> arbitrary+ ]++instance Arbitrary Balance where+ arbitrary =+ Balance+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Unspent where+ arbitrary =+ Unspent <$> arbitrary <*> arbitrary <*> arbitrary <*>+ (BSS.toShort . pack <$> listOf1 arbitrary)++instance Arbitrary BlockHeader where+ arbitrary =+ BlockHeader <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>+ arbitrary <*>+ arbitrary++instance Arbitrary BlockData where+ arbitrary =+ BlockData+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> listOf1 arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary XPubBal where+ arbitrary = XPubBal <$> arbitrary <*> arbitrary++instance Arbitrary XPubUnspent where+ arbitrary = XPubUnspent <$> arbitrary <*> arbitrary++instance Arbitrary XPubSummary where+ arbitrary =+ XPubSummary+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Event where+ arbitrary =+ oneof [EventBlock <$> arbitrary, EventTx <$> arbitrary]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}