{-# 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(..) -- * Other Data , TxId(..) , GenericResult(..) , RawResult(..) , RawResultList(..) , PeerInformation(..) , Healthy(..) , BlockHealth(..) , TimeHealth(..) , CountHealth(..) , MaxHealth(..) , HealthCheck(..) , Event(..) , Except(..) -- * Blockchain.info API , BinfoTxId(..) , encodeBinfoTxId , BinfoFilter(..) , BinfoMultiAddr(..) , binfoMultiAddrToJSON , binfoMultiAddrToEncoding , binfoMultiAddrParseJSON , BinfoBalance(..) , toBinfoAddrs , binfoBalanceToJSON , binfoBalanceToEncoding , binfoBalanceParseJSON , BinfoAddr(..) , parseBinfoAddr , BinfoWallet(..) , BinfoUnspent(..) , binfoUnspentToJSON , binfoUnspentToEncoding , binfoUnspentParseJSON , binfoHexValue , BinfoUnspents(..) , binfoUnspentsToJSON , binfoUnspentsToEncoding , binfoUnspentsParseJSON , BinfoTx(..) , relevantTxs , toBinfoTx , toBinfoTxSimple , binfoTxToJSON , binfoTxToEncoding , binfoTxParseJSON , BinfoTxInput(..) , binfoTxInputToJSON , binfoTxInputToEncoding , binfoTxInputParseJSON , BinfoTxOutput(..) , binfoTxOutputToJSON , binfoTxOutputToEncoding , binfoTxOutputParseJSON , BinfoSpender(..) , BinfoXPubPath(..) , binfoXPubPathToJSON , binfoXPubPathToEncoding , binfoXPubPathParseJSON , BinfoInfo(..) , BinfoBlockInfo(..) , BinfoSymbol(..) , BinfoTicker(..) ) where import Control.Applicative ((<|>)) import Control.DeepSeq (NFData) import Control.Exception (Exception) import Control.Monad (guard, join, mzero, (<=<)) import Data.Aeson (Encoding, FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), Value (..), object, pairs, withObject, (.!=), (.:), (.:?), (.=)) import qualified Data.Aeson as A import Data.Aeson.Encoding (list, null_, pair, text, unsafeToEncoding) import Data.Aeson.Types (Parser) import Data.Bits (setBit, shift, testBit, (.&.), (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.ByteString.Builder (char7, lazyByteStringHex) import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as BSS import Data.Default (Default (..)) import Data.Either (fromRight, lefts, rights) 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.Map.Strict (Map) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe, maybeToList) import Data.Serialize (Get, Put, Serialize (..), getWord32be, getWord64be, getWord8, putWord32be, putWord64be, putWord8) import qualified Data.Serialize as S import Data.String.Conversions (cs) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Data.Text.Lazy as TL import Data.Word (Word32, Word64) import GHC.Generics (Generic) import Haskoin (Address, BlockHash, BlockHeader (..), BlockHeight, BlockWork, Coin (..), KeyIndex, Network (..), OutPoint (..), PubKeyI (..), SoftPath, Tx (..), TxHash (..), TxIn (..), TxOut (..), WitnessStack, XPubKey (..), addrFromJSON, addrToEncoding, addrToJSON, bch, blockHashToHex, btc, decodeHex, eitherToMaybe, encodeHex, headerHash, hexToTxHash, maybeToEither, parseSoft, pathToList, pathToStr, putVarInt, scriptToAddressBS, textToAddr, txHash, txHashToHex, wrapPubKey, xPubFromJSON, xPubImport, xPubToEncoding, xPubToJSON) import Text.Printf (printf) import Text.Read (readMaybe) import Web.Scotty.Trans (Parsable (..), ScottyError (..)) data DeriveType = DeriveNormal | DeriveP2SH | DeriveP2WPKH deriving (Show, Eq, Generic, NFData, Serialize) instance Default DeriveType where def = DeriveNormal data XPubSpec = XPubSpec { xPubSpecKey :: !XPubKey , xPubDeriveType :: !DeriveType } deriving (Show, Eq, Generic, NFData) instance Hashable XPubSpec where hashWithSalt i XPubSpec {xPubSpecKey = XPubKey {xPubKey = pubkey}} = hashWithSalt i pubkey instance Serialize XPubSpec where put XPubSpec {xPubSpecKey = k, xPubDeriveType = t} = do put (xPubDepth k) put (xPubParent k) put (xPubIndex k) put (xPubChain k) put (wrapPubKey True (xPubKey k)) put t get = do d <- get p <- get i <- get c <- get k <- get t <- get let x = XPubKey { xPubDepth = d , xPubParent = p , xPubIndex = i , xPubChain = c , xPubKey = pubKeyPoint k } return XPubSpec {xPubSpecKey = x, xPubDeriveType = t} type UnixTime = Word64 type BlockPos = Word32 -- | Serialize such that ordering is inverted. putUnixTime :: Word64 -> Put putUnixTime w = putWord64be $ maxBound - w getUnixTime :: Get Word64 getUnixTime = (maxBound -) <$> getWord64be -- | Reference to a block where a transaction is stored. data BlockRef = BlockRef { blockRefHeight :: !BlockHeight -- ^ block height in the chain , blockRefPos :: !Word32 -- ^ position of transaction within the block } | MemRef { memRefTime :: !UnixTime } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData) -- | Serialized entities will sort in reverse order. instance Serialize BlockRef where put MemRef {memRefTime = t} = do putWord8 0x00 putUnixTime t put BlockRef {blockRefHeight = h, blockRefPos = p} = do putWord8 0x01 putWord32be (maxBound - h) putWord32be (maxBound - p) get = getmemref <|> getblockref where getmemref = do guard . (== 0x00) =<< getWord8 MemRef <$> getUnixTime getblockref = do guard . (== 0x01) =<< getWord8 h <- (maxBound -) <$> getWord32be p <- (maxBound -) <$> getWord32be return BlockRef {blockRefHeight = h, blockRefPos = p} confirmed :: BlockRef -> Bool confirmed BlockRef {} = True confirmed MemRef {} = False instance ToJSON BlockRef where toJSON BlockRef {blockRefHeight = h, blockRefPos = p} = object ["height" .= h, "position" .= p] toJSON MemRef {memRefTime = t} = object ["mempool" .= t] toEncoding BlockRef {blockRefHeight = h, blockRefPos = p} = pairs ("height" .= h <> "position" .= p) toEncoding MemRef {memRefTime = t} = pairs ("mempool" .= t) instance FromJSON BlockRef where parseJSON = A.withObject "blockref" $ \o -> b o <|> m o where b o = do height <- o .: "height" position <- o .: "position" return BlockRef{blockRefHeight = height, blockRefPos = position} m o = do mempool <- o .: "mempool" return MemRef{memRefTime = mempool} -- | Transaction in relation to an address. data TxRef = TxRef { txRefBlock :: !BlockRef -- ^ block information , txRefHash :: !TxHash -- ^ transaction hash } deriving (Show, Eq, Ord, Generic, Serialize, Hashable, NFData) instance ToJSON TxRef where toJSON btx = object ["txid" .= txRefHash btx, "block" .= txRefBlock btx] toEncoding btx = 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, Serialize, Hashable, NFData) zeroBalance :: Address -> Balance zeroBalance a = Balance { balanceAddress = a , balanceAmount = 0 , balanceUnspentCount = 0 , balanceZero = 0 , balanceTxCount = 0 , balanceTotalReceived = 0 } nullBalance :: Balance -> Bool nullBalance Balance { balanceAmount = 0 , balanceUnspentCount = 0 , balanceZero = 0 , balanceTxCount = 0 , balanceTotalReceived = 0 } = True nullBalance _ = False balanceToJSON :: Network -> Balance -> Value balanceToJSON net b = object [ "address" .= addrToJSON net (balanceAddress b) , "confirmed" .= balanceAmount b , "unconfirmed" .= balanceZero b , "utxo" .= balanceUnspentCount b , "txs" .= balanceTxCount b , "received" .= balanceTotalReceived b ] balanceToEncoding :: Network -> Balance -> Encoding balanceToEncoding net b = pairs ( "address" `pair` addrToEncoding net (balanceAddress b) <> "confirmed" .= balanceAmount b <> "unconfirmed" .= balanceZero b <> "utxo" .= balanceUnspentCount b <> "txs" .= balanceTxCount b <> "received" .= balanceTotalReceived b ) balanceParseJSON :: Network -> Value -> Parser Balance balanceParseJSON net = A.withObject "balance" $ \o -> do amount <- o .: "confirmed" unconfirmed <- o .: "unconfirmed" utxo <- o .: "utxo" txs <- o .: "txs" received <- o .: "received" address <- addrFromJSON net =<< o .: "address" return Balance { balanceAddress = address , balanceAmount = amount , balanceUnspentCount = utxo , balanceZero = unconfirmed , balanceTxCount = txs , balanceTotalReceived = received } -- | Unspent output. data Unspent = Unspent { unspentBlock :: !BlockRef , unspentPoint :: !OutPoint , unspentAmount :: !Word64 , unspentScript :: !ShortByteString , unspentAddress :: !(Maybe Address) } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData) instance Coin Unspent where coinValue = unspentAmount unspentToJSON :: Network -> Unspent -> Value unspentToJSON net u = object [ "address" .= (addrToJSON net <$> unspentAddress u) , "block" .= unspentBlock u , "txid" .= outPointHash (unspentPoint u) , "index" .= outPointIndex (unspentPoint u) , "pkscript" .= script , "value" .= unspentAmount u ] where bsscript = BSS.fromShort (unspentScript u) script = encodeHex bsscript unspentToEncoding :: Network -> Unspent -> Encoding unspentToEncoding net u = pairs ( "address" `pair` maybe null_ (addrToEncoding net) (unspentAddress u) <> "block" .= unspentBlock u <> "txid" .= outPointHash (unspentPoint u) <> "index" .= outPointIndex (unspentPoint u) <> "pkscript" `pair` text script <> "value" .= unspentAmount u ) where bsscript = BSS.fromShort (unspentScript u) script = encodeHex bsscript 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 <- BSS.toShort <$> (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 :: !BlockWork -- ^ accumulated work in that block , blockDataHeader :: !BlockHeader -- ^ block header , blockDataSize :: !Word32 -- ^ size of the block including witnesses , blockDataWeight :: !Word32 -- ^ weight of this block (for segwit networks) , blockDataTxs :: ![TxHash] -- ^ block transactions , blockDataOutputs :: !Word64 -- ^ sum of all transaction outputs , blockDataFees :: !Word64 -- ^ sum of all transaction fees , blockDataSubsidy :: !Word64 -- ^ block subsidy } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData) blockDataToJSON :: Network -> BlockData -> Value blockDataToJSON net bv = object $ [ "hash" .= headerHash (blockDataHeader bv) , "height" .= blockDataHeight bv , "mainchain" .= blockDataMainChain bv , "previous" .= prevBlock (blockDataHeader bv) , "time" .= blockTimestamp (blockDataHeader bv) , "version" .= blockVersion (blockDataHeader bv) , "bits" .= blockBits (blockDataHeader bv) , "nonce" .= bhNonce (blockDataHeader bv) , "size" .= blockDataSize bv , "tx" .= blockDataTxs bv , "merkle" .= TxHash (merkleRoot (blockDataHeader bv)) , "subsidy" .= blockDataSubsidy bv , "fees" .= blockDataFees bv , "outputs" .= blockDataOutputs bv , "work" .= blockDataWork bv ] <> ["weight" .= blockDataWeight bv | getSegWit net] blockDataToEncoding :: Network -> BlockData -> Encoding blockDataToEncoding net bv = pairs ( "hash" `pair` text (blockHashToHex (headerHash (blockDataHeader bv))) <> "height" .= blockDataHeight bv <> "mainchain" .= blockDataMainChain bv <> "previous" .= prevBlock (blockDataHeader bv) <> "time" .= blockTimestamp (blockDataHeader bv) <> "version" .= blockVersion (blockDataHeader bv) <> "bits" .= blockBits (blockDataHeader bv) <> "nonce" .= bhNonce (blockDataHeader bv) <> "size" .= blockDataSize bv <> "tx" .= blockDataTxs bv <> "merkle" `pair` text (txHashToHex (TxHash (merkleRoot (blockDataHeader bv)))) <> "subsidy" .= blockDataSubsidy bv <> "fees" .= blockDataFees bv <> "outputs" .= blockDataOutputs bv <> "work" .= blockDataWork bv <> (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, Serialize, Hashable, NFData) isCoinbase :: StoreInput -> Bool isCoinbase StoreCoinbase {} = True isCoinbase StoreInput {} = False storeInputToJSON :: Network -> StoreInput -> Value storeInputToJSON net StoreInput { inputPoint = OutPoint oph opi , inputSequence = sq , inputSigScript = ss , inputPkScript = ps , inputAmount = val , inputWitness = wit , inputAddress = 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 net StoreCoinbase { inputPoint = OutPoint oph opi , inputSequence = sq , inputSigScript = ss , inputWitness = wit } = object $ [ "coinbase" .= True , "txid" .= oph , "output" .= opi , "sigscript" .= String (encodeHex ss) , "sequence" .= sq , "pkscript" .= Null , "value" .= Null , "address" .= Null , "witness" .= 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 } = pairs ( "coinbase" .= False <> "txid" .= oph <> "output" .= opi <> "sigscript" `pair` text (encodeHex ss) <> "sequence" .= sq <> "pkscript" `pair` text (encodeHex ps) <> "value" .= val <> "address" `pair` maybe null_ (addrToEncoding net) a <> "witness" .= map encodeHex wit ) storeInputToEncoding net StoreCoinbase { inputPoint = OutPoint oph opi , inputSequence = sq , inputSigScript = ss , inputWitness = wit } = pairs ( "coinbase" .= True <> "txid" `pair` text (txHashToHex oph) <> "output" .= opi <> "sigscript" `pair` text (encodeHex ss) <> "sequence" .= sq <> "pkscript" `pair` null_ <> "value" `pair` null_ <> "address" `pair` null_ <> "witness" .= 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, Serialize, Hashable, NFData) instance ToJSON Spender where toJSON n = object [ "txid" .= txHashToHex (spenderHash n) , "input" .= spenderIndex n ] toEncoding n = pairs $ "txid" .= txHashToHex (spenderHash n) <> "input" .= spenderIndex n instance FromJSON Spender where parseJSON = A.withObject "spender" $ \o -> Spender <$> o .: "txid" <*> o .: "input" -- | Output information. data StoreOutput = StoreOutput { outputAmount :: !Word64 , outputScript :: !ByteString , outputSpender :: !(Maybe Spender) , outputAddress :: !(Maybe Address) } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData) storeOutputToJSON :: Network -> StoreOutput -> Value storeOutputToJSON net d = object [ "address" .= (addrToJSON net <$> outputAddress d) , "pkscript" .= encodeHex (outputScript d) , "value" .= outputAmount d , "spent" .= isJust (outputSpender d) , "spender" .= outputSpender d ] storeOutputToEncoding :: Network -> StoreOutput -> Encoding storeOutputToEncoding net d = pairs ( "address" `pair` maybe null_ (addrToEncoding net) (outputAddress d) <> "pkscript" `pair` 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 , outputAddress = addr } data Prev = Prev { prevScript :: !ByteString , prevAmount :: !Word64 } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData) 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 , outputAddress = 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, Serialize, NFData) toTransaction :: TxData -> IntMap Spender -> Transaction toTransaction t sm = Transaction { transactionBlock = txDataBlock t , transactionVersion = txVersion (txData t) , transactionLockTime = txLockTime (txData t) , transactionInputs = ins , transactionOutputs = outs , transactionDeleted = txDataDeleted t , transactionRBF = txDataRBF t , transactionTime = txDataTime t , transactionId = txid , transactionSize = txsize , transactionWeight = txweight , transactionFees = fees } where txid = txHash (txData t) txsize = fromIntegral $ B.length (S.encode (txData t)) txweight = let b = B.length $ S.encode (txData t) {txWitness = []} x = B.length $ S.encode (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, Serialize, NFData) 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 = 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 = pairs ( "txid" .= transactionId dtx <> "size" .= transactionSize dtx <> "version" .= transactionVersion dtx <> "locktime" .= transactionLockTime dtx <> "fee" .= transactionFees dtx <> "inputs" `pair` list (storeInputToEncoding net) (transactionInputs dtx) <> "outputs" `pair` list (storeOutputToEncoding net) (transactionOutputs dtx) <> "block" .= transactionBlock dtx <> "deleted" .= transactionDeleted dtx <> "time" .= transactionTime dtx <> "rbf" .= transactionRBF dtx <> "weight" .= 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, Serialize) instance ToJSON PeerInformation where toJSON p = object [ "useragent" .= String (cs (peerUserAgent p)) , "address" .= peerAddress p , "version" .= peerVersion p , "services" .= String (encodeHex (S.encode (peerServices p))) , "relay" .= peerRelay p ] toEncoding p = pairs ( "useragent" `pair` text (cs (peerUserAgent p)) <> "address" .= peerAddress p <> "version" .= peerVersion p <> "services" `pair` text (encodeHex (S.encode (peerServices p))) <> "relay" .= peerRelay p ) instance FromJSON PeerInformation where parseJSON = A.withObject "peerinformation" $ \o -> do String useragent <- o .: "useragent" address <- o .: "address" version <- o .: "version" services <- o .: "services" >>= jsonHex >>= \b -> case S.decode b of Left e -> fail $ "Could not decode services: " <> e Right s -> return s relay <- o .: "relay" return PeerInformation { peerUserAgent = cs useragent , peerAddress = address , peerVersion = version , peerServices = services , peerRelay = relay } -- | Address balances for an extended public key. data XPubBal = XPubBal { xPubBalPath :: ![KeyIndex] , xPubBal :: !Balance } deriving (Show, Ord, Eq, Generic, Serialize, NFData) xPubBalToJSON :: Network -> XPubBal -> Value xPubBalToJSON net XPubBal {xPubBalPath = p, xPubBal = b} = object ["path" .= p, "balance" .= balanceToJSON net b] xPubBalToEncoding :: Network -> XPubBal -> Encoding xPubBalToEncoding net XPubBal {xPubBalPath = p, xPubBal = b} = pairs ("path" .= p <> "balance" `pair` balanceToEncoding net b) xPubBalParseJSON :: Network -> Value -> Parser XPubBal xPubBalParseJSON net = A.withObject "xpubbal" $ \o -> do path <- o .: "path" balance <- balanceParseJSON net =<< o .: "balance" return XPubBal {xPubBalPath = path, xPubBal = balance} -- | Unspent transaction for extended public key. data XPubUnspent = XPubUnspent { xPubUnspentPath :: ![KeyIndex] , xPubUnspent :: !Unspent } deriving (Show, Eq, Generic, Serialize, NFData) xPubUnspentToJSON :: Network -> XPubUnspent -> Value xPubUnspentToJSON net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} = object ["path" .= p, "unspent" .= unspentToJSON net u] xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding xPubUnspentToEncoding net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} = pairs ("path" .= p <> "unspent" `pair` unspentToEncoding net u) xPubUnspentParseJSON :: Network -> Value -> Parser XPubUnspent xPubUnspentParseJSON net = A.withObject "xpubunspent" $ \o -> do p <- o .: "path" u <- o .: "unspent" >>= unspentParseJSON net return XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} data XPubSummary = XPubSummary { xPubSummaryConfirmed :: !Word64 , xPubSummaryZero :: !Word64 , xPubSummaryReceived :: !Word64 , xPubUnspentCount :: !Word64 , xPubExternalIndex :: !Word32 , xPubChangeIndex :: !Word32 } deriving (Eq, Show, Generic, Serialize, NFData) instance ToJSON XPubSummary where toJSON XPubSummary { xPubSummaryConfirmed = c , xPubSummaryZero = z , xPubSummaryReceived = r , xPubUnspentCount = u , xPubExternalIndex = ext , xPubChangeIndex = ch } = object [ "balance" .= object [ "confirmed" .= c , "unconfirmed" .= z , "received" .= r , "utxo" .= u ] , "indices" .= object ["change" .= ch, "external" .= ext] ] toEncoding XPubSummary { xPubSummaryConfirmed = c , xPubSummaryZero = z , xPubSummaryReceived = r , xPubUnspentCount = u , xPubExternalIndex = ext , xPubChangeIndex = ch } = pairs ( "balance" `pair` pairs ( "confirmed" .= c <> "unconfirmed" .= z <> "received" .= r <> "utxo" .= u ) <> "indices" `pair` pairs ( "change" .= ch <> "external" .= ext ) ) instance FromJSON XPubSummary where parseJSON = A.withObject "xpubsummary" $ \o -> do b <- o .: "balance" i <- o .: "indices" conf <- b .: "confirmed" unconfirmed <- b .: "unconfirmed" received <- b .: "received" utxo <- b .: "utxo" change <- i .: "change" external <- i .: "external" return XPubSummary { xPubSummaryConfirmed = conf , xPubSummaryZero = unconfirmed , xPubSummaryReceived = received , xPubUnspentCount = utxo , xPubExternalIndex = external , xPubChangeIndex = change } class Healthy a where isOK :: a -> Bool data BlockHealth = BlockHealth { blockHealthHeaders :: !BlockHeight , blockHealthBlocks :: !BlockHeight , blockHealthMaxDiff :: !Int } deriving (Show, Eq, Generic, NFData) instance Serialize BlockHealth where put h@BlockHealth {..} = do put (isOK h) put blockHealthHeaders put blockHealthBlocks put blockHealthMaxDiff get = do k <- get blockHealthHeaders <- get blockHealthBlocks <- get blockHealthMaxDiff <- get let h = BlockHealth {..} guard (k == isOK h) return h instance Healthy BlockHealth where isOK BlockHealth {..} = h - b <= blockHealthMaxDiff where h = fromIntegral blockHealthHeaders b = fromIntegral blockHealthBlocks instance ToJSON BlockHealth where toJSON h@BlockHealth {..} = object [ "headers" .= blockHealthHeaders , "blocks" .= blockHealthBlocks , "diff" .= diff , "max" .= blockHealthMaxDiff , "ok" .= isOK h ] where diff = blockHealthHeaders - blockHealthBlocks instance FromJSON BlockHealth where parseJSON = A.withObject "BlockHealth" $ \o -> do blockHealthHeaders <- o .: "headers" blockHealthBlocks <- o .: "blocks" blockHealthMaxDiff <- o .: "max" return BlockHealth {..} data TimeHealth = TimeHealth { timeHealthAge :: !Int , timeHealthMax :: !Int } deriving (Show, Eq, Generic, NFData) instance Serialize TimeHealth where put h@TimeHealth {..} = do put (isOK h) put timeHealthAge put timeHealthMax get = do k <- get timeHealthAge <- get timeHealthMax <- get let t = TimeHealth {..} guard (k == isOK t) return t instance Healthy TimeHealth where isOK TimeHealth {..} = timeHealthAge <= timeHealthMax instance ToJSON TimeHealth where toJSON h@TimeHealth {..} = object [ "age" .= timeHealthAge , "max" .= timeHealthMax , "ok" .= isOK h ] instance FromJSON TimeHealth where parseJSON = A.withObject "TimeHealth" $ \o -> do timeHealthAge <- o .: "age" timeHealthMax <- o .: "max" return TimeHealth {..} data CountHealth = CountHealth { countHealthNum :: !Int , countHealthMin :: !Int } deriving (Show, Eq, Generic, NFData) instance Serialize CountHealth where put h@CountHealth {..} = do put (isOK h) put countHealthNum put countHealthMin get = do k <- get countHealthNum <- get countHealthMin <- get let c = CountHealth {..} guard (k == isOK c) return c instance Healthy CountHealth where isOK CountHealth {..} = countHealthMin <= countHealthNum instance ToJSON CountHealth where toJSON h@CountHealth {..} = object [ "count" .= countHealthNum , "min" .= countHealthMin , "ok" .= isOK h ] instance FromJSON CountHealth where parseJSON = A.withObject "CountHealth" $ \o -> do countHealthNum <- o .: "count" countHealthMin <- o .: "min" return CountHealth {..} data MaxHealth = MaxHealth { maxHealthNum :: !Int , maxHealthMax :: !Int } deriving (Show, Eq, Generic, NFData) instance Serialize MaxHealth where put h@MaxHealth {..} = do put $ isOK h put maxHealthNum put maxHealthMax get = do k <- get maxHealthNum <- get maxHealthMax <- get let h = MaxHealth {..} guard (k == isOK h) return h instance Healthy MaxHealth where isOK MaxHealth {..} = maxHealthNum <= maxHealthMax instance ToJSON MaxHealth where toJSON h@MaxHealth {..} = 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 Serialize HealthCheck where put h@HealthCheck {..} = do put (isOK h) put healthBlocks put healthLastBlock put healthLastTx put healthPendingTxs put healthPeers put healthNetwork put healthVersion get = do k <- get healthBlocks <- get healthLastBlock <- get healthLastTx <- get healthPendingTxs <- get healthPeers <- get healthNetwork <- get healthVersion <- get let h = HealthCheck {..} guard (k == isOK h) return h instance Healthy HealthCheck where isOK HealthCheck {..} = isOK healthBlocks && isOK healthLastBlock && isOK healthLastTx && isOK healthPendingTxs && isOK healthPeers instance ToJSON HealthCheck where toJSON h@HealthCheck {..} = 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, Serialize, NFData) instance ToJSON Event where toJSON (EventTx h) = object ["type" .= String "tx", "id" .= h] toJSON (EventBlock h) = object ["type" .= String "block", "id" .= h] toEncoding (EventTx h) = pairs ("type" `pair` text "tx" <> "id" `pair` text (txHashToHex h)) toEncoding (EventBlock h) = pairs ("type" `pair` text "block" <> "id" `pair` text (blockHashToHex h)) instance FromJSON Event where parseJSON = A.withObject "event" $ \o -> do t <- o .: "type" case t of "tx" -> do i <- o .: "id" return $ EventTx i "block" -> do i <- o .: "id" return $ EventBlock i _ -> fail $ "Could not recognize event type: " <> t newtype GenericResult a = GenericResult { getResult :: a } deriving (Show, Eq, Generic, Serialize, NFData) instance ToJSON a => ToJSON (GenericResult a) where toJSON (GenericResult b) = object ["result" .= b] toEncoding (GenericResult b) = pairs ("result" .= b) instance FromJSON a => FromJSON (GenericResult a) where parseJSON = A.withObject "GenericResult" $ \o -> GenericResult <$> o .: "result" newtype RawResult a = RawResult { getRawResult :: a } deriving (Show, Eq, Generic, Serialize, NFData) instance S.Serialize a => ToJSON (RawResult a) where toJSON (RawResult b) = object [ "result" .= A.String (encodeHex $ S.encode b)] toEncoding (RawResult b) = pairs $ "result" `pair` unsafeToEncoding str where str = char7 '"' <> lazyByteStringHex (S.runPutLazy $ put b) <> char7 '"' instance S.Serialize a => FromJSON (RawResult a) where parseJSON = A.withObject "RawResult" $ \o -> do res <- o .: "result" let valM = eitherToMaybe . S.decode =<< decodeHex res maybe mzero (return . RawResult) valM newtype RawResultList a = RawResultList { getRawResultList :: [a] } deriving (Show, Eq, Generic, Serialize, NFData) instance Semigroup (RawResultList a) where (RawResultList a) <> (RawResultList b) = RawResultList $ a <> b instance Monoid (RawResultList a) where mempty = RawResultList mempty instance S.Serialize a => ToJSON (RawResultList a) where toJSON (RawResultList xs) = toJSON $ encodeHex . S.encode <$> xs toEncoding (RawResultList xs) = list (unsafeToEncoding . str) xs where str x = char7 '"' <> lazyByteStringHex (S.runPutLazy (put x)) <> char7 '"' instance S.Serialize 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 . S.decode <=< decodeHex newtype TxId = TxId TxHash deriving (Show, Eq, Generic, Serialize, NFData) instance ToJSON TxId where toJSON (TxId h) = object ["txid" .= h] toEncoding (TxId h) = pairs ("txid" `pair` text (txHashToHex h)) instance FromJSON TxId where parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid" data Except = ThingNotFound | ServerError | BadRequest | UserError !String | StringError !String | BlockTooLarge | TxIndexConflict ![TxHash] deriving (Show, Eq, Ord, Serialize, Generic, NFData) instance Exception Except instance ScottyError Except where stringError = StringError showError = TL.pack . show instance ToJSON Except where toJSON e = 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) ] BlockTooLarge -> [ "error" .= String "block-too-large" , "message" .= String "Block is too large to get all txs" ] TxIndexConflict txids -> [ "error" .= String "multiple-tx-index" , "message" .= String "Many txs match that tx_index" , "txids" .= txids ] 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 "block-too-large" -> return BlockTooLarge String "multiple-tx-index" -> do txids <- o .: "txids" return $ TxIndexConflict txids _ -> mzero toIntTxId :: TxHash -> Word64 toIntTxId h = let bs = S.encode h Right w64 = S.runGet getWord64be bs in w64 `shift` (-11) --------------------------------------- -- Blockchain.info API Compatibility -- --------------------------------------- data BinfoTxId = BinfoTxIdHash !TxHash | BinfoTxIdIndex !Word64 deriving (Eq, Show, Read, Generic, Serialize, 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, Serialize, 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 {..} = 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 = 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 {..} = pairs ( "addresses" `pair` as <> "wallet" .= getBinfoMultiAddrWallet <> "txs" `pair` ts <> "info" .= getBinfoMultiAddrInfo <> "recommend_include_fee" .= getBinfoMultiAddrRecommendFee <> if getBinfoMultiAddrCashAddr then "cash_addr" .= True else mempty ) where as = list (binfoBalanceToEncoding net) getBinfoMultiAddrAddresses ts = list (binfoTxToEncoding net) getBinfoMultiAddrTxs net = if not getBinfoMultiAddrCashAddr && net' == bch then btc else net' 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, Serialize, NFData) binfoBalanceToJSON :: Network -> BinfoBalance -> Value binfoBalanceToJSON net BinfoAddrBalance {..} = object [ "address" .= addrToJSON net getBinfoAddress , "final_balance" .= getBinfoAddrBalance , "n_tx" .= getBinfoAddrTxCount , "total_received" .= getBinfoAddrReceived , "total_sent" .= getBinfoAddrSent ] binfoBalanceToJSON net BinfoXPubBalance {..} = 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 = 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 {..} = pairs ( "address" `pair` addrToEncoding net getBinfoAddress <> "final_balance" .= getBinfoAddrBalance <> "n_tx" .= getBinfoAddrTxCount <> "total_received" .= getBinfoAddrReceived <> "total_sent" .= getBinfoAddrSent ) binfoBalanceToEncoding net BinfoXPubBalance {..} = pairs ( "address" `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, Serialize, NFData) instance ToJSON BinfoWallet where toJSON BinfoWallet {..} = object [ "final_balance" .= getBinfoWalletBalance , "n_tx" .= getBinfoWalletTxCount , "n_tx_filtered" .= getBinfoWalletFilteredCount , "total_received" .= getBinfoWalletTotalReceived , "total_sent" .= getBinfoWalletTotalSent ] toEncoding BinfoWallet {..} = pairs ( "final_balance" .= getBinfoWalletBalance <> "n_tx" .= getBinfoWalletTxCount <> "n_tx_filtered" .= getBinfoWalletFilteredCount <> "total_received" .= getBinfoWalletTotalReceived <> "total_sent" .= getBinfoWalletTotalSent ) instance FromJSON BinfoWallet where parseJSON = 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 = B.dropWhile (== 0x00) (S.encode w64) in encodeHex $ if B.null bs || B.head bs `testBit` 7 then B.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, Serialize, NFData) binfoUnspentToJSON :: Network -> BinfoUnspent -> Value binfoUnspentToJSON net BinfoUnspent{..} = object $ [ "tx_hash_big_endian" .= getBinfoUnspentHash , "tx_hash" .= encodeHex (S.encode (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{..} = pairs $ "tx_hash_big_endian" .= getBinfoUnspentHash <> "tx_hash" .= encodeHex (S.encode (getTxHash getBinfoUnspentHash)) <> "tx_output_n" .= getBinfoUnspentOutputIndex <> "script" .= encodeHex getBinfoUnspentScript <> "value" .= getBinfoUnspentValue <> "value_hex" .= binfoHexValue getBinfoUnspentValue <> "confirmations" .= getBinfoUnspentConfirmations <> "tx_index" .= getBinfoUnspentTxIndex <> maybe mempty (("xpub" `pair`) . binfoXPubPathToEncoding net) getBinfoUnspentXPub binfoUnspentParseJSON :: Network -> Value -> Parser BinfoUnspent binfoUnspentParseJSON net = 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, Serialize, NFData) binfoUnspentsToJSON :: Network -> BinfoUnspents -> Value binfoUnspentsToJSON net (BinfoUnspents us) = object [ "notice" .= T.empty , "unspent_outputs" .= map (binfoUnspentToJSON net) us ] binfoUnspentsToEncoding :: Network -> BinfoUnspents -> Encoding binfoUnspentsToEncoding net (BinfoUnspents us) = pairs $ "notice" .= T.empty <> "unspent_outputs" `pair` list (binfoUnspentToEncoding net) us binfoUnspentsParseJSON :: Network -> Value -> Parser BinfoUnspents binfoUnspentsParseJSON net = withObject "unspents" $ \o -> do us <- mapM (binfoUnspentParseJSON net) =<< o .: "unspent_outputs" return (BinfoUnspents us) 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, Serialize, NFData) binfoTxToJSON :: Network -> BinfoTx -> Value binfoTxToJSON net BinfoTx {..} = object $ [ "hash" .= getBinfoTxHash , "ver" .= getBinfoTxVer , "vin_sz" .= getBinfoTxVinSz , "vout_sz" .= getBinfoTxVoutSz , "size" .= getBinfoTxSize , "weight" .= getBinfoTxWeight , "fee" .= getBinfoTxFee , "relayed_by" .= 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 = if getBinfoTxRBF then ["rbf" .= True] else [] binfoTxToEncoding :: Network -> BinfoTx -> Encoding binfoTxToEncoding net BinfoTx {..} = pairs $ "hash" .= getBinfoTxHash <> "ver" .= getBinfoTxVer <> "vin_sz" .= getBinfoTxVinSz <> "vout_sz" .= getBinfoTxVoutSz <> "size" .= getBinfoTxSize <> "weight" .= getBinfoTxWeight <> "fee" .= getBinfoTxFee <> "relayed_by" .= decodeUtf8 getBinfoTxRelayedBy <> "lock_time" .= getBinfoTxLockTime <> "tx_index" .= getBinfoTxIndex <> "double_spend" .= getBinfoTxDoubleSpend <> "time" .= getBinfoTxTime <> "block_index" .= getBinfoTxBlockIndex <> "block_height" .= getBinfoTxBlockHeight <> "inputs" `pair` list (binfoTxInputToEncoding net) getBinfoTxInputs <> "out" `pair` 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 = 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 <- 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 :: !(Maybe BinfoTxOutput) } deriving (Eq, Show, Generic, Serialize, NFData) binfoTxInputToJSON :: Network -> BinfoTxInput -> Value binfoTxInputToJSON net BinfoTxInput {..} = object [ "sequence" .= getBinfoTxInputSeq , "witness" .= encodeHex getBinfoTxInputWitness , "script" .= encodeHex getBinfoTxInputScript , "index" .= getBinfoTxInputIndex , "prev_out" .= (binfoTxOutputToJSON net <$> getBinfoTxInputPrevOut) ] binfoTxInputToEncoding :: Network -> BinfoTxInput -> Encoding binfoTxInputToEncoding net BinfoTxInput {..} = pairs ( "sequence" .= getBinfoTxInputSeq <> "witness" .= encodeHex getBinfoTxInputWitness <> "script" .= encodeHex getBinfoTxInputScript <> "index" .= getBinfoTxInputIndex <> "prev_out" .= (binfoTxOutputToJSON net <$> getBinfoTxInputPrevOut) ) binfoTxInputParseJSON :: Network -> Value -> Parser BinfoTxInput binfoTxInputParseJSON net = 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" >>= mapM (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, Serialize, NFData) binfoTxOutputToJSON :: Network -> BinfoTxOutput -> Value binfoTxOutputToJSON net BinfoTxOutput {..} = 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 {..} = 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 = 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, Serialize, NFData) instance ToJSON BinfoSpender where toJSON BinfoSpender {..} = object [ "tx_index" .= getBinfoSpenderTxIndex , "n" .= getBinfoSpenderIndex ] toEncoding BinfoSpender {..} = pairs ( "tx_index" .= getBinfoSpenderTxIndex <> "n" .= getBinfoSpenderIndex ) instance FromJSON BinfoSpender where parseJSON = withObject "spender" $ \o -> do getBinfoSpenderTxIndex <- o .: "tx_index" getBinfoSpenderIndex <- o .: "n" return BinfoSpender {..} data BinfoXPubPath = BinfoXPubPath { getBinfoXPubPathKey :: !XPubKey , getBinfoXPubPathDeriv :: !SoftPath } deriving (Eq, Show, Generic, Serialize, NFData) binfoXPubPathToJSON :: Network -> BinfoXPubPath -> Value binfoXPubPathToJSON net BinfoXPubPath {..} = object [ "m" .= xPubToJSON net getBinfoXPubPathKey , "path" .= ("M" ++ pathToStr getBinfoXPubPathDeriv) ] binfoXPubPathToEncoding :: Network -> BinfoXPubPath -> Encoding binfoXPubPathToEncoding net BinfoXPubPath {..} = pairs $ "m" `pair` xPubToEncoding net getBinfoXPubPathKey <> "path" .= ("M" ++ pathToStr getBinfoXPubPathDeriv) binfoXPubPathParseJSON :: Network -> Value -> Parser BinfoXPubPath binfoXPubPathParseJSON net = 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 {..} = object [ "nconnected" .= getBinfoConnected , "conversion" .= getBinfoConversion , "symbol_local" .= getBinfoLocal , "symbol_btc" .= getBinfoBTC , "latest_block" .= getBinfoLatestBlock ] toEncoding BinfoInfo {..} = pairs ( "nconnected" .= getBinfoConnected <> "conversion" .= getBinfoConversion <> "symbol_local" .= getBinfoLocal <> "symbol_btc" .= getBinfoBTC <> "latest_block" .= getBinfoLatestBlock ) instance FromJSON BinfoInfo where parseJSON = 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, Serialize, NFData) instance ToJSON BinfoBlockInfo where toJSON BinfoBlockInfo {..} = object [ "hash" .= getBinfoBlockInfoHash , "height" .= getBinfoBlockInfoHeight , "time" .= getBinfoBlockInfoTime , "block_index" .= getBinfoBlockInfoIndex ] toEncoding BinfoBlockInfo {..} = pairs ( "hash" .= getBinfoBlockInfoHash <> "height" .= getBinfoBlockInfoHeight <> "time" .= getBinfoBlockInfoTime <> "block_index" .= getBinfoBlockInfoIndex ) instance FromJSON BinfoBlockInfo where parseJSON = withObject "block_info" $ \o -> do getBinfoBlockInfoHash <- o .: "hash" getBinfoBlockInfoHeight <- o .: "height" getBinfoBlockInfoTime <- o .: "time" getBinfoBlockInfoIndex <- o .: "block_index" return BinfoBlockInfo {..} 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{..} = object [ "symbol" .= binfoTickerSymbol , "sell" .= binfoTickerSell , "buy" .= binfoTickerBuy , "last" .= binfoTickerLast , "15m" .= binfoTicker15m ] toEncoding BinfoTicker{..} = pairs $ "symbol" .= binfoTickerSymbol <> "sell" .= binfoTickerSell <> "buy" .= binfoTickerBuy <> "last" .= binfoTickerLast <> "15m" .= binfoTicker15m instance FromJSON BinfoTicker where parseJSON = 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 {..} = object [ "code" .= getBinfoSymbolCode , "symbol" .= getBinfoSymbolString , "name" .= getBinfoSymbolName , "conversion" .= getBinfoSymbolConversion , "symbolAppearsAfter" .= getBinfoSymbolAfter , "local" .= getBinfoSymbolLocal ] toEncoding BinfoSymbol {..} = pairs ( "code" .= getBinfoSymbolCode <> "symbol" .= getBinfoSymbolString <> "name" .= getBinfoSymbolName <> "conversion" .= getBinfoSymbolConversion <> "symbolAppearsAfter" .= getBinfoSymbolAfter <> "local" .= getBinfoSymbolLocal ) instance FromJSON BinfoSymbol where parseJSON = 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 outputAddress 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 = case HashMap.lookup k xpub_txs of Nothing -> 0 Just i -> fromIntegral i 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 [] -> B.empty ws -> S.runPut (put_witness ws) prev = inputToBinfoTxOutput numtxid abook t put_witness ws = do putVarInt (length ws) mapM_ put_item ws put_item bs = do putVarInt (B.length bs) S.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 outputAddress 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 = outputAddress getBinfoTxOutputXPub = outputAddress >>= join . (`HashMap.lookup` abook) in if prune && isNothing (outputAddress >>= (`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 -> Maybe BinfoTxOutput inputToBinfoTxOutput _ _ _ _ StoreCoinbase{} = Nothing inputToBinfoTxOutput numtxid abook t n StoreInput{..} = Just BinfoTxOutput { getBinfoTxOutputIndex = out_index , getBinfoTxOutputType = 0 , getBinfoTxOutputSpent = True , getBinfoTxOutputValue = inputAmount , getBinfoTxOutputTxIndex = encodeBinfoTxId numtxid out_hash , getBinfoTxOutputScript = inputPkScript , getBinfoTxOutputSpenders = [spender] , getBinfoTxOutputAddress = inputAddress , getBinfoTxOutputXPub = xpub } where OutPoint out_hash out_index = inputPoint spender = BinfoSpender (encodeBinfoTxId numtxid (txHash (transactionData t))) n xpub = inputAddress >>= join . (`HashMap.lookup` abook) data BinfoAddr = BinfoAddr !Address | BinfoXpub !XPubKey deriving (Eq, Show, Generic, Serialize, Hashable, NFData) parseBinfoAddr :: Network -> Text -> Maybe [BinfoAddr] parseBinfoAddr _ "" = Just [] parseBinfoAddr net s = mapM f $ T.splitOn "|" s where f x = BinfoAddr <$> textToAddr net x <|> BinfoXpub <$> xPubImport net x