haskoin-store-data 0.64.0 → 0.64.1
raw patch · 8 files changed
+4060/−3963 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +8/−0
- haskoin-store-data.cabal +2/−2
- src/Haskoin/Store/Data.hs +3597/−3564
- src/Haskoin/Store/WebClient.hs +141/−142
- src/Haskoin/Store/WebCommon.hs +90/−76
- test/Haskoin/Store/DataSpec.hs +194/−152
- test/Haskoin/Store/WebCommonSpec.hs +28/−27
- test/Spec.hs +0/−0
CHANGELOG.md view
@@ -4,6 +4,14 @@ 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.1+### Changed+- Automatic formatting.+- Improve cache debug logging.++### Fixed+- Add item count to 'all' query metrics.+ ## 0.64.0 ### Changed - Improve metrics.
haskoin-store-data.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8e295ac2c2b5d4bb55a7a408c025cab9e8512f14ea19c9e1e93d35bd3ae2cf07+-- hash: 16e4dd06dcfd3c56d96499877692bf9b24801d4a40a1619d38a0d1e85066ed63 name: haskoin-store-data-version: 0.64.0+version: 0.64.1 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
@@ -1,3567 +1,3600 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# 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- { blockRefHeight :: !BlockHeight- -- ^ block height in the chain- , blockRefPos :: !Word32- -- ^ position of transaction within the block- }- | MemRef- { memRefTime :: !UnixTime- }- deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)---- | 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- { txRefBlock :: !BlockRef- -- ^ block information- , txRefHash :: !TxHash- -- ^ transaction hash- }- 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- { balanceAddress :: !Address- -- ^ address balance- , balanceAmount :: !Word64- -- ^ confirmed balance- , balanceZero :: !Word64- -- ^ unconfirmed balance- , balanceUnspentCount :: !Word64- -- ^ number of unspent outputs- , balanceTxCount :: !Word64- -- ^ number of transactions- , balanceTotalReceived :: !Word64- -- ^ total amount from all outputs in this address- }- deriving (Show, Read, Eq, Ord, Generic, 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- { blockDataHeight :: !BlockHeight- -- ^ height of the block in the chain- , blockDataMainChain :: !Bool- -- ^ is this block in the main chain?- , blockDataWork :: !Integer- -- ^ accumulated work in that block- , blockDataHeader :: !BlockHeader- -- ^ block header- , blockDataSize :: !Word32- -- ^ size of the block including witnesses- , blockDataWeight :: !Word32- -- ^ weight of this block (for segwit networks)- , blockDataTxs :: ![TxHash]- -- ^ block transactions- , blockDataOutputs :: !Word64- -- ^ sum of all transaction outputs- , blockDataFees :: !Word64- -- ^ sum of all transaction fees- , blockDataSubsidy :: !Word64- -- ^ block subsidy- }- deriving (Show, Read, Eq, Ord, Generic, 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- { spenderHash :: !TxHash- -- ^ input transaction hash- , spenderIndex :: !Word32- -- ^ input position in transaction- }- 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- { transactionBlock :: !BlockRef- -- ^ block information for this transaction- , transactionVersion :: !Word32- -- ^ transaction version- , transactionLockTime :: !Word32- -- ^ lock time- , transactionInputs :: ![StoreInput]- -- ^ transaction inputs- , transactionOutputs :: ![StoreOutput]- -- ^ transaction outputs- , transactionDeleted :: !Bool- -- ^ this transaction has been deleted and is no longer valid- , transactionRBF :: !Bool- -- ^ this transaction can be replaced in the mempool- , transactionTime :: !Word64- -- ^ time the transaction was first seen or time of block- , transactionId :: !TxHash- -- ^ transaction id- , transactionSize :: !Word32- -- ^ serialized transaction size (includes witness data)- , transactionWeight :: !Word32- -- ^ transaction weight- , transactionFees :: !Word64- -- ^ fees that this transaction pays (0 for coinbase)- }- 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- { peerUserAgent :: !ByteString- -- ^ user agent string- , peerAddress :: !String- -- ^ network address- , peerVersion :: !Word32- -- ^ version number- , peerServices :: !Word64- -- ^ services field- , peerRelay :: !Bool- -- ^ will relay transactions- }- deriving (Show, Eq, Ord, Generic, NFData)--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 XPubKey [XPubBal]- -> HashMap XPubKey Int- -> [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 = maybe 0 fromIntegral $ HashMap.lookup k xpub_txs- ax = foldl max 0 (map (i 0) xs)- cx = foldl max 0 (map (i 1) xs)- in BinfoXPubBalance{ getBinfoXPubKey = 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 ]+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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 XPubKey [XPubBal] ->+ HashMap XPubKey Int ->+ [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 = maybe 0 fromIntegral $ HashMap.lookup k xpub_txs+ ax = foldl max 0 (map (i 0) xs)+ cx = foldl max 0 (map (i 1) xs)+ in BinfoXPubBalance+ { getBinfoXPubKey = 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
@@ -1,132 +1,132 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-module Haskoin.Store.WebClient-( ApiConfig(..)-, apiCall-, apiBatch--- Blocks-, GetBlock(..)-, GetBlocks(..)-, GetBlockRaw(..)-, GetBlockBest(..)-, GetBlockBestRaw(..)-, GetBlockLatest(..)-, GetBlockHeight(..)-, GetBlockHeights(..)-, GetBlockHeightRaw(..)-, GetBlockTime(..)-, GetBlockTimeRaw(..)--- Transactions-, GetTx(..)-, GetTxs(..)-, GetTxRaw(..)-, GetTxsRaw(..)-, GetTxsBlock(..)-, GetTxsBlockRaw(..)-, GetTxAfter(..)-, PostTx(..)-, GetMempool(..)-, GetEvents(..)--- Address-, GetAddrTxs(..)-, GetAddrsTxs(..)-, GetAddrTxsFull(..)-, GetAddrsTxsFull(..)-, GetAddrBalance(..)-, GetAddrsBalance(..)-, GetAddrUnspent(..)-, GetAddrsUnspent(..)--- XPubs-, GetXPub(..)-, GetXPubTxs(..)-, GetXPubTxsFull(..)-, GetXPubBalances(..)-, GetXPubUnspent(..)-, DelCachedXPub(..)--- Network-, GetPeers(..)-, GetHealth(..)--- Params-, StartParam(..)-, OffsetParam(..)-, LimitParam(..)-, LimitsParam(..)-, HeightParam(..)-, HeightsParam(..)-, Store.DeriveType(..)-, NoCache(..)-, NoTx(..)-)+{-# LANGUAGE OverloadedStrings #-} -where+module Haskoin.Store.WebClient (+ ApiConfig (..),+ apiCall,+ apiBatch,+ -- Blocks+ GetBlock (..),+ GetBlocks (..),+ GetBlockRaw (..),+ GetBlockBest (..),+ GetBlockBestRaw (..),+ GetBlockLatest (..),+ GetBlockHeight (..),+ GetBlockHeights (..),+ GetBlockHeightRaw (..),+ GetBlockTime (..),+ GetBlockTimeRaw (..),+ -- Transactions+ GetTx (..),+ GetTxs (..),+ GetTxRaw (..),+ GetTxsRaw (..),+ GetTxsBlock (..),+ GetTxsBlockRaw (..),+ GetTxAfter (..),+ PostTx (..),+ GetMempool (..),+ GetEvents (..),+ -- Address+ GetAddrTxs (..),+ GetAddrsTxs (..),+ GetAddrTxsFull (..),+ GetAddrsTxsFull (..),+ GetAddrBalance (..),+ GetAddrsBalance (..),+ GetAddrUnspent (..),+ GetAddrsUnspent (..),+ -- XPubs+ GetXPub (..),+ GetXPubTxs (..),+ GetXPubTxsFull (..),+ GetXPubBalances (..),+ GetXPubUnspent (..),+ DelCachedXPub (..),+ -- Network+ GetPeers (..),+ GetHealth (..),+ -- Params+ StartParam (..),+ OffsetParam (..),+ LimitParam (..),+ LimitsParam (..),+ HeightParam (..),+ HeightsParam (..),+ Store.DeriveType (..),+ NoCache (..),+ NoTx (..),+) where -import Control.Arrow (second)-import Control.Exception-import Control.Lens ((.~), (?~), (^.))-import Control.Monad.Except-import qualified Data.Aeson as A-import qualified Data.ByteString.Lazy as BL-import Data.Bytes.Get-import Data.Bytes.Put-import Data.Bytes.Serial-import Data.Default (Default, def)-import Data.Monoid (Endo (..), appEndo)-import Data.String.Conversions (cs)-import Data.Text (Text)-import qualified Data.Text as Text-import Haskoin.Constants-import Haskoin.Data-import qualified Haskoin.Store.Data as Store-import Haskoin.Store.WebCommon-import Haskoin.Transaction-import Haskoin.Util-import Network.HTTP.Client (Request (..))-import Network.HTTP.Types (StdMethod (..))-import Network.HTTP.Types.Status-import qualified Network.Wreq as HTTP-import Network.Wreq.Types (ResponseChecker)-import Numeric.Natural (Natural)+import Control.Arrow (second)+import Control.Exception+import Control.Lens ((.~), (?~), (^.))+import Control.Monad.Except+import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BL+import Data.Bytes.Get+import Data.Bytes.Put+import Data.Bytes.Serial+import Data.Default (Default, def)+import Data.Monoid (Endo (..), appEndo)+import Data.String.Conversions (cs)+import Data.Text (Text)+import qualified Data.Text as Text+import Haskoin.Constants+import Haskoin.Data+import qualified Haskoin.Store.Data as Store+import Haskoin.Store.WebCommon+import Haskoin.Transaction+import Haskoin.Util+import Network.HTTP.Client (Request (..))+import Network.HTTP.Types (StdMethod (..))+import Network.HTTP.Types.Status+import qualified Network.Wreq as HTTP+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+ , configHost :: !String } deriving (Eq, Show) instance Default ApiConfig where- def = ApiConfig- { configNetwork = bch- , configHost = "https://api.haskoin.com/"- }+ 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:------ > 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)@@ -139,16 +139,16 @@ _ -> throwError $ Store.StringError "Could not post resource" _ -> throwError $ Store.StringError "Unsupported HTTP method" --- | Batch commands that have a large list of arguments:------ > 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@@ -160,8 +160,8 @@ instance Batchable GetBlockHeights (Store.SerialList Store.BlockData) where resourceBatch i (GetBlockHeights (HeightsParam hs) n) =- (`GetBlockHeights` n) <$>- (HeightsParam <$> chunksOf i hs)+ (`GetBlockHeights` n)+ <$> (HeightsParam <$> chunksOf i hs) instance Batchable GetTxs (Store.SerialList Store.Transaction) where resourceBatch i (GetTxs ts) =@@ -192,7 +192,7 @@ ------------------ 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) where@@ -207,10 +207,10 @@ 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@@ -218,11 +218,11 @@ 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@@ -234,7 +234,7 @@ appEndo (opts <> accept <> stat) HTTP.defaults where accept = Endo $ HTTP.header "Accept" .~ ["application/octet-stream"]- stat = Endo $ HTTP.checkResponse ?~ checkStatus+ stat = Endo $ HTTP.checkResponse ?~ checkStatus checkStatus :: ResponseChecker checkStatus req res@@ -245,7 +245,7 @@ throwIO $ case e of Just except -> except :: Store.Except- Nothing -> Store.StringError "could not decode error"+ Nothing -> Store.StringError "could not decode error" where code = res ^. HTTP.responseStatus . HTTP.statusCode message = res ^. HTTP.responseStatus . HTTP.statusMessage@@ -257,7 +257,7 @@ --------------- toExcept :: Either String a -> Either Store.Except a-toExcept (Right a) = Right a+toExcept (Right a) = Right a toExcept (Left err) = Left $ Store.UserError err chunksOf :: Natural -> [a] -> [[a]]@@ -265,4 +265,3 @@ | null xs = [] | otherwise = uncurry (:) $ second (chunksOf n) $ splitAt (fromIntegral n) xs-
src/Haskoin/Store/WebCommon.hs view
@@ -1,36 +1,39 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-module Haskoin.Store.WebCommon+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} -where+module Haskoin.Store.WebCommon where -import Control.Applicative ((<|>))-import Control.Monad (guard)-import Data.Bytes.Serial-import Data.Default (Default, def)-import Data.Proxy (Proxy (..))-import Data.String (IsString (..))-import Data.String.Conversions (cs)-import Data.Text (Text)-import qualified Data.Text as T-import Haskoin.Address-import Haskoin.Block (Block, BlockHash, blockHashToHex,- hexToBlockHash)-import Haskoin.Constants-import Haskoin.Data-import Haskoin.Crypto (Hash256)-import Haskoin.Keys-import qualified Haskoin.Store.Data as Store-import Haskoin.Transaction-import Network.HTTP.Types (StdMethod (..))-import Numeric.Natural (Natural)-import Text.Read (readMaybe)-import qualified Web.Scotty.Trans as Scotty+import Control.Applicative ((<|>))+import Control.Monad (guard)+import Data.Bytes.Serial+import Data.Default (Default, def)+import Data.Proxy (Proxy (..))+import Data.String (IsString (..))+import Data.String.Conversions (cs)+import Data.Text (Text)+import qualified Data.Text as T+import Haskoin.Address+import Haskoin.Block (+ Block,+ BlockHash,+ blockHashToHex,+ hexToBlockHash,+ )+import Haskoin.Constants+import Haskoin.Crypto (Hash256)+import Haskoin.Data+import Haskoin.Keys+import qualified Haskoin.Store.Data as Store+import Haskoin.Transaction+import Network.HTTP.Types (StdMethod (..))+import Numeric.Natural (Natural)+import Text.Read (readMaybe)+import qualified Web.Scotty.Trans as Scotty ------------------- -- API Resources --@@ -41,15 +44,15 @@ resourceMethod _ = GET resourcePath :: Proxy a -> ([Text] -> Text) queryParams :: a -> ([ParamBox], [ParamBox]) -- (resource, querystring)- queryParams _ = ([],[])+ 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)+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) -------------------- -- Resource Paths --@@ -69,6 +72,7 @@ newtype GetBlockTimeRaw = GetBlockTimeRaw TimeParam data GetBlockMTP = GetBlockMTP !TimeParam !NoTx newtype GetBlockMTPRaw = GetBlockMTPRaw TimeParam+ -- Transactions newtype GetTx = GetTx TxHash newtype GetTxs = GetTxs [TxHash]@@ -80,6 +84,7 @@ newtype PostTx = PostTx Tx data GetMempool = GetMempool !(Maybe LimitParam) !OffsetParam data GetEvents = GetEvents+ -- Address data GetAddrTxs = GetAddrTxs !Address !LimitsParam data GetAddrsTxs = GetAddrsTxs ![Address] !LimitsParam@@ -89,6 +94,7 @@ 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@@ -96,6 +102,7 @@ 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@@ -228,7 +235,7 @@ 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)+ ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM) instance ApiResource GetAddrTxsFull (Store.SerialList Store.Transaction) where resourcePath _ = "/address/" <+> "/transactions/full"@@ -239,7 +246,7 @@ 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)+ ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM) instance ApiResource GetAddrBalance Store.Balance where resourcePath _ = "/address/" <+> "/balance"@@ -248,7 +255,7 @@ instance ApiResource GetAddrsBalance (Store.SerialList Store.Balance) where resourcePath _ _ = "/address/balances"- queryParams (GetAddrsBalance as) = ([] , [ParamBox as])+ queryParams (GetAddrsBalance as) = ([], [ParamBox as]) instance ApiResource GetAddrUnspent (Store.SerialList Store.Unspent) where resourcePath _ = "/address/" <+> "/unspent"@@ -259,7 +266,7 @@ 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)+ ([], [ParamBox as] <> noMaybeBox l <> noDefBox o <> noMaybeBox sM) ----------- -- XPubs --@@ -338,7 +345,7 @@ noMaybeBox :: (Param p, Eq p) => Maybe p -> [ParamBox] noMaybeBox (Just p) = [ParamBox p]-noMaybeBox _ = []+noMaybeBox _ = [] asProxy :: a -> Proxy a asProxy = const Proxy@@ -350,7 +357,7 @@ encParam (ParamBox p) = case encodeParam net p of Just [res] -> res- _ -> error "Invalid query param"+ _ -> error "Invalid query param" capturePath :: ApiResource a b => Proxy a -> Scotty.RoutePattern capturePath proxy =@@ -373,24 +380,25 @@ instance Param Address where proxyLabel = const "address"- encodeParam net a = (:[]) <$> addrToText net a+ encodeParam net a = (: []) <$> addrToText net a parseParam net [a] = textToAddr net a- parseParam _ _ = Nothing+ parseParam _ _ = Nothing instance Param [Address] where proxyLabel = const "addresses" encodeParam = mapM . addrToText parseParam = mapM . textToAddr -data StartParam = StartParamHash- { startParamHash :: Hash256- }+data StartParam+ = StartParamHash+ { startParamHash :: Hash256+ } | StartParamHeight- { startParamHeight :: Natural- }+ { startParamHeight :: Natural+ } | StartParamTime- { startParamTime :: Store.UnixTime- }+ { startParamTime :: Store.UnixTime+ } deriving (Eq, Show) instance Param StartParam where@@ -422,7 +430,8 @@ newtype OffsetParam = OffsetParam { getOffsetParam :: Natural- } deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ }+ deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral) instance Default OffsetParam where def = OffsetParam 0@@ -431,24 +440,24 @@ proxyLabel = const "offset" encodeParam _ (OffsetParam o) = Just [cs $ show o] parseParam _ [s] = OffsetParam <$> readMaybe (cs s)- parseParam _ _ = Nothing+ parseParam _ _ = Nothing newtype LimitParam = LimitParam { getLimitParam :: Natural- } deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ }+ 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+ parseParam _ _ = Nothing -data LimitsParam =- LimitsParam- { paramLimit :: Maybe LimitParam -- 0 means maximum- , paramOffset :: OffsetParam- , paramStart :: Maybe StartParam- }+data LimitsParam = LimitsParam+ { paramLimit :: Maybe LimitParam -- 0 means maximum+ , paramOffset :: OffsetParam+ , paramStart :: Maybe StartParam+ } deriving (Eq, Show) instance Default LimitsParam where@@ -456,17 +465,19 @@ newtype HeightParam = HeightParam { getHeightParam :: Natural- } deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ }+ 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+ parseParam _ _ = Nothing newtype HeightsParam = HeightsParam { getHeightsParam :: [Natural]- } deriving (Eq, Show, Read)+ }+ deriving (Eq, Show, Read) instance Param HeightsParam where proxyLabel = const "heights"@@ -475,19 +486,20 @@ newtype TimeParam = TimeParam { getTimeParam :: Store.UnixTime- } deriving (Eq, Show, Read, Enum, Ord, Num, Real, Integral)+ }+ 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+ parseParam _ _ = Nothing instance Param XPubKey where proxyLabel = const "xpub" encodeParam net p = Just [xPubExport net p] parseParam net [s] = xPubImport net s- parseParam _ _ = Nothing+ parseParam _ _ = Nothing instance Param Store.DeriveType where proxyLabel = const "derive"@@ -497,47 +509,49 @@ parseParam net d = do res <- case d of [x] -> Store.textToDeriveType x- _ -> Nothing+ _ -> Nothing guard (getSegWit net || res == Store.DeriveNormal) return res newtype NoCache = NoCache { getNoCache :: Bool- } deriving (Eq, Show, Read)+ }+ deriving (Eq, Show, Read) instance Default NoCache where def = NoCache False instance Param NoCache where proxyLabel = const "nocache"- encodeParam _ (NoCache True) = Just ["true"]+ encodeParam _ (NoCache True) = Just ["true"] encodeParam _ (NoCache False) = Just ["false"] parseParam _ = \case- ["true"] -> Just $ NoCache True+ ["true"] -> Just $ NoCache True ["false"] -> Just $ NoCache False- _ -> Nothing+ _ -> Nothing newtype NoTx = NoTx { getNoTx :: Bool- } deriving (Eq, Show, Read)+ }+ deriving (Eq, Show, Read) instance Default NoTx where def = NoTx False instance Param NoTx where proxyLabel = const "notx"- encodeParam _ (NoTx True) = Just ["true"]+ encodeParam _ (NoTx True) = Just ["true"] encodeParam _ (NoTx False) = Just ["false"] parseParam _ = \case- ["true"] -> Just $ NoTx True+ ["true"] -> Just $ NoTx True ["false"] -> Just $ NoTx False- _ -> Nothing+ _ -> Nothing instance Param BlockHash where proxyLabel = const "block" encodeParam _ b = Just [blockHashToHex b] parseParam _ [s] = hexToBlockHash s- parseParam _ _ = Nothing+ parseParam _ _ = Nothing instance Param [BlockHash] where proxyLabel = const "blocks"@@ -548,7 +562,7 @@ proxyLabel = const "txid" encodeParam _ t = Just [txHashToHex t] parseParam _ [s] = hexToTxHash s- parseParam _ _ = Nothing+ parseParam _ _ = Nothing instance Param [TxHash] where proxyLabel = const "txids"
test/Haskoin/Store/DataSpec.hs view
@@ -1,23 +1,24 @@ {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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+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)@@ -75,82 +76,120 @@ 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)+ [ 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@@ -160,7 +199,7 @@ 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+ forM_ netVals $ \(NetBox (j, e, p, g)) -> testNetJson j e p g instance Arbitrary BlockRef where arbitrary =@@ -201,8 +240,9 @@ arbitraryStoreInputNet = do net <- arbitraryNetwork store <- arbitrary- let res | getSegWit net = store- | otherwise = store{ inputWitness = [] }+ let res+ | getSegWit net = store+ | otherwise = store{inputWitness = []} return (net, res) instance Arbitrary Spender where@@ -211,10 +251,10 @@ instance Arbitrary StoreOutput where arbitrary = StoreOutput- <$> arbitrary- <*> arbitraryBS1- <*> arbitrary- <*> arbitraryMaybe arbitraryAddress+ <$> arbitrary+ <*> arbitraryBS1+ <*> arbitrary+ <*> arbitraryMaybe arbitraryAddress instance Arbitrary Transaction where arbitrary =@@ -324,23 +364,24 @@ instance Arbitrary BlockData where arbitrary = BlockData- <$> arbitrary- <*> arbitrary- <*> (fromInteger <$> suchThat arbitrary (0<=))- <*> arbitraryBlockHeader- <*> arbitrary- <*> arbitrary- <*> listOf1 arbitraryTxHash- <*> arbitrary- <*> arbitrary- <*> arbitrary+ <$> 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}+ let res+ | getSegWit net = dat+ | otherwise = dat{blockDataWeight = 0} return (net, res) instance Arbitrary a => Arbitrary (GenericResult a) where@@ -361,41 +402,42 @@ instance Arbitrary XPubSummary where arbitrary = XPubSummary- <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary instance Arbitrary Event where arbitrary = oneof- [ EventBlock <$> arbitraryBlockHash- , EventTx <$> arbitraryTxHash- ]+ [ 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- ]+ [ 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- ]+ arbitrary =+ oneof+ [ BinfoTxIdHash <$> arbitraryTxHash+ , BinfoTxIdIndex <$> arbitrary+ ] instance Arbitrary BinfoMultiAddr where arbitrary = do@@ -405,22 +447,22 @@ getBinfoMultiAddrInfo <- arbitrary getBinfoMultiAddrRecommendFee <- arbitrary getBinfoMultiAddrCashAddr <- arbitrary- return BinfoMultiAddr {..}+ return BinfoMultiAddr{..} instance Arbitrary BinfoRawAddr where arbitrary = do binfoRawAddr <- oneof- [ BinfoAddr <$> arbitraryAddress- , BinfoXpub . snd <$> arbitraryXPubKey- ]+ [ BinfoAddr <$> arbitraryAddress+ , BinfoXpub . snd <$> arbitraryXPubKey+ ] binfoRawBalance <- arbitrary binfoRawTxCount <- arbitrary binfoRawUnredeemed <- arbitrary binfoRawReceived <- arbitrary binfoRawSent <- arbitrary binfoRawTxs <- arbitrary- return $ BinfoRawAddr {..}+ return $ BinfoRawAddr{..} instance Arbitrary BinfoShortBal where arbitrary = BinfoShortBal <$> arbitrary <*> arbitrary <*> arbitrary@@ -435,7 +477,7 @@ getBinfoXPubKey <- snd <$> arbitraryXPubKey getBinfoXPubAccountIndex <- arbitrary getBinfoXPubChangeIndex <- arbitrary- elements [BinfoAddrBalance {..}, BinfoXPubBalance {..}]+ elements [BinfoAddrBalance{..}, BinfoXPubBalance{..}] instance Arbitrary BinfoWallet where arbitrary = do@@ -444,7 +486,7 @@ getBinfoWalletFilteredCount <- arbitrary getBinfoWalletTotalReceived <- arbitrary getBinfoWalletTotalSent <- arbitrary- return BinfoWallet {..}+ return BinfoWallet{..} instance Arbitrary BinfoBlock where arbitrary = do@@ -486,7 +528,7 @@ getBinfoTxBlockIndex <- arbitrary getBinfoTxBlockHeight <- arbitrary getBinfoTxResultBal <- arbitrary- return BinfoTx {..}+ return BinfoTx{..} instance Arbitrary BinfoTxInput where arbitrary = do@@ -495,7 +537,7 @@ getBinfoTxInputScript <- B.pack <$> listOf arbitrary getBinfoTxInputIndex <- arbitrary getBinfoTxInputPrevOut <- arbitrary- return BinfoTxInput {..}+ return BinfoTxInput{..} instance Arbitrary BinfoTxOutput where arbitrary = do@@ -509,19 +551,19 @@ getBinfoTxOutputAddress <- oneof [return Nothing, Just <$> arbitraryAddress] getBinfoTxOutputXPub <- arbitrary- return BinfoTxOutput {..}+ return BinfoTxOutput{..} instance Arbitrary BinfoSpender where arbitrary = do getBinfoSpenderTxIndex <- arbitrary getBinfoSpenderIndex <- arbitrary- return BinfoSpender {..}+ return BinfoSpender{..} instance Arbitrary BinfoXPubPath where arbitrary = do getBinfoXPubPathKey <- snd <$> arbitraryXPubKey getBinfoXPubPathDeriv <- arbitrarySoftPath- return BinfoXPubPath {..}+ return BinfoXPubPath{..} instance Arbitrary BinfoInfo where arbitrary = do@@ -530,7 +572,7 @@ getBinfoLocal <- arbitrary getBinfoBTC <- arbitrary getBinfoLatestBlock <- arbitrary- return BinfoInfo {..}+ return BinfoInfo{..} instance Arbitrary BinfoBlockInfo where arbitrary = do@@ -538,7 +580,7 @@ getBinfoBlockInfoHeight <- arbitrary getBinfoBlockInfoTime <- arbitrary getBinfoBlockInfoIndex <- arbitrary- return BinfoBlockInfo {..}+ return BinfoBlockInfo{..} instance Arbitrary BinfoSymbol where arbitrary = do@@ -548,7 +590,7 @@ getBinfoSymbolConversion <- arbitrary getBinfoSymbolAfter <- arbitrary getBinfoSymbolLocal <- arbitrary- return BinfoSymbol {..}+ return BinfoSymbol{..} instance Arbitrary BinfoRate where arbitrary = BinfoRate <$> arbitrary <*> arbitrary <*> arbitrary@@ -591,11 +633,11 @@ instance Arbitrary BinfoHeader where arbitrary = BinfoHeader- <$> arbitraryBlockHash- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary+ <$> arbitraryBlockHash+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary instance Arbitrary BinfoMempool where arbitrary = BinfoMempool <$> arbitrary
test/Haskoin/Store/WebCommonSpec.hs view
@@ -1,26 +1,27 @@ {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}-module Haskoin.Store.WebCommonSpec- ( spec- ) where -import Control.Monad (forM_)-import Data.Proxy-import Data.String.Conversions (cs)-import Data.Word-import Haskoin-import Haskoin.Store.Data-import Haskoin.Store.DataSpec ()-import Haskoin.Store.WebCommon-import Haskoin.Util.Arbitrary-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck+module Haskoin.Store.WebCommonSpec (+ spec,+) where +import Control.Monad (forM_)+import Data.Proxy+import Data.String.Conversions (cs)+import Data.Word+import Haskoin+import Haskoin.Store.Data+import Haskoin.Store.DataSpec ()+import Haskoin.Store.WebCommon+import Haskoin.Util.Arbitrary+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+ data GenBox = forall p. (Show p, Eq p, Param p) => GenBox (Gen p) params :: [GenBox]@@ -51,10 +52,10 @@ 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"+ 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@@ -64,10 +65,10 @@ arbitrary = oneof [ StartParamHash <$> arbitraryHash256- , StartParamHeight . fromIntegral <$>- (choose (0, 1230768000) :: Gen Word64)- , StartParamTime . fromIntegral <$>- (choose (1230768000, maxBound) :: Gen Word64)+ , StartParamHeight . fromIntegral+ <$> (choose (0, 1230768000) :: Gen Word64)+ , StartParamTime . fromIntegral+ <$> (choose (1230768000, maxBound) :: Gen Word64) ] instance Arbitrary HeightsParam where
test/Spec.hs view