{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Store.Data
( -- * Address Balances
Balance(..)
, balanceToJSON
, balanceToEncoding
, balanceParseJSON
, zeroBalance
, nullBalance
-- * Block Data
, BlockData(..)
, blockDataToJSON
, blockDataToEncoding
, confirmed
-- * Transactions
, BlockTx(..)
, TxData(..)
, Transaction(..)
, transactionToJSON
, transactionToEncoding
, transactionData
, fromTransaction
, toTransaction
, StoreInput(..)
, storeInputToJSON
, storeInputToEncoding
, isCoinbase
, StoreOutput(..)
, storeOutputToJSON
, storeOutputToEncoding
, Prev(..)
, Spender(..)
, BlockRef(..)
, UnixTime
, getUnixTime
, putUnixTime
, BlockPos
-- * Unspent Outputs
, Unspent(..)
, unspentToJSON
, unspentToEncoding
-- * Extended Public Keys
, XPubSpec(..)
, XPubBal(..)
, xPubBalToJSON
, xPubBalToEncoding
, xPubBalParseJSON
, XPubUnspent(..)
, xPubUnspentToJSON
, xPubUnspentToEncoding
, XPubSummary(..)
, DeriveType(..)
-- * Other Data
, TxId(..)
, GenericResult(..)
, PeerInformation(..)
, HealthCheck(..)
, Event(..)
, Except(..)
) where
import Control.Applicative ((<|>))
import Control.DeepSeq (NFData)
import Control.Exception (Exception)
import Control.Monad (guard, join)
import Data.Aeson (Encoding, FromJSON (..), ToJSON (..),
Value (..), object, pairs, (.!=),
(.:), (.:?), (.=))
import qualified Data.Aeson as A
import Data.Aeson.Encoding (list, null_, pair, text)
import Data.Aeson.Types (Parser)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BSS
import Data.Hashable (Hashable (..))
import qualified Data.IntMap as I
import Data.IntMap.Strict (IntMap)
import Data.Maybe (catMaybes, isJust, mapMaybe)
import Data.Serialize (Get, Put, Serialize (..), getWord32be,
getWord64be, getWord8, putWord32be,
putWord64be, putWord8)
import qualified Data.Serialize as S
import Data.String.Conversions (cs)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Haskoin (Address, BlockHash, BlockHeader (..),
BlockHeight, BlockWork, KeyIndex,
Network (..), OutPoint (..),
PubKeyI (..), Tx (..), TxHash (..),
TxIn (..), TxOut (..), WitnessStack,
XPubKey (..), addrFromJSON,
addrToEncoding, addrToJSON,
blockHashToHex, decodeHex, encodeHex,
headerHash, scriptToAddressBS, txHash,
txHashToHex, wrapPubKey)
import Web.Scotty.Trans (ScottyError (..))
data DeriveType
= DeriveNormal
| DeriveP2SH
| DeriveP2WPKH
deriving (Show, Eq, Generic, NFData, Serialize)
data XPubSpec =
XPubSpec
{ xPubSpecKey :: !XPubKey
, xPubDeriveType :: !DeriveType
} deriving (Show, Eq, Generic, NFData)
instance Hashable XPubSpec where
hashWithSalt i XPubSpec {xPubSpecKey = XPubKey {xPubKey = pubkey}} =
hashWithSalt i pubkey
instance Serialize XPubSpec where
put XPubSpec {xPubSpecKey = k, xPubDeriveType = t} = do
put (xPubDepth k)
put (xPubParent k)
put (xPubIndex k)
put (xPubChain k)
put (wrapPubKey True (xPubKey k))
put t
get = do
d <- get
p <- get
i <- get
c <- get
k <- get
t <- get
let x =
XPubKey
{ xPubDepth = d
, xPubParent = p
, xPubIndex = i
, xPubChain = c
, xPubKey = pubKeyPoint k
}
return XPubSpec {xPubSpecKey = x, xPubDeriveType = t}
type UnixTime = Word64
type BlockPos = Word32
-- | Serialize such that ordering is inverted.
putUnixTime :: Word64 -> Put
putUnixTime w = putWord64be $ maxBound - w
getUnixTime :: Get Word64
getUnixTime = (maxBound -) <$> getWord64be
-- | Reference to a block where a transaction is stored.
data BlockRef
= BlockRef
{ blockRefHeight :: !BlockHeight
-- ^ block height in the chain
, blockRefPos :: !Word32
-- ^ position of transaction within the block
}
| MemRef
{ memRefTime :: !UnixTime
}
deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
-- | Serialized entities will sort in reverse order.
instance Serialize BlockRef where
put MemRef {memRefTime = t} = do
putWord8 0x00
putUnixTime t
put BlockRef {blockRefHeight = h, blockRefPos = p} = do
putWord8 0x01
putWord32be (maxBound - h)
putWord32be (maxBound - p)
get = getmemref <|> getblockref
where
getmemref = do
guard . (== 0x00) =<< getWord8
MemRef <$> getUnixTime
getblockref = do
guard . (== 0x01) =<< getWord8
h <- (maxBound -) <$> getWord32be
p <- (maxBound -) <$> getWord32be
return BlockRef {blockRefHeight = h, blockRefPos = p}
confirmed :: BlockRef -> Bool
confirmed BlockRef {} = True
confirmed MemRef {} = False
instance ToJSON BlockRef where
toJSON BlockRef {blockRefHeight = h, blockRefPos = p} =
object ["height" .= h, "position" .= p]
toJSON MemRef {memRefTime = t} = object ["mempool" .= t]
toEncoding BlockRef {blockRefHeight = h, blockRefPos = p} =
pairs ("height" .= h <> "position" .= p)
toEncoding MemRef {memRefTime = t} = pairs ("mempool" .= t)
instance FromJSON BlockRef where
parseJSON = A.withObject "blockref" $ \o -> b o <|> m o
where
b o = do
height <- o .: "height"
position <- o .: "position"
return BlockRef {blockRefHeight = height, blockRefPos = position}
m o = do
mempool <- o .: "mempool"
return MemRef {memRefTime = mempool}
-- | Transaction in relation to an address.
data BlockTx = BlockTx
{ blockTxBlock :: !BlockRef
-- ^ block information
, blockTxHash :: !TxHash
-- ^ transaction hash
} deriving (Show, Eq, Ord, Generic, Serialize, Hashable, NFData)
instance ToJSON BlockTx where
toJSON btx = object ["txid" .= blockTxHash btx, "block" .= blockTxBlock btx]
toEncoding btx =
pairs
( "txid" .= blockTxHash btx
<> "block" .= blockTxBlock btx
)
instance FromJSON BlockTx where
parseJSON =
A.withObject "blocktx" $ \o -> do
txid <- o .: "txid"
block <- o .: "block"
return BlockTx {blockTxBlock = block, blockTxHash = txid}
-- | Address balance information.
data Balance =
Balance
{ balanceAddress :: !Address
-- ^ address balance
, balanceAmount :: !Word64
-- ^ confirmed balance
, balanceZero :: !Word64
-- ^ unconfirmed balance
, balanceUnspentCount :: !Word64
-- ^ number of unspent outputs
, balanceTxCount :: !Word64
-- ^ number of transactions
, balanceTotalReceived :: !Word64
-- ^ total amount from all outputs in this address
}
deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)
zeroBalance :: Address -> Balance
zeroBalance a =
Balance
{ balanceAddress = a
, balanceAmount = 0
, balanceUnspentCount = 0
, balanceZero = 0
, balanceTxCount = 0
, balanceTotalReceived = 0
}
nullBalance :: Balance -> Bool
nullBalance Balance { balanceAmount = 0
, balanceUnspentCount = 0
, balanceZero = 0
, balanceTxCount = 0
, balanceTotalReceived = 0
} = True
nullBalance _ = False
balanceToJSON :: Network -> Balance -> Value
balanceToJSON net b =
object $
[ "address" .= addrToJSON net (balanceAddress b)
, "confirmed" .= balanceAmount b
, "unconfirmed" .= balanceZero b
, "utxo" .= balanceUnspentCount b
, "txs" .= balanceTxCount b
, "received" .= balanceTotalReceived b
]
balanceToEncoding :: Network -> Balance -> Encoding
balanceToEncoding net b =
pairs
( "address" `pair` addrToEncoding net (balanceAddress b)
<> "confirmed" .= balanceAmount b
<> "unconfirmed" .= balanceZero b
<> "utxo" .= balanceUnspentCount b
<> "txs" .= balanceTxCount b
<> "received" .= balanceTotalReceived b
)
balanceParseJSON :: Network -> Value -> Parser Balance
balanceParseJSON net =
A.withObject "balance" $ \o -> do
amount <- o .: "confirmed"
unconfirmed <- o .: "unconfirmed"
utxo <- o .: "utxo"
txs <- o .: "txs"
received <- o .: "received"
address <- addrFromJSON net =<< o .: "address"
return
Balance
{ balanceAddress = address
, balanceAmount = amount
, balanceUnspentCount = utxo
, balanceZero = unconfirmed
, balanceTxCount = txs
, balanceTotalReceived = received
}
-- | Unspent output.
data Unspent = Unspent
{ unspentBlock :: !BlockRef
, unspentPoint :: !OutPoint
, unspentAmount :: !Word64
, unspentScript :: !ShortByteString
} deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)
unspentToJSON :: Network -> Unspent -> Value
unspentToJSON net u =
object
[ "address" .= scriptToAddrJSON net bsscript
, "block" .= unspentBlock u
, "txid" .= outPointHash (unspentPoint u)
, "index" .= outPointIndex (unspentPoint u)
, "pkscript" .= script
, "value" .= unspentAmount u
]
where
bsscript = BSS.fromShort (unspentScript u)
script = encodeHex bsscript
unspentToEncoding :: Network -> Unspent -> Encoding
unspentToEncoding net u =
pairs
( "address" `pair` scriptToAddrEncoding net bsscript
<> "block" .= unspentBlock u
<> "txid" .= outPointHash (unspentPoint u)
<> "index" .= outPointIndex (unspentPoint u)
<> "pkscript" `pair` text script
<> "value" .= unspentAmount u
)
where
bsscript = BSS.fromShort (unspentScript u)
script = encodeHex bsscript
instance FromJSON Unspent where
parseJSON =
A.withObject "unspent" $ \o -> do
block <- o .: "block"
txid <- o .: "txid"
index <- o .: "index"
value <- o .: "value"
script <- BSS.toShort <$> (o .: "pkscript" >>= jsonHex)
return
Unspent
{ unspentBlock = block
, unspentPoint = OutPoint txid index
, unspentAmount = value
, unspentScript = script
}
-- | Database value for a block entry.
data BlockData = BlockData
{ blockDataHeight :: !BlockHeight
-- ^ height of the block in the chain
, blockDataMainChain :: !Bool
-- ^ is this block in the main chain?
, blockDataWork :: !BlockWork
-- ^ accumulated work in that block
, blockDataHeader :: !BlockHeader
-- ^ block header
, blockDataSize :: !Word32
-- ^ size of the block including witnesses
, blockDataWeight :: !Word32
-- ^ weight of this block (for segwit networks)
, blockDataTxs :: ![TxHash]
-- ^ block transactions
, blockDataOutputs :: !Word64
-- ^ sum of all transaction outputs
, blockDataFees :: !Word64
-- ^ sum of all transaction fees
, blockDataSubsidy :: !Word64
-- ^ block subsidy
} deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)
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 :: !(Maybe WitnessStack)
}
| StoreInput { inputPoint :: !OutPoint
, inputSequence :: !Word32
, inputSigScript :: !ByteString
, inputPkScript :: !ByteString
, inputAmount :: !Word64
, inputWitness :: !(Maybe WitnessStack)
}
deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)
isCoinbase :: StoreInput -> Bool
isCoinbase StoreCoinbase {} = True
isCoinbase StoreInput {} = False
storeInputToJSON :: Network -> StoreInput -> Value
storeInputToJSON net StoreInput { inputPoint = OutPoint oph opi
, inputSequence = sq
, inputSigScript = ss
, inputPkScript = ps
, inputAmount = val
, inputWitness = wit
} =
object $
[ "coinbase" .= False
, "txid" .= oph
, "output" .= opi
, "sigscript" .= String (encodeHex ss)
, "sequence" .= sq
, "pkscript" .= String (encodeHex ps)
, "value" .= val
, "address" .= scriptToAddrJSON net ps
] <>
["witness" .= fmap (map encodeHex) wit | getSegWit net]
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" .= fmap (map encodeHex) wit | getSegWit net]
storeInputToEncoding :: Network -> StoreInput -> Encoding
storeInputToEncoding net StoreInput { inputPoint = OutPoint oph opi
, inputSequence = sq
, inputSigScript = ss
, inputPkScript = ps
, inputAmount = val
, inputWitness = wit
} =
pairs
( "coinbase" .= False
<> "txid" .= oph
<> "output" .= opi
<> "sigscript" `pair` text (encodeHex ss)
<> "sequence" .= sq
<> "pkscript" `pair` text (encodeHex ps)
<> "value" .= val
<> "address" `pair` scriptToAddrEncoding net ps
<> if getSegWit net
then "witness" .= fmap (map encodeHex) wit
else mempty
)
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_
<> if getSegWit net
then "witness" .= fmap (map encodeHex) wit
else mempty
)
instance FromJSON StoreInput where
parseJSON =
A.withObject "storeinput" $ \o -> do
coinbase <- o .: "coinbase"
outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"
sequ <- o .: "sequence"
witness <-
o .:? "witness" >>= \mmxs ->
case join mmxs of
Nothing -> return Nothing
Just xs -> Just <$> mapM jsonHex xs
sigscript <- o .: "sigscript" >>= jsonHex
if coinbase
then return
StoreCoinbase
{ inputPoint = outpoint
, inputSequence = sequ
, inputSigScript = sigscript
, inputWitness = witness
}
else do
pkscript <- o .: "pkscript" >>= jsonHex
value <- o .: "value"
return
StoreInput
{ inputPoint = outpoint
, inputSequence = sequ
, inputSigScript = sigscript
, inputPkScript = pkscript
, inputAmount = value
, inputWitness = witness
}
jsonHex :: Text -> Parser ByteString
jsonHex s =
case decodeHex s of
Nothing -> fail "Could not decode hex"
Just b -> return b
-- | Information about input spending output.
data Spender = Spender
{ spenderHash :: !TxHash
-- ^ input transaction hash
, spenderIndex :: !Word32
-- ^ input position in transaction
} deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)
instance ToJSON Spender where
toJSON n = object ["txid" .= txHashToHex (spenderHash n), "input" .= spenderIndex n]
toEncoding n = pairs ("txid" .= txHashToHex (spenderHash n) <> "input" .= spenderIndex n)
instance FromJSON Spender where
parseJSON =
A.withObject "spender" $ \o -> Spender <$> o .: "txid" <*> o .: "input"
-- | Output information.
data StoreOutput = StoreOutput
{ outputAmount :: !Word64
, outputScript :: !ByteString
, outputSpender :: !(Maybe Spender)
} deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)
storeOutputToJSON :: Network -> StoreOutput -> Value
storeOutputToJSON net d =
object
[ "address" .= scriptToAddrJSON net (outputScript d)
, "pkscript" .= encodeHex (outputScript d)
, "value" .= outputAmount d
, "spent" .= isJust (outputSpender d)
, "spender" .= outputSpender d
]
storeOutputToEncoding :: Network -> StoreOutput -> Encoding
storeOutputToEncoding net d =
pairs
( "address" `pair` scriptToAddrEncoding net (outputScript d)
<> "pkscript" `pair` text (encodeHex (outputScript d))
<> "value" .= outputAmount d
<> "spent" .= isJust (outputSpender d)
<> "spender" .= outputSpender d
)
instance FromJSON StoreOutput where
parseJSON =
A.withObject "storeoutput" $ \o -> do
value <- o .: "value"
pkscript <- o .: "pkscript" >>= jsonHex
spender <- o .: "spender"
return
StoreOutput
{ outputAmount = value
, outputScript = pkscript
, outputSpender = spender
}
data Prev = Prev
{ prevScript :: !ByteString
, prevAmount :: !Word64
} deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)
toInput :: TxIn -> Maybe Prev -> Maybe WitnessStack -> StoreInput
toInput i Nothing w =
StoreCoinbase
{ inputPoint = prevOutput i
, inputSequence = txInSequence i
, inputSigScript = scriptInput i
, inputWitness = w
}
toInput i (Just p) w =
StoreInput
{ inputPoint = prevOutput i
, inputSequence = txInSequence i
, inputSigScript = scriptInput i
, inputPkScript = prevScript p
, inputAmount = prevAmount p
, inputWitness = w
}
toOutput :: TxOut -> Maybe Spender -> StoreOutput
toOutput o s =
StoreOutput
{ outputAmount = outValue o
, outputScript = scriptOutput o
, outputSpender = s
}
data TxData = TxData
{ txDataBlock :: !BlockRef
, txData :: !Tx
, txDataPrevs :: !(IntMap Prev)
, txDataDeleted :: !Bool
, txDataRBF :: !Bool
, txDataTime :: !Word64
} deriving (Show, Eq, Ord, Generic, Serialize, NFData)
toTransaction :: TxData -> IntMap Spender -> Transaction
toTransaction t sm =
Transaction
{ transactionBlock = txDataBlock t
, transactionVersion = txVersion (txData t)
, transactionLockTime = txLockTime (txData t)
, transactionInputs = ins
, transactionOutputs = outs
, transactionDeleted = txDataDeleted t
, transactionRBF = txDataRBF t
, transactionTime = txDataTime t
}
where
ws =
take (length (txIn (txData t))) $
map Just (txWitness (txData t)) <> repeat Nothing
f n i = toInput i (I.lookup n (txDataPrevs t)) (ws !! n)
ins = zipWith f [0 ..] (txIn (txData t))
g n o = toOutput o (I.lookup n sm)
outs = zipWith g [0 ..] (txOut (txData t))
fromTransaction :: Transaction -> (TxData, IntMap Spender)
fromTransaction t = (d, sm)
where
d =
TxData
{ txDataBlock = transactionBlock t
, txData = transactionData t
, txDataPrevs = ps
, txDataDeleted = transactionDeleted t
, txDataRBF = transactionRBF t
, txDataTime = transactionTime t
}
f _ StoreCoinbase {} = Nothing
f n StoreInput {inputPkScript = s, inputAmount = v} =
Just (n, Prev {prevScript = s, prevAmount = v})
ps = I.fromList . catMaybes $ zipWith f [0 ..] (transactionInputs t)
g _ StoreOutput {outputSpender = Nothing} = Nothing
g n StoreOutput {outputSpender = Just s} = Just (n, s)
sm = I.fromList . catMaybes $ zipWith g [0 ..] (transactionOutputs t)
-- | Detailed transaction information.
data Transaction = Transaction
{ transactionBlock :: !BlockRef
-- ^ block information for this transaction
, transactionVersion :: !Word32
-- ^ transaction version
, transactionLockTime :: !Word32
-- ^ lock time
, transactionInputs :: ![StoreInput]
-- ^ transaction inputs
, transactionOutputs :: ![StoreOutput]
-- ^ transaction outputs
, transactionDeleted :: !Bool
-- ^ this transaction has been deleted and is no longer valid
, transactionRBF :: !Bool
-- ^ this transaction can be replaced in the mempool
, transactionTime :: !Word64
-- ^ time the transaction was first seen or time of block
} deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)
transactionData :: Transaction -> Tx
transactionData t =
Tx
{ txVersion = transactionVersion t
, txIn = map i (transactionInputs t)
, txOut = map o (transactionOutputs t)
, txWitness = mapMaybe inputWitness (transactionInputs t)
, txLockTime = transactionLockTime t
}
where
i StoreCoinbase {inputPoint = p, inputSequence = q, inputSigScript = s} =
TxIn {prevOutput = p, scriptInput = s, txInSequence = q}
i StoreInput {inputPoint = p, inputSequence = q, inputSigScript = s} =
TxIn {prevOutput = p, scriptInput = s, txInSequence = q}
o StoreOutput {outputAmount = v, outputScript = s} =
TxOut {outValue = v, scriptOutput = s}
transactionToJSON :: Network -> Transaction -> Value
transactionToJSON net dtx =
object $
[ "txid" .= txHash (transactionData dtx)
, "size" .= B.length (S.encode (transactionData dtx))
, "version" .= transactionVersion dtx
, "locktime" .= transactionLockTime dtx
, "fee" .=
if any isCoinbase (transactionInputs dtx)
then 0
else inv - outv
, "inputs" .= map (storeInputToJSON net) (transactionInputs dtx)
, "outputs" .= map (storeOutputToJSON net) (transactionOutputs dtx)
, "block" .= transactionBlock dtx
, "deleted" .= transactionDeleted dtx
, "time" .= transactionTime dtx
, "rbf" .= transactionRBF dtx
] <>
["weight" .= w | getSegWit net]
where
inv = sum (map inputAmount (transactionInputs dtx))
outv = sum (map outputAmount (transactionOutputs dtx))
w =
let b = B.length $ S.encode (transactionData dtx) {txWitness = []}
x = B.length $ S.encode (transactionData dtx)
in b * 3 + x
transactionToEncoding :: Network -> Transaction -> Encoding
transactionToEncoding net dtx =
pairs
( "txid" `pair` text (txHashToHex (txHash (transactionData dtx)))
<> "size" .= B.length (S.encode (transactionData dtx))
<> "version" .= transactionVersion dtx
<> "locktime" .= transactionLockTime dtx
<> "fee" .= (if any isCoinbase (transactionInputs dtx) then 0 else inv - outv)
<> "inputs" `pair` list (storeInputToEncoding net) (transactionInputs dtx)
<> "outputs" `pair` list (storeOutputToEncoding net) (transactionOutputs dtx)
<> "block" .= transactionBlock dtx
<> "deleted" .= transactionDeleted dtx
<> "time" .= transactionTime dtx
<> "rbf" .= transactionRBF dtx
<> if getSegWit net
then "weight" .= w
else mempty
)
where
inv = sum (map inputAmount (transactionInputs dtx))
outv = sum (map outputAmount (transactionOutputs dtx))
w =
let b = B.length $ S.encode (transactionData dtx) {txWitness = []}
x = B.length $ S.encode (transactionData dtx)
in b * 3 + x
instance FromJSON Transaction where
parseJSON =
A.withObject "transaction" $ \o -> do
version <- o .: "version"
locktime <- o .: "locktime"
inputs <- o .: "inputs"
outputs <- o .: "outputs"
block <- o .: "block"
deleted <- o .: "deleted"
time <- o .: "time"
rbf <- o .:? "rbf" .!= False
return
Transaction
{ transactionBlock = block
, transactionVersion = version
, transactionLockTime = locktime
, transactionInputs = inputs
, transactionOutputs = outputs
, transactionDeleted = deleted
, transactionTime = time
, transactionRBF = rbf
}
-- | Information about a connected peer.
data PeerInformation
= PeerInformation { peerUserAgent :: !ByteString
-- ^ user agent string
, peerAddress :: !String
-- ^ network address
, peerVersion :: !Word32
-- ^ version number
, peerServices :: !Word64
-- ^ services field
, peerRelay :: !Bool
-- ^ will relay transactions
}
deriving (Show, Eq, Ord, Generic, NFData, Serialize)
instance ToJSON PeerInformation where
toJSON p = object
[ "useragent" .= String (cs (peerUserAgent p))
, "address" .= peerAddress p
, "version" .= peerVersion p
, "services" .= String (encodeHex (S.encode (peerServices p)))
, "relay" .= peerRelay p
]
toEncoding p = pairs
( "useragent" `pair` text (cs (peerUserAgent p))
<> "address" .= peerAddress p
<> "version" .= peerVersion p
<> "services" `pair` text (encodeHex (S.encode (peerServices p)))
<> "relay" .= peerRelay p
)
instance FromJSON PeerInformation where
parseJSON =
A.withObject "peerinformation" $ \o -> do
String useragent <- o .: "useragent"
address <- o .: "address"
version <- o .: "version"
services <-
o .: "services" >>= jsonHex >>= \b ->
case S.decode b of
Left e -> fail $ "Could not decode services: " <> e
Right s -> return s
relay <- o .: "relay"
return
PeerInformation
{ peerUserAgent = cs useragent
, peerAddress = address
, peerVersion = version
, peerServices = services
, peerRelay = relay
}
-- | Address balances for an extended public key.
data XPubBal = XPubBal
{ xPubBalPath :: ![KeyIndex]
, xPubBal :: !Balance
} deriving (Show, Ord, Eq, Generic, Serialize, NFData)
xPubBalToJSON :: Network -> XPubBal -> Value
xPubBalToJSON net XPubBal {xPubBalPath = p, xPubBal = b} =
object ["path" .= p, "balance" .= balanceToJSON net b]
xPubBalToEncoding :: Network -> XPubBal -> Encoding
xPubBalToEncoding net XPubBal {xPubBalPath = p, xPubBal = b} =
pairs ("path" .= p <> "balance" `pair` balanceToEncoding net b)
xPubBalParseJSON :: Network -> Value -> Parser XPubBal
xPubBalParseJSON net =
A.withObject "xpubbal" $ \o -> do
path <- o .: "path"
balance <- balanceParseJSON net =<< o .: "balance"
return XPubBal {xPubBalPath = path, xPubBal = balance}
-- | Unspent transaction for extended public key.
data XPubUnspent = XPubUnspent
{ xPubUnspentPath :: ![KeyIndex]
, xPubUnspent :: !Unspent
} deriving (Show, Eq, Generic, Serialize, NFData)
xPubUnspentToJSON :: Network -> XPubUnspent -> Value
xPubUnspentToJSON net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =
object ["path" .= p, "unspent" .= unspentToJSON net u]
xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding
xPubUnspentToEncoding net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =
pairs ("path" .= p <> "unspent" `pair` unspentToEncoding net u)
instance FromJSON XPubUnspent where
parseJSON =
A.withObject "xpubunspent" $ \o -> do
p <- o .: "path"
u <- o .: "unspent"
return XPubUnspent {xPubUnspentPath = p, xPubUnspent = u}
data XPubSummary =
XPubSummary
{ xPubSummaryConfirmed :: !Word64
, xPubSummaryZero :: !Word64
, xPubSummaryReceived :: !Word64
, xPubUnspentCount :: !Word64
, xPubExternalIndex :: !Word32
, xPubChangeIndex :: !Word32
}
deriving (Eq, Show, Generic, Serialize, NFData)
instance ToJSON XPubSummary where
toJSON XPubSummary { xPubSummaryConfirmed = c
, xPubSummaryZero = z
, xPubSummaryReceived = r
, xPubUnspentCount = u
, xPubExternalIndex = ext
, xPubChangeIndex = ch
} =
object
[ "balance" .=
object
[ "confirmed" .= c
, "unconfirmed" .= z
, "received" .= r
, "utxo" .= u
]
, "indices" .= object ["change" .= ch, "external" .= ext]
]
toEncoding XPubSummary { xPubSummaryConfirmed = c
, xPubSummaryZero = z
, xPubSummaryReceived = r
, xPubUnspentCount = u
, xPubExternalIndex = ext
, xPubChangeIndex = ch
} =
pairs
( "balance" `pair` pairs
( "confirmed" .= c
<> "unconfirmed" .= z
<> "received" .= r
<> "utxo" .= u
)
<> "indices" `pair` pairs
( "change" .= ch
<> "external" .= ext
)
)
instance FromJSON XPubSummary where
parseJSON =
A.withObject "xpubsummary" $ \o -> do
b <- o .: "balance"
i <- o .: "indices"
conf <- b .: "confirmed"
unconfirmed <- b .: "unconfirmed"
received <- b .: "received"
utxo <- b .: "utxo"
change <- i .: "change"
external <- i .: "external"
return
XPubSummary
{ xPubSummaryConfirmed = conf
, xPubSummaryZero = unconfirmed
, xPubSummaryReceived = received
, xPubUnspentCount = utxo
, xPubExternalIndex = external
, xPubChangeIndex = change
}
data HealthCheck =
HealthCheck
{ healthHeaderBest :: !(Maybe BlockHash)
, healthHeaderHeight :: !(Maybe BlockHeight)
, healthBlockBest :: !(Maybe BlockHash)
, healthBlockHeight :: !(Maybe BlockHeight)
, healthPeers :: !(Maybe Int)
, healthNetwork :: !String
, healthOK :: !Bool
, healthSynced :: !Bool
, healthLastBlock :: !(Maybe Word64)
, healthLastTx :: !(Maybe Word64)
, healthVersion :: !String
}
deriving (Show, Eq, Generic, Serialize, NFData)
instance ToJSON HealthCheck where
toJSON h =
object
[ "headers" .=
object
[ "hash" .= healthHeaderBest h
, "height" .= healthHeaderHeight h
]
, "blocks" .=
object
["hash" .= healthBlockBest h, "height" .= healthBlockHeight h]
, "peers" .= healthPeers h
, "net" .= healthNetwork h
, "ok" .= healthOK h
, "synced" .= healthSynced h
, "version" .= healthVersion h
, "lastblock" .= healthLastBlock h
, "lasttx" .= healthLastTx h
]
toEncoding h =
pairs
( "headers" `pair`
pairs
( "hash" .= healthHeaderBest h
<> "height" .= healthHeaderHeight h
)
<> "blocks" `pair`
pairs
( "hash" .= healthBlockBest h
<> "height" .= healthBlockHeight h
)
<> "peers" .= healthPeers h
<> "net" .= healthNetwork h
<> "ok" .= healthOK h
<> "synced" .= healthSynced h
<> "version" .= healthVersion h
<> "lastblock" .= healthLastBlock h
<> "lasttx" .= healthLastTx h
)
instance FromJSON HealthCheck where
parseJSON =
A.withObject "healthcheck" $ \o -> do
headers <- o .: "headers"
headers_hash <- headers .: "hash"
headers_height <- headers .: "height"
blocks <- o .: "blocks"
blocks_hash <- blocks .: "hash"
blocks_height <- blocks .: "height"
peers <- o .: "peers"
net <- o .: "net"
ok <- o .: "ok"
synced <- o .: "synced"
lastblock <- o .: "lastblock"
lasttx <- o .: "lasttx"
ver <- o .: "version"
return
HealthCheck
{ healthHeaderBest = headers_hash
, healthHeaderHeight = headers_height
, healthBlockBest = blocks_hash
, healthBlockHeight = blocks_height
, healthPeers = peers
, healthNetwork = net
, healthOK = ok
, healthSynced = synced
, healthLastBlock = lastblock
, healthLastTx = lasttx
, healthVersion = ver
}
data Event
= EventBlock BlockHash
| EventTx TxHash
deriving (Show, Eq, Generic, Serialize, NFData)
instance ToJSON Event where
toJSON (EventTx h) = object ["type" .= String "tx", "id" .= h]
toJSON (EventBlock h) = object ["type" .= String "block", "id" .= h]
toEncoding (EventTx h) =
pairs ("type" `pair` text "tx" <> "id" `pair` text (txHashToHex h))
toEncoding (EventBlock h) =
pairs
("type" `pair` text "block" <> "id" `pair` text (blockHashToHex h))
instance FromJSON Event where
parseJSON =
A.withObject "event" $ \o -> do
t <- o .: "type"
case t of
"tx" -> do
i <- o .: "id"
return $ EventTx i
"block" -> do
i <- o .: "id"
return $ EventBlock i
_ -> fail $ "Could not recognize event type: " <> t
newtype GenericResult a = GenericResult
{ getResult :: a
} deriving (Show, Eq, Generic, Serialize, NFData)
instance ToJSON a => ToJSON (GenericResult a) where
toJSON (GenericResult b) = object ["result" .= b]
toEncoding (GenericResult b) = pairs ("result" .= b)
instance FromJSON a => FromJSON (GenericResult a) where
parseJSON =
A.withObject "result" $ \o -> GenericResult <$> o .: "result"
newtype TxId =
TxId TxHash
deriving (Show, Eq, Generic, Serialize, NFData)
instance ToJSON TxId where
toJSON (TxId h) = object ["txid" .= h]
toEncoding (TxId h) = pairs ("txid" `pair` text (txHashToHex h))
instance FromJSON TxId where
parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid"
scriptToAddrJSON :: Network -> ByteString -> Value
scriptToAddrJSON net bs =
case scriptToAddressBS bs of
Left _ -> Null
Right a -> addrToJSON net a
scriptToAddrEncoding :: Network -> ByteString -> Encoding
scriptToAddrEncoding net bs =
case scriptToAddressBS bs of
Left _ -> null_
Right a -> addrToEncoding net a
data Except
= ThingNotFound
| ServerError
| BadRequest
| UserError String
| StringError String
| BlockTooLarge
deriving (Eq, Ord, Serialize, Generic, NFData)
instance Show Except where
show ThingNotFound = "not found"
show ServerError = "you made me kill a unicorn"
show BadRequest = "bad request"
show (UserError s) = s
show (StringError _) = "you killed the dragon with your bare hands"
show BlockTooLarge = "block too large"
instance Exception Except
instance ScottyError Except where
stringError = StringError
showError = TL.pack . show
instance ToJSON Except where
toJSON e = object ["error" .= TL.pack (show e)]