{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoFieldSelectors #-}
module Haskoin.Store.Data
( -- * Address Balances
Balance (..),
zeroBalance,
nullBalance,
-- * Block Data
BlockData (..),
confirmed,
-- * Transactions
TxRef (..),
TxData (..),
txDataFee,
isCoinbaseTx,
Transaction (..),
transactionData,
fromTransaction,
toTransaction,
StoreInput (..),
isCoinbase,
StoreOutput (..),
Prev (..),
Spender (..),
BlockRef (..),
UnixTime,
getUnixTime,
putUnixTime,
BlockPos,
-- * Unspent Outputs
Unspent (..),
-- * Extended Public Keys
XPubSpec (..),
XPubBal (..),
XPubUnspent (..),
XPubSummary (..),
DeriveType (..),
textToDeriveType,
deriveTypeToText,
-- * Other Data
TxId (..),
GenericResult (..),
SerialList (..),
RawResult (..),
RawResultList (..),
PeerInfo (..),
Healthy (..),
BlockHealth (..),
TimeHealth (..),
CountHealth (..),
MaxHealth (..),
HealthCheck (..),
Event (..),
Except (..),
-- * Blockchain.info API
BinfoInfo (..),
BinfoBlockId (..),
BinfoTxId (..),
encodeBinfoTxId,
BinfoFilter (..),
BinfoMultiAddr (..),
BinfoShortBal (..),
BinfoBalance (..),
toBinfoAddrs,
BinfoRawAddr (..),
BinfoAddr (..),
parseBinfoAddr,
BinfoWallet (..),
BinfoUnspent (..),
binfoHexValue,
BinfoUnspents (..),
BinfoBlock (..),
toBinfoBlock,
BinfoTx (..),
relevantTxs,
toBinfoTx,
toBinfoTxSimple,
BinfoTxInput (..),
BinfoTxOutput (..),
BinfoSpender (..),
BinfoXPubPath (..),
BinfoBlockInfo (..),
toBinfoBlockInfo,
BinfoSymbol (..),
BinfoTicker (..),
BinfoRate (..),
BinfoHistory (..),
toBinfoHistory,
BinfoDate (..),
BinfoHeader (..),
BinfoMempool (..),
BinfoBlockInfos (..),
)
where
import Control.Applicative (optional, (<|>))
import Control.DeepSeq (NFData)
import Control.Exception (Exception)
import Control.Monad (guard, join, mzero, unless, (<=<))
import Data.Aeson
( Encoding,
FromJSON (..),
ToJSON (..),
Value (..),
(.!=),
(.:),
(.:?),
(.=),
)
import Data.Aeson qualified as A
import Data.Aeson.Encoding qualified as A
import Data.Aeson.Types (Parser)
import Data.Binary (Binary (get, put))
import Data.Bits (Bits (..))
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Builder qualified as Builder
import Data.Bytes.Get
import Data.Bytes.Get qualified 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 Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Hashable (Hashable (..))
import Data.Int (Int32, Int64)
import Data.IntMap qualified 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 Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as LazyText
import Data.Text.Lazy.Encoding qualified as LazyText
import Data.Time (UTCTime (UTCTime), rfc822DateFormat)
import Data.Time.Clock.POSIX
( posixSecondsToUTCTime,
utcTimeToPOSIXSeconds,
)
import Data.Time.Format
( defaultTimeLocale,
formatTime,
parseTimeM,
)
import Data.Time.Format.ISO8601
( iso8601ParseM,
iso8601Show,
)
import Data.Vector qualified as V
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Haskoin
import Web.Scotty.Trans (Parsable (..))
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 (LazyText.toStrict txt) of
Nothing -> Left "invalid derivation type"
Just x -> Right x
data XPubSpec = XPubSpec
{ key :: !XPubKey,
deriv :: !DeriveType
}
deriving (Show, Eq, Generic, NFData)
instance Hashable XPubSpec where
hashWithSalt i = hashWithSalt i . (.key.key)
instance Serial XPubSpec where
serialize XPubSpec {key = k, deriv = t} = do
putWord8 k.depth
serialize k.parent
putWord32be k.index
serialize k.chain
putByteString k.key.get
serialize t
deserialize = do
depth <- getWord8
parent <- deserialize
index <- getWord32be
chain <- deserialize
key <- PubKey <$> getByteString 64
deriv <- deserialize
return XPubSpec {key = XPubKey {..}, deriv}
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
height :: !BlockHeight,
-- | position of transaction within the block
position :: !Word32
}
| MemRef
{ timestamp :: !UnixTime
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
-- | Serial entities will sort in reverse order.
instance Serial BlockRef where
serialize MemRef {timestamp = t} = do
putWord8 0x00
putUnixTime t
serialize BlockRef {height = h, position = 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 {height = h, position = 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 {height = h, position = p} =
A.object
[ "height" .= h,
"position" .= p
]
toJSON MemRef {timestamp = t} =
A.object ["mempool" .= t]
toEncoding BlockRef {height = h, position = p} =
A.pairs $
mconcat
[ "height" `A.pair` A.word32 h,
"position" `A.pair` A.word32 p
]
toEncoding MemRef {timestamp = t} =
A.pairs $ "mempool" `A.pair` A.word64 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 {..}
m o =
MemRef <$> o .: "mempool"
-- | Transaction in relation to an address.
data TxRef = TxRef
{ -- | block information
block :: !BlockRef,
-- | transaction hash
txid :: !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 x =
A.object
[ "txid" .= x.txid,
"block" .= x.block
]
toEncoding btx =
A.pairs $
mconcat
[ "txid" `A.pair` toEncoding btx.txid,
"block" `A.pair` toEncoding btx.block
]
instance FromJSON TxRef where
parseJSON =
A.withObject "TxRef" $ \o -> do
txid <- o .: "txid"
block <- o .: "block"
return TxRef {..}
-- | Address balance information.
data Balance = Balance
{ -- | address balance
address :: !Address,
-- | confirmed balance
confirmed :: !Word64,
-- | unconfirmed balance
unconfirmed :: !Word64,
-- | number of unspent outputs
utxo :: !Word64,
-- | number of transactions
txs :: !Word64,
-- | total amount from all outputs in this address
received :: !Word64
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
instance Serial Balance where
serialize b = do
serialize b.address
putWord64be b.confirmed
putWord64be b.unconfirmed
putWord64be b.utxo
putWord64be b.txs
putWord64be b.received
deserialize = do
address <- deserialize
confirmed <- getWord64be
unconfirmed <- getWord64be
utxo <- getWord64be
txs <- getWord64be
received <- 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
{ address = a,
confirmed = 0,
unconfirmed = 0,
utxo = 0,
txs = 0,
received = 0
}
nullBalance :: Balance -> Bool
nullBalance
Balance
{ confirmed = 0,
unconfirmed = 0,
utxo = 0,
txs = 0,
received = 0
} = True
nullBalance _ = False
instance MarshalJSON Network Balance where
marshalValue net b =
A.object
[ "address" .= marshalValue net b.address,
"confirmed" .= b.confirmed,
"unconfirmed" .= b.unconfirmed,
"utxo" .= b.utxo,
"txs" .= b.txs,
"received" .= b.received
]
marshalEncoding net b =
A.pairs $
mconcat
[ "address" `A.pair` marshalEncoding net b.address,
"confirmed" `A.pair` A.word64 b.confirmed,
"unconfirmed" `A.pair` A.word64 b.unconfirmed,
"utxo" `A.pair` A.word64 b.utxo,
"txs" `A.pair` A.word64 b.txs,
"received" `A.pair` A.word64 b.received
]
unmarshalValue net =
A.withObject "Balance" $ \o -> do
confirmed <- o .: "confirmed"
unconfirmed <- o .: "unconfirmed"
utxo <- o .: "utxo"
txs <- o .: "txs"
received <- o .: "received"
address <- unmarshalValue net =<< o .: "address"
return Balance {..}
-- | Unspent output.
data Unspent = Unspent
{ block :: !BlockRef,
outpoint :: !OutPoint,
value :: !Word64,
script :: !ByteString,
address :: !(Maybe Address)
}
deriving (Show, Eq, Ord, Generic, Hashable, NFData)
instance Serial Unspent where
serialize u = do
serialize u.block
serialize u.outpoint
putWord64be u.value
putLengthBytes u.script
putMaybe serialize u.address
deserialize = do
block <- deserialize
outpoint <- deserialize
value <- getWord64be
script <- getLengthBytes
address <- 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 = (.value)
instance MarshalJSON Network Unspent where
marshalValue net u =
A.object
[ "address" .= fmap (marshalValue net) u.address,
"block" .= u.block,
"txid" .= u.outpoint.hash,
"index" .= u.outpoint.index,
"pkscript" .= encodeHex u.script,
"value" .= u.value
]
marshalEncoding net u =
A.pairs $
mconcat
[ "address" `A.pair` maybe A.null_ (marshalEncoding net) u.address,
"block" `A.pair` toEncoding u.block,
"txid" `A.pair` toEncoding u.outpoint.hash,
"index" `A.pair` A.word32 u.outpoint.index,
"pkscript" `A.pair` hexEncoding (B.fromStrict u.script),
"value" `A.pair` A.word64 u.value
]
unmarshalValue net =
A.withObject "Unspent" $ \o -> do
block <- o .: "block"
hash <- o .: "txid"
index <- o .: "index"
value <- o .: "value"
script <- o .: "pkscript" >>= jsonHex
address <-
o .: "address"
>>= maybe (return Nothing) (optional . unmarshalValue net)
return Unspent {outpoint = OutPoint {..}, ..}
-- | Database value for a block entry.
data BlockData = BlockData
{ -- | height of the block in the chain
height :: !BlockHeight,
-- | is this block in the main chain?
main :: !Bool,
-- | accumulated work in that block
work :: !Integer,
-- | block header
header :: !BlockHeader,
-- | size of the block including witnesses
size :: !Word32,
-- | weight of this block (for segwit networks)
weight :: !Word32,
-- | block transactions
txs :: ![TxHash],
-- | sum of all transaction outputs
outputs :: !Word64,
-- | sum of all transaction fee
fee :: !Word64,
-- | block subsidy
subsidy :: !Word64
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
instance Serial BlockData where
serialize b = do
putWord32be b.height
serialize b.main
putInteger b.work
serialize b.header
putWord32be b.size
putWord32be b.weight
putList serialize b.txs
putWord64be b.outputs
putWord64be b.fee
putWord64be b.subsidy
deserialize = do
height <- getWord32be
main <- deserialize
work <- getInteger
header <- deserialize
size <- getWord32be
weight <- getWord32be
txs <- getList deserialize
outputs <- getWord64be
fee <- getWord64be
subsidy <- getWord64be
return BlockData {..}
instance Serialize BlockData where
put = serialize
get = deserialize
instance Binary BlockData where
put = serialize
get = deserialize
instance FromJSON BlockData where
parseJSON =
A.withObject "BlockData" $ \o -> do
height <- o .: "height"
main <- o .: "mainchain"
prev <- o .: "previous"
timestamp <- o .: "time"
version <- o .: "version"
bits <- o .: "bits"
nonce <- o .: "nonce"
size <- o .: "size"
txs <- o .: "tx"
TxHash merkle <- o .: "merkle"
subsidy <- o .: "subsidy"
fee <- o .: "fees"
outputs <- o .: "outputs"
work <- o .: "work"
weight <- o .:? "weight" .!= 0
return BlockData {header = BlockHeader {..}, ..}
instance MarshalJSON Network BlockData where
marshalValue net b =
A.object $
[ "hash" .= headerHash b.header,
"height" .= b.height,
"mainchain" .= b.main,
"previous" .= b.header.prev,
"time" .= b.header.timestamp,
"version" .= b.header.version,
"bits" .= b.header.bits,
"nonce" .= b.header.nonce,
"size" .= b.size,
"tx" .= b.txs,
"merkle" .= TxHash b.header.merkle,
"subsidy" .= b.subsidy,
"fees" .= b.fee,
"outputs" .= b.outputs,
"work" .= b.work
]
<> ["weight" .= b.weight | net.segWit]
marshalEncoding net b =
A.pairs $
mconcat
[ "hash" `A.pair` toEncoding (headerHash b.header),
"height" `A.pair` A.word32 b.height,
"mainchain" `A.pair` A.bool b.main,
"previous" `A.pair` toEncoding b.header.prev,
"time" `A.pair` A.word32 b.header.timestamp,
"version" `A.pair` A.word32 b.header.version,
"bits" `A.pair` A.word32 b.header.bits,
"nonce" `A.pair` A.word32 b.header.nonce,
"size" `A.pair` A.word32 b.size,
"tx" `A.pair` A.list toEncoding b.txs,
"merkle" `A.pair` toEncoding (TxHash b.header.merkle),
"subsidy" `A.pair` A.word64 b.subsidy,
"fees" `A.pair` A.word64 b.fee,
"outputs" `A.pair` A.word64 b.outputs,
"work" `A.pair` A.integer b.work,
bool mempty ("weight" `A.pair` A.word32 b.weight) net.segWit
]
unmarshalValue net = parseJSON
data StoreInput
= StoreCoinbase
{ outpoint :: !OutPoint,
sequence :: !Word32,
script :: !ByteString,
witness :: !WitnessStack
}
| StoreInput
{ outpoint :: !OutPoint,
sequence :: !Word32,
script :: !ByteString,
pkscript :: !ByteString,
value :: !Word64,
witness :: !WitnessStack,
address :: !(Maybe Address)
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
instance Serial StoreInput where
serialize StoreCoinbase {..} = do
putWord8 0x00
serialize outpoint
putWord32be sequence
putLengthBytes script
putList putLengthBytes witness
serialize StoreInput {..} = do
putWord8 0x01
serialize outpoint
putWord32be sequence
putLengthBytes script
putLengthBytes pkscript
putWord64be value
putList putLengthBytes witness
putMaybe serialize address
deserialize =
getWord8 >>= \case
0x00 -> do
outpoint <- deserialize
sequence <- getWord32be
script <- getLengthBytes
witness <- getList getLengthBytes
return StoreCoinbase {..}
0x01 -> do
outpoint <- deserialize
sequence <- getWord32be
script <- getLengthBytes
pkscript <- getLengthBytes
value <- getWord64be
witness <- getList getLengthBytes
address <- 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
isCoinbaseTx :: Tx -> Bool
isCoinbaseTx = all ((== nullOutPoint) . (.outpoint)) . (.inputs)
isCoinbase :: StoreInput -> Bool
isCoinbase StoreCoinbase {} = True
isCoinbase StoreInput {} = False
instance MarshalJSON Network StoreInput where
marshalValue net StoreInput {..} =
A.object
[ "coinbase" .= False,
"txid" .= outpoint.hash,
"output" .= outpoint.index,
"sigscript" .= String (encodeHex script),
"sequence" .= sequence,
"pkscript" .= String (encodeHex pkscript),
"value" .= value,
"address" .= (marshalValue net <$> address),
"witness" .= map encodeHex witness
]
marshalValue net StoreCoinbase {..} =
A.object
[ "coinbase" .= True,
"txid" .= outpoint.hash,
"output" .= outpoint.index,
"sigscript" .= String (encodeHex script),
"sequence" .= sequence,
"pkscript" .= Null,
"value" .= Null,
"address" .= Null,
"witness" .= map encodeHex witness
]
marshalEncoding net StoreInput {..} =
A.pairs $
mconcat
[ "coinbase" `A.pair` A.bool False,
"txid" `A.pair` toEncoding outpoint.hash,
"output" `A.pair` A.word32 outpoint.index,
"sigscript" `A.pair` hexEncoding (B.fromStrict script),
"sequence" `A.pair` A.word32 sequence,
"pkscript" `A.pair` hexEncoding (B.fromStrict pkscript),
"value" `A.pair` A.word64 value,
"address" `A.pair` maybe A.null_ (marshalEncoding net) address,
"witness" `A.pair` A.list (hexEncoding . B.fromStrict) witness
]
marshalEncoding net StoreCoinbase {..} =
A.pairs $
mconcat
[ "coinbase" .= True,
"txid" `A.pair` toEncoding outpoint.hash,
"output" `A.pair` A.word32 outpoint.index,
"sigscript" `A.pair` hexEncoding (B.fromStrict script),
"sequence" `A.pair` A.word32 sequence,
"pkscript" `A.pair` A.null_,
"value" `A.pair` A.null_,
"address" `A.pair` A.null_,
"witness" `A.pair` A.list (hexEncoding . B.fromStrict) witness
]
unmarshalValue net =
A.withObject "StoreInput" $ \o -> do
coinbase <- o .: "coinbase"
outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"
sequence <- o .: "sequence"
witness <- mapM jsonHex =<< o .:? "witness" .!= []
script <- o .: "sigscript" >>= jsonHex
if coinbase
then return StoreCoinbase {..}
else do
pkscript <- o .: "pkscript" >>= jsonHex
value <- o .: "value"
address <-
o .: "address"
>>= maybe (return Nothing) (optional . unmarshalValue net)
return StoreInput {..}
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
txid :: !TxHash,
-- | input position in transaction
index :: !Word32
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
instance Serial Spender where
serialize s = do
serialize s.txid
putWord32be s.index
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 s =
A.object
[ "txid" .= s.txid,
"input" .= s.index
]
toEncoding s =
A.pairs $
mconcat
[ "txid" `A.pair` toEncoding s.txid,
"input" `A.pair` A.word32 s.index
]
instance FromJSON Spender where
parseJSON =
A.withObject "Spender" $ \o ->
Spender <$> o .: "txid" <*> o .: "input"
-- | Output information.
data StoreOutput = StoreOutput
{ value :: !Word64,
script :: !ByteString,
spender :: !(Maybe Spender),
address :: !(Maybe Address)
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
instance Serial StoreOutput where
serialize o = do
putWord64be o.value
putLengthBytes o.script
putMaybe serialize o.spender
putMaybe serialize o.address
deserialize = do
value <- getWord64be
script <- getLengthBytes
spender <- getMaybe deserialize
address <- getMaybe deserialize
return StoreOutput {..}
instance Serialize StoreOutput where
put = serialize
get = deserialize
instance Binary StoreOutput where
put = serialize
get = deserialize
instance MarshalJSON Network StoreOutput where
marshalValue net o =
A.object
[ "address" .= (marshalValue net <$> o.address),
"pkscript" .= encodeHex o.script,
"value" .= o.value,
"spent" .= isJust o.spender,
"spender" .= o.spender
]
marshalEncoding net o =
A.pairs $
mconcat
[ "address" `A.pair` maybe A.null_ (marshalEncoding net) o.address,
"pkscript" `A.pair` hexEncoding (B.fromStrict o.script),
"value" `A.pair` A.word64 o.value,
"spent" `A.pair` A.bool (isJust o.spender),
"spender" `A.pair` toEncoding o.spender
]
unmarshalValue net =
A.withObject "StoreOutput" $ \o -> do
value <- o .: "value"
script <- o .: "pkscript" >>= jsonHex
spender <- o .: "spender"
address <-
o .: "address"
>>= maybe (return Nothing) (optional . unmarshalValue net)
return StoreOutput {..}
data Prev = Prev
{ script :: !ByteString,
value :: !Word64
}
deriving (Show, Eq, Ord, Generic, Hashable, NFData)
instance Serial Prev where
serialize p = do
putLengthBytes p.script
putWord64be p.value
deserialize = do
script <- getLengthBytes
value <- getWord64be
return Prev {..}
instance Binary Prev where
put = serialize
get = deserialize
instance Serialize Prev where
put = serialize
get = deserialize
toInput :: Ctx -> TxIn -> Maybe Prev -> WitnessStack -> StoreInput
toInput ctx i Nothing w =
StoreCoinbase
{ outpoint = i.outpoint,
sequence = i.sequence,
script = i.script,
witness = w
}
toInput ctx i (Just p) w =
StoreInput
{ outpoint = i.outpoint,
sequence = i.sequence,
script = i.script,
pkscript = p.script,
value = p.value,
witness = w,
address = eitherToMaybe (scriptToAddressBS ctx p.script)
}
toOutput :: Ctx -> TxOut -> Maybe Spender -> StoreOutput
toOutput ctx o s =
StoreOutput
{ value = o.value,
script = o.script,
spender = s,
address = eitherToMaybe (scriptToAddressBS ctx o.script)
}
data TxData = TxData
{ block :: !BlockRef,
tx :: !Tx,
prevs :: !(IntMap Prev),
deleted :: !Bool,
rbf :: !Bool,
timestamp :: !Word64,
spenders :: !(IntMap Spender)
}
deriving (Show, Eq, Ord, Generic, NFData)
instance Serial TxData where
serialize t = do
serialize t.block
serialize t.tx
putIntMap (putWord64be . fromIntegral) serialize t.prevs
serialize t.deleted
serialize t.rbf
putWord64be t.timestamp
putIntMap (putWord64be . fromIntegral) serialize t.spenders
deserialize = do
block <- deserialize
tx <- deserialize
prevs <- getIntMap (fromIntegral <$> getWord64be) deserialize
deleted <- deserialize
rbf <- deserialize
timestamp <- getWord64be
spenders <- getIntMap (fromIntegral <$> getWord64be) deserialize
return TxData {..}
instance Serialize TxData where
put = serialize
get = deserialize
instance Binary TxData where
put = serialize
get = deserialize
txDataFee :: TxData -> Word64
txDataFee t =
if isCoinbaseTx t.tx
then 0
else inputs - outputs
where
inputs = sum $ map (.value) $ IntMap.elems t.prevs
outputs = sum $ map (.value) t.tx.outputs
toTransaction :: Ctx -> TxData -> Transaction
toTransaction ctx t =
Transaction
{ version = t.tx.version,
locktime = t.tx.locktime,
block = t.block,
deleted = t.deleted,
rbf = t.rbf,
timestamp = t.timestamp,
txid = txHash t.tx,
inputs = ins,
outputs = outs,
size =
fromIntegral $
B.length $
runPutS $
serialize t.tx,
weight =
let b = B.length $ runPutS $ serialize witless
x = B.length $ runPutS $ serialize t.tx
in fromIntegral $ b * 3 + x,
fee =
if any isCoinbase ins
then 0
else inv - outv
}
where
ins = zipWith f [0 ..] t.tx.inputs
witless =
let Tx {..} = t.tx
in Tx {witness = [], ..}
inv = sum (map (.value) ins)
outs = zipWith g [0 ..] t.tx.outputs
outv = sum $ map (.value) outs
ws = take (length t.tx.inputs) $ t.tx.witness <> repeat []
f n i = toInput ctx i (IntMap.lookup n t.prevs) (ws !! n)
g n o = toOutput ctx o $ IntMap.lookup n t.spenders
fromTransaction :: Transaction -> TxData
fromTransaction t =
TxData
{ block = t.block,
tx = tx,
deleted = t.deleted,
rbf = t.rbf,
timestamp = t.timestamp,
prevs =
IntMap.fromList $
catMaybes $
zipWith f [0 ..] t.inputs,
spenders =
IntMap.fromList $
catMaybes $
zipWith g [0 ..] t.outputs
}
where
tx = transactionData t
f _ StoreCoinbase {} = Nothing
f n StoreInput {script = s, value = v} =
Just (n, Prev {script = s, value = v})
g _ StoreOutput {spender = Nothing} = Nothing
g n StoreOutput {spender = Just s} = Just (n, s)
-- | Detailed transaction information.
data Transaction = Transaction
{ -- | block information for this transaction
block :: !BlockRef,
-- | transaction version
version :: !Word32,
-- | lock time
locktime :: !Word32,
-- | transaction inputs
inputs :: ![StoreInput],
-- | transaction outputs
outputs :: ![StoreOutput],
-- | this transaction has been deleted and is no longer valid
deleted :: !Bool,
-- | this transaction can be replaced in the mempool
rbf :: !Bool,
-- | time the transaction was first seen or time of block
timestamp :: !Word64,
-- | transaction id
txid :: !TxHash,
-- | serialized transaction size (includes witness data)
size :: !Word32,
-- | transaction weight
weight :: !Word32,
-- | fees that this transaction pays (0 for coinbase)
fee :: !Word64
}
deriving (Show, Eq, Ord, Generic, Hashable, NFData)
instance Serial Transaction where
serialize t = do
serialize t.block
putWord32be t.version
putWord32be t.locktime
putList serialize t.inputs
putList serialize t.outputs
serialize t.deleted
serialize t.rbf
putWord64be t.timestamp
serialize t.txid
putWord32be t.size
putWord32be t.weight
putWord64be t.fee
deserialize = do
block <- deserialize
version <- getWord32be
locktime <- getWord32be
inputs <- getList deserialize
outputs <- getList deserialize
deleted <- deserialize
rbf <- deserialize
timestamp <- getWord64be
txid <- deserialize
size <- getWord32be
weight <- getWord32be
fee <- 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
{ inputs = map i t.inputs,
outputs = map o t.outputs,
version = t.version,
locktime = t.locktime,
witness = w $ map (.witness) t.inputs
}
where
i StoreCoinbase {..} = TxIn {..}
i StoreInput {..} = TxIn {..}
o StoreOutput {..} = TxOut {..}
w xs
| all null xs = []
| otherwise = xs
instance MarshalJSON Network Transaction where
marshalValue net t =
A.object
[ "txid" .= t.txid,
"size" .= t.size,
"version" .= t.version,
"locktime" .= t.locktime,
"fee" .= t.fee,
"inputs" .= map (marshalValue net) t.inputs,
"outputs" .= map (marshalValue net) t.outputs,
"block" .= t.block,
"deleted" .= t.deleted,
"time" .= t.timestamp,
"rbf" .= t.rbf,
"weight" .= t.weight
]
marshalEncoding net t =
A.pairs $
mconcat
[ "txid" `A.pair` toEncoding t.txid,
"size" `A.pair` A.word32 t.size,
"version" `A.pair` A.word32 t.version,
"locktime" `A.pair` A.word32 t.locktime,
"fee" `A.pair` A.word64 t.fee,
"inputs" `A.pair` A.list (marshalEncoding net) t.inputs,
"outputs" `A.pair` A.list (marshalEncoding net) t.outputs,
"block" `A.pair` toEncoding t.block,
"deleted" `A.pair` A.bool t.deleted,
"time" `A.pair` A.word64 t.timestamp,
"rbf" `A.pair` A.bool t.rbf,
"weight" `A.pair` A.word32 t.weight
]
unmarshalValue net = A.withObject "Transaction" $ \o -> do
version <- o .: "version"
locktime <- o .: "locktime"
inputs <- o .: "inputs" >>= mapM (unmarshalValue net)
outputs <- o .: "outputs" >>= mapM (unmarshalValue net)
block <- o .: "block"
deleted <- o .: "deleted"
timestamp <- o .: "time"
rbf <- o .:? "rbf" .!= False
weight <- o .:? "weight" .!= 0
size <- o .: "size"
txid <- o .: "txid"
fee <- o .: "fee"
return Transaction {..}
-- | Information about a connected peer.
data PeerInfo = PeerInfo
{ -- | user agent string
userAgent :: !ByteString,
-- | network address
address :: !String,
-- | version number
version :: !Word32,
-- | services field
services :: !Word64,
-- | will relay transactions
relay :: !Bool
}
deriving (Show, Eq, Ord, Generic, NFData)
instance Serial PeerInfo where
serialize p = do
putLengthBytes p.userAgent
putLengthBytes $ T.encodeUtf8 $ T.pack p.address
putWord32be p.version
putWord64be p.services
serialize p.relay
deserialize = do
userAgent <- getLengthBytes
address <- T.unpack . T.decodeUtf8 <$> getLengthBytes
version <- getWord32be
services <- getWord64be
relay <- deserialize
return PeerInfo {..}
instance Serialize PeerInfo where
put = serialize
get = deserialize
instance Binary PeerInfo where
put = serialize
get = deserialize
instance ToJSON PeerInfo where
toJSON p =
A.object
[ "useragent" .= String (T.decodeUtf8 p.userAgent),
"address" .= p.address,
"version" .= p.version,
"services"
.= String (encodeHex $ runPutS $ serialize p.services),
"relay" .= p.relay
]
toEncoding p =
A.pairs $
mconcat
[ "useragent" `A.pair` A.text (T.decodeUtf8 p.userAgent),
"address" `A.pair` toEncoding p.address,
"version" `A.pair` A.word32 p.version,
"services" `A.pair` hexEncoding (runPutL $ serialize p.services),
"relay" `A.pair` A.bool p.relay
]
instance FromJSON PeerInfo where
parseJSON =
A.withObject "PeerInfo" $ \o -> do
String userAgentText <- o .: "useragent"
let userAgent = T.encodeUtf8 userAgentText
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 PeerInfo {..}
-- | Address balances for an extended public key.
data XPubBal = XPubBal
{ path :: ![KeyIndex],
balance :: !Balance
}
deriving (Show, Ord, Eq, Generic, NFData)
instance Serial XPubBal where
serialize b = do
putList putWord32be b.path
serialize b.balance
deserialize = do
path <- getList getWord32be
balance <- deserialize
return XPubBal {..}
instance Serialize XPubBal where
put = serialize
get = deserialize
instance Binary XPubBal where
put = serialize
get = deserialize
instance MarshalJSON Network XPubBal where
marshalValue net b =
A.object
[ "path" .= b.path,
"balance" .= marshalValue net b.balance
]
marshalEncoding net b =
A.pairs $
mconcat
[ "path" `A.pair` A.list A.word32 b.path,
"balance" `A.pair` marshalEncoding net b.balance
]
unmarshalValue net =
A.withObject "XPubBal" $ \o -> do
path <- o .: "path"
balance <- unmarshalValue net =<< o .: "balance"
return XPubBal {..}
-- | Unspent transaction for extended public key.
data XPubUnspent = XPubUnspent
{ unspent :: !Unspent,
path :: ![KeyIndex]
}
deriving (Show, Eq, Ord, Generic, NFData)
instance Serial XPubUnspent where
serialize u = do
putList putWord32be u.path
serialize u.unspent
deserialize = do
path <- getList getWord32be
unspent <- deserialize
return XPubUnspent {..}
instance Serialize XPubUnspent where
put = serialize
get = deserialize
instance Binary XPubUnspent where
put = serialize
get = deserialize
instance MarshalJSON Network XPubUnspent where
marshalValue net u =
A.object
[ "unspent" .= marshalValue net u.unspent,
"path" .= u.path
]
marshalEncoding net u =
A.pairs $
mconcat
[ "unspent" `A.pair` marshalEncoding net u.unspent,
"path" `A.pair` A.list A.word32 u.path
]
unmarshalValue net =
A.withObject "XPubUnspent" $ \o -> do
unspent <- o .: "unspent" >>= unmarshalValue net
path <- o .: "path"
return XPubUnspent {..}
data XPubSummary = XPubSummary
{ confirmed :: !Word64,
unconfirmed :: !Word64,
received :: !Word64,
utxo :: !Word64,
external :: !Word32,
change :: !Word32
}
deriving (Eq, Show, Generic, NFData)
instance Serial XPubSummary where
serialize s = do
putWord64be s.confirmed
putWord64be s.unconfirmed
putWord64be s.received
putWord64be s.utxo
putWord32be s.external
putWord32be s.change
deserialize = do
confirmed <- getWord64be
unconfirmed <- getWord64be
received <- getWord64be
utxo <- getWord64be
external <- getWord32be
change <- getWord32be
return XPubSummary {..}
instance Binary XPubSummary where
put = serialize
get = deserialize
instance Serialize XPubSummary where
put = serialize
get = deserialize
instance ToJSON XPubSummary where
toJSON s =
A.object
[ "balance"
.= A.object
[ "confirmed" .= s.confirmed,
"unconfirmed" .= s.unconfirmed,
"received" .= s.received,
"utxo" .= s.utxo
],
"indices"
.= A.object
[ "change" .= s.change,
"external" .= s.external
]
]
toEncoding s =
A.pairs $
mconcat
[ A.pair "balance" $
A.pairs $
mconcat
[ "confirmed" `A.pair` A.word64 s.confirmed,
"unconfirmed" `A.pair` A.word64 s.unconfirmed,
"received" `A.pair` A.word64 s.received,
"utxo" `A.pair` A.word64 s.utxo
],
A.pair "indices" $
A.pairs $
mconcat
[ "change" `A.pair` A.word32 s.change,
"external" `A.pair` A.word32 s.external
]
]
instance FromJSON XPubSummary where
parseJSON =
A.withObject "XPubSummary" $ \o -> do
b <- o .: "balance"
i <- o .: "indices"
confirmed <- b .: "confirmed"
unconfirmed <- b .: "unconfirmed"
received <- b .: "received"
utxo <- b .: "utxo"
change <- i .: "change"
external <- i .: "external"
return XPubSummary {..}
class Healthy a where
isOK :: a -> Bool
data BlockHealth = BlockHealth
{ headers :: !BlockHeight,
blocks :: !BlockHeight,
max :: !Int32
}
deriving (Show, Eq, Generic, NFData)
instance Serial BlockHealth where
serialize h = do
serialize (isOK h)
putWord32be h.headers
putWord32be h.blocks
putInt32be h.max
deserialize = do
k <- deserialize
headers <- getWord32be
blocks <- getWord32be
max <- 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 x =
h - b <= x.max
where
h = fromIntegral x.headers
b = fromIntegral x.blocks
instance ToJSON BlockHealth where
toJSON h =
A.object
[ "headers" .= h.headers,
"blocks" .= h.blocks,
"diff" .= diff,
"max" .= h.max,
"ok" .= isOK h
]
where
diff = toInteger h.headers - toInteger h.blocks
instance FromJSON BlockHealth where
parseJSON =
A.withObject "BlockHealth" $ \o -> do
headers <- o .: "headers"
blocks <- o .: "blocks"
max <- o .: "max"
return BlockHealth {..}
data TimeHealth = TimeHealth
{ age :: !Int64,
max :: !Int64
}
deriving (Show, Eq, Generic, NFData)
instance Serial TimeHealth where
serialize h = do
serialize (isOK h)
putInt64be h.age
putInt64be h.max
deserialize = do
k <- deserialize
age <- getInt64be
max <- 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 {..} =
age <= max
instance ToJSON TimeHealth where
toJSON h =
A.object
[ "age" .= h.age,
"max" .= h.max,
"ok" .= isOK h
]
instance FromJSON TimeHealth where
parseJSON =
A.withObject "TimeHealth" $ \o -> do
age <- o .: "age"
max <- o .: "max"
return TimeHealth {..}
data CountHealth = CountHealth
{ count :: !Int64,
min :: !Int64
}
deriving (Show, Eq, Generic, NFData)
instance Serial CountHealth where
serialize h = do
serialize (isOK h)
putInt64be h.count
putInt64be h.min
deserialize = do
k <- deserialize
count <- getInt64be
min <- 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 {..} = min <= count
instance ToJSON CountHealth where
toJSON h =
A.object
[ "count" .= h.count,
"min" .= h.min,
"ok" .= isOK h
]
instance FromJSON CountHealth where
parseJSON =
A.withObject "CountHealth" $ \o -> do
count <- o .: "count"
min <- o .: "min"
return CountHealth {..}
data MaxHealth = MaxHealth
{ count :: !Int64,
max :: !Int64
}
deriving (Show, Eq, Generic, NFData)
instance Serial MaxHealth where
serialize h = do
serialize $ isOK h
putInt64be h.count
putInt64be h.max
deserialize = do
k <- deserialize
count <- getInt64be
max <- 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 {..} = count <= max
instance ToJSON MaxHealth where
toJSON h =
A.object
[ "count" .= h.count,
"max" .= h.max,
"ok" .= isOK h
]
instance FromJSON MaxHealth where
parseJSON =
A.withObject "MaxHealth" $ \o -> do
count <- o .: "count"
max <- o .: "max"
return MaxHealth {..}
data HealthCheck = HealthCheck
{ blocks :: !BlockHealth,
lastBlock :: !TimeHealth,
lastTx :: !TimeHealth,
pendingTxs :: !MaxHealth,
peers :: !CountHealth,
network :: !String,
version :: !String,
time :: !Word64
}
deriving (Show, Eq, Generic, NFData)
instance Serial HealthCheck where
serialize h = do
serialize $ isOK h
serialize h.blocks
serialize h.lastBlock
serialize h.lastTx
serialize h.pendingTxs
serialize h.peers
putLengthBytes $ T.encodeUtf8 $ T.pack h.network
putLengthBytes $ T.encodeUtf8 $ T.pack h.version
putWord64be h.time
deserialize = do
k <- deserialize
blocks <- deserialize
lastBlock <- deserialize
lastTx <- deserialize
pendingTxs <- deserialize
peers <- deserialize
network <- T.unpack . T.decodeUtf8 <$> getLengthBytes
version <- T.unpack . T.decodeUtf8 <$> getLengthBytes
time <- getWord64be
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 h =
and
[ isOK h.blocks,
isOK h.lastBlock,
isOK h.lastTx,
isOK h.pendingTxs,
isOK h.peers
]
instance ToJSON HealthCheck where
toJSON h =
A.object
[ "blocks" .= h.blocks,
"last-block" .= h.lastBlock,
"last-tx" .= h.lastTx,
"pending-txs" .= h.pendingTxs,
"peers" .= h.peers,
"net" .= h.network,
"version" .= h.version,
"time" .= show (posixSecondsToUTCTime $ fromIntegral h.time),
"ok" .= isOK h
]
instance FromJSON HealthCheck where
parseJSON =
A.withObject "HealthCheck" $ \o -> do
blocks <- o .: "blocks"
lastBlock <- o .: "last-block"
lastTx <- o .: "last-tx"
pendingTxs <- o .: "pending-txs"
peers <- o .: "peers"
network <- o .: "net"
version <- o .: "version"
utcTime <- read <$> o .: "time"
let time = round $ utcTimeToPOSIXSeconds utcTime
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) =
A.pairs ("type" `A.pair` A.text "tx" <> "id" `A.pair` toEncoding h)
toEncoding (EventBlock h) =
A.pairs ("type" `A.pair` A.text "block" <> "id" `A.pair` toEncoding 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 {get :: 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) = A.pairs ("result" `A.pair` toEncoding b)
instance (FromJSON a) => FromJSON (GenericResult a) where
parseJSON =
A.withObject "GenericResult" $ \o -> GenericResult <$> o .: "result"
newtype RawResult a = RawResult {get :: 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" .= String (encodeHex $ runPutS $ serialize b)]
toEncoding (RawResult b) =
A.pairs $ "result" `A.pair` hexEncoding (runPutL $ serialize b)
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 {get :: [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) = A.list toEncoding ls
instance (FromJSON a) => FromJSON (SerialList a) where
parseJSON = fmap SerialList . parseJSON
newtype RawResultList a = RawResultList {get :: [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 $ String . encodeHex . runPutS . serialize <$> xs
toEncoding (RawResultList xs) =
A.list (hexEncoding . runPutL . serialize) xs
instance (Serial a) => FromJSON (RawResultList a) where
parseJSON =
A.withArray "RawResultList" $ \vec ->
RawResultList <$> mapM parseElem (toList vec)
where
deser = eitherToMaybe . runGetS deserialize
parseElem =
A.withText "RawResultListItem" $ \t ->
maybe mzero return (decodeHex t >>= deser)
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) = A.pairs ("txid" `A.pair` toEncoding 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 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
---------------------------------------
-- Blockchain.info API Compatibility --
---------------------------------------
toIntTxId :: TxHash -> Word64
toIntTxId h =
let bs = runPutS (serialize h)
Right w64 = runGetS getWord64be bs
in w64 `shift` (-11)
data BinfoBlockId
= BinfoBlockHash !BlockHash
| BinfoBlockIndex !Word32
deriving (Eq, Show, Read, Generic, NFData)
instance Parsable BinfoBlockId where
parseParam t =
hex <> igr
where
hex = case hexToBlockHash (LazyText.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 (LazyText.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) = A.word64 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
{ addresses :: ![BinfoBalance],
wallet :: !BinfoWallet,
txs :: ![BinfoTx],
info :: !BinfoInfo,
recommendFee :: !Bool,
cashAddr :: !Bool
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoMultiAddr where
marshalValue (net', ctx) m =
A.object $
[ "addresses" .= map (marshalValue (net, ctx)) m.addresses,
"wallet" .= m.wallet,
"txs" .= map (marshalValue (net, ctx)) m.txs,
"info" .= m.info,
"recommend_include_fee" .= m.recommendFee
]
++ ["cash_addr" .= True | m.cashAddr]
where
net = if not m.cashAddr && net' == bch then btc else net'
unmarshalValue (net, ctx) =
A.withObject "BinfoMultiAddr" $ \o -> do
addresses <- mapM (unmarshalValue (net, ctx)) =<< o .: "addresses"
wallet <- o .: "wallet"
txs <- mapM (unmarshalValue (net, ctx)) =<< o .: "txs"
info <- o .: "info"
recommendFee <- o .: "recommend_include_fee"
cashAddr <- o .:? "cash_addr" .!= False
return BinfoMultiAddr {..}
marshalEncoding (net', ctx) m =
A.pairs $
mconcat
[ "addresses" `A.pair` A.list (marshalEncoding (net, ctx)) m.addresses,
"wallet" `A.pair` toEncoding m.wallet,
"txs" `A.pair` A.list (marshalEncoding (net, ctx)) m.txs,
"info" `A.pair` toEncoding m.info,
"recommend_include_fee" `A.pair` A.bool m.recommendFee,
if m.cashAddr then "cash_addr" `A.pair` A.bool True else mempty
]
where
net = if not m.cashAddr && net' == bch then btc else net'
data BinfoRawAddr = BinfoRawAddr
{ address :: !BinfoAddr,
balance :: !Word64,
ntx :: !Word64,
utxo :: !Word64,
received :: !Word64,
sent :: !Int64,
txs :: ![BinfoTx]
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoRawAddr where
marshalValue (net, ctx) r =
A.object
[ "hash160" .= h160,
"address" .= address,
"n_tx" .= r.ntx,
"n_unredeemed" .= r.utxo,
"total_received" .= r.received,
"total_sent" .= r.sent,
"final_balance" .= r.balance,
"txs" .= map (marshalValue (net, ctx)) r.txs
]
where
address = case r.address of
BinfoAddr a -> marshalValue net a
BinfoXpub x -> marshalValue (net, ctx) x
h160 =
encodeHex . runPutS . serialize
<$> case r.address of
BinfoAddr a -> case a of
PubKeyAddress h -> Just h
ScriptAddress h -> Just h
WitnessPubKeyAddress h -> Just h
_ -> Nothing
_ -> Nothing
marshalEncoding (net, ctx) r =
A.pairs $
mconcat
[ "hash160" `A.pair` fromMaybe A.null_ h160,
"address" `A.pair` address,
"n_tx" `A.pair` A.word64 r.ntx,
"n_unredeemed" `A.pair` A.word64 r.utxo,
"total_received" `A.pair` A.word64 r.received,
"total_sent" `A.pair` A.int64 r.sent,
"final_balance" `A.pair` A.word64 r.balance,
"txs" `A.pair` A.list (marshalEncoding (net, ctx)) r.txs
]
where
address = case r.address of
BinfoAddr a -> marshalEncoding net a
BinfoXpub x -> marshalEncoding (net, ctx) x
h160 =
hexEncoding . runPutL . serialize
<$> case r.address of
BinfoAddr a -> case a of
PubKeyAddress h -> Just h
ScriptAddress h -> Just h
WitnessPubKeyAddress h -> Just h
_ -> Nothing
_ -> Nothing
unmarshalValue (net, ctx) =
A.withObject "BinfoRawAddr" $ \o -> do
addr <- o .: "address"
address <-
BinfoAddr <$> unmarshalValue net addr
<|> BinfoXpub <$> unmarshalValue (net, ctx) addr
balance <- o .: "final_balance"
utxo <- o .: "n_unredeemed"
ntx <- o .: "n_tx"
received <- o .: "total_received"
sent <- o .: "total_sent"
txs <- mapM (unmarshalValue (net, ctx)) =<< o .: "txs"
return BinfoRawAddr {..}
data BinfoShortBal = BinfoShortBal
{ final :: !Word64,
ntx :: !Word64,
received :: !Word64
}
deriving (Eq, Show, Read, Generic, NFData)
instance ToJSON BinfoShortBal where
toJSON b =
A.object
[ "final_balance" .= b.final,
"n_tx" .= b.ntx,
"total_received" .= b.received
]
toEncoding b =
A.pairs $
mconcat
[ "final_balance" `A.pair` A.word64 b.final,
"n_tx" `A.pair` A.word64 b.ntx,
"total_received" `A.pair` A.word64 b.received
]
instance FromJSON BinfoShortBal where
parseJSON =
A.withObject "BinfoShortBal" $ \o -> do
final <- o .: "final_balance"
ntx <- o .: "n_tx"
received <- o .: "total_received"
return BinfoShortBal {..}
data BinfoBalance
= BinfoAddrBalance
{ address :: !Address,
txs :: !Word64,
received :: !Word64,
sent :: !Word64,
balance :: !Word64
}
| BinfoXPubBalance
{ xpub :: !XPubKey,
txs :: !Word64,
received :: !Word64,
sent :: !Word64,
balance :: !Word64,
external :: !Word32,
change :: !Word32
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoBalance where
marshalValue (net, ctx) b@BinfoAddrBalance {} =
A.object
[ "address" .= marshalValue net b.address,
"final_balance" .= b.balance,
"n_tx" .= b.txs,
"total_received" .= b.received,
"total_sent" .= b.sent
]
marshalValue (net, ctx) b@BinfoXPubBalance {} =
A.object
[ "address" .= marshalValue (net, ctx) b.xpub,
"change_index" .= b.change,
"account_index" .= b.external,
"final_balance" .= b.balance,
"n_tx" .= b.txs,
"total_received" .= b.received,
"total_sent" .= b.sent
]
unmarshalValue (net, ctx) =
A.withObject "BinfoBalance" $ \o -> x o <|> a o
where
x o = do
xpub <- unmarshalValue (net, ctx) =<< o .: "address"
change <- o .: "change_index"
external <- o .: "account_index"
balance <- o .: "final_balance"
txs <- o .: "n_tx"
received <- o .: "total_received"
sent <- o .: "total_sent"
return BinfoXPubBalance {..}
a o = do
address <- unmarshalValue net =<< o .: "address"
balance <- o .: "final_balance"
txs <- o .: "n_tx"
received <- o .: "total_received"
sent <- o .: "total_sent"
return BinfoAddrBalance {..}
marshalEncoding (net, ctx) b@BinfoAddrBalance {} =
A.pairs $
mconcat
[ "address" `A.pair` marshalEncoding net b.address,
"final_balance" `A.pair` A.word64 b.balance,
"n_tx" `A.pair` A.word64 b.txs,
"total_received" `A.pair` A.word64 b.received,
"total_sent" `A.pair` A.word64 b.sent
]
marshalEncoding (net, ctx) b@BinfoXPubBalance {} =
A.pairs $
mconcat
[ "address" `A.pair` marshalEncoding (net, ctx) b.xpub,
"change_index" `A.pair` A.word32 b.change,
"account_index" `A.pair` A.word32 b.external,
"final_balance" `A.pair` A.word64 b.balance,
"n_tx" `A.pair` A.word64 b.txs,
"total_received" `A.pair` A.word64 b.received,
"total_sent" `A.pair` A.word64 b.sent
]
instance MarshalJSON (Network, Ctx) [BinfoBalance] where
marshalValue (net, ctx) addrs =
toJSON $ map (marshalValue (net, ctx)) addrs
marshalEncoding (net, ctx) =
A.list (marshalEncoding (net, ctx))
unmarshalValue (net, ctx) =
A.withArray "[BinfoBalance]" $
fmap V.toList . mapM (unmarshalValue (net, ctx))
data BinfoWallet = BinfoWallet
{ balance :: !Word64,
txs :: !Word64,
filtered :: !Word64,
received :: !Word64,
sent :: !Word64
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoWallet where
toJSON w =
A.object
[ "final_balance" .= w.balance,
"n_tx" .= w.txs,
"n_tx_filtered" .= w.filtered,
"total_received" .= w.received,
"total_sent" .= w.sent
]
toEncoding w =
A.pairs $
mconcat
[ "final_balance" `A.pair` A.word64 w.balance,
"n_tx" `A.pair` A.word64 w.txs,
"n_tx_filtered" `A.pair` A.word64 w.filtered,
"total_received" `A.pair` A.word64 w.received,
"total_sent" `A.pair` A.word64 w.sent
]
instance FromJSON BinfoWallet where
parseJSON =
A.withObject "BinfoWallet" $ \o -> do
balance <- o .: "final_balance"
txs <- o .: "n_tx"
filtered <- o .: "n_tx_filtered"
received <- o .: "total_received"
sent <- o .: "total_sent"
return BinfoWallet {..}
binfoHexValue :: Word64 -> Text
binfoHexValue w64 =
encodeHex $
if B.null bs || B.head bs `testBit` 7
then B.cons 0x00 bs
else bs
where
bs =
B.dropWhile (== 0x00) $
runPutS $
serialize w64
data BinfoUnspent = BinfoUnspent
{ txid :: !TxHash,
index :: !Word32,
script :: !ByteString,
value :: !Word64,
confirmations :: !Int32,
txidx :: !BinfoTxId,
xpub :: !(Maybe BinfoXPubPath)
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoUnspent where
marshalValue (net, ctx) u =
A.object $
[ "tx_hash_big_endian" .= u.txid,
"tx_hash" .= encodeHex (runPutS (serialize u.txid.get)),
"tx_output_n" .= u.index,
"script" .= encodeHex u.script,
"value" .= u.value,
"value_hex" .= binfoHexValue u.value,
"confirmations" .= u.confirmations,
"tx_index" .= u.txidx
]
<> [ "xpub" .= marshalValue (net, ctx) x
| x <- maybeToList u.xpub
]
marshalEncoding (net, ctx) u =
A.pairs $
mconcat
[ "tx_hash_big_endian" `A.pair` toEncoding u.txid,
"tx_hash" `A.pair` hexEncoding (runPutL (serialize u.txid.get)),
"tx_output_n" `A.pair` A.word32 u.index,
"script" `A.pair` hexEncoding (B.fromStrict u.script),
"value" `A.pair` A.word64 u.value,
"value_hex" `A.pair` A.text (binfoHexValue u.value),
"confirmations" `A.pair` A.int32 u.confirmations,
"tx_index" `A.pair` toEncoding u.txidx,
maybe mempty (("xpub" `A.pair`) . marshalEncoding (net, ctx)) u.xpub
]
unmarshalValue (net, ctx) =
A.withObject "BinfoUnspent" $ \o -> do
txid <- o .: "tx_hash_big_endian"
index <- o .: "tx_output_n"
script <- maybe mzero return . decodeHex =<< o .: "script"
value <- o .: "value"
confirmations <- o .: "confirmations"
txidx <- o .: "tx_index"
xpub <- mapM (unmarshalValue (net, ctx)) =<< o .:? "xpub"
return BinfoUnspent {..}
newtype BinfoUnspents = BinfoUnspents [BinfoUnspent]
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoUnspents where
marshalValue (net, ctx) (BinfoUnspents us) =
A.object
[ "notice" .= T.empty,
"unspent_outputs" .= map (marshalValue (net, ctx)) us
]
marshalEncoding (net, ctx) (BinfoUnspents us) =
A.pairs $
mconcat
[ "notice" `A.pair` A.text T.empty,
"unspent_outputs" `A.pair` A.list (marshalEncoding (net, ctx)) us
]
unmarshalValue (net, ctx) =
A.withObject "BinfoUnspents" $ \o -> do
us <- mapM (unmarshalValue (net, ctx)) =<< o .: "unspent_outputs"
return (BinfoUnspents us)
toBinfoBlock :: BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock b transactions next_blocks =
BinfoBlock
{ hash = headerHash b.header,
version = b.header.version,
prev = b.header.prev,
merkle = b.header.merkle,
timestamp = b.header.timestamp,
bits = b.header.bits,
next = next_blocks,
fee = b.fee,
nonce = b.header.nonce,
ntx = fromIntegral (length transactions),
size = b.size,
index = b.height,
main = b.main,
height = b.height,
weight = b.weight,
txs = transactions
}
data BinfoBlock = BinfoBlock
{ hash :: !BlockHash,
version :: !Word32,
prev :: !BlockHash,
merkle :: !Hash256,
timestamp :: !Word32,
bits :: !Word32,
next :: ![BlockHash],
fee :: !Word64,
nonce :: !Word32,
ntx :: !Word32,
size :: !Word32,
index :: !Word32,
main :: !Bool,
height :: !Word32,
weight :: !Word32,
txs :: ![BinfoTx]
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoBlock where
marshalValue (net, ctx) b =
A.object
[ "hash" .= b.hash,
"ver" .= b.version,
"prev_block" .= b.prev,
"mrkl_root" .= TxHash b.merkle,
"time" .= b.timestamp,
"bits" .= b.bits,
"next_block" .= b.next,
"fee" .= b.fee,
"nonce" .= b.nonce,
"n_tx" .= b.ntx,
"size" .= b.size,
"block_index" .= b.index,
"main_chain" .= b.main,
"height" .= b.height,
"weight" .= b.weight,
"tx" .= map (marshalValue (net, ctx)) b.txs
]
marshalEncoding (net, ctx) b =
A.pairs $
mconcat
[ "hash" `A.pair` toEncoding b.hash,
"ver" `A.pair` A.word32 b.version,
"prev_block" `A.pair` toEncoding b.prev,
"mrkl_root" `A.pair` toEncoding (TxHash b.merkle),
"time" `A.pair` A.word32 b.timestamp,
"bits" `A.pair` A.word32 b.bits,
"next_block" `A.pair` toEncoding b.next,
"fee" `A.pair` A.word64 b.fee,
"nonce" `A.pair` A.word32 b.nonce,
"n_tx" `A.pair` A.word32 b.ntx,
"size" `A.pair` A.word32 b.size,
"block_index" `A.pair` A.word32 b.index,
"main_chain" `A.pair` A.bool b.main,
"height" `A.pair` A.word32 b.height,
"weight" `A.pair` A.word32 b.weight,
"tx" `A.pair` A.list (marshalEncoding (net, ctx)) b.txs
]
unmarshalValue (net, ctx) =
A.withObject "BinfoBlock" $ \o -> do
hash <- o .: "hash"
version <- o .: "ver"
prev <- o .: "prev_block"
merkle <- (\(TxHash h) -> h) <$> o .: "mrkl_root"
timestamp <- o .: "time"
bits <- o .: "bits"
next <- o .: "next_block"
fee <- o .: "fee"
nonce <- o .: "nonce"
ntx <- o .: "n_tx"
size <- o .: "size"
index <- o .: "block_index"
main <- o .: "main_chain"
height <- o .: "height"
weight <- o .: "weight"
txs <- o .: "tx" >>= mapM (unmarshalValue (net, ctx))
return BinfoBlock {..}
instance MarshalJSON (Network, Ctx) [BinfoBlock] where
marshalValue (net, ctx) blocks =
A.object ["blocks" .= map (marshalValue (net, ctx)) blocks]
marshalEncoding (net, ctx) blocks =
A.pairs $ "blocks" `A.pair` A.list (marshalEncoding (net, ctx)) blocks
unmarshalValue (net, ctx) =
A.withObject "blocks" $ \o ->
mapM (unmarshalValue (net, ctx)) =<< o .: "blocks"
data BinfoTx = BinfoTx
{ txid :: !TxHash,
version :: !Word32,
inputCount :: !Word32,
outputCount :: !Word32,
size :: !Word32,
weight :: !Word32,
fee :: !Word64,
relayed :: !ByteString,
locktime :: !Word32,
index :: !BinfoTxId,
doubleSpend :: !Bool,
rbf :: !Bool,
balance :: !(Maybe (Int64, Int64)),
timestamp :: !Word64,
blockIndex :: !(Maybe Word32),
blockHeight :: !(Maybe Word32),
inputs :: ![BinfoTxInput],
outputs :: ![BinfoTxOutput]
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoTx where
marshalValue (net, ctx) t =
A.object $
[ "hash" .= t.txid,
"ver" .= t.version,
"vin_sz" .= t.inputCount,
"vout_sz" .= t.outputCount,
"size" .= t.size,
"weight" .= t.weight,
"fee" .= t.fee,
"relayed_by" .= T.decodeUtf8 t.relayed,
"lock_time" .= t.locktime,
"tx_index" .= t.index,
"double_spend" .= t.doubleSpend,
"time" .= t.timestamp,
"block_index" .= t.blockIndex,
"block_height" .= t.blockHeight,
"inputs" .= map (marshalValue (net, ctx)) t.inputs,
"out" .= map (marshalValue (net, ctx)) t.outputs
]
++ bal
++ rbf
where
bal =
case t.balance of
Nothing -> []
Just (r, b) -> ["result" .= r, "balance" .= b]
rbf = ["rbf" .= True | t.rbf]
marshalEncoding (net, ctx) t =
A.pairs $
mconcat
[ "hash" `A.pair` toEncoding t.txid,
"ver" `A.pair` A.word32 t.version,
"vin_sz" `A.pair` A.word32 t.inputCount,
"vout_sz" `A.pair` A.word32 t.outputCount,
"size" `A.pair` A.word32 t.size,
"weight" `A.pair` A.word32 t.weight,
"fee" `A.pair` A.word64 t.fee,
"relayed_by" `A.pair` A.text (T.decodeUtf8 t.relayed),
"lock_time" `A.pair` A.word32 t.locktime,
"tx_index" `A.pair` toEncoding t.index,
"double_spend" `A.pair` A.bool t.doubleSpend,
"time" `A.pair` A.word64 t.timestamp,
"block_index" `A.pair` toEncoding t.blockIndex,
"block_height" `A.pair` maybe A.null_ A.word32 t.blockHeight,
"inputs" `A.pair` A.list (marshalEncoding (net, ctx)) t.inputs,
"out" `A.pair` A.list (marshalEncoding (net, ctx)) t.outputs,
bal,
rbf
]
where
bal =
case t.balance of
Nothing -> mempty
Just (r, b) ->
"result" `A.pair` A.int64 r <> "balance" `A.pair` A.int64 b
rbf = if t.rbf then "rbf" .= True else mempty
unmarshalValue (net, ctx) = A.withObject "BinfoTx" $ \o -> do
txid <- o .: "hash"
version <- o .: "ver"
inputCount <- o .: "vin_sz"
outputCount <- o .: "vout_sz"
size <- o .: "size"
weight <- o .: "weight"
fee <- o .: "fee"
relayed <- T.encodeUtf8 <$> o .: "relayed_by"
locktime <- o .: "lock_time"
index <- o .: "tx_index"
doubleSpend <- o .: "double_spend"
timestamp <- o .: "time"
blockIndex <- o .: "block_index"
blockHeight <- o .: "block_height"
inputs <- o .: "inputs" >>= mapM (unmarshalValue (net, ctx))
outputs <- o .: "out" >>= mapM (unmarshalValue (net, ctx))
rbf <- o .:? "rbf" .!= False
res <- o .:? "result"
bal <- o .:? "balance"
let balance = (,) <$> res <*> bal
return BinfoTx {..}
instance MarshalJSON (Network, Ctx) [BinfoTx] where
marshalValue (net, ctx) txs =
toJSON $ map (marshalValue (net, ctx)) txs
marshalEncoding (net, ctx) =
A.list (marshalEncoding (net, ctx))
unmarshalValue (net, ctx) =
A.withArray "[BinfoTx]" $
fmap V.toList . mapM (unmarshalValue (net, ctx))
data BinfoTxInput = BinfoTxInput
{ sequence :: !Word32,
witness :: !ByteString,
script :: !ByteString,
index :: !Word32,
output :: !BinfoTxOutput
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoTxInput where
marshalValue (net, ctx) i =
A.object
[ "sequence" .= i.sequence,
"witness" .= encodeHex i.witness,
"script" .= encodeHex i.script,
"index" .= i.index,
"prev_out" .= marshalValue (net, ctx) i.output
]
marshalEncoding (net, ctx) i =
A.pairs $
mconcat
[ "sequence" `A.pair` A.word32 i.sequence,
"witness" `A.pair` hexEncoding (B.fromStrict i.witness),
"script" `A.pair` hexEncoding (B.fromStrict i.script),
"index" `A.pair` A.word32 i.index,
"prev_out" `A.pair` marshalEncoding (net, ctx) i.output
]
unmarshalValue (net, ctx) =
A.withObject "BinfoTxInput" $ \o -> do
sequence <- o .: "sequence"
witness <-
maybe mzero return . decodeHex
=<< o .: "witness"
script <-
maybe mzero return . decodeHex
=<< o .: "script"
index <- o .: "index"
output <-
o .: "prev_out"
>>= unmarshalValue (net, ctx)
return BinfoTxInput {..}
data BinfoTxOutput = BinfoTxOutput
{ typ :: !Int,
spent :: !Bool,
value :: !Word64,
index :: !Word32,
txidx :: !BinfoTxId,
script :: !ByteString,
spenders :: ![BinfoSpender],
address :: !(Maybe Address),
xpub :: !(Maybe BinfoXPubPath)
}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoTxOutput where
marshalValue (net, ctx) o =
A.object $
[ "type" .= o.typ,
"spent" .= o.spent,
"value" .= o.value,
"spending_outpoints" .= o.spenders,
"n" .= o.index,
"tx_index" .= o.txidx,
"script" .= encodeHex o.script
]
<> [ "addr" .= marshalValue net a
| a <- maybeToList o.address
]
<> [ "xpub" .= marshalValue (net, ctx) x
| x <- maybeToList o.xpub
]
marshalEncoding (net, ctx) o =
A.pairs $
mconcat $
[ "type" `A.pair` A.int o.typ,
"spent" `A.pair` A.bool o.spent,
"value" `A.pair` A.word64 o.value,
"spending_outpoints" `A.pair` A.list toEncoding o.spenders,
"n" `A.pair` A.word32 o.index,
"tx_index" `A.pair` toEncoding o.txidx,
"script" `A.pair` hexEncoding (B.fromStrict o.script)
]
<> [ "addr" `A.pair` marshalEncoding net a
| a <- maybeToList o.address
]
<> [ "xpub" `A.pair` marshalEncoding (net, ctx) x
| x <- maybeToList o.xpub
]
unmarshalValue (net, ctx) =
A.withObject "BinfoTxOutput" $ \o -> do
typ <- o .: "type"
spent <- o .: "spent"
value <- o .: "value"
spenders <- o .: "spending_outpoints"
index <- o .: "n"
txidx <- o .: "tx_index"
script <- maybe mzero return . decodeHex =<< o .: "script"
address <- o .:? "addr" >>= mapM (unmarshalValue net)
xpub <- o .:? "xpub" >>= mapM (unmarshalValue (net, ctx))
return BinfoTxOutput {..}
data BinfoSpender = BinfoSpender
{ txidx :: !BinfoTxId,
input :: !Word32
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoSpender where
toJSON s =
A.object
[ "tx_index" .= s.txidx,
"n" .= s.input
]
toEncoding s =
A.pairs $
mconcat
[ "tx_index" `A.pair` toEncoding s.txidx,
"n" `A.pair` A.word32 s.input
]
instance FromJSON BinfoSpender where
parseJSON =
A.withObject "BinfoSpender" $ \o -> do
txidx <- o .: "tx_index"
input <- o .: "n"
return BinfoSpender {..}
data BinfoXPubPath = BinfoXPubPath
{ key :: !XPubKey,
deriv :: !SoftPath
}
deriving (Eq, Show, Generic, NFData)
instance Ord BinfoXPubPath where
compare = compare `on` f
where
f b =
( b.key.parent,
b.deriv
)
instance MarshalJSON (Network, Ctx) BinfoXPubPath where
marshalValue (net, ctx) p =
A.object
[ "m" .= marshalValue (net, ctx) p.key,
"path" .= ("M" ++ pathToStr p.deriv)
]
marshalEncoding (net, ctx) p =
A.pairs $
mconcat
[ "m" `A.pair` marshalEncoding (net, ctx) p.key,
"path" `A.pair` A.string ("M" ++ pathToStr p.deriv)
]
unmarshalValue (net, ctx) =
A.withObject "BinfoXPubPath" $ \o -> do
key <- o .: "m" >>= unmarshalValue (net, ctx)
deriv <- fromMaybe "bad xpub path" . parseSoft <$> o .: "path"
return BinfoXPubPath {..}
data BinfoInfo = BinfoInfo
{ connected :: !Word32,
conversion :: !Double,
fiat :: !BinfoSymbol,
crypto :: !BinfoSymbol,
head :: !BinfoBlockInfo
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoInfo where
toJSON i =
A.object
[ "nconnected" .= i.connected,
"conversion" .= i.conversion,
"symbol_local" .= i.fiat,
"symbol_btc" .= i.crypto,
"latest_block" .= i.head
]
toEncoding i =
A.pairs $
mconcat
[ "nconnected" `A.pair` A.word32 i.connected,
"conversion" `A.pair` A.double i.conversion,
"symbol_local" `A.pair` toEncoding i.fiat,
"symbol_btc" `A.pair` toEncoding i.crypto,
"latest_block" `A.pair` toEncoding i.head
]
instance FromJSON BinfoInfo where
parseJSON =
A.withObject "BinfoInfo" $ \o -> do
connected <- o .: "nconnected"
conversion <- o .: "conversion"
fiat <- o .: "symbol_local"
crypto <- o .: "symbol_btc"
head <- o .: "latest_block"
return BinfoInfo {..}
data BinfoBlockInfo = BinfoBlockInfo
{ hash :: !BlockHash,
height :: !BlockHeight,
timestamp :: !Word32,
index :: !BlockHeight
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoBlockInfo where
toJSON i =
A.object
[ "hash" .= i.hash,
"height" .= i.height,
"time" .= i.timestamp,
"block_index" .= i.index
]
toEncoding i =
A.pairs $
mconcat
[ "hash" `A.pair` toEncoding i.hash,
"height" `A.pair` A.word32 i.height,
"time" `A.pair` A.word32 i.timestamp,
"block_index" `A.pair` A.word32 i.index
]
instance FromJSON BinfoBlockInfo where
parseJSON =
A.withObject "BinfoBlockInfo" $ \o -> do
hash <- o .: "hash"
height <- o .: "height"
timestamp <- o .: "time"
index <- o .: "block_index"
return BinfoBlockInfo {..}
toBinfoBlockInfo :: BlockData -> BinfoBlockInfo
toBinfoBlockInfo d =
BinfoBlockInfo
{ hash = headerHash d.header,
height = d.height,
timestamp = d.header.timestamp,
index = d.height
}
data BinfoRate = BinfoRate
{ timestamp :: !Word64,
price :: !Double,
vol24 :: !Double
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoRate where
toJSON r =
A.object
[ "timestamp" .= r.timestamp,
"price" .= r.price,
"volume24h" .= r.vol24
]
toEncoding r =
A.pairs $
mconcat
[ "timestamp" `A.pair` A.word64 r.timestamp,
"price" `A.pair` A.double r.price,
"volume24h" `A.pair` A.double r.vol24
]
instance FromJSON BinfoRate where
parseJSON =
A.withObject "BinfoRate" $ \o -> do
timestamp <- o .: "timestamp"
price <- o .: "price"
vol24 <- o .: "volume24h"
return BinfoRate {..}
data BinfoHistory = BinfoHistory
{ date :: !Text,
time :: !Text,
typ :: !Text,
amount :: !Double,
valueThen :: !Double,
valueNow :: !Double,
rateThen :: !Double,
txid :: !TxHash,
fee :: !Double
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoHistory where
toJSON h =
A.object
[ "date" .= h.date,
"time" .= h.time,
"type" .= h.typ,
"amount" .= h.amount,
"value_then" .= h.valueThen,
"value_now" .= h.valueNow,
"exchange_rate_then" .= h.rateThen,
"tx" .= h.txid,
"fee" .= h.fee
]
toEncoding h =
A.pairs $
mconcat
[ "date" `A.pair` A.text h.date,
"time" `A.pair` A.text h.time,
"type" `A.pair` A.text h.typ,
"amount" `A.pair` A.double h.amount,
"value_then" `A.pair` A.double h.valueThen,
"value_now" `A.pair` A.double h.valueNow,
"exchange_rate_then" `A.pair` A.double h.rateThen,
"tx" `A.pair` toEncoding h.txid,
"fee" `A.pair` A.double h.fee
]
instance FromJSON BinfoHistory where
parseJSON =
A.withObject "BinfoHistory" $ \o -> do
date <- o .: "date"
time <- o .: "time"
typ <- o .: "type"
amount <- o .: "amount"
valueThen <- o .: "value_then"
valueNow <- o .: "value_now"
rateThen <- o .: "exchange_rate_then"
txid <- o .: "tx"
fee <- o .: "fee"
return BinfoHistory {..}
toBinfoHistory ::
Int64 ->
Word64 ->
Double ->
Double ->
Word64 ->
TxHash ->
BinfoHistory
toBinfoHistory satoshi timestamp rateThen rateNow fee txid =
BinfoHistory
{ date = T.pack $ formatTime defaultTimeLocale "%Y-%m-%d" t,
time = T.pack $ formatTime defaultTimeLocale "%H:%M:%S GMT %Ez" t,
typ = if satoshi <= 0 then "sent" else "received",
amount = fromRational v,
fee = fromRational f,
valueThen = fromRational v1,
valueNow = fromRational v2,
rateThen,
txid
}
where
t = posixSecondsToUTCTime (realToFrac timestamp)
v = toRational satoshi / (100 * 1000 * 1000)
r1 = toRational rateThen
r2 = toRational rateNow
f = toRational fee / (100 * 1000 * 1000)
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 = LazyText.unpack t
p fmt = parseTimeM False defaultTimeLocale fmt s
data BinfoTicker = BinfoTicker
{ fifteen :: !Double,
last :: !Double,
buy :: !Double,
sell :: !Double,
symbol :: !Text
}
deriving (Eq, Show, Generic, NFData)
instance Default BinfoTicker where
def =
BinfoTicker
{ symbol = "XXX",
fifteen = 0.0,
last = 0.0,
buy = 0.0,
sell = 0.0
}
instance ToJSON BinfoTicker where
toJSON t =
A.object
[ "symbol" .= t.symbol,
"sell" .= t.sell,
"buy" .= t.buy,
"last" .= t.last,
"15m" .= t.fifteen
]
toEncoding t =
A.pairs $
mconcat
[ "symbol" `A.pair` A.text t.symbol,
"sell" `A.pair` A.double t.sell,
"buy" `A.pair` A.double t.buy,
"last" `A.pair` A.double t.last,
"15m" `A.pair` A.double t.fifteen
]
instance FromJSON BinfoTicker where
parseJSON =
A.withObject "BinfoTicker" $ \o -> do
symbol <- o .: "symbol"
fifteen <- o .: "15m"
sell <- o .: "sell"
buy <- o .: "buy"
last <- o .: "last"
return BinfoTicker {..}
data BinfoSymbol = BinfoSymbol
{ code :: !Text,
symbol :: !Text,
name :: !Text,
conversion :: !Double,
after :: !Bool,
local :: !Bool
}
deriving (Eq, Show, Generic, NFData)
instance Default BinfoSymbol where
def =
BinfoSymbol
{ code = "XXX",
symbol = "¤",
name = "No currency",
conversion = 0.0,
after = False,
local = True
}
instance ToJSON BinfoSymbol where
toJSON s =
A.object
[ "code" .= s.code,
"symbol" .= s.symbol,
"name" .= s.name,
"conversion" .= s.conversion,
"symbolAppearsAfter" .= s.after,
"local" .= s.local
]
toEncoding s =
A.pairs $
mconcat
[ "code" `A.pair` A.text s.code,
"symbol" `A.pair` A.text s.symbol,
"name" `A.pair` A.text s.name,
"conversion" `A.pair` A.double s.conversion,
"symbolAppearsAfter" `A.pair` A.bool s.after,
"local" `A.pair` A.bool s.local
]
instance FromJSON BinfoSymbol where
parseJSON =
A.withObject "BinfoSymbol" $ \o -> do
code <- o .: "code"
symbol <- o .: "symbol"
name <- o .: "name"
conversion <- o .: "conversion"
after <- o .: "symbolAppearsAfter"
local <- o .: "local"
return BinfoSymbol {..}
relevantTxs ::
HashSet Address ->
Bool ->
Transaction ->
HashSet TxHash
relevantTxs addrs prune t =
HashSet.fromList $ ins <> outs
where
p a =
prune
&& getTxResult addrs t > 0
&& not (HashSet.member a addrs)
f o = do
Spender {txid} <- o.spender
a <- o.address
guard $ p a
return txid
outs = mapMaybe f t.outputs
g StoreCoinbase {} = Nothing
g StoreInput {outpoint = OutPoint h i} = Just h
ins = mapMaybe g t.inputs
toBinfoAddrs ::
HashMap Address Balance ->
HashMap XPubSpec [XPubBal] ->
HashMap XPubSpec Word64 ->
[BinfoBalance]
toBinfoAddrs onlyAddrs onlyXpubs xpubTxs =
xpubBals <> addrBals
where
xpubBal k xs =
let f x =
case x.path of
[0, _] -> x.balance.received
_ -> 0
g x = x.balance.confirmed + x.balance.unconfirmed
i m x =
case x.path of
[m', n] | m == m' -> n + 1
_ -> 0
received = sum $ map f xs
bal = fromIntegral $ sum $ map g xs
sent = if bal <= received then received - bal else 0
count = HashMap.lookupDefault 0 k xpubTxs
ax = foldl max 0 $ map (i 0) xs
cx = foldl max 0 $ map (i 1) xs
in BinfoXPubBalance
{ xpub = k.key,
txs = count,
received = received,
sent = sent,
balance = bal,
external = ax,
change = cx
}
xpubBals = map (uncurry xpubBal) $ HashMap.toList onlyXpubs
addrBals =
let f Balance {..} =
let sent = received - balance
balance = confirmed + unconfirmed
in BinfoAddrBalance {..}
in map f $ HashMap.elems onlyAddrs
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 ..] t.inputs
where
f n i =
BinfoTxInput
{ index = n,
sequence = i.sequence,
script = i.script,
witness = wit i,
output = prev n i
}
wit i =
case i.witness of
[] -> B.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 (B.length bs)
putByteString bs
transactionHeight :: Transaction -> Maybe BlockHeight
transactionHeight Transaction {deleted = True} = Nothing
transactionHeight Transaction {block = MemRef _} = Nothing
transactionHeight Transaction {block = BlockRef h _} = Just h
toBinfoTx ::
Bool ->
HashMap Address (Maybe BinfoXPubPath) ->
Bool ->
Int64 ->
Transaction ->
BinfoTx
toBinfoTx numtxid abook prune bal t =
BinfoTx
{ version = t.version,
weight = t.weight,
relayed = "0.0.0.0",
txid = txHash tx,
index = encodeBinfoTxId numtxid (txHash tx),
inputCount = fromIntegral $ length t.inputs,
outputCount = fromIntegral $ length t.outputs,
blockIndex = transactionHeight t,
blockHeight = transactionHeight t,
doubleSpend = t.deleted,
balance =
if simple
then Nothing
else Just (getTxResult aset t, bal),
outputs =
let p = prune && getTxResult aset t > 0
f = toBinfoTxOutput numtxid abook p t
in catMaybes $ zipWith f [0 ..] t.outputs,
inputs = toBinfoTxInputs numtxid abook t,
size = t.size,
rbf = t.rbf,
fee = t.fee,
locktime = t.locktime,
timestamp = t.timestamp
}
where
tx = transactionData t
aset = HashMap.keysSet abook
simple = HashMap.null abook && bal == 0
getTxResult :: HashSet Address -> Transaction -> Int64
getTxResult aset t =
inputSum + outputSum
where
inputSum = sum $ map inputValue t.inputs
inputValue StoreCoinbase {} = 0
inputValue StoreInput {address, value} =
case address of
Nothing -> 0
Just a ->
if testAddr a
then negate $ fromIntegral value
else 0
testAddr a = HashSet.member a aset
outputSum = sum $ map outValue t.outputs
outValue StoreOutput {address, value} =
case address of
Nothing -> 0
Just a ->
if testAddr a
then fromIntegral value
else 0
toBinfoTxOutput ::
Bool ->
HashMap Address (Maybe BinfoXPubPath) ->
Bool ->
Transaction ->
Word32 ->
StoreOutput ->
Maybe BinfoTxOutput
toBinfoTxOutput numtxid abook prune t index o =
if prune && notInBook
then Nothing
else
Just
BinfoTxOutput
{ typ = 0,
spent = isJust o.spender,
value = o.value,
index = index,
txidx = encodeBinfoTxId numtxid $ txHash $ transactionData t,
script = o.script,
spenders = maybeToList $ toBinfoSpender numtxid <$> o.spender,
address = o.address,
xpub = o.address >>= join . flip HashMap.lookup abook
}
where
notInBook = isNothing $ o.address >>= flip HashMap.lookup abook
toBinfoSpender :: Bool -> Spender -> BinfoSpender
toBinfoSpender numtxid s =
BinfoSpender
{ txidx = encodeBinfoTxId numtxid s.txid,
input = s.index
}
inputToBinfoTxOutput ::
Bool ->
HashMap Address (Maybe BinfoXPubPath) ->
Transaction ->
Word32 ->
StoreInput ->
BinfoTxOutput
inputToBinfoTxOutput numtxid abook t n i =
BinfoTxOutput
{ typ = 0,
spent = True,
txidx = encodeBinfoTxId numtxid i.outpoint.hash,
value =
case i of
StoreCoinbase {} -> 0
StoreInput {value} -> value,
script =
case i of
StoreCoinbase {} -> B.empty
StoreInput {pkscript} -> pkscript,
address =
case i of
StoreCoinbase {} -> Nothing
StoreInput {address} -> address,
index = i.outpoint.index,
spenders =
[ BinfoSpender
(encodeBinfoTxId numtxid (txHash (transactionData t)))
n
],
xpub =
case i of
StoreCoinbase {} -> Nothing
StoreInput {address} -> address >>= join . flip HashMap.lookup abook
}
data BinfoAddr
= BinfoAddr !Address
| BinfoXpub !XPubKey
deriving (Eq, Show, Generic, Hashable, NFData)
parseBinfoAddr :: Network -> Ctx -> Text -> Maybe [BinfoAddr]
parseBinfoAddr net ctx "" = Just []
parseBinfoAddr net ctx s =
mapM f $
concatMap (filter (not . T.null) . T.splitOn ",") (T.splitOn "|" s)
where
f x =
BinfoAddr <$> textToAddr net x
<|> BinfoXpub <$> xPubImport net ctx x
data BinfoHeader = BinfoHeader
{ hash :: !BlockHash,
timestamp :: !Timestamp,
index :: !Word32,
height :: !BlockHeight,
txids :: ![BinfoTxId]
}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoHeader where
toJSON h =
A.object
[ "hash" .= h.hash,
"time" .= h.timestamp,
"block_index" .= h.index,
"height" .= h.height,
"txIndexes" .= h.txids
]
toEncoding h =
A.pairs $
mconcat
[ "hash" `A.pair` toEncoding h.hash,
"time" `A.pair` A.word32 h.timestamp,
"block_index" `A.pair` A.word32 h.index,
"height" `A.pair` A.word32 h.height,
"txIndexes" `A.pair` A.list toEncoding h.txids
]
instance FromJSON BinfoHeader where
parseJSON =
A.withObject "BinfoHeader" $ \o -> do
hash <- o .: "hash"
timestamp <- o .: "time"
index <- o .: "block_index"
height <- o .: "height"
txids <- o .: "txIndexes"
return BinfoHeader {..}
newtype BinfoMempool = BinfoMempool {get :: [BinfoTx]}
deriving (Eq, Show, Generic, NFData)
instance MarshalJSON (Network, Ctx) BinfoMempool where
marshalValue (net, ctx) (BinfoMempool txs) =
A.object ["txs" .= map (marshalValue (net, ctx)) txs]
marshalEncoding (net, ctx) (BinfoMempool txs) =
A.pairs $ A.pair "txs" $ A.list (marshalEncoding (net, ctx)) txs
unmarshalValue (net, ctx) =
A.withObject "BinfoMempool" $ \o ->
BinfoMempool <$> (mapM (unmarshalValue (net, ctx)) =<< o .: "txs")
newtype BinfoBlockInfos = BinfoBlockInfos {get :: [BinfoBlockInfo]}
deriving (Eq, Show, Generic, NFData)
instance ToJSON BinfoBlockInfos where
toJSON b = A.object ["blocks" .= b.get]
toEncoding b =
A.pairs $ A.pair "blocks" $ A.list toEncoding b.get
instance FromJSON BinfoBlockInfos where
parseJSON =
A.withObject "BinfoBlockInfos" $ \o ->
BinfoBlockInfos <$> o .: "blocks"