haskoin-store-data 0.64.7 → 0.64.8
raw patch · 7 files changed
+4691/−4645 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−0
- haskoin-store-data.cabal +2/−2
- src/Haskoin/Store/Data.hs +3592/−3591
- src/Haskoin/Store/WebClient.hs +104/−106
- src/Haskoin/Store/WebCommon.hs +307/−271
- test/Haskoin/Store/DataSpec.hs +640/−639
- test/Haskoin/Store/WebCommonSpec.hs +37/−36
CHANGELOG.md view
@@ -4,6 +4,15 @@ 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.64.8+### Changed+- Use better Fourmolu format.+- Be more precise when counting retrieved items.++### Fixed+- Avoid transactions duplicated in xpub data.+- Refactor some functions to make them more robust.+ ## 0.64.7 ### Fixed - Optimisations for various Blockchain endpoints.
haskoin-store-data.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 76f274c78531ac5c9255daff075b1c2876704184a4879a99b06fff516cc97e1d+-- hash: 41ca12699b2d3f410e0363cfe334c04ecd3be2fda24904c674eb10868c770185 name: haskoin-store-data-version: 0.64.7+version: 0.64.8 synopsis: Data for Haskoin Store description: Please see the README on GitHub at <https://github.com/haskoin/haskoin-store#readme> category: Bitcoin, Finance, Network
src/Haskoin/Store/Data.hs view
@@ -7,3594 +7,3595 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -module Haskoin.Store.Data (- -- * Address Balances- Balance (..),- balanceToJSON,- balanceToEncoding,- balanceParseJSON,- zeroBalance,- nullBalance,-- -- * Block Data- BlockData (..),- blockDataToJSON,- blockDataToEncoding,- confirmed,-- -- * Transactions- TxRef (..),- TxData (..),- Transaction (..),- transactionToJSON,- transactionToEncoding,- transactionParseJSON,- transactionData,- fromTransaction,- toTransaction,- StoreInput (..),- storeInputToJSON,- storeInputToEncoding,- storeInputParseJSON,- isCoinbase,- StoreOutput (..),- storeOutputToJSON,- storeOutputToEncoding,- storeOutputParseJSON,- Prev (..),- Spender (..),- BlockRef (..),- UnixTime,- getUnixTime,- putUnixTime,- BlockPos,-- -- * Unspent Outputs- Unspent (..),- unspentToJSON,- unspentToEncoding,- unspentParseJSON,-- -- * Extended Public Keys- XPubSpec (..),- XPubBal (..),- xPubBalToJSON,- xPubBalToEncoding,- xPubBalParseJSON,- XPubUnspent (..),- xPubUnspentToJSON,- xPubUnspentToEncoding,- xPubUnspentParseJSON,- XPubSummary (..),- DeriveType (..),- textToDeriveType,- deriveTypeToText,-- -- * Other Data- TxId (..),- GenericResult (..),- SerialList (..),- RawResult (..),- RawResultList (..),- PeerInformation (..),- Healthy (..),- BlockHealth (..),- TimeHealth (..),- CountHealth (..),- MaxHealth (..),- HealthCheck (..),- Event (..),- Except (..),-- -- * Blockchain.info API- BinfoBlockId (..),- BinfoTxId (..),- encodeBinfoTxId,- BinfoFilter (..),- BinfoMultiAddr (..),- binfoMultiAddrToJSON,- binfoMultiAddrToEncoding,- binfoMultiAddrParseJSON,- BinfoShortBal (..),- BinfoBalance (..),- toBinfoAddrs,- binfoBalanceToJSON,- binfoBalanceToEncoding,- binfoBalanceParseJSON,- BinfoRawAddr (..),- binfoRawAddrToJSON,- binfoRawAddrToEncoding,- binfoRawAddrParseJSON,- BinfoAddr (..),- parseBinfoAddr,- BinfoWallet (..),- BinfoUnspent (..),- binfoUnspentToJSON,- binfoUnspentToEncoding,- binfoUnspentParseJSON,- binfoHexValue,- BinfoUnspents (..),- binfoUnspentsToJSON,- binfoUnspentsToEncoding,- binfoUnspentsParseJSON,- BinfoBlock (..),- toBinfoBlock,- binfoBlockToJSON,- binfoBlockToEncoding,- binfoBlockParseJSON,- binfoBlocksToJSON,- binfoBlocksToEncoding,- binfoBlocksParseJSON,- BinfoTx (..),- relevantTxs,- toBinfoTx,- toBinfoTxSimple,- binfoTxToJSON,- binfoTxToEncoding,- binfoTxParseJSON,- BinfoTxInput (..),- binfoTxInputToJSON,- binfoTxInputToEncoding,- binfoTxInputParseJSON,- BinfoTxOutput (..),- binfoTxOutputToJSON,- binfoTxOutputToEncoding,- binfoTxOutputParseJSON,- BinfoSpender (..),- BinfoXPubPath (..),- binfoXPubPathToJSON,- binfoXPubPathToEncoding,- binfoXPubPathParseJSON,- BinfoInfo (..),- BinfoBlockInfo (..),- toBinfoBlockInfo,- BinfoSymbol (..),- BinfoTicker (..),- BinfoRate (..),- BinfoHistory (..),- toBinfoHistory,- BinfoDate (..),- BinfoHeader (..),- BinfoMempool (..),- binfoMempoolToJSON,- binfoMempoolToEncoding,- binfoMempoolParseJSON,- BinfoBlocks (..),-) where--import Control.Applicative ((<|>))-import Control.DeepSeq (NFData)-import Control.Exception (Exception)-import Control.Monad (join, mzero, unless, (<=<))-import Data.Aeson (- Encoding,- FromJSON (..),- ToJSON (..),- Value (..),- (.!=),- (.:),- (.:?),- (.=),- )-import qualified Data.Aeson as A-import qualified Data.Aeson.Encoding as AE-import Data.Aeson.Types (Parser)-import Data.Binary (Binary (get, put))-import Data.Bits (Bits (..))-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Builder as BSB-import Data.Bytes.Get-import qualified Data.Bytes.Get as Bytes.Get-import Data.Bytes.Put-import Data.Bytes.Serial-import Data.Default (Default (..))-import Data.Foldable (toList)-import Data.Function (on)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap-import Data.HashSet (HashSet)-import qualified Data.HashSet as HashSet-import Data.Hashable (Hashable (..))-import Data.Int (Int32, Int64)-import qualified Data.IntMap as IntMap-import Data.IntMap.Strict (IntMap)-import Data.Maybe (- catMaybes,- fromMaybe,- isJust,- isNothing,- mapMaybe,- maybeToList,- )-import Data.Serialize (Serialize (..))-import Data.String.Conversions (cs)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import Data.Time.Clock.POSIX (- posixSecondsToUTCTime,- utcTimeToPOSIXSeconds,- )-import Data.Time.Format (- defaultTimeLocale,- formatTime,- parseTimeM,- )-import Data.Word (Word32, Word64)-import GHC.Generics (Generic)-import Haskoin hiding (inputAddress)-import Web.Scotty.Trans (Parsable (..), ScottyError (..))--data DeriveType- = DeriveNormal- | DeriveP2SH- | DeriveP2WPKH- deriving (Show, Eq, Generic, NFData)--textToDeriveType :: Text -> Maybe DeriveType-textToDeriveType "normal" = Just DeriveNormal-textToDeriveType "compat" = Just DeriveP2SH-textToDeriveType "segwit" = Just DeriveP2WPKH-textToDeriveType _ = Nothing--deriveTypeToText :: DeriveType -> Text-deriveTypeToText DeriveNormal = "normal"-deriveTypeToText DeriveP2SH = "compat"-deriveTypeToText DeriveP2WPKH = "segwit"--instance Serial DeriveType where- serialize DeriveNormal = putWord8 0x00- serialize DeriveP2SH = putWord8 0x01- serialize DeriveP2WPKH = putWord8 0x02-- deserialize =- getWord8 >>= \case- 0x00 -> return DeriveNormal- 0x01 -> return DeriveP2SH- 0x02 -> return DeriveP2WPKH- _ -> return DeriveNormal--instance Binary DeriveType where- put = serialize- get = deserialize--instance Serialize DeriveType where- put = serialize- get = deserialize--instance Default DeriveType where- def = DeriveNormal--instance Parsable DeriveType where- parseParam txt =- case textToDeriveType (TL.toStrict txt) of- Nothing -> Left "invalid derivation type"- Just x -> Right x--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 Serial XPubSpec where- serialize XPubSpec{xPubSpecKey = k, xPubDeriveType = t} = do- putWord8 (xPubDepth k)- serialize (xPubParent k)- putWord32be (xPubIndex k)- serialize (xPubChain k)- serialize (wrapPubKey True (xPubKey k))- serialize t- deserialize = do- d <- getWord8- p <- deserialize- i <- getWord32be- c <- deserialize- k <- deserialize- t <- deserialize- let x =- XPubKey- { xPubDepth = d- , xPubParent = p- , xPubIndex = i- , xPubChain = c- , xPubKey = pubKeyPoint k- }- return XPubSpec{xPubSpecKey = x, xPubDeriveType = t}--instance Serialize XPubSpec where- put = serialize- get = deserialize--instance Binary XPubSpec where- put = serialize- get = deserialize--type UnixTime = Word64-type BlockPos = Word32---- | Binary such that ordering is inverted.-putUnixTime :: MonadPut m => Word64 -> m ()-putUnixTime w = putWord64be $ maxBound - w--getUnixTime :: MonadGet m => m Word64-getUnixTime = (maxBound -) <$> getWord64be---- | Reference to a block where a transaction is stored.-data BlockRef- = BlockRef- { -- | block height in the chain- blockRefHeight :: !BlockHeight- , -- | position of transaction within the block- blockRefPos :: !Word32- }- | MemRef- { memRefTime :: !UnixTime- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)---- | Serial entities will sort in reverse order.-instance Serial BlockRef where- serialize MemRef{memRefTime = t} = do- putWord8 0x00- putUnixTime t- serialize BlockRef{blockRefHeight = h, blockRefPos = p} = do- putWord8 0x01- putWord32be (maxBound - h)- putWord32be (maxBound - p)- deserialize =- getWord8 >>= \case- 0x00 -> getmemref- 0x01 -> getblockref- _ -> fail "Cannot decode BlockRef"- where- getmemref = do- MemRef <$> getUnixTime- getblockref = do- h <- (maxBound -) <$> getWord32be- p <- (maxBound -) <$> getWord32be- return BlockRef{blockRefHeight = h, blockRefPos = p}--instance Serialize BlockRef where- put = serialize- get = deserialize--instance Binary BlockRef where- put = serialize- get = deserialize--confirmed :: BlockRef -> Bool-confirmed BlockRef{} = True-confirmed MemRef{} = False--instance ToJSON BlockRef where- toJSON BlockRef{blockRefHeight = h, blockRefPos = p} =- A.object ["height" .= h, "position" .= p]- toJSON MemRef{memRefTime = t} = A.object ["mempool" .= t]- toEncoding BlockRef{blockRefHeight = h, blockRefPos = p} =- AE.pairs ("height" .= h <> "position" .= p)- toEncoding MemRef{memRefTime = t} = AE.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 TxRef = TxRef- { -- | block information- txRefBlock :: !BlockRef- , -- | transaction hash- txRefHash :: !TxHash- }- deriving (Show, Eq, Ord, Generic, Hashable, NFData)--instance Serial TxRef where- serialize (TxRef b h) = do- serialize b- serialize h-- deserialize =- TxRef <$> deserialize <*> deserialize--instance Binary TxRef where- put = serialize- get = deserialize--instance Serialize TxRef where- put = serialize- get = deserialize--instance ToJSON TxRef where- toJSON btx =- A.object- [ "txid" .= txRefHash btx- , "block" .= txRefBlock btx- ]- toEncoding btx =- AE.pairs $- "txid" .= txRefHash btx- <> "block" .= txRefBlock btx--instance FromJSON TxRef where- parseJSON =- A.withObject "blocktx" $ \o -> do- txid <- o .: "txid"- block <- o .: "block"- return TxRef{txRefBlock = block, txRefHash = txid}---- | Address balance information.-data Balance = Balance- { -- | address balance- balanceAddress :: !Address- , -- | confirmed balance- balanceAmount :: !Word64- , -- | unconfirmed balance- balanceZero :: !Word64- , -- | number of unspent outputs- balanceUnspentCount :: !Word64- , -- | number of transactions- balanceTxCount :: !Word64- , -- | total amount from all outputs in this address- balanceTotalReceived :: !Word64- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)--instance Serial Balance where- serialize Balance{..} = do- serialize balanceAddress- putWord64be balanceAmount- putWord64be balanceZero- putWord64be balanceUnspentCount- putWord64be balanceTxCount- putWord64be balanceTotalReceived-- deserialize = do- balanceAddress <- deserialize- balanceAmount <- getWord64be- balanceZero <- getWord64be- balanceUnspentCount <- getWord64be- balanceTxCount <- getWord64be- balanceTotalReceived <- getWord64be- return Balance{..}--instance Binary Balance where- put = serialize- get = deserialize--instance Serialize Balance where- put = serialize- get = deserialize--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 =- A.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 =- AE.pairs $- "address" `AE.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 :: !ByteString- , unspentAddress :: !(Maybe Address)- }- deriving (Show, Eq, Generic, Hashable, NFData)--{- | Follow same order as in database and cache by inverting outpoint sort- order.--}-instance Ord Unspent where- compare a b =- compare- (unspentBlock a, unspentPoint b)- (unspentBlock b, unspentPoint a)--instance Serial Unspent where- serialize Unspent{..} = do- serialize unspentBlock- serialize unspentPoint- putWord64be unspentAmount- putLengthBytes unspentScript- putMaybe serialize unspentAddress-- deserialize = do- unspentBlock <- deserialize- unspentPoint <- deserialize- unspentAmount <- getWord64be- unspentScript <- getLengthBytes- unspentAddress <- getMaybe deserialize- return Unspent{..}--instance Binary Unspent where- put = serialize- get = deserialize--instance Serialize Unspent where- put = serialize- get = deserialize--instance Coin Unspent where- coinValue = unspentAmount--unspentToJSON :: Network -> Unspent -> Value-unspentToJSON net u =- A.object- [ "address" .= (addrToJSON net <$> unspentAddress u)- , "block" .= unspentBlock u- , "txid" .= outPointHash (unspentPoint u)- , "index" .= outPointIndex (unspentPoint u)- , "pkscript" .= encodeHex (unspentScript u)- , "value" .= unspentAmount u- ]--unspentToEncoding :: Network -> Unspent -> Encoding-unspentToEncoding net u =- AE.pairs $- "address" `AE.pair` maybe AE.null_ (addrToEncoding net) (unspentAddress u)- <> "block" .= unspentBlock u- <> "txid" .= outPointHash (unspentPoint u)- <> "index" .= outPointIndex (unspentPoint u)- <> "pkscript" `AE.pair` AE.text (encodeHex (unspentScript u))- <> "value" .= unspentAmount u--unspentParseJSON :: Network -> Value -> Parser Unspent-unspentParseJSON net =- A.withObject "unspent" $ \o -> do- block <- o .: "block"- txid <- o .: "txid"- index <- o .: "index"- value <- o .: "value"- script <- o .: "pkscript" >>= jsonHex- addr <-- o .: "address" >>= \case- Nothing -> return Nothing- Just a -> Just <$> addrFromJSON net a <|> return Nothing- return- Unspent- { unspentBlock = block- , unspentPoint = OutPoint txid index- , unspentAmount = value- , unspentScript = script- , unspentAddress = addr- }---- | Database value for a block entry.-data BlockData = BlockData- { -- | height of the block in the chain- blockDataHeight :: !BlockHeight- , -- | is this block in the main chain?- blockDataMainChain :: !Bool- , -- | accumulated work in that block- blockDataWork :: !Integer- , -- | block header- blockDataHeader :: !BlockHeader- , -- | size of the block including witnesses- blockDataSize :: !Word32- , -- | weight of this block (for segwit networks)- blockDataWeight :: !Word32- , -- | block transactions- blockDataTxs :: ![TxHash]- , -- | sum of all transaction outputs- blockDataOutputs :: !Word64- , -- | sum of all transaction fees- blockDataFees :: !Word64- , -- | block subsidy- blockDataSubsidy :: !Word64- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)--instance Serial BlockData where- serialize BlockData{..} = do- putWord32be blockDataHeight- serialize blockDataMainChain- putInteger blockDataWork- serialize blockDataHeader- putWord32be blockDataSize- putWord32be blockDataWeight- putList serialize blockDataTxs- putWord64be blockDataOutputs- putWord64be blockDataFees- putWord64be blockDataSubsidy-- deserialize = do- blockDataHeight <- getWord32be- blockDataMainChain <- deserialize- blockDataWork <- getInteger- blockDataHeader <- deserialize- blockDataSize <- getWord32be- blockDataWeight <- getWord32be- blockDataTxs <- getList deserialize- blockDataOutputs <- getWord64be- blockDataFees <- getWord64be- blockDataSubsidy <- getWord64be- return BlockData{..}--instance Serialize BlockData where- put = serialize- get = deserialize--instance Binary BlockData where- put = serialize- get = deserialize--blockDataToJSON :: Network -> BlockData -> Value-blockDataToJSON net bv =- A.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" .= blockDataWork bv- ]- <> ["weight" .= blockDataWeight bv | getSegWit net]--blockDataToEncoding :: Network -> BlockData -> Encoding-blockDataToEncoding net bv =- AE.pairs $- "hash"- `AE.pair` AE.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"- `AE.pair` AE.text- (txHashToHex (TxHash (merkleRoot (blockDataHeader bv))))- <> "subsidy" .= blockDataSubsidy bv- <> "fees" .= blockDataFees bv- <> "outputs" .= blockDataOutputs bv- <> "work" .= blockDataWork bv- <> (if getSegWit net then "weight" .= blockDataWeight bv else mempty)--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" .!= 0- 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 :: !WitnessStack- }- | StoreInput- { inputPoint :: !OutPoint- , inputSequence :: !Word32- , inputSigScript :: !ByteString- , inputPkScript :: !ByteString- , inputAmount :: !Word64- , inputWitness :: !WitnessStack- , inputAddress :: !(Maybe Address)- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)--instance Serial StoreInput where- serialize StoreCoinbase{..} = do- putWord8 0x00- serialize inputPoint- putWord32be inputSequence- putLengthBytes inputSigScript- putList putLengthBytes inputWitness- serialize StoreInput{..} = do- putWord8 0x01- serialize inputPoint- putWord32be inputSequence- putLengthBytes inputSigScript- putLengthBytes inputPkScript- putWord64be inputAmount- putList putLengthBytes inputWitness- putMaybe serialize inputAddress-- deserialize =- getWord8 >>= \case- 0x00 -> do- inputPoint <- deserialize- inputSequence <- getWord32be- inputSigScript <- getLengthBytes- inputWitness <- getList getLengthBytes- return StoreCoinbase{..}- 0x01 -> do- inputPoint <- deserialize- inputSequence <- getWord32be- inputSigScript <- getLengthBytes- inputPkScript <- getLengthBytes- inputAmount <- getWord64be- inputWitness <- getList getLengthBytes- inputAddress <- getMaybe deserialize- return StoreInput{..}- x -> fail $ "Unknown input id: " <> cs (show x)--instance Serialize StoreInput where- put = serialize- get = deserialize--instance Binary StoreInput where- put = serialize- get = deserialize--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- , inputAddress = a- } =- A.object- [ "coinbase" .= False- , "txid" .= oph- , "output" .= opi- , "sigscript" .= String (encodeHex ss)- , "sequence" .= sq- , "pkscript" .= String (encodeHex ps)- , "value" .= val- , "address" .= (addrToJSON net <$> a)- , "witness" .= map encodeHex wit- ]-storeInputToJSON- _- StoreCoinbase- { inputPoint = OutPoint oph opi- , inputSequence = sq- , inputSigScript = ss- , inputWitness = wit- } =- A.object- [ "coinbase" .= True- , "txid" .= oph- , "output" .= opi- , "sigscript" .= String (encodeHex ss)- , "sequence" .= sq- , "pkscript" .= Null- , "value" .= Null- , "address" .= Null- , "witness" .= map encodeHex wit- ]--storeInputToEncoding :: Network -> StoreInput -> Encoding-storeInputToEncoding- net- StoreInput- { inputPoint = OutPoint oph opi- , inputSequence = sq- , inputSigScript = ss- , inputPkScript = ps- , inputAmount = val- , inputWitness = wit- , inputAddress = a- } =- AE.pairs $- "coinbase" .= False- <> "txid" .= oph- <> "output" .= opi- <> "sigscript" `AE.pair` AE.text (encodeHex ss)- <> "sequence" .= sq- <> "pkscript" `AE.pair` AE.text (encodeHex ps)- <> "value" .= val- <> "address" `AE.pair` maybe AE.null_ (addrToEncoding net) a- <> "witness" .= map encodeHex wit-storeInputToEncoding- _- StoreCoinbase- { inputPoint = OutPoint oph opi- , inputSequence = sq- , inputSigScript = ss- , inputWitness = wit- } =- AE.pairs $- "coinbase" .= True- <> "txid" `AE.pair` AE.text (txHashToHex oph)- <> "output" .= opi- <> "sigscript" `AE.pair` AE.text (encodeHex ss)- <> "sequence" .= sq- <> "pkscript" `AE.pair` AE.null_- <> "value" `AE.pair` AE.null_- <> "address" `AE.pair` AE.null_- <> "witness" .= map encodeHex wit--storeInputParseJSON :: Network -> Value -> Parser StoreInput-storeInputParseJSON net =- A.withObject "storeinput" $ \o -> do- coinbase <- o .: "coinbase"- outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"- sequ <- o .: "sequence"- witness <- mapM jsonHex =<< o .:? "witness" .!= []- 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"- addr <-- o .: "address" >>= \case- Nothing -> return Nothing- Just a -> Just <$> addrFromJSON net a <|> return Nothing- return- StoreInput- { inputPoint = outpoint- , inputSequence = sequ- , inputSigScript = sigscript- , inputPkScript = pkscript- , inputAmount = value- , inputWitness = witness- , inputAddress = addr- }--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- { -- | input transaction hash- spenderHash :: !TxHash- , -- | input position in transaction- spenderIndex :: !Word32- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)--instance Serial Spender where- serialize Spender{..} = do- serialize spenderHash- putWord32be spenderIndex- deserialize = Spender <$> deserialize <*> getWord32be--instance Serialize Spender where- put = serialize- get = deserialize--instance Binary Spender where- put = serialize- get = deserialize--instance ToJSON Spender where- toJSON n =- A.object- [ "txid" .= txHashToHex (spenderHash n)- , "input" .= spenderIndex n- ]- toEncoding n =- AE.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)- , outputAddr :: !(Maybe Address)- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)--instance Serial StoreOutput where- serialize StoreOutput{..} = do- putWord64be outputAmount- putLengthBytes outputScript- putMaybe serialize outputSpender- putMaybe serialize outputAddr- deserialize = do- outputAmount <- getWord64be- outputScript <- getLengthBytes- outputSpender <- getMaybe deserialize- outputAddr <- getMaybe deserialize- return StoreOutput{..}--instance Serialize StoreOutput where- put = serialize- get = deserialize--instance Binary StoreOutput where- put = serialize- get = deserialize--storeOutputToJSON :: Network -> StoreOutput -> Value-storeOutputToJSON net d =- A.object- [ "address" .= (addrToJSON net <$> outputAddr d)- , "pkscript" .= encodeHex (outputScript d)- , "value" .= outputAmount d- , "spent" .= isJust (outputSpender d)- , "spender" .= outputSpender d- ]--storeOutputToEncoding :: Network -> StoreOutput -> Encoding-storeOutputToEncoding net d =- AE.pairs $- "address" `AE.pair` maybe AE.null_ (addrToEncoding net) (outputAddr d)- <> "pkscript" `AE.pair` AE.text (encodeHex (outputScript d))- <> "value" .= outputAmount d- <> "spent" .= isJust (outputSpender d)- <> "spender" .= outputSpender d--storeOutputParseJSON :: Network -> Value -> Parser StoreOutput-storeOutputParseJSON net =- A.withObject "storeoutput" $ \o -> do- value <- o .: "value"- pkscript <- o .: "pkscript" >>= jsonHex- spender <- o .: "spender"- addr <-- o .: "address" >>= \case- Nothing -> return Nothing- Just a -> Just <$> addrFromJSON net a <|> return Nothing- return- StoreOutput- { outputAmount = value- , outputScript = pkscript- , outputSpender = spender- , outputAddr = addr- }--data Prev = Prev- { prevScript :: !ByteString- , prevAmount :: !Word64- }- deriving (Show, Eq, Ord, Generic, Hashable, NFData)--instance Serial Prev where- serialize Prev{..} = do- putLengthBytes prevScript- putWord64be prevAmount- deserialize = do- prevScript <- getLengthBytes- prevAmount <- getWord64be- return Prev{..}--instance Binary Prev where- put = serialize- get = deserialize--instance Serialize Prev where- put = serialize- get = deserialize--toInput :: TxIn -> Maybe Prev -> 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- , inputAddress = eitherToMaybe (scriptToAddressBS (prevScript p))- }--toOutput :: TxOut -> Maybe Spender -> StoreOutput-toOutput o s =- StoreOutput- { outputAmount = outValue o- , outputScript = scriptOutput o- , outputSpender = s- , outputAddr = eitherToMaybe (scriptToAddressBS (scriptOutput o))- }--data TxData = TxData- { txDataBlock :: !BlockRef- , txData :: !Tx- , txDataPrevs :: !(IntMap Prev)- , txDataDeleted :: !Bool- , txDataRBF :: !Bool- , txDataTime :: !Word64- }- deriving (Show, Eq, Ord, Generic, NFData)--instance Serial TxData where- serialize TxData{..} = do- serialize txDataBlock- serialize txData- putIntMap (putWord64be . fromIntegral) serialize txDataPrevs- serialize txDataDeleted- serialize txDataRBF- putWord64be txDataTime- deserialize = do- txDataBlock <- deserialize- txData <- deserialize- txDataPrevs <- getIntMap (fromIntegral <$> getWord64be) deserialize- txDataDeleted <- deserialize- txDataRBF <- deserialize- txDataTime <- getWord64be- return TxData{..}--instance Serialize TxData where- put = serialize- get = deserialize--instance Binary TxData where- put = serialize- get = deserialize--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- , transactionId = txid- , transactionSize = txsize- , transactionWeight = txweight- , transactionFees = fees- }- where- txid = txHash (txData t)- txsize = fromIntegral $ BS.length (runPutS (serialize (txData t)))- txweight =- let b = BS.length $ runPutS $ serialize (txData t){txWitness = []}- x = BS.length $ runPutS $ serialize (txData t)- in fromIntegral $ b * 3 + x- inv = sum (map inputAmount ins)- outv = sum (map outputAmount outs)- fees = if any isCoinbase ins then 0 else inv - outv- ws = take (length (txIn (txData t))) $ txWitness (txData t) <> repeat []- f n i = toInput i (IntMap.lookup n (txDataPrevs t)) (ws !! n)- ins = zipWith f [0 ..] (txIn (txData t))- g n o = toOutput o (IntMap.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 = IntMap.fromList . catMaybes $ zipWith f [0 ..] (transactionInputs t)- g _ StoreOutput{outputSpender = Nothing} = Nothing- g n StoreOutput{outputSpender = Just s} = Just (n, s)- sm = IntMap.fromList . catMaybes $ zipWith g [0 ..] (transactionOutputs t)---- | Detailed transaction information.-data Transaction = Transaction- { -- | block information for this transaction- transactionBlock :: !BlockRef- , -- | transaction version- transactionVersion :: !Word32- , -- | lock time- transactionLockTime :: !Word32- , -- | transaction inputs- transactionInputs :: ![StoreInput]- , -- | transaction outputs- transactionOutputs :: ![StoreOutput]- , -- | this transaction has been deleted and is no longer valid- transactionDeleted :: !Bool- , -- | this transaction can be replaced in the mempool- transactionRBF :: !Bool- , -- | time the transaction was first seen or time of block- transactionTime :: !Word64- , -- | transaction id- transactionId :: !TxHash- , -- | serialized transaction size (includes witness data)- transactionSize :: !Word32- , -- | transaction weight- transactionWeight :: !Word32- , -- | fees that this transaction pays (0 for coinbase)- transactionFees :: !Word64- }- deriving (Show, Eq, Ord, Generic, Hashable, NFData)--instance Serial Transaction where- serialize Transaction{..} = do- serialize transactionBlock- putWord32be transactionVersion- putWord32be transactionLockTime- putList serialize transactionInputs- putList serialize transactionOutputs- serialize transactionDeleted- serialize transactionRBF- putWord64be transactionTime- serialize transactionId- putWord32be transactionSize- putWord32be transactionWeight- putWord64be transactionFees- deserialize = do- transactionBlock <- deserialize- transactionVersion <- getWord32be- transactionLockTime <- getWord32be- transactionInputs <- getList deserialize- transactionOutputs <- getList deserialize- transactionDeleted <- deserialize- transactionRBF <- deserialize- transactionTime <- getWord64be- transactionId <- deserialize- transactionSize <- getWord32be- transactionWeight <- getWord32be- transactionFees <- getWord64be- return Transaction{..}--instance Serialize Transaction where- put = serialize- get = deserialize--instance Binary Transaction where- put = serialize- get = deserialize--transactionData :: Transaction -> Tx-transactionData t =- Tx- { txVersion = transactionVersion t- , txIn = map i (transactionInputs t)- , txOut = map o (transactionOutputs t)- , txWitness = w $ map 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}- w xs- | all null xs = []- | otherwise = xs--transactionToJSON :: Network -> Transaction -> Value-transactionToJSON net dtx =- A.object- [ "txid" .= transactionId dtx- , "size" .= transactionSize dtx- , "version" .= transactionVersion dtx- , "locktime" .= transactionLockTime dtx- , "fee" .= transactionFees dtx- , "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" .= transactionWeight dtx- ]--transactionToEncoding :: Network -> Transaction -> Encoding-transactionToEncoding net dtx =- AE.pairs $- "txid" .= transactionId dtx- <> "size" .= transactionSize dtx- <> "version" .= transactionVersion dtx- <> "locktime" .= transactionLockTime dtx- <> "fee" .= transactionFees dtx- <> "inputs"- `AE.pair` AE.list- (storeInputToEncoding net)- (transactionInputs dtx)- <> "outputs"- `AE.pair` AE.list- (storeOutputToEncoding net)- (transactionOutputs dtx)- <> "block" .= transactionBlock dtx- <> "deleted" .= transactionDeleted dtx- <> "time" .= transactionTime dtx- <> "rbf" .= transactionRBF dtx- <> "weight" .= transactionWeight dtx--transactionParseJSON :: Network -> Value -> Parser Transaction-transactionParseJSON net = A.withObject "transaction" $ \o -> do- version <- o .: "version"- locktime <- o .: "locktime"- inputs <- o .: "inputs" >>= mapM (storeInputParseJSON net)- outputs <- o .: "outputs" >>= mapM (storeOutputParseJSON net)- block <- o .: "block"- deleted <- o .: "deleted"- time <- o .: "time"- rbf <- o .:? "rbf" .!= False- weight <- o .:? "weight" .!= 0- size <- o .: "size"- txid <- o .: "txid"- fees <- o .: "fee"- return- Transaction- { transactionBlock = block- , transactionVersion = version- , transactionLockTime = locktime- , transactionInputs = inputs- , transactionOutputs = outputs- , transactionDeleted = deleted- , transactionTime = time- , transactionRBF = rbf- , transactionWeight = weight- , transactionSize = size- , transactionId = txid- , transactionFees = fees- }---- | Information about a connected peer.-data PeerInformation = PeerInformation- { -- | user agent string- peerUserAgent :: !ByteString- , -- | network address- peerAddress :: !String- , -- | version number- peerVersion :: !Word32- , -- | services field- peerServices :: !Word64- , -- | will relay transactions- peerRelay :: !Bool- }- deriving (Show, Eq, Ord, Generic, NFData)--instance Serial PeerInformation where- serialize PeerInformation{..} = do- putLengthBytes peerUserAgent- putLengthBytes (TE.encodeUtf8 (T.pack peerAddress))- putWord32be peerVersion- putWord64be peerServices- serialize peerRelay- deserialize = do- peerUserAgent <- getLengthBytes- peerAddress <- T.unpack . TE.decodeUtf8 <$> getLengthBytes- peerVersion <- getWord32be- peerServices <- getWord64be- peerRelay <- deserialize- return PeerInformation{..}--instance Serialize PeerInformation where- put = serialize- get = deserialize--instance Binary PeerInformation where- put = serialize- get = deserialize--instance ToJSON PeerInformation where- toJSON p =- A.object- [ "useragent" .= String (cs (peerUserAgent p))- , "address" .= peerAddress p- , "version" .= peerVersion p- , "services"- .= String (encodeHex (runPutS (serialize (peerServices p))))- , "relay" .= peerRelay p- ]- toEncoding p =- AE.pairs $- "useragent" `AE.pair` AE.text (cs (peerUserAgent p))- <> "address" .= peerAddress p- <> "version" .= peerVersion p- <> "services"- `AE.pair` AE.text- (encodeHex (runPutS (serialize (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 runGetS deserialize 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, NFData)--instance Serial XPubBal where- serialize XPubBal{..} = do- putList putWord32be xPubBalPath- serialize xPubBal- deserialize = do- xPubBalPath <- getList getWord32be- xPubBal <- deserialize- return XPubBal{..}--instance Serialize XPubBal where- put = serialize- get = deserialize--instance Binary XPubBal where- put = serialize- get = deserialize--xPubBalToJSON :: Network -> XPubBal -> Value-xPubBalToJSON net XPubBal{xPubBalPath = p, xPubBal = b} =- A.object ["path" .= p, "balance" .= balanceToJSON net b]--xPubBalToEncoding :: Network -> XPubBal -> Encoding-xPubBalToEncoding net XPubBal{xPubBalPath = p, xPubBal = b} =- AE.pairs ("path" .= p <> "balance" `AE.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- { xPubUnspent :: !Unspent- , xPubUnspentPath :: ![KeyIndex]- }- deriving (Show, Eq, Ord, Generic, NFData)--instance Serial XPubUnspent where- serialize XPubUnspent{..} = do- putList putWord32be xPubUnspentPath- serialize xPubUnspent- deserialize = do- xPubUnspentPath <- getList getWord32be- xPubUnspent <- deserialize- return XPubUnspent{..}--instance Serialize XPubUnspent where- put = serialize- get = deserialize--instance Binary XPubUnspent where- put = serialize- get = deserialize--xPubUnspentToJSON :: Network -> XPubUnspent -> Value-xPubUnspentToJSON net XPubUnspent{xPubUnspentPath = p, xPubUnspent = u} =- A.object ["unspent" .= unspentToJSON net u, "path" .= p]--xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding-xPubUnspentToEncoding net XPubUnspent{xPubUnspentPath = p, xPubUnspent = u} =- AE.pairs $ "unspent" `AE.pair` unspentToEncoding net u <> "path" .= p--xPubUnspentParseJSON :: Network -> Value -> Parser XPubUnspent-xPubUnspentParseJSON net =- A.withObject "xpubunspent" $ \o -> do- u <- o .: "unspent" >>= unspentParseJSON net- p <- o .: "path"- 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, NFData)--instance Serial XPubSummary where- serialize XPubSummary{..} = do- putWord64be xPubSummaryConfirmed- putWord64be xPubSummaryZero- putWord64be xPubSummaryReceived- putWord64be xPubUnspentCount- putWord32be xPubExternalIndex- putWord32be xPubChangeIndex- deserialize = do- xPubSummaryConfirmed <- getWord64be- xPubSummaryZero <- getWord64be- xPubSummaryReceived <- getWord64be- xPubUnspentCount <- getWord64be- xPubExternalIndex <- getWord32be- xPubChangeIndex <- getWord32be- return XPubSummary{..}--instance Binary XPubSummary where- put = serialize- get = deserialize--instance Serialize XPubSummary where- put = serialize- get = deserialize--instance ToJSON XPubSummary where- toJSON- XPubSummary- { xPubSummaryConfirmed = c- , xPubSummaryZero = z- , xPubSummaryReceived = r- , xPubUnspentCount = u- , xPubExternalIndex = ext- , xPubChangeIndex = ch- } =- A.object- [ "balance"- .= A.object- [ "confirmed" .= c- , "unconfirmed" .= z- , "received" .= r- , "utxo" .= u- ]- , "indices"- .= A.object- [ "change" .= ch- , "external" .= ext- ]- ]- toEncoding- XPubSummary- { xPubSummaryConfirmed = c- , xPubSummaryZero = z- , xPubSummaryReceived = r- , xPubUnspentCount = u- , xPubExternalIndex = ext- , xPubChangeIndex = ch- } =- AE.pairs $- "balance"- `AE.pair` AE.pairs- ( "confirmed" .= c- <> "unconfirmed" .= z- <> "received" .= r- <> "utxo" .= u- )- <> "indices"- `AE.pair` AE.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- }--class Healthy a where- isOK :: a -> Bool--data BlockHealth = BlockHealth- { blockHealthHeaders :: !BlockHeight- , blockHealthBlocks :: !BlockHeight- , blockHealthMaxDiff :: !Int32- }- deriving (Show, Eq, Generic, NFData)--instance Serial BlockHealth where- serialize h@BlockHealth{..} = do- serialize (isOK h)- putWord32be blockHealthHeaders- putWord32be blockHealthBlocks- putInt32be blockHealthMaxDiff- deserialize = do- k <- deserialize- blockHealthHeaders <- getWord32be- blockHealthBlocks <- getWord32be- blockHealthMaxDiff <- getInt32be- let h = BlockHealth{..}- unless (k == isOK h) $ fail "Inconsistent health check"- return h--instance Serialize BlockHealth where- put = serialize- get = deserialize--instance Binary BlockHealth where- put = serialize- get = deserialize--instance Healthy BlockHealth where- isOK BlockHealth{..} =- h - b <= blockHealthMaxDiff- where- h = fromIntegral blockHealthHeaders- b = fromIntegral blockHealthBlocks--instance ToJSON BlockHealth where- toJSON h@BlockHealth{..} =- A.object- [ "headers" .= blockHealthHeaders- , "blocks" .= blockHealthBlocks- , "diff" .= diff- , "max" .= blockHealthMaxDiff- , "ok" .= isOK h- ]- where- diff = toInteger blockHealthHeaders - toInteger 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 :: !Int64- , timeHealthMax :: !Int64- }- deriving (Show, Eq, Generic, NFData)--instance Serial TimeHealth where- serialize h@TimeHealth{..} = do- serialize (isOK h)- putInt64be timeHealthAge- putInt64be timeHealthMax- deserialize = do- k <- deserialize- timeHealthAge <- getInt64be- timeHealthMax <- getInt64be- let t = TimeHealth{..}- unless (k == isOK t) $ fail "Inconsistent health check"- return t--instance Binary TimeHealth where- put = serialize- get = deserialize--instance Serialize TimeHealth where- put = serialize- get = deserialize--instance Healthy TimeHealth where- isOK TimeHealth{..} =- timeHealthAge <= timeHealthMax--instance ToJSON TimeHealth where- toJSON h@TimeHealth{..} =- A.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 :: !Int64- , countHealthMin :: !Int64- }- deriving (Show, Eq, Generic, NFData)--instance Serial CountHealth where- serialize h@CountHealth{..} = do- serialize (isOK h)- putInt64be countHealthNum- putInt64be countHealthMin- deserialize = do- k <- deserialize- countHealthNum <- getInt64be- countHealthMin <- getInt64be- let c = CountHealth{..}- unless (k == isOK c) $ fail "Inconsistent health check"- return c--instance Serialize CountHealth where- put = serialize- get = deserialize--instance Binary CountHealth where- put = serialize- get = deserialize--instance Healthy CountHealth where- isOK CountHealth{..} =- countHealthMin <= countHealthNum--instance ToJSON CountHealth where- toJSON h@CountHealth{..} =- A.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 MaxHealth = MaxHealth- { maxHealthNum :: !Int64- , maxHealthMax :: !Int64- }- deriving (Show, Eq, Generic, NFData)--instance Serial MaxHealth where- serialize h@MaxHealth{..} = do- serialize $ isOK h- putInt64be maxHealthNum- putInt64be maxHealthMax- deserialize = do- k <- deserialize- maxHealthNum <- getInt64be- maxHealthMax <- getInt64be- let h = MaxHealth{..}- unless (k == isOK h) $ fail "Inconsistent health check"- return h--instance Binary MaxHealth where- put = serialize- get = deserialize--instance Serialize MaxHealth where- put = serialize- get = deserialize--instance Healthy MaxHealth where- isOK MaxHealth{..} = maxHealthNum <= maxHealthMax--instance ToJSON MaxHealth where- toJSON h@MaxHealth{..} =- A.object- [ "count" .= maxHealthNum- , "max" .= maxHealthMax- , "ok" .= isOK h- ]--instance FromJSON MaxHealth where- parseJSON =- A.withObject "MaxHealth" $ \o -> do- maxHealthNum <- o .: "count"- maxHealthMax <- o .: "max"- return MaxHealth{..}--data HealthCheck = HealthCheck- { healthBlocks :: !BlockHealth- , healthLastBlock :: !TimeHealth- , healthLastTx :: !TimeHealth- , healthPendingTxs :: !MaxHealth- , healthPeers :: !CountHealth- , healthNetwork :: !String- , healthVersion :: !String- }- deriving (Show, Eq, Generic, NFData)--instance Serial HealthCheck where- serialize h@HealthCheck{..} = do- serialize (isOK h)- serialize healthBlocks- serialize healthLastBlock- serialize healthLastTx- serialize healthPendingTxs- serialize healthPeers- putLengthBytes ((TE.encodeUtf8 . T.pack) healthNetwork)- putLengthBytes ((TE.encodeUtf8 . T.pack) healthVersion)- deserialize = do- k <- deserialize- healthBlocks <- deserialize- healthLastBlock <- deserialize- healthLastTx <- deserialize- healthPendingTxs <- deserialize- healthPeers <- deserialize- healthNetwork <- T.unpack . TE.decodeUtf8 <$> getLengthBytes- healthVersion <- T.unpack . TE.decodeUtf8 <$> getLengthBytes- let h = HealthCheck{..}- unless (k == isOK h) $ fail "Inconsistent health check"- return h--instance Binary HealthCheck where- put = serialize- get = deserialize--instance Serialize HealthCheck where- put = serialize- get = deserialize--instance Healthy HealthCheck where- isOK HealthCheck{..} =- isOK healthBlocks- && isOK healthLastBlock- && isOK healthLastTx- && isOK healthPendingTxs- && isOK healthPeers--instance ToJSON HealthCheck where- toJSON h@HealthCheck{..} =- A.object- [ "blocks" .= healthBlocks- , "last-block" .= healthLastBlock- , "last-tx" .= healthLastTx- , "pending-txs" .= healthPendingTxs- , "peers" .= healthPeers- , "net" .= healthNetwork- , "version" .= healthVersion- , "ok" .= isOK h- ]--instance FromJSON HealthCheck where- parseJSON =- A.withObject "HealthCheck" $ \o -> do- healthBlocks <- o .: "blocks"- healthLastBlock <- o .: "last-block"- healthLastTx <- o .: "last-tx"- healthPendingTxs <- o .: "pending-txs"- healthPeers <- o .: "peers"- healthNetwork <- o .: "net"- healthVersion <- o .: "version"- return HealthCheck{..}--data Event- = EventBlock !BlockHash- | EventTx !TxHash- deriving (Show, Eq, Generic, NFData)--instance Serial Event where- serialize (EventBlock bh) = putWord8 0x00 >> serialize bh- serialize (EventTx th) = putWord8 0x01 >> serialize th- deserialize =- getWord8 >>= \case- 0x00 -> EventBlock <$> deserialize- 0x01 -> EventTx <$> deserialize- _ -> fail "Not an Event"--instance Serialize Event where- put = serialize- get = deserialize--instance Binary Event where- put = serialize- get = deserialize--instance ToJSON Event where- toJSON (EventTx h) =- A.object- [ "type" .= String "tx"- , "id" .= h- ]- toJSON (EventBlock h) =- A.object- [ "type" .= String "block"- , "id" .= h- ]- toEncoding (EventTx h) =- AE.pairs $- "type" `AE.pair` AE.text "tx"- <> "id" `AE.pair` AE.text (txHashToHex h)- toEncoding (EventBlock h) =- AE.pairs $- "type" `AE.pair` AE.text "block"- <> "id" `AE.pair` AE.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, NFData)--instance Serial a => Serial (GenericResult a) where- serialize (GenericResult x) = serialize x- deserialize = GenericResult <$> deserialize--instance Serial a => Serialize (GenericResult a) where- put = serialize- get = deserialize--instance Serial a => Binary (GenericResult a) where- put = serialize- get = deserialize--instance ToJSON a => ToJSON (GenericResult a) where- toJSON (GenericResult b) = A.object ["result" .= b]- toEncoding (GenericResult b) = AE.pairs ("result" .= b)--instance FromJSON a => FromJSON (GenericResult a) where- parseJSON =- A.withObject "GenericResult" $ \o ->- GenericResult <$> o .: "result"--newtype RawResult a = RawResult- { getRawResult :: a- }- deriving (Show, Eq, Generic, NFData)--instance Serial a => Serial (RawResult a) where- serialize (RawResult x) = serialize x- deserialize = RawResult <$> deserialize--instance Serial a => Serialize (RawResult a) where- put = serialize- get = deserialize--instance Serial a => Binary (RawResult a) where- put = serialize- get = deserialize--instance Serial a => ToJSON (RawResult a) where- toJSON (RawResult b) =- A.object ["result" .= x b]- where- x =- TLE.decodeUtf8- . BSB.toLazyByteString- . BSB.lazyByteStringHex- . runPutL- . serialize- toEncoding (RawResult b) =- AE.pairs $ "result" `AE.pair` AE.unsafeToEncoding str- where- str =- BSB.char7 '"'- <> BSB.lazyByteStringHex (runPutL (serialize b))- <> BSB.char7 '"'--instance Serial a => FromJSON (RawResult a) where- parseJSON =- A.withObject "RawResult" $ \o -> do- res <- o .: "result"- let m =- eitherToMaybe . Bytes.Get.runGetS deserialize- =<< decodeHex res- maybe mzero (return . RawResult) m--newtype SerialList a = SerialList {getSerialList :: [a]}- deriving (Show, Eq, Generic, NFData)--instance Semigroup (SerialList a) where- SerialList a <> SerialList b = SerialList (a <> b)--instance Monoid (SerialList a) where- mempty = SerialList mempty--instance Serial a => Serial (SerialList a) where- serialize (SerialList ls) = putList serialize ls- deserialize = SerialList <$> getList deserialize--instance ToJSON a => ToJSON (SerialList a) where- toJSON (SerialList ls) = toJSON ls- toEncoding (SerialList ls) = toEncoding ls--instance FromJSON a => FromJSON (SerialList a) where- parseJSON = fmap SerialList . parseJSON--newtype RawResultList a = RawResultList- { getRawResultList :: [a]- }- deriving (Show, Eq, Generic, NFData)--instance Serial a => Serial (RawResultList a) where- serialize (RawResultList xs) =- mapM_ serialize xs- deserialize = RawResultList <$> go- where- go =- isEmpty >>= \case- True -> return []- False -> (:) <$> deserialize <*> go--instance Serial a => Serialize (RawResultList a) where- put = serialize- get = deserialize--instance Serial a => Binary (RawResultList a) where- put = serialize- get = deserialize--instance Semigroup (RawResultList a) where- (RawResultList a) <> (RawResultList b) = RawResultList $ a <> b--instance Monoid (RawResultList a) where- mempty = RawResultList mempty--instance Serial a => ToJSON (RawResultList a) where- toJSON (RawResultList xs) =- toJSON $- TLE.decodeUtf8- . BSB.toLazyByteString- . BSB.lazyByteStringHex- . runPutL- . serialize- <$> xs- toEncoding (RawResultList xs) =- AE.list (AE.unsafeToEncoding . str) xs- where- str x =- BSB.char7 '"'- <> BSB.lazyByteStringHex (runPutL (serialize x))- <> BSB.char7 '"'--instance Serial a => FromJSON (RawResultList a) where- parseJSON =- A.withArray "RawResultList" $ \vec ->- RawResultList <$> mapM parseElem (toList vec)- where- parseElem = A.withText "RawResultListElem" $ maybe mzero return . f- f = eitherToMaybe . Bytes.Get.runGetS deserialize <=< decodeHex--newtype TxId- = TxId TxHash- deriving (Show, Eq, Generic, NFData)--instance Serial TxId where- serialize (TxId h) = serialize h- deserialize = TxId <$> deserialize--instance Serialize TxId where- put = serialize- get = deserialize--instance Binary TxId where- put = serialize- get = deserialize--instance ToJSON TxId where- toJSON (TxId h) = A.object ["txid" .= h]- toEncoding (TxId h) = AE.pairs ("txid" `AE.pair` AE.text (txHashToHex h))--instance FromJSON TxId where- parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid"--data Except- = ThingNotFound- | ServerError- | BadRequest- | UserError !String- | StringError !String- | TxIndexConflict ![TxHash]- | ServerTimeout- | RequestTooLarge- deriving (Show, Eq, Ord, Generic, NFData)--instance Exception Except--instance ScottyError Except where- stringError = StringError- showError = TL.pack . show--instance ToJSON Except where- toJSON e =- A.object $- case e of- ThingNotFound ->- [ "error" .= String "not-found-or-invalid-arg"- , "message" .= String "Item not found or argument invalid"- ]- ServerError ->- [ "error" .= String "server-error"- , "message" .= String "Server error"- ]- BadRequest ->- [ "error" .= String "bad-request"- , "message" .= String "Invalid request"- ]- UserError msg' ->- [ "error" .= String "user-error"- , "message" .= String (cs msg')- ]- StringError msg' ->- [ "error" .= String "string-error"- , "message" .= String (cs msg')- ]- TxIndexConflict txids ->- [ "error" .= String "multiple-tx-index"- , "message" .= String "Multiple txs match that index"- , "txids" .= txids- ]- ServerTimeout ->- [ "error" .= String "server-timeout"- , "message" .= String "Request is taking too long"- ]- RequestTooLarge ->- [ "error" .= String "request-too-large"- , "message" .= String "Request body too large"- ]--instance FromJSON Except where- parseJSON =- A.withObject "Except" $ \o -> do- ctr <- o .: "error"- msg' <- o .:? "message" .!= ""- case ctr of- String "not-found-or-invalid-arg" ->- return ThingNotFound- String "server-error" ->- return ServerError- String "bad-request" ->- return BadRequest- String "user-error" ->- return $ UserError msg'- String "string-error" ->- return $ StringError msg'- String "multiple-tx-index" -> do- txids <- o .: "txids"- return $ TxIndexConflict txids- String "server-timeout" ->- return ServerTimeout- String "request-too-large" ->- return RequestTooLarge- _ -> mzero--toIntTxId :: TxHash -> Word64-toIntTxId h =- let bs = runPutS (serialize h)- Right w64 = runGetS getWord64be bs- in w64 `shift` (-11)-------------------------------------------- Blockchain.info API Compatibility --------------------------------------------data BinfoBlockId- = BinfoBlockHash !BlockHash- | BinfoBlockIndex !Word32- deriving (Eq, Show, Read, Generic, NFData)--instance Parsable BinfoBlockId where- parseParam t =- hex <> igr- where- hex = case hexToBlockHash (TL.toStrict t) of- Nothing -> Left "could not decode txid"- Just h -> Right $ BinfoBlockHash h- igr = BinfoBlockIndex <$> parseParam t--data BinfoTxId- = BinfoTxIdHash !TxHash- | BinfoTxIdIndex !Word64- deriving (Eq, Show, Read, Generic, NFData)--encodeBinfoTxId :: Bool -> TxHash -> BinfoTxId-encodeBinfoTxId False = BinfoTxIdHash-encodeBinfoTxId True = BinfoTxIdIndex . toIntTxId--instance Parsable BinfoTxId where- parseParam t =- hex <> igr- where- hex =- case hexToTxHash (TL.toStrict t) of- Nothing -> Left "could not decode txid"- Just h -> Right $ BinfoTxIdHash h- igr = BinfoTxIdIndex <$> parseParam t--instance ToJSON BinfoTxId where- toJSON (BinfoTxIdHash h) = toJSON h- toJSON (BinfoTxIdIndex i) = toJSON i- toEncoding (BinfoTxIdHash h) = toEncoding h- toEncoding (BinfoTxIdIndex i) = toEncoding i--instance FromJSON BinfoTxId where- parseJSON v =- BinfoTxIdHash <$> parseJSON v- <|> BinfoTxIdIndex <$> parseJSON v--data BinfoFilter- = BinfoFilterAll- | BinfoFilterSent- | BinfoFilterReceived- | BinfoFilterMoved- | BinfoFilterConfirmed- | BinfoFilterMempool- deriving (Eq, Show, Generic, NFData)--instance Parsable BinfoFilter where- parseParam t =- parseParam t >>= \case- (0 :: Int) -> return BinfoFilterAll- 1 -> return BinfoFilterSent- 2 -> return BinfoFilterReceived- 3 -> return BinfoFilterMoved- 5 -> return BinfoFilterConfirmed- 6 -> return BinfoFilterAll- 7 -> return BinfoFilterMempool- _ -> Left "could not parse filter parameter"--data BinfoMultiAddr = BinfoMultiAddr- { getBinfoMultiAddrAddresses :: ![BinfoBalance]- , getBinfoMultiAddrWallet :: !BinfoWallet- , getBinfoMultiAddrTxs :: ![BinfoTx]- , getBinfoMultiAddrInfo :: !BinfoInfo- , getBinfoMultiAddrRecommendFee :: !Bool- , getBinfoMultiAddrCashAddr :: !Bool- }- deriving (Eq, Show, Generic, NFData)--binfoMultiAddrToJSON :: Network -> BinfoMultiAddr -> Value-binfoMultiAddrToJSON net' BinfoMultiAddr{..} =- A.object $- [ "addresses" .= map (binfoBalanceToJSON net) getBinfoMultiAddrAddresses- , "wallet" .= getBinfoMultiAddrWallet- , "txs" .= map (binfoTxToJSON net) getBinfoMultiAddrTxs- , "info" .= getBinfoMultiAddrInfo- , "recommend_include_fee" .= getBinfoMultiAddrRecommendFee- ]- ++ ["cash_addr" .= True | getBinfoMultiAddrCashAddr]- where- net = if not getBinfoMultiAddrCashAddr && net' == bch then btc else net'--binfoMultiAddrParseJSON :: Network -> Value -> Parser BinfoMultiAddr-binfoMultiAddrParseJSON net = A.withObject "multiaddr" $ \o -> do- getBinfoMultiAddrAddresses <-- mapM (binfoBalanceParseJSON net) =<< o .: "addresses"- getBinfoMultiAddrWallet <- o .: "wallet"- getBinfoMultiAddrTxs <-- mapM (binfoTxParseJSON net) =<< o .: "txs"- getBinfoMultiAddrInfo <- o .: "info"- getBinfoMultiAddrRecommendFee <- o .: "recommend_include_fee"- getBinfoMultiAddrCashAddr <- o .:? "cash_addr" .!= False- return BinfoMultiAddr{..}--binfoMultiAddrToEncoding :: Network -> BinfoMultiAddr -> Encoding-binfoMultiAddrToEncoding net' BinfoMultiAddr{..} =- AE.pairs- ( "addresses" `AE.pair` as- <> "wallet" .= getBinfoMultiAddrWallet- <> "txs" `AE.pair` ts- <> "info" .= getBinfoMultiAddrInfo- <> "recommend_include_fee" .= getBinfoMultiAddrRecommendFee- <> if getBinfoMultiAddrCashAddr then "cash_addr" .= True else mempty- )- where- as = AE.list (binfoBalanceToEncoding net) getBinfoMultiAddrAddresses- ts = AE.list (binfoTxToEncoding net) getBinfoMultiAddrTxs- net = if not getBinfoMultiAddrCashAddr && net' == bch then btc else net'--data BinfoRawAddr = BinfoRawAddr- { binfoRawAddr :: !BinfoAddr- , binfoRawBalance :: !Word64- , binfoRawTxCount :: !Word64- , binfoRawUnredeemed :: !Word64- , binfoRawReceived :: !Word64- , binfoRawSent :: !Int64- , binfoRawTxs :: ![BinfoTx]- }- deriving (Eq, Show, Generic, NFData)--binfoRawAddrToJSON :: Network -> BinfoRawAddr -> Value-binfoRawAddrToJSON net BinfoRawAddr{..} =- A.object- [ "hash160" .= h160- , "address" .= address- , "n_tx" .= binfoRawTxCount- , "n_unredeemed" .= binfoRawUnredeemed- , "total_received" .= binfoRawReceived- , "total_sent" .= binfoRawSent- , "final_balance" .= binfoRawBalance- , "txs" .= map (binfoTxToJSON net) binfoRawTxs- ]- where- address = case binfoRawAddr of- BinfoAddr a -> addrToJSON net a- BinfoXpub x -> xPubToJSON net x- h160 =- encodeHex . runPutS . serialize- <$> case binfoRawAddr of- BinfoAddr a -> case a of- PubKeyAddress h -> Just h- ScriptAddress h -> Just h- WitnessPubKeyAddress h -> Just h- _ -> Nothing- _ -> Nothing--binfoRawAddrToEncoding :: Network -> BinfoRawAddr -> Encoding-binfoRawAddrToEncoding net BinfoRawAddr{..} =- AE.pairs $- "hash160" .= h160- <> "address" `AE.pair` address- <> "n_tx" .= binfoRawTxCount- <> "n_unredeemed" .= binfoRawUnredeemed- <> "total_received" .= binfoRawReceived- <> "total_sent" .= binfoRawSent- <> "final_balance" .= binfoRawBalance- <> "txs" `AE.pair` AE.list (binfoTxToEncoding net) binfoRawTxs- where- address = case binfoRawAddr of- BinfoAddr a -> addrToEncoding net a- BinfoXpub x -> xPubToEncoding net x- h160 =- encodeHex . runPutS . serialize- <$> case binfoRawAddr of- BinfoAddr a -> case a of- PubKeyAddress h -> Just h- ScriptAddress h -> Just h- WitnessPubKeyAddress h -> Just h- _ -> Nothing- _ -> Nothing--binfoRawAddrParseJSON :: Network -> Value -> Parser BinfoRawAddr-binfoRawAddrParseJSON net = A.withObject "balancetxs" $ \o -> do- addr <- o .: "address"- binfoRawAddr <-- BinfoAddr <$> addrFromJSON net addr- <|> BinfoXpub <$> xPubFromJSON net addr- binfoRawBalance <- o .: "final_balance"- binfoRawUnredeemed <- o .: "n_unredeemed"- binfoRawTxCount <- o .: "n_tx"- binfoRawReceived <- o .: "total_received"- binfoRawSent <- o .: "total_sent"- binfoRawTxs <- mapM (binfoTxParseJSON net) =<< o .: "txs"- return BinfoRawAddr{..}--data BinfoShortBal = BinfoShortBal- { binfoShortBalFinal :: !Word64- , binfoShortBalTxCount :: !Word64- , binfoShortBalReceived :: !Word64- }- deriving (Eq, Show, Read, Generic, NFData)--instance ToJSON BinfoShortBal where- toJSON BinfoShortBal{..} =- A.object- [ "final_balance" .= binfoShortBalFinal- , "n_tx" .= binfoShortBalTxCount- , "total_received" .= binfoShortBalReceived- ]- toEncoding BinfoShortBal{..} =- AE.pairs $- "final_balance" .= binfoShortBalFinal- <> "n_tx" .= binfoShortBalTxCount- <> "total_received" .= binfoShortBalReceived--instance FromJSON BinfoShortBal where- parseJSON = A.withObject "short_balance" $ \o -> do- binfoShortBalFinal <- o .: "final_balance"- binfoShortBalTxCount <- o .: "n_tx"- binfoShortBalReceived <- o .: "total_received"- return BinfoShortBal{..}--data BinfoBalance- = BinfoAddrBalance- { getBinfoAddress :: !Address- , getBinfoAddrTxCount :: !Word64- , getBinfoAddrReceived :: !Word64- , getBinfoAddrSent :: !Word64- , getBinfoAddrBalance :: !Word64- }- | BinfoXPubBalance- { getBinfoXPubKey :: !XPubKey- , getBinfoAddrTxCount :: !Word64- , getBinfoAddrReceived :: !Word64- , getBinfoAddrSent :: !Word64- , getBinfoAddrBalance :: !Word64- , getBinfoXPubAccountIndex :: !Word32- , getBinfoXPubChangeIndex :: !Word32- }- deriving (Eq, Show, Generic, NFData)--binfoBalanceToJSON :: Network -> BinfoBalance -> Value-binfoBalanceToJSON net BinfoAddrBalance{..} =- A.object- [ "address" .= addrToJSON net getBinfoAddress- , "final_balance" .= getBinfoAddrBalance- , "n_tx" .= getBinfoAddrTxCount- , "total_received" .= getBinfoAddrReceived- , "total_sent" .= getBinfoAddrSent- ]-binfoBalanceToJSON net BinfoXPubBalance{..} =- A.object- [ "address" .= xPubToJSON net getBinfoXPubKey- , "change_index" .= getBinfoXPubChangeIndex- , "account_index" .= getBinfoXPubAccountIndex- , "final_balance" .= getBinfoAddrBalance- , "n_tx" .= getBinfoAddrTxCount- , "total_received" .= getBinfoAddrReceived- , "total_sent" .= getBinfoAddrSent- ]--binfoBalanceParseJSON :: Network -> Value -> Parser BinfoBalance-binfoBalanceParseJSON net = A.withObject "address" $ \o -> x o <|> a o- where- x o = do- getBinfoXPubKey <- xPubFromJSON net =<< o .: "address"- getBinfoXPubChangeIndex <- o .: "change_index"- getBinfoXPubAccountIndex <- o .: "account_index"- getBinfoAddrBalance <- o .: "final_balance"- getBinfoAddrTxCount <- o .: "n_tx"- getBinfoAddrReceived <- o .: "total_received"- getBinfoAddrSent <- o .: "total_sent"- return BinfoXPubBalance{..}- a o = do- getBinfoAddress <- addrFromJSON net =<< o .: "address"- getBinfoAddrBalance <- o .: "final_balance"- getBinfoAddrTxCount <- o .: "n_tx"- getBinfoAddrReceived <- o .: "total_received"- getBinfoAddrSent <- o .: "total_sent"- return BinfoAddrBalance{..}--binfoBalanceToEncoding :: Network -> BinfoBalance -> Encoding-binfoBalanceToEncoding net BinfoAddrBalance{..} =- AE.pairs- ( "address" `AE.pair` addrToEncoding net getBinfoAddress- <> "final_balance" .= getBinfoAddrBalance- <> "n_tx" .= getBinfoAddrTxCount- <> "total_received" .= getBinfoAddrReceived- <> "total_sent" .= getBinfoAddrSent- )-binfoBalanceToEncoding net BinfoXPubBalance{..} =- AE.pairs- ( "address" `AE.pair` xPubToEncoding net getBinfoXPubKey- <> "change_index" .= getBinfoXPubChangeIndex- <> "account_index" .= getBinfoXPubAccountIndex- <> "final_balance" .= getBinfoAddrBalance- <> "n_tx" .= getBinfoAddrTxCount- <> "total_received" .= getBinfoAddrReceived- <> "total_sent" .= getBinfoAddrSent- )--data BinfoWallet = BinfoWallet- { getBinfoWalletBalance :: !Word64- , getBinfoWalletTxCount :: !Word64- , getBinfoWalletFilteredCount :: !Word64- , getBinfoWalletTotalReceived :: !Word64- , getBinfoWalletTotalSent :: !Word64- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoWallet where- toJSON BinfoWallet{..} =- A.object- [ "final_balance" .= getBinfoWalletBalance- , "n_tx" .= getBinfoWalletTxCount- , "n_tx_filtered" .= getBinfoWalletFilteredCount- , "total_received" .= getBinfoWalletTotalReceived- , "total_sent" .= getBinfoWalletTotalSent- ]- toEncoding BinfoWallet{..} =- AE.pairs- ( "final_balance" .= getBinfoWalletBalance- <> "n_tx" .= getBinfoWalletTxCount- <> "n_tx_filtered" .= getBinfoWalletFilteredCount- <> "total_received" .= getBinfoWalletTotalReceived- <> "total_sent" .= getBinfoWalletTotalSent- )--instance FromJSON BinfoWallet where- parseJSON = A.withObject "wallet" $ \o -> do- getBinfoWalletBalance <- o .: "final_balance"- getBinfoWalletTxCount <- o .: "n_tx"- getBinfoWalletFilteredCount <- o .: "n_tx_filtered"- getBinfoWalletTotalReceived <- o .: "total_received"- getBinfoWalletTotalSent <- o .: "total_sent"- return BinfoWallet{..}--binfoHexValue :: Word64 -> Text-binfoHexValue w64 =- let bs = BS.dropWhile (== 0x00) (runPutS (serialize w64))- in encodeHex $- if BS.null bs || BS.head bs `testBit` 7- then BS.cons 0x00 bs- else bs--data BinfoUnspent = BinfoUnspent- { getBinfoUnspentHash :: !TxHash- , getBinfoUnspentOutputIndex :: !Word32- , getBinfoUnspentScript :: !ByteString- , getBinfoUnspentValue :: !Word64- , getBinfoUnspentConfirmations :: !Int32- , getBinfoUnspentTxIndex :: !BinfoTxId- , getBinfoUnspentXPub :: !(Maybe BinfoXPubPath)- }- deriving (Eq, Show, Generic, NFData)--binfoUnspentToJSON :: Network -> BinfoUnspent -> Value-binfoUnspentToJSON net BinfoUnspent{..} =- A.object $- [ "tx_hash_big_endian" .= getBinfoUnspentHash- , "tx_hash"- .= encodeHex (runPutS (serialize (getTxHash getBinfoUnspentHash)))- , "tx_output_n" .= getBinfoUnspentOutputIndex- , "script" .= encodeHex getBinfoUnspentScript- , "value" .= getBinfoUnspentValue- , "value_hex" .= binfoHexValue getBinfoUnspentValue- , "confirmations" .= getBinfoUnspentConfirmations- , "tx_index" .= getBinfoUnspentTxIndex- ]- <> [ "xpub" .= binfoXPubPathToJSON net x- | x <- maybeToList getBinfoUnspentXPub- ]--binfoUnspentToEncoding :: Network -> BinfoUnspent -> Encoding-binfoUnspentToEncoding net BinfoUnspent{..} =- AE.pairs $- "tx_hash_big_endian" .= getBinfoUnspentHash- <> "tx_hash"- .= encodeHex (runPutS (serialize (getTxHash getBinfoUnspentHash)))- <> "tx_output_n"- .= getBinfoUnspentOutputIndex- <> "script"- .= encodeHex getBinfoUnspentScript- <> "value"- .= getBinfoUnspentValue- <> "value_hex"- .= binfoHexValue getBinfoUnspentValue- <> "confirmations"- .= getBinfoUnspentConfirmations- <> "tx_index"- .= getBinfoUnspentTxIndex- <> maybe- mempty- (("xpub" `AE.pair`) . binfoXPubPathToEncoding net)- getBinfoUnspentXPub--binfoUnspentParseJSON :: Network -> Value -> Parser BinfoUnspent-binfoUnspentParseJSON net = A.withObject "unspent" $ \o -> do- getBinfoUnspentHash <- o .: "tx_hash_big_endian"- getBinfoUnspentOutputIndex <- o .: "tx_output_n"- getBinfoUnspentScript <- maybe mzero return . decodeHex =<< o .: "script"- getBinfoUnspentValue <- o .: "value"- getBinfoUnspentConfirmations <- o .: "confirmations"- getBinfoUnspentTxIndex <- o .: "tx_index"- getBinfoUnspentXPub <- mapM (binfoXPubPathParseJSON net) =<< o .:? "xpub"- return BinfoUnspent{..}--newtype BinfoUnspents = BinfoUnspents [BinfoUnspent]- deriving (Eq, Show, Generic, NFData)--binfoUnspentsToJSON :: Network -> BinfoUnspents -> Value-binfoUnspentsToJSON net (BinfoUnspents us) =- A.object- [ "notice" .= T.empty- , "unspent_outputs" .= map (binfoUnspentToJSON net) us- ]--binfoUnspentsToEncoding :: Network -> BinfoUnspents -> Encoding-binfoUnspentsToEncoding net (BinfoUnspents us) =- AE.pairs $- "notice" .= T.empty- <> "unspent_outputs" `AE.pair` AE.list (binfoUnspentToEncoding net) us--binfoUnspentsParseJSON :: Network -> Value -> Parser BinfoUnspents-binfoUnspentsParseJSON net = A.withObject "unspents" $ \o -> do- us <- mapM (binfoUnspentParseJSON net) =<< o .: "unspent_outputs"- return (BinfoUnspents us)--binfoBlocksToJSON :: Network -> [BinfoBlock] -> Value-binfoBlocksToJSON net blocks =- A.object ["blocks" .= map (binfoBlockToJSON net) blocks]--binfoBlocksToEncoding :: Network -> [BinfoBlock] -> Encoding-binfoBlocksToEncoding net blocks =- AE.pairs $ "blocks" `AE.pair` AE.list (binfoBlockToEncoding net) blocks--binfoBlocksParseJSON :: Network -> Value -> Parser [BinfoBlock]-binfoBlocksParseJSON net =- A.withObject "blocks" $ \o ->- mapM (binfoBlockParseJSON net) =<< o .: "blocks"--toBinfoBlock :: BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock-toBinfoBlock BlockData{..} txs next_blocks =- BinfoBlock- { getBinfoBlockHash = headerHash blockDataHeader- , getBinfoBlockVer = blockVersion blockDataHeader- , getBinfoPrevBlock = prevBlock blockDataHeader- , getBinfoMerkleRoot = merkleRoot blockDataHeader- , getBinfoBlockTime = blockTimestamp blockDataHeader- , getBinfoBlockBits = blockBits blockDataHeader- , getBinfoNextBlock = next_blocks- , getBinfoBlockFee = blockDataFees- , getBinfoBlockNonce = bhNonce blockDataHeader- , getBinfoBlockTxCount = fromIntegral (length txs)- , getBinfoBlockSize = blockDataSize- , getBinfoBlockIndex = blockDataHeight- , getBinfoBlockMain = blockDataMainChain- , getBinfoBlockHeight = blockDataHeight- , getBinfoBlockWeight = blockDataWeight- , getBinfoBlockTx = txs- }--data BinfoBlock = BinfoBlock- { getBinfoBlockHash :: !BlockHash- , getBinfoBlockVer :: !Word32- , getBinfoPrevBlock :: !BlockHash- , getBinfoMerkleRoot :: !Hash256- , getBinfoBlockTime :: !Word32- , getBinfoBlockBits :: !Word32- , getBinfoNextBlock :: ![BlockHash]- , getBinfoBlockFee :: !Word64- , getBinfoBlockNonce :: !Word32- , getBinfoBlockTxCount :: !Word32- , getBinfoBlockSize :: !Word32- , getBinfoBlockIndex :: !Word32- , getBinfoBlockMain :: !Bool- , getBinfoBlockHeight :: !Word32- , getBinfoBlockWeight :: !Word32- , getBinfoBlockTx :: ![BinfoTx]- }- deriving (Eq, Show, Generic, NFData)--binfoBlockToJSON :: Network -> BinfoBlock -> Value-binfoBlockToJSON net BinfoBlock{..} =- A.object- [ "hash" .= getBinfoBlockHash- , "ver" .= getBinfoBlockVer- , "prev_block" .= getBinfoPrevBlock- , "mrkl_root" .= TxHash getBinfoMerkleRoot- , "time" .= getBinfoBlockTime- , "bits" .= getBinfoBlockBits- , "next_block" .= getBinfoNextBlock- , "fee" .= getBinfoBlockFee- , "nonce" .= getBinfoBlockNonce- , "n_tx" .= getBinfoBlockTxCount- , "size" .= getBinfoBlockSize- , "block_index" .= getBinfoBlockIndex- , "main_chain" .= getBinfoBlockMain- , "height" .= getBinfoBlockHeight- , "weight" .= getBinfoBlockWeight- , "tx" .= map (binfoTxToJSON net) getBinfoBlockTx- ]--binfoBlockToEncoding :: Network -> BinfoBlock -> Encoding-binfoBlockToEncoding net BinfoBlock{..} =- AE.pairs $- "hash" .= getBinfoBlockHash- <> "ver" .= getBinfoBlockVer- <> "prev_block" .= getBinfoPrevBlock- <> "mrkl_root" .= TxHash getBinfoMerkleRoot- <> "time" .= getBinfoBlockTime- <> "bits" .= getBinfoBlockBits- <> "next_block" .= getBinfoNextBlock- <> "fee" .= getBinfoBlockFee- <> "nonce" .= getBinfoBlockNonce- <> "n_tx" .= getBinfoBlockTxCount- <> "size" .= getBinfoBlockSize- <> "block_index" .= getBinfoBlockIndex- <> "main_chain" .= getBinfoBlockMain- <> "height" .= getBinfoBlockHeight- <> "weight" .= getBinfoBlockWeight- <> "tx" `AE.pair` AE.list (binfoTxToEncoding net) getBinfoBlockTx--binfoBlockParseJSON :: Network -> Value -> Parser BinfoBlock-binfoBlockParseJSON net = A.withObject "block" $ \o -> do- getBinfoBlockHash <- o .: "hash"- getBinfoBlockVer <- o .: "ver"- getBinfoPrevBlock <- o .: "prev_block"- getBinfoMerkleRoot <- getTxHash <$> o .: "mrkl_root"- getBinfoBlockTime <- o .: "time"- getBinfoBlockBits <- o .: "bits"- getBinfoNextBlock <- o .: "next_block"- getBinfoBlockFee <- o .: "fee"- getBinfoBlockNonce <- o .: "nonce"- getBinfoBlockTxCount <- o .: "n_tx"- getBinfoBlockSize <- o .: "size"- getBinfoBlockIndex <- o .: "block_index"- getBinfoBlockMain <- o .: "main_chain"- getBinfoBlockHeight <- o .: "height"- getBinfoBlockWeight <- o .: "weight"- getBinfoBlockTx <- o .: "tx" >>= mapM (binfoTxParseJSON net)- return BinfoBlock{..}--data BinfoTx = BinfoTx- { getBinfoTxHash :: !TxHash- , getBinfoTxVer :: !Word32- , getBinfoTxVinSz :: !Word32- , getBinfoTxVoutSz :: !Word32- , getBinfoTxSize :: !Word32- , getBinfoTxWeight :: !Word32- , getBinfoTxFee :: !Word64- , getBinfoTxRelayedBy :: !ByteString- , getBinfoTxLockTime :: !Word32- , getBinfoTxIndex :: !BinfoTxId- , getBinfoTxDoubleSpend :: !Bool- , getBinfoTxRBF :: !Bool- , getBinfoTxResultBal :: !(Maybe (Int64, Int64))- , getBinfoTxTime :: !Word64- , getBinfoTxBlockIndex :: !(Maybe Word32)- , getBinfoTxBlockHeight :: !(Maybe Word32)- , getBinfoTxInputs :: [BinfoTxInput]- , getBinfoTxOutputs :: [BinfoTxOutput]- }- deriving (Eq, Show, Generic, NFData)--binfoTxToJSON :: Network -> BinfoTx -> Value-binfoTxToJSON net BinfoTx{..} =- A.object $- [ "hash" .= getBinfoTxHash- , "ver" .= getBinfoTxVer- , "vin_sz" .= getBinfoTxVinSz- , "vout_sz" .= getBinfoTxVoutSz- , "size" .= getBinfoTxSize- , "weight" .= getBinfoTxWeight- , "fee" .= getBinfoTxFee- , "relayed_by" .= TE.decodeUtf8 getBinfoTxRelayedBy- , "lock_time" .= getBinfoTxLockTime- , "tx_index" .= getBinfoTxIndex- , "double_spend" .= getBinfoTxDoubleSpend- , "time" .= getBinfoTxTime- , "block_index" .= getBinfoTxBlockIndex- , "block_height" .= getBinfoTxBlockHeight- , "inputs" .= map (binfoTxInputToJSON net) getBinfoTxInputs- , "out" .= map (binfoTxOutputToJSON net) getBinfoTxOutputs- ]- ++ bal- ++ rbf- where- bal =- case getBinfoTxResultBal of- Nothing -> []- Just (res, bal') -> ["result" .= res, "balance" .= bal']- rbf = ["rbf" .= True | getBinfoTxRBF]--binfoTxToEncoding :: Network -> BinfoTx -> Encoding-binfoTxToEncoding net BinfoTx{..} =- AE.pairs $- "hash" .= getBinfoTxHash- <> "ver" .= getBinfoTxVer- <> "vin_sz" .= getBinfoTxVinSz- <> "vout_sz" .= getBinfoTxVoutSz- <> "size" .= getBinfoTxSize- <> "weight" .= getBinfoTxWeight- <> "fee" .= getBinfoTxFee- <> "relayed_by" .= TE.decodeUtf8 getBinfoTxRelayedBy- <> "lock_time" .= getBinfoTxLockTime- <> "tx_index" .= getBinfoTxIndex- <> "double_spend" .= getBinfoTxDoubleSpend- <> "time" .= getBinfoTxTime- <> "block_index" .= getBinfoTxBlockIndex- <> "block_height" .= getBinfoTxBlockHeight- <> "inputs" `AE.pair` AE.list (binfoTxInputToEncoding net) getBinfoTxInputs- <> "out" `AE.pair` AE.list (binfoTxOutputToEncoding net) getBinfoTxOutputs- <> bal- <> rbf- where- bal =- case getBinfoTxResultBal of- Nothing -> mempty- Just (res, bal') -> "result" .= res <> "balance" .= bal'- rbf = if getBinfoTxRBF then "rbf" .= True else mempty--binfoTxParseJSON :: Network -> Value -> Parser BinfoTx-binfoTxParseJSON net = A.withObject "tx" $ \o -> do- getBinfoTxHash <- o .: "hash"- getBinfoTxVer <- o .: "ver"- getBinfoTxVinSz <- o .: "vin_sz"- getBinfoTxVoutSz <- o .: "vout_sz"- getBinfoTxSize <- o .: "size"- getBinfoTxWeight <- o .: "weight"- getBinfoTxFee <- o .: "fee"- getBinfoTxRelayedBy <- TE.encodeUtf8 <$> o .: "relayed_by"- getBinfoTxLockTime <- o .: "lock_time"- getBinfoTxIndex <- o .: "tx_index"- getBinfoTxDoubleSpend <- o .: "double_spend"- getBinfoTxTime <- o .: "time"- getBinfoTxBlockIndex <- o .: "block_index"- getBinfoTxBlockHeight <- o .: "block_height"- getBinfoTxInputs <- o .: "inputs" >>= mapM (binfoTxInputParseJSON net)- getBinfoTxOutputs <- o .: "out" >>= mapM (binfoTxOutputParseJSON net)- getBinfoTxRBF <- o .:? "rbf" .!= False- res <- o .:? "result"- bal <- o .:? "balance"- let getBinfoTxResultBal = (,) <$> res <*> bal- return BinfoTx{..}--data BinfoTxInput = BinfoTxInput- { getBinfoTxInputSeq :: !Word32- , getBinfoTxInputWitness :: !ByteString- , getBinfoTxInputScript :: !ByteString- , getBinfoTxInputIndex :: !Word32- , getBinfoTxInputPrevOut :: !BinfoTxOutput- }- deriving (Eq, Show, Generic, NFData)--binfoTxInputToJSON :: Network -> BinfoTxInput -> Value-binfoTxInputToJSON net BinfoTxInput{..} =- A.object- [ "sequence" .= getBinfoTxInputSeq- , "witness" .= encodeHex getBinfoTxInputWitness- , "script" .= encodeHex getBinfoTxInputScript- , "index" .= getBinfoTxInputIndex- , "prev_out" .= binfoTxOutputToJSON net getBinfoTxInputPrevOut- ]--binfoTxInputToEncoding :: Network -> BinfoTxInput -> Encoding-binfoTxInputToEncoding net BinfoTxInput{..} =- AE.pairs- ( "sequence" .= getBinfoTxInputSeq- <> "witness" .= encodeHex getBinfoTxInputWitness- <> "script" .= encodeHex getBinfoTxInputScript- <> "index" .= getBinfoTxInputIndex- <> "prev_out" .= binfoTxOutputToJSON net getBinfoTxInputPrevOut- )--binfoTxInputParseJSON :: Network -> Value -> Parser BinfoTxInput-binfoTxInputParseJSON net = A.withObject "txin" $ \o -> do- getBinfoTxInputSeq <- o .: "sequence"- getBinfoTxInputWitness <-- maybe mzero return . decodeHex- =<< o .: "witness"- getBinfoTxInputScript <-- maybe mzero return . decodeHex- =<< o .: "script"- getBinfoTxInputIndex <- o .: "index"- getBinfoTxInputPrevOut <-- o .: "prev_out"- >>= binfoTxOutputParseJSON net- return BinfoTxInput{..}--data BinfoTxOutput = BinfoTxOutput- { getBinfoTxOutputType :: !Int- , getBinfoTxOutputSpent :: !Bool- , getBinfoTxOutputValue :: !Word64- , getBinfoTxOutputIndex :: !Word32- , getBinfoTxOutputTxIndex :: !BinfoTxId- , getBinfoTxOutputScript :: !ByteString- , getBinfoTxOutputSpenders :: ![BinfoSpender]- , getBinfoTxOutputAddress :: !(Maybe Address)- , getBinfoTxOutputXPub :: !(Maybe BinfoXPubPath)- }- deriving (Eq, Show, Generic, NFData)--binfoTxOutputToJSON :: Network -> BinfoTxOutput -> Value-binfoTxOutputToJSON net BinfoTxOutput{..} =- A.object $- [ "type" .= getBinfoTxOutputType- , "spent" .= getBinfoTxOutputSpent- , "value" .= getBinfoTxOutputValue- , "spending_outpoints" .= getBinfoTxOutputSpenders- , "n" .= getBinfoTxOutputIndex- , "tx_index" .= getBinfoTxOutputTxIndex- , "script" .= encodeHex getBinfoTxOutputScript- ]- <> [ "addr" .= addrToJSON net a- | a <- maybeToList getBinfoTxOutputAddress- ]- <> [ "xpub" .= binfoXPubPathToJSON net x- | x <- maybeToList getBinfoTxOutputXPub- ]--binfoTxOutputToEncoding :: Network -> BinfoTxOutput -> Encoding-binfoTxOutputToEncoding net BinfoTxOutput{..} =- AE.pairs $- mconcat $- [ "type" .= getBinfoTxOutputType- , "spent" .= getBinfoTxOutputSpent- , "value" .= getBinfoTxOutputValue- , "spending_outpoints" .= getBinfoTxOutputSpenders- , "n" .= getBinfoTxOutputIndex- , "tx_index" .= getBinfoTxOutputTxIndex- , "script" .= encodeHex getBinfoTxOutputScript- ]- <> [ "addr" .= addrToJSON net a- | a <- maybeToList getBinfoTxOutputAddress- ]- <> [ "xpub" .= binfoXPubPathToJSON net x- | x <- maybeToList getBinfoTxOutputXPub- ]--binfoTxOutputParseJSON :: Network -> Value -> Parser BinfoTxOutput-binfoTxOutputParseJSON net = A.withObject "txout" $ \o -> do- getBinfoTxOutputType <- o .: "type"- getBinfoTxOutputSpent <- o .: "spent"- getBinfoTxOutputValue <- o .: "value"- getBinfoTxOutputSpenders <- o .: "spending_outpoints"- getBinfoTxOutputIndex <- o .: "n"- getBinfoTxOutputTxIndex <- o .: "tx_index"- getBinfoTxOutputScript <- maybe mzero return . decodeHex =<< o .: "script"- getBinfoTxOutputAddress <- o .:? "addr" >>= mapM (addrFromJSON net)- getBinfoTxOutputXPub <- o .:? "xpub" >>= mapM (binfoXPubPathParseJSON net)- return BinfoTxOutput{..}--data BinfoSpender = BinfoSpender- { getBinfoSpenderTxIndex :: !BinfoTxId- , getBinfoSpenderIndex :: !Word32- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoSpender where- toJSON BinfoSpender{..} =- A.object- [ "tx_index" .= getBinfoSpenderTxIndex- , "n" .= getBinfoSpenderIndex- ]- toEncoding BinfoSpender{..} =- AE.pairs- ( "tx_index" .= getBinfoSpenderTxIndex- <> "n" .= getBinfoSpenderIndex- )--instance FromJSON BinfoSpender where- parseJSON = A.withObject "spender" $ \o -> do- getBinfoSpenderTxIndex <- o .: "tx_index"- getBinfoSpenderIndex <- o .: "n"- return BinfoSpender{..}--data BinfoXPubPath = BinfoXPubPath- { getBinfoXPubPathKey :: !XPubKey- , getBinfoXPubPathDeriv :: !SoftPath- }- deriving (Eq, Show, Generic, NFData)--instance Ord BinfoXPubPath where- compare = compare `on` f- where- f b =- ( xPubParent (getBinfoXPubPathKey b)- , getBinfoXPubPathDeriv b- )--binfoXPubPathToJSON :: Network -> BinfoXPubPath -> Value-binfoXPubPathToJSON net BinfoXPubPath{..} =- A.object- [ "m" .= xPubToJSON net getBinfoXPubPathKey- , "path" .= ("M" ++ pathToStr getBinfoXPubPathDeriv)- ]--binfoXPubPathToEncoding :: Network -> BinfoXPubPath -> Encoding-binfoXPubPathToEncoding net BinfoXPubPath{..} =- AE.pairs $- "m" `AE.pair` xPubToEncoding net getBinfoXPubPathKey- <> "path" .= ("M" ++ pathToStr getBinfoXPubPathDeriv)--binfoXPubPathParseJSON :: Network -> Value -> Parser BinfoXPubPath-binfoXPubPathParseJSON net = A.withObject "xpub" $ \o -> do- getBinfoXPubPathKey <- o .: "m" >>= xPubFromJSON net- getBinfoXPubPathDeriv <-- fromMaybe "bad xpub path" . parseSoft <$> o .: "path"- return BinfoXPubPath{..}--data BinfoInfo = BinfoInfo- { getBinfoConnected :: !Word32- , getBinfoConversion :: !Double- , getBinfoLocal :: !BinfoSymbol- , getBinfoBTC :: !BinfoSymbol- , getBinfoLatestBlock :: !BinfoBlockInfo- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoInfo where- toJSON BinfoInfo{..} =- A.object- [ "nconnected" .= getBinfoConnected- , "conversion" .= getBinfoConversion- , "symbol_local" .= getBinfoLocal- , "symbol_btc" .= getBinfoBTC- , "latest_block" .= getBinfoLatestBlock- ]- toEncoding BinfoInfo{..} =- AE.pairs- ( "nconnected" .= getBinfoConnected- <> "conversion" .= getBinfoConversion- <> "symbol_local" .= getBinfoLocal- <> "symbol_btc" .= getBinfoBTC- <> "latest_block" .= getBinfoLatestBlock- )--instance FromJSON BinfoInfo where- parseJSON = A.withObject "info" $ \o -> do- getBinfoConnected <- o .: "nconnected"- getBinfoConversion <- o .: "conversion"- getBinfoLocal <- o .: "symbol_local"- getBinfoBTC <- o .: "symbol_btc"- getBinfoLatestBlock <- o .: "latest_block"- return BinfoInfo{..}--data BinfoBlockInfo = BinfoBlockInfo- { getBinfoBlockInfoHash :: !BlockHash- , getBinfoBlockInfoHeight :: !BlockHeight- , getBinfoBlockInfoTime :: !Word32- , getBinfoBlockInfoIndex :: !BlockHeight- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoBlockInfo where- toJSON BinfoBlockInfo{..} =- A.object- [ "hash" .= getBinfoBlockInfoHash- , "height" .= getBinfoBlockInfoHeight- , "time" .= getBinfoBlockInfoTime- , "block_index" .= getBinfoBlockInfoIndex- ]- toEncoding BinfoBlockInfo{..} =- AE.pairs- ( "hash" .= getBinfoBlockInfoHash- <> "height" .= getBinfoBlockInfoHeight- <> "time" .= getBinfoBlockInfoTime- <> "block_index" .= getBinfoBlockInfoIndex- )--instance FromJSON BinfoBlockInfo where- parseJSON = A.withObject "block_info" $ \o -> do- getBinfoBlockInfoHash <- o .: "hash"- getBinfoBlockInfoHeight <- o .: "height"- getBinfoBlockInfoTime <- o .: "time"- getBinfoBlockInfoIndex <- o .: "block_index"- return BinfoBlockInfo{..}--toBinfoBlockInfo :: BlockData -> BinfoBlockInfo-toBinfoBlockInfo BlockData{..} =- BinfoBlockInfo- { getBinfoBlockInfoHash = headerHash blockDataHeader- , getBinfoBlockInfoHeight = blockDataHeight- , getBinfoBlockInfoTime = blockTimestamp blockDataHeader- , getBinfoBlockInfoIndex = blockDataHeight- }--data BinfoRate = BinfoRate- { binfoRateTime :: !Word64- , binfoRatePrice :: !Double- , binfoRateVol24 :: !Double- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoRate where- toJSON BinfoRate{..} =- A.object- [ "timestamp" .= binfoRateTime- , "price" .= binfoRatePrice- , "volume24h" .= binfoRateVol24- ]--instance FromJSON BinfoRate where- parseJSON = A.withObject "price" $ \o -> do- binfoRateTime <- o .: "timestamp"- binfoRatePrice <- o .: "price"- binfoRateVol24 <- o .: "volume24h"- return BinfoRate{..}--data BinfoHistory = BinfoHistory- { binfoHistoryDate :: !Text- , binfoHistoryTime :: !Text- , binfoHistoryType :: !Text- , binfoHistoryAmount :: !Double- , binfoHistoryValueThen :: !Double- , binfoHistoryValueNow :: !Double- , binfoHistoryExchangeRateThen :: !Double- , binfoHistoryTx :: !TxHash- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoHistory where- toJSON BinfoHistory{..} =- A.object- [ "date" .= binfoHistoryDate- , "time" .= binfoHistoryTime- , "type" .= binfoHistoryType- , "amount" .= binfoHistoryAmount- , "value_then" .= binfoHistoryValueThen- , "value_now" .= binfoHistoryValueNow- , "exchange_rate_then" .= binfoHistoryExchangeRateThen- , "tx" .= binfoHistoryTx- ]--instance FromJSON BinfoHistory where- parseJSON = A.withObject "history" $ \o -> do- binfoHistoryDate <- o .: "date"- binfoHistoryTime <- o .: "time"- binfoHistoryType <- o .: "type"- binfoHistoryAmount <- o .: "amount"- binfoHistoryValueThen <- o .: "value_then"- binfoHistoryValueNow <- o .: "value_now"- binfoHistoryExchangeRateThen <- o .: "exchange_rate_then"- binfoHistoryTx <- o .: "tx"- return BinfoHistory{..}--toBinfoHistory ::- Int64 ->- Word64 ->- Double ->- Double ->- TxHash ->- BinfoHistory-toBinfoHistory satoshi timestamp rate_then rate_now txhash =- BinfoHistory- { binfoHistoryDate =- T.pack $ formatTime defaultTimeLocale "%Y-%m-%d" t- , binfoHistoryTime =- T.pack $ formatTime defaultTimeLocale "%H:%M:%S GMT %Ez" t- , binfoHistoryType =- if satoshi <= 0 then "sent" else "received"- , binfoHistoryAmount =- fromRational v- , binfoHistoryValueThen =- fromRational v1- , binfoHistoryValueNow =- fromRational v2- , binfoHistoryExchangeRateThen =- rate_then- , binfoHistoryTx =- txhash- }- where- t = posixSecondsToUTCTime (realToFrac timestamp)- v = toRational satoshi / (100 * 1000 * 1000)- r1 = toRational rate_then- r2 = toRational rate_now- v1 = v * r1- v2 = v * r2--newtype BinfoDate = BinfoDate Word64- deriving (Eq, Show, Read, Generic, NFData)--instance Parsable BinfoDate where- parseParam t =- maybeToEither "Cannot parse date"- . fmap (BinfoDate . round . utcTimeToPOSIXSeconds)- $ p "%d-%m-%Y" <|> p "%d/%m/%Y"- where- s = TL.unpack t- p fmt = parseTimeM False defaultTimeLocale fmt s--data BinfoTicker = BinfoTicker- { binfoTicker15m :: !Double- , binfoTickerLast :: !Double- , binfoTickerBuy :: !Double- , binfoTickerSell :: !Double- , binfoTickerSymbol :: !Text- }- deriving (Eq, Show, Generic, NFData)--instance Default BinfoTicker where- def =- BinfoTicker- { binfoTickerSymbol = "XXX"- , binfoTicker15m = 0.0- , binfoTickerLast = 0.0- , binfoTickerBuy = 0.0- , binfoTickerSell = 0.0- }--instance ToJSON BinfoTicker where- toJSON BinfoTicker{..} =- A.object- [ "symbol" .= binfoTickerSymbol- , "sell" .= binfoTickerSell- , "buy" .= binfoTickerBuy- , "last" .= binfoTickerLast- , "15m" .= binfoTicker15m- ]- toEncoding BinfoTicker{..} =- AE.pairs $- "symbol" .= binfoTickerSymbol- <> "sell" .= binfoTickerSell- <> "buy" .= binfoTickerBuy- <> "last" .= binfoTickerLast- <> "15m" .= binfoTicker15m--instance FromJSON BinfoTicker where- parseJSON = A.withObject "ticker" $ \o -> do- binfoTickerSymbol <- o .: "symbol"- binfoTicker15m <- o .: "15m"- binfoTickerSell <- o .: "sell"- binfoTickerBuy <- o .: "buy"- binfoTickerLast <- o .: "last"- return BinfoTicker{..}--data BinfoSymbol = BinfoSymbol- { getBinfoSymbolCode :: !Text- , getBinfoSymbolString :: !Text- , getBinfoSymbolName :: !Text- , getBinfoSymbolConversion :: !Double- , getBinfoSymbolAfter :: !Bool- , getBinfoSymbolLocal :: !Bool- }- deriving (Eq, Show, Generic, NFData)--instance Default BinfoSymbol where- def =- BinfoSymbol- { getBinfoSymbolCode = "XXX"- , getBinfoSymbolString = "¤"- , getBinfoSymbolName = "No currency"- , getBinfoSymbolConversion = 0.0- , getBinfoSymbolAfter = False- , getBinfoSymbolLocal = True- }--instance ToJSON BinfoSymbol where- toJSON BinfoSymbol{..} =- A.object- [ "code" .= getBinfoSymbolCode- , "symbol" .= getBinfoSymbolString- , "name" .= getBinfoSymbolName- , "conversion" .= getBinfoSymbolConversion- , "symbolAppearsAfter" .= getBinfoSymbolAfter- , "local" .= getBinfoSymbolLocal- ]- toEncoding BinfoSymbol{..} =- AE.pairs- ( "code" .= getBinfoSymbolCode- <> "symbol" .= getBinfoSymbolString- <> "name" .= getBinfoSymbolName- <> "conversion" .= getBinfoSymbolConversion- <> "symbolAppearsAfter" .= getBinfoSymbolAfter- <> "local" .= getBinfoSymbolLocal- )--instance FromJSON BinfoSymbol where- parseJSON = A.withObject "symbol" $ \o -> do- getBinfoSymbolCode <- o .: "code"- getBinfoSymbolString <- o .: "symbol"- getBinfoSymbolName <- o .: "name"- getBinfoSymbolConversion <- o .: "conversion"- getBinfoSymbolAfter <- o .: "symbolAppearsAfter"- getBinfoSymbolLocal <- o .: "local"- return BinfoSymbol{..}--relevantTxs ::- HashSet Address ->- Bool ->- Transaction ->- HashSet TxHash-relevantTxs addrs prune t@Transaction{..} =- let p a = prune && getTxResult addrs t > 0 && not (HashSet.member a addrs)- f StoreOutput{..} =- case outputSpender of- Nothing -> Nothing- Just Spender{..} ->- case outputAddr of- Nothing -> Nothing- Just a- | p a -> Nothing- | otherwise -> Just spenderHash- outs = mapMaybe f transactionOutputs- g StoreCoinbase{} = Nothing- g StoreInput{inputPoint = OutPoint{..}} = Just outPointHash- ins = mapMaybe g transactionInputs- in HashSet.fromList $ ins <> outs--toBinfoAddrs ::- HashMap Address Balance ->- HashMap XPubSpec [XPubBal] ->- HashMap XPubSpec Word64 ->- [BinfoBalance]-toBinfoAddrs only_addrs only_xpubs xpub_txs =- xpub_bals <> addr_bals- where- xpub_bal k xs =- let f x = case xPubBalPath x of- [0, _] -> balanceTotalReceived (xPubBal x)- _ -> 0- g x = balanceAmount (xPubBal x) + balanceZero (xPubBal x)- i m x = case xPubBalPath x of- [m', n] | m == m' -> n + 1- _ -> 0- received = sum (map f xs)- bal = fromIntegral (sum (map g xs))- sent = if bal <= received then received - bal else 0- count = HashMap.lookupDefault 0 k xpub_txs- ax = foldl max 0 (map (i 0) xs)- cx = foldl max 0 (map (i 1) xs)- in BinfoXPubBalance- { getBinfoXPubKey = xPubSpecKey k- , getBinfoAddrTxCount = count- , getBinfoAddrReceived = received- , getBinfoAddrSent = sent- , getBinfoAddrBalance = bal- , getBinfoXPubAccountIndex = ax- , getBinfoXPubChangeIndex = cx- }- xpub_bals = map (uncurry xpub_bal) (HashMap.toList only_xpubs)- addr_bals =- let f Balance{..} =- let addr = balanceAddress- sent = recv - bal- recv = balanceTotalReceived- tx_count = balanceTxCount- bal = balanceAmount + balanceZero- in BinfoAddrBalance- { getBinfoAddress = addr- , getBinfoAddrTxCount = tx_count- , getBinfoAddrReceived = recv- , getBinfoAddrSent = sent- , getBinfoAddrBalance = bal- }- in map f $ HashMap.elems only_addrs--toBinfoTxSimple ::- Bool ->- Transaction ->- BinfoTx-toBinfoTxSimple numtxid =- toBinfoTx numtxid HashMap.empty False 0--toBinfoTxInputs ::- Bool ->- HashMap Address (Maybe BinfoXPubPath) ->- Transaction ->- [BinfoTxInput]-toBinfoTxInputs numtxid abook t =- zipWith f [0 ..] (transactionInputs t)- where- f n i =- BinfoTxInput- { getBinfoTxInputIndex = n- , getBinfoTxInputSeq = inputSequence i- , getBinfoTxInputScript = inputSigScript i- , getBinfoTxInputWitness = wit i- , getBinfoTxInputPrevOut = prev n i- }- wit i =- case inputWitness i of- [] -> BS.empty- ws -> runPutS (put_witness ws)- prev = inputToBinfoTxOutput numtxid abook t- put_witness ws = do- putVarInt (length ws)- mapM_ put_item ws- put_item bs = do- putVarInt (BS.length bs)- putByteString bs--toBinfoBlockIndex :: Transaction -> Maybe BlockHeight-toBinfoBlockIndex Transaction{transactionDeleted = True} = Nothing-toBinfoBlockIndex Transaction{transactionBlock = MemRef _} = Nothing-toBinfoBlockIndex Transaction{transactionBlock = BlockRef h _} = Just h--toBinfoTx ::- Bool ->- HashMap Address (Maybe BinfoXPubPath) ->- Bool ->- Int64 ->- Transaction ->- BinfoTx-toBinfoTx numtxid abook prune bal t@Transaction{..} =- BinfoTx- { getBinfoTxHash = txHash (transactionData t)- , getBinfoTxVer = transactionVersion- , getBinfoTxVinSz = fromIntegral (length transactionInputs)- , getBinfoTxVoutSz = fromIntegral (length transactionOutputs)- , getBinfoTxSize = transactionSize- , getBinfoTxWeight = transactionWeight- , getBinfoTxFee = transactionFees- , getBinfoTxRelayedBy = "0.0.0.0"- , getBinfoTxLockTime = transactionLockTime- , getBinfoTxIndex =- encodeBinfoTxId numtxid (txHash (transactionData t))- , getBinfoTxDoubleSpend = transactionDeleted- , getBinfoTxRBF = transactionRBF- , getBinfoTxTime = transactionTime- , getBinfoTxBlockIndex = toBinfoBlockIndex t- , getBinfoTxBlockHeight = toBinfoBlockIndex t- , getBinfoTxInputs = toBinfoTxInputs numtxid abook t- , getBinfoTxOutputs = outs- , getBinfoTxResultBal = resbal- }- where- simple = HashMap.null abook && bal == 0- resbal = if simple then Nothing else Just (getTxResult aset t, bal)- aset = HashMap.keysSet abook- outs =- let p = prune && getTxResult aset t > 0- f = toBinfoTxOutput numtxid abook p t- in catMaybes $ zipWith f [0 ..] transactionOutputs--getTxResult :: HashSet Address -> Transaction -> Int64-getTxResult aset Transaction{..} =- let input_sum = sum $ map input_value transactionInputs- input_value StoreCoinbase{} = 0- input_value StoreInput{..} =- case inputAddress of- Nothing -> 0- Just a ->- if test_addr a- then negate $ fromIntegral inputAmount- else 0- test_addr a = HashSet.member a aset- output_sum = sum $ map out_value transactionOutputs- out_value StoreOutput{..} =- case outputAddr of- Nothing -> 0- Just a ->- if test_addr a- then fromIntegral outputAmount- else 0- in input_sum + output_sum--toBinfoTxOutput ::- Bool ->- HashMap Address (Maybe BinfoXPubPath) ->- Bool ->- Transaction ->- Word32 ->- StoreOutput ->- Maybe BinfoTxOutput-toBinfoTxOutput numtxid abook prune t n StoreOutput{..} =- let getBinfoTxOutputType = 0- getBinfoTxOutputSpent = isJust outputSpender- getBinfoTxOutputValue = outputAmount- getBinfoTxOutputIndex = n- getBinfoTxOutputTxIndex =- encodeBinfoTxId numtxid (txHash (transactionData t))- getBinfoTxOutputScript = outputScript- getBinfoTxOutputSpenders =- maybeToList $ toBinfoSpender numtxid <$> outputSpender- getBinfoTxOutputAddress = outputAddr- getBinfoTxOutputXPub =- outputAddr >>= join . (`HashMap.lookup` abook)- in if prune && isNothing (outputAddr >>= (`HashMap.lookup` abook))- then Nothing- else Just BinfoTxOutput{..}--toBinfoSpender :: Bool -> Spender -> BinfoSpender-toBinfoSpender numtxid Spender{..} =- let getBinfoSpenderTxIndex = encodeBinfoTxId numtxid spenderHash- getBinfoSpenderIndex = spenderIndex- in BinfoSpender{..}--inputToBinfoTxOutput ::- Bool ->- HashMap Address (Maybe BinfoXPubPath) ->- Transaction ->- Word32 ->- StoreInput ->- BinfoTxOutput-inputToBinfoTxOutput numtxid abook t n i =- BinfoTxOutput- { getBinfoTxOutputIndex = out_index- , getBinfoTxOutputType = 0- , getBinfoTxOutputSpent = True- , getBinfoTxOutputValue = inputAmount- , getBinfoTxOutputTxIndex = encodeBinfoTxId numtxid out_hash- , getBinfoTxOutputScript = inputPkScript- , getBinfoTxOutputSpenders = [spender]- , getBinfoTxOutputAddress = inputAddress- , getBinfoTxOutputXPub = xpub- }- where- inputAmount =- case i of- StoreCoinbase{} -> 0- StoreInput{..} -> inputAmount- inputPkScript =- case i of- StoreCoinbase{} -> BS.empty- StoreInput{..} -> inputPkScript- inputAddress =- case i of- StoreCoinbase{} -> Nothing- StoreInput{..} -> inputAddress- OutPoint out_hash out_index = inputPoint i- spender =- BinfoSpender- (encodeBinfoTxId numtxid (txHash (transactionData t)))- n- xpub = inputAddress >>= join . (`HashMap.lookup` abook)--data BinfoAddr- = BinfoAddr !Address- | BinfoXpub !XPubKey- deriving (Eq, Show, Generic, Hashable, NFData)--parseBinfoAddr :: Network -> Text -> Maybe [BinfoAddr]-parseBinfoAddr _ "" = Just []-parseBinfoAddr net s =- mapM f $- filter (not . T.null) $- concatMap (T.splitOn ",") (T.splitOn "|" s)- where- f x = BinfoAddr <$> textToAddr net x <|> BinfoXpub <$> xPubImport net x--data BinfoHeader = BinfoHeader- { binfoHeaderHash :: !BlockHash- , binfoHeaderTime :: !Timestamp- , binfoHeaderIndex :: !Word32- , binfoHeaderHeight :: !BlockHeight- , binfoTxIndices :: ![BinfoTxId]- }- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoHeader where- toJSON BinfoHeader{..} =- A.object- [ "hash" .= binfoHeaderHash- , "time" .= binfoHeaderTime- , "block_index" .= binfoHeaderIndex- , "height" .= binfoHeaderHeight- , "txIndexes" .= binfoTxIndices- ]--instance FromJSON BinfoHeader where- parseJSON = A.withObject "header" $ \o -> do- binfoHeaderHash <- o .: "hash"- binfoHeaderTime <- o .: "time"- binfoHeaderIndex <- o .: "block_index"- binfoHeaderHeight <- o .: "height"- binfoTxIndices <- o .: "txIndexes"- return BinfoHeader{..}--newtype BinfoMempool = BinfoMempool {getBinfoMempool :: [BinfoTx]}- deriving (Eq, Show, Generic, NFData)--binfoMempoolToJSON :: Network -> BinfoMempool -> Value-binfoMempoolToJSON net (BinfoMempool txs) =- A.object ["txs" .= map (binfoTxToJSON net) txs]--binfoMempoolToEncoding :: Network -> BinfoMempool -> Encoding-binfoMempoolToEncoding net (BinfoMempool txs) =- AE.pairs $ AE.pair "txs" (AE.list (binfoTxToEncoding net) txs)--binfoMempoolParseJSON :: Network -> Value -> Parser BinfoMempool-binfoMempoolParseJSON net =- A.withObject "mempool" $ \o ->- BinfoMempool <$> (mapM (binfoTxParseJSON net) =<< o .: "txs")--newtype BinfoBlocks = BinfoBlocks {binfoBlocks :: [BinfoBlockInfo]}- deriving (Eq, Show, Generic, NFData)--instance ToJSON BinfoBlocks where- toJSON BinfoBlocks{..} = A.object ["blocks" .= binfoBlocks]--instance FromJSON BinfoBlocks where- parseJSON = A.withObject "blocks" $ \o -> BinfoBlocks <$> o .: "blocks"+module Haskoin.Store.Data+ ( -- * Address Balances+ Balance (..),+ balanceToJSON,+ balanceToEncoding,+ balanceParseJSON,+ zeroBalance,+ nullBalance,++ -- * Block Data+ BlockData (..),+ blockDataToJSON,+ blockDataToEncoding,+ confirmed,++ -- * Transactions+ TxRef (..),+ TxData (..),+ Transaction (..),+ transactionToJSON,+ transactionToEncoding,+ transactionParseJSON,+ transactionData,+ fromTransaction,+ toTransaction,+ StoreInput (..),+ storeInputToJSON,+ storeInputToEncoding,+ storeInputParseJSON,+ isCoinbase,+ StoreOutput (..),+ storeOutputToJSON,+ storeOutputToEncoding,+ storeOutputParseJSON,+ Prev (..),+ Spender (..),+ BlockRef (..),+ UnixTime,+ getUnixTime,+ putUnixTime,+ BlockPos,++ -- * Unspent Outputs+ Unspent (..),+ unspentToJSON,+ unspentToEncoding,+ unspentParseJSON,++ -- * Extended Public Keys+ XPubSpec (..),+ XPubBal (..),+ xPubBalToJSON,+ xPubBalToEncoding,+ xPubBalParseJSON,+ XPubUnspent (..),+ xPubUnspentToJSON,+ xPubUnspentToEncoding,+ xPubUnspentParseJSON,+ XPubSummary (..),+ DeriveType (..),+ textToDeriveType,+ deriveTypeToText,++ -- * Other Data+ TxId (..),+ GenericResult (..),+ SerialList (..),+ RawResult (..),+ RawResultList (..),+ PeerInformation (..),+ Healthy (..),+ BlockHealth (..),+ TimeHealth (..),+ CountHealth (..),+ MaxHealth (..),+ HealthCheck (..),+ Event (..),+ Except (..),++ -- * Blockchain.info API+ BinfoBlockId (..),+ BinfoTxId (..),+ encodeBinfoTxId,+ BinfoFilter (..),+ BinfoMultiAddr (..),+ binfoMultiAddrToJSON,+ binfoMultiAddrToEncoding,+ binfoMultiAddrParseJSON,+ BinfoShortBal (..),+ BinfoBalance (..),+ toBinfoAddrs,+ binfoBalanceToJSON,+ binfoBalanceToEncoding,+ binfoBalanceParseJSON,+ BinfoRawAddr (..),+ binfoRawAddrToJSON,+ binfoRawAddrToEncoding,+ binfoRawAddrParseJSON,+ BinfoAddr (..),+ parseBinfoAddr,+ BinfoWallet (..),+ BinfoUnspent (..),+ binfoUnspentToJSON,+ binfoUnspentToEncoding,+ binfoUnspentParseJSON,+ binfoHexValue,+ BinfoUnspents (..),+ binfoUnspentsToJSON,+ binfoUnspentsToEncoding,+ binfoUnspentsParseJSON,+ BinfoBlock (..),+ toBinfoBlock,+ binfoBlockToJSON,+ binfoBlockToEncoding,+ binfoBlockParseJSON,+ binfoBlocksToJSON,+ binfoBlocksToEncoding,+ binfoBlocksParseJSON,+ BinfoTx (..),+ relevantTxs,+ toBinfoTx,+ toBinfoTxSimple,+ binfoTxToJSON,+ binfoTxToEncoding,+ binfoTxParseJSON,+ BinfoTxInput (..),+ binfoTxInputToJSON,+ binfoTxInputToEncoding,+ binfoTxInputParseJSON,+ BinfoTxOutput (..),+ binfoTxOutputToJSON,+ binfoTxOutputToEncoding,+ binfoTxOutputParseJSON,+ BinfoSpender (..),+ BinfoXPubPath (..),+ binfoXPubPathToJSON,+ binfoXPubPathToEncoding,+ binfoXPubPathParseJSON,+ BinfoInfo (..),+ BinfoBlockInfo (..),+ toBinfoBlockInfo,+ BinfoSymbol (..),+ BinfoTicker (..),+ BinfoRate (..),+ BinfoHistory (..),+ toBinfoHistory,+ BinfoDate (..),+ BinfoHeader (..),+ BinfoMempool (..),+ binfoMempoolToJSON,+ binfoMempoolToEncoding,+ binfoMempoolParseJSON,+ BinfoBlocks (..),+ )+where++import Control.Applicative ((<|>))+import Control.DeepSeq (NFData)+import Control.Exception (Exception)+import Control.Monad (join, mzero, unless, (<=<))+import Data.Aeson+ ( Encoding,+ FromJSON (..),+ ToJSON (..),+ Value (..),+ (.!=),+ (.:),+ (.:?),+ (.=),+ )+import qualified Data.Aeson as A+import qualified Data.Aeson.Encoding as AE+import Data.Aeson.Types (Parser)+import Data.Binary (Binary (get, put))+import Data.Bits (Bits (..))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import Data.Bytes.Get+import qualified Data.Bytes.Get as Bytes.Get+import Data.Bytes.Put+import Data.Bytes.Serial+import Data.Default (Default (..))+import Data.Foldable (toList)+import Data.Function (on)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.HashSet (HashSet)+import qualified Data.HashSet as HashSet+import Data.Hashable (Hashable (..))+import Data.Int (Int32, Int64)+import qualified Data.IntMap as IntMap+import Data.IntMap.Strict (IntMap)+import Data.Maybe+ ( catMaybes,+ fromMaybe,+ isJust,+ isNothing,+ mapMaybe,+ maybeToList,+ )+import Data.Serialize (Serialize (..))+import Data.String.Conversions (cs)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import Data.Time.Clock.POSIX+ ( posixSecondsToUTCTime,+ utcTimeToPOSIXSeconds,+ )+import Data.Time.Format+ ( defaultTimeLocale,+ formatTime,+ parseTimeM,+ )+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Haskoin hiding (inputAddress)+import Web.Scotty.Trans (Parsable (..), ScottyError (..))++data DeriveType+ = DeriveNormal+ | DeriveP2SH+ | DeriveP2WPKH+ deriving (Show, Eq, Generic, NFData)++textToDeriveType :: Text -> Maybe DeriveType+textToDeriveType "normal" = Just DeriveNormal+textToDeriveType "compat" = Just DeriveP2SH+textToDeriveType "segwit" = Just DeriveP2WPKH+textToDeriveType _ = Nothing++deriveTypeToText :: DeriveType -> Text+deriveTypeToText DeriveNormal = "normal"+deriveTypeToText DeriveP2SH = "compat"+deriveTypeToText DeriveP2WPKH = "segwit"++instance Serial DeriveType where+ serialize DeriveNormal = putWord8 0x00+ serialize DeriveP2SH = putWord8 0x01+ serialize DeriveP2WPKH = putWord8 0x02++ deserialize =+ getWord8 >>= \case+ 0x00 -> return DeriveNormal+ 0x01 -> return DeriveP2SH+ 0x02 -> return DeriveP2WPKH+ _ -> return DeriveNormal++instance Binary DeriveType where+ put = serialize+ get = deserialize++instance Serialize DeriveType where+ put = serialize+ get = deserialize++instance Default DeriveType where+ def = DeriveNormal++instance Parsable DeriveType where+ parseParam txt =+ case textToDeriveType (TL.toStrict txt) of+ Nothing -> Left "invalid derivation type"+ Just x -> Right x++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 Serial XPubSpec where+ serialize XPubSpec {xPubSpecKey = k, xPubDeriveType = t} = do+ putWord8 (xPubDepth k)+ serialize (xPubParent k)+ putWord32be (xPubIndex k)+ serialize (xPubChain k)+ serialize (wrapPubKey True (xPubKey k))+ serialize t+ deserialize = do+ d <- getWord8+ p <- deserialize+ i <- getWord32be+ c <- deserialize+ k <- deserialize+ t <- deserialize+ let x =+ XPubKey+ { xPubDepth = d,+ xPubParent = p,+ xPubIndex = i,+ xPubChain = c,+ xPubKey = pubKeyPoint k+ }+ return XPubSpec {xPubSpecKey = x, xPubDeriveType = t}++instance Serialize XPubSpec where+ put = serialize+ get = deserialize++instance Binary XPubSpec where+ put = serialize+ get = deserialize++type UnixTime = Word64++type BlockPos = Word32++-- | Binary such that ordering is inverted.+putUnixTime :: MonadPut m => Word64 -> m ()+putUnixTime w = putWord64be $ maxBound - w++getUnixTime :: MonadGet m => m Word64+getUnixTime = (maxBound -) <$> getWord64be++-- | Reference to a block where a transaction is stored.+data BlockRef+ = BlockRef+ { -- | block height in the chain+ blockRefHeight :: !BlockHeight,+ -- | position of transaction within the block+ blockRefPos :: !Word32+ }+ | MemRef+ { memRefTime :: !UnixTime+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++-- | Serial entities will sort in reverse order.+instance Serial BlockRef where+ serialize MemRef {memRefTime = t} = do+ putWord8 0x00+ putUnixTime t+ serialize BlockRef {blockRefHeight = h, blockRefPos = p} = do+ putWord8 0x01+ putWord32be (maxBound - h)+ putWord32be (maxBound - p)+ deserialize =+ getWord8 >>= \case+ 0x00 -> getmemref+ 0x01 -> getblockref+ _ -> fail "Cannot decode BlockRef"+ where+ getmemref = do+ MemRef <$> getUnixTime+ getblockref = do+ h <- (maxBound -) <$> getWord32be+ p <- (maxBound -) <$> getWord32be+ return BlockRef {blockRefHeight = h, blockRefPos = p}++instance Serialize BlockRef where+ put = serialize+ get = deserialize++instance Binary BlockRef where+ put = serialize+ get = deserialize++confirmed :: BlockRef -> Bool+confirmed BlockRef {} = True+confirmed MemRef {} = False++instance ToJSON BlockRef where+ toJSON BlockRef {blockRefHeight = h, blockRefPos = p} =+ A.object ["height" .= h, "position" .= p]+ toJSON MemRef {memRefTime = t} = A.object ["mempool" .= t]+ toEncoding BlockRef {blockRefHeight = h, blockRefPos = p} =+ AE.pairs ("height" .= h <> "position" .= p)+ toEncoding MemRef {memRefTime = t} = AE.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 TxRef = TxRef+ { -- | block information+ txRefBlock :: !BlockRef,+ -- | transaction hash+ txRefHash :: !TxHash+ }+ deriving (Show, Eq, Ord, Generic, Hashable, NFData)++instance Serial TxRef where+ serialize (TxRef b h) = do+ serialize b+ serialize h++ deserialize =+ TxRef <$> deserialize <*> deserialize++instance Binary TxRef where+ put = serialize+ get = deserialize++instance Serialize TxRef where+ put = serialize+ get = deserialize++instance ToJSON TxRef where+ toJSON btx =+ A.object+ [ "txid" .= txRefHash btx,+ "block" .= txRefBlock btx+ ]+ toEncoding btx =+ AE.pairs $+ "txid" .= txRefHash btx+ <> "block" .= txRefBlock btx++instance FromJSON TxRef where+ parseJSON =+ A.withObject "blocktx" $ \o -> do+ txid <- o .: "txid"+ block <- o .: "block"+ return TxRef {txRefBlock = block, txRefHash = txid}++-- | Address balance information.+data Balance = Balance+ { -- | address balance+ balanceAddress :: !Address,+ -- | confirmed balance+ balanceAmount :: !Word64,+ -- | unconfirmed balance+ balanceZero :: !Word64,+ -- | number of unspent outputs+ balanceUnspentCount :: !Word64,+ -- | number of transactions+ balanceTxCount :: !Word64,+ -- | total amount from all outputs in this address+ balanceTotalReceived :: !Word64+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++instance Serial Balance where+ serialize Balance {..} = do+ serialize balanceAddress+ putWord64be balanceAmount+ putWord64be balanceZero+ putWord64be balanceUnspentCount+ putWord64be balanceTxCount+ putWord64be balanceTotalReceived++ deserialize = do+ balanceAddress <- deserialize+ balanceAmount <- getWord64be+ balanceZero <- getWord64be+ balanceUnspentCount <- getWord64be+ balanceTxCount <- getWord64be+ balanceTotalReceived <- getWord64be+ return Balance {..}++instance Binary Balance where+ put = serialize+ get = deserialize++instance Serialize Balance where+ put = serialize+ get = deserialize++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 =+ A.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 =+ AE.pairs $+ "address" `AE.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 :: !ByteString,+ unspentAddress :: !(Maybe Address)+ }+ deriving (Show, Eq, Generic, Hashable, NFData)++-- | Follow same order as in database and cache by inverting outpoint sort+-- order.+instance Ord Unspent where+ compare a b =+ compare+ (unspentBlock a, unspentPoint b)+ (unspentBlock b, unspentPoint a)++instance Serial Unspent where+ serialize Unspent {..} = do+ serialize unspentBlock+ serialize unspentPoint+ putWord64be unspentAmount+ putLengthBytes unspentScript+ putMaybe serialize unspentAddress++ deserialize = do+ unspentBlock <- deserialize+ unspentPoint <- deserialize+ unspentAmount <- getWord64be+ unspentScript <- getLengthBytes+ unspentAddress <- getMaybe deserialize+ return Unspent {..}++instance Binary Unspent where+ put = serialize+ get = deserialize++instance Serialize Unspent where+ put = serialize+ get = deserialize++instance Coin Unspent where+ coinValue = unspentAmount++unspentToJSON :: Network -> Unspent -> Value+unspentToJSON net u =+ A.object+ [ "address" .= (addrToJSON net <$> unspentAddress u),+ "block" .= unspentBlock u,+ "txid" .= outPointHash (unspentPoint u),+ "index" .= outPointIndex (unspentPoint u),+ "pkscript" .= encodeHex (unspentScript u),+ "value" .= unspentAmount u+ ]++unspentToEncoding :: Network -> Unspent -> Encoding+unspentToEncoding net u =+ AE.pairs $+ "address" `AE.pair` maybe AE.null_ (addrToEncoding net) (unspentAddress u)+ <> "block" .= unspentBlock u+ <> "txid" .= outPointHash (unspentPoint u)+ <> "index" .= outPointIndex (unspentPoint u)+ <> "pkscript" `AE.pair` AE.text (encodeHex (unspentScript u))+ <> "value" .= unspentAmount u++unspentParseJSON :: Network -> Value -> Parser Unspent+unspentParseJSON net =+ A.withObject "unspent" $ \o -> do+ block <- o .: "block"+ txid <- o .: "txid"+ index <- o .: "index"+ value <- o .: "value"+ script <- o .: "pkscript" >>= jsonHex+ addr <-+ o .: "address" >>= \case+ Nothing -> return Nothing+ Just a -> Just <$> addrFromJSON net a <|> return Nothing+ return+ Unspent+ { unspentBlock = block,+ unspentPoint = OutPoint txid index,+ unspentAmount = value,+ unspentScript = script,+ unspentAddress = addr+ }++-- | Database value for a block entry.+data BlockData = BlockData+ { -- | height of the block in the chain+ blockDataHeight :: !BlockHeight,+ -- | is this block in the main chain?+ blockDataMainChain :: !Bool,+ -- | accumulated work in that block+ blockDataWork :: !Integer,+ -- | block header+ blockDataHeader :: !BlockHeader,+ -- | size of the block including witnesses+ blockDataSize :: !Word32,+ -- | weight of this block (for segwit networks)+ blockDataWeight :: !Word32,+ -- | block transactions+ blockDataTxs :: ![TxHash],+ -- | sum of all transaction outputs+ blockDataOutputs :: !Word64,+ -- | sum of all transaction fees+ blockDataFees :: !Word64,+ -- | block subsidy+ blockDataSubsidy :: !Word64+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++instance Serial BlockData where+ serialize BlockData {..} = do+ putWord32be blockDataHeight+ serialize blockDataMainChain+ putInteger blockDataWork+ serialize blockDataHeader+ putWord32be blockDataSize+ putWord32be blockDataWeight+ putList serialize blockDataTxs+ putWord64be blockDataOutputs+ putWord64be blockDataFees+ putWord64be blockDataSubsidy++ deserialize = do+ blockDataHeight <- getWord32be+ blockDataMainChain <- deserialize+ blockDataWork <- getInteger+ blockDataHeader <- deserialize+ blockDataSize <- getWord32be+ blockDataWeight <- getWord32be+ blockDataTxs <- getList deserialize+ blockDataOutputs <- getWord64be+ blockDataFees <- getWord64be+ blockDataSubsidy <- getWord64be+ return BlockData {..}++instance Serialize BlockData where+ put = serialize+ get = deserialize++instance Binary BlockData where+ put = serialize+ get = deserialize++blockDataToJSON :: Network -> BlockData -> Value+blockDataToJSON net bv =+ A.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" .= blockDataWork bv+ ]+ <> ["weight" .= blockDataWeight bv | getSegWit net]++blockDataToEncoding :: Network -> BlockData -> Encoding+blockDataToEncoding net bv =+ AE.pairs $+ "hash"+ `AE.pair` AE.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"+ `AE.pair` AE.text+ (txHashToHex (TxHash (merkleRoot (blockDataHeader bv))))+ <> "subsidy" .= blockDataSubsidy bv+ <> "fees" .= blockDataFees bv+ <> "outputs" .= blockDataOutputs bv+ <> "work" .= blockDataWork bv+ <> (if getSegWit net then "weight" .= blockDataWeight bv else mempty)++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" .!= 0+ 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 :: !WitnessStack+ }+ | StoreInput+ { inputPoint :: !OutPoint,+ inputSequence :: !Word32,+ inputSigScript :: !ByteString,+ inputPkScript :: !ByteString,+ inputAmount :: !Word64,+ inputWitness :: !WitnessStack,+ inputAddress :: !(Maybe Address)+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++instance Serial StoreInput where+ serialize StoreCoinbase {..} = do+ putWord8 0x00+ serialize inputPoint+ putWord32be inputSequence+ putLengthBytes inputSigScript+ putList putLengthBytes inputWitness+ serialize StoreInput {..} = do+ putWord8 0x01+ serialize inputPoint+ putWord32be inputSequence+ putLengthBytes inputSigScript+ putLengthBytes inputPkScript+ putWord64be inputAmount+ putList putLengthBytes inputWitness+ putMaybe serialize inputAddress++ deserialize =+ getWord8 >>= \case+ 0x00 -> do+ inputPoint <- deserialize+ inputSequence <- getWord32be+ inputSigScript <- getLengthBytes+ inputWitness <- getList getLengthBytes+ return StoreCoinbase {..}+ 0x01 -> do+ inputPoint <- deserialize+ inputSequence <- getWord32be+ inputSigScript <- getLengthBytes+ inputPkScript <- getLengthBytes+ inputAmount <- getWord64be+ inputWitness <- getList getLengthBytes+ inputAddress <- getMaybe deserialize+ return StoreInput {..}+ x -> fail $ "Unknown input id: " <> cs (show x)++instance Serialize StoreInput where+ put = serialize+ get = deserialize++instance Binary StoreInput where+ put = serialize+ get = deserialize++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,+ inputAddress = a+ } =+ A.object+ [ "coinbase" .= False,+ "txid" .= oph,+ "output" .= opi,+ "sigscript" .= String (encodeHex ss),+ "sequence" .= sq,+ "pkscript" .= String (encodeHex ps),+ "value" .= val,+ "address" .= (addrToJSON net <$> a),+ "witness" .= map encodeHex wit+ ]+storeInputToJSON+ _+ StoreCoinbase+ { inputPoint = OutPoint oph opi,+ inputSequence = sq,+ inputSigScript = ss,+ inputWitness = wit+ } =+ A.object+ [ "coinbase" .= True,+ "txid" .= oph,+ "output" .= opi,+ "sigscript" .= String (encodeHex ss),+ "sequence" .= sq,+ "pkscript" .= Null,+ "value" .= Null,+ "address" .= Null,+ "witness" .= map encodeHex wit+ ]++storeInputToEncoding :: Network -> StoreInput -> Encoding+storeInputToEncoding+ net+ StoreInput+ { inputPoint = OutPoint oph opi,+ inputSequence = sq,+ inputSigScript = ss,+ inputPkScript = ps,+ inputAmount = val,+ inputWitness = wit,+ inputAddress = a+ } =+ AE.pairs $+ "coinbase" .= False+ <> "txid" .= oph+ <> "output" .= opi+ <> "sigscript" `AE.pair` AE.text (encodeHex ss)+ <> "sequence" .= sq+ <> "pkscript" `AE.pair` AE.text (encodeHex ps)+ <> "value" .= val+ <> "address" `AE.pair` maybe AE.null_ (addrToEncoding net) a+ <> "witness" .= map encodeHex wit+storeInputToEncoding+ _+ StoreCoinbase+ { inputPoint = OutPoint oph opi,+ inputSequence = sq,+ inputSigScript = ss,+ inputWitness = wit+ } =+ AE.pairs $+ "coinbase" .= True+ <> "txid" `AE.pair` AE.text (txHashToHex oph)+ <> "output" .= opi+ <> "sigscript" `AE.pair` AE.text (encodeHex ss)+ <> "sequence" .= sq+ <> "pkscript" `AE.pair` AE.null_+ <> "value" `AE.pair` AE.null_+ <> "address" `AE.pair` AE.null_+ <> "witness" .= map encodeHex wit++storeInputParseJSON :: Network -> Value -> Parser StoreInput+storeInputParseJSON net =+ A.withObject "storeinput" $ \o -> do+ coinbase <- o .: "coinbase"+ outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"+ sequ <- o .: "sequence"+ witness <- mapM jsonHex =<< o .:? "witness" .!= []+ 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"+ addr <-+ o .: "address" >>= \case+ Nothing -> return Nothing+ Just a -> Just <$> addrFromJSON net a <|> return Nothing+ return+ StoreInput+ { inputPoint = outpoint,+ inputSequence = sequ,+ inputSigScript = sigscript,+ inputPkScript = pkscript,+ inputAmount = value,+ inputWitness = witness,+ inputAddress = addr+ }++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+ { -- | input transaction hash+ spenderHash :: !TxHash,+ -- | input position in transaction+ spenderIndex :: !Word32+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++instance Serial Spender where+ serialize Spender {..} = do+ serialize spenderHash+ putWord32be spenderIndex+ deserialize = Spender <$> deserialize <*> getWord32be++instance Serialize Spender where+ put = serialize+ get = deserialize++instance Binary Spender where+ put = serialize+ get = deserialize++instance ToJSON Spender where+ toJSON n =+ A.object+ [ "txid" .= txHashToHex (spenderHash n),+ "input" .= spenderIndex n+ ]+ toEncoding n =+ AE.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),+ outputAddr :: !(Maybe Address)+ }+ deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++instance Serial StoreOutput where+ serialize StoreOutput {..} = do+ putWord64be outputAmount+ putLengthBytes outputScript+ putMaybe serialize outputSpender+ putMaybe serialize outputAddr+ deserialize = do+ outputAmount <- getWord64be+ outputScript <- getLengthBytes+ outputSpender <- getMaybe deserialize+ outputAddr <- getMaybe deserialize+ return StoreOutput {..}++instance Serialize StoreOutput where+ put = serialize+ get = deserialize++instance Binary StoreOutput where+ put = serialize+ get = deserialize++storeOutputToJSON :: Network -> StoreOutput -> Value+storeOutputToJSON net d =+ A.object+ [ "address" .= (addrToJSON net <$> outputAddr d),+ "pkscript" .= encodeHex (outputScript d),+ "value" .= outputAmount d,+ "spent" .= isJust (outputSpender d),+ "spender" .= outputSpender d+ ]++storeOutputToEncoding :: Network -> StoreOutput -> Encoding+storeOutputToEncoding net d =+ AE.pairs $+ "address" `AE.pair` maybe AE.null_ (addrToEncoding net) (outputAddr d)+ <> "pkscript" `AE.pair` AE.text (encodeHex (outputScript d))+ <> "value" .= outputAmount d+ <> "spent" .= isJust (outputSpender d)+ <> "spender" .= outputSpender d++storeOutputParseJSON :: Network -> Value -> Parser StoreOutput+storeOutputParseJSON net =+ A.withObject "storeoutput" $ \o -> do+ value <- o .: "value"+ pkscript <- o .: "pkscript" >>= jsonHex+ spender <- o .: "spender"+ addr <-+ o .: "address" >>= \case+ Nothing -> return Nothing+ Just a -> Just <$> addrFromJSON net a <|> return Nothing+ return+ StoreOutput+ { outputAmount = value,+ outputScript = pkscript,+ outputSpender = spender,+ outputAddr = addr+ }++data Prev = Prev+ { prevScript :: !ByteString,+ prevAmount :: !Word64+ }+ deriving (Show, Eq, Ord, Generic, Hashable, NFData)++instance Serial Prev where+ serialize Prev {..} = do+ putLengthBytes prevScript+ putWord64be prevAmount+ deserialize = do+ prevScript <- getLengthBytes+ prevAmount <- getWord64be+ return Prev {..}++instance Binary Prev where+ put = serialize+ get = deserialize++instance Serialize Prev where+ put = serialize+ get = deserialize++toInput :: TxIn -> Maybe Prev -> 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,+ inputAddress = eitherToMaybe (scriptToAddressBS (prevScript p))+ }++toOutput :: TxOut -> Maybe Spender -> StoreOutput+toOutput o s =+ StoreOutput+ { outputAmount = outValue o,+ outputScript = scriptOutput o,+ outputSpender = s,+ outputAddr = eitherToMaybe (scriptToAddressBS (scriptOutput o))+ }++data TxData = TxData+ { txDataBlock :: !BlockRef,+ txData :: !Tx,+ txDataPrevs :: !(IntMap Prev),+ txDataDeleted :: !Bool,+ txDataRBF :: !Bool,+ txDataTime :: !Word64+ }+ deriving (Show, Eq, Ord, Generic, NFData)++instance Serial TxData where+ serialize TxData {..} = do+ serialize txDataBlock+ serialize txData+ putIntMap (putWord64be . fromIntegral) serialize txDataPrevs+ serialize txDataDeleted+ serialize txDataRBF+ putWord64be txDataTime+ deserialize = do+ txDataBlock <- deserialize+ txData <- deserialize+ txDataPrevs <- getIntMap (fromIntegral <$> getWord64be) deserialize+ txDataDeleted <- deserialize+ txDataRBF <- deserialize+ txDataTime <- getWord64be+ return TxData {..}++instance Serialize TxData where+ put = serialize+ get = deserialize++instance Binary TxData where+ put = serialize+ get = deserialize++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,+ transactionId = txid,+ transactionSize = txsize,+ transactionWeight = txweight,+ transactionFees = fees+ }+ where+ txid = txHash (txData t)+ txsize = fromIntegral $ BS.length (runPutS (serialize (txData t)))+ txweight =+ let b = BS.length $ runPutS $ serialize (txData t) {txWitness = []}+ x = BS.length $ runPutS $ serialize (txData t)+ in fromIntegral $ b * 3 + x+ inv = sum (map inputAmount ins)+ outv = sum (map outputAmount outs)+ fees = if any isCoinbase ins then 0 else inv - outv+ ws = take (length (txIn (txData t))) $ txWitness (txData t) <> repeat []+ f n i = toInput i (IntMap.lookup n (txDataPrevs t)) (ws !! n)+ ins = zipWith f [0 ..] (txIn (txData t))+ g n o = toOutput o (IntMap.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 = IntMap.fromList . catMaybes $ zipWith f [0 ..] (transactionInputs t)+ g _ StoreOutput {outputSpender = Nothing} = Nothing+ g n StoreOutput {outputSpender = Just s} = Just (n, s)+ sm = IntMap.fromList . catMaybes $ zipWith g [0 ..] (transactionOutputs t)++-- | Detailed transaction information.+data Transaction = Transaction+ { -- | block information for this transaction+ transactionBlock :: !BlockRef,+ -- | transaction version+ transactionVersion :: !Word32,+ -- | lock time+ transactionLockTime :: !Word32,+ -- | transaction inputs+ transactionInputs :: ![StoreInput],+ -- | transaction outputs+ transactionOutputs :: ![StoreOutput],+ -- | this transaction has been deleted and is no longer valid+ transactionDeleted :: !Bool,+ -- | this transaction can be replaced in the mempool+ transactionRBF :: !Bool,+ -- | time the transaction was first seen or time of block+ transactionTime :: !Word64,+ -- | transaction id+ transactionId :: !TxHash,+ -- | serialized transaction size (includes witness data)+ transactionSize :: !Word32,+ -- | transaction weight+ transactionWeight :: !Word32,+ -- | fees that this transaction pays (0 for coinbase)+ transactionFees :: !Word64+ }+ deriving (Show, Eq, Ord, Generic, Hashable, NFData)++instance Serial Transaction where+ serialize Transaction {..} = do+ serialize transactionBlock+ putWord32be transactionVersion+ putWord32be transactionLockTime+ putList serialize transactionInputs+ putList serialize transactionOutputs+ serialize transactionDeleted+ serialize transactionRBF+ putWord64be transactionTime+ serialize transactionId+ putWord32be transactionSize+ putWord32be transactionWeight+ putWord64be transactionFees+ deserialize = do+ transactionBlock <- deserialize+ transactionVersion <- getWord32be+ transactionLockTime <- getWord32be+ transactionInputs <- getList deserialize+ transactionOutputs <- getList deserialize+ transactionDeleted <- deserialize+ transactionRBF <- deserialize+ transactionTime <- getWord64be+ transactionId <- deserialize+ transactionSize <- getWord32be+ transactionWeight <- getWord32be+ transactionFees <- getWord64be+ return Transaction {..}++instance Serialize Transaction where+ put = serialize+ get = deserialize++instance Binary Transaction where+ put = serialize+ get = deserialize++transactionData :: Transaction -> Tx+transactionData t =+ Tx+ { txVersion = transactionVersion t,+ txIn = map i (transactionInputs t),+ txOut = map o (transactionOutputs t),+ txWitness = w $ map 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}+ w xs+ | all null xs = []+ | otherwise = xs++transactionToJSON :: Network -> Transaction -> Value+transactionToJSON net dtx =+ A.object+ [ "txid" .= transactionId dtx,+ "size" .= transactionSize dtx,+ "version" .= transactionVersion dtx,+ "locktime" .= transactionLockTime dtx,+ "fee" .= transactionFees dtx,+ "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" .= transactionWeight dtx+ ]++transactionToEncoding :: Network -> Transaction -> Encoding+transactionToEncoding net dtx =+ AE.pairs $+ "txid" .= transactionId dtx+ <> "size" .= transactionSize dtx+ <> "version" .= transactionVersion dtx+ <> "locktime" .= transactionLockTime dtx+ <> "fee" .= transactionFees dtx+ <> "inputs"+ `AE.pair` AE.list+ (storeInputToEncoding net)+ (transactionInputs dtx)+ <> "outputs"+ `AE.pair` AE.list+ (storeOutputToEncoding net)+ (transactionOutputs dtx)+ <> "block" .= transactionBlock dtx+ <> "deleted" .= transactionDeleted dtx+ <> "time" .= transactionTime dtx+ <> "rbf" .= transactionRBF dtx+ <> "weight" .= transactionWeight dtx++transactionParseJSON :: Network -> Value -> Parser Transaction+transactionParseJSON net = A.withObject "transaction" $ \o -> do+ version <- o .: "version"+ locktime <- o .: "locktime"+ inputs <- o .: "inputs" >>= mapM (storeInputParseJSON net)+ outputs <- o .: "outputs" >>= mapM (storeOutputParseJSON net)+ block <- o .: "block"+ deleted <- o .: "deleted"+ time <- o .: "time"+ rbf <- o .:? "rbf" .!= False+ weight <- o .:? "weight" .!= 0+ size <- o .: "size"+ txid <- o .: "txid"+ fees <- o .: "fee"+ return+ Transaction+ { transactionBlock = block,+ transactionVersion = version,+ transactionLockTime = locktime,+ transactionInputs = inputs,+ transactionOutputs = outputs,+ transactionDeleted = deleted,+ transactionTime = time,+ transactionRBF = rbf,+ transactionWeight = weight,+ transactionSize = size,+ transactionId = txid,+ transactionFees = fees+ }++-- | Information about a connected peer.+data PeerInformation = PeerInformation+ { -- | user agent string+ peerUserAgent :: !ByteString,+ -- | network address+ peerAddress :: !String,+ -- | version number+ peerVersion :: !Word32,+ -- | services field+ peerServices :: !Word64,+ -- | will relay transactions+ peerRelay :: !Bool+ }+ deriving (Show, Eq, Ord, Generic, NFData)++instance Serial PeerInformation where+ serialize PeerInformation {..} = do+ putLengthBytes peerUserAgent+ putLengthBytes (TE.encodeUtf8 (T.pack peerAddress))+ putWord32be peerVersion+ putWord64be peerServices+ serialize peerRelay+ deserialize = do+ peerUserAgent <- getLengthBytes+ peerAddress <- T.unpack . TE.decodeUtf8 <$> getLengthBytes+ peerVersion <- getWord32be+ peerServices <- getWord64be+ peerRelay <- deserialize+ return PeerInformation {..}++instance Serialize PeerInformation where+ put = serialize+ get = deserialize++instance Binary PeerInformation where+ put = serialize+ get = deserialize++instance ToJSON PeerInformation where+ toJSON p =+ A.object+ [ "useragent" .= String (cs (peerUserAgent p)),+ "address" .= peerAddress p,+ "version" .= peerVersion p,+ "services"+ .= String (encodeHex (runPutS (serialize (peerServices p)))),+ "relay" .= peerRelay p+ ]+ toEncoding p =+ AE.pairs $+ "useragent" `AE.pair` AE.text (cs (peerUserAgent p))+ <> "address" .= peerAddress p+ <> "version" .= peerVersion p+ <> "services"+ `AE.pair` AE.text+ (encodeHex (runPutS (serialize (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 runGetS deserialize 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, NFData)++instance Serial XPubBal where+ serialize XPubBal {..} = do+ putList putWord32be xPubBalPath+ serialize xPubBal+ deserialize = do+ xPubBalPath <- getList getWord32be+ xPubBal <- deserialize+ return XPubBal {..}++instance Serialize XPubBal where+ put = serialize+ get = deserialize++instance Binary XPubBal where+ put = serialize+ get = deserialize++xPubBalToJSON :: Network -> XPubBal -> Value+xPubBalToJSON net XPubBal {xPubBalPath = p, xPubBal = b} =+ A.object ["path" .= p, "balance" .= balanceToJSON net b]++xPubBalToEncoding :: Network -> XPubBal -> Encoding+xPubBalToEncoding net XPubBal {xPubBalPath = p, xPubBal = b} =+ AE.pairs ("path" .= p <> "balance" `AE.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+ { xPubUnspent :: !Unspent,+ xPubUnspentPath :: ![KeyIndex]+ }+ deriving (Show, Eq, Ord, Generic, NFData)++instance Serial XPubUnspent where+ serialize XPubUnspent {..} = do+ putList putWord32be xPubUnspentPath+ serialize xPubUnspent+ deserialize = do+ xPubUnspentPath <- getList getWord32be+ xPubUnspent <- deserialize+ return XPubUnspent {..}++instance Serialize XPubUnspent where+ put = serialize+ get = deserialize++instance Binary XPubUnspent where+ put = serialize+ get = deserialize++xPubUnspentToJSON :: Network -> XPubUnspent -> Value+xPubUnspentToJSON net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =+ A.object ["unspent" .= unspentToJSON net u, "path" .= p]++xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding+xPubUnspentToEncoding net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =+ AE.pairs $ "unspent" `AE.pair` unspentToEncoding net u <> "path" .= p++xPubUnspentParseJSON :: Network -> Value -> Parser XPubUnspent+xPubUnspentParseJSON net =+ A.withObject "xpubunspent" $ \o -> do+ u <- o .: "unspent" >>= unspentParseJSON net+ p <- o .: "path"+ 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, NFData)++instance Serial XPubSummary where+ serialize XPubSummary {..} = do+ putWord64be xPubSummaryConfirmed+ putWord64be xPubSummaryZero+ putWord64be xPubSummaryReceived+ putWord64be xPubUnspentCount+ putWord32be xPubExternalIndex+ putWord32be xPubChangeIndex+ deserialize = do+ xPubSummaryConfirmed <- getWord64be+ xPubSummaryZero <- getWord64be+ xPubSummaryReceived <- getWord64be+ xPubUnspentCount <- getWord64be+ xPubExternalIndex <- getWord32be+ xPubChangeIndex <- getWord32be+ return XPubSummary {..}++instance Binary XPubSummary where+ put = serialize+ get = deserialize++instance Serialize XPubSummary where+ put = serialize+ get = deserialize++instance ToJSON XPubSummary where+ toJSON+ XPubSummary+ { xPubSummaryConfirmed = c,+ xPubSummaryZero = z,+ xPubSummaryReceived = r,+ xPubUnspentCount = u,+ xPubExternalIndex = ext,+ xPubChangeIndex = ch+ } =+ A.object+ [ "balance"+ .= A.object+ [ "confirmed" .= c,+ "unconfirmed" .= z,+ "received" .= r,+ "utxo" .= u+ ],+ "indices"+ .= A.object+ [ "change" .= ch,+ "external" .= ext+ ]+ ]+ toEncoding+ XPubSummary+ { xPubSummaryConfirmed = c,+ xPubSummaryZero = z,+ xPubSummaryReceived = r,+ xPubUnspentCount = u,+ xPubExternalIndex = ext,+ xPubChangeIndex = ch+ } =+ AE.pairs $+ "balance"+ `AE.pair` AE.pairs+ ( "confirmed" .= c+ <> "unconfirmed" .= z+ <> "received" .= r+ <> "utxo" .= u+ )+ <> "indices"+ `AE.pair` AE.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+ }++class Healthy a where+ isOK :: a -> Bool++data BlockHealth = BlockHealth+ { blockHealthHeaders :: !BlockHeight,+ blockHealthBlocks :: !BlockHeight,+ blockHealthMaxDiff :: !Int32+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial BlockHealth where+ serialize h@BlockHealth {..} = do+ serialize (isOK h)+ putWord32be blockHealthHeaders+ putWord32be blockHealthBlocks+ putInt32be blockHealthMaxDiff+ deserialize = do+ k <- deserialize+ blockHealthHeaders <- getWord32be+ blockHealthBlocks <- getWord32be+ blockHealthMaxDiff <- getInt32be+ let h = BlockHealth {..}+ unless (k == isOK h) $ fail "Inconsistent health check"+ return h++instance Serialize BlockHealth where+ put = serialize+ get = deserialize++instance Binary BlockHealth where+ put = serialize+ get = deserialize++instance Healthy BlockHealth where+ isOK BlockHealth {..} =+ h - b <= blockHealthMaxDiff+ where+ h = fromIntegral blockHealthHeaders+ b = fromIntegral blockHealthBlocks++instance ToJSON BlockHealth where+ toJSON h@BlockHealth {..} =+ A.object+ [ "headers" .= blockHealthHeaders,+ "blocks" .= blockHealthBlocks,+ "diff" .= diff,+ "max" .= blockHealthMaxDiff,+ "ok" .= isOK h+ ]+ where+ diff = toInteger blockHealthHeaders - toInteger 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 :: !Int64,+ timeHealthMax :: !Int64+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial TimeHealth where+ serialize h@TimeHealth {..} = do+ serialize (isOK h)+ putInt64be timeHealthAge+ putInt64be timeHealthMax+ deserialize = do+ k <- deserialize+ timeHealthAge <- getInt64be+ timeHealthMax <- getInt64be+ let t = TimeHealth {..}+ unless (k == isOK t) $ fail "Inconsistent health check"+ return t++instance Binary TimeHealth where+ put = serialize+ get = deserialize++instance Serialize TimeHealth where+ put = serialize+ get = deserialize++instance Healthy TimeHealth where+ isOK TimeHealth {..} =+ timeHealthAge <= timeHealthMax++instance ToJSON TimeHealth where+ toJSON h@TimeHealth {..} =+ A.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 :: !Int64,+ countHealthMin :: !Int64+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial CountHealth where+ serialize h@CountHealth {..} = do+ serialize (isOK h)+ putInt64be countHealthNum+ putInt64be countHealthMin+ deserialize = do+ k <- deserialize+ countHealthNum <- getInt64be+ countHealthMin <- getInt64be+ let c = CountHealth {..}+ unless (k == isOK c) $ fail "Inconsistent health check"+ return c++instance Serialize CountHealth where+ put = serialize+ get = deserialize++instance Binary CountHealth where+ put = serialize+ get = deserialize++instance Healthy CountHealth where+ isOK CountHealth {..} =+ countHealthMin <= countHealthNum++instance ToJSON CountHealth where+ toJSON h@CountHealth {..} =+ A.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 MaxHealth = MaxHealth+ { maxHealthNum :: !Int64,+ maxHealthMax :: !Int64+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial MaxHealth where+ serialize h@MaxHealth {..} = do+ serialize $ isOK h+ putInt64be maxHealthNum+ putInt64be maxHealthMax+ deserialize = do+ k <- deserialize+ maxHealthNum <- getInt64be+ maxHealthMax <- getInt64be+ let h = MaxHealth {..}+ unless (k == isOK h) $ fail "Inconsistent health check"+ return h++instance Binary MaxHealth where+ put = serialize+ get = deserialize++instance Serialize MaxHealth where+ put = serialize+ get = deserialize++instance Healthy MaxHealth where+ isOK MaxHealth {..} = maxHealthNum <= maxHealthMax++instance ToJSON MaxHealth where+ toJSON h@MaxHealth {..} =+ A.object+ [ "count" .= maxHealthNum,+ "max" .= maxHealthMax,+ "ok" .= isOK h+ ]++instance FromJSON MaxHealth where+ parseJSON =+ A.withObject "MaxHealth" $ \o -> do+ maxHealthNum <- o .: "count"+ maxHealthMax <- o .: "max"+ return MaxHealth {..}++data HealthCheck = HealthCheck+ { healthBlocks :: !BlockHealth,+ healthLastBlock :: !TimeHealth,+ healthLastTx :: !TimeHealth,+ healthPendingTxs :: !MaxHealth,+ healthPeers :: !CountHealth,+ healthNetwork :: !String,+ healthVersion :: !String+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial HealthCheck where+ serialize h@HealthCheck {..} = do+ serialize (isOK h)+ serialize healthBlocks+ serialize healthLastBlock+ serialize healthLastTx+ serialize healthPendingTxs+ serialize healthPeers+ putLengthBytes ((TE.encodeUtf8 . T.pack) healthNetwork)+ putLengthBytes ((TE.encodeUtf8 . T.pack) healthVersion)+ deserialize = do+ k <- deserialize+ healthBlocks <- deserialize+ healthLastBlock <- deserialize+ healthLastTx <- deserialize+ healthPendingTxs <- deserialize+ healthPeers <- deserialize+ healthNetwork <- T.unpack . TE.decodeUtf8 <$> getLengthBytes+ healthVersion <- T.unpack . TE.decodeUtf8 <$> getLengthBytes+ let h = HealthCheck {..}+ unless (k == isOK h) $ fail "Inconsistent health check"+ return h++instance Binary HealthCheck where+ put = serialize+ get = deserialize++instance Serialize HealthCheck where+ put = serialize+ get = deserialize++instance Healthy HealthCheck where+ isOK HealthCheck {..} =+ isOK healthBlocks+ && isOK healthLastBlock+ && isOK healthLastTx+ && isOK healthPendingTxs+ && isOK healthPeers++instance ToJSON HealthCheck where+ toJSON h@HealthCheck {..} =+ A.object+ [ "blocks" .= healthBlocks,+ "last-block" .= healthLastBlock,+ "last-tx" .= healthLastTx,+ "pending-txs" .= healthPendingTxs,+ "peers" .= healthPeers,+ "net" .= healthNetwork,+ "version" .= healthVersion,+ "ok" .= isOK h+ ]++instance FromJSON HealthCheck where+ parseJSON =+ A.withObject "HealthCheck" $ \o -> do+ healthBlocks <- o .: "blocks"+ healthLastBlock <- o .: "last-block"+ healthLastTx <- o .: "last-tx"+ healthPendingTxs <- o .: "pending-txs"+ healthPeers <- o .: "peers"+ healthNetwork <- o .: "net"+ healthVersion <- o .: "version"+ return HealthCheck {..}++data Event+ = EventBlock !BlockHash+ | EventTx !TxHash+ deriving (Show, Eq, Generic, NFData)++instance Serial Event where+ serialize (EventBlock bh) = putWord8 0x00 >> serialize bh+ serialize (EventTx th) = putWord8 0x01 >> serialize th+ deserialize =+ getWord8 >>= \case+ 0x00 -> EventBlock <$> deserialize+ 0x01 -> EventTx <$> deserialize+ _ -> fail "Not an Event"++instance Serialize Event where+ put = serialize+ get = deserialize++instance Binary Event where+ put = serialize+ get = deserialize++instance ToJSON Event where+ toJSON (EventTx h) =+ A.object+ [ "type" .= String "tx",+ "id" .= h+ ]+ toJSON (EventBlock h) =+ A.object+ [ "type" .= String "block",+ "id" .= h+ ]+ toEncoding (EventTx h) =+ AE.pairs $+ "type" `AE.pair` AE.text "tx"+ <> "id" `AE.pair` AE.text (txHashToHex h)+ toEncoding (EventBlock h) =+ AE.pairs $+ "type" `AE.pair` AE.text "block"+ <> "id" `AE.pair` AE.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, NFData)++instance Serial a => Serial (GenericResult a) where+ serialize (GenericResult x) = serialize x+ deserialize = GenericResult <$> deserialize++instance Serial a => Serialize (GenericResult a) where+ put = serialize+ get = deserialize++instance Serial a => Binary (GenericResult a) where+ put = serialize+ get = deserialize++instance ToJSON a => ToJSON (GenericResult a) where+ toJSON (GenericResult b) = A.object ["result" .= b]+ toEncoding (GenericResult b) = AE.pairs ("result" .= b)++instance FromJSON a => FromJSON (GenericResult a) where+ parseJSON =+ A.withObject "GenericResult" $ \o ->+ GenericResult <$> o .: "result"++newtype RawResult a = RawResult+ { getRawResult :: a+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial a => Serial (RawResult a) where+ serialize (RawResult x) = serialize x+ deserialize = RawResult <$> deserialize++instance Serial a => Serialize (RawResult a) where+ put = serialize+ get = deserialize++instance Serial a => Binary (RawResult a) where+ put = serialize+ get = deserialize++instance Serial a => ToJSON (RawResult a) where+ toJSON (RawResult b) =+ A.object ["result" .= x b]+ where+ x =+ TLE.decodeUtf8+ . BSB.toLazyByteString+ . BSB.lazyByteStringHex+ . runPutL+ . serialize+ toEncoding (RawResult b) =+ AE.pairs $ "result" `AE.pair` AE.unsafeToEncoding str+ where+ str =+ BSB.char7 '"'+ <> BSB.lazyByteStringHex (runPutL (serialize b))+ <> BSB.char7 '"'++instance Serial a => FromJSON (RawResult a) where+ parseJSON =+ A.withObject "RawResult" $ \o -> do+ res <- o .: "result"+ let m =+ eitherToMaybe . Bytes.Get.runGetS deserialize+ =<< decodeHex res+ maybe mzero (return . RawResult) m++newtype SerialList a = SerialList {getSerialList :: [a]}+ deriving (Show, Eq, Generic, NFData)++instance Semigroup (SerialList a) where+ SerialList a <> SerialList b = SerialList (a <> b)++instance Monoid (SerialList a) where+ mempty = SerialList mempty++instance Serial a => Serial (SerialList a) where+ serialize (SerialList ls) = putList serialize ls+ deserialize = SerialList <$> getList deserialize++instance ToJSON a => ToJSON (SerialList a) where+ toJSON (SerialList ls) = toJSON ls+ toEncoding (SerialList ls) = toEncoding ls++instance FromJSON a => FromJSON (SerialList a) where+ parseJSON = fmap SerialList . parseJSON++newtype RawResultList a = RawResultList+ { getRawResultList :: [a]+ }+ deriving (Show, Eq, Generic, NFData)++instance Serial a => Serial (RawResultList a) where+ serialize (RawResultList xs) =+ mapM_ serialize xs+ deserialize = RawResultList <$> go+ where+ go =+ isEmpty >>= \case+ True -> return []+ False -> (:) <$> deserialize <*> go++instance Serial a => Serialize (RawResultList a) where+ put = serialize+ get = deserialize++instance Serial a => Binary (RawResultList a) where+ put = serialize+ get = deserialize++instance Semigroup (RawResultList a) where+ (RawResultList a) <> (RawResultList b) = RawResultList $ a <> b++instance Monoid (RawResultList a) where+ mempty = RawResultList mempty++instance Serial a => ToJSON (RawResultList a) where+ toJSON (RawResultList xs) =+ toJSON $+ TLE.decodeUtf8+ . BSB.toLazyByteString+ . BSB.lazyByteStringHex+ . runPutL+ . serialize+ <$> xs+ toEncoding (RawResultList xs) =+ AE.list (AE.unsafeToEncoding . str) xs+ where+ str x =+ BSB.char7 '"'+ <> BSB.lazyByteStringHex (runPutL (serialize x))+ <> BSB.char7 '"'++instance Serial a => FromJSON (RawResultList a) where+ parseJSON =+ A.withArray "RawResultList" $ \vec ->+ RawResultList <$> mapM parseElem (toList vec)+ where+ parseElem = A.withText "RawResultListElem" $ maybe mzero return . f+ f = eitherToMaybe . Bytes.Get.runGetS deserialize <=< decodeHex++newtype TxId+ = TxId TxHash+ deriving (Show, Eq, Generic, NFData)++instance Serial TxId where+ serialize (TxId h) = serialize h+ deserialize = TxId <$> deserialize++instance Serialize TxId where+ put = serialize+ get = deserialize++instance Binary TxId where+ put = serialize+ get = deserialize++instance ToJSON TxId where+ toJSON (TxId h) = A.object ["txid" .= h]+ toEncoding (TxId h) = AE.pairs ("txid" `AE.pair` AE.text (txHashToHex h))++instance FromJSON TxId where+ parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid"++data Except+ = ThingNotFound+ | ServerError+ | BadRequest+ | UserError !String+ | StringError !String+ | TxIndexConflict ![TxHash]+ | ServerTimeout+ | RequestTooLarge+ deriving (Show, Eq, Ord, Generic, NFData)++instance Exception Except++instance ScottyError Except where+ stringError = StringError+ showError = TL.pack . show++instance ToJSON Except where+ toJSON e =+ A.object $+ case e of+ ThingNotFound ->+ [ "error" .= String "not-found-or-invalid-arg",+ "message" .= String "Item not found or argument invalid"+ ]+ ServerError ->+ [ "error" .= String "server-error",+ "message" .= String "Server error"+ ]+ BadRequest ->+ [ "error" .= String "bad-request",+ "message" .= String "Invalid request"+ ]+ UserError msg' ->+ [ "error" .= String "user-error",+ "message" .= String (cs msg')+ ]+ StringError msg' ->+ [ "error" .= String "string-error",+ "message" .= String (cs msg')+ ]+ TxIndexConflict txids ->+ [ "error" .= String "multiple-tx-index",+ "message" .= String "Multiple txs match that index",+ "txids" .= txids+ ]+ ServerTimeout ->+ [ "error" .= String "server-timeout",+ "message" .= String "Request is taking too long"+ ]+ RequestTooLarge ->+ [ "error" .= String "request-too-large",+ "message" .= String "Request body too large"+ ]++instance FromJSON Except where+ parseJSON =+ A.withObject "Except" $ \o -> do+ ctr <- o .: "error"+ msg' <- o .:? "message" .!= ""+ case ctr of+ String "not-found-or-invalid-arg" ->+ return ThingNotFound+ String "server-error" ->+ return ServerError+ String "bad-request" ->+ return BadRequest+ String "user-error" ->+ return $ UserError msg'+ String "string-error" ->+ return $ StringError msg'+ String "multiple-tx-index" -> do+ txids <- o .: "txids"+ return $ TxIndexConflict txids+ String "server-timeout" ->+ return ServerTimeout+ String "request-too-large" ->+ return RequestTooLarge+ _ -> mzero++toIntTxId :: TxHash -> Word64+toIntTxId h =+ let bs = runPutS (serialize h)+ Right w64 = runGetS getWord64be bs+ in w64 `shift` (-11)++---------------------------------------+-- Blockchain.info API Compatibility --+---------------------------------------++data BinfoBlockId+ = BinfoBlockHash !BlockHash+ | BinfoBlockIndex !Word32+ deriving (Eq, Show, Read, Generic, NFData)++instance Parsable BinfoBlockId where+ parseParam t =+ hex <> igr+ where+ hex = case hexToBlockHash (TL.toStrict t) of+ Nothing -> Left "could not decode txid"+ Just h -> Right $ BinfoBlockHash h+ igr = BinfoBlockIndex <$> parseParam t++data BinfoTxId+ = BinfoTxIdHash !TxHash+ | BinfoTxIdIndex !Word64+ deriving (Eq, Show, Read, Generic, NFData)++encodeBinfoTxId :: Bool -> TxHash -> BinfoTxId+encodeBinfoTxId False = BinfoTxIdHash+encodeBinfoTxId True = BinfoTxIdIndex . toIntTxId++instance Parsable BinfoTxId where+ parseParam t =+ hex <> igr+ where+ hex =+ case hexToTxHash (TL.toStrict t) of+ Nothing -> Left "could not decode txid"+ Just h -> Right $ BinfoTxIdHash h+ igr = BinfoTxIdIndex <$> parseParam t++instance ToJSON BinfoTxId where+ toJSON (BinfoTxIdHash h) = toJSON h+ toJSON (BinfoTxIdIndex i) = toJSON i+ toEncoding (BinfoTxIdHash h) = toEncoding h+ toEncoding (BinfoTxIdIndex i) = toEncoding i++instance FromJSON BinfoTxId where+ parseJSON v =+ BinfoTxIdHash <$> parseJSON v+ <|> BinfoTxIdIndex <$> parseJSON v++data BinfoFilter+ = BinfoFilterAll+ | BinfoFilterSent+ | BinfoFilterReceived+ | BinfoFilterMoved+ | BinfoFilterConfirmed+ | BinfoFilterMempool+ deriving (Eq, Show, Generic, NFData)++instance Parsable BinfoFilter where+ parseParam t =+ parseParam t >>= \case+ (0 :: Int) -> return BinfoFilterAll+ 1 -> return BinfoFilterSent+ 2 -> return BinfoFilterReceived+ 3 -> return BinfoFilterMoved+ 5 -> return BinfoFilterConfirmed+ 6 -> return BinfoFilterAll+ 7 -> return BinfoFilterMempool+ _ -> Left "could not parse filter parameter"++data BinfoMultiAddr = BinfoMultiAddr+ { getBinfoMultiAddrAddresses :: ![BinfoBalance],+ getBinfoMultiAddrWallet :: !BinfoWallet,+ getBinfoMultiAddrTxs :: ![BinfoTx],+ getBinfoMultiAddrInfo :: !BinfoInfo,+ getBinfoMultiAddrRecommendFee :: !Bool,+ getBinfoMultiAddrCashAddr :: !Bool+ }+ deriving (Eq, Show, Generic, NFData)++binfoMultiAddrToJSON :: Network -> BinfoMultiAddr -> Value+binfoMultiAddrToJSON net' BinfoMultiAddr {..} =+ A.object $+ [ "addresses" .= map (binfoBalanceToJSON net) getBinfoMultiAddrAddresses,+ "wallet" .= getBinfoMultiAddrWallet,+ "txs" .= map (binfoTxToJSON net) getBinfoMultiAddrTxs,+ "info" .= getBinfoMultiAddrInfo,+ "recommend_include_fee" .= getBinfoMultiAddrRecommendFee+ ]+ ++ ["cash_addr" .= True | getBinfoMultiAddrCashAddr]+ where+ net = if not getBinfoMultiAddrCashAddr && net' == bch then btc else net'++binfoMultiAddrParseJSON :: Network -> Value -> Parser BinfoMultiAddr+binfoMultiAddrParseJSON net = A.withObject "multiaddr" $ \o -> do+ getBinfoMultiAddrAddresses <-+ mapM (binfoBalanceParseJSON net) =<< o .: "addresses"+ getBinfoMultiAddrWallet <- o .: "wallet"+ getBinfoMultiAddrTxs <-+ mapM (binfoTxParseJSON net) =<< o .: "txs"+ getBinfoMultiAddrInfo <- o .: "info"+ getBinfoMultiAddrRecommendFee <- o .: "recommend_include_fee"+ getBinfoMultiAddrCashAddr <- o .:? "cash_addr" .!= False+ return BinfoMultiAddr {..}++binfoMultiAddrToEncoding :: Network -> BinfoMultiAddr -> Encoding+binfoMultiAddrToEncoding net' BinfoMultiAddr {..} =+ AE.pairs+ ( "addresses" `AE.pair` as+ <> "wallet" .= getBinfoMultiAddrWallet+ <> "txs" `AE.pair` ts+ <> "info" .= getBinfoMultiAddrInfo+ <> "recommend_include_fee" .= getBinfoMultiAddrRecommendFee+ <> if getBinfoMultiAddrCashAddr then "cash_addr" .= True else mempty+ )+ where+ as = AE.list (binfoBalanceToEncoding net) getBinfoMultiAddrAddresses+ ts = AE.list (binfoTxToEncoding net) getBinfoMultiAddrTxs+ net = if not getBinfoMultiAddrCashAddr && net' == bch then btc else net'++data BinfoRawAddr = BinfoRawAddr+ { binfoRawAddr :: !BinfoAddr,+ binfoRawBalance :: !Word64,+ binfoRawTxCount :: !Word64,+ binfoRawUnredeemed :: !Word64,+ binfoRawReceived :: !Word64,+ binfoRawSent :: !Int64,+ binfoRawTxs :: ![BinfoTx]+ }+ deriving (Eq, Show, Generic, NFData)++binfoRawAddrToJSON :: Network -> BinfoRawAddr -> Value+binfoRawAddrToJSON net BinfoRawAddr {..} =+ A.object+ [ "hash160" .= h160,+ "address" .= address,+ "n_tx" .= binfoRawTxCount,+ "n_unredeemed" .= binfoRawUnredeemed,+ "total_received" .= binfoRawReceived,+ "total_sent" .= binfoRawSent,+ "final_balance" .= binfoRawBalance,+ "txs" .= map (binfoTxToJSON net) binfoRawTxs+ ]+ where+ address = case binfoRawAddr of+ BinfoAddr a -> addrToJSON net a+ BinfoXpub x -> xPubToJSON net x+ h160 =+ encodeHex . runPutS . serialize+ <$> case binfoRawAddr of+ BinfoAddr a -> case a of+ PubKeyAddress h -> Just h+ ScriptAddress h -> Just h+ WitnessPubKeyAddress h -> Just h+ _ -> Nothing+ _ -> Nothing++binfoRawAddrToEncoding :: Network -> BinfoRawAddr -> Encoding+binfoRawAddrToEncoding net BinfoRawAddr {..} =+ AE.pairs $+ "hash160" .= h160+ <> "address" `AE.pair` address+ <> "n_tx" .= binfoRawTxCount+ <> "n_unredeemed" .= binfoRawUnredeemed+ <> "total_received" .= binfoRawReceived+ <> "total_sent" .= binfoRawSent+ <> "final_balance" .= binfoRawBalance+ <> "txs" `AE.pair` AE.list (binfoTxToEncoding net) binfoRawTxs+ where+ address = case binfoRawAddr of+ BinfoAddr a -> addrToEncoding net a+ BinfoXpub x -> xPubToEncoding net x+ h160 =+ encodeHex . runPutS . serialize+ <$> case binfoRawAddr of+ BinfoAddr a -> case a of+ PubKeyAddress h -> Just h+ ScriptAddress h -> Just h+ WitnessPubKeyAddress h -> Just h+ _ -> Nothing+ _ -> Nothing++binfoRawAddrParseJSON :: Network -> Value -> Parser BinfoRawAddr+binfoRawAddrParseJSON net = A.withObject "balancetxs" $ \o -> do+ addr <- o .: "address"+ binfoRawAddr <-+ BinfoAddr <$> addrFromJSON net addr+ <|> BinfoXpub <$> xPubFromJSON net addr+ binfoRawBalance <- o .: "final_balance"+ binfoRawUnredeemed <- o .: "n_unredeemed"+ binfoRawTxCount <- o .: "n_tx"+ binfoRawReceived <- o .: "total_received"+ binfoRawSent <- o .: "total_sent"+ binfoRawTxs <- mapM (binfoTxParseJSON net) =<< o .: "txs"+ return BinfoRawAddr {..}++data BinfoShortBal = BinfoShortBal+ { binfoShortBalFinal :: !Word64,+ binfoShortBalTxCount :: !Word64,+ binfoShortBalReceived :: !Word64+ }+ deriving (Eq, Show, Read, Generic, NFData)++instance ToJSON BinfoShortBal where+ toJSON BinfoShortBal {..} =+ A.object+ [ "final_balance" .= binfoShortBalFinal,+ "n_tx" .= binfoShortBalTxCount,+ "total_received" .= binfoShortBalReceived+ ]+ toEncoding BinfoShortBal {..} =+ AE.pairs $+ "final_balance" .= binfoShortBalFinal+ <> "n_tx" .= binfoShortBalTxCount+ <> "total_received" .= binfoShortBalReceived++instance FromJSON BinfoShortBal where+ parseJSON = A.withObject "short_balance" $ \o -> do+ binfoShortBalFinal <- o .: "final_balance"+ binfoShortBalTxCount <- o .: "n_tx"+ binfoShortBalReceived <- o .: "total_received"+ return BinfoShortBal {..}++data BinfoBalance+ = BinfoAddrBalance+ { getBinfoAddress :: !Address,+ getBinfoAddrTxCount :: !Word64,+ getBinfoAddrReceived :: !Word64,+ getBinfoAddrSent :: !Word64,+ getBinfoAddrBalance :: !Word64+ }+ | BinfoXPubBalance+ { getBinfoXPubKey :: !XPubKey,+ getBinfoAddrTxCount :: !Word64,+ getBinfoAddrReceived :: !Word64,+ getBinfoAddrSent :: !Word64,+ getBinfoAddrBalance :: !Word64,+ getBinfoXPubAccountIndex :: !Word32,+ getBinfoXPubChangeIndex :: !Word32+ }+ deriving (Eq, Show, Generic, NFData)++binfoBalanceToJSON :: Network -> BinfoBalance -> Value+binfoBalanceToJSON net BinfoAddrBalance {..} =+ A.object+ [ "address" .= addrToJSON net getBinfoAddress,+ "final_balance" .= getBinfoAddrBalance,+ "n_tx" .= getBinfoAddrTxCount,+ "total_received" .= getBinfoAddrReceived,+ "total_sent" .= getBinfoAddrSent+ ]+binfoBalanceToJSON net BinfoXPubBalance {..} =+ A.object+ [ "address" .= xPubToJSON net getBinfoXPubKey,+ "change_index" .= getBinfoXPubChangeIndex,+ "account_index" .= getBinfoXPubAccountIndex,+ "final_balance" .= getBinfoAddrBalance,+ "n_tx" .= getBinfoAddrTxCount,+ "total_received" .= getBinfoAddrReceived,+ "total_sent" .= getBinfoAddrSent+ ]++binfoBalanceParseJSON :: Network -> Value -> Parser BinfoBalance+binfoBalanceParseJSON net = A.withObject "address" $ \o -> x o <|> a o+ where+ x o = do+ getBinfoXPubKey <- xPubFromJSON net =<< o .: "address"+ getBinfoXPubChangeIndex <- o .: "change_index"+ getBinfoXPubAccountIndex <- o .: "account_index"+ getBinfoAddrBalance <- o .: "final_balance"+ getBinfoAddrTxCount <- o .: "n_tx"+ getBinfoAddrReceived <- o .: "total_received"+ getBinfoAddrSent <- o .: "total_sent"+ return BinfoXPubBalance {..}+ a o = do+ getBinfoAddress <- addrFromJSON net =<< o .: "address"+ getBinfoAddrBalance <- o .: "final_balance"+ getBinfoAddrTxCount <- o .: "n_tx"+ getBinfoAddrReceived <- o .: "total_received"+ getBinfoAddrSent <- o .: "total_sent"+ return BinfoAddrBalance {..}++binfoBalanceToEncoding :: Network -> BinfoBalance -> Encoding+binfoBalanceToEncoding net BinfoAddrBalance {..} =+ AE.pairs+ ( "address" `AE.pair` addrToEncoding net getBinfoAddress+ <> "final_balance" .= getBinfoAddrBalance+ <> "n_tx" .= getBinfoAddrTxCount+ <> "total_received" .= getBinfoAddrReceived+ <> "total_sent" .= getBinfoAddrSent+ )+binfoBalanceToEncoding net BinfoXPubBalance {..} =+ AE.pairs+ ( "address" `AE.pair` xPubToEncoding net getBinfoXPubKey+ <> "change_index" .= getBinfoXPubChangeIndex+ <> "account_index" .= getBinfoXPubAccountIndex+ <> "final_balance" .= getBinfoAddrBalance+ <> "n_tx" .= getBinfoAddrTxCount+ <> "total_received" .= getBinfoAddrReceived+ <> "total_sent" .= getBinfoAddrSent+ )++data BinfoWallet = BinfoWallet+ { getBinfoWalletBalance :: !Word64,+ getBinfoWalletTxCount :: !Word64,+ getBinfoWalletFilteredCount :: !Word64,+ getBinfoWalletTotalReceived :: !Word64,+ getBinfoWalletTotalSent :: !Word64+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoWallet where+ toJSON BinfoWallet {..} =+ A.object+ [ "final_balance" .= getBinfoWalletBalance,+ "n_tx" .= getBinfoWalletTxCount,+ "n_tx_filtered" .= getBinfoWalletFilteredCount,+ "total_received" .= getBinfoWalletTotalReceived,+ "total_sent" .= getBinfoWalletTotalSent+ ]+ toEncoding BinfoWallet {..} =+ AE.pairs+ ( "final_balance" .= getBinfoWalletBalance+ <> "n_tx" .= getBinfoWalletTxCount+ <> "n_tx_filtered" .= getBinfoWalletFilteredCount+ <> "total_received" .= getBinfoWalletTotalReceived+ <> "total_sent" .= getBinfoWalletTotalSent+ )++instance FromJSON BinfoWallet where+ parseJSON = A.withObject "wallet" $ \o -> do+ getBinfoWalletBalance <- o .: "final_balance"+ getBinfoWalletTxCount <- o .: "n_tx"+ getBinfoWalletFilteredCount <- o .: "n_tx_filtered"+ getBinfoWalletTotalReceived <- o .: "total_received"+ getBinfoWalletTotalSent <- o .: "total_sent"+ return BinfoWallet {..}++binfoHexValue :: Word64 -> Text+binfoHexValue w64 =+ let bs = BS.dropWhile (== 0x00) (runPutS (serialize w64))+ in encodeHex $+ if BS.null bs || BS.head bs `testBit` 7+ then BS.cons 0x00 bs+ else bs++data BinfoUnspent = BinfoUnspent+ { getBinfoUnspentHash :: !TxHash,+ getBinfoUnspentOutputIndex :: !Word32,+ getBinfoUnspentScript :: !ByteString,+ getBinfoUnspentValue :: !Word64,+ getBinfoUnspentConfirmations :: !Int32,+ getBinfoUnspentTxIndex :: !BinfoTxId,+ getBinfoUnspentXPub :: !(Maybe BinfoXPubPath)+ }+ deriving (Eq, Show, Generic, NFData)++binfoUnspentToJSON :: Network -> BinfoUnspent -> Value+binfoUnspentToJSON net BinfoUnspent {..} =+ A.object $+ [ "tx_hash_big_endian" .= getBinfoUnspentHash,+ "tx_hash"+ .= encodeHex (runPutS (serialize (getTxHash getBinfoUnspentHash))),+ "tx_output_n" .= getBinfoUnspentOutputIndex,+ "script" .= encodeHex getBinfoUnspentScript,+ "value" .= getBinfoUnspentValue,+ "value_hex" .= binfoHexValue getBinfoUnspentValue,+ "confirmations" .= getBinfoUnspentConfirmations,+ "tx_index" .= getBinfoUnspentTxIndex+ ]+ <> [ "xpub" .= binfoXPubPathToJSON net x+ | x <- maybeToList getBinfoUnspentXPub+ ]++binfoUnspentToEncoding :: Network -> BinfoUnspent -> Encoding+binfoUnspentToEncoding net BinfoUnspent {..} =+ AE.pairs $+ "tx_hash_big_endian" .= getBinfoUnspentHash+ <> "tx_hash"+ .= encodeHex (runPutS (serialize (getTxHash getBinfoUnspentHash)))+ <> "tx_output_n"+ .= getBinfoUnspentOutputIndex+ <> "script"+ .= encodeHex getBinfoUnspentScript+ <> "value"+ .= getBinfoUnspentValue+ <> "value_hex"+ .= binfoHexValue getBinfoUnspentValue+ <> "confirmations"+ .= getBinfoUnspentConfirmations+ <> "tx_index"+ .= getBinfoUnspentTxIndex+ <> maybe+ mempty+ (("xpub" `AE.pair`) . binfoXPubPathToEncoding net)+ getBinfoUnspentXPub++binfoUnspentParseJSON :: Network -> Value -> Parser BinfoUnspent+binfoUnspentParseJSON net = A.withObject "unspent" $ \o -> do+ getBinfoUnspentHash <- o .: "tx_hash_big_endian"+ getBinfoUnspentOutputIndex <- o .: "tx_output_n"+ getBinfoUnspentScript <- maybe mzero return . decodeHex =<< o .: "script"+ getBinfoUnspentValue <- o .: "value"+ getBinfoUnspentConfirmations <- o .: "confirmations"+ getBinfoUnspentTxIndex <- o .: "tx_index"+ getBinfoUnspentXPub <- mapM (binfoXPubPathParseJSON net) =<< o .:? "xpub"+ return BinfoUnspent {..}++newtype BinfoUnspents = BinfoUnspents [BinfoUnspent]+ deriving (Eq, Show, Generic, NFData)++binfoUnspentsToJSON :: Network -> BinfoUnspents -> Value+binfoUnspentsToJSON net (BinfoUnspents us) =+ A.object+ [ "notice" .= T.empty,+ "unspent_outputs" .= map (binfoUnspentToJSON net) us+ ]++binfoUnspentsToEncoding :: Network -> BinfoUnspents -> Encoding+binfoUnspentsToEncoding net (BinfoUnspents us) =+ AE.pairs $+ "notice" .= T.empty+ <> "unspent_outputs" `AE.pair` AE.list (binfoUnspentToEncoding net) us++binfoUnspentsParseJSON :: Network -> Value -> Parser BinfoUnspents+binfoUnspentsParseJSON net = A.withObject "unspents" $ \o -> do+ us <- mapM (binfoUnspentParseJSON net) =<< o .: "unspent_outputs"+ return (BinfoUnspents us)++binfoBlocksToJSON :: Network -> [BinfoBlock] -> Value+binfoBlocksToJSON net blocks =+ A.object ["blocks" .= map (binfoBlockToJSON net) blocks]++binfoBlocksToEncoding :: Network -> [BinfoBlock] -> Encoding+binfoBlocksToEncoding net blocks =+ AE.pairs $ "blocks" `AE.pair` AE.list (binfoBlockToEncoding net) blocks++binfoBlocksParseJSON :: Network -> Value -> Parser [BinfoBlock]+binfoBlocksParseJSON net =+ A.withObject "blocks" $ \o ->+ mapM (binfoBlockParseJSON net) =<< o .: "blocks"++toBinfoBlock :: BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock+toBinfoBlock BlockData {..} txs next_blocks =+ BinfoBlock+ { getBinfoBlockHash = headerHash blockDataHeader,+ getBinfoBlockVer = blockVersion blockDataHeader,+ getBinfoPrevBlock = prevBlock blockDataHeader,+ getBinfoMerkleRoot = merkleRoot blockDataHeader,+ getBinfoBlockTime = blockTimestamp blockDataHeader,+ getBinfoBlockBits = blockBits blockDataHeader,+ getBinfoNextBlock = next_blocks,+ getBinfoBlockFee = blockDataFees,+ getBinfoBlockNonce = bhNonce blockDataHeader,+ getBinfoBlockTxCount = fromIntegral (length txs),+ getBinfoBlockSize = blockDataSize,+ getBinfoBlockIndex = blockDataHeight,+ getBinfoBlockMain = blockDataMainChain,+ getBinfoBlockHeight = blockDataHeight,+ getBinfoBlockWeight = blockDataWeight,+ getBinfoBlockTx = txs+ }++data BinfoBlock = BinfoBlock+ { getBinfoBlockHash :: !BlockHash,+ getBinfoBlockVer :: !Word32,+ getBinfoPrevBlock :: !BlockHash,+ getBinfoMerkleRoot :: !Hash256,+ getBinfoBlockTime :: !Word32,+ getBinfoBlockBits :: !Word32,+ getBinfoNextBlock :: ![BlockHash],+ getBinfoBlockFee :: !Word64,+ getBinfoBlockNonce :: !Word32,+ getBinfoBlockTxCount :: !Word32,+ getBinfoBlockSize :: !Word32,+ getBinfoBlockIndex :: !Word32,+ getBinfoBlockMain :: !Bool,+ getBinfoBlockHeight :: !Word32,+ getBinfoBlockWeight :: !Word32,+ getBinfoBlockTx :: ![BinfoTx]+ }+ deriving (Eq, Show, Generic, NFData)++binfoBlockToJSON :: Network -> BinfoBlock -> Value+binfoBlockToJSON net BinfoBlock {..} =+ A.object+ [ "hash" .= getBinfoBlockHash,+ "ver" .= getBinfoBlockVer,+ "prev_block" .= getBinfoPrevBlock,+ "mrkl_root" .= TxHash getBinfoMerkleRoot,+ "time" .= getBinfoBlockTime,+ "bits" .= getBinfoBlockBits,+ "next_block" .= getBinfoNextBlock,+ "fee" .= getBinfoBlockFee,+ "nonce" .= getBinfoBlockNonce,+ "n_tx" .= getBinfoBlockTxCount,+ "size" .= getBinfoBlockSize,+ "block_index" .= getBinfoBlockIndex,+ "main_chain" .= getBinfoBlockMain,+ "height" .= getBinfoBlockHeight,+ "weight" .= getBinfoBlockWeight,+ "tx" .= map (binfoTxToJSON net) getBinfoBlockTx+ ]++binfoBlockToEncoding :: Network -> BinfoBlock -> Encoding+binfoBlockToEncoding net BinfoBlock {..} =+ AE.pairs $+ "hash" .= getBinfoBlockHash+ <> "ver" .= getBinfoBlockVer+ <> "prev_block" .= getBinfoPrevBlock+ <> "mrkl_root" .= TxHash getBinfoMerkleRoot+ <> "time" .= getBinfoBlockTime+ <> "bits" .= getBinfoBlockBits+ <> "next_block" .= getBinfoNextBlock+ <> "fee" .= getBinfoBlockFee+ <> "nonce" .= getBinfoBlockNonce+ <> "n_tx" .= getBinfoBlockTxCount+ <> "size" .= getBinfoBlockSize+ <> "block_index" .= getBinfoBlockIndex+ <> "main_chain" .= getBinfoBlockMain+ <> "height" .= getBinfoBlockHeight+ <> "weight" .= getBinfoBlockWeight+ <> "tx" `AE.pair` AE.list (binfoTxToEncoding net) getBinfoBlockTx++binfoBlockParseJSON :: Network -> Value -> Parser BinfoBlock+binfoBlockParseJSON net = A.withObject "block" $ \o -> do+ getBinfoBlockHash <- o .: "hash"+ getBinfoBlockVer <- o .: "ver"+ getBinfoPrevBlock <- o .: "prev_block"+ getBinfoMerkleRoot <- getTxHash <$> o .: "mrkl_root"+ getBinfoBlockTime <- o .: "time"+ getBinfoBlockBits <- o .: "bits"+ getBinfoNextBlock <- o .: "next_block"+ getBinfoBlockFee <- o .: "fee"+ getBinfoBlockNonce <- o .: "nonce"+ getBinfoBlockTxCount <- o .: "n_tx"+ getBinfoBlockSize <- o .: "size"+ getBinfoBlockIndex <- o .: "block_index"+ getBinfoBlockMain <- o .: "main_chain"+ getBinfoBlockHeight <- o .: "height"+ getBinfoBlockWeight <- o .: "weight"+ getBinfoBlockTx <- o .: "tx" >>= mapM (binfoTxParseJSON net)+ return BinfoBlock {..}++data BinfoTx = BinfoTx+ { getBinfoTxHash :: !TxHash,+ getBinfoTxVer :: !Word32,+ getBinfoTxVinSz :: !Word32,+ getBinfoTxVoutSz :: !Word32,+ getBinfoTxSize :: !Word32,+ getBinfoTxWeight :: !Word32,+ getBinfoTxFee :: !Word64,+ getBinfoTxRelayedBy :: !ByteString,+ getBinfoTxLockTime :: !Word32,+ getBinfoTxIndex :: !BinfoTxId,+ getBinfoTxDoubleSpend :: !Bool,+ getBinfoTxRBF :: !Bool,+ getBinfoTxResultBal :: !(Maybe (Int64, Int64)),+ getBinfoTxTime :: !Word64,+ getBinfoTxBlockIndex :: !(Maybe Word32),+ getBinfoTxBlockHeight :: !(Maybe Word32),+ getBinfoTxInputs :: [BinfoTxInput],+ getBinfoTxOutputs :: [BinfoTxOutput]+ }+ deriving (Eq, Show, Generic, NFData)++binfoTxToJSON :: Network -> BinfoTx -> Value+binfoTxToJSON net BinfoTx {..} =+ A.object $+ [ "hash" .= getBinfoTxHash,+ "ver" .= getBinfoTxVer,+ "vin_sz" .= getBinfoTxVinSz,+ "vout_sz" .= getBinfoTxVoutSz,+ "size" .= getBinfoTxSize,+ "weight" .= getBinfoTxWeight,+ "fee" .= getBinfoTxFee,+ "relayed_by" .= TE.decodeUtf8 getBinfoTxRelayedBy,+ "lock_time" .= getBinfoTxLockTime,+ "tx_index" .= getBinfoTxIndex,+ "double_spend" .= getBinfoTxDoubleSpend,+ "time" .= getBinfoTxTime,+ "block_index" .= getBinfoTxBlockIndex,+ "block_height" .= getBinfoTxBlockHeight,+ "inputs" .= map (binfoTxInputToJSON net) getBinfoTxInputs,+ "out" .= map (binfoTxOutputToJSON net) getBinfoTxOutputs+ ]+ ++ bal+ ++ rbf+ where+ bal =+ case getBinfoTxResultBal of+ Nothing -> []+ Just (res, bal') -> ["result" .= res, "balance" .= bal']+ rbf = ["rbf" .= True | getBinfoTxRBF]++binfoTxToEncoding :: Network -> BinfoTx -> Encoding+binfoTxToEncoding net BinfoTx {..} =+ AE.pairs $+ "hash" .= getBinfoTxHash+ <> "ver" .= getBinfoTxVer+ <> "vin_sz" .= getBinfoTxVinSz+ <> "vout_sz" .= getBinfoTxVoutSz+ <> "size" .= getBinfoTxSize+ <> "weight" .= getBinfoTxWeight+ <> "fee" .= getBinfoTxFee+ <> "relayed_by" .= TE.decodeUtf8 getBinfoTxRelayedBy+ <> "lock_time" .= getBinfoTxLockTime+ <> "tx_index" .= getBinfoTxIndex+ <> "double_spend" .= getBinfoTxDoubleSpend+ <> "time" .= getBinfoTxTime+ <> "block_index" .= getBinfoTxBlockIndex+ <> "block_height" .= getBinfoTxBlockHeight+ <> "inputs" `AE.pair` AE.list (binfoTxInputToEncoding net) getBinfoTxInputs+ <> "out" `AE.pair` AE.list (binfoTxOutputToEncoding net) getBinfoTxOutputs+ <> bal+ <> rbf+ where+ bal =+ case getBinfoTxResultBal of+ Nothing -> mempty+ Just (res, bal') -> "result" .= res <> "balance" .= bal'+ rbf = if getBinfoTxRBF then "rbf" .= True else mempty++binfoTxParseJSON :: Network -> Value -> Parser BinfoTx+binfoTxParseJSON net = A.withObject "tx" $ \o -> do+ getBinfoTxHash <- o .: "hash"+ getBinfoTxVer <- o .: "ver"+ getBinfoTxVinSz <- o .: "vin_sz"+ getBinfoTxVoutSz <- o .: "vout_sz"+ getBinfoTxSize <- o .: "size"+ getBinfoTxWeight <- o .: "weight"+ getBinfoTxFee <- o .: "fee"+ getBinfoTxRelayedBy <- TE.encodeUtf8 <$> o .: "relayed_by"+ getBinfoTxLockTime <- o .: "lock_time"+ getBinfoTxIndex <- o .: "tx_index"+ getBinfoTxDoubleSpend <- o .: "double_spend"+ getBinfoTxTime <- o .: "time"+ getBinfoTxBlockIndex <- o .: "block_index"+ getBinfoTxBlockHeight <- o .: "block_height"+ getBinfoTxInputs <- o .: "inputs" >>= mapM (binfoTxInputParseJSON net)+ getBinfoTxOutputs <- o .: "out" >>= mapM (binfoTxOutputParseJSON net)+ getBinfoTxRBF <- o .:? "rbf" .!= False+ res <- o .:? "result"+ bal <- o .:? "balance"+ let getBinfoTxResultBal = (,) <$> res <*> bal+ return BinfoTx {..}++data BinfoTxInput = BinfoTxInput+ { getBinfoTxInputSeq :: !Word32,+ getBinfoTxInputWitness :: !ByteString,+ getBinfoTxInputScript :: !ByteString,+ getBinfoTxInputIndex :: !Word32,+ getBinfoTxInputPrevOut :: !BinfoTxOutput+ }+ deriving (Eq, Show, Generic, NFData)++binfoTxInputToJSON :: Network -> BinfoTxInput -> Value+binfoTxInputToJSON net BinfoTxInput {..} =+ A.object+ [ "sequence" .= getBinfoTxInputSeq,+ "witness" .= encodeHex getBinfoTxInputWitness,+ "script" .= encodeHex getBinfoTxInputScript,+ "index" .= getBinfoTxInputIndex,+ "prev_out" .= binfoTxOutputToJSON net getBinfoTxInputPrevOut+ ]++binfoTxInputToEncoding :: Network -> BinfoTxInput -> Encoding+binfoTxInputToEncoding net BinfoTxInput {..} =+ AE.pairs+ ( "sequence" .= getBinfoTxInputSeq+ <> "witness" .= encodeHex getBinfoTxInputWitness+ <> "script" .= encodeHex getBinfoTxInputScript+ <> "index" .= getBinfoTxInputIndex+ <> "prev_out" .= binfoTxOutputToJSON net getBinfoTxInputPrevOut+ )++binfoTxInputParseJSON :: Network -> Value -> Parser BinfoTxInput+binfoTxInputParseJSON net = A.withObject "txin" $ \o -> do+ getBinfoTxInputSeq <- o .: "sequence"+ getBinfoTxInputWitness <-+ maybe mzero return . decodeHex+ =<< o .: "witness"+ getBinfoTxInputScript <-+ maybe mzero return . decodeHex+ =<< o .: "script"+ getBinfoTxInputIndex <- o .: "index"+ getBinfoTxInputPrevOut <-+ o .: "prev_out"+ >>= binfoTxOutputParseJSON net+ return BinfoTxInput {..}++data BinfoTxOutput = BinfoTxOutput+ { getBinfoTxOutputType :: !Int,+ getBinfoTxOutputSpent :: !Bool,+ getBinfoTxOutputValue :: !Word64,+ getBinfoTxOutputIndex :: !Word32,+ getBinfoTxOutputTxIndex :: !BinfoTxId,+ getBinfoTxOutputScript :: !ByteString,+ getBinfoTxOutputSpenders :: ![BinfoSpender],+ getBinfoTxOutputAddress :: !(Maybe Address),+ getBinfoTxOutputXPub :: !(Maybe BinfoXPubPath)+ }+ deriving (Eq, Show, Generic, NFData)++binfoTxOutputToJSON :: Network -> BinfoTxOutput -> Value+binfoTxOutputToJSON net BinfoTxOutput {..} =+ A.object $+ [ "type" .= getBinfoTxOutputType,+ "spent" .= getBinfoTxOutputSpent,+ "value" .= getBinfoTxOutputValue,+ "spending_outpoints" .= getBinfoTxOutputSpenders,+ "n" .= getBinfoTxOutputIndex,+ "tx_index" .= getBinfoTxOutputTxIndex,+ "script" .= encodeHex getBinfoTxOutputScript+ ]+ <> [ "addr" .= addrToJSON net a+ | a <- maybeToList getBinfoTxOutputAddress+ ]+ <> [ "xpub" .= binfoXPubPathToJSON net x+ | x <- maybeToList getBinfoTxOutputXPub+ ]++binfoTxOutputToEncoding :: Network -> BinfoTxOutput -> Encoding+binfoTxOutputToEncoding net BinfoTxOutput {..} =+ AE.pairs $+ mconcat $+ [ "type" .= getBinfoTxOutputType,+ "spent" .= getBinfoTxOutputSpent,+ "value" .= getBinfoTxOutputValue,+ "spending_outpoints" .= getBinfoTxOutputSpenders,+ "n" .= getBinfoTxOutputIndex,+ "tx_index" .= getBinfoTxOutputTxIndex,+ "script" .= encodeHex getBinfoTxOutputScript+ ]+ <> [ "addr" .= addrToJSON net a+ | a <- maybeToList getBinfoTxOutputAddress+ ]+ <> [ "xpub" .= binfoXPubPathToJSON net x+ | x <- maybeToList getBinfoTxOutputXPub+ ]++binfoTxOutputParseJSON :: Network -> Value -> Parser BinfoTxOutput+binfoTxOutputParseJSON net = A.withObject "txout" $ \o -> do+ getBinfoTxOutputType <- o .: "type"+ getBinfoTxOutputSpent <- o .: "spent"+ getBinfoTxOutputValue <- o .: "value"+ getBinfoTxOutputSpenders <- o .: "spending_outpoints"+ getBinfoTxOutputIndex <- o .: "n"+ getBinfoTxOutputTxIndex <- o .: "tx_index"+ getBinfoTxOutputScript <- maybe mzero return . decodeHex =<< o .: "script"+ getBinfoTxOutputAddress <- o .:? "addr" >>= mapM (addrFromJSON net)+ getBinfoTxOutputXPub <- o .:? "xpub" >>= mapM (binfoXPubPathParseJSON net)+ return BinfoTxOutput {..}++data BinfoSpender = BinfoSpender+ { getBinfoSpenderTxIndex :: !BinfoTxId,+ getBinfoSpenderIndex :: !Word32+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoSpender where+ toJSON BinfoSpender {..} =+ A.object+ [ "tx_index" .= getBinfoSpenderTxIndex,+ "n" .= getBinfoSpenderIndex+ ]+ toEncoding BinfoSpender {..} =+ AE.pairs+ ( "tx_index" .= getBinfoSpenderTxIndex+ <> "n" .= getBinfoSpenderIndex+ )++instance FromJSON BinfoSpender where+ parseJSON = A.withObject "spender" $ \o -> do+ getBinfoSpenderTxIndex <- o .: "tx_index"+ getBinfoSpenderIndex <- o .: "n"+ return BinfoSpender {..}++data BinfoXPubPath = BinfoXPubPath+ { getBinfoXPubPathKey :: !XPubKey,+ getBinfoXPubPathDeriv :: !SoftPath+ }+ deriving (Eq, Show, Generic, NFData)++instance Ord BinfoXPubPath where+ compare = compare `on` f+ where+ f b =+ ( xPubParent (getBinfoXPubPathKey b),+ getBinfoXPubPathDeriv b+ )++binfoXPubPathToJSON :: Network -> BinfoXPubPath -> Value+binfoXPubPathToJSON net BinfoXPubPath {..} =+ A.object+ [ "m" .= xPubToJSON net getBinfoXPubPathKey,+ "path" .= ("M" ++ pathToStr getBinfoXPubPathDeriv)+ ]++binfoXPubPathToEncoding :: Network -> BinfoXPubPath -> Encoding+binfoXPubPathToEncoding net BinfoXPubPath {..} =+ AE.pairs $+ "m" `AE.pair` xPubToEncoding net getBinfoXPubPathKey+ <> "path" .= ("M" ++ pathToStr getBinfoXPubPathDeriv)++binfoXPubPathParseJSON :: Network -> Value -> Parser BinfoXPubPath+binfoXPubPathParseJSON net = A.withObject "xpub" $ \o -> do+ getBinfoXPubPathKey <- o .: "m" >>= xPubFromJSON net+ getBinfoXPubPathDeriv <-+ fromMaybe "bad xpub path" . parseSoft <$> o .: "path"+ return BinfoXPubPath {..}++data BinfoInfo = BinfoInfo+ { getBinfoConnected :: !Word32,+ getBinfoConversion :: !Double,+ getBinfoLocal :: !BinfoSymbol,+ getBinfoBTC :: !BinfoSymbol,+ getBinfoLatestBlock :: !BinfoBlockInfo+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoInfo where+ toJSON BinfoInfo {..} =+ A.object+ [ "nconnected" .= getBinfoConnected,+ "conversion" .= getBinfoConversion,+ "symbol_local" .= getBinfoLocal,+ "symbol_btc" .= getBinfoBTC,+ "latest_block" .= getBinfoLatestBlock+ ]+ toEncoding BinfoInfo {..} =+ AE.pairs+ ( "nconnected" .= getBinfoConnected+ <> "conversion" .= getBinfoConversion+ <> "symbol_local" .= getBinfoLocal+ <> "symbol_btc" .= getBinfoBTC+ <> "latest_block" .= getBinfoLatestBlock+ )++instance FromJSON BinfoInfo where+ parseJSON = A.withObject "info" $ \o -> do+ getBinfoConnected <- o .: "nconnected"+ getBinfoConversion <- o .: "conversion"+ getBinfoLocal <- o .: "symbol_local"+ getBinfoBTC <- o .: "symbol_btc"+ getBinfoLatestBlock <- o .: "latest_block"+ return BinfoInfo {..}++data BinfoBlockInfo = BinfoBlockInfo+ { getBinfoBlockInfoHash :: !BlockHash,+ getBinfoBlockInfoHeight :: !BlockHeight,+ getBinfoBlockInfoTime :: !Word32,+ getBinfoBlockInfoIndex :: !BlockHeight+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoBlockInfo where+ toJSON BinfoBlockInfo {..} =+ A.object+ [ "hash" .= getBinfoBlockInfoHash,+ "height" .= getBinfoBlockInfoHeight,+ "time" .= getBinfoBlockInfoTime,+ "block_index" .= getBinfoBlockInfoIndex+ ]+ toEncoding BinfoBlockInfo {..} =+ AE.pairs+ ( "hash" .= getBinfoBlockInfoHash+ <> "height" .= getBinfoBlockInfoHeight+ <> "time" .= getBinfoBlockInfoTime+ <> "block_index" .= getBinfoBlockInfoIndex+ )++instance FromJSON BinfoBlockInfo where+ parseJSON = A.withObject "block_info" $ \o -> do+ getBinfoBlockInfoHash <- o .: "hash"+ getBinfoBlockInfoHeight <- o .: "height"+ getBinfoBlockInfoTime <- o .: "time"+ getBinfoBlockInfoIndex <- o .: "block_index"+ return BinfoBlockInfo {..}++toBinfoBlockInfo :: BlockData -> BinfoBlockInfo+toBinfoBlockInfo BlockData {..} =+ BinfoBlockInfo+ { getBinfoBlockInfoHash = headerHash blockDataHeader,+ getBinfoBlockInfoHeight = blockDataHeight,+ getBinfoBlockInfoTime = blockTimestamp blockDataHeader,+ getBinfoBlockInfoIndex = blockDataHeight+ }++data BinfoRate = BinfoRate+ { binfoRateTime :: !Word64,+ binfoRatePrice :: !Double,+ binfoRateVol24 :: !Double+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoRate where+ toJSON BinfoRate {..} =+ A.object+ [ "timestamp" .= binfoRateTime,+ "price" .= binfoRatePrice,+ "volume24h" .= binfoRateVol24+ ]++instance FromJSON BinfoRate where+ parseJSON = A.withObject "price" $ \o -> do+ binfoRateTime <- o .: "timestamp"+ binfoRatePrice <- o .: "price"+ binfoRateVol24 <- o .: "volume24h"+ return BinfoRate {..}++data BinfoHistory = BinfoHistory+ { binfoHistoryDate :: !Text,+ binfoHistoryTime :: !Text,+ binfoHistoryType :: !Text,+ binfoHistoryAmount :: !Double,+ binfoHistoryValueThen :: !Double,+ binfoHistoryValueNow :: !Double,+ binfoHistoryExchangeRateThen :: !Double,+ binfoHistoryTx :: !TxHash+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoHistory where+ toJSON BinfoHistory {..} =+ A.object+ [ "date" .= binfoHistoryDate,+ "time" .= binfoHistoryTime,+ "type" .= binfoHistoryType,+ "amount" .= binfoHistoryAmount,+ "value_then" .= binfoHistoryValueThen,+ "value_now" .= binfoHistoryValueNow,+ "exchange_rate_then" .= binfoHistoryExchangeRateThen,+ "tx" .= binfoHistoryTx+ ]++instance FromJSON BinfoHistory where+ parseJSON = A.withObject "history" $ \o -> do+ binfoHistoryDate <- o .: "date"+ binfoHistoryTime <- o .: "time"+ binfoHistoryType <- o .: "type"+ binfoHistoryAmount <- o .: "amount"+ binfoHistoryValueThen <- o .: "value_then"+ binfoHistoryValueNow <- o .: "value_now"+ binfoHistoryExchangeRateThen <- o .: "exchange_rate_then"+ binfoHistoryTx <- o .: "tx"+ return BinfoHistory {..}++toBinfoHistory ::+ Int64 ->+ Word64 ->+ Double ->+ Double ->+ TxHash ->+ BinfoHistory+toBinfoHistory satoshi timestamp rate_then rate_now txhash =+ BinfoHistory+ { binfoHistoryDate =+ T.pack $ formatTime defaultTimeLocale "%Y-%m-%d" t,+ binfoHistoryTime =+ T.pack $ formatTime defaultTimeLocale "%H:%M:%S GMT %Ez" t,+ binfoHistoryType =+ if satoshi <= 0 then "sent" else "received",+ binfoHistoryAmount =+ fromRational v,+ binfoHistoryValueThen =+ fromRational v1,+ binfoHistoryValueNow =+ fromRational v2,+ binfoHistoryExchangeRateThen =+ rate_then,+ binfoHistoryTx =+ txhash+ }+ where+ t = posixSecondsToUTCTime (realToFrac timestamp)+ v = toRational satoshi / (100 * 1000 * 1000)+ r1 = toRational rate_then+ r2 = toRational rate_now+ v1 = v * r1+ v2 = v * r2++newtype BinfoDate = BinfoDate Word64+ deriving (Eq, Show, Read, Generic, NFData)++instance Parsable BinfoDate where+ parseParam t =+ maybeToEither "Cannot parse date"+ . fmap (BinfoDate . round . utcTimeToPOSIXSeconds)+ $ p "%d-%m-%Y" <|> p "%d/%m/%Y"+ where+ s = TL.unpack t+ p fmt = parseTimeM False defaultTimeLocale fmt s++data BinfoTicker = BinfoTicker+ { binfoTicker15m :: !Double,+ binfoTickerLast :: !Double,+ binfoTickerBuy :: !Double,+ binfoTickerSell :: !Double,+ binfoTickerSymbol :: !Text+ }+ deriving (Eq, Show, Generic, NFData)++instance Default BinfoTicker where+ def =+ BinfoTicker+ { binfoTickerSymbol = "XXX",+ binfoTicker15m = 0.0,+ binfoTickerLast = 0.0,+ binfoTickerBuy = 0.0,+ binfoTickerSell = 0.0+ }++instance ToJSON BinfoTicker where+ toJSON BinfoTicker {..} =+ A.object+ [ "symbol" .= binfoTickerSymbol,+ "sell" .= binfoTickerSell,+ "buy" .= binfoTickerBuy,+ "last" .= binfoTickerLast,+ "15m" .= binfoTicker15m+ ]+ toEncoding BinfoTicker {..} =+ AE.pairs $+ "symbol" .= binfoTickerSymbol+ <> "sell" .= binfoTickerSell+ <> "buy" .= binfoTickerBuy+ <> "last" .= binfoTickerLast+ <> "15m" .= binfoTicker15m++instance FromJSON BinfoTicker where+ parseJSON = A.withObject "ticker" $ \o -> do+ binfoTickerSymbol <- o .: "symbol"+ binfoTicker15m <- o .: "15m"+ binfoTickerSell <- o .: "sell"+ binfoTickerBuy <- o .: "buy"+ binfoTickerLast <- o .: "last"+ return BinfoTicker {..}++data BinfoSymbol = BinfoSymbol+ { getBinfoSymbolCode :: !Text,+ getBinfoSymbolString :: !Text,+ getBinfoSymbolName :: !Text,+ getBinfoSymbolConversion :: !Double,+ getBinfoSymbolAfter :: !Bool,+ getBinfoSymbolLocal :: !Bool+ }+ deriving (Eq, Show, Generic, NFData)++instance Default BinfoSymbol where+ def =+ BinfoSymbol+ { getBinfoSymbolCode = "XXX",+ getBinfoSymbolString = "¤",+ getBinfoSymbolName = "No currency",+ getBinfoSymbolConversion = 0.0,+ getBinfoSymbolAfter = False,+ getBinfoSymbolLocal = True+ }++instance ToJSON BinfoSymbol where+ toJSON BinfoSymbol {..} =+ A.object+ [ "code" .= getBinfoSymbolCode,+ "symbol" .= getBinfoSymbolString,+ "name" .= getBinfoSymbolName,+ "conversion" .= getBinfoSymbolConversion,+ "symbolAppearsAfter" .= getBinfoSymbolAfter,+ "local" .= getBinfoSymbolLocal+ ]+ toEncoding BinfoSymbol {..} =+ AE.pairs+ ( "code" .= getBinfoSymbolCode+ <> "symbol" .= getBinfoSymbolString+ <> "name" .= getBinfoSymbolName+ <> "conversion" .= getBinfoSymbolConversion+ <> "symbolAppearsAfter" .= getBinfoSymbolAfter+ <> "local" .= getBinfoSymbolLocal+ )++instance FromJSON BinfoSymbol where+ parseJSON = A.withObject "symbol" $ \o -> do+ getBinfoSymbolCode <- o .: "code"+ getBinfoSymbolString <- o .: "symbol"+ getBinfoSymbolName <- o .: "name"+ getBinfoSymbolConversion <- o .: "conversion"+ getBinfoSymbolAfter <- o .: "symbolAppearsAfter"+ getBinfoSymbolLocal <- o .: "local"+ return BinfoSymbol {..}++relevantTxs ::+ HashSet Address ->+ Bool ->+ Transaction ->+ HashSet TxHash+relevantTxs addrs prune t@Transaction {..} =+ let p a = prune && getTxResult addrs t > 0 && not (HashSet.member a addrs)+ f StoreOutput {..} =+ case outputSpender of+ Nothing -> Nothing+ Just Spender {..} ->+ case outputAddr of+ Nothing -> Nothing+ Just a+ | p a -> Nothing+ | otherwise -> Just spenderHash+ outs = mapMaybe f transactionOutputs+ g StoreCoinbase {} = Nothing+ g StoreInput {inputPoint = OutPoint {..}} = Just outPointHash+ ins = mapMaybe g transactionInputs+ in HashSet.fromList $ ins <> outs++toBinfoAddrs ::+ HashMap Address Balance ->+ HashMap XPubSpec [XPubBal] ->+ HashMap XPubSpec Word64 ->+ [BinfoBalance]+toBinfoAddrs only_addrs only_xpubs xpub_txs =+ xpub_bals <> addr_bals+ where+ xpub_bal k xs =+ let f x = case xPubBalPath x of+ [0, _] -> balanceTotalReceived (xPubBal x)+ _ -> 0+ g x = balanceAmount (xPubBal x) + balanceZero (xPubBal x)+ i m x = case xPubBalPath x of+ [m', n] | m == m' -> n + 1+ _ -> 0+ received = sum (map f xs)+ bal = fromIntegral (sum (map g xs))+ sent = if bal <= received then received - bal else 0+ count = HashMap.lookupDefault 0 k xpub_txs+ ax = foldl max 0 (map (i 0) xs)+ cx = foldl max 0 (map (i 1) xs)+ in BinfoXPubBalance+ { getBinfoXPubKey = xPubSpecKey k,+ getBinfoAddrTxCount = count,+ getBinfoAddrReceived = received,+ getBinfoAddrSent = sent,+ getBinfoAddrBalance = bal,+ getBinfoXPubAccountIndex = ax,+ getBinfoXPubChangeIndex = cx+ }+ xpub_bals = map (uncurry xpub_bal) (HashMap.toList only_xpubs)+ addr_bals =+ let f Balance {..} =+ let addr = balanceAddress+ sent = recv - bal+ recv = balanceTotalReceived+ tx_count = balanceTxCount+ bal = balanceAmount + balanceZero+ in BinfoAddrBalance+ { getBinfoAddress = addr,+ getBinfoAddrTxCount = tx_count,+ getBinfoAddrReceived = recv,+ getBinfoAddrSent = sent,+ getBinfoAddrBalance = bal+ }+ in map f $ HashMap.elems only_addrs++toBinfoTxSimple ::+ Bool ->+ Transaction ->+ BinfoTx+toBinfoTxSimple numtxid =+ toBinfoTx numtxid HashMap.empty False 0++toBinfoTxInputs ::+ Bool ->+ HashMap Address (Maybe BinfoXPubPath) ->+ Transaction ->+ [BinfoTxInput]+toBinfoTxInputs numtxid abook t =+ zipWith f [0 ..] (transactionInputs t)+ where+ f n i =+ BinfoTxInput+ { getBinfoTxInputIndex = n,+ getBinfoTxInputSeq = inputSequence i,+ getBinfoTxInputScript = inputSigScript i,+ getBinfoTxInputWitness = wit i,+ getBinfoTxInputPrevOut = prev n i+ }+ wit i =+ case inputWitness i of+ [] -> BS.empty+ ws -> runPutS (put_witness ws)+ prev = inputToBinfoTxOutput numtxid abook t+ put_witness ws = do+ putVarInt (length ws)+ mapM_ put_item ws+ put_item bs = do+ putVarInt (BS.length bs)+ putByteString bs++toBinfoBlockIndex :: Transaction -> Maybe BlockHeight+toBinfoBlockIndex Transaction {transactionDeleted = True} = Nothing+toBinfoBlockIndex Transaction {transactionBlock = MemRef _} = Nothing+toBinfoBlockIndex Transaction {transactionBlock = BlockRef h _} = Just h++toBinfoTx ::+ Bool ->+ HashMap Address (Maybe BinfoXPubPath) ->+ Bool ->+ Int64 ->+ Transaction ->+ BinfoTx+toBinfoTx numtxid abook prune bal t@Transaction {..} =+ BinfoTx+ { getBinfoTxHash = txHash (transactionData t),+ getBinfoTxVer = transactionVersion,+ getBinfoTxVinSz = fromIntegral (length transactionInputs),+ getBinfoTxVoutSz = fromIntegral (length transactionOutputs),+ getBinfoTxSize = transactionSize,+ getBinfoTxWeight = transactionWeight,+ getBinfoTxFee = transactionFees,+ getBinfoTxRelayedBy = "0.0.0.0",+ getBinfoTxLockTime = transactionLockTime,+ getBinfoTxIndex =+ encodeBinfoTxId numtxid (txHash (transactionData t)),+ getBinfoTxDoubleSpend = transactionDeleted,+ getBinfoTxRBF = transactionRBF,+ getBinfoTxTime = transactionTime,+ getBinfoTxBlockIndex = toBinfoBlockIndex t,+ getBinfoTxBlockHeight = toBinfoBlockIndex t,+ getBinfoTxInputs = toBinfoTxInputs numtxid abook t,+ getBinfoTxOutputs = outs,+ getBinfoTxResultBal = resbal+ }+ where+ simple = HashMap.null abook && bal == 0+ resbal = if simple then Nothing else Just (getTxResult aset t, bal)+ aset = HashMap.keysSet abook+ outs =+ let p = prune && getTxResult aset t > 0+ f = toBinfoTxOutput numtxid abook p t+ in catMaybes $ zipWith f [0 ..] transactionOutputs++getTxResult :: HashSet Address -> Transaction -> Int64+getTxResult aset Transaction {..} =+ let input_sum = sum $ map input_value transactionInputs+ input_value StoreCoinbase {} = 0+ input_value StoreInput {..} =+ case inputAddress of+ Nothing -> 0+ Just a ->+ if test_addr a+ then negate $ fromIntegral inputAmount+ else 0+ test_addr a = HashSet.member a aset+ output_sum = sum $ map out_value transactionOutputs+ out_value StoreOutput {..} =+ case outputAddr of+ Nothing -> 0+ Just a ->+ if test_addr a+ then fromIntegral outputAmount+ else 0+ in input_sum + output_sum++toBinfoTxOutput ::+ Bool ->+ HashMap Address (Maybe BinfoXPubPath) ->+ Bool ->+ Transaction ->+ Word32 ->+ StoreOutput ->+ Maybe BinfoTxOutput+toBinfoTxOutput numtxid abook prune t n StoreOutput {..} =+ let getBinfoTxOutputType = 0+ getBinfoTxOutputSpent = isJust outputSpender+ getBinfoTxOutputValue = outputAmount+ getBinfoTxOutputIndex = n+ getBinfoTxOutputTxIndex =+ encodeBinfoTxId numtxid (txHash (transactionData t))+ getBinfoTxOutputScript = outputScript+ getBinfoTxOutputSpenders =+ maybeToList $ toBinfoSpender numtxid <$> outputSpender+ getBinfoTxOutputAddress = outputAddr+ getBinfoTxOutputXPub =+ outputAddr >>= join . (`HashMap.lookup` abook)+ in if prune && isNothing (outputAddr >>= (`HashMap.lookup` abook))+ then Nothing+ else Just BinfoTxOutput {..}++toBinfoSpender :: Bool -> Spender -> BinfoSpender+toBinfoSpender numtxid Spender {..} =+ let getBinfoSpenderTxIndex = encodeBinfoTxId numtxid spenderHash+ getBinfoSpenderIndex = spenderIndex+ in BinfoSpender {..}++inputToBinfoTxOutput ::+ Bool ->+ HashMap Address (Maybe BinfoXPubPath) ->+ Transaction ->+ Word32 ->+ StoreInput ->+ BinfoTxOutput+inputToBinfoTxOutput numtxid abook t n i =+ BinfoTxOutput+ { getBinfoTxOutputIndex = out_index,+ getBinfoTxOutputType = 0,+ getBinfoTxOutputSpent = True,+ getBinfoTxOutputValue = inputAmount,+ getBinfoTxOutputTxIndex = encodeBinfoTxId numtxid out_hash,+ getBinfoTxOutputScript = inputPkScript,+ getBinfoTxOutputSpenders = [spender],+ getBinfoTxOutputAddress = inputAddress,+ getBinfoTxOutputXPub = xpub+ }+ where+ inputAmount =+ case i of+ StoreCoinbase {} -> 0+ StoreInput {..} -> inputAmount+ inputPkScript =+ case i of+ StoreCoinbase {} -> BS.empty+ StoreInput {..} -> inputPkScript+ inputAddress =+ case i of+ StoreCoinbase {} -> Nothing+ StoreInput {..} -> inputAddress+ OutPoint out_hash out_index = inputPoint i+ spender =+ BinfoSpender+ (encodeBinfoTxId numtxid (txHash (transactionData t)))+ n+ xpub = inputAddress >>= join . (`HashMap.lookup` abook)++data BinfoAddr+ = BinfoAddr !Address+ | BinfoXpub !XPubKey+ deriving (Eq, Show, Generic, Hashable, NFData)++parseBinfoAddr :: Network -> Text -> Maybe [BinfoAddr]+parseBinfoAddr _ "" = Just []+parseBinfoAddr net s =+ mapM f $+ filter (not . T.null) $+ concatMap (T.splitOn ",") (T.splitOn "|" s)+ where+ f x = BinfoAddr <$> textToAddr net x <|> BinfoXpub <$> xPubImport net x++data BinfoHeader = BinfoHeader+ { binfoHeaderHash :: !BlockHash,+ binfoHeaderTime :: !Timestamp,+ binfoHeaderIndex :: !Word32,+ binfoHeaderHeight :: !BlockHeight,+ binfoTxIndices :: ![BinfoTxId]+ }+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoHeader where+ toJSON BinfoHeader {..} =+ A.object+ [ "hash" .= binfoHeaderHash,+ "time" .= binfoHeaderTime,+ "block_index" .= binfoHeaderIndex,+ "height" .= binfoHeaderHeight,+ "txIndexes" .= binfoTxIndices+ ]++instance FromJSON BinfoHeader where+ parseJSON = A.withObject "header" $ \o -> do+ binfoHeaderHash <- o .: "hash"+ binfoHeaderTime <- o .: "time"+ binfoHeaderIndex <- o .: "block_index"+ binfoHeaderHeight <- o .: "height"+ binfoTxIndices <- o .: "txIndexes"+ return BinfoHeader {..}++newtype BinfoMempool = BinfoMempool {getBinfoMempool :: [BinfoTx]}+ deriving (Eq, Show, Generic, NFData)++binfoMempoolToJSON :: Network -> BinfoMempool -> Value+binfoMempoolToJSON net (BinfoMempool txs) =+ A.object ["txs" .= map (binfoTxToJSON net) txs]++binfoMempoolToEncoding :: Network -> BinfoMempool -> Encoding+binfoMempoolToEncoding net (BinfoMempool txs) =+ AE.pairs $ AE.pair "txs" (AE.list (binfoTxToEncoding net) txs)++binfoMempoolParseJSON :: Network -> Value -> Parser BinfoMempool+binfoMempoolParseJSON net =+ A.withObject "mempool" $ \o ->+ BinfoMempool <$> (mapM (binfoTxParseJSON net) =<< o .: "txs")++newtype BinfoBlocks = BinfoBlocks {binfoBlocks :: [BinfoBlockInfo]}+ deriving (Eq, Show, Generic, NFData)++instance ToJSON BinfoBlocks where+ toJSON BinfoBlocks {..} = A.object ["blocks" .= binfoBlocks]++instance FromJSON BinfoBlocks where+ parseJSON = A.withObject "blocks" $ \o -> BinfoBlocks <$> o .: "blocks"
src/Haskoin/Store/WebClient.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -module Haskoin.Store.WebClient (- ApiConfig (..),+module Haskoin.Store.WebClient+ ( ApiConfig (..), apiCall, apiBatch, -- Blocks@@ -60,7 +60,8 @@ Store.DeriveType (..), NoCache (..), NoTx (..),-) where+ )+where import Control.Arrow (second) import Control.Exception@@ -89,163 +90,160 @@ import Network.Wreq.Types (ResponseChecker) import Numeric.Natural (Natural) -{- | Configuration specifying the Network and the Host for API calls.- Default instance:-- @- ApiConfig- { configNetwork = bch- , configHost = "https://api.haskoin.com/"- }- @--}+-- | Configuration specifying the Network and the Host for API calls.+-- Default instance:+--+-- @+-- ApiConfig+-- { configNetwork = bch+-- , configHost = "https://api.haskoin.com/"+-- }+-- @ data ApiConfig = ApiConfig- { configNetwork :: !Network- , configHost :: !String- }- deriving (Eq, Show)+ { configNetwork :: !Network,+ configHost :: !String+ }+ deriving (Eq, Show) instance Default ApiConfig where- def =- ApiConfig- { configNetwork = bch- , configHost = "https://api.haskoin.com/"- }--{- | Make a call to the haskoin-store API.-- Usage (default options):-- > apiCall def $ GetAddrsTxs addrs def-- With options:+ def =+ ApiConfig+ { configNetwork = bch,+ configHost = "https://api.haskoin.com/"+ } - > apiCall def $ GetAddrsUnspent addrs def{ paramLimit = Just 10 }--}+-- | Make a call to the haskoin-store API.+--+-- Usage (default options):+--+-- > apiCall def $ GetAddrsTxs addrs def+--+-- With options:+--+-- > apiCall def $ GetAddrsUnspent addrs def{ paramLimit = Just 10 } apiCall ::- (ApiResource a b, MonadIO m, MonadError Store.Except m) =>- ApiConfig ->- a ->- m b+ (ApiResource a b, MonadIO m, MonadError Store.Except m) =>+ ApiConfig ->+ a ->+ m b apiCall (ApiConfig net apiHost) res = do- args <- liftEither $ toOptions net res- let url = apiHost <> getNetworkName net <> cs (queryPath net res)- case resourceMethod $ asProxy res of- GET -> liftEither =<< liftIO (getBinary args url)- POST ->- case resourceBody res of- Just (PostBox val) ->- liftEither =<< liftIO (postBinary args url val)- _ -> throwError $ Store.StringError "Could not post resource"- _ -> throwError $ Store.StringError "Unsupported HTTP method"--{- | Batch commands that have a large list of arguments:+ args <- liftEither $ toOptions net res+ let url = apiHost <> getNetworkName net <> cs (queryPath net res)+ case resourceMethod $ asProxy res of+ GET -> liftEither =<< liftIO (getBinary args url)+ POST ->+ case resourceBody res of+ Just (PostBox val) ->+ liftEither =<< liftIO (postBinary args url val)+ _ -> throwError $ Store.StringError "Could not post resource"+ _ -> throwError $ Store.StringError "Unsupported HTTP method" - > apiBatch 20 def (GetAddrsTxs addrs def)--}+-- | Batch commands that have a large list of arguments:+--+-- > apiBatch 20 def (GetAddrsTxs addrs def) apiBatch ::- (Batchable a b, MonadIO m, MonadError Store.Except m) =>- Natural ->- ApiConfig ->- a ->- m b+ (Batchable a b, MonadIO m, MonadError Store.Except m) =>+ Natural ->+ ApiConfig ->+ a ->+ m b apiBatch i conf res = mconcat <$> mapM (apiCall conf) (resourceBatch i res) class (ApiResource a b, Monoid b) => Batchable a b where- resourceBatch :: Natural -> a -> [a]+ resourceBatch :: Natural -> a -> [a] instance Batchable GetBlocks (Store.SerialList Store.BlockData) where- resourceBatch i (GetBlocks hs t) =- (`GetBlocks` t) <$> chunksOf i hs+ resourceBatch i (GetBlocks hs t) =+ (`GetBlocks` t) <$> chunksOf i hs instance Batchable GetBlockHeights (Store.SerialList Store.BlockData) where- resourceBatch i (GetBlockHeights (HeightsParam hs) n) =- (`GetBlockHeights` n)- <$> (HeightsParam <$> chunksOf i hs)+ resourceBatch i (GetBlockHeights (HeightsParam hs) n) =+ (`GetBlockHeights` n)+ <$> (HeightsParam <$> chunksOf i hs) instance Batchable GetTxs (Store.SerialList Store.Transaction) where- resourceBatch i (GetTxs ts) =- GetTxs <$> chunksOf i ts+ resourceBatch i (GetTxs ts) =+ GetTxs <$> chunksOf i ts instance Batchable GetTxsRaw (Store.RawResultList Tx) where- resourceBatch i (GetTxsRaw ts) =- GetTxsRaw <$> chunksOf i ts+ resourceBatch i (GetTxsRaw ts) =+ GetTxsRaw <$> chunksOf i ts instance Batchable GetAddrsTxs (Store.SerialList Store.TxRef) where- resourceBatch i (GetAddrsTxs as l) =- (`GetAddrsTxs` l) <$> chunksOf i as+ resourceBatch i (GetAddrsTxs as l) =+ (`GetAddrsTxs` l) <$> chunksOf i as instance Batchable GetAddrsTxsFull (Store.SerialList Store.Transaction) where- resourceBatch i (GetAddrsTxsFull as l) =- (`GetAddrsTxsFull` l) <$> chunksOf i as+ resourceBatch i (GetAddrsTxsFull as l) =+ (`GetAddrsTxsFull` l) <$> chunksOf i as instance Batchable GetAddrsBalance (Store.SerialList Store.Balance) where- resourceBatch i (GetAddrsBalance as) =- GetAddrsBalance <$> chunksOf i as+ resourceBatch i (GetAddrsBalance as) =+ GetAddrsBalance <$> chunksOf i as instance Batchable GetAddrsUnspent (Store.SerialList Store.Unspent) where- resourceBatch i (GetAddrsUnspent as l) =- (`GetAddrsUnspent` l) <$> chunksOf i as+ resourceBatch i (GetAddrsUnspent as l) =+ (`GetAddrsUnspent` l) <$> chunksOf i as ------------------ -- API Internal -- ------------------ toOptions ::- ApiResource a b => Network -> a -> Either Store.Except (Endo HTTP.Options)+ ApiResource a b => Network -> a -> Either Store.Except (Endo HTTP.Options) toOptions net res =- mconcat <$> mapM f (snd $ queryParams res)+ mconcat <$> mapM f (snd $ queryParams res) where f (ParamBox p) = toOption net p toOption :: Param a => Network -> a -> Either Store.Except (Endo HTTP.Options) toOption net a = do- res <- maybeToEither (Store.UserError "Invalid Param") $ encodeParam net a- return $ applyOpt (paramLabel a) res+ res <- maybeToEither (Store.UserError "Invalid Param") $ encodeParam net a+ return $ applyOpt (paramLabel a) res applyOpt :: Text -> [Text] -> Endo HTTP.Options applyOpt p t = Endo $ HTTP.param p .~ [Text.intercalate "," t] getBinary ::- Serial a =>- Endo HTTP.Options ->- String ->- IO (Either Store.Except a)+ Serial a =>+ Endo HTTP.Options ->+ String ->+ IO (Either Store.Except a) getBinary opts url = do- resE <- try $ HTTP.getWith (binaryOpts opts) url- return $ do- res <- resE- toExcept $ runGetS deserialize $ BL.toStrict $ res ^. HTTP.responseBody+ resE <- try $ HTTP.getWith (binaryOpts opts) url+ return $ do+ res <- resE+ toExcept $ runGetS deserialize $ BL.toStrict $ res ^. HTTP.responseBody postBinary ::- (Serial a, Serial r) =>- Endo HTTP.Options ->- String ->- a ->- IO (Either Store.Except r)+ (Serial a, Serial r) =>+ Endo HTTP.Options ->+ String ->+ a ->+ IO (Either Store.Except r) postBinary opts url body = do- resE <- try $ HTTP.postWith (binaryOpts opts) url (runPutL (serialize body))- return $ do- res <- resE- toExcept $ runGetL deserialize $ res ^. HTTP.responseBody+ resE <- try $ HTTP.postWith (binaryOpts opts) url (runPutL (serialize body))+ return $ do+ res <- resE+ toExcept $ runGetL deserialize $ res ^. HTTP.responseBody binaryOpts :: Endo HTTP.Options -> HTTP.Options binaryOpts opts =- appEndo (opts <> accept <> stat) HTTP.defaults+ appEndo (opts <> accept <> stat) HTTP.defaults where accept = Endo $ HTTP.header "Accept" .~ ["application/octet-stream"] stat = Endo $ HTTP.checkResponse ?~ checkStatus checkStatus :: ResponseChecker checkStatus req res- | statusIsSuccessful status = return ()- | isHealthPath && code == 503 = return () -- Ignore health checks- | otherwise = do- e <- A.decodeStrict <$> res ^. HTTP.responseBody- throwIO $- case e of- Just except -> except :: Store.Except- Nothing -> Store.StringError "could not decode error"+ | statusIsSuccessful status = return ()+ | isHealthPath && code == 503 = return () -- Ignore health checks+ | otherwise = do+ e <- A.decodeStrict <$> res ^. HTTP.responseBody+ throwIO $+ case e of+ Just except -> except :: Store.Except+ Nothing -> Store.StringError "could not decode error" where code = res ^. HTTP.responseStatus . HTTP.statusCode message = res ^. HTTP.responseStatus . HTTP.statusMessage@@ -262,6 +260,6 @@ chunksOf :: Natural -> [a] -> [[a]] chunksOf n xs- | null xs = []- | otherwise =- uncurry (:) $ second (chunksOf n) $ splitAt (fromIntegral n) xs+ | null xs = []+ | otherwise =+ uncurry (:) $ second (chunksOf n) $ splitAt (fromIntegral n) xs
src/Haskoin/Store/WebCommon.hs view
@@ -18,12 +18,12 @@ import Data.Text (Text) import qualified Data.Text as T import Haskoin.Address-import Haskoin.Block (- Block,+import Haskoin.Block+ ( Block, BlockHash, blockHashToHex, hexToBlockHash,- )+ ) import Haskoin.Constants import Haskoin.Crypto (Hash256) import Haskoin.Data@@ -40,18 +40,20 @@ ------------------- class Serial b => ApiResource a b | a -> b where- resourceMethod :: Proxy a -> StdMethod- resourceMethod _ = GET- resourcePath :: Proxy a -> ([Text] -> Text)- queryParams :: a -> ([ParamBox], [ParamBox]) -- (resource, querystring)- queryParams _ = ([], [])- captureParams :: Proxy a -> [ProxyBox]- captureParams _ = []- resourceBody :: a -> Maybe PostBox- resourceBody = const Nothing+ resourceMethod :: Proxy a -> StdMethod+ resourceMethod _ = GET+ resourcePath :: Proxy a -> ([Text] -> Text)+ queryParams :: a -> ([ParamBox], [ParamBox]) -- (resource, querystring)+ queryParams _ = ([], [])+ captureParams :: Proxy a -> [ProxyBox]+ captureParams _ = []+ resourceBody :: a -> Maybe PostBox+ resourceBody = const Nothing data PostBox = forall s. Serial s => PostBox !s+ data ParamBox = forall p. (Eq p, Param p) => ParamBox !p+ data ProxyBox = forall p. Param p => ProxyBox !(Proxy p) --------------------@@ -60,51 +62,85 @@ -- Blocks data GetBlock = GetBlock !BlockHash !NoTx+ data GetBlocks = GetBlocks ![BlockHash] !NoTx+ newtype GetBlockRaw = GetBlockRaw BlockHash+ newtype GetBlockBest = GetBlockBest NoTx+ data GetBlockBestRaw = GetBlockBestRaw+ newtype GetBlockLatest = GetBlockLatest NoTx+ data GetBlockHeight = GetBlockHeight !HeightParam !NoTx+ data GetBlockHeights = GetBlockHeights !HeightsParam !NoTx+ newtype GetBlockHeightRaw = GetBlockHeightRaw HeightParam+ data GetBlockTime = GetBlockTime !TimeParam !NoTx+ newtype GetBlockTimeRaw = GetBlockTimeRaw TimeParam+ data GetBlockMTP = GetBlockMTP !TimeParam !NoTx+ newtype GetBlockMTPRaw = GetBlockMTPRaw TimeParam -- Transactions newtype GetTx = GetTx TxHash+ newtype GetTxs = GetTxs [TxHash]+ newtype GetTxRaw = GetTxRaw TxHash+ newtype GetTxsRaw = GetTxsRaw [TxHash]+ newtype GetTxsBlock = GetTxsBlock BlockHash+ newtype GetTxsBlockRaw = GetTxsBlockRaw BlockHash+ data GetTxAfter = GetTxAfter !TxHash !HeightParam+ newtype PostTx = PostTx Tx+ data GetMempool = GetMempool !(Maybe LimitParam) !OffsetParam+ data GetEvents = GetEvents -- Address data GetAddrTxs = GetAddrTxs !Address !LimitsParam+ data GetAddrsTxs = GetAddrsTxs ![Address] !LimitsParam+ data GetAddrTxsFull = GetAddrTxsFull !Address !LimitsParam+ data GetAddrsTxsFull = GetAddrsTxsFull ![Address] !LimitsParam+ newtype GetAddrBalance = GetAddrBalance Address+ newtype GetAddrsBalance = GetAddrsBalance [Address]+ data GetAddrUnspent = GetAddrUnspent !Address !LimitsParam+ data GetAddrsUnspent = GetAddrsUnspent ![Address] !LimitsParam -- XPubs data GetXPub = GetXPub !XPubKey !Store.DeriveType !NoCache+ data GetXPubTxs = GetXPubTxs !XPubKey !Store.DeriveType !LimitsParam !NoCache+ data GetXPubTxsFull = GetXPubTxsFull !XPubKey !Store.DeriveType !LimitsParam !NoCache+ data GetXPubBalances = GetXPubBalances !XPubKey !Store.DeriveType !NoCache+ data GetXPubUnspent = GetXPubUnspent !XPubKey !Store.DeriveType !LimitsParam !NoCache+ data DelCachedXPub = DelCachedXPub !XPubKey !Store.DeriveType -- Network data GetPeers = GetPeers+ data GetHealth = GetHealth ------------@@ -112,215 +148,215 @@ ------------ instance ApiResource GetBlock Store.BlockData where- resourcePath _ = ("/block/" <:>)- queryParams (GetBlock h t) = ([ParamBox h], noDefBox t)- captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)]+ resourcePath _ = ("/block/" <:>)+ queryParams (GetBlock h t) = ([ParamBox h], noDefBox t)+ captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)] instance ApiResource GetBlocks (Store.SerialList Store.BlockData) where- resourcePath _ _ = "/blocks"- queryParams (GetBlocks hs t) = ([], [ParamBox hs] <> noDefBox t)+ resourcePath _ _ = "/blocks"+ queryParams (GetBlocks hs t) = ([], [ParamBox hs] <> noDefBox t) instance ApiResource GetBlockRaw (Store.RawResult Block) where- resourcePath _ = "/block/" <+> "/raw"- queryParams (GetBlockRaw h) = ([ParamBox h], [])- captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)]+ resourcePath _ = "/block/" <+> "/raw"+ queryParams (GetBlockRaw h) = ([ParamBox h], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)] instance ApiResource GetBlockBest Store.BlockData where- resourcePath _ _ = "/block/best"- queryParams (GetBlockBest t) = ([], noDefBox t)+ resourcePath _ _ = "/block/best"+ queryParams (GetBlockBest t) = ([], noDefBox t) instance ApiResource GetBlockBestRaw (Store.RawResult Block) where- resourcePath _ _ = "/block/best/raw"+ resourcePath _ _ = "/block/best/raw" instance ApiResource GetBlockLatest (Store.SerialList Store.BlockData) where- resourcePath _ _ = "/block/latest"- queryParams (GetBlockLatest t) = ([], noDefBox t)+ resourcePath _ _ = "/block/latest"+ queryParams (GetBlockLatest t) = ([], noDefBox t) instance ApiResource GetBlockHeight (Store.SerialList Store.BlockData) where- resourcePath _ = ("/block/height/" <:>)- queryParams (GetBlockHeight h t) = ([ParamBox h], noDefBox t)- captureParams _ = [ProxyBox (Proxy :: Proxy HeightParam)]+ resourcePath _ = ("/block/height/" <:>)+ queryParams (GetBlockHeight h t) = ([ParamBox h], noDefBox t)+ captureParams _ = [ProxyBox (Proxy :: Proxy HeightParam)] instance ApiResource GetBlockHeights (Store.SerialList Store.BlockData) where- resourcePath _ _ = "/block/heights"- queryParams (GetBlockHeights hs t) = ([], [ParamBox hs] <> noDefBox t)+ resourcePath _ _ = "/block/heights"+ queryParams (GetBlockHeights hs t) = ([], [ParamBox hs] <> noDefBox t) instance ApiResource GetBlockHeightRaw (Store.RawResultList Block) where- resourcePath _ = "/block/height/" <+> "/raw"- queryParams (GetBlockHeightRaw h) = ([ParamBox h], [])- captureParams _ = [ProxyBox (Proxy :: Proxy HeightParam)]+ resourcePath _ = "/block/height/" <+> "/raw"+ queryParams (GetBlockHeightRaw h) = ([ParamBox h], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy HeightParam)] instance ApiResource GetBlockTime Store.BlockData where- resourcePath _ = ("/block/time/" <:>)- queryParams (GetBlockTime u t) = ([ParamBox u], noDefBox t)- captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)]+ resourcePath _ = ("/block/time/" <:>)+ queryParams (GetBlockTime u t) = ([ParamBox u], noDefBox t)+ captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)] instance ApiResource GetBlockTimeRaw (Store.RawResult Block) where- resourcePath _ = "/block/time/" <+> "/raw"- queryParams (GetBlockTimeRaw u) = ([ParamBox u], [])- captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)]+ resourcePath _ = "/block/time/" <+> "/raw"+ queryParams (GetBlockTimeRaw u) = ([ParamBox u], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)] instance ApiResource GetBlockMTP Store.BlockData where- resourcePath _ = ("/block/mtp/" <:>)- queryParams (GetBlockMTP u t) = ([ParamBox u], noDefBox t)- captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)]+ resourcePath _ = ("/block/mtp/" <:>)+ queryParams (GetBlockMTP u t) = ([ParamBox u], noDefBox t)+ captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)] instance ApiResource GetBlockMTPRaw (Store.RawResult Block) where- resourcePath _ = "/block/mtp/" <+> "/raw"- queryParams (GetBlockMTPRaw u) = ([ParamBox u], [])- captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)]+ resourcePath _ = "/block/mtp/" <+> "/raw"+ queryParams (GetBlockMTPRaw u) = ([ParamBox u], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy TimeParam)] ------------------ -- Transactions -- ------------------ instance ApiResource GetTx Store.Transaction where- resourcePath _ = ("/transaction/" <:>)- queryParams (GetTx h) = ([ParamBox h], [])- captureParams _ = [ProxyBox (Proxy :: Proxy TxHash)]+ resourcePath _ = ("/transaction/" <:>)+ queryParams (GetTx h) = ([ParamBox h], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy TxHash)] instance ApiResource GetTxs (Store.SerialList Store.Transaction) where- resourcePath _ _ = "/transactions"- queryParams (GetTxs hs) = ([], [ParamBox hs])+ resourcePath _ _ = "/transactions"+ queryParams (GetTxs hs) = ([], [ParamBox hs]) instance ApiResource GetTxRaw (Store.RawResult Tx) where- resourcePath _ = "/transaction/" <+> "/raw"- queryParams (GetTxRaw h) = ([ParamBox h], [])- captureParams _ = [ProxyBox (Proxy :: Proxy TxHash)]+ resourcePath _ = "/transaction/" <+> "/raw"+ queryParams (GetTxRaw h) = ([ParamBox h], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy TxHash)] instance ApiResource GetTxsRaw (Store.RawResultList Tx) where- resourcePath _ _ = "/transactions/raw"- queryParams (GetTxsRaw hs) = ([], [ParamBox hs])+ resourcePath _ _ = "/transactions/raw"+ queryParams (GetTxsRaw hs) = ([], [ParamBox hs]) instance ApiResource GetTxsBlock (Store.SerialList Store.Transaction) where- resourcePath _ = ("/transactions/block/" <:>)- queryParams (GetTxsBlock h) = ([ParamBox h], [])- captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)]+ resourcePath _ = ("/transactions/block/" <:>)+ queryParams (GetTxsBlock h) = ([ParamBox h], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)] instance ApiResource GetTxsBlockRaw (Store.RawResultList Tx) where- resourcePath _ = "/transactions/block/" <+> "/raw"- queryParams (GetTxsBlockRaw h) = ([ParamBox h], [])- captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)]+ resourcePath _ = "/transactions/block/" <+> "/raw"+ queryParams (GetTxsBlockRaw h) = ([ParamBox h], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy BlockHash)] instance ApiResource GetTxAfter (Store.GenericResult (Maybe Bool)) where- resourcePath _ = "/transaction/" <++> "/after/"- queryParams (GetTxAfter h i) = ([ParamBox h, ParamBox i], [])- captureParams _ =- [ ProxyBox (Proxy :: Proxy TxHash)- , ProxyBox (Proxy :: Proxy HeightParam)- ]+ resourcePath _ = "/transaction/" <++> "/after/"+ queryParams (GetTxAfter h i) = ([ParamBox h, ParamBox i], [])+ captureParams _ =+ [ ProxyBox (Proxy :: Proxy TxHash),+ ProxyBox (Proxy :: Proxy HeightParam)+ ] instance ApiResource PostTx Store.TxId where- resourceMethod _ = POST- resourcePath _ _ = "/transactions"- resourceBody (PostTx tx) = Just $ PostBox tx+ resourceMethod _ = POST+ resourcePath _ _ = "/transactions"+ resourceBody (PostTx tx) = Just $ PostBox tx instance ApiResource GetMempool (Store.SerialList TxHash) where- resourcePath _ _ = "/mempool"- queryParams (GetMempool l o) = ([], noMaybeBox l <> noDefBox o)+ resourcePath _ _ = "/mempool"+ queryParams (GetMempool l o) = ([], noMaybeBox l <> noDefBox o) instance ApiResource GetEvents (Store.SerialList Store.Event) where- resourcePath _ _ = "/events"+ resourcePath _ _ = "/events" ------------- -- Address -- ------------- instance ApiResource GetAddrTxs (Store.SerialList Store.TxRef) where- resourcePath _ = "/address/" <+> "/transactions"- queryParams (GetAddrTxs a (LimitsParam l o sM)) =- ([ParamBox a], noMaybeBox l <> noDefBox o <> noMaybeBox sM)- captureParams _ = [ProxyBox (Proxy :: Proxy Address)]+ resourcePath _ = "/address/" <+> "/transactions"+ queryParams (GetAddrTxs a (LimitsParam l o sM)) =+ ([ParamBox a], noMaybeBox l <> noDefBox o <> noMaybeBox sM)+ captureParams _ = [ProxyBox (Proxy :: Proxy Address)] instance ApiResource GetAddrsTxs (Store.SerialList Store.TxRef) where- resourcePath _ _ = "/address/transactions"- queryParams (GetAddrsTxs as (LimitsParam l o sM)) =- ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM)+ resourcePath _ _ = "/address/transactions"+ queryParams (GetAddrsTxs as (LimitsParam l o sM)) =+ ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM) instance ApiResource GetAddrTxsFull (Store.SerialList Store.Transaction) where- resourcePath _ = "/address/" <+> "/transactions/full"- queryParams (GetAddrTxsFull a (LimitsParam l o sM)) =- ([ParamBox a], noMaybeBox l <> noDefBox o <> noMaybeBox sM)- captureParams _ = [ProxyBox (Proxy :: Proxy Address)]+ resourcePath _ = "/address/" <+> "/transactions/full"+ queryParams (GetAddrTxsFull a (LimitsParam l o sM)) =+ ([ParamBox a], noMaybeBox l <> noDefBox o <> noMaybeBox sM)+ captureParams _ = [ProxyBox (Proxy :: Proxy Address)] instance ApiResource GetAddrsTxsFull (Store.SerialList Store.Transaction) where- resourcePath _ _ = "/address/transactions/full"- queryParams (GetAddrsTxsFull as (LimitsParam l o sM)) =- ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM)+ resourcePath _ _ = "/address/transactions/full"+ queryParams (GetAddrsTxsFull as (LimitsParam l o sM)) =+ ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM) instance ApiResource GetAddrBalance Store.Balance where- resourcePath _ = "/address/" <+> "/balance"- queryParams (GetAddrBalance a) = ([ParamBox a], [])- captureParams _ = [ProxyBox (Proxy :: Proxy Address)]+ resourcePath _ = "/address/" <+> "/balance"+ queryParams (GetAddrBalance a) = ([ParamBox a], [])+ captureParams _ = [ProxyBox (Proxy :: Proxy Address)] instance ApiResource GetAddrsBalance (Store.SerialList Store.Balance) where- resourcePath _ _ = "/address/balances"- queryParams (GetAddrsBalance as) = ([], [ParamBox as])+ resourcePath _ _ = "/address/balances"+ queryParams (GetAddrsBalance as) = ([], [ParamBox as]) instance ApiResource GetAddrUnspent (Store.SerialList Store.Unspent) where- resourcePath _ = "/address/" <+> "/unspent"- queryParams (GetAddrUnspent a (LimitsParam l o sM)) =- ([ParamBox a], noMaybeBox l <> noDefBox o <> noMaybeBox sM)- captureParams _ = [ProxyBox (Proxy :: Proxy Address)]+ resourcePath _ = "/address/" <+> "/unspent"+ queryParams (GetAddrUnspent a (LimitsParam l o sM)) =+ ([ParamBox a], noMaybeBox l <> noDefBox o <> noMaybeBox sM)+ captureParams _ = [ProxyBox (Proxy :: Proxy Address)] instance ApiResource GetAddrsUnspent (Store.SerialList Store.Unspent) where- resourcePath _ _ = "/address/unspent"- queryParams (GetAddrsUnspent as (LimitsParam l o sM)) =- ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM)+ resourcePath _ _ = "/address/unspent"+ queryParams (GetAddrsUnspent as (LimitsParam l o sM)) =+ ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM) ----------- -- XPubs -- ----------- instance ApiResource GetXPub Store.XPubSummary where- resourcePath _ = ("/xpub/" <:>)- queryParams (GetXPub p d n) = ([ParamBox p], noDefBox d <> noDefBox n)- captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)]+ resourcePath _ = ("/xpub/" <:>)+ queryParams (GetXPub p d n) = ([ParamBox p], noDefBox d <> noDefBox n)+ captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)] instance ApiResource GetXPubTxs (Store.SerialList Store.TxRef) where- resourcePath _ = "/xpub/" <+> "/transactions"- queryParams (GetXPubTxs p d (LimitsParam l o sM) n) =- ( [ParamBox p]- , noDefBox d <> noMaybeBox l <> noDefBox o <> noMaybeBox sM <> noDefBox n- )- captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)]+ resourcePath _ = "/xpub/" <+> "/transactions"+ queryParams (GetXPubTxs p d (LimitsParam l o sM) n) =+ ( [ParamBox p],+ noDefBox d <> noMaybeBox l <> noDefBox o <> noMaybeBox sM <> noDefBox n+ )+ captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)] instance ApiResource GetXPubTxsFull (Store.SerialList Store.Transaction) where- resourcePath _ = "/xpub/" <+> "/transactions/full"- queryParams (GetXPubTxsFull p d (LimitsParam l o sM) n) =- ( [ParamBox p]- , noDefBox d <> noMaybeBox l <> noDefBox o <> noMaybeBox sM <> noDefBox n- )- captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)]+ resourcePath _ = "/xpub/" <+> "/transactions/full"+ queryParams (GetXPubTxsFull p d (LimitsParam l o sM) n) =+ ( [ParamBox p],+ noDefBox d <> noMaybeBox l <> noDefBox o <> noMaybeBox sM <> noDefBox n+ )+ captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)] instance ApiResource GetXPubBalances (Store.SerialList Store.XPubBal) where- resourcePath _ = "/xpub/" <+> "/balances"- queryParams (GetXPubBalances p d n) = ([ParamBox p], noDefBox d <> noDefBox n)- captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)]+ resourcePath _ = "/xpub/" <+> "/balances"+ queryParams (GetXPubBalances p d n) = ([ParamBox p], noDefBox d <> noDefBox n)+ captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)] instance ApiResource GetXPubUnspent (Store.SerialList Store.XPubUnspent) where- resourcePath _ = "/xpub/" <+> "/unspent"- queryParams (GetXPubUnspent p d (LimitsParam l o sM) n) =- ( [ParamBox p]- , noDefBox d <> noMaybeBox l <> noDefBox o <> noMaybeBox sM <> noDefBox n- )- captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)]+ resourcePath _ = "/xpub/" <+> "/unspent"+ queryParams (GetXPubUnspent p d (LimitsParam l o sM) n) =+ ( [ParamBox p],+ noDefBox d <> noMaybeBox l <> noDefBox o <> noMaybeBox sM <> noDefBox n+ )+ captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)] instance ApiResource DelCachedXPub (Store.GenericResult Bool) where- resourceMethod _ = DELETE- resourcePath _ = ("/xpub/" <:>)- queryParams (DelCachedXPub p d) = ([ParamBox p], noDefBox d)- captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)]+ resourceMethod _ = DELETE+ resourcePath _ = ("/xpub/" <:>)+ queryParams (DelCachedXPub p d) = ([ParamBox p], noDefBox d)+ captureParams _ = [ProxyBox (Proxy :: Proxy XPubKey)] ------------- -- Network -- ------------- instance ApiResource GetPeers (Store.SerialList Store.PeerInformation) where- resourcePath _ _ = "/peers"+ resourcePath _ _ = "/peers" instance ApiResource GetHealth Store.HealthCheck where- resourcePath _ _ = "/health"+ resourcePath _ _ = "/health" ------------- -- Helpers --@@ -337,8 +373,8 @@ fill :: Int -> [Text] -> [Text] -> Text fill i a b- | length b /= i = error "Invalid query parameters"- | otherwise = mconcat $ uncurry (<>) <$> zip a (b <> repeat "")+ | length b /= i = error "Invalid query parameters"+ | otherwise = mconcat $ uncurry (<>) <$> zip a (b <> repeat "") noDefBox :: (Default p, Param p, Eq p) => p -> [ParamBox] noDefBox p = [ParamBox p | p /= def]@@ -355,13 +391,13 @@ where f = resourcePath $ asProxy a encParam (ParamBox p) =- case encodeParam net p of- Just [res] -> res- _ -> error "Invalid query param"+ case encodeParam net p of+ Just [res] -> res+ _ -> error "Invalid query param" capturePath :: ApiResource a b => Proxy a -> Scotty.RoutePattern capturePath proxy =- fromString $ cs $ f $ toLabel <$> captureParams proxy+ fromString $ cs $ f $ toLabel <$> captureParams proxy where f = resourcePath proxy toLabel (ProxyBox p) = ":" <> proxyLabel p@@ -374,197 +410,197 @@ ------------- class Param a where- proxyLabel :: Proxy a -> Text- encodeParam :: Network -> a -> Maybe [Text]- parseParam :: Network -> [Text] -> Maybe a+ proxyLabel :: Proxy a -> Text+ encodeParam :: Network -> a -> Maybe [Text]+ parseParam :: Network -> [Text] -> Maybe a instance Param Address where- proxyLabel = const "address"- encodeParam net a = (: []) <$> addrToText net a- parseParam net [a] = textToAddr net a- parseParam _ _ = Nothing+ proxyLabel = const "address"+ encodeParam net a = (: []) <$> addrToText net a+ parseParam net [a] = textToAddr net a+ parseParam _ _ = Nothing instance Param [Address] where- proxyLabel = const "addresses"- encodeParam = mapM . addrToText- parseParam = mapM . textToAddr+ proxyLabel = const "addresses"+ encodeParam = mapM . addrToText+ parseParam = mapM . textToAddr data StartParam- = StartParamHash- { startParamHash :: Hash256- }- | StartParamHeight- { startParamHeight :: Natural- }- | StartParamTime- { startParamTime :: Store.UnixTime- }- deriving (Eq, Show)+ = StartParamHash+ { startParamHash :: Hash256+ }+ | StartParamHeight+ { startParamHeight :: Natural+ }+ | StartParamTime+ { startParamTime :: Store.UnixTime+ }+ deriving (Eq, Show) instance Param StartParam where- proxyLabel = const "height"- encodeParam _ p =- case p of- StartParamHash h -> return [txHashToHex (TxHash h)]- StartParamHeight h -> do- guard $ h <= 1230768000- return [cs $ show h]- StartParamTime t -> do- guard $ t > 1230768000- return [cs $ show t]- parseParam _ [s] = parseHash <|> parseHeight <|> parseUnix- where- parseHash = do- guard (T.length s == 32 * 2)- TxHash x <- hexToTxHash s- return $ StartParamHash x- parseHeight = do- x <- readMaybe $ cs s- guard $ x <= 1230768000- return $ StartParamHeight x- parseUnix = do- x <- readMaybe $ cs s- guard $ x > 1230768000- return $ StartParamTime x- parseParam _ _ = Nothing+ proxyLabel = const "height"+ encodeParam _ p =+ case p of+ StartParamHash h -> return [txHashToHex (TxHash h)]+ StartParamHeight h -> do+ guard $ h <= 1230768000+ return [cs $ show h]+ StartParamTime t -> do+ guard $ t > 1230768000+ return [cs $ show t]+ parseParam _ [s] = parseHash <|> parseHeight <|> parseUnix+ where+ parseHash = do+ guard (T.length s == 32 * 2)+ TxHash x <- hexToTxHash s+ return $ StartParamHash x+ parseHeight = do+ x <- readMaybe $ cs s+ guard $ x <= 1230768000+ return $ StartParamHeight x+ parseUnix = do+ x <- readMaybe $ cs s+ guard $ x > 1230768000+ return $ StartParamTime x+ parseParam _ _ = Nothing newtype OffsetParam = OffsetParam- { getOffsetParam :: Natural- }- deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ { getOffsetParam :: Natural+ }+ deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral) instance Default OffsetParam where- def = OffsetParam 0+ def = OffsetParam 0 instance Param OffsetParam where- proxyLabel = const "offset"- encodeParam _ (OffsetParam o) = Just [cs $ show o]- parseParam _ [s] = OffsetParam <$> readMaybe (cs s)- parseParam _ _ = Nothing+ proxyLabel = const "offset"+ encodeParam _ (OffsetParam o) = Just [cs $ show o]+ parseParam _ [s] = OffsetParam <$> readMaybe (cs s)+ parseParam _ _ = Nothing newtype LimitParam = LimitParam- { getLimitParam :: Natural- }- deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ { getLimitParam :: Natural+ }+ deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral) instance Param LimitParam where- proxyLabel = const "limit"- encodeParam _ (LimitParam l) = Just [cs $ show l]- parseParam _ [s] = LimitParam <$> readMaybe (cs s)- parseParam _ _ = Nothing+ proxyLabel = const "limit"+ encodeParam _ (LimitParam l) = Just [cs $ show l]+ parseParam _ [s] = LimitParam <$> readMaybe (cs s)+ parseParam _ _ = Nothing data LimitsParam = LimitsParam- { paramLimit :: Maybe LimitParam -- 0 means maximum- , paramOffset :: OffsetParam- , paramStart :: Maybe StartParam- }- deriving (Eq, Show)+ { paramLimit :: Maybe LimitParam, -- 0 means maximum+ paramOffset :: OffsetParam,+ paramStart :: Maybe StartParam+ }+ deriving (Eq, Show) instance Default LimitsParam where- def = LimitsParam Nothing def Nothing+ def = LimitsParam Nothing def Nothing newtype HeightParam = HeightParam- { getHeightParam :: Natural- }- deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ { getHeightParam :: Natural+ }+ deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral) instance Param HeightParam where- proxyLabel = const "height"- encodeParam _ (HeightParam h) = Just [cs $ show h]- parseParam _ [s] = HeightParam <$> readMaybe (cs s)- parseParam _ _ = Nothing+ proxyLabel = const "height"+ encodeParam _ (HeightParam h) = Just [cs $ show h]+ parseParam _ [s] = HeightParam <$> readMaybe (cs s)+ parseParam _ _ = Nothing newtype HeightsParam = HeightsParam- { getHeightsParam :: [Natural]- }- deriving (Eq, Show, Read)+ { getHeightsParam :: [Natural]+ }+ deriving (Eq, Show, Read) instance Param HeightsParam where- proxyLabel = const "heights"- encodeParam _ (HeightsParam hs) = Just $ cs . show <$> hs- parseParam _ xs = HeightsParam <$> mapM (readMaybe . cs) xs+ proxyLabel = const "heights"+ encodeParam _ (HeightsParam hs) = Just $ cs . show <$> hs+ parseParam _ xs = HeightsParam <$> mapM (readMaybe . cs) xs newtype TimeParam = TimeParam- { getTimeParam :: Store.UnixTime- }- deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ { getTimeParam :: Store.UnixTime+ }+ deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral) instance Param TimeParam where- proxyLabel = const "time"- encodeParam _ (TimeParam t) = Just [cs $ show t]- parseParam _ [s] = TimeParam <$> readMaybe (cs s)- parseParam _ _ = Nothing+ proxyLabel = const "time"+ encodeParam _ (TimeParam t) = Just [cs $ show t]+ parseParam _ [s] = TimeParam <$> readMaybe (cs s)+ parseParam _ _ = Nothing instance Param XPubKey where- proxyLabel = const "xpub"- encodeParam net p = Just [xPubExport net p]- parseParam net [s] = xPubImport net s- parseParam _ _ = Nothing+ proxyLabel = const "xpub"+ encodeParam net p = Just [xPubExport net p]+ parseParam net [s] = xPubImport net s+ parseParam _ _ = Nothing instance Param Store.DeriveType where- proxyLabel = const "derive"- encodeParam net p = do- guard (getSegWit net || p == Store.DeriveNormal)- Just [Store.deriveTypeToText p]- parseParam net d = do- res <- case d of- [x] -> Store.textToDeriveType x- _ -> Nothing- guard (getSegWit net || res == Store.DeriveNormal)- return res+ proxyLabel = const "derive"+ encodeParam net p = do+ guard (getSegWit net || p == Store.DeriveNormal)+ Just [Store.deriveTypeToText p]+ parseParam net d = do+ res <- case d of+ [x] -> Store.textToDeriveType x+ _ -> Nothing+ guard (getSegWit net || res == Store.DeriveNormal)+ return res newtype NoCache = NoCache- { getNoCache :: Bool- }- deriving (Eq, Show, Read)+ { getNoCache :: Bool+ }+ deriving (Eq, Show, Read) instance Default NoCache where- def = NoCache False+ def = NoCache False instance Param NoCache where- proxyLabel = const "nocache"- encodeParam _ (NoCache True) = Just ["true"]- encodeParam _ (NoCache False) = Just ["false"]- parseParam _ = \case- ["true"] -> Just $ NoCache True- ["false"] -> Just $ NoCache False- _ -> Nothing+ proxyLabel = const "nocache"+ encodeParam _ (NoCache True) = Just ["true"]+ encodeParam _ (NoCache False) = Just ["false"]+ parseParam _ = \case+ ["true"] -> Just $ NoCache True+ ["false"] -> Just $ NoCache False+ _ -> Nothing newtype NoTx = NoTx- { getNoTx :: Bool- }- deriving (Eq, Show, Read)+ { getNoTx :: Bool+ }+ deriving (Eq, Show, Read) instance Default NoTx where- def = NoTx False+ def = NoTx False instance Param NoTx where- proxyLabel = const "notx"- encodeParam _ (NoTx True) = Just ["true"]- encodeParam _ (NoTx False) = Just ["false"]- parseParam _ = \case- ["true"] -> Just $ NoTx True- ["false"] -> Just $ NoTx False- _ -> Nothing+ proxyLabel = const "notx"+ encodeParam _ (NoTx True) = Just ["true"]+ encodeParam _ (NoTx False) = Just ["false"]+ parseParam _ = \case+ ["true"] -> Just $ NoTx True+ ["false"] -> Just $ NoTx False+ _ -> Nothing instance Param BlockHash where- proxyLabel = const "block"- encodeParam _ b = Just [blockHashToHex b]- parseParam _ [s] = hexToBlockHash s- parseParam _ _ = Nothing+ proxyLabel = const "block"+ encodeParam _ b = Just [blockHashToHex b]+ parseParam _ [s] = hexToBlockHash s+ parseParam _ _ = Nothing instance Param [BlockHash] where- proxyLabel = const "blocks"- encodeParam _ bs = Just $ blockHashToHex <$> bs- parseParam _ = mapM hexToBlockHash+ proxyLabel = const "blocks"+ encodeParam _ bs = Just $ blockHashToHex <$> bs+ parseParam _ = mapM hexToBlockHash instance Param TxHash where- proxyLabel = const "txid"- encodeParam _ t = Just [txHashToHex t]- parseParam _ [s] = hexToTxHash s- parseParam _ _ = Nothing+ proxyLabel = const "txid"+ encodeParam _ t = Just [txHashToHex t]+ parseParam _ [s] = hexToTxHash s+ parseParam _ _ = Nothing instance Param [TxHash] where- proxyLabel = const "txids"- encodeParam _ ts = Just $ txHashToHex <$> ts- parseParam _ = mapM hexToTxHash+ proxyLabel = const "txids"+ encodeParam _ ts = Just $ txHashToHex <$> ts+ parseParam _ = mapM hexToTxHash
test/Haskoin/Store/DataSpec.hs view
@@ -5,642 +5,643 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Haskoin.Store.DataSpec (- spec,-) where--import Control.Monad (forM_)-import Data.Aeson (FromJSON (..))-import qualified Data.ByteString as B-import Data.String.Conversions (cs)-import Haskoin-import Haskoin.Store.Data-import Haskoin.Util.Arbitrary-import Test.Hspec (Spec, describe)-import Test.QuickCheck--serialVals :: [SerialBox]-serialVals =- [ SerialBox (arbitrary :: Gen DeriveType)- , SerialBox (arbitrary :: Gen XPubSpec)- , SerialBox (arbitrary :: Gen BlockRef)- , SerialBox (arbitrary :: Gen TxRef)- , SerialBox (arbitrary :: Gen Balance)- , SerialBox (arbitrary :: Gen Unspent)- , SerialBox (arbitrary :: Gen BlockData)- , SerialBox (arbitrary :: Gen StoreInput)- , SerialBox (arbitrary :: Gen Spender)- , SerialBox (arbitrary :: Gen StoreOutput)- , SerialBox (arbitrary :: Gen Prev)- , SerialBox (arbitrary :: Gen TxData)- , SerialBox (arbitrary :: Gen Transaction)- , SerialBox (arbitrary :: Gen XPubBal)- , SerialBox (arbitrary :: Gen XPubUnspent)- , SerialBox (arbitrary :: Gen XPubSummary)- , SerialBox (arbitrary :: Gen HealthCheck)- , SerialBox (arbitrary :: Gen Event)- , SerialBox (arbitrary :: Gen TxId)- , SerialBox (arbitrary :: Gen PeerInformation)- , SerialBox (arbitrary :: Gen (GenericResult BlockData))- , SerialBox (arbitrary :: Gen (RawResult BlockData))- , SerialBox (arbitrary :: Gen (RawResultList BlockData))- ]--jsonVals :: [JsonBox]-jsonVals =- [ JsonBox (arbitrary :: Gen TxRef)- , JsonBox (arbitrary :: Gen BlockRef)- , JsonBox (arbitrary :: Gen Spender)- , JsonBox (arbitrary :: Gen XPubSummary)- , JsonBox (arbitrary :: Gen HealthCheck)- , JsonBox (arbitrary :: Gen Event)- , JsonBox (arbitrary :: Gen TxId)- , JsonBox (arbitrary :: Gen PeerInformation)- , JsonBox (arbitrary :: Gen (GenericResult XPubSummary))- , JsonBox (arbitrary :: Gen (RawResult BlockData))- , JsonBox (arbitrary :: Gen (RawResultList BlockData))- , JsonBox (arbitrary :: Gen Except)- , JsonBox (arbitrary :: Gen BinfoWallet)- , JsonBox (arbitrary :: Gen BinfoSymbol)- , JsonBox (arbitrary :: Gen BinfoBlockInfo)- , JsonBox (arbitrary :: Gen BinfoInfo)- , JsonBox (arbitrary :: Gen BinfoSpender)- , JsonBox (arbitrary :: Gen BinfoRate)- , JsonBox (arbitrary :: Gen BinfoTicker)- , JsonBox (arbitrary :: Gen BinfoTxId)- , JsonBox (arbitrary :: Gen BinfoShortBal)- , JsonBox (arbitrary :: Gen BinfoHistory)- , JsonBox (arbitrary :: Gen BinfoHeader)- , JsonBox (arbitrary :: Gen BinfoBlocks)- ]--netVals :: [NetBox]-netVals =- [ NetBox- ( balanceToJSON- , balanceToEncoding- , balanceParseJSON- , arbitraryNetData- )- , NetBox- ( storeOutputToJSON- , storeOutputToEncoding- , storeOutputParseJSON- , arbitraryNetData- )- , NetBox- ( unspentToJSON- , unspentToEncoding- , unspentParseJSON- , arbitraryNetData- )- , NetBox- ( xPubBalToJSON- , xPubBalToEncoding- , xPubBalParseJSON- , arbitraryNetData- )- , NetBox- ( xPubUnspentToJSON- , xPubUnspentToEncoding- , xPubUnspentParseJSON- , arbitraryNetData- )- , NetBox- ( storeInputToJSON- , storeInputToEncoding- , storeInputParseJSON- , arbitraryStoreInputNet- )- , NetBox- ( blockDataToJSON- , blockDataToEncoding- , const parseJSON- , arbitraryBlockDataNet- )- , NetBox- ( transactionToJSON- , transactionToEncoding- , transactionParseJSON- , arbitraryNetData- )- , NetBox- ( binfoMultiAddrToJSON- , binfoMultiAddrToEncoding- , binfoMultiAddrParseJSON- , arbitraryNetData- )- , NetBox- ( binfoBalanceToJSON- , binfoBalanceToEncoding- , binfoBalanceParseJSON- , arbitraryNetData- )- , NetBox- ( binfoBlockToJSON- , binfoBlockToEncoding- , binfoBlockParseJSON- , arbitraryNetData- )- , NetBox- ( binfoTxToJSON- , binfoTxToEncoding- , binfoTxParseJSON- , arbitraryNetData- )- , NetBox- ( binfoTxInputToJSON- , binfoTxInputToEncoding- , binfoTxInputParseJSON- , arbitraryNetData- )- , NetBox- ( binfoTxOutputToJSON- , binfoTxOutputToEncoding- , binfoTxOutputParseJSON- , arbitraryNetData- )- , NetBox- ( binfoXPubPathToJSON- , binfoXPubPathToEncoding- , binfoXPubPathParseJSON- , arbitraryNetData- )- , NetBox- ( binfoUnspentToJSON- , binfoUnspentToEncoding- , binfoUnspentParseJSON- , arbitraryNetData- )- , NetBox- ( binfoBlocksToJSON- , binfoBlocksToEncoding- , binfoBlocksParseJSON- , arbitraryNetData- )- , NetBox- ( binfoRawAddrToJSON- , binfoRawAddrToEncoding- , binfoRawAddrParseJSON- , arbitraryNetData- )- , NetBox- ( binfoMempoolToJSON- , binfoMempoolToEncoding- , binfoMempoolParseJSON- , arbitraryNetData- )- ]--spec :: Spec-spec = do- describe "Binary Encoding" $- forM_ serialVals $ \(SerialBox g) -> testSerial g- describe "JSON Encoding" $- forM_ jsonVals $ \(JsonBox g) -> testJson g- describe "JSON Encoding with Network" $- forM_ netVals $ \(NetBox (j, e, p, g)) -> testNetJson j e p g--instance Arbitrary BlockRef where- arbitrary =- oneof [BlockRef <$> arbitrary <*> arbitrary, MemRef <$> arbitrary]--instance Arbitrary Prev where- arbitrary = Prev <$> arbitraryBS1 <*> arbitrary--instance Arbitrary TxData where- arbitrary =- TxData- <$> arbitrary- <*> arbitraryTx btc- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary StoreInput where- arbitrary =- oneof- [ StoreCoinbase- <$> arbitraryOutPoint- <*> arbitrary- <*> arbitraryBS1- <*> listOf arbitraryBS1- , StoreInput- <$> arbitraryOutPoint- <*> arbitrary- <*> arbitraryBS1- <*> arbitraryBS1- <*> arbitrary- <*> listOf arbitraryBS1- <*> arbitraryMaybe arbitraryAddress- ]--arbitraryStoreInputNet :: Gen (Network, StoreInput)-arbitraryStoreInputNet = do- net <- arbitraryNetwork- store <- arbitrary- let res- | getSegWit net = store- | otherwise = store{inputWitness = []}- return (net, res)--instance Arbitrary Spender where- arbitrary = Spender <$> arbitraryTxHash <*> arbitrary--instance Arbitrary StoreOutput where- arbitrary =- StoreOutput- <$> arbitrary- <*> arbitraryBS1- <*> arbitrary- <*> arbitraryMaybe arbitraryAddress--instance Arbitrary Transaction where- arbitrary =- Transaction- <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitraryTxHash- <*> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary PeerInformation where- arbitrary =- PeerInformation- <$> (cs <$> listOf arbitraryUnicodeChar)- <*> listOf arbitraryPrintableChar- <*> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary BlockHealth where- arbitrary =- BlockHealth- <$> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary TimeHealth where- arbitrary =- TimeHealth- <$> arbitrary- <*> arbitrary--instance Arbitrary CountHealth where- arbitrary =- CountHealth- <$> arbitrary- <*> arbitrary--instance Arbitrary MaxHealth where- arbitrary =- MaxHealth- <$> arbitrary- <*> arbitrary--instance Arbitrary HealthCheck where- arbitrary =- HealthCheck- <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary RejectCode where- arbitrary =- elements- [ RejectMalformed- , RejectInvalid- , RejectObsolete- , RejectDuplicate- , RejectNonStandard- , RejectDust- , RejectInsufficientFee- , RejectCheckpoint- ]--instance Arbitrary XPubSpec where- arbitrary = XPubSpec <$> (snd <$> arbitraryXPubKey) <*> arbitrary--instance Arbitrary DeriveType where- arbitrary = elements [DeriveNormal, DeriveP2SH, DeriveP2WPKH]--instance Arbitrary TxId where- arbitrary = TxId <$> arbitraryTxHash--instance Arbitrary TxRef where- arbitrary = TxRef <$> arbitrary <*> arbitraryTxHash--instance Arbitrary Balance where- arbitrary =- Balance- <$> arbitraryAddress- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary Unspent where- arbitrary =- Unspent- <$> arbitrary- <*> arbitraryOutPoint- <*> arbitrary- <*> arbitraryBS1- <*> arbitraryMaybe arbitraryAddress--instance Arbitrary BlockData where- arbitrary =- BlockData- <$> arbitrary- <*> arbitrary- <*> (fromInteger <$> suchThat arbitrary (0 <=))- <*> arbitraryBlockHeader- <*> arbitrary- <*> arbitrary- <*> listOf1 arbitraryTxHash- <*> arbitrary- <*> arbitrary- <*> arbitrary--arbitraryBlockDataNet :: Gen (Network, BlockData)-arbitraryBlockDataNet = do- net <- arbitraryNetwork- dat <- arbitrary- let res- | getSegWit net = dat- | otherwise = dat{blockDataWeight = 0}- return (net, res)--instance Arbitrary a => Arbitrary (GenericResult a) where- arbitrary = GenericResult <$> arbitrary--instance Arbitrary a => Arbitrary (RawResult a) where- arbitrary = RawResult <$> arbitrary--instance Arbitrary a => Arbitrary (RawResultList a) where- arbitrary = RawResultList <$> 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 <$> arbitraryBlockHash- , EventTx <$> arbitraryTxHash- ]--instance Arbitrary Except where- arbitrary =- oneof- [ return ThingNotFound- , return ServerError- , return BadRequest- , UserError <$> arbitrary- , StringError <$> arbitrary- , TxIndexConflict <$> listOf1 arbitraryTxHash- , return ServerTimeout- ]-------------------------------------------- Blockchain.info API Compatibility --------------------------------------------instance Arbitrary BinfoTxId where- arbitrary =- oneof- [ BinfoTxIdHash <$> arbitraryTxHash- , BinfoTxIdIndex <$> arbitrary- ]--instance Arbitrary BinfoMultiAddr where- arbitrary = do- getBinfoMultiAddrAddresses <- arbitrary- getBinfoMultiAddrWallet <- arbitrary- getBinfoMultiAddrTxs <- resize 10 arbitrary- getBinfoMultiAddrInfo <- arbitrary- getBinfoMultiAddrRecommendFee <- arbitrary- getBinfoMultiAddrCashAddr <- arbitrary- return BinfoMultiAddr{..}--instance Arbitrary BinfoRawAddr where- arbitrary = do- binfoRawAddr <-- oneof- [ BinfoAddr <$> arbitraryAddress- , BinfoXpub . snd <$> arbitraryXPubKey- ]- binfoRawBalance <- arbitrary- binfoRawTxCount <- arbitrary- binfoRawUnredeemed <- arbitrary- binfoRawReceived <- arbitrary- binfoRawSent <- arbitrary- binfoRawTxs <- arbitrary- return $ BinfoRawAddr{..}--instance Arbitrary BinfoShortBal where- arbitrary = BinfoShortBal <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary BinfoBalance where- arbitrary = do- getBinfoAddress <- arbitraryAddress- getBinfoAddrTxCount <- arbitrary- getBinfoAddrReceived <- arbitrary- getBinfoAddrSent <- arbitrary- getBinfoAddrBalance <- arbitrary- getBinfoXPubKey <- snd <$> arbitraryXPubKey- getBinfoXPubAccountIndex <- arbitrary- getBinfoXPubChangeIndex <- arbitrary- elements [BinfoAddrBalance{..}, BinfoXPubBalance{..}]--instance Arbitrary BinfoWallet where- arbitrary = do- getBinfoWalletBalance <- arbitrary- getBinfoWalletTxCount <- arbitrary- getBinfoWalletFilteredCount <- arbitrary- getBinfoWalletTotalReceived <- arbitrary- getBinfoWalletTotalSent <- arbitrary- return BinfoWallet{..}--instance Arbitrary BinfoBlock where- arbitrary = do- getBinfoBlockHash <- arbitraryBlockHash- getBinfoBlockVer <- arbitrary- getBinfoPrevBlock <- arbitraryBlockHash- getBinfoMerkleRoot <- getTxHash <$> arbitraryTxHash- getBinfoBlockTime <- arbitrary- getBinfoBlockBits <- arbitrary- getBinfoNextBlock <- listOf arbitraryBlockHash- getBinfoBlockTxCount <- arbitrary- getBinfoBlockFee <- arbitrary- getBinfoBlockNonce <- arbitrary- getBinfoBlockSize <- arbitrary- getBinfoBlockIndex <- arbitrary- getBinfoBlockMain <- arbitrary- getBinfoBlockHeight <- arbitrary- getBinfoBlockWeight <- arbitrary- getBinfoBlockTx <- resize 5 arbitrary- return BinfoBlock{..}--instance Arbitrary BinfoTx where- arbitrary = do- getBinfoTxHash <- arbitraryTxHash- getBinfoTxVer <- arbitrary- getBinfoTxInputs <- resize 5 $ listOf1 arbitrary- getBinfoTxOutputs <- resize 5 $ listOf1 arbitrary- let getBinfoTxVinSz = fromIntegral (length getBinfoTxInputs)- getBinfoTxVoutSz = fromIntegral (length getBinfoTxOutputs)- getBinfoTxSize <- arbitrary- getBinfoTxWeight <- arbitrary- getBinfoTxFee <- arbitrary- getBinfoTxRelayedBy <- cs <$> listOf arbitraryUnicodeChar- getBinfoTxLockTime <- arbitrary- getBinfoTxIndex <- arbitrary- getBinfoTxDoubleSpend <- arbitrary- getBinfoTxRBF <- arbitrary- getBinfoTxTime <- arbitrary- getBinfoTxBlockIndex <- arbitrary- getBinfoTxBlockHeight <- arbitrary- getBinfoTxResultBal <- arbitrary- return BinfoTx{..}--instance Arbitrary BinfoTxInput where- arbitrary = do- getBinfoTxInputSeq <- arbitrary- getBinfoTxInputWitness <- B.pack <$> listOf arbitrary- getBinfoTxInputScript <- B.pack <$> listOf arbitrary- getBinfoTxInputIndex <- arbitrary- getBinfoTxInputPrevOut <- arbitrary- return BinfoTxInput{..}--instance Arbitrary BinfoTxOutput where- arbitrary = do- getBinfoTxOutputType <- arbitrary- getBinfoTxOutputSpent <- arbitrary- getBinfoTxOutputValue <- arbitrary- getBinfoTxOutputIndex <- arbitrary- getBinfoTxOutputTxIndex <- arbitrary- getBinfoTxOutputScript <- B.pack <$> listOf arbitrary- getBinfoTxOutputSpenders <- arbitrary- getBinfoTxOutputAddress <-- oneof [return Nothing, Just <$> arbitraryAddress]- getBinfoTxOutputXPub <- arbitrary- return BinfoTxOutput{..}--instance Arbitrary BinfoSpender where- arbitrary = do- getBinfoSpenderTxIndex <- arbitrary- getBinfoSpenderIndex <- arbitrary- return BinfoSpender{..}--instance Arbitrary BinfoXPubPath where- arbitrary = do- getBinfoXPubPathKey <- snd <$> arbitraryXPubKey- getBinfoXPubPathDeriv <- arbitrarySoftPath- return BinfoXPubPath{..}--instance Arbitrary BinfoInfo where- arbitrary = do- getBinfoConnected <- arbitrary- getBinfoConversion <- arbitrary- getBinfoLocal <- arbitrary- getBinfoBTC <- arbitrary- getBinfoLatestBlock <- arbitrary- return BinfoInfo{..}--instance Arbitrary BinfoBlockInfo where- arbitrary = do- getBinfoBlockInfoHash <- arbitraryBlockHash- getBinfoBlockInfoHeight <- arbitrary- getBinfoBlockInfoTime <- arbitrary- getBinfoBlockInfoIndex <- arbitrary- return BinfoBlockInfo{..}--instance Arbitrary BinfoSymbol where- arbitrary = do- getBinfoSymbolCode <- cs <$> listOf1 arbitraryUnicodeChar- getBinfoSymbolString <- cs <$> listOf1 arbitraryUnicodeChar- getBinfoSymbolName <- cs <$> listOf1 arbitraryUnicodeChar- getBinfoSymbolConversion <- arbitrary- getBinfoSymbolAfter <- arbitrary- getBinfoSymbolLocal <- arbitrary- return BinfoSymbol{..}--instance Arbitrary BinfoRate where- arbitrary = BinfoRate <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary BinfoTicker where- arbitrary = do- binfoTicker15m <- arbitrary- binfoTickerSell <- arbitrary- binfoTickerBuy <- arbitrary- binfoTickerLast <- arbitrary- binfoTickerSymbol <- cs <$> listOf1 arbitraryUnicodeChar- return BinfoTicker{..}--instance Arbitrary BinfoHistory where- arbitrary = do- binfoHistoryDate <- cs <$> listOf1 arbitraryUnicodeChar- binfoHistoryTime <- cs <$> listOf1 arbitraryUnicodeChar- binfoHistoryType <- cs <$> listOf1 arbitraryUnicodeChar- binfoHistoryAmount <- arbitrary- binfoHistoryValueThen <- arbitrary- binfoHistoryValueNow <- arbitrary- binfoHistoryExchangeRateThen <- arbitrary- binfoHistoryTx <- arbitraryTxHash- return BinfoHistory{..}--instance Arbitrary BinfoUnspent where- arbitrary = do- getBinfoUnspentHash <- arbitraryTxHash- getBinfoUnspentOutputIndex <- arbitrary- getBinfoUnspentScript <- B.pack <$> listOf arbitrary- getBinfoUnspentValue <- arbitrary- getBinfoUnspentConfirmations <- arbitrary- getBinfoUnspentTxIndex <- arbitrary- getBinfoUnspentXPub <- arbitrary- return BinfoUnspent{..}--instance Arbitrary BinfoUnspents where- arbitrary = BinfoUnspents <$> arbitrary--instance Arbitrary BinfoHeader where- arbitrary =- BinfoHeader- <$> arbitraryBlockHash- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary--instance Arbitrary BinfoMempool where- arbitrary = BinfoMempool <$> arbitrary--instance Arbitrary BinfoBlocks where- arbitrary = BinfoBlocks <$> arbitrary+module Haskoin.Store.DataSpec+ ( spec,+ )+where++import Control.Monad (forM_)+import Data.Aeson (FromJSON (..))+import qualified Data.ByteString as B+import Data.String.Conversions (cs)+import Haskoin+import Haskoin.Store.Data+import Haskoin.Util.Arbitrary+import Test.Hspec (Spec, describe)+import Test.QuickCheck++serialVals :: [SerialBox]+serialVals =+ [ SerialBox (arbitrary :: Gen DeriveType),+ SerialBox (arbitrary :: Gen XPubSpec),+ SerialBox (arbitrary :: Gen BlockRef),+ SerialBox (arbitrary :: Gen TxRef),+ SerialBox (arbitrary :: Gen Balance),+ SerialBox (arbitrary :: Gen Unspent),+ SerialBox (arbitrary :: Gen BlockData),+ SerialBox (arbitrary :: Gen StoreInput),+ SerialBox (arbitrary :: Gen Spender),+ SerialBox (arbitrary :: Gen StoreOutput),+ SerialBox (arbitrary :: Gen Prev),+ SerialBox (arbitrary :: Gen TxData),+ SerialBox (arbitrary :: Gen Transaction),+ SerialBox (arbitrary :: Gen XPubBal),+ SerialBox (arbitrary :: Gen XPubUnspent),+ SerialBox (arbitrary :: Gen XPubSummary),+ SerialBox (arbitrary :: Gen HealthCheck),+ SerialBox (arbitrary :: Gen Event),+ SerialBox (arbitrary :: Gen TxId),+ SerialBox (arbitrary :: Gen PeerInformation),+ SerialBox (arbitrary :: Gen (GenericResult BlockData)),+ SerialBox (arbitrary :: Gen (RawResult BlockData)),+ SerialBox (arbitrary :: Gen (RawResultList BlockData))+ ]++jsonVals :: [JsonBox]+jsonVals =+ [ JsonBox (arbitrary :: Gen TxRef),+ JsonBox (arbitrary :: Gen BlockRef),+ JsonBox (arbitrary :: Gen Spender),+ JsonBox (arbitrary :: Gen XPubSummary),+ JsonBox (arbitrary :: Gen HealthCheck),+ JsonBox (arbitrary :: Gen Event),+ JsonBox (arbitrary :: Gen TxId),+ JsonBox (arbitrary :: Gen PeerInformation),+ JsonBox (arbitrary :: Gen (GenericResult XPubSummary)),+ JsonBox (arbitrary :: Gen (RawResult BlockData)),+ JsonBox (arbitrary :: Gen (RawResultList BlockData)),+ JsonBox (arbitrary :: Gen Except),+ JsonBox (arbitrary :: Gen BinfoWallet),+ JsonBox (arbitrary :: Gen BinfoSymbol),+ JsonBox (arbitrary :: Gen BinfoBlockInfo),+ JsonBox (arbitrary :: Gen BinfoInfo),+ JsonBox (arbitrary :: Gen BinfoSpender),+ JsonBox (arbitrary :: Gen BinfoRate),+ JsonBox (arbitrary :: Gen BinfoTicker),+ JsonBox (arbitrary :: Gen BinfoTxId),+ JsonBox (arbitrary :: Gen BinfoShortBal),+ JsonBox (arbitrary :: Gen BinfoHistory),+ JsonBox (arbitrary :: Gen BinfoHeader),+ JsonBox (arbitrary :: Gen BinfoBlocks)+ ]++netVals :: [NetBox]+netVals =+ [ NetBox+ ( balanceToJSON,+ balanceToEncoding,+ balanceParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( storeOutputToJSON,+ storeOutputToEncoding,+ storeOutputParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( unspentToJSON,+ unspentToEncoding,+ unspentParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( xPubBalToJSON,+ xPubBalToEncoding,+ xPubBalParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( xPubUnspentToJSON,+ xPubUnspentToEncoding,+ xPubUnspentParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( storeInputToJSON,+ storeInputToEncoding,+ storeInputParseJSON,+ arbitraryStoreInputNet+ ),+ NetBox+ ( blockDataToJSON,+ blockDataToEncoding,+ const parseJSON,+ arbitraryBlockDataNet+ ),+ NetBox+ ( transactionToJSON,+ transactionToEncoding,+ transactionParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoMultiAddrToJSON,+ binfoMultiAddrToEncoding,+ binfoMultiAddrParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoBalanceToJSON,+ binfoBalanceToEncoding,+ binfoBalanceParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoBlockToJSON,+ binfoBlockToEncoding,+ binfoBlockParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoTxToJSON,+ binfoTxToEncoding,+ binfoTxParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoTxInputToJSON,+ binfoTxInputToEncoding,+ binfoTxInputParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoTxOutputToJSON,+ binfoTxOutputToEncoding,+ binfoTxOutputParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoXPubPathToJSON,+ binfoXPubPathToEncoding,+ binfoXPubPathParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoUnspentToJSON,+ binfoUnspentToEncoding,+ binfoUnspentParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoBlocksToJSON,+ binfoBlocksToEncoding,+ binfoBlocksParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoRawAddrToJSON,+ binfoRawAddrToEncoding,+ binfoRawAddrParseJSON,+ arbitraryNetData+ ),+ NetBox+ ( binfoMempoolToJSON,+ binfoMempoolToEncoding,+ binfoMempoolParseJSON,+ arbitraryNetData+ )+ ]++spec :: Spec+spec = do+ describe "Binary Encoding" $+ forM_ serialVals $ \(SerialBox g) -> testSerial g+ describe "JSON Encoding" $+ forM_ jsonVals $ \(JsonBox g) -> testJson g+ describe "JSON Encoding with Network" $+ forM_ netVals $ \(NetBox (j, e, p, g)) -> testNetJson j e p g++instance Arbitrary BlockRef where+ arbitrary =+ oneof [BlockRef <$> arbitrary <*> arbitrary, MemRef <$> arbitrary]++instance Arbitrary Prev where+ arbitrary = Prev <$> arbitraryBS1 <*> arbitrary++instance Arbitrary TxData where+ arbitrary =+ TxData+ <$> arbitrary+ <*> arbitraryTx btc+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary StoreInput where+ arbitrary =+ oneof+ [ StoreCoinbase+ <$> arbitraryOutPoint+ <*> arbitrary+ <*> arbitraryBS1+ <*> listOf arbitraryBS1,+ StoreInput+ <$> arbitraryOutPoint+ <*> arbitrary+ <*> arbitraryBS1+ <*> arbitraryBS1+ <*> arbitrary+ <*> listOf arbitraryBS1+ <*> arbitraryMaybe arbitraryAddress+ ]++arbitraryStoreInputNet :: Gen (Network, StoreInput)+arbitraryStoreInputNet = do+ net <- arbitraryNetwork+ store <- arbitrary+ let res+ | getSegWit net = store+ | otherwise = store {inputWitness = []}+ return (net, res)++instance Arbitrary Spender where+ arbitrary = Spender <$> arbitraryTxHash <*> arbitrary++instance Arbitrary StoreOutput where+ arbitrary =+ StoreOutput+ <$> arbitrary+ <*> arbitraryBS1+ <*> arbitrary+ <*> arbitraryMaybe arbitraryAddress++instance Arbitrary Transaction where+ arbitrary =+ Transaction+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitraryTxHash+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary PeerInformation where+ arbitrary =+ PeerInformation+ <$> (cs <$> listOf arbitraryUnicodeChar)+ <*> listOf arbitraryPrintableChar+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary BlockHealth where+ arbitrary =+ BlockHealth+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary TimeHealth where+ arbitrary =+ TimeHealth+ <$> arbitrary+ <*> arbitrary++instance Arbitrary CountHealth where+ arbitrary =+ CountHealth+ <$> arbitrary+ <*> arbitrary++instance Arbitrary MaxHealth where+ arbitrary =+ MaxHealth+ <$> arbitrary+ <*> arbitrary++instance Arbitrary HealthCheck where+ arbitrary =+ HealthCheck+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary RejectCode where+ arbitrary =+ elements+ [ RejectMalformed,+ RejectInvalid,+ RejectObsolete,+ RejectDuplicate,+ RejectNonStandard,+ RejectDust,+ RejectInsufficientFee,+ RejectCheckpoint+ ]++instance Arbitrary XPubSpec where+ arbitrary = XPubSpec <$> (snd <$> arbitraryXPubKey) <*> arbitrary++instance Arbitrary DeriveType where+ arbitrary = elements [DeriveNormal, DeriveP2SH, DeriveP2WPKH]++instance Arbitrary TxId where+ arbitrary = TxId <$> arbitraryTxHash++instance Arbitrary TxRef where+ arbitrary = TxRef <$> arbitrary <*> arbitraryTxHash++instance Arbitrary Balance where+ arbitrary =+ Balance+ <$> arbitraryAddress+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary Unspent where+ arbitrary =+ Unspent+ <$> arbitrary+ <*> arbitraryOutPoint+ <*> arbitrary+ <*> arbitraryBS1+ <*> arbitraryMaybe arbitraryAddress++instance Arbitrary BlockData where+ arbitrary =+ BlockData+ <$> arbitrary+ <*> arbitrary+ <*> (fromInteger <$> suchThat arbitrary (0 <=))+ <*> arbitraryBlockHeader+ <*> arbitrary+ <*> arbitrary+ <*> listOf1 arbitraryTxHash+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++arbitraryBlockDataNet :: Gen (Network, BlockData)+arbitraryBlockDataNet = do+ net <- arbitraryNetwork+ dat <- arbitrary+ let res+ | getSegWit net = dat+ | otherwise = dat {blockDataWeight = 0}+ return (net, res)++instance Arbitrary a => Arbitrary (GenericResult a) where+ arbitrary = GenericResult <$> arbitrary++instance Arbitrary a => Arbitrary (RawResult a) where+ arbitrary = RawResult <$> arbitrary++instance Arbitrary a => Arbitrary (RawResultList a) where+ arbitrary = RawResultList <$> 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 <$> arbitraryBlockHash,+ EventTx <$> arbitraryTxHash+ ]++instance Arbitrary Except where+ arbitrary =+ oneof+ [ return ThingNotFound,+ return ServerError,+ return BadRequest,+ UserError <$> arbitrary,+ StringError <$> arbitrary,+ TxIndexConflict <$> listOf1 arbitraryTxHash,+ return ServerTimeout+ ]++---------------------------------------+-- Blockchain.info API Compatibility --+---------------------------------------++instance Arbitrary BinfoTxId where+ arbitrary =+ oneof+ [ BinfoTxIdHash <$> arbitraryTxHash,+ BinfoTxIdIndex <$> arbitrary+ ]++instance Arbitrary BinfoMultiAddr where+ arbitrary = do+ getBinfoMultiAddrAddresses <- arbitrary+ getBinfoMultiAddrWallet <- arbitrary+ getBinfoMultiAddrTxs <- resize 10 arbitrary+ getBinfoMultiAddrInfo <- arbitrary+ getBinfoMultiAddrRecommendFee <- arbitrary+ getBinfoMultiAddrCashAddr <- arbitrary+ return BinfoMultiAddr {..}++instance Arbitrary BinfoRawAddr where+ arbitrary = do+ binfoRawAddr <-+ oneof+ [ BinfoAddr <$> arbitraryAddress,+ BinfoXpub . snd <$> arbitraryXPubKey+ ]+ binfoRawBalance <- arbitrary+ binfoRawTxCount <- arbitrary+ binfoRawUnredeemed <- arbitrary+ binfoRawReceived <- arbitrary+ binfoRawSent <- arbitrary+ binfoRawTxs <- arbitrary+ return $ BinfoRawAddr {..}++instance Arbitrary BinfoShortBal where+ arbitrary = BinfoShortBal <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary BinfoBalance where+ arbitrary = do+ getBinfoAddress <- arbitraryAddress+ getBinfoAddrTxCount <- arbitrary+ getBinfoAddrReceived <- arbitrary+ getBinfoAddrSent <- arbitrary+ getBinfoAddrBalance <- arbitrary+ getBinfoXPubKey <- snd <$> arbitraryXPubKey+ getBinfoXPubAccountIndex <- arbitrary+ getBinfoXPubChangeIndex <- arbitrary+ elements [BinfoAddrBalance {..}, BinfoXPubBalance {..}]++instance Arbitrary BinfoWallet where+ arbitrary = do+ getBinfoWalletBalance <- arbitrary+ getBinfoWalletTxCount <- arbitrary+ getBinfoWalletFilteredCount <- arbitrary+ getBinfoWalletTotalReceived <- arbitrary+ getBinfoWalletTotalSent <- arbitrary+ return BinfoWallet {..}++instance Arbitrary BinfoBlock where+ arbitrary = do+ getBinfoBlockHash <- arbitraryBlockHash+ getBinfoBlockVer <- arbitrary+ getBinfoPrevBlock <- arbitraryBlockHash+ getBinfoMerkleRoot <- getTxHash <$> arbitraryTxHash+ getBinfoBlockTime <- arbitrary+ getBinfoBlockBits <- arbitrary+ getBinfoNextBlock <- listOf arbitraryBlockHash+ getBinfoBlockTxCount <- arbitrary+ getBinfoBlockFee <- arbitrary+ getBinfoBlockNonce <- arbitrary+ getBinfoBlockSize <- arbitrary+ getBinfoBlockIndex <- arbitrary+ getBinfoBlockMain <- arbitrary+ getBinfoBlockHeight <- arbitrary+ getBinfoBlockWeight <- arbitrary+ getBinfoBlockTx <- resize 5 arbitrary+ return BinfoBlock {..}++instance Arbitrary BinfoTx where+ arbitrary = do+ getBinfoTxHash <- arbitraryTxHash+ getBinfoTxVer <- arbitrary+ getBinfoTxInputs <- resize 5 $ listOf1 arbitrary+ getBinfoTxOutputs <- resize 5 $ listOf1 arbitrary+ let getBinfoTxVinSz = fromIntegral (length getBinfoTxInputs)+ getBinfoTxVoutSz = fromIntegral (length getBinfoTxOutputs)+ getBinfoTxSize <- arbitrary+ getBinfoTxWeight <- arbitrary+ getBinfoTxFee <- arbitrary+ getBinfoTxRelayedBy <- cs <$> listOf arbitraryUnicodeChar+ getBinfoTxLockTime <- arbitrary+ getBinfoTxIndex <- arbitrary+ getBinfoTxDoubleSpend <- arbitrary+ getBinfoTxRBF <- arbitrary+ getBinfoTxTime <- arbitrary+ getBinfoTxBlockIndex <- arbitrary+ getBinfoTxBlockHeight <- arbitrary+ getBinfoTxResultBal <- arbitrary+ return BinfoTx {..}++instance Arbitrary BinfoTxInput where+ arbitrary = do+ getBinfoTxInputSeq <- arbitrary+ getBinfoTxInputWitness <- B.pack <$> listOf arbitrary+ getBinfoTxInputScript <- B.pack <$> listOf arbitrary+ getBinfoTxInputIndex <- arbitrary+ getBinfoTxInputPrevOut <- arbitrary+ return BinfoTxInput {..}++instance Arbitrary BinfoTxOutput where+ arbitrary = do+ getBinfoTxOutputType <- arbitrary+ getBinfoTxOutputSpent <- arbitrary+ getBinfoTxOutputValue <- arbitrary+ getBinfoTxOutputIndex <- arbitrary+ getBinfoTxOutputTxIndex <- arbitrary+ getBinfoTxOutputScript <- B.pack <$> listOf arbitrary+ getBinfoTxOutputSpenders <- arbitrary+ getBinfoTxOutputAddress <-+ oneof [return Nothing, Just <$> arbitraryAddress]+ getBinfoTxOutputXPub <- arbitrary+ return BinfoTxOutput {..}++instance Arbitrary BinfoSpender where+ arbitrary = do+ getBinfoSpenderTxIndex <- arbitrary+ getBinfoSpenderIndex <- arbitrary+ return BinfoSpender {..}++instance Arbitrary BinfoXPubPath where+ arbitrary = do+ getBinfoXPubPathKey <- snd <$> arbitraryXPubKey+ getBinfoXPubPathDeriv <- arbitrarySoftPath+ return BinfoXPubPath {..}++instance Arbitrary BinfoInfo where+ arbitrary = do+ getBinfoConnected <- arbitrary+ getBinfoConversion <- arbitrary+ getBinfoLocal <- arbitrary+ getBinfoBTC <- arbitrary+ getBinfoLatestBlock <- arbitrary+ return BinfoInfo {..}++instance Arbitrary BinfoBlockInfo where+ arbitrary = do+ getBinfoBlockInfoHash <- arbitraryBlockHash+ getBinfoBlockInfoHeight <- arbitrary+ getBinfoBlockInfoTime <- arbitrary+ getBinfoBlockInfoIndex <- arbitrary+ return BinfoBlockInfo {..}++instance Arbitrary BinfoSymbol where+ arbitrary = do+ getBinfoSymbolCode <- cs <$> listOf1 arbitraryUnicodeChar+ getBinfoSymbolString <- cs <$> listOf1 arbitraryUnicodeChar+ getBinfoSymbolName <- cs <$> listOf1 arbitraryUnicodeChar+ getBinfoSymbolConversion <- arbitrary+ getBinfoSymbolAfter <- arbitrary+ getBinfoSymbolLocal <- arbitrary+ return BinfoSymbol {..}++instance Arbitrary BinfoRate where+ arbitrary = BinfoRate <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary BinfoTicker where+ arbitrary = do+ binfoTicker15m <- arbitrary+ binfoTickerSell <- arbitrary+ binfoTickerBuy <- arbitrary+ binfoTickerLast <- arbitrary+ binfoTickerSymbol <- cs <$> listOf1 arbitraryUnicodeChar+ return BinfoTicker {..}++instance Arbitrary BinfoHistory where+ arbitrary = do+ binfoHistoryDate <- cs <$> listOf1 arbitraryUnicodeChar+ binfoHistoryTime <- cs <$> listOf1 arbitraryUnicodeChar+ binfoHistoryType <- cs <$> listOf1 arbitraryUnicodeChar+ binfoHistoryAmount <- arbitrary+ binfoHistoryValueThen <- arbitrary+ binfoHistoryValueNow <- arbitrary+ binfoHistoryExchangeRateThen <- arbitrary+ binfoHistoryTx <- arbitraryTxHash+ return BinfoHistory {..}++instance Arbitrary BinfoUnspent where+ arbitrary = do+ getBinfoUnspentHash <- arbitraryTxHash+ getBinfoUnspentOutputIndex <- arbitrary+ getBinfoUnspentScript <- B.pack <$> listOf arbitrary+ getBinfoUnspentValue <- arbitrary+ getBinfoUnspentConfirmations <- arbitrary+ getBinfoUnspentTxIndex <- arbitrary+ getBinfoUnspentXPub <- arbitrary+ return BinfoUnspent {..}++instance Arbitrary BinfoUnspents where+ arbitrary = BinfoUnspents <$> arbitrary++instance Arbitrary BinfoHeader where+ arbitrary =+ BinfoHeader+ <$> arbitraryBlockHash+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++instance Arbitrary BinfoMempool where+ arbitrary = BinfoMempool <$> arbitrary++instance Arbitrary BinfoBlocks where+ arbitrary = BinfoBlocks <$> arbitrary
test/Haskoin/Store/WebCommonSpec.hs view
@@ -5,9 +5,10 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Haskoin.Store.WebCommonSpec (- spec,-) where+module Haskoin.Store.WebCommonSpec+ ( spec,+ )+where import Control.Monad (forM_) import Data.Proxy@@ -26,50 +27,50 @@ params :: [GenBox] params =- [ GenBox arbitraryAddress- , GenBox (listOf arbitraryAddress)- , GenBox (arbitrary :: Gen StartParam)- , GenBox (arbitrarySizedNatural :: Gen OffsetParam)- , GenBox (arbitrarySizedNatural :: Gen LimitParam)- , GenBox (arbitrarySizedNatural :: Gen HeightParam)- , GenBox (arbitrary :: Gen HeightsParam)- , GenBox (arbitrarySizedNatural :: Gen TimeParam)- , GenBox (snd <$> arbitraryXPubKey :: Gen XPubKey)- , GenBox (arbitrary :: Gen DeriveType)- , GenBox (NoCache <$> arbitrary :: Gen NoCache)- , GenBox (NoTx <$> arbitrary :: Gen NoTx)- , GenBox arbitraryBlockHash- , GenBox (listOf arbitraryBlockHash)- , GenBox arbitraryTxHash- , GenBox (listOf arbitraryTxHash)- ]+ [ GenBox arbitraryAddress,+ GenBox (listOf arbitraryAddress),+ GenBox (arbitrary :: Gen StartParam),+ GenBox (arbitrarySizedNatural :: Gen OffsetParam),+ GenBox (arbitrarySizedNatural :: Gen LimitParam),+ GenBox (arbitrarySizedNatural :: Gen HeightParam),+ GenBox (arbitrary :: Gen HeightsParam),+ GenBox (arbitrarySizedNatural :: Gen TimeParam),+ GenBox (snd <$> arbitraryXPubKey :: Gen XPubKey),+ GenBox (arbitrary :: Gen DeriveType),+ GenBox (NoCache <$> arbitrary :: Gen NoCache),+ GenBox (NoTx <$> arbitrary :: Gen NoTx),+ GenBox arbitraryBlockHash,+ GenBox (listOf arbitraryBlockHash),+ GenBox arbitraryTxHash,+ GenBox (listOf arbitraryTxHash)+ ] spec :: Spec spec =- describe "Parameter encoding" $- forM_ params $ \(GenBox g) -> testParam g+ describe "Parameter encoding" $+ forM_ params $ \(GenBox g) -> testParam g testParam :: (Eq a, Show a, Param a) => Gen a -> Spec testParam pGen =- prop ("encodeParam/parseParam identity for parameter " <> name) $- forAll pGen $ \p ->- case encodeParam btc p of- Just txts -> parseParam btc txts `shouldBe` Just p- _ -> expectationFailure "Param encoding failed"+ prop ("encodeParam/parseParam identity for parameter " <> name) $+ forAll pGen $ \p ->+ case encodeParam btc p of+ Just txts -> parseParam btc txts `shouldBe` Just p+ _ -> expectationFailure "Param encoding failed" where name = cs $ proxyLabel $ proxy pGen proxy :: Gen a -> Proxy a proxy = const Proxy instance Arbitrary StartParam where- arbitrary =- oneof- [ StartParamHash <$> arbitraryHash256- , StartParamHeight . fromIntegral- <$> (choose (0, 1230768000) :: Gen Word64)- , StartParamTime . fromIntegral- <$> (choose (1230768000, maxBound) :: Gen Word64)- ]+ arbitrary =+ oneof+ [ StartParamHash <$> arbitraryHash256,+ StartParamHeight . fromIntegral+ <$> (choose (0, 1230768000) :: Gen Word64),+ StartParamTime . fromIntegral+ <$> (choose (1230768000, maxBound) :: Gen Word64)+ ] instance Arbitrary HeightsParam where- arbitrary = HeightsParam <$> listOf arbitrarySizedNatural+ arbitrary = HeightsParam <$> listOf arbitrarySizedNatural