{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Haskoin.Store.Data
    ( -- * Address Balances
      Balance(..)
    , balanceToJSON
    , balanceToEncoding
    , balanceParseJSON
    , zeroBalance
    , nullBalance

      -- * Block Data
    , BlockData(..)
    , blockDataToJSON
    , blockDataToEncoding
    , confirmed

      -- * Transactions
    , TxRef(..)
    , TxData(..)
    , Transaction(..)
    , transactionToJSON
    , transactionToEncoding
    , transactionParseJSON
    , transactionData
    , fromTransaction
    , toTransaction
    , StoreInput(..)
    , storeInputToJSON
    , storeInputToEncoding
    , storeInputParseJSON
    , isCoinbase
    , StoreOutput(..)
    , storeOutputToJSON
    , storeOutputToEncoding
    , storeOutputParseJSON
    , Prev(..)
    , Spender(..)
    , BlockRef(..)
    , UnixTime
    , getUnixTime
    , putUnixTime
    , BlockPos

      -- * Unspent Outputs
    , Unspent(..)
    , unspentToJSON
    , unspentToEncoding
    , unspentParseJSON

      -- * Extended Public Keys
    , XPubSpec(..)
    , XPubBal(..)
    , xPubBalToJSON
    , xPubBalToEncoding
    , xPubBalParseJSON
    , XPubUnspent(..)
    , xPubUnspentToJSON
    , xPubUnspentToEncoding
    , xPubUnspentParseJSON
    , XPubSummary(..)
    , DeriveType(..)

      -- * Other Data
    , TxId(..)
    , GenericResult(..)
    , RawResult(..)
    , RawResultList(..)
    , PeerInformation(..)
    , Healthy(..)
    , BlockHealth(..)
    , TimeHealth(..)
    , CountHealth(..)
    , MaxHealth(..)
    , HealthCheck(..)
    , Event(..)
    , Except(..)

     -- * Blockchain.info API
    , BinfoTxIndex
    , isBinfoTxIndexNull
    , isBinfoTxIndexBlock
    , isBinfoTxIndexHash
    , encodeBinfoTxIndexHash
    , hashToBinfoTxIndex
    , blockToBinfoTxIndex
    , matchBinfoTxHash
    , binfoTxIndexBlock
    , binfoTransactionIndex
    , BinfoTxId(..)
    , BinfoMultiAddr(..)
    , binfoMultiAddrToJSON
    , binfoMultiAddrToEncoding
    , binfoMultiAddrParseJSON
    , BinfoAddress(..)
    , toBinfoAddrs
    , binfoAddressToJSON
    , binfoAddressToEncoding
    , binfoAddressParseJSON
    , BinfoAddr(..)
    , parseBinfoAddr
    , BinfoWallet(..)
    , BinfoTx(..)
    , relevantTxs
    , toBinfoTx
    , toBinfoTxSimple
    , binfoTxToJSON
    , binfoTxToEncoding
    , binfoTxParseJSON
    , BinfoTxInput(..)
    , binfoTxInputToJSON
    , binfoTxInputToEncoding
    , binfoTxInputParseJSON
    , BinfoTxOutput(..)
    , binfoTxOutputToJSON
    , binfoTxOutputToEncoding
    , binfoTxOutputParseJSON
    , BinfoSpender(..)
    , BinfoXPubPath(..)
    , binfoXPubPathToJSON
    , binfoXPubPathToEncoding
    , binfoXPubPathParseJSON
    , BinfoInfo(..)
    , BinfoBlockInfo(..)
    , BinfoSymbol(..)
    , BinfoTicker(..)
    )

where

import           Control.Applicative     ((<|>))
import           Control.DeepSeq         (NFData)
import           Control.Exception       (Exception)
import           Control.Monad           (guard, join, mzero, (<=<))
import           Data.Aeson              (Encoding, FromJSON (..),
                                          FromJSONKey (..), ToJSON (..),
                                          ToJSONKey (..), Value (..), object,
                                          pairs, withObject, (.!=), (.:), (.:?),
                                          (.=))
import qualified Data.Aeson              as A
import           Data.Aeson.Encoding     (list, null_, pair, text,
                                          unsafeToEncoding)
import           Data.Aeson.Types        (Parser)
import           Data.Bits               (setBit, shift, testBit, (.&.), (.|.))
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as B
import           Data.ByteString.Builder (char7, lazyByteStringHex)
import           Data.ByteString.Short   (ShortByteString)
import qualified Data.ByteString.Short   as BSS
import           Data.Default            (Default (..))
import           Data.Either             (fromRight, lefts, rights)
import           Data.Foldable           (toList)
import           Data.Function           (on)
import           Data.Hashable           (Hashable (..))
import           Data.HashMap.Strict     (HashMap)
import qualified Data.HashMap.Strict     as HashMap
import           Data.HashSet            (HashSet)
import qualified Data.HashSet            as HashSet
import           Data.Int                (Int64)
import qualified Data.IntMap             as IntMap
import           Data.IntMap.Strict      (IntMap)
import           Data.Map.Strict         (Map)
import           Data.Maybe              (catMaybes, fromMaybe, isJust,
                                          isNothing, mapMaybe, maybeToList)
import           Data.Serialize          (Get, Put, Serialize (..), getWord32be,
                                          getWord64be, getWord8, putWord32be,
                                          putWord64be, putWord8)
import qualified Data.Serialize          as S
import           Data.String.Conversions (cs)
import           Data.Text               (Text)
import qualified Data.Text               as T
import           Data.Text.Encoding      (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy          as TL
import           Data.Word               (Word32, Word64)
import           GHC.Generics            (Generic)
import           Haskoin                 (Address, BlockHash, BlockHeader (..),
                                          BlockHeight, BlockWork, Coin (..),
                                          KeyIndex, Network (..), OutPoint (..),
                                          PubKeyI (..), SoftPath, Tx (..),
                                          TxHash (..), TxIn (..), TxOut (..),
                                          WitnessStack, XPubKey (..),
                                          addrFromJSON, addrToEncoding,
                                          addrToJSON, bch, blockHashToHex, btc,
                                          decodeHex, eitherToMaybe, encodeHex,
                                          headerHash, hexToTxHash,
                                          maybeToEither, parseSoft, pathToList,
                                          pathToStr, putVarInt,
                                          scriptToAddressBS, textToAddr, txHash,
                                          txHashToHex, wrapPubKey, xPubFromJSON,
                                          xPubImport, xPubToEncoding,
                                          xPubToJSON)
import           Text.Read               (readMaybe)
import           Web.Scotty.Trans        (Parsable (..), ScottyError (..))

data DeriveType = DeriveNormal
    | DeriveP2SH
    | DeriveP2WPKH
    deriving (Int -> DeriveType -> ShowS
[DeriveType] -> ShowS
DeriveType -> String
(Int -> DeriveType -> ShowS)
-> (DeriveType -> String)
-> ([DeriveType] -> ShowS)
-> Show DeriveType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeriveType] -> ShowS
$cshowList :: [DeriveType] -> ShowS
show :: DeriveType -> String
$cshow :: DeriveType -> String
showsPrec :: Int -> DeriveType -> ShowS
$cshowsPrec :: Int -> DeriveType -> ShowS
Show, DeriveType -> DeriveType -> Bool
(DeriveType -> DeriveType -> Bool)
-> (DeriveType -> DeriveType -> Bool) -> Eq DeriveType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeriveType -> DeriveType -> Bool
$c/= :: DeriveType -> DeriveType -> Bool
== :: DeriveType -> DeriveType -> Bool
$c== :: DeriveType -> DeriveType -> Bool
Eq, (forall x. DeriveType -> Rep DeriveType x)
-> (forall x. Rep DeriveType x -> DeriveType) -> Generic DeriveType
forall x. Rep DeriveType x -> DeriveType
forall x. DeriveType -> Rep DeriveType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeriveType x -> DeriveType
$cfrom :: forall x. DeriveType -> Rep DeriveType x
Generic, DeriveType -> ()
(DeriveType -> ()) -> NFData DeriveType
forall a. (a -> ()) -> NFData a
rnf :: DeriveType -> ()
$crnf :: DeriveType -> ()
NFData, Get DeriveType
Putter DeriveType
Putter DeriveType -> Get DeriveType -> Serialize DeriveType
forall t. Putter t -> Get t -> Serialize t
get :: Get DeriveType
$cget :: Get DeriveType
put :: Putter DeriveType
$cput :: Putter DeriveType
Serialize)

instance Default DeriveType where
    def :: DeriveType
def = DeriveType
DeriveNormal

data XPubSpec =
    XPubSpec
        { XPubSpec -> XPubKey
xPubSpecKey    :: !XPubKey
        , XPubSpec -> DeriveType
xPubDeriveType :: !DeriveType
        }
    deriving (Int -> XPubSpec -> ShowS
[XPubSpec] -> ShowS
XPubSpec -> String
(Int -> XPubSpec -> ShowS)
-> (XPubSpec -> String) -> ([XPubSpec] -> ShowS) -> Show XPubSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPubSpec] -> ShowS
$cshowList :: [XPubSpec] -> ShowS
show :: XPubSpec -> String
$cshow :: XPubSpec -> String
showsPrec :: Int -> XPubSpec -> ShowS
$cshowsPrec :: Int -> XPubSpec -> ShowS
Show, XPubSpec -> XPubSpec -> Bool
(XPubSpec -> XPubSpec -> Bool)
-> (XPubSpec -> XPubSpec -> Bool) -> Eq XPubSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPubSpec -> XPubSpec -> Bool
$c/= :: XPubSpec -> XPubSpec -> Bool
== :: XPubSpec -> XPubSpec -> Bool
$c== :: XPubSpec -> XPubSpec -> Bool
Eq, (forall x. XPubSpec -> Rep XPubSpec x)
-> (forall x. Rep XPubSpec x -> XPubSpec) -> Generic XPubSpec
forall x. Rep XPubSpec x -> XPubSpec
forall x. XPubSpec -> Rep XPubSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPubSpec x -> XPubSpec
$cfrom :: forall x. XPubSpec -> Rep XPubSpec x
Generic, XPubSpec -> ()
(XPubSpec -> ()) -> NFData XPubSpec
forall a. (a -> ()) -> NFData a
rnf :: XPubSpec -> ()
$crnf :: XPubSpec -> ()
NFData)

instance Hashable XPubSpec where
    hashWithSalt :: Int -> XPubSpec -> Int
hashWithSalt i :: Int
i XPubSpec {xPubSpecKey :: XPubSpec -> XPubKey
xPubSpecKey = XPubKey {xPubKey :: XPubKey -> PubKey
xPubKey = PubKey
pubkey}} =
        Int -> PubKey -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i PubKey
pubkey

instance Serialize XPubSpec where
    put :: Putter XPubSpec
put XPubSpec {xPubSpecKey :: XPubSpec -> XPubKey
xPubSpecKey = XPubKey
k, xPubDeriveType :: XPubSpec -> DeriveType
xPubDeriveType = DeriveType
t} = do
        Putter Word8
forall t. Serialize t => Putter t
put (XPubKey -> Word8
xPubDepth XPubKey
k)
        Putter Fingerprint
forall t. Serialize t => Putter t
put (XPubKey -> Fingerprint
xPubParent XPubKey
k)
        Putter Fingerprint
forall t. Serialize t => Putter t
put (XPubKey -> Fingerprint
xPubIndex XPubKey
k)
        Putter ChainCode
forall t. Serialize t => Putter t
put (XPubKey -> ChainCode
xPubChain XPubKey
k)
        Putter PubKeyI
forall t. Serialize t => Putter t
put (Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
k))
        Putter DeriveType
forall t. Serialize t => Putter t
put DeriveType
t
    get :: Get XPubSpec
get = do
        Word8
d <- Get Word8
forall t. Serialize t => Get t
get
        Fingerprint
p <- Get Fingerprint
forall t. Serialize t => Get t
get
        Fingerprint
i <- Get Fingerprint
forall t. Serialize t => Get t
get
        ChainCode
c <- Get ChainCode
forall t. Serialize t => Get t
get
        PubKeyI
k <- Get PubKeyI
forall t. Serialize t => Get t
get
        DeriveType
t <- Get DeriveType
forall t. Serialize t => Get t
get
        let x :: XPubKey
x =
                $WXPubKey :: Word8
-> Fingerprint -> Fingerprint -> ChainCode -> PubKey -> XPubKey
XPubKey
                    { xPubDepth :: Word8
xPubDepth = Word8
d
                    , xPubParent :: Fingerprint
xPubParent = Fingerprint
p
                    , xPubIndex :: Fingerprint
xPubIndex = Fingerprint
i
                    , xPubChain :: ChainCode
xPubChain = ChainCode
c
                    , xPubKey :: PubKey
xPubKey = PubKeyI -> PubKey
pubKeyPoint PubKeyI
k
                    }
        XPubSpec -> Get XPubSpec
forall (m :: * -> *) a. Monad m => a -> m a
return $WXPubSpec :: XPubKey -> DeriveType -> XPubSpec
XPubSpec {xPubSpecKey :: XPubKey
xPubSpecKey = XPubKey
x, xPubDeriveType :: DeriveType
xPubDeriveType = DeriveType
t}

type UnixTime = Word64
type BlockPos = Word32

-- | Serialize such that ordering is inverted.
putUnixTime :: Word64 -> Put
putUnixTime :: Word64 -> Put
putUnixTime w :: Word64
w = Word64 -> Put
putWord64be (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
w

getUnixTime :: Get Word64
getUnixTime :: Get Word64
getUnixTime = (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-) (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be

-- | Reference to a block where a transaction is stored.
data BlockRef
    = BlockRef
          { BlockRef -> Fingerprint
blockRefHeight :: !BlockHeight
    -- ^ block height in the chain
          , BlockRef -> Fingerprint
blockRefPos    :: !Word32
    -- ^ position of transaction within the block
          }
    | MemRef
          { BlockRef -> Word64
memRefTime :: !UnixTime
          }
    deriving (Int -> BlockRef -> ShowS
[BlockRef] -> ShowS
BlockRef -> String
(Int -> BlockRef -> ShowS)
-> (BlockRef -> String) -> ([BlockRef] -> ShowS) -> Show BlockRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockRef] -> ShowS
$cshowList :: [BlockRef] -> ShowS
show :: BlockRef -> String
$cshow :: BlockRef -> String
showsPrec :: Int -> BlockRef -> ShowS
$cshowsPrec :: Int -> BlockRef -> ShowS
Show, ReadPrec [BlockRef]
ReadPrec BlockRef
Int -> ReadS BlockRef
ReadS [BlockRef]
(Int -> ReadS BlockRef)
-> ReadS [BlockRef]
-> ReadPrec BlockRef
-> ReadPrec [BlockRef]
-> Read BlockRef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlockRef]
$creadListPrec :: ReadPrec [BlockRef]
readPrec :: ReadPrec BlockRef
$creadPrec :: ReadPrec BlockRef
readList :: ReadS [BlockRef]
$creadList :: ReadS [BlockRef]
readsPrec :: Int -> ReadS BlockRef
$creadsPrec :: Int -> ReadS BlockRef
Read, BlockRef -> BlockRef -> Bool
(BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool) -> Eq BlockRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockRef -> BlockRef -> Bool
$c/= :: BlockRef -> BlockRef -> Bool
== :: BlockRef -> BlockRef -> Bool
$c== :: BlockRef -> BlockRef -> Bool
Eq, Eq BlockRef
Eq BlockRef =>
(BlockRef -> BlockRef -> Ordering)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> Bool)
-> (BlockRef -> BlockRef -> BlockRef)
-> (BlockRef -> BlockRef -> BlockRef)
-> Ord BlockRef
BlockRef -> BlockRef -> Bool
BlockRef -> BlockRef -> Ordering
BlockRef -> BlockRef -> BlockRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockRef -> BlockRef -> BlockRef
$cmin :: BlockRef -> BlockRef -> BlockRef
max :: BlockRef -> BlockRef -> BlockRef
$cmax :: BlockRef -> BlockRef -> BlockRef
>= :: BlockRef -> BlockRef -> Bool
$c>= :: BlockRef -> BlockRef -> Bool
> :: BlockRef -> BlockRef -> Bool
$c> :: BlockRef -> BlockRef -> Bool
<= :: BlockRef -> BlockRef -> Bool
$c<= :: BlockRef -> BlockRef -> Bool
< :: BlockRef -> BlockRef -> Bool
$c< :: BlockRef -> BlockRef -> Bool
compare :: BlockRef -> BlockRef -> Ordering
$ccompare :: BlockRef -> BlockRef -> Ordering
$cp1Ord :: Eq BlockRef
Ord, (forall x. BlockRef -> Rep BlockRef x)
-> (forall x. Rep BlockRef x -> BlockRef) -> Generic BlockRef
forall x. Rep BlockRef x -> BlockRef
forall x. BlockRef -> Rep BlockRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockRef x -> BlockRef
$cfrom :: forall x. BlockRef -> Rep BlockRef x
Generic, Int -> BlockRef -> Int
BlockRef -> Int
(Int -> BlockRef -> Int) -> (BlockRef -> Int) -> Hashable BlockRef
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockRef -> Int
$chash :: BlockRef -> Int
hashWithSalt :: Int -> BlockRef -> Int
$chashWithSalt :: Int -> BlockRef -> Int
Hashable, BlockRef -> ()
(BlockRef -> ()) -> NFData BlockRef
forall a. (a -> ()) -> NFData a
rnf :: BlockRef -> ()
$crnf :: BlockRef -> ()
NFData)

-- | Serialized entities will sort in reverse order.
instance Serialize BlockRef where
    put :: Putter BlockRef
put MemRef {memRefTime :: BlockRef -> Word64
memRefTime = Word64
t} = do
        Putter Word8
putWord8 0x00
        Word64 -> Put
putUnixTime Word64
t
    put BlockRef {blockRefHeight :: BlockRef -> Fingerprint
blockRefHeight = Fingerprint
h, blockRefPos :: BlockRef -> Fingerprint
blockRefPos = Fingerprint
p} = do
        Putter Word8
putWord8 0x01
        Putter Fingerprint
putWord32be (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
- Fingerprint
h)
        Putter Fingerprint
putWord32be (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
- Fingerprint
p)
    get :: Get BlockRef
get = Get BlockRef
getmemref Get BlockRef -> Get BlockRef -> Get BlockRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Get BlockRef
getblockref
      where
        getmemref :: Get BlockRef
getmemref = do
            Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
            Word64 -> BlockRef
MemRef (Word64 -> BlockRef) -> Get Word64 -> Get BlockRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getUnixTime
        getblockref :: Get BlockRef
getblockref = do
            Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x01) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
            Fingerprint
h <- (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
-) (Fingerprint -> Fingerprint) -> Get Fingerprint -> Get Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Fingerprint
getWord32be
            Fingerprint
p <- (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
-) (Fingerprint -> Fingerprint) -> Get Fingerprint -> Get Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Fingerprint
getWord32be
            BlockRef -> Get BlockRef
forall (m :: * -> *) a. Monad m => a -> m a
return $WBlockRef :: Fingerprint -> Fingerprint -> BlockRef
BlockRef {blockRefHeight :: Fingerprint
blockRefHeight = Fingerprint
h, blockRefPos :: Fingerprint
blockRefPos = Fingerprint
p}

confirmed :: BlockRef -> Bool
confirmed :: BlockRef -> Bool
confirmed BlockRef {} = Bool
True
confirmed MemRef {}   = Bool
False

instance ToJSON BlockRef where
    toJSON :: BlockRef -> Value
toJSON BlockRef {blockRefHeight :: BlockRef -> Fingerprint
blockRefHeight = Fingerprint
h, blockRefPos :: BlockRef -> Fingerprint
blockRefPos = Fingerprint
p} =
        [Pair] -> Value
object ["height" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
h, "position" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
p]
    toJSON MemRef {memRefTime :: BlockRef -> Word64
memRefTime = Word64
t} = [Pair] -> Value
object ["mempool" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
t]
    toEncoding :: BlockRef -> Encoding
toEncoding BlockRef {blockRefHeight :: BlockRef -> Fingerprint
blockRefHeight = Fingerprint
h, blockRefPos :: BlockRef -> Fingerprint
blockRefPos = Fingerprint
p} =
        Series -> Encoding
pairs ("height" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
h Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "position" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
p)
    toEncoding MemRef {memRefTime :: BlockRef -> Word64
memRefTime = Word64
t} = Series -> Encoding
pairs ("mempool" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
t)

instance FromJSON BlockRef where
    parseJSON :: Value -> Parser BlockRef
parseJSON = String -> (Object -> Parser BlockRef) -> Value -> Parser BlockRef
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "blockref" ((Object -> Parser BlockRef) -> Value -> Parser BlockRef)
-> (Object -> Parser BlockRef) -> Value -> Parser BlockRef
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Object -> Parser BlockRef
b Object
o Parser BlockRef -> Parser BlockRef -> Parser BlockRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser BlockRef
m Object
o
      where
        b :: Object -> Parser BlockRef
b o :: Object
o = do
            Fingerprint
height <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "height"
            Fingerprint
position <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "position"
            BlockRef -> Parser BlockRef
forall (m :: * -> *) a. Monad m => a -> m a
return $WBlockRef :: Fingerprint -> Fingerprint -> BlockRef
BlockRef{blockRefHeight :: Fingerprint
blockRefHeight = Fingerprint
height, blockRefPos :: Fingerprint
blockRefPos = Fingerprint
position}
        m :: Object -> Parser BlockRef
m o :: Object
o = do
            Word64
mempool <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "mempool"
            BlockRef -> Parser BlockRef
forall (m :: * -> *) a. Monad m => a -> m a
return $WMemRef :: Word64 -> BlockRef
MemRef{memRefTime :: Word64
memRefTime = Word64
mempool}

-- | Transaction in relation to an address.
data TxRef =
    TxRef
        { TxRef -> BlockRef
txRefBlock :: !BlockRef
    -- ^ block information
        , TxRef -> TxHash
txRefHash  :: !TxHash
    -- ^ transaction hash
        }
    deriving (Int -> TxRef -> ShowS
[TxRef] -> ShowS
TxRef -> String
(Int -> TxRef -> ShowS)
-> (TxRef -> String) -> ([TxRef] -> ShowS) -> Show TxRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxRef] -> ShowS
$cshowList :: [TxRef] -> ShowS
show :: TxRef -> String
$cshow :: TxRef -> String
showsPrec :: Int -> TxRef -> ShowS
$cshowsPrec :: Int -> TxRef -> ShowS
Show, TxRef -> TxRef -> Bool
(TxRef -> TxRef -> Bool) -> (TxRef -> TxRef -> Bool) -> Eq TxRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxRef -> TxRef -> Bool
$c/= :: TxRef -> TxRef -> Bool
== :: TxRef -> TxRef -> Bool
$c== :: TxRef -> TxRef -> Bool
Eq, Eq TxRef
Eq TxRef =>
(TxRef -> TxRef -> Ordering)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> TxRef)
-> (TxRef -> TxRef -> TxRef)
-> Ord TxRef
TxRef -> TxRef -> Bool
TxRef -> TxRef -> Ordering
TxRef -> TxRef -> TxRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxRef -> TxRef -> TxRef
$cmin :: TxRef -> TxRef -> TxRef
max :: TxRef -> TxRef -> TxRef
$cmax :: TxRef -> TxRef -> TxRef
>= :: TxRef -> TxRef -> Bool
$c>= :: TxRef -> TxRef -> Bool
> :: TxRef -> TxRef -> Bool
$c> :: TxRef -> TxRef -> Bool
<= :: TxRef -> TxRef -> Bool
$c<= :: TxRef -> TxRef -> Bool
< :: TxRef -> TxRef -> Bool
$c< :: TxRef -> TxRef -> Bool
compare :: TxRef -> TxRef -> Ordering
$ccompare :: TxRef -> TxRef -> Ordering
$cp1Ord :: Eq TxRef
Ord, (forall x. TxRef -> Rep TxRef x)
-> (forall x. Rep TxRef x -> TxRef) -> Generic TxRef
forall x. Rep TxRef x -> TxRef
forall x. TxRef -> Rep TxRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxRef x -> TxRef
$cfrom :: forall x. TxRef -> Rep TxRef x
Generic, Get TxRef
Putter TxRef
Putter TxRef -> Get TxRef -> Serialize TxRef
forall t. Putter t -> Get t -> Serialize t
get :: Get TxRef
$cget :: Get TxRef
put :: Putter TxRef
$cput :: Putter TxRef
Serialize, Int -> TxRef -> Int
TxRef -> Int
(Int -> TxRef -> Int) -> (TxRef -> Int) -> Hashable TxRef
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TxRef -> Int
$chash :: TxRef -> Int
hashWithSalt :: Int -> TxRef -> Int
$chashWithSalt :: Int -> TxRef -> Int
Hashable, TxRef -> ()
(TxRef -> ()) -> NFData TxRef
forall a. (a -> ()) -> NFData a
rnf :: TxRef -> ()
$crnf :: TxRef -> ()
NFData)

instance ToJSON TxRef where
    toJSON :: TxRef -> Value
toJSON btx :: TxRef
btx = [Pair] -> Value
object ["txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxRef -> TxHash
txRefHash TxRef
btx, "block" Text -> BlockRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxRef -> BlockRef
txRefBlock TxRef
btx]
    toEncoding :: TxRef -> Encoding
toEncoding btx :: TxRef
btx =
        Series -> Encoding
pairs
            (  "txid" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxRef -> TxHash
txRefHash TxRef
btx
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "block" Text -> BlockRef -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxRef -> BlockRef
txRefBlock TxRef
btx
            )

instance FromJSON TxRef where
    parseJSON :: Value -> Parser TxRef
parseJSON =
        String -> (Object -> Parser TxRef) -> Value -> Parser TxRef
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "blocktx" ((Object -> Parser TxRef) -> Value -> Parser TxRef)
-> (Object -> Parser TxRef) -> Value -> Parser TxRef
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            TxHash
txid <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid"
            BlockRef
block <- Object
o Object -> Text -> Parser BlockRef
forall a. FromJSON a => Object -> Text -> Parser a
.: "block"
            TxRef -> Parser TxRef
forall (m :: * -> *) a. Monad m => a -> m a
return $WTxRef :: BlockRef -> TxHash -> TxRef
TxRef {txRefBlock :: BlockRef
txRefBlock = BlockRef
block, txRefHash :: TxHash
txRefHash = TxHash
txid}

-- | Address balance information.
data Balance =
    Balance
        { Balance -> Address
balanceAddress       :: !Address
        -- ^ address balance
        , Balance -> Word64
balanceAmount        :: !Word64
        -- ^ confirmed balance
        , Balance -> Word64
balanceZero          :: !Word64
        -- ^ unconfirmed balance
        , Balance -> Word64
balanceUnspentCount  :: !Word64
        -- ^ number of unspent outputs
        , Balance -> Word64
balanceTxCount       :: !Word64
        -- ^ number of transactions
        , Balance -> Word64
balanceTotalReceived :: !Word64
        -- ^ total amount from all outputs in this address
        }
    deriving (Int -> Balance -> ShowS
[Balance] -> ShowS
Balance -> String
(Int -> Balance -> ShowS)
-> (Balance -> String) -> ([Balance] -> ShowS) -> Show Balance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Balance] -> ShowS
$cshowList :: [Balance] -> ShowS
show :: Balance -> String
$cshow :: Balance -> String
showsPrec :: Int -> Balance -> ShowS
$cshowsPrec :: Int -> Balance -> ShowS
Show, ReadPrec [Balance]
ReadPrec Balance
Int -> ReadS Balance
ReadS [Balance]
(Int -> ReadS Balance)
-> ReadS [Balance]
-> ReadPrec Balance
-> ReadPrec [Balance]
-> Read Balance
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Balance]
$creadListPrec :: ReadPrec [Balance]
readPrec :: ReadPrec Balance
$creadPrec :: ReadPrec Balance
readList :: ReadS [Balance]
$creadList :: ReadS [Balance]
readsPrec :: Int -> ReadS Balance
$creadsPrec :: Int -> ReadS Balance
Read, Balance -> Balance -> Bool
(Balance -> Balance -> Bool)
-> (Balance -> Balance -> Bool) -> Eq Balance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Balance -> Balance -> Bool
$c/= :: Balance -> Balance -> Bool
== :: Balance -> Balance -> Bool
$c== :: Balance -> Balance -> Bool
Eq, Eq Balance
Eq Balance =>
(Balance -> Balance -> Ordering)
-> (Balance -> Balance -> Bool)
-> (Balance -> Balance -> Bool)
-> (Balance -> Balance -> Bool)
-> (Balance -> Balance -> Bool)
-> (Balance -> Balance -> Balance)
-> (Balance -> Balance -> Balance)
-> Ord Balance
Balance -> Balance -> Bool
Balance -> Balance -> Ordering
Balance -> Balance -> Balance
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Balance -> Balance -> Balance
$cmin :: Balance -> Balance -> Balance
max :: Balance -> Balance -> Balance
$cmax :: Balance -> Balance -> Balance
>= :: Balance -> Balance -> Bool
$c>= :: Balance -> Balance -> Bool
> :: Balance -> Balance -> Bool
$c> :: Balance -> Balance -> Bool
<= :: Balance -> Balance -> Bool
$c<= :: Balance -> Balance -> Bool
< :: Balance -> Balance -> Bool
$c< :: Balance -> Balance -> Bool
compare :: Balance -> Balance -> Ordering
$ccompare :: Balance -> Balance -> Ordering
$cp1Ord :: Eq Balance
Ord, (forall x. Balance -> Rep Balance x)
-> (forall x. Rep Balance x -> Balance) -> Generic Balance
forall x. Rep Balance x -> Balance
forall x. Balance -> Rep Balance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Balance x -> Balance
$cfrom :: forall x. Balance -> Rep Balance x
Generic, Get Balance
Putter Balance
Putter Balance -> Get Balance -> Serialize Balance
forall t. Putter t -> Get t -> Serialize t
get :: Get Balance
$cget :: Get Balance
put :: Putter Balance
$cput :: Putter Balance
Serialize, Int -> Balance -> Int
Balance -> Int
(Int -> Balance -> Int) -> (Balance -> Int) -> Hashable Balance
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Balance -> Int
$chash :: Balance -> Int
hashWithSalt :: Int -> Balance -> Int
$chashWithSalt :: Int -> Balance -> Int
Hashable, Balance -> ()
(Balance -> ()) -> NFData Balance
forall a. (a -> ()) -> NFData a
rnf :: Balance -> ()
$crnf :: Balance -> ()
NFData)

zeroBalance :: Address -> Balance
zeroBalance :: Address -> Balance
zeroBalance a :: Address
a =
    $WBalance :: Address
-> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Balance
Balance
        { balanceAddress :: Address
balanceAddress = Address
a
        , balanceAmount :: Word64
balanceAmount = 0
        , balanceUnspentCount :: Word64
balanceUnspentCount = 0
        , balanceZero :: Word64
balanceZero = 0
        , balanceTxCount :: Word64
balanceTxCount = 0
        , balanceTotalReceived :: Word64
balanceTotalReceived = 0
        }

nullBalance :: Balance -> Bool
nullBalance :: Balance -> Bool
nullBalance Balance { balanceAmount :: Balance -> Word64
balanceAmount = Word64
0
                    , balanceUnspentCount :: Balance -> Word64
balanceUnspentCount = Word64
0
                    , balanceZero :: Balance -> Word64
balanceZero = Word64
0
                    , balanceTxCount :: Balance -> Word64
balanceTxCount = Word64
0
                    , balanceTotalReceived :: Balance -> Word64
balanceTotalReceived = Word64
0
                    } = Bool
True
nullBalance _ = Bool
False

balanceToJSON :: Network -> Balance -> Value
balanceToJSON :: Network -> Balance -> Value
balanceToJSON net :: Network
net b :: Balance
b =
        [Pair] -> Value
object
        [ "address" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> Address -> Value
addrToJSON Network
net (Balance -> Address
balanceAddress Balance
b)
        , "confirmed" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceAmount Balance
b
        , "unconfirmed" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceZero Balance
b
        , "utxo" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceUnspentCount Balance
b
        , "txs" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceTxCount Balance
b
        , "received" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceTotalReceived Balance
b
        ]

balanceToEncoding :: Network -> Balance -> Encoding
balanceToEncoding :: Network -> Balance -> Encoding
balanceToEncoding net :: Network
net b :: Balance
b =
    Series -> Encoding
pairs
        (  "address" Text -> Encoding -> Series
`pair` Network -> Address -> Encoding
addrToEncoding Network
net (Balance -> Address
balanceAddress Balance
b)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "confirmed" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceAmount Balance
b
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "unconfirmed" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceZero Balance
b
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "utxo" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceUnspentCount Balance
b
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "txs" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceTxCount Balance
b
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "received" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Balance -> Word64
balanceTotalReceived Balance
b
        )

balanceParseJSON :: Network -> Value -> Parser Balance
balanceParseJSON :: Network -> Value -> Parser Balance
balanceParseJSON net :: Network
net =
    String -> (Object -> Parser Balance) -> Value -> Parser Balance
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "balance" ((Object -> Parser Balance) -> Value -> Parser Balance)
-> (Object -> Parser Balance) -> Value -> Parser Balance
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Word64
amount <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "confirmed"
        Word64
unconfirmed <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "unconfirmed"
        Word64
utxo <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "utxo"
        Word64
txs <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "txs"
        Word64
received <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "received"
        Address
address <- Network -> Value -> Parser Address
addrFromJSON Network
net (Value -> Parser Address) -> Parser Value -> Parser Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "address"
        Balance -> Parser Balance
forall (m :: * -> *) a. Monad m => a -> m a
return
            $WBalance :: Address
-> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Balance
Balance
                { balanceAddress :: Address
balanceAddress = Address
address
                , balanceAmount :: Word64
balanceAmount = Word64
amount
                , balanceUnspentCount :: Word64
balanceUnspentCount = Word64
utxo
                , balanceZero :: Word64
balanceZero = Word64
unconfirmed
                , balanceTxCount :: Word64
balanceTxCount = Word64
txs
                , balanceTotalReceived :: Word64
balanceTotalReceived = Word64
received
                }

-- | Unspent output.
data Unspent =
    Unspent
        { Unspent -> BlockRef
unspentBlock   :: !BlockRef
        , Unspent -> OutPoint
unspentPoint   :: !OutPoint
        , Unspent -> Word64
unspentAmount  :: !Word64
        , Unspent -> ShortByteString
unspentScript  :: !ShortByteString
        , Unspent -> Maybe Address
unspentAddress :: !(Maybe Address)
        }
    deriving (Int -> Unspent -> ShowS
[Unspent] -> ShowS
Unspent -> String
(Int -> Unspent -> ShowS)
-> (Unspent -> String) -> ([Unspent] -> ShowS) -> Show Unspent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unspent] -> ShowS
$cshowList :: [Unspent] -> ShowS
show :: Unspent -> String
$cshow :: Unspent -> String
showsPrec :: Int -> Unspent -> ShowS
$cshowsPrec :: Int -> Unspent -> ShowS
Show, Unspent -> Unspent -> Bool
(Unspent -> Unspent -> Bool)
-> (Unspent -> Unspent -> Bool) -> Eq Unspent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unspent -> Unspent -> Bool
$c/= :: Unspent -> Unspent -> Bool
== :: Unspent -> Unspent -> Bool
$c== :: Unspent -> Unspent -> Bool
Eq, Eq Unspent
Eq Unspent =>
(Unspent -> Unspent -> Ordering)
-> (Unspent -> Unspent -> Bool)
-> (Unspent -> Unspent -> Bool)
-> (Unspent -> Unspent -> Bool)
-> (Unspent -> Unspent -> Bool)
-> (Unspent -> Unspent -> Unspent)
-> (Unspent -> Unspent -> Unspent)
-> Ord Unspent
Unspent -> Unspent -> Bool
Unspent -> Unspent -> Ordering
Unspent -> Unspent -> Unspent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Unspent -> Unspent -> Unspent
$cmin :: Unspent -> Unspent -> Unspent
max :: Unspent -> Unspent -> Unspent
$cmax :: Unspent -> Unspent -> Unspent
>= :: Unspent -> Unspent -> Bool
$c>= :: Unspent -> Unspent -> Bool
> :: Unspent -> Unspent -> Bool
$c> :: Unspent -> Unspent -> Bool
<= :: Unspent -> Unspent -> Bool
$c<= :: Unspent -> Unspent -> Bool
< :: Unspent -> Unspent -> Bool
$c< :: Unspent -> Unspent -> Bool
compare :: Unspent -> Unspent -> Ordering
$ccompare :: Unspent -> Unspent -> Ordering
$cp1Ord :: Eq Unspent
Ord, (forall x. Unspent -> Rep Unspent x)
-> (forall x. Rep Unspent x -> Unspent) -> Generic Unspent
forall x. Rep Unspent x -> Unspent
forall x. Unspent -> Rep Unspent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Unspent x -> Unspent
$cfrom :: forall x. Unspent -> Rep Unspent x
Generic, Int -> Unspent -> Int
Unspent -> Int
(Int -> Unspent -> Int) -> (Unspent -> Int) -> Hashable Unspent
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Unspent -> Int
$chash :: Unspent -> Int
hashWithSalt :: Int -> Unspent -> Int
$chashWithSalt :: Int -> Unspent -> Int
Hashable, Get Unspent
Putter Unspent
Putter Unspent -> Get Unspent -> Serialize Unspent
forall t. Putter t -> Get t -> Serialize t
get :: Get Unspent
$cget :: Get Unspent
put :: Putter Unspent
$cput :: Putter Unspent
Serialize, Unspent -> ()
(Unspent -> ()) -> NFData Unspent
forall a. (a -> ()) -> NFData a
rnf :: Unspent -> ()
$crnf :: Unspent -> ()
NFData)

instance Coin Unspent where
    coinValue :: Unspent -> Word64
coinValue = Unspent -> Word64
unspentAmount

unspentToJSON :: Network -> Unspent -> Value
unspentToJSON :: Network -> Unspent -> Value
unspentToJSON net :: Network
net u :: Unspent
u =
    [Pair] -> Value
object
        [ "address" Text -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Network -> Address -> Value
addrToJSON Network
net (Address -> Value) -> Maybe Address -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unspent -> Maybe Address
unspentAddress Unspent
u)
        , "block" Text -> BlockRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Unspent -> BlockRef
unspentBlock Unspent
u
        , "txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OutPoint -> TxHash
outPointHash (Unspent -> OutPoint
unspentPoint Unspent
u)
        , "index" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OutPoint -> Fingerprint
outPointIndex (Unspent -> OutPoint
unspentPoint Unspent
u)
        , "pkscript" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
script
        , "value" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Unspent -> Word64
unspentAmount Unspent
u
        ]
  where
    bsscript :: ByteString
bsscript = ShortByteString -> ByteString
BSS.fromShort (Unspent -> ShortByteString
unspentScript Unspent
u)
    script :: Text
script = ByteString -> Text
encodeHex ByteString
bsscript

unspentToEncoding :: Network -> Unspent -> Encoding
unspentToEncoding :: Network -> Unspent -> Encoding
unspentToEncoding net :: Network
net u :: Unspent
u =
    Series -> Encoding
pairs
        (  "address" Text -> Encoding -> Series
`pair` Encoding -> (Address -> Encoding) -> Maybe Address -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
null_ (Network -> Address -> Encoding
addrToEncoding Network
net) (Unspent -> Maybe Address
unspentAddress Unspent
u)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "block" Text -> BlockRef -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Unspent -> BlockRef
unspentBlock Unspent
u
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "txid" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OutPoint -> TxHash
outPointHash (Unspent -> OutPoint
unspentPoint Unspent
u)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "index" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OutPoint -> Fingerprint
outPointIndex (Unspent -> OutPoint
unspentPoint Unspent
u)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "pkscript" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text Text
script
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "value" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Unspent -> Word64
unspentAmount Unspent
u
        )
  where
    bsscript :: ByteString
bsscript = ShortByteString -> ByteString
BSS.fromShort (Unspent -> ShortByteString
unspentScript Unspent
u)
    script :: Text
script = ByteString -> Text
encodeHex ByteString
bsscript

unspentParseJSON :: Network -> Value -> Parser Unspent
unspentParseJSON :: Network -> Value -> Parser Unspent
unspentParseJSON net :: Network
net =
    String -> (Object -> Parser Unspent) -> Value -> Parser Unspent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "unspent" ((Object -> Parser Unspent) -> Value -> Parser Unspent)
-> (Object -> Parser Unspent) -> Value -> Parser Unspent
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        BlockRef
block <- Object
o Object -> Text -> Parser BlockRef
forall a. FromJSON a => Object -> Text -> Parser a
.: "block"
        TxHash
txid <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid"
        Fingerprint
index <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "index"
        Word64
value <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
        ShortByteString
script <- ByteString -> ShortByteString
BSS.toShort (ByteString -> ShortByteString)
-> Parser ByteString -> Parser ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "pkscript" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
jsonHex)
        Maybe Address
addr <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: "address" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Nothing -> Maybe Address -> Parser (Maybe Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing
            Just a :: Value
a -> Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address)
-> Parser Address -> Parser (Maybe Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Value -> Parser Address
addrFromJSON Network
net Value
a Parser (Maybe Address)
-> Parser (Maybe Address) -> Parser (Maybe Address)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Address -> Parser (Maybe Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing
        Unspent -> Parser Unspent
forall (m :: * -> *) a. Monad m => a -> m a
return
            $WUnspent :: BlockRef
-> OutPoint
-> Word64
-> ShortByteString
-> Maybe Address
-> Unspent
Unspent
                { unspentBlock :: BlockRef
unspentBlock = BlockRef
block
                , unspentPoint :: OutPoint
unspentPoint = TxHash -> Fingerprint -> OutPoint
OutPoint TxHash
txid Fingerprint
index
                , unspentAmount :: Word64
unspentAmount = Word64
value
                , unspentScript :: ShortByteString
unspentScript = ShortByteString
script
                , unspentAddress :: Maybe Address
unspentAddress = Maybe Address
addr
                }

-- | Database value for a block entry.
data BlockData =
    BlockData
        { BlockData -> Fingerprint
blockDataHeight    :: !BlockHeight
        -- ^ height of the block in the chain
        , BlockData -> Bool
blockDataMainChain :: !Bool
        -- ^ is this block in the main chain?
        , BlockData -> BlockWork
blockDataWork      :: !BlockWork
        -- ^ accumulated work in that block
        , BlockData -> BlockHeader
blockDataHeader    :: !BlockHeader
        -- ^ block header
        , BlockData -> Fingerprint
blockDataSize      :: !Word32
        -- ^ size of the block including witnesses
        , BlockData -> Fingerprint
blockDataWeight    :: !Word32
        -- ^ weight of this block (for segwit networks)
        , BlockData -> [TxHash]
blockDataTxs       :: ![TxHash]
        -- ^ block transactions
        , BlockData -> Word64
blockDataOutputs   :: !Word64
        -- ^ sum of all transaction outputs
        , BlockData -> Word64
blockDataFees      :: !Word64
        -- ^ sum of all transaction fees
        , BlockData -> Word64
blockDataSubsidy   :: !Word64
        -- ^ block subsidy
        }
    deriving (Int -> BlockData -> ShowS
[BlockData] -> ShowS
BlockData -> String
(Int -> BlockData -> ShowS)
-> (BlockData -> String)
-> ([BlockData] -> ShowS)
-> Show BlockData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockData] -> ShowS
$cshowList :: [BlockData] -> ShowS
show :: BlockData -> String
$cshow :: BlockData -> String
showsPrec :: Int -> BlockData -> ShowS
$cshowsPrec :: Int -> BlockData -> ShowS
Show, ReadPrec [BlockData]
ReadPrec BlockData
Int -> ReadS BlockData
ReadS [BlockData]
(Int -> ReadS BlockData)
-> ReadS [BlockData]
-> ReadPrec BlockData
-> ReadPrec [BlockData]
-> Read BlockData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlockData]
$creadListPrec :: ReadPrec [BlockData]
readPrec :: ReadPrec BlockData
$creadPrec :: ReadPrec BlockData
readList :: ReadS [BlockData]
$creadList :: ReadS [BlockData]
readsPrec :: Int -> ReadS BlockData
$creadsPrec :: Int -> ReadS BlockData
Read, BlockData -> BlockData -> Bool
(BlockData -> BlockData -> Bool)
-> (BlockData -> BlockData -> Bool) -> Eq BlockData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockData -> BlockData -> Bool
$c/= :: BlockData -> BlockData -> Bool
== :: BlockData -> BlockData -> Bool
$c== :: BlockData -> BlockData -> Bool
Eq, Eq BlockData
Eq BlockData =>
(BlockData -> BlockData -> Ordering)
-> (BlockData -> BlockData -> Bool)
-> (BlockData -> BlockData -> Bool)
-> (BlockData -> BlockData -> Bool)
-> (BlockData -> BlockData -> Bool)
-> (BlockData -> BlockData -> BlockData)
-> (BlockData -> BlockData -> BlockData)
-> Ord BlockData
BlockData -> BlockData -> Bool
BlockData -> BlockData -> Ordering
BlockData -> BlockData -> BlockData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockData -> BlockData -> BlockData
$cmin :: BlockData -> BlockData -> BlockData
max :: BlockData -> BlockData -> BlockData
$cmax :: BlockData -> BlockData -> BlockData
>= :: BlockData -> BlockData -> Bool
$c>= :: BlockData -> BlockData -> Bool
> :: BlockData -> BlockData -> Bool
$c> :: BlockData -> BlockData -> Bool
<= :: BlockData -> BlockData -> Bool
$c<= :: BlockData -> BlockData -> Bool
< :: BlockData -> BlockData -> Bool
$c< :: BlockData -> BlockData -> Bool
compare :: BlockData -> BlockData -> Ordering
$ccompare :: BlockData -> BlockData -> Ordering
$cp1Ord :: Eq BlockData
Ord, (forall x. BlockData -> Rep BlockData x)
-> (forall x. Rep BlockData x -> BlockData) -> Generic BlockData
forall x. Rep BlockData x -> BlockData
forall x. BlockData -> Rep BlockData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockData x -> BlockData
$cfrom :: forall x. BlockData -> Rep BlockData x
Generic, Get BlockData
Putter BlockData
Putter BlockData -> Get BlockData -> Serialize BlockData
forall t. Putter t -> Get t -> Serialize t
get :: Get BlockData
$cget :: Get BlockData
put :: Putter BlockData
$cput :: Putter BlockData
Serialize, Int -> BlockData -> Int
BlockData -> Int
(Int -> BlockData -> Int)
-> (BlockData -> Int) -> Hashable BlockData
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockData -> Int
$chash :: BlockData -> Int
hashWithSalt :: Int -> BlockData -> Int
$chashWithSalt :: Int -> BlockData -> Int
Hashable, BlockData -> ()
(BlockData -> ()) -> NFData BlockData
forall a. (a -> ()) -> NFData a
rnf :: BlockData -> ()
$crnf :: BlockData -> ()
NFData)

blockDataToJSON :: Network -> BlockData -> Value
blockDataToJSON :: Network -> BlockData -> Value
blockDataToJSON net :: Network
net bv :: BlockData
bv =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "hash" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> BlockHash
headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
    , "height" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Fingerprint
blockDataHeight BlockData
bv
    , "mainchain" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Bool
blockDataMainChain BlockData
bv
    , "previous" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
    , "time" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
blockTimestamp (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
    , "version" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
blockVersion (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
    , "bits" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
blockBits (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
    , "nonce" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
bhNonce (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
    , "size" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Fingerprint
blockDataSize BlockData
bv
    , "tx" Text -> [TxHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> [TxHash]
blockDataTxs BlockData
bv
    , "merkle" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChainCode -> TxHash
TxHash (BlockHeader -> ChainCode
merkleRoot (BlockData -> BlockHeader
blockDataHeader BlockData
bv))
    , "subsidy" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Word64
blockDataSubsidy BlockData
bv
    , "fees" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Word64
blockDataFees BlockData
bv
    , "outputs" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Word64
blockDataOutputs BlockData
bv
    , "work" Text -> BlockWork -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> BlockWork
blockDataWork BlockData
bv
    ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
    ["weight" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Fingerprint
blockDataWeight BlockData
bv | Network -> Bool
getSegWit Network
net]

blockDataToEncoding :: Network -> BlockData -> Encoding
blockDataToEncoding :: Network -> BlockData -> Encoding
blockDataToEncoding net :: Network
net bv :: BlockData
bv =
    Series -> Encoding
pairs
        (  "hash" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
bv)))
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "height" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Fingerprint
blockDataHeight BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "mainchain" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Bool
blockDataMainChain BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "previous" Text -> BlockHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "time" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
blockTimestamp (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "version" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
blockVersion (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "bits" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
blockBits (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "nonce" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHeader -> Fingerprint
bhNonce (BlockData -> BlockHeader
blockDataHeader BlockData
bv)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "size" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Fingerprint
blockDataSize BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "tx" Text -> [TxHash] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> [TxHash]
blockDataTxs BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "merkle" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (TxHash -> Text
txHashToHex (ChainCode -> TxHash
TxHash (BlockHeader -> ChainCode
merkleRoot (BlockData -> BlockHeader
blockDataHeader BlockData
bv))))
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "subsidy" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Word64
blockDataSubsidy BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "fees" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Word64
blockDataFees BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "outputs" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Word64
blockDataOutputs BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "work" Text -> BlockWork -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> BlockWork
blockDataWork BlockData
bv
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> (if Network -> Bool
getSegWit Network
net then "weight" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockData -> Fingerprint
blockDataWeight BlockData
bv else Series
forall a. Monoid a => a
mempty)
        )

instance FromJSON BlockData where
    parseJSON :: Value -> Parser BlockData
parseJSON =
        String -> (Object -> Parser BlockData) -> Value -> Parser BlockData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "blockdata" ((Object -> Parser BlockData) -> Value -> Parser BlockData)
-> (Object -> Parser BlockData) -> Value -> Parser BlockData
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Fingerprint
height <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "height"
            Bool
mainchain <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "mainchain"
            BlockHash
previous <- Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "previous"
            Fingerprint
time <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "time"
            Fingerprint
version <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
            Fingerprint
bits <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "bits"
            Fingerprint
nonce <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "nonce"
            Fingerprint
size <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
            [TxHash]
tx <- Object
o Object -> Text -> Parser [TxHash]
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx"
            TxHash merkle :: ChainCode
merkle <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "merkle"
            Word64
subsidy <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "subsidy"
            Word64
fees <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "fees"
            Word64
outputs <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "outputs"
            BlockWork
work <- Object
o Object -> Text -> Parser BlockWork
forall a. FromJSON a => Object -> Text -> Parser a
.: "work"
            Fingerprint
weight <- Object
o Object -> Text -> Parser (Maybe Fingerprint)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "weight" Parser (Maybe Fingerprint) -> Fingerprint -> Parser Fingerprint
forall a. Parser (Maybe a) -> a -> Parser a
.!= 0
            BlockData -> Parser BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return
                $WBlockData :: Fingerprint
-> Bool
-> BlockWork
-> BlockHeader
-> Fingerprint
-> Fingerprint
-> [TxHash]
-> Word64
-> Word64
-> Word64
-> BlockData
BlockData
                    { blockDataHeader :: BlockHeader
blockDataHeader =
                          $WBlockHeader :: Fingerprint
-> BlockHash
-> ChainCode
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> BlockHeader
BlockHeader
                              { prevBlock :: BlockHash
prevBlock = BlockHash
previous
                              , blockTimestamp :: Fingerprint
blockTimestamp = Fingerprint
time
                              , blockVersion :: Fingerprint
blockVersion = Fingerprint
version
                              , blockBits :: Fingerprint
blockBits = Fingerprint
bits
                              , bhNonce :: Fingerprint
bhNonce = Fingerprint
nonce
                              , merkleRoot :: ChainCode
merkleRoot = ChainCode
merkle
                              }
                    , blockDataMainChain :: Bool
blockDataMainChain = Bool
mainchain
                    , blockDataWork :: BlockWork
blockDataWork = BlockWork
work
                    , blockDataSize :: Fingerprint
blockDataSize = Fingerprint
size
                    , blockDataWeight :: Fingerprint
blockDataWeight = Fingerprint
weight
                    , blockDataTxs :: [TxHash]
blockDataTxs = [TxHash]
tx
                    , blockDataOutputs :: Word64
blockDataOutputs = Word64
outputs
                    , blockDataFees :: Word64
blockDataFees = Word64
fees
                    , blockDataHeight :: Fingerprint
blockDataHeight = Fingerprint
height
                    , blockDataSubsidy :: Word64
blockDataSubsidy = Word64
subsidy
                    }

data StoreInput
    = StoreCoinbase
          { StoreInput -> OutPoint
inputPoint     :: !OutPoint
          , StoreInput -> Fingerprint
inputSequence  :: !Word32
          , StoreInput -> ByteString
inputSigScript :: !ByteString
          , StoreInput -> WitnessStack
inputWitness   :: !WitnessStack
          }
    | StoreInput
          { inputPoint     :: !OutPoint
          , inputSequence  :: !Word32
          , inputSigScript :: !ByteString
          , StoreInput -> ByteString
inputPkScript  :: !ByteString
          , StoreInput -> Word64
inputAmount    :: !Word64
          , inputWitness   :: !WitnessStack
          , StoreInput -> Maybe Address
inputAddress   :: !(Maybe Address)
          }
    deriving (Int -> StoreInput -> ShowS
[StoreInput] -> ShowS
StoreInput -> String
(Int -> StoreInput -> ShowS)
-> (StoreInput -> String)
-> ([StoreInput] -> ShowS)
-> Show StoreInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreInput] -> ShowS
$cshowList :: [StoreInput] -> ShowS
show :: StoreInput -> String
$cshow :: StoreInput -> String
showsPrec :: Int -> StoreInput -> ShowS
$cshowsPrec :: Int -> StoreInput -> ShowS
Show, ReadPrec [StoreInput]
ReadPrec StoreInput
Int -> ReadS StoreInput
ReadS [StoreInput]
(Int -> ReadS StoreInput)
-> ReadS [StoreInput]
-> ReadPrec StoreInput
-> ReadPrec [StoreInput]
-> Read StoreInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StoreInput]
$creadListPrec :: ReadPrec [StoreInput]
readPrec :: ReadPrec StoreInput
$creadPrec :: ReadPrec StoreInput
readList :: ReadS [StoreInput]
$creadList :: ReadS [StoreInput]
readsPrec :: Int -> ReadS StoreInput
$creadsPrec :: Int -> ReadS StoreInput
Read, StoreInput -> StoreInput -> Bool
(StoreInput -> StoreInput -> Bool)
-> (StoreInput -> StoreInput -> Bool) -> Eq StoreInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreInput -> StoreInput -> Bool
$c/= :: StoreInput -> StoreInput -> Bool
== :: StoreInput -> StoreInput -> Bool
$c== :: StoreInput -> StoreInput -> Bool
Eq, Eq StoreInput
Eq StoreInput =>
(StoreInput -> StoreInput -> Ordering)
-> (StoreInput -> StoreInput -> Bool)
-> (StoreInput -> StoreInput -> Bool)
-> (StoreInput -> StoreInput -> Bool)
-> (StoreInput -> StoreInput -> Bool)
-> (StoreInput -> StoreInput -> StoreInput)
-> (StoreInput -> StoreInput -> StoreInput)
-> Ord StoreInput
StoreInput -> StoreInput -> Bool
StoreInput -> StoreInput -> Ordering
StoreInput -> StoreInput -> StoreInput
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StoreInput -> StoreInput -> StoreInput
$cmin :: StoreInput -> StoreInput -> StoreInput
max :: StoreInput -> StoreInput -> StoreInput
$cmax :: StoreInput -> StoreInput -> StoreInput
>= :: StoreInput -> StoreInput -> Bool
$c>= :: StoreInput -> StoreInput -> Bool
> :: StoreInput -> StoreInput -> Bool
$c> :: StoreInput -> StoreInput -> Bool
<= :: StoreInput -> StoreInput -> Bool
$c<= :: StoreInput -> StoreInput -> Bool
< :: StoreInput -> StoreInput -> Bool
$c< :: StoreInput -> StoreInput -> Bool
compare :: StoreInput -> StoreInput -> Ordering
$ccompare :: StoreInput -> StoreInput -> Ordering
$cp1Ord :: Eq StoreInput
Ord, (forall x. StoreInput -> Rep StoreInput x)
-> (forall x. Rep StoreInput x -> StoreInput) -> Generic StoreInput
forall x. Rep StoreInput x -> StoreInput
forall x. StoreInput -> Rep StoreInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StoreInput x -> StoreInput
$cfrom :: forall x. StoreInput -> Rep StoreInput x
Generic, Get StoreInput
Putter StoreInput
Putter StoreInput -> Get StoreInput -> Serialize StoreInput
forall t. Putter t -> Get t -> Serialize t
get :: Get StoreInput
$cget :: Get StoreInput
put :: Putter StoreInput
$cput :: Putter StoreInput
Serialize, Int -> StoreInput -> Int
StoreInput -> Int
(Int -> StoreInput -> Int)
-> (StoreInput -> Int) -> Hashable StoreInput
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StoreInput -> Int
$chash :: StoreInput -> Int
hashWithSalt :: Int -> StoreInput -> Int
$chashWithSalt :: Int -> StoreInput -> Int
Hashable, StoreInput -> ()
(StoreInput -> ()) -> NFData StoreInput
forall a. (a -> ()) -> NFData a
rnf :: StoreInput -> ()
$crnf :: StoreInput -> ()
NFData)

isCoinbase :: StoreInput -> Bool
isCoinbase :: StoreInput -> Bool
isCoinbase StoreCoinbase {} = Bool
True
isCoinbase StoreInput {}    = Bool
False

storeInputToJSON :: Network -> StoreInput -> Value
storeInputToJSON :: Network -> StoreInput -> Value
storeInputToJSON net :: Network
net StoreInput { inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint oph :: TxHash
oph opi :: Fingerprint
opi
                                , inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
sq
                                , inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
ss
                                , inputPkScript :: StoreInput -> ByteString
inputPkScript = ByteString
ps
                                , inputAmount :: StoreInput -> Word64
inputAmount = Word64
val
                                , inputWitness :: StoreInput -> WitnessStack
inputWitness = WitnessStack
wit
                                , inputAddress :: StoreInput -> Maybe Address
inputAddress = Maybe Address
a
                                } =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "coinbase" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
False
    , "txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
oph
    , "output" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
opi
    , "sigscript" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
encodeHex ByteString
ss)
    , "sequence" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
sq
    , "pkscript" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
encodeHex ByteString
ps)
    , "value" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
val
    , "address" Text -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Network -> Address -> Value
addrToJSON Network
net (Address -> Value) -> Maybe Address -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Address
a)
    , "witness" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text) -> WitnessStack -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
encodeHex WitnessStack
wit
    ]
storeInputToJSON net :: Network
net StoreCoinbase { inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint oph :: TxHash
oph opi :: Fingerprint
opi
                                   , inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
sq
                                   , inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
ss
                                   , inputWitness :: StoreInput -> WitnessStack
inputWitness = WitnessStack
wit
                                   } =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "coinbase" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True
    , "txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
oph
    , "output" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
opi
    , "sigscript" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
encodeHex ByteString
ss)
    , "sequence" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
sq
    , "pkscript" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null
    , "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null
    , "address" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null
    , "witness" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text) -> WitnessStack -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
encodeHex WitnessStack
wit
    ]

storeInputToEncoding :: Network -> StoreInput -> Encoding
storeInputToEncoding :: Network -> StoreInput -> Encoding
storeInputToEncoding net :: Network
net StoreInput { inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint oph :: TxHash
oph opi :: Fingerprint
opi
                                    , inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
sq
                                    , inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
ss
                                    , inputPkScript :: StoreInput -> ByteString
inputPkScript = ByteString
ps
                                    , inputAmount :: StoreInput -> Word64
inputAmount = Word64
val
                                    , inputWitness :: StoreInput -> WitnessStack
inputWitness = WitnessStack
wit
                                    , inputAddress :: StoreInput -> Maybe Address
inputAddress = Maybe Address
a
                                    } =
    Series -> Encoding
pairs
        (  "coinbase" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
False
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "txid" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
oph
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "output" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
opi
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "sigscript" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (ByteString -> Text
encodeHex ByteString
ss)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "sequence" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
sq
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "pkscript" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (ByteString -> Text
encodeHex ByteString
ps)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "value" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
val
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "address" Text -> Encoding -> Series
`pair` Encoding -> (Address -> Encoding) -> Maybe Address -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
null_ (Network -> Address -> Encoding
addrToEncoding Network
net) Maybe Address
a
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "witness" Text -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text) -> WitnessStack -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
encodeHex WitnessStack
wit
        )
storeInputToEncoding net :: Network
net StoreCoinbase { inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint oph :: TxHash
oph opi :: Fingerprint
opi
                                     , inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
sq
                                     , inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
ss
                                     , inputWitness :: StoreInput -> WitnessStack
inputWitness = WitnessStack
wit
                                     } =
    Series -> Encoding
pairs
        (  "coinbase" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "txid" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (TxHash -> Text
txHashToHex TxHash
oph)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "output" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
opi
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "sigscript" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (ByteString -> Text
encodeHex ByteString
ss)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "sequence" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
sq
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "pkscript" Text -> Encoding -> Series
`pair` Encoding
null_
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "value" Text -> Encoding -> Series
`pair` Encoding
null_
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "address" Text -> Encoding -> Series
`pair` Encoding
null_
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "witness" Text -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text) -> WitnessStack -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
encodeHex WitnessStack
wit
        )

storeInputParseJSON :: Network -> Value -> Parser StoreInput
storeInputParseJSON :: Network -> Value -> Parser StoreInput
storeInputParseJSON net :: Network
net =
    String
-> (Object -> Parser StoreInput) -> Value -> Parser StoreInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "storeinput" ((Object -> Parser StoreInput) -> Value -> Parser StoreInput)
-> (Object -> Parser StoreInput) -> Value -> Parser StoreInput
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Bool
coinbase <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "coinbase"
        OutPoint
outpoint <- TxHash -> Fingerprint -> OutPoint
OutPoint (TxHash -> Fingerprint -> OutPoint)
-> Parser TxHash -> Parser (Fingerprint -> OutPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid" Parser (Fingerprint -> OutPoint)
-> Parser Fingerprint -> Parser OutPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "output"
        Fingerprint
sequ <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "sequence"
        WitnessStack
witness <- (Text -> Parser ByteString) -> [Text] -> Parser WitnessStack
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Parser ByteString
jsonHex ([Text] -> Parser WitnessStack)
-> Parser [Text] -> Parser WitnessStack
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "witness" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
        ByteString
sigscript <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "sigscript" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
jsonHex
        if Bool
coinbase
            then StoreInput -> Parser StoreInput
forall (m :: * -> *) a. Monad m => a -> m a
return
                    $WStoreCoinbase :: OutPoint -> Fingerprint -> ByteString -> WitnessStack -> StoreInput
StoreCoinbase
                        { inputPoint :: OutPoint
inputPoint = OutPoint
outpoint
                        , inputSequence :: Fingerprint
inputSequence = Fingerprint
sequ
                        , inputSigScript :: ByteString
inputSigScript = ByteString
sigscript
                        , inputWitness :: WitnessStack
inputWitness = WitnessStack
witness
                        }
            else do
                ByteString
pkscript <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "pkscript" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
jsonHex
                Word64
value <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
                Maybe Address
addr <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: "address" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Nothing -> Maybe Address -> Parser (Maybe Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing
                    Just a :: Value
a -> Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address)
-> Parser Address -> Parser (Maybe Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Value -> Parser Address
addrFromJSON Network
net Value
a Parser (Maybe Address)
-> Parser (Maybe Address) -> Parser (Maybe Address)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Address -> Parser (Maybe Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing
                StoreInput -> Parser StoreInput
forall (m :: * -> *) a. Monad m => a -> m a
return
                    $WStoreInput :: OutPoint
-> Fingerprint
-> ByteString
-> ByteString
-> Word64
-> WitnessStack
-> Maybe Address
-> StoreInput
StoreInput
                        { inputPoint :: OutPoint
inputPoint = OutPoint
outpoint
                        , inputSequence :: Fingerprint
inputSequence = Fingerprint
sequ
                        , inputSigScript :: ByteString
inputSigScript = ByteString
sigscript
                        , inputPkScript :: ByteString
inputPkScript = ByteString
pkscript
                        , inputAmount :: Word64
inputAmount = Word64
value
                        , inputWitness :: WitnessStack
inputWitness = WitnessStack
witness
                        , inputAddress :: Maybe Address
inputAddress = Maybe Address
addr
                        }

jsonHex :: Text -> Parser ByteString
jsonHex :: Text -> Parser ByteString
jsonHex s :: Text
s =
    case Text -> Maybe ByteString
decodeHex Text
s of
        Nothing -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Could not decode hex"
        Just b :: ByteString
b  -> ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

-- | Information about input spending output.
data Spender =
    Spender
        { Spender -> TxHash
spenderHash  :: !TxHash
        -- ^ input transaction hash
        , Spender -> Fingerprint
spenderIndex :: !Word32
        -- ^ input position in transaction
        }
    deriving (Int -> Spender -> ShowS
[Spender] -> ShowS
Spender -> String
(Int -> Spender -> ShowS)
-> (Spender -> String) -> ([Spender] -> ShowS) -> Show Spender
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spender] -> ShowS
$cshowList :: [Spender] -> ShowS
show :: Spender -> String
$cshow :: Spender -> String
showsPrec :: Int -> Spender -> ShowS
$cshowsPrec :: Int -> Spender -> ShowS
Show, ReadPrec [Spender]
ReadPrec Spender
Int -> ReadS Spender
ReadS [Spender]
(Int -> ReadS Spender)
-> ReadS [Spender]
-> ReadPrec Spender
-> ReadPrec [Spender]
-> Read Spender
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Spender]
$creadListPrec :: ReadPrec [Spender]
readPrec :: ReadPrec Spender
$creadPrec :: ReadPrec Spender
readList :: ReadS [Spender]
$creadList :: ReadS [Spender]
readsPrec :: Int -> ReadS Spender
$creadsPrec :: Int -> ReadS Spender
Read, Spender -> Spender -> Bool
(Spender -> Spender -> Bool)
-> (Spender -> Spender -> Bool) -> Eq Spender
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spender -> Spender -> Bool
$c/= :: Spender -> Spender -> Bool
== :: Spender -> Spender -> Bool
$c== :: Spender -> Spender -> Bool
Eq, Eq Spender
Eq Spender =>
(Spender -> Spender -> Ordering)
-> (Spender -> Spender -> Bool)
-> (Spender -> Spender -> Bool)
-> (Spender -> Spender -> Bool)
-> (Spender -> Spender -> Bool)
-> (Spender -> Spender -> Spender)
-> (Spender -> Spender -> Spender)
-> Ord Spender
Spender -> Spender -> Bool
Spender -> Spender -> Ordering
Spender -> Spender -> Spender
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Spender -> Spender -> Spender
$cmin :: Spender -> Spender -> Spender
max :: Spender -> Spender -> Spender
$cmax :: Spender -> Spender -> Spender
>= :: Spender -> Spender -> Bool
$c>= :: Spender -> Spender -> Bool
> :: Spender -> Spender -> Bool
$c> :: Spender -> Spender -> Bool
<= :: Spender -> Spender -> Bool
$c<= :: Spender -> Spender -> Bool
< :: Spender -> Spender -> Bool
$c< :: Spender -> Spender -> Bool
compare :: Spender -> Spender -> Ordering
$ccompare :: Spender -> Spender -> Ordering
$cp1Ord :: Eq Spender
Ord, (forall x. Spender -> Rep Spender x)
-> (forall x. Rep Spender x -> Spender) -> Generic Spender
forall x. Rep Spender x -> Spender
forall x. Spender -> Rep Spender x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Spender x -> Spender
$cfrom :: forall x. Spender -> Rep Spender x
Generic, Get Spender
Putter Spender
Putter Spender -> Get Spender -> Serialize Spender
forall t. Putter t -> Get t -> Serialize t
get :: Get Spender
$cget :: Get Spender
put :: Putter Spender
$cput :: Putter Spender
Serialize, Int -> Spender -> Int
Spender -> Int
(Int -> Spender -> Int) -> (Spender -> Int) -> Hashable Spender
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Spender -> Int
$chash :: Spender -> Int
hashWithSalt :: Int -> Spender -> Int
$chashWithSalt :: Int -> Spender -> Int
Hashable, Spender -> ()
(Spender -> ()) -> NFData Spender
forall a. (a -> ()) -> NFData a
rnf :: Spender -> ()
$crnf :: Spender -> ()
NFData)

instance ToJSON Spender where
    toJSON :: Spender -> Value
toJSON n :: Spender
n =
        [Pair] -> Value
object
        [ "txid" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash -> Text
txHashToHex (Spender -> TxHash
spenderHash Spender
n)
        , "input" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Spender -> Fingerprint
spenderIndex Spender
n
        ]
    toEncoding :: Spender -> Encoding
toEncoding n :: Spender
n =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
          "txid" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash -> Text
txHashToHex (Spender -> TxHash
spenderHash Spender
n) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
          "input" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Spender -> Fingerprint
spenderIndex Spender
n

instance FromJSON Spender where
    parseJSON :: Value -> Parser Spender
parseJSON =
        String -> (Object -> Parser Spender) -> Value -> Parser Spender
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "spender" ((Object -> Parser Spender) -> Value -> Parser Spender)
-> (Object -> Parser Spender) -> Value -> Parser Spender
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> TxHash -> Fingerprint -> Spender
Spender (TxHash -> Fingerprint -> Spender)
-> Parser TxHash -> Parser (Fingerprint -> Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid" Parser (Fingerprint -> Spender)
-> Parser Fingerprint -> Parser Spender
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "input"

-- | Output information.
data StoreOutput =
    StoreOutput
        { StoreOutput -> Word64
outputAmount  :: !Word64
        , StoreOutput -> ByteString
outputScript  :: !ByteString
        , StoreOutput -> Maybe Spender
outputSpender :: !(Maybe Spender)
        , StoreOutput -> Maybe Address
outputAddress :: !(Maybe Address)
        }
    deriving (Int -> StoreOutput -> ShowS
[StoreOutput] -> ShowS
StoreOutput -> String
(Int -> StoreOutput -> ShowS)
-> (StoreOutput -> String)
-> ([StoreOutput] -> ShowS)
-> Show StoreOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreOutput] -> ShowS
$cshowList :: [StoreOutput] -> ShowS
show :: StoreOutput -> String
$cshow :: StoreOutput -> String
showsPrec :: Int -> StoreOutput -> ShowS
$cshowsPrec :: Int -> StoreOutput -> ShowS
Show, ReadPrec [StoreOutput]
ReadPrec StoreOutput
Int -> ReadS StoreOutput
ReadS [StoreOutput]
(Int -> ReadS StoreOutput)
-> ReadS [StoreOutput]
-> ReadPrec StoreOutput
-> ReadPrec [StoreOutput]
-> Read StoreOutput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StoreOutput]
$creadListPrec :: ReadPrec [StoreOutput]
readPrec :: ReadPrec StoreOutput
$creadPrec :: ReadPrec StoreOutput
readList :: ReadS [StoreOutput]
$creadList :: ReadS [StoreOutput]
readsPrec :: Int -> ReadS StoreOutput
$creadsPrec :: Int -> ReadS StoreOutput
Read, StoreOutput -> StoreOutput -> Bool
(StoreOutput -> StoreOutput -> Bool)
-> (StoreOutput -> StoreOutput -> Bool) -> Eq StoreOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreOutput -> StoreOutput -> Bool
$c/= :: StoreOutput -> StoreOutput -> Bool
== :: StoreOutput -> StoreOutput -> Bool
$c== :: StoreOutput -> StoreOutput -> Bool
Eq, Eq StoreOutput
Eq StoreOutput =>
(StoreOutput -> StoreOutput -> Ordering)
-> (StoreOutput -> StoreOutput -> Bool)
-> (StoreOutput -> StoreOutput -> Bool)
-> (StoreOutput -> StoreOutput -> Bool)
-> (StoreOutput -> StoreOutput -> Bool)
-> (StoreOutput -> StoreOutput -> StoreOutput)
-> (StoreOutput -> StoreOutput -> StoreOutput)
-> Ord StoreOutput
StoreOutput -> StoreOutput -> Bool
StoreOutput -> StoreOutput -> Ordering
StoreOutput -> StoreOutput -> StoreOutput
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StoreOutput -> StoreOutput -> StoreOutput
$cmin :: StoreOutput -> StoreOutput -> StoreOutput
max :: StoreOutput -> StoreOutput -> StoreOutput
$cmax :: StoreOutput -> StoreOutput -> StoreOutput
>= :: StoreOutput -> StoreOutput -> Bool
$c>= :: StoreOutput -> StoreOutput -> Bool
> :: StoreOutput -> StoreOutput -> Bool
$c> :: StoreOutput -> StoreOutput -> Bool
<= :: StoreOutput -> StoreOutput -> Bool
$c<= :: StoreOutput -> StoreOutput -> Bool
< :: StoreOutput -> StoreOutput -> Bool
$c< :: StoreOutput -> StoreOutput -> Bool
compare :: StoreOutput -> StoreOutput -> Ordering
$ccompare :: StoreOutput -> StoreOutput -> Ordering
$cp1Ord :: Eq StoreOutput
Ord, (forall x. StoreOutput -> Rep StoreOutput x)
-> (forall x. Rep StoreOutput x -> StoreOutput)
-> Generic StoreOutput
forall x. Rep StoreOutput x -> StoreOutput
forall x. StoreOutput -> Rep StoreOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StoreOutput x -> StoreOutput
$cfrom :: forall x. StoreOutput -> Rep StoreOutput x
Generic, Get StoreOutput
Putter StoreOutput
Putter StoreOutput -> Get StoreOutput -> Serialize StoreOutput
forall t. Putter t -> Get t -> Serialize t
get :: Get StoreOutput
$cget :: Get StoreOutput
put :: Putter StoreOutput
$cput :: Putter StoreOutput
Serialize, Int -> StoreOutput -> Int
StoreOutput -> Int
(Int -> StoreOutput -> Int)
-> (StoreOutput -> Int) -> Hashable StoreOutput
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: StoreOutput -> Int
$chash :: StoreOutput -> Int
hashWithSalt :: Int -> StoreOutput -> Int
$chashWithSalt :: Int -> StoreOutput -> Int
Hashable, StoreOutput -> ()
(StoreOutput -> ()) -> NFData StoreOutput
forall a. (a -> ()) -> NFData a
rnf :: StoreOutput -> ()
$crnf :: StoreOutput -> ()
NFData)

storeOutputToJSON :: Network -> StoreOutput -> Value
storeOutputToJSON :: Network -> StoreOutput -> Value
storeOutputToJSON net :: Network
net d :: StoreOutput
d =
    [Pair] -> Value
object
        [ "address" Text -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Network -> Address -> Value
addrToJSON Network
net (Address -> Value) -> Maybe Address -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreOutput -> Maybe Address
outputAddress StoreOutput
d)
        , "pkscript" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex (StoreOutput -> ByteString
outputScript StoreOutput
d)
        , "value" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StoreOutput -> Word64
outputAmount StoreOutput
d
        , "spent" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Spender -> Bool
forall a. Maybe a -> Bool
isJust (StoreOutput -> Maybe Spender
outputSpender StoreOutput
d)
        , "spender" Text -> Maybe Spender -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StoreOutput -> Maybe Spender
outputSpender StoreOutput
d
        ]

storeOutputToEncoding :: Network -> StoreOutput -> Encoding
storeOutputToEncoding :: Network -> StoreOutput -> Encoding
storeOutputToEncoding net :: Network
net d :: StoreOutput
d =
    Series -> Encoding
pairs
        (  "address" Text -> Encoding -> Series
`pair` Encoding -> (Address -> Encoding) -> Maybe Address -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
null_ (Network -> Address -> Encoding
addrToEncoding Network
net) (StoreOutput -> Maybe Address
outputAddress StoreOutput
d)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "pkscript" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (ByteString -> Text
encodeHex (StoreOutput -> ByteString
outputScript StoreOutput
d))
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "value" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StoreOutput -> Word64
outputAmount StoreOutput
d
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "spent" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Spender -> Bool
forall a. Maybe a -> Bool
isJust (StoreOutput -> Maybe Spender
outputSpender StoreOutput
d)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "spender" Text -> Maybe Spender -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= StoreOutput -> Maybe Spender
outputSpender StoreOutput
d
        )

storeOutputParseJSON :: Network -> Value -> Parser StoreOutput
storeOutputParseJSON :: Network -> Value -> Parser StoreOutput
storeOutputParseJSON net :: Network
net =
    String
-> (Object -> Parser StoreOutput) -> Value -> Parser StoreOutput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "storeoutput" ((Object -> Parser StoreOutput) -> Value -> Parser StoreOutput)
-> (Object -> Parser StoreOutput) -> Value -> Parser StoreOutput
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Word64
value <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
        ByteString
pkscript <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "pkscript" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
jsonHex
        Maybe Spender
spender <- Object
o Object -> Text -> Parser (Maybe Spender)
forall a. FromJSON a => Object -> Text -> Parser a
.: "spender"
        Maybe Address
addr <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: "address" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Nothing -> Maybe Address -> Parser (Maybe Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing
            Just a :: Value
a -> Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address)
-> Parser Address -> Parser (Maybe Address)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Value -> Parser Address
addrFromJSON Network
net Value
a Parser (Maybe Address)
-> Parser (Maybe Address) -> Parser (Maybe Address)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Address -> Parser (Maybe Address)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing
        StoreOutput -> Parser StoreOutput
forall (m :: * -> *) a. Monad m => a -> m a
return
            $WStoreOutput :: Word64
-> ByteString -> Maybe Spender -> Maybe Address -> StoreOutput
StoreOutput
                { outputAmount :: Word64
outputAmount = Word64
value
                , outputScript :: ByteString
outputScript = ByteString
pkscript
                , outputSpender :: Maybe Spender
outputSpender = Maybe Spender
spender
                , outputAddress :: Maybe Address
outputAddress = Maybe Address
addr
                }

data Prev =
    Prev
        { Prev -> ByteString
prevScript :: !ByteString
        , Prev -> Word64
prevAmount :: !Word64
        }
    deriving (Int -> Prev -> ShowS
[Prev] -> ShowS
Prev -> String
(Int -> Prev -> ShowS)
-> (Prev -> String) -> ([Prev] -> ShowS) -> Show Prev
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prev] -> ShowS
$cshowList :: [Prev] -> ShowS
show :: Prev -> String
$cshow :: Prev -> String
showsPrec :: Int -> Prev -> ShowS
$cshowsPrec :: Int -> Prev -> ShowS
Show, Prev -> Prev -> Bool
(Prev -> Prev -> Bool) -> (Prev -> Prev -> Bool) -> Eq Prev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prev -> Prev -> Bool
$c/= :: Prev -> Prev -> Bool
== :: Prev -> Prev -> Bool
$c== :: Prev -> Prev -> Bool
Eq, Eq Prev
Eq Prev =>
(Prev -> Prev -> Ordering)
-> (Prev -> Prev -> Bool)
-> (Prev -> Prev -> Bool)
-> (Prev -> Prev -> Bool)
-> (Prev -> Prev -> Bool)
-> (Prev -> Prev -> Prev)
-> (Prev -> Prev -> Prev)
-> Ord Prev
Prev -> Prev -> Bool
Prev -> Prev -> Ordering
Prev -> Prev -> Prev
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Prev -> Prev -> Prev
$cmin :: Prev -> Prev -> Prev
max :: Prev -> Prev -> Prev
$cmax :: Prev -> Prev -> Prev
>= :: Prev -> Prev -> Bool
$c>= :: Prev -> Prev -> Bool
> :: Prev -> Prev -> Bool
$c> :: Prev -> Prev -> Bool
<= :: Prev -> Prev -> Bool
$c<= :: Prev -> Prev -> Bool
< :: Prev -> Prev -> Bool
$c< :: Prev -> Prev -> Bool
compare :: Prev -> Prev -> Ordering
$ccompare :: Prev -> Prev -> Ordering
$cp1Ord :: Eq Prev
Ord, (forall x. Prev -> Rep Prev x)
-> (forall x. Rep Prev x -> Prev) -> Generic Prev
forall x. Rep Prev x -> Prev
forall x. Prev -> Rep Prev x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prev x -> Prev
$cfrom :: forall x. Prev -> Rep Prev x
Generic, Int -> Prev -> Int
Prev -> Int
(Int -> Prev -> Int) -> (Prev -> Int) -> Hashable Prev
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Prev -> Int
$chash :: Prev -> Int
hashWithSalt :: Int -> Prev -> Int
$chashWithSalt :: Int -> Prev -> Int
Hashable, Get Prev
Putter Prev
Putter Prev -> Get Prev -> Serialize Prev
forall t. Putter t -> Get t -> Serialize t
get :: Get Prev
$cget :: Get Prev
put :: Putter Prev
$cput :: Putter Prev
Serialize, Prev -> ()
(Prev -> ()) -> NFData Prev
forall a. (a -> ()) -> NFData a
rnf :: Prev -> ()
$crnf :: Prev -> ()
NFData)

toInput :: TxIn -> Maybe Prev -> WitnessStack -> StoreInput
toInput :: TxIn -> Maybe Prev -> WitnessStack -> StoreInput
toInput i :: TxIn
i Nothing w :: WitnessStack
w =
    $WStoreCoinbase :: OutPoint -> Fingerprint -> ByteString -> WitnessStack -> StoreInput
StoreCoinbase
        { inputPoint :: OutPoint
inputPoint = TxIn -> OutPoint
prevOutput TxIn
i
        , inputSequence :: Fingerprint
inputSequence = TxIn -> Fingerprint
txInSequence TxIn
i
        , inputSigScript :: ByteString
inputSigScript = TxIn -> ByteString
scriptInput TxIn
i
        , inputWitness :: WitnessStack
inputWitness = WitnessStack
w
        }
toInput i :: TxIn
i (Just p :: Prev
p) w :: WitnessStack
w =
    $WStoreInput :: OutPoint
-> Fingerprint
-> ByteString
-> ByteString
-> Word64
-> WitnessStack
-> Maybe Address
-> StoreInput
StoreInput
        { inputPoint :: OutPoint
inputPoint = TxIn -> OutPoint
prevOutput TxIn
i
        , inputSequence :: Fingerprint
inputSequence = TxIn -> Fingerprint
txInSequence TxIn
i
        , inputSigScript :: ByteString
inputSigScript = TxIn -> ByteString
scriptInput TxIn
i
        , inputPkScript :: ByteString
inputPkScript = Prev -> ByteString
prevScript Prev
p
        , inputAmount :: Word64
inputAmount = Prev -> Word64
prevAmount Prev
p
        , inputWitness :: WitnessStack
inputWitness = WitnessStack
w
        , inputAddress :: Maybe Address
inputAddress = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS (Prev -> ByteString
prevScript Prev
p))
        }

toOutput :: TxOut -> Maybe Spender -> StoreOutput
toOutput :: TxOut -> Maybe Spender -> StoreOutput
toOutput o :: TxOut
o s :: Maybe Spender
s =
    $WStoreOutput :: Word64
-> ByteString -> Maybe Spender -> Maybe Address -> StoreOutput
StoreOutput
        { outputAmount :: Word64
outputAmount = TxOut -> Word64
outValue TxOut
o
        , outputScript :: ByteString
outputScript = TxOut -> ByteString
scriptOutput TxOut
o
        , outputSpender :: Maybe Spender
outputSpender = Maybe Spender
s
        , outputAddress :: Maybe Address
outputAddress = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS (TxOut -> ByteString
scriptOutput TxOut
o))
        }

data TxData =
    TxData
        { TxData -> BlockRef
txDataBlock   :: !BlockRef
        , TxData -> Tx
txData        :: !Tx
        , TxData -> IntMap Prev
txDataPrevs   :: !(IntMap Prev)
        , TxData -> Bool
txDataDeleted :: !Bool
        , TxData -> Bool
txDataRBF     :: !Bool
        , TxData -> Word64
txDataTime    :: !Word64
        }
    deriving (Int -> TxData -> ShowS
[TxData] -> ShowS
TxData -> String
(Int -> TxData -> ShowS)
-> (TxData -> String) -> ([TxData] -> ShowS) -> Show TxData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxData] -> ShowS
$cshowList :: [TxData] -> ShowS
show :: TxData -> String
$cshow :: TxData -> String
showsPrec :: Int -> TxData -> ShowS
$cshowsPrec :: Int -> TxData -> ShowS
Show, TxData -> TxData -> Bool
(TxData -> TxData -> Bool)
-> (TxData -> TxData -> Bool) -> Eq TxData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxData -> TxData -> Bool
$c/= :: TxData -> TxData -> Bool
== :: TxData -> TxData -> Bool
$c== :: TxData -> TxData -> Bool
Eq, Eq TxData
Eq TxData =>
(TxData -> TxData -> Ordering)
-> (TxData -> TxData -> Bool)
-> (TxData -> TxData -> Bool)
-> (TxData -> TxData -> Bool)
-> (TxData -> TxData -> Bool)
-> (TxData -> TxData -> TxData)
-> (TxData -> TxData -> TxData)
-> Ord TxData
TxData -> TxData -> Bool
TxData -> TxData -> Ordering
TxData -> TxData -> TxData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxData -> TxData -> TxData
$cmin :: TxData -> TxData -> TxData
max :: TxData -> TxData -> TxData
$cmax :: TxData -> TxData -> TxData
>= :: TxData -> TxData -> Bool
$c>= :: TxData -> TxData -> Bool
> :: TxData -> TxData -> Bool
$c> :: TxData -> TxData -> Bool
<= :: TxData -> TxData -> Bool
$c<= :: TxData -> TxData -> Bool
< :: TxData -> TxData -> Bool
$c< :: TxData -> TxData -> Bool
compare :: TxData -> TxData -> Ordering
$ccompare :: TxData -> TxData -> Ordering
$cp1Ord :: Eq TxData
Ord, (forall x. TxData -> Rep TxData x)
-> (forall x. Rep TxData x -> TxData) -> Generic TxData
forall x. Rep TxData x -> TxData
forall x. TxData -> Rep TxData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxData x -> TxData
$cfrom :: forall x. TxData -> Rep TxData x
Generic, Get TxData
Putter TxData
Putter TxData -> Get TxData -> Serialize TxData
forall t. Putter t -> Get t -> Serialize t
get :: Get TxData
$cget :: Get TxData
put :: Putter TxData
$cput :: Putter TxData
Serialize, TxData -> ()
(TxData -> ()) -> NFData TxData
forall a. (a -> ()) -> NFData a
rnf :: TxData -> ()
$crnf :: TxData -> ()
NFData)

toTransaction :: TxData -> IntMap Spender -> Transaction
toTransaction :: TxData -> IntMap Spender -> Transaction
toTransaction t :: TxData
t sm :: IntMap Spender
sm =
    $WTransaction :: BlockRef
-> Fingerprint
-> Fingerprint
-> [StoreInput]
-> [StoreOutput]
-> Bool
-> Bool
-> Word64
-> TxHash
-> Fingerprint
-> Fingerprint
-> Word64
-> Transaction
Transaction
        { transactionBlock :: BlockRef
transactionBlock = TxData -> BlockRef
txDataBlock TxData
t
        , transactionVersion :: Fingerprint
transactionVersion = Tx -> Fingerprint
txVersion (TxData -> Tx
txData TxData
t)
        , transactionLockTime :: Fingerprint
transactionLockTime = Tx -> Fingerprint
txLockTime (TxData -> Tx
txData TxData
t)
        , transactionInputs :: [StoreInput]
transactionInputs = [StoreInput]
ins
        , transactionOutputs :: [StoreOutput]
transactionOutputs = [StoreOutput]
outs
        , transactionDeleted :: Bool
transactionDeleted = TxData -> Bool
txDataDeleted TxData
t
        , transactionRBF :: Bool
transactionRBF = TxData -> Bool
txDataRBF TxData
t
        , transactionTime :: Word64
transactionTime = TxData -> Word64
txDataTime TxData
t
        , transactionId :: TxHash
transactionId = TxHash
txid
        , transactionSize :: Fingerprint
transactionSize = Fingerprint
txsize
        , transactionWeight :: Fingerprint
transactionWeight = Fingerprint
txweight
        , transactionFees :: Word64
transactionFees = Word64
fees
        }
  where
    txid :: TxHash
txid = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
t)
    txsize :: Fingerprint
txsize = Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Fingerprint) -> Int -> Fingerprint
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length (Tx -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (TxData -> Tx
txData TxData
t))
    txweight :: Fingerprint
txweight =
        let b :: Int
b = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (TxData -> Tx
txData TxData
t) {txWitness :: WitnessData
txWitness = []}
            x :: Int
x = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (TxData -> Tx
txData TxData
t)
         in Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Fingerprint) -> Int -> Fingerprint
forall a b. (a -> b) -> a -> b
$ Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
    inv :: Word64
inv = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Word64
inputAmount [StoreInput]
ins)
    outv :: Word64
outv = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> Word64
outputAmount [StoreOutput]
outs)
    fees :: Word64
fees = if (StoreInput -> Bool) -> [StoreInput] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StoreInput -> Bool
isCoinbase [StoreInput]
ins then 0 else Word64
inv Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
outv
    ws :: WitnessData
ws = Int -> WitnessData -> WitnessData
forall a. Int -> [a] -> [a]
take ([TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxIn]
txIn (TxData -> Tx
txData TxData
t))) (WitnessData -> WitnessData) -> WitnessData -> WitnessData
forall a b. (a -> b) -> a -> b
$ Tx -> WitnessData
txWitness (TxData -> Tx
txData TxData
t) WitnessData -> WitnessData -> WitnessData
forall a. Semigroup a => a -> a -> a
<> WitnessStack -> WitnessData
forall a. a -> [a]
repeat []
    f :: Int -> TxIn -> StoreInput
f n :: Int
n i :: TxIn
i = TxIn -> Maybe Prev -> WitnessStack -> StoreInput
toInput TxIn
i (Int -> IntMap Prev -> Maybe Prev
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n (TxData -> IntMap Prev
txDataPrevs TxData
t)) (WitnessData
ws WitnessData -> Int -> WitnessStack
forall a. [a] -> Int -> a
!! Int
n)
    ins :: [StoreInput]
ins = (Int -> TxIn -> StoreInput) -> [Int] -> [TxIn] -> [StoreInput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> TxIn -> StoreInput
f [0 ..] (Tx -> [TxIn]
txIn (TxData -> Tx
txData TxData
t))
    g :: Int -> TxOut -> StoreOutput
g n :: Int
n o :: TxOut
o = TxOut -> Maybe Spender -> StoreOutput
toOutput TxOut
o (Int -> IntMap Spender -> Maybe Spender
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n IntMap Spender
sm)
    outs :: [StoreOutput]
outs = (Int -> TxOut -> StoreOutput) -> [Int] -> [TxOut] -> [StoreOutput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> TxOut -> StoreOutput
g [0 ..] (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
t))

fromTransaction :: Transaction -> (TxData, IntMap Spender)
fromTransaction :: Transaction -> (TxData, IntMap Spender)
fromTransaction t :: Transaction
t = (TxData
d, IntMap Spender
sm)
  where
    d :: TxData
d =
        $WTxData :: BlockRef -> Tx -> IntMap Prev -> Bool -> Bool -> Word64 -> TxData
TxData
            { txDataBlock :: BlockRef
txDataBlock = Transaction -> BlockRef
transactionBlock Transaction
t
            , txData :: Tx
txData = Transaction -> Tx
transactionData Transaction
t
            , txDataPrevs :: IntMap Prev
txDataPrevs = IntMap Prev
ps
            , txDataDeleted :: Bool
txDataDeleted = Transaction -> Bool
transactionDeleted Transaction
t
            , txDataRBF :: Bool
txDataRBF = Transaction -> Bool
transactionRBF Transaction
t
            , txDataTime :: Word64
txDataTime = Transaction -> Word64
transactionTime Transaction
t
            }
    f :: a -> StoreInput -> Maybe (a, Prev)
f _ StoreCoinbase {} = Maybe (a, Prev)
forall a. Maybe a
Nothing
    f n :: a
n StoreInput {inputPkScript :: StoreInput -> ByteString
inputPkScript = ByteString
s, inputAmount :: StoreInput -> Word64
inputAmount = Word64
v} =
        (a, Prev) -> Maybe (a, Prev)
forall a. a -> Maybe a
Just (a
n, $WPrev :: ByteString -> Word64 -> Prev
Prev {prevScript :: ByteString
prevScript = ByteString
s, prevAmount :: Word64
prevAmount = Word64
v})
    ps :: IntMap Prev
ps = [(Int, Prev)] -> IntMap Prev
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Prev)] -> IntMap Prev)
-> ([Maybe (Int, Prev)] -> [(Int, Prev)])
-> [Maybe (Int, Prev)]
-> IntMap Prev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Int, Prev)] -> [(Int, Prev)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, Prev)] -> IntMap Prev)
-> [Maybe (Int, Prev)] -> IntMap Prev
forall a b. (a -> b) -> a -> b
$ (Int -> StoreInput -> Maybe (Int, Prev))
-> [Int] -> [StoreInput] -> [Maybe (Int, Prev)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> StoreInput -> Maybe (Int, Prev)
forall a. a -> StoreInput -> Maybe (a, Prev)
f [0 ..] (Transaction -> [StoreInput]
transactionInputs Transaction
t)
    g :: a -> StoreOutput -> Maybe (a, Spender)
g _ StoreOutput {outputSpender :: StoreOutput -> Maybe Spender
outputSpender = Maybe Spender
Nothing} = Maybe (a, Spender)
forall a. Maybe a
Nothing
    g n :: a
n StoreOutput {outputSpender :: StoreOutput -> Maybe Spender
outputSpender = Just s :: Spender
s}  = (a, Spender) -> Maybe (a, Spender)
forall a. a -> Maybe a
Just (a
n, Spender
s)
    sm :: IntMap Spender
sm = [(Int, Spender)] -> IntMap Spender
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Spender)] -> IntMap Spender)
-> ([Maybe (Int, Spender)] -> [(Int, Spender)])
-> [Maybe (Int, Spender)]
-> IntMap Spender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Int, Spender)] -> [(Int, Spender)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, Spender)] -> IntMap Spender)
-> [Maybe (Int, Spender)] -> IntMap Spender
forall a b. (a -> b) -> a -> b
$ (Int -> StoreOutput -> Maybe (Int, Spender))
-> [Int] -> [StoreOutput] -> [Maybe (Int, Spender)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> StoreOutput -> Maybe (Int, Spender)
forall a. a -> StoreOutput -> Maybe (a, Spender)
g [0 ..] (Transaction -> [StoreOutput]
transactionOutputs Transaction
t)

-- | Detailed transaction information.
data Transaction =
    Transaction
        { Transaction -> BlockRef
transactionBlock    :: !BlockRef
        -- ^ block information for this transaction
        , Transaction -> Fingerprint
transactionVersion  :: !Word32
        -- ^ transaction version
        , Transaction -> Fingerprint
transactionLockTime :: !Word32
        -- ^ lock time
        , Transaction -> [StoreInput]
transactionInputs   :: ![StoreInput]
        -- ^ transaction inputs
        , Transaction -> [StoreOutput]
transactionOutputs  :: ![StoreOutput]
        -- ^ transaction outputs
        , Transaction -> Bool
transactionDeleted  :: !Bool
        -- ^ this transaction has been deleted and is no longer valid
        , Transaction -> Bool
transactionRBF      :: !Bool
        -- ^ this transaction can be replaced in the mempool
        , Transaction -> Word64
transactionTime     :: !Word64
        -- ^ time the transaction was first seen or time of block
        , Transaction -> TxHash
transactionId       :: !TxHash
        -- ^ transaction id
        , Transaction -> Fingerprint
transactionSize     :: !Word32
        -- ^ serialized transaction size (includes witness data)
        , Transaction -> Fingerprint
transactionWeight   :: !Word32
        -- ^ transaction weight
        , Transaction -> Word64
transactionFees     :: !Word64
        -- ^ fees that this transaction pays (0 for coinbase)
        }
    deriving (Int -> Transaction -> ShowS
[Transaction] -> ShowS
Transaction -> String
(Int -> Transaction -> ShowS)
-> (Transaction -> String)
-> ([Transaction] -> ShowS)
-> Show Transaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transaction] -> ShowS
$cshowList :: [Transaction] -> ShowS
show :: Transaction -> String
$cshow :: Transaction -> String
showsPrec :: Int -> Transaction -> ShowS
$cshowsPrec :: Int -> Transaction -> ShowS
Show, Transaction -> Transaction -> Bool
(Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Bool) -> Eq Transaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transaction -> Transaction -> Bool
$c/= :: Transaction -> Transaction -> Bool
== :: Transaction -> Transaction -> Bool
$c== :: Transaction -> Transaction -> Bool
Eq, Eq Transaction
Eq Transaction =>
(Transaction -> Transaction -> Ordering)
-> (Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Transaction)
-> (Transaction -> Transaction -> Transaction)
-> Ord Transaction
Transaction -> Transaction -> Bool
Transaction -> Transaction -> Ordering
Transaction -> Transaction -> Transaction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Transaction -> Transaction -> Transaction
$cmin :: Transaction -> Transaction -> Transaction
max :: Transaction -> Transaction -> Transaction
$cmax :: Transaction -> Transaction -> Transaction
>= :: Transaction -> Transaction -> Bool
$c>= :: Transaction -> Transaction -> Bool
> :: Transaction -> Transaction -> Bool
$c> :: Transaction -> Transaction -> Bool
<= :: Transaction -> Transaction -> Bool
$c<= :: Transaction -> Transaction -> Bool
< :: Transaction -> Transaction -> Bool
$c< :: Transaction -> Transaction -> Bool
compare :: Transaction -> Transaction -> Ordering
$ccompare :: Transaction -> Transaction -> Ordering
$cp1Ord :: Eq Transaction
Ord, (forall x. Transaction -> Rep Transaction x)
-> (forall x. Rep Transaction x -> Transaction)
-> Generic Transaction
forall x. Rep Transaction x -> Transaction
forall x. Transaction -> Rep Transaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Transaction x -> Transaction
$cfrom :: forall x. Transaction -> Rep Transaction x
Generic, Int -> Transaction -> Int
Transaction -> Int
(Int -> Transaction -> Int)
-> (Transaction -> Int) -> Hashable Transaction
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Transaction -> Int
$chash :: Transaction -> Int
hashWithSalt :: Int -> Transaction -> Int
$chashWithSalt :: Int -> Transaction -> Int
Hashable, Get Transaction
Putter Transaction
Putter Transaction -> Get Transaction -> Serialize Transaction
forall t. Putter t -> Get t -> Serialize t
get :: Get Transaction
$cget :: Get Transaction
put :: Putter Transaction
$cput :: Putter Transaction
Serialize, Transaction -> ()
(Transaction -> ()) -> NFData Transaction
forall a. (a -> ()) -> NFData a
rnf :: Transaction -> ()
$crnf :: Transaction -> ()
NFData)

transactionData :: Transaction -> Tx
transactionData :: Transaction -> Tx
transactionData t :: Transaction
t =
    $WTx :: Fingerprint
-> [TxIn] -> [TxOut] -> WitnessData -> Fingerprint -> Tx
Tx
        { txVersion :: Fingerprint
txVersion = Transaction -> Fingerprint
transactionVersion Transaction
t
        , txIn :: [TxIn]
txIn = (StoreInput -> TxIn) -> [StoreInput] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> TxIn
i (Transaction -> [StoreInput]
transactionInputs Transaction
t)
        , txOut :: [TxOut]
txOut = (StoreOutput -> TxOut) -> [StoreOutput] -> [TxOut]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> TxOut
o (Transaction -> [StoreOutput]
transactionOutputs Transaction
t)
        , txWitness :: WitnessData
txWitness = WitnessData -> WitnessData
forall (t :: * -> *) a. Foldable t => [t a] -> [t a]
w (WitnessData -> WitnessData) -> WitnessData -> WitnessData
forall a b. (a -> b) -> a -> b
$ (StoreInput -> WitnessStack) -> [StoreInput] -> WitnessData
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> WitnessStack
inputWitness (Transaction -> [StoreInput]
transactionInputs Transaction
t)
        , txLockTime :: Fingerprint
txLockTime = Transaction -> Fingerprint
transactionLockTime Transaction
t
        }
  where
    i :: StoreInput -> TxIn
i StoreCoinbase {inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint
p, inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
q, inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
s} =
        $WTxIn :: OutPoint -> ByteString -> Fingerprint -> TxIn
TxIn {prevOutput :: OutPoint
prevOutput = OutPoint
p, scriptInput :: ByteString
scriptInput = ByteString
s, txInSequence :: Fingerprint
txInSequence = Fingerprint
q}
    i StoreInput {inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint
p, inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
q, inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
s} =
        $WTxIn :: OutPoint -> ByteString -> Fingerprint -> TxIn
TxIn {prevOutput :: OutPoint
prevOutput = OutPoint
p, scriptInput :: ByteString
scriptInput = ByteString
s, txInSequence :: Fingerprint
txInSequence = Fingerprint
q}
    o :: StoreOutput -> TxOut
o StoreOutput {outputAmount :: StoreOutput -> Word64
outputAmount = Word64
v, outputScript :: StoreOutput -> ByteString
outputScript = ByteString
s} =
        $WTxOut :: Word64 -> ByteString -> TxOut
TxOut {outValue :: Word64
outValue = Word64
v, scriptOutput :: ByteString
scriptOutput = ByteString
s}
    w :: [t a] -> [t a]
w xs :: [t a]
xs | (t a -> Bool) -> [t a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t a]
xs = []
         | Bool
otherwise = [t a]
xs

transactionToJSON :: Network -> Transaction -> Value
transactionToJSON :: Network -> Transaction -> Value
transactionToJSON net :: Network
net dtx :: Transaction
dtx =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> TxHash
transactionId Transaction
dtx
    , "size" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionSize Transaction
dtx
    , "version" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionVersion Transaction
dtx
    , "locktime" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionLockTime Transaction
dtx
    , "fee" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Word64
transactionFees Transaction
dtx
    , "inputs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (StoreInput -> Value) -> [StoreInput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> StoreInput -> Value
storeInputToJSON Network
net) (Transaction -> [StoreInput]
transactionInputs Transaction
dtx)
    , "outputs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (StoreOutput -> Value) -> [StoreOutput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> StoreOutput -> Value
storeOutputToJSON Network
net) (Transaction -> [StoreOutput]
transactionOutputs Transaction
dtx)
    , "block" Text -> BlockRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> BlockRef
transactionBlock Transaction
dtx
    , "deleted" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Bool
transactionDeleted Transaction
dtx
    , "time" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Word64
transactionTime Transaction
dtx
    , "rbf" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Bool
transactionRBF Transaction
dtx
    , "weight" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionWeight Transaction
dtx
    ]

transactionToEncoding :: Network -> Transaction -> Encoding
transactionToEncoding :: Network -> Transaction -> Encoding
transactionToEncoding net :: Network
net dtx :: Transaction
dtx =
    Series -> Encoding
pairs
        (  "txid" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> TxHash
transactionId Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "size" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionSize Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "version" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionVersion Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "locktime" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionLockTime Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "fee" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Word64
transactionFees Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "inputs" Text -> Encoding -> Series
`pair` (StoreInput -> Encoding) -> [StoreInput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> StoreInput -> Encoding
storeInputToEncoding Network
net) (Transaction -> [StoreInput]
transactionInputs Transaction
dtx)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "outputs" Text -> Encoding -> Series
`pair` (StoreOutput -> Encoding) -> [StoreOutput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> StoreOutput -> Encoding
storeOutputToEncoding Network
net) (Transaction -> [StoreOutput]
transactionOutputs Transaction
dtx)
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "block" Text -> BlockRef -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> BlockRef
transactionBlock Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "deleted" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Bool
transactionDeleted Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "time" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Word64
transactionTime Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "rbf" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Bool
transactionRBF Transaction
dtx
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "weight" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Transaction -> Fingerprint
transactionWeight Transaction
dtx
        )

transactionParseJSON :: Network -> Value -> Parser Transaction
transactionParseJSON :: Network -> Value -> Parser Transaction
transactionParseJSON net :: Network
net =
    String
-> (Object -> Parser Transaction) -> Value -> Parser Transaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "transaction" ((Object -> Parser Transaction) -> Value -> Parser Transaction)
-> (Object -> Parser Transaction) -> Value -> Parser Transaction
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Fingerprint
version <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
        Fingerprint
locktime <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "locktime"
        [StoreInput]
inputs <- Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "inputs" Parser [Value]
-> ([Value] -> Parser [StoreInput]) -> Parser [StoreInput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser StoreInput) -> [Value] -> Parser [StoreInput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser StoreInput
storeInputParseJSON Network
net)
        [StoreOutput]
outputs <- Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "outputs" Parser [Value]
-> ([Value] -> Parser [StoreOutput]) -> Parser [StoreOutput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser StoreOutput) -> [Value] -> Parser [StoreOutput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser StoreOutput
storeOutputParseJSON Network
net)
        BlockRef
block <- Object
o Object -> Text -> Parser BlockRef
forall a. FromJSON a => Object -> Text -> Parser a
.: "block"
        Bool
deleted <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "deleted"
        Word64
time <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "time"
        Bool
rbf <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "rbf" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        Fingerprint
weight <- Object
o Object -> Text -> Parser (Maybe Fingerprint)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "weight" Parser (Maybe Fingerprint) -> Fingerprint -> Parser Fingerprint
forall a. Parser (Maybe a) -> a -> Parser a
.!= 0
        Fingerprint
size <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
        TxHash
txid <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid"
        Word64
fees <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "fee"
        Transaction -> Parser Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return
            $WTransaction :: BlockRef
-> Fingerprint
-> Fingerprint
-> [StoreInput]
-> [StoreOutput]
-> Bool
-> Bool
-> Word64
-> TxHash
-> Fingerprint
-> Fingerprint
-> Word64
-> Transaction
Transaction
                { transactionBlock :: BlockRef
transactionBlock = BlockRef
block
                , transactionVersion :: Fingerprint
transactionVersion = Fingerprint
version
                , transactionLockTime :: Fingerprint
transactionLockTime = Fingerprint
locktime
                , transactionInputs :: [StoreInput]
transactionInputs = [StoreInput]
inputs
                , transactionOutputs :: [StoreOutput]
transactionOutputs = [StoreOutput]
outputs
                , transactionDeleted :: Bool
transactionDeleted = Bool
deleted
                , transactionTime :: Word64
transactionTime = Word64
time
                , transactionRBF :: Bool
transactionRBF = Bool
rbf
                , transactionWeight :: Fingerprint
transactionWeight = Fingerprint
weight
                , transactionSize :: Fingerprint
transactionSize = Fingerprint
size
                , transactionId :: TxHash
transactionId = TxHash
txid
                , transactionFees :: Word64
transactionFees = Word64
fees
                }

-- | Information about a connected peer.
data PeerInformation =
    PeerInformation
        { PeerInformation -> ByteString
peerUserAgent :: !ByteString
                        -- ^ user agent string
        , PeerInformation -> String
peerAddress   :: !String
                        -- ^ network address
        , PeerInformation -> Fingerprint
peerVersion   :: !Word32
                        -- ^ version number
        , PeerInformation -> Word64
peerServices  :: !Word64
                        -- ^ services field
        , PeerInformation -> Bool
peerRelay     :: !Bool
                        -- ^ will relay transactions
        }
    deriving (Int -> PeerInformation -> ShowS
[PeerInformation] -> ShowS
PeerInformation -> String
(Int -> PeerInformation -> ShowS)
-> (PeerInformation -> String)
-> ([PeerInformation] -> ShowS)
-> Show PeerInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PeerInformation] -> ShowS
$cshowList :: [PeerInformation] -> ShowS
show :: PeerInformation -> String
$cshow :: PeerInformation -> String
showsPrec :: Int -> PeerInformation -> ShowS
$cshowsPrec :: Int -> PeerInformation -> ShowS
Show, PeerInformation -> PeerInformation -> Bool
(PeerInformation -> PeerInformation -> Bool)
-> (PeerInformation -> PeerInformation -> Bool)
-> Eq PeerInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PeerInformation -> PeerInformation -> Bool
$c/= :: PeerInformation -> PeerInformation -> Bool
== :: PeerInformation -> PeerInformation -> Bool
$c== :: PeerInformation -> PeerInformation -> Bool
Eq, Eq PeerInformation
Eq PeerInformation =>
(PeerInformation -> PeerInformation -> Ordering)
-> (PeerInformation -> PeerInformation -> Bool)
-> (PeerInformation -> PeerInformation -> Bool)
-> (PeerInformation -> PeerInformation -> Bool)
-> (PeerInformation -> PeerInformation -> Bool)
-> (PeerInformation -> PeerInformation -> PeerInformation)
-> (PeerInformation -> PeerInformation -> PeerInformation)
-> Ord PeerInformation
PeerInformation -> PeerInformation -> Bool
PeerInformation -> PeerInformation -> Ordering
PeerInformation -> PeerInformation -> PeerInformation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PeerInformation -> PeerInformation -> PeerInformation
$cmin :: PeerInformation -> PeerInformation -> PeerInformation
max :: PeerInformation -> PeerInformation -> PeerInformation
$cmax :: PeerInformation -> PeerInformation -> PeerInformation
>= :: PeerInformation -> PeerInformation -> Bool
$c>= :: PeerInformation -> PeerInformation -> Bool
> :: PeerInformation -> PeerInformation -> Bool
$c> :: PeerInformation -> PeerInformation -> Bool
<= :: PeerInformation -> PeerInformation -> Bool
$c<= :: PeerInformation -> PeerInformation -> Bool
< :: PeerInformation -> PeerInformation -> Bool
$c< :: PeerInformation -> PeerInformation -> Bool
compare :: PeerInformation -> PeerInformation -> Ordering
$ccompare :: PeerInformation -> PeerInformation -> Ordering
$cp1Ord :: Eq PeerInformation
Ord, (forall x. PeerInformation -> Rep PeerInformation x)
-> (forall x. Rep PeerInformation x -> PeerInformation)
-> Generic PeerInformation
forall x. Rep PeerInformation x -> PeerInformation
forall x. PeerInformation -> Rep PeerInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PeerInformation x -> PeerInformation
$cfrom :: forall x. PeerInformation -> Rep PeerInformation x
Generic, PeerInformation -> ()
(PeerInformation -> ()) -> NFData PeerInformation
forall a. (a -> ()) -> NFData a
rnf :: PeerInformation -> ()
$crnf :: PeerInformation -> ()
NFData, Get PeerInformation
Putter PeerInformation
Putter PeerInformation
-> Get PeerInformation -> Serialize PeerInformation
forall t. Putter t -> Get t -> Serialize t
get :: Get PeerInformation
$cget :: Get PeerInformation
put :: Putter PeerInformation
$cput :: Putter PeerInformation
Serialize)

instance ToJSON PeerInformation where
    toJSON :: PeerInformation -> Value
toJSON p :: PeerInformation
p = [Pair] -> Value
object
        [ "useragent"   Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (PeerInformation -> ByteString
peerUserAgent PeerInformation
p))
        , "address"     Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PeerInformation -> String
peerAddress PeerInformation
p
        , "version"     Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PeerInformation -> Fingerprint
peerVersion PeerInformation
p
        , "services"    Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
encodeHex (Word64 -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (PeerInformation -> Word64
peerServices PeerInformation
p)))
        , "relay"       Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PeerInformation -> Bool
peerRelay PeerInformation
p
        ]
    toEncoding :: PeerInformation -> Encoding
toEncoding p :: PeerInformation
p = Series -> Encoding
pairs
        (  "useragent"   Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (PeerInformation -> ByteString
peerUserAgent PeerInformation
p))
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "address"     Text -> String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PeerInformation -> String
peerAddress PeerInformation
p
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "version"     Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PeerInformation -> Fingerprint
peerVersion PeerInformation
p
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "services"    Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (ByteString -> Text
encodeHex (Word64 -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (PeerInformation -> Word64
peerServices PeerInformation
p)))
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "relay"       Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PeerInformation -> Bool
peerRelay PeerInformation
p
        )

instance FromJSON PeerInformation where
    parseJSON :: Value -> Parser PeerInformation
parseJSON =
        String
-> (Object -> Parser PeerInformation)
-> Value
-> Parser PeerInformation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "peerinformation" ((Object -> Parser PeerInformation)
 -> Value -> Parser PeerInformation)
-> (Object -> Parser PeerInformation)
-> Value
-> Parser PeerInformation
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            String useragent :: Text
useragent <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "useragent"
            String
address <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "address"
            Fingerprint
version <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
            Word64
services <-
                Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "services" Parser Text -> (Text -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser ByteString
jsonHex Parser ByteString -> (ByteString -> Parser Word64) -> Parser Word64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: ByteString
b ->
                    case ByteString -> Either String Word64
forall a. Serialize a => ByteString -> Either String a
S.decode ByteString
b of
                        Left e :: String
e  -> String -> Parser Word64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Word64) -> String -> Parser Word64
forall a b. (a -> b) -> a -> b
$ "Could not decode services: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
                        Right s :: Word64
s -> Word64 -> Parser Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
s
            Bool
relay <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "relay"
            PeerInformation -> Parser PeerInformation
forall (m :: * -> *) a. Monad m => a -> m a
return
                $WPeerInformation :: ByteString
-> String -> Fingerprint -> Word64 -> Bool -> PeerInformation
PeerInformation
                    { peerUserAgent :: ByteString
peerUserAgent = Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
useragent
                    , peerAddress :: String
peerAddress = String
address
                    , peerVersion :: Fingerprint
peerVersion = Fingerprint
version
                    , peerServices :: Word64
peerServices = Word64
services
                    , peerRelay :: Bool
peerRelay = Bool
relay
                    }

-- | Address balances for an extended public key.
data XPubBal =
    XPubBal
        { XPubBal -> [Fingerprint]
xPubBalPath :: ![KeyIndex]
        , XPubBal -> Balance
xPubBal     :: !Balance
        }
    deriving (Int -> XPubBal -> ShowS
[XPubBal] -> ShowS
XPubBal -> String
(Int -> XPubBal -> ShowS)
-> (XPubBal -> String) -> ([XPubBal] -> ShowS) -> Show XPubBal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPubBal] -> ShowS
$cshowList :: [XPubBal] -> ShowS
show :: XPubBal -> String
$cshow :: XPubBal -> String
showsPrec :: Int -> XPubBal -> ShowS
$cshowsPrec :: Int -> XPubBal -> ShowS
Show, Eq XPubBal
Eq XPubBal =>
(XPubBal -> XPubBal -> Ordering)
-> (XPubBal -> XPubBal -> Bool)
-> (XPubBal -> XPubBal -> Bool)
-> (XPubBal -> XPubBal -> Bool)
-> (XPubBal -> XPubBal -> Bool)
-> (XPubBal -> XPubBal -> XPubBal)
-> (XPubBal -> XPubBal -> XPubBal)
-> Ord XPubBal
XPubBal -> XPubBal -> Bool
XPubBal -> XPubBal -> Ordering
XPubBal -> XPubBal -> XPubBal
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XPubBal -> XPubBal -> XPubBal
$cmin :: XPubBal -> XPubBal -> XPubBal
max :: XPubBal -> XPubBal -> XPubBal
$cmax :: XPubBal -> XPubBal -> XPubBal
>= :: XPubBal -> XPubBal -> Bool
$c>= :: XPubBal -> XPubBal -> Bool
> :: XPubBal -> XPubBal -> Bool
$c> :: XPubBal -> XPubBal -> Bool
<= :: XPubBal -> XPubBal -> Bool
$c<= :: XPubBal -> XPubBal -> Bool
< :: XPubBal -> XPubBal -> Bool
$c< :: XPubBal -> XPubBal -> Bool
compare :: XPubBal -> XPubBal -> Ordering
$ccompare :: XPubBal -> XPubBal -> Ordering
$cp1Ord :: Eq XPubBal
Ord, XPubBal -> XPubBal -> Bool
(XPubBal -> XPubBal -> Bool)
-> (XPubBal -> XPubBal -> Bool) -> Eq XPubBal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPubBal -> XPubBal -> Bool
$c/= :: XPubBal -> XPubBal -> Bool
== :: XPubBal -> XPubBal -> Bool
$c== :: XPubBal -> XPubBal -> Bool
Eq, (forall x. XPubBal -> Rep XPubBal x)
-> (forall x. Rep XPubBal x -> XPubBal) -> Generic XPubBal
forall x. Rep XPubBal x -> XPubBal
forall x. XPubBal -> Rep XPubBal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPubBal x -> XPubBal
$cfrom :: forall x. XPubBal -> Rep XPubBal x
Generic, Get XPubBal
Putter XPubBal
Putter XPubBal -> Get XPubBal -> Serialize XPubBal
forall t. Putter t -> Get t -> Serialize t
get :: Get XPubBal
$cget :: Get XPubBal
put :: Putter XPubBal
$cput :: Putter XPubBal
Serialize, XPubBal -> ()
(XPubBal -> ()) -> NFData XPubBal
forall a. (a -> ()) -> NFData a
rnf :: XPubBal -> ()
$crnf :: XPubBal -> ()
NFData)

xPubBalToJSON :: Network -> XPubBal -> Value
xPubBalToJSON :: Network -> XPubBal -> Value
xPubBalToJSON net :: Network
net XPubBal {xPubBalPath :: XPubBal -> [Fingerprint]
xPubBalPath = [Fingerprint]
p, xPubBal :: XPubBal -> Balance
xPubBal = Balance
b} =
    [Pair] -> Value
object ["path" Text -> [Fingerprint] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Fingerprint]
p, "balance" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> Balance -> Value
balanceToJSON Network
net Balance
b]

xPubBalToEncoding :: Network -> XPubBal -> Encoding
xPubBalToEncoding :: Network -> XPubBal -> Encoding
xPubBalToEncoding net :: Network
net XPubBal {xPubBalPath :: XPubBal -> [Fingerprint]
xPubBalPath = [Fingerprint]
p, xPubBal :: XPubBal -> Balance
xPubBal = Balance
b} =
    Series -> Encoding
pairs ("path" Text -> [Fingerprint] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Fingerprint]
p Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "balance" Text -> Encoding -> Series
`pair` Network -> Balance -> Encoding
balanceToEncoding Network
net Balance
b)

xPubBalParseJSON :: Network -> Value -> Parser XPubBal
xPubBalParseJSON :: Network -> Value -> Parser XPubBal
xPubBalParseJSON net :: Network
net =
    String -> (Object -> Parser XPubBal) -> Value -> Parser XPubBal
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "xpubbal" ((Object -> Parser XPubBal) -> Value -> Parser XPubBal)
-> (Object -> Parser XPubBal) -> Value -> Parser XPubBal
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        [Fingerprint]
path <- Object
o Object -> Text -> Parser [Fingerprint]
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
        Balance
balance <- Network -> Value -> Parser Balance
balanceParseJSON Network
net (Value -> Parser Balance) -> Parser Value -> Parser Balance
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "balance"
        XPubBal -> Parser XPubBal
forall (m :: * -> *) a. Monad m => a -> m a
return $WXPubBal :: [Fingerprint] -> Balance -> XPubBal
XPubBal {xPubBalPath :: [Fingerprint]
xPubBalPath = [Fingerprint]
path, xPubBal :: Balance
xPubBal = Balance
balance}

-- | Unspent transaction for extended public key.
data XPubUnspent =
    XPubUnspent
        { XPubUnspent -> [Fingerprint]
xPubUnspentPath :: ![KeyIndex]
        , XPubUnspent -> Unspent
xPubUnspent     :: !Unspent
        }
    deriving (Int -> XPubUnspent -> ShowS
[XPubUnspent] -> ShowS
XPubUnspent -> String
(Int -> XPubUnspent -> ShowS)
-> (XPubUnspent -> String)
-> ([XPubUnspent] -> ShowS)
-> Show XPubUnspent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPubUnspent] -> ShowS
$cshowList :: [XPubUnspent] -> ShowS
show :: XPubUnspent -> String
$cshow :: XPubUnspent -> String
showsPrec :: Int -> XPubUnspent -> ShowS
$cshowsPrec :: Int -> XPubUnspent -> ShowS
Show, XPubUnspent -> XPubUnspent -> Bool
(XPubUnspent -> XPubUnspent -> Bool)
-> (XPubUnspent -> XPubUnspent -> Bool) -> Eq XPubUnspent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPubUnspent -> XPubUnspent -> Bool
$c/= :: XPubUnspent -> XPubUnspent -> Bool
== :: XPubUnspent -> XPubUnspent -> Bool
$c== :: XPubUnspent -> XPubUnspent -> Bool
Eq, (forall x. XPubUnspent -> Rep XPubUnspent x)
-> (forall x. Rep XPubUnspent x -> XPubUnspent)
-> Generic XPubUnspent
forall x. Rep XPubUnspent x -> XPubUnspent
forall x. XPubUnspent -> Rep XPubUnspent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPubUnspent x -> XPubUnspent
$cfrom :: forall x. XPubUnspent -> Rep XPubUnspent x
Generic, Get XPubUnspent
Putter XPubUnspent
Putter XPubUnspent -> Get XPubUnspent -> Serialize XPubUnspent
forall t. Putter t -> Get t -> Serialize t
get :: Get XPubUnspent
$cget :: Get XPubUnspent
put :: Putter XPubUnspent
$cput :: Putter XPubUnspent
Serialize, XPubUnspent -> ()
(XPubUnspent -> ()) -> NFData XPubUnspent
forall a. (a -> ()) -> NFData a
rnf :: XPubUnspent -> ()
$crnf :: XPubUnspent -> ()
NFData)

xPubUnspentToJSON :: Network -> XPubUnspent -> Value
xPubUnspentToJSON :: Network -> XPubUnspent -> Value
xPubUnspentToJSON net :: Network
net XPubUnspent {xPubUnspentPath :: XPubUnspent -> [Fingerprint]
xPubUnspentPath = [Fingerprint]
p, xPubUnspent :: XPubUnspent -> Unspent
xPubUnspent = Unspent
u} =
    [Pair] -> Value
object ["path" Text -> [Fingerprint] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Fingerprint]
p, "unspent" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> Unspent -> Value
unspentToJSON Network
net Unspent
u]

xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding
xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding
xPubUnspentToEncoding net :: Network
net XPubUnspent {xPubUnspentPath :: XPubUnspent -> [Fingerprint]
xPubUnspentPath = [Fingerprint]
p, xPubUnspent :: XPubUnspent -> Unspent
xPubUnspent = Unspent
u} =
    Series -> Encoding
pairs ("path" Text -> [Fingerprint] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Fingerprint]
p Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "unspent" Text -> Encoding -> Series
`pair` Network -> Unspent -> Encoding
unspentToEncoding Network
net Unspent
u)

xPubUnspentParseJSON :: Network -> Value -> Parser XPubUnspent
xPubUnspentParseJSON :: Network -> Value -> Parser XPubUnspent
xPubUnspentParseJSON net :: Network
net =
    String
-> (Object -> Parser XPubUnspent) -> Value -> Parser XPubUnspent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "xpubunspent" ((Object -> Parser XPubUnspent) -> Value -> Parser XPubUnspent)
-> (Object -> Parser XPubUnspent) -> Value -> Parser XPubUnspent
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        [Fingerprint]
p <- Object
o Object -> Text -> Parser [Fingerprint]
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
        Unspent
u <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "unspent" Parser Value -> (Value -> Parser Unspent) -> Parser Unspent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Network -> Value -> Parser Unspent
unspentParseJSON Network
net
        XPubUnspent -> Parser XPubUnspent
forall (m :: * -> *) a. Monad m => a -> m a
return $WXPubUnspent :: [Fingerprint] -> Unspent -> XPubUnspent
XPubUnspent {xPubUnspentPath :: [Fingerprint]
xPubUnspentPath = [Fingerprint]
p, xPubUnspent :: Unspent
xPubUnspent = Unspent
u}

data XPubSummary =
    XPubSummary
        { XPubSummary -> Word64
xPubSummaryConfirmed :: !Word64
        , XPubSummary -> Word64
xPubSummaryZero      :: !Word64
        , XPubSummary -> Word64
xPubSummaryReceived  :: !Word64
        , XPubSummary -> Word64
xPubUnspentCount     :: !Word64
        , XPubSummary -> Fingerprint
xPubExternalIndex    :: !Word32
        , XPubSummary -> Fingerprint
xPubChangeIndex      :: !Word32
        }
    deriving (XPubSummary -> XPubSummary -> Bool
(XPubSummary -> XPubSummary -> Bool)
-> (XPubSummary -> XPubSummary -> Bool) -> Eq XPubSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPubSummary -> XPubSummary -> Bool
$c/= :: XPubSummary -> XPubSummary -> Bool
== :: XPubSummary -> XPubSummary -> Bool
$c== :: XPubSummary -> XPubSummary -> Bool
Eq, Int -> XPubSummary -> ShowS
[XPubSummary] -> ShowS
XPubSummary -> String
(Int -> XPubSummary -> ShowS)
-> (XPubSummary -> String)
-> ([XPubSummary] -> ShowS)
-> Show XPubSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPubSummary] -> ShowS
$cshowList :: [XPubSummary] -> ShowS
show :: XPubSummary -> String
$cshow :: XPubSummary -> String
showsPrec :: Int -> XPubSummary -> ShowS
$cshowsPrec :: Int -> XPubSummary -> ShowS
Show, (forall x. XPubSummary -> Rep XPubSummary x)
-> (forall x. Rep XPubSummary x -> XPubSummary)
-> Generic XPubSummary
forall x. Rep XPubSummary x -> XPubSummary
forall x. XPubSummary -> Rep XPubSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPubSummary x -> XPubSummary
$cfrom :: forall x. XPubSummary -> Rep XPubSummary x
Generic, Get XPubSummary
Putter XPubSummary
Putter XPubSummary -> Get XPubSummary -> Serialize XPubSummary
forall t. Putter t -> Get t -> Serialize t
get :: Get XPubSummary
$cget :: Get XPubSummary
put :: Putter XPubSummary
$cput :: Putter XPubSummary
Serialize, XPubSummary -> ()
(XPubSummary -> ()) -> NFData XPubSummary
forall a. (a -> ()) -> NFData a
rnf :: XPubSummary -> ()
$crnf :: XPubSummary -> ()
NFData)

instance ToJSON XPubSummary where
    toJSON :: XPubSummary -> Value
toJSON XPubSummary { xPubSummaryConfirmed :: XPubSummary -> Word64
xPubSummaryConfirmed = Word64
c
                       , xPubSummaryZero :: XPubSummary -> Word64
xPubSummaryZero = Word64
z
                       , xPubSummaryReceived :: XPubSummary -> Word64
xPubSummaryReceived = Word64
r
                       , xPubUnspentCount :: XPubSummary -> Word64
xPubUnspentCount = Word64
u
                       , xPubExternalIndex :: XPubSummary -> Fingerprint
xPubExternalIndex = Fingerprint
ext
                       , xPubChangeIndex :: XPubSummary -> Fingerprint
xPubChangeIndex = Fingerprint
ch
                       } =
        [Pair] -> Value
object
            [ "balance" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
              [Pair] -> Value
object
                  [ "confirmed" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
c
                  , "unconfirmed" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
z
                  , "received" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
r
                  , "utxo" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
u
                  ]
            , "indices" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object ["change" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
ch, "external" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
ext]
            ]
    toEncoding :: XPubSummary -> Encoding
toEncoding XPubSummary { xPubSummaryConfirmed :: XPubSummary -> Word64
xPubSummaryConfirmed = Word64
c
                       , xPubSummaryZero :: XPubSummary -> Word64
xPubSummaryZero = Word64
z
                       , xPubSummaryReceived :: XPubSummary -> Word64
xPubSummaryReceived = Word64
r
                       , xPubUnspentCount :: XPubSummary -> Word64
xPubUnspentCount = Word64
u
                       , xPubExternalIndex :: XPubSummary -> Fingerprint
xPubExternalIndex = Fingerprint
ext
                       , xPubChangeIndex :: XPubSummary -> Fingerprint
xPubChangeIndex = Fingerprint
ch
                       } =
        Series -> Encoding
pairs
            (  "balance" Text -> Encoding -> Series
`pair` Series -> Encoding
pairs
                (  "confirmed" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
c
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "unconfirmed" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
z
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "received" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
r
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "utxo" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
u
                )
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "indices" Text -> Encoding -> Series
`pair` Series -> Encoding
pairs
                (  "change" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
ch
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "external" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
ext
                )
            )

instance FromJSON XPubSummary where
    parseJSON :: Value -> Parser XPubSummary
parseJSON =
        String
-> (Object -> Parser XPubSummary) -> Value -> Parser XPubSummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "xpubsummary" ((Object -> Parser XPubSummary) -> Value -> Parser XPubSummary)
-> (Object -> Parser XPubSummary) -> Value -> Parser XPubSummary
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Object
b <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: "balance"
            Object
i <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: "indices"
            Word64
conf <- Object
b Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "confirmed"
            Word64
unconfirmed <- Object
b Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "unconfirmed"
            Word64
received <- Object
b Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "received"
            Word64
utxo <- Object
b Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "utxo"
            Fingerprint
change <- Object
i Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "change"
            Fingerprint
external <- Object
i Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "external"
            XPubSummary -> Parser XPubSummary
forall (m :: * -> *) a. Monad m => a -> m a
return
                $WXPubSummary :: Word64
-> Word64
-> Word64
-> Word64
-> Fingerprint
-> Fingerprint
-> XPubSummary
XPubSummary
                    { xPubSummaryConfirmed :: Word64
xPubSummaryConfirmed = Word64
conf
                    , xPubSummaryZero :: Word64
xPubSummaryZero = Word64
unconfirmed
                    , xPubSummaryReceived :: Word64
xPubSummaryReceived = Word64
received
                    , xPubUnspentCount :: Word64
xPubUnspentCount = Word64
utxo
                    , xPubExternalIndex :: Fingerprint
xPubExternalIndex = Fingerprint
external
                    , xPubChangeIndex :: Fingerprint
xPubChangeIndex = Fingerprint
change
                    }

class Healthy a where
    isOK :: a -> Bool

data BlockHealth =
    BlockHealth
        { BlockHealth -> Fingerprint
blockHealthHeaders :: !BlockHeight
        , BlockHealth -> Fingerprint
blockHealthBlocks  :: !BlockHeight
        , BlockHealth -> Int
blockHealthMaxDiff :: !Int
        }
    deriving (Int -> BlockHealth -> ShowS
[BlockHealth] -> ShowS
BlockHealth -> String
(Int -> BlockHealth -> ShowS)
-> (BlockHealth -> String)
-> ([BlockHealth] -> ShowS)
-> Show BlockHealth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockHealth] -> ShowS
$cshowList :: [BlockHealth] -> ShowS
show :: BlockHealth -> String
$cshow :: BlockHealth -> String
showsPrec :: Int -> BlockHealth -> ShowS
$cshowsPrec :: Int -> BlockHealth -> ShowS
Show, BlockHealth -> BlockHealth -> Bool
(BlockHealth -> BlockHealth -> Bool)
-> (BlockHealth -> BlockHealth -> Bool) -> Eq BlockHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockHealth -> BlockHealth -> Bool
$c/= :: BlockHealth -> BlockHealth -> Bool
== :: BlockHealth -> BlockHealth -> Bool
$c== :: BlockHealth -> BlockHealth -> Bool
Eq, (forall x. BlockHealth -> Rep BlockHealth x)
-> (forall x. Rep BlockHealth x -> BlockHealth)
-> Generic BlockHealth
forall x. Rep BlockHealth x -> BlockHealth
forall x. BlockHealth -> Rep BlockHealth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockHealth x -> BlockHealth
$cfrom :: forall x. BlockHealth -> Rep BlockHealth x
Generic, BlockHealth -> ()
(BlockHealth -> ()) -> NFData BlockHealth
forall a. (a -> ()) -> NFData a
rnf :: BlockHealth -> ()
$crnf :: BlockHealth -> ()
NFData)

instance Serialize BlockHealth where
    put :: Putter BlockHealth
put h :: BlockHealth
h@BlockHealth {..} = do
        Putter Bool
forall t. Serialize t => Putter t
put (BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h)
        Putter Fingerprint
forall t. Serialize t => Putter t
put Fingerprint
blockHealthHeaders
        Putter Fingerprint
forall t. Serialize t => Putter t
put Fingerprint
blockHealthBlocks
        Putter Int
forall t. Serialize t => Putter t
put Int
blockHealthMaxDiff
    get :: Get BlockHealth
get = do
        Bool
k <- Get Bool
forall t. Serialize t => Get t
get
        Fingerprint
blockHealthHeaders <- Get Fingerprint
forall t. Serialize t => Get t
get
        Fingerprint
blockHealthBlocks  <- Get Fingerprint
forall t. Serialize t => Get t
get
        Int
blockHealthMaxDiff <- Get Int
forall t. Serialize t => Get t
get
        let h :: BlockHealth
h = $WBlockHealth :: Fingerprint -> Fingerprint -> Int -> BlockHealth
BlockHealth {..}
        Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h)
        BlockHealth -> Get BlockHealth
forall (m :: * -> *) a. Monad m => a -> m a
return BlockHealth
h

instance Healthy BlockHealth where
    isOK :: BlockHealth -> Bool
isOK BlockHealth {..} =
        Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
blockHealthMaxDiff
      where
        h :: Int
h = Fingerprint -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fingerprint
blockHealthHeaders
        b :: Int
b = Fingerprint -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fingerprint
blockHealthBlocks

instance ToJSON BlockHealth where
    toJSON :: BlockHealth -> Value
toJSON h :: BlockHealth
h@BlockHealth {..} =
        [Pair] -> Value
object
            [ "headers"  Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
blockHealthHeaders
            , "blocks"   Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
blockHealthBlocks
            , "diff"     Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
diff
            , "max"      Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
blockHealthMaxDiff
            , "ok"       Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h
            ]
      where
        diff :: Fingerprint
diff = Fingerprint
blockHealthHeaders Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
- Fingerprint
blockHealthBlocks

instance FromJSON BlockHealth where
    parseJSON :: Value -> Parser BlockHealth
parseJSON =
        String
-> (Object -> Parser BlockHealth) -> Value -> Parser BlockHealth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "BlockHealth" ((Object -> Parser BlockHealth) -> Value -> Parser BlockHealth)
-> (Object -> Parser BlockHealth) -> Value -> Parser BlockHealth
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Fingerprint
blockHealthHeaders  <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "headers"
            Fingerprint
blockHealthBlocks   <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "blocks"
            Int
blockHealthMaxDiff  <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "max"
            BlockHealth -> Parser BlockHealth
forall (m :: * -> *) a. Monad m => a -> m a
return $WBlockHealth :: Fingerprint -> Fingerprint -> Int -> BlockHealth
BlockHealth {..}

data TimeHealth =
    TimeHealth
        { TimeHealth -> Int
timeHealthAge :: !Int
        , TimeHealth -> Int
timeHealthMax :: !Int
        }
    deriving (Int -> TimeHealth -> ShowS
[TimeHealth] -> ShowS
TimeHealth -> String
(Int -> TimeHealth -> ShowS)
-> (TimeHealth -> String)
-> ([TimeHealth] -> ShowS)
-> Show TimeHealth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeHealth] -> ShowS
$cshowList :: [TimeHealth] -> ShowS
show :: TimeHealth -> String
$cshow :: TimeHealth -> String
showsPrec :: Int -> TimeHealth -> ShowS
$cshowsPrec :: Int -> TimeHealth -> ShowS
Show, TimeHealth -> TimeHealth -> Bool
(TimeHealth -> TimeHealth -> Bool)
-> (TimeHealth -> TimeHealth -> Bool) -> Eq TimeHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeHealth -> TimeHealth -> Bool
$c/= :: TimeHealth -> TimeHealth -> Bool
== :: TimeHealth -> TimeHealth -> Bool
$c== :: TimeHealth -> TimeHealth -> Bool
Eq, (forall x. TimeHealth -> Rep TimeHealth x)
-> (forall x. Rep TimeHealth x -> TimeHealth) -> Generic TimeHealth
forall x. Rep TimeHealth x -> TimeHealth
forall x. TimeHealth -> Rep TimeHealth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeHealth x -> TimeHealth
$cfrom :: forall x. TimeHealth -> Rep TimeHealth x
Generic, TimeHealth -> ()
(TimeHealth -> ()) -> NFData TimeHealth
forall a. (a -> ()) -> NFData a
rnf :: TimeHealth -> ()
$crnf :: TimeHealth -> ()
NFData)

instance Serialize TimeHealth where
    put :: Putter TimeHealth
put h :: TimeHealth
h@TimeHealth {..} = do
        Putter Bool
forall t. Serialize t => Putter t
put (TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
h)
        Putter Int
forall t. Serialize t => Putter t
put Int
timeHealthAge
        Putter Int
forall t. Serialize t => Putter t
put Int
timeHealthMax
    get :: Get TimeHealth
get = do
        Bool
k <- Get Bool
forall t. Serialize t => Get t
get
        Int
timeHealthAge <- Get Int
forall t. Serialize t => Get t
get
        Int
timeHealthMax <- Get Int
forall t. Serialize t => Get t
get
        let t :: TimeHealth
t = $WTimeHealth :: Int -> Int -> TimeHealth
TimeHealth {..}
        Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
t)
        TimeHealth -> Get TimeHealth
forall (m :: * -> *) a. Monad m => a -> m a
return TimeHealth
t

instance Healthy TimeHealth where
    isOK :: TimeHealth -> Bool
isOK TimeHealth {..} =
        Int
timeHealthAge Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
timeHealthMax

instance ToJSON TimeHealth where
    toJSON :: TimeHealth -> Value
toJSON h :: TimeHealth
h@TimeHealth {..} =
        [Pair] -> Value
object
            [ "age"  Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
timeHealthAge
            , "max"  Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
timeHealthMax
            , "ok"   Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
h
            ]

instance FromJSON TimeHealth where
    parseJSON :: Value -> Parser TimeHealth
parseJSON =
        String
-> (Object -> Parser TimeHealth) -> Value -> Parser TimeHealth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "TimeHealth" ((Object -> Parser TimeHealth) -> Value -> Parser TimeHealth)
-> (Object -> Parser TimeHealth) -> Value -> Parser TimeHealth
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Int
timeHealthAge <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "age"
            Int
timeHealthMax <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "max"
            TimeHealth -> Parser TimeHealth
forall (m :: * -> *) a. Monad m => a -> m a
return $WTimeHealth :: Int -> Int -> TimeHealth
TimeHealth {..}

data CountHealth =
    CountHealth
        { CountHealth -> Int
countHealthNum :: !Int
        , CountHealth -> Int
countHealthMin :: !Int
        }
    deriving (Int -> CountHealth -> ShowS
[CountHealth] -> ShowS
CountHealth -> String
(Int -> CountHealth -> ShowS)
-> (CountHealth -> String)
-> ([CountHealth] -> ShowS)
-> Show CountHealth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CountHealth] -> ShowS
$cshowList :: [CountHealth] -> ShowS
show :: CountHealth -> String
$cshow :: CountHealth -> String
showsPrec :: Int -> CountHealth -> ShowS
$cshowsPrec :: Int -> CountHealth -> ShowS
Show, CountHealth -> CountHealth -> Bool
(CountHealth -> CountHealth -> Bool)
-> (CountHealth -> CountHealth -> Bool) -> Eq CountHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CountHealth -> CountHealth -> Bool
$c/= :: CountHealth -> CountHealth -> Bool
== :: CountHealth -> CountHealth -> Bool
$c== :: CountHealth -> CountHealth -> Bool
Eq, (forall x. CountHealth -> Rep CountHealth x)
-> (forall x. Rep CountHealth x -> CountHealth)
-> Generic CountHealth
forall x. Rep CountHealth x -> CountHealth
forall x. CountHealth -> Rep CountHealth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CountHealth x -> CountHealth
$cfrom :: forall x. CountHealth -> Rep CountHealth x
Generic, CountHealth -> ()
(CountHealth -> ()) -> NFData CountHealth
forall a. (a -> ()) -> NFData a
rnf :: CountHealth -> ()
$crnf :: CountHealth -> ()
NFData)

instance Serialize CountHealth where
    put :: Putter CountHealth
put h :: CountHealth
h@CountHealth {..} = do
        Putter Bool
forall t. Serialize t => Putter t
put (CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
h)
        Putter Int
forall t. Serialize t => Putter t
put Int
countHealthNum
        Putter Int
forall t. Serialize t => Putter t
put Int
countHealthMin
    get :: Get CountHealth
get = do
        Bool
k <- Get Bool
forall t. Serialize t => Get t
get
        Int
countHealthNum <- Get Int
forall t. Serialize t => Get t
get
        Int
countHealthMin <- Get Int
forall t. Serialize t => Get t
get
        let c :: CountHealth
c = $WCountHealth :: Int -> Int -> CountHealth
CountHealth {..}
        Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
c)
        CountHealth -> Get CountHealth
forall (m :: * -> *) a. Monad m => a -> m a
return CountHealth
c

instance Healthy CountHealth where
    isOK :: CountHealth -> Bool
isOK CountHealth {..} =
        Int
countHealthMin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
countHealthNum

instance ToJSON CountHealth where
    toJSON :: CountHealth -> Value
toJSON h :: CountHealth
h@CountHealth {..} =
        [Pair] -> Value
object
            [ "count"  Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
countHealthNum
            , "min"    Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
countHealthMin
            , "ok"     Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
h
            ]

instance FromJSON CountHealth where
    parseJSON :: Value -> Parser CountHealth
parseJSON =
        String
-> (Object -> Parser CountHealth) -> Value -> Parser CountHealth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "CountHealth" ((Object -> Parser CountHealth) -> Value -> Parser CountHealth)
-> (Object -> Parser CountHealth) -> Value -> Parser CountHealth
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Int
countHealthNum <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "count"
            Int
countHealthMin <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "min"
            CountHealth -> Parser CountHealth
forall (m :: * -> *) a. Monad m => a -> m a
return $WCountHealth :: Int -> Int -> CountHealth
CountHealth {..}

data MaxHealth =
    MaxHealth
        { MaxHealth -> Int
maxHealthNum :: !Int
        , MaxHealth -> Int
maxHealthMax :: !Int
        }
    deriving (Int -> MaxHealth -> ShowS
[MaxHealth] -> ShowS
MaxHealth -> String
(Int -> MaxHealth -> ShowS)
-> (MaxHealth -> String)
-> ([MaxHealth] -> ShowS)
-> Show MaxHealth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxHealth] -> ShowS
$cshowList :: [MaxHealth] -> ShowS
show :: MaxHealth -> String
$cshow :: MaxHealth -> String
showsPrec :: Int -> MaxHealth -> ShowS
$cshowsPrec :: Int -> MaxHealth -> ShowS
Show, MaxHealth -> MaxHealth -> Bool
(MaxHealth -> MaxHealth -> Bool)
-> (MaxHealth -> MaxHealth -> Bool) -> Eq MaxHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxHealth -> MaxHealth -> Bool
$c/= :: MaxHealth -> MaxHealth -> Bool
== :: MaxHealth -> MaxHealth -> Bool
$c== :: MaxHealth -> MaxHealth -> Bool
Eq, (forall x. MaxHealth -> Rep MaxHealth x)
-> (forall x. Rep MaxHealth x -> MaxHealth) -> Generic MaxHealth
forall x. Rep MaxHealth x -> MaxHealth
forall x. MaxHealth -> Rep MaxHealth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaxHealth x -> MaxHealth
$cfrom :: forall x. MaxHealth -> Rep MaxHealth x
Generic, MaxHealth -> ()
(MaxHealth -> ()) -> NFData MaxHealth
forall a. (a -> ()) -> NFData a
rnf :: MaxHealth -> ()
$crnf :: MaxHealth -> ()
NFData)

instance Serialize MaxHealth where
    put :: Putter MaxHealth
put h :: MaxHealth
h@MaxHealth {..} = do
        Putter Bool
forall t. Serialize t => Putter t
put Putter Bool -> Putter Bool
forall a b. (a -> b) -> a -> b
$ MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
h
        Putter Int
forall t. Serialize t => Putter t
put Int
maxHealthNum
        Putter Int
forall t. Serialize t => Putter t
put Int
maxHealthMax
    get :: Get MaxHealth
get = do
        Bool
k <- Get Bool
forall t. Serialize t => Get t
get
        Int
maxHealthNum <- Get Int
forall t. Serialize t => Get t
get
        Int
maxHealthMax <- Get Int
forall t. Serialize t => Get t
get
        let h :: MaxHealth
h = $WMaxHealth :: Int -> Int -> MaxHealth
MaxHealth {..}
        Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
h)
        MaxHealth -> Get MaxHealth
forall (m :: * -> *) a. Monad m => a -> m a
return MaxHealth
h

instance Healthy MaxHealth where
    isOK :: MaxHealth -> Bool
isOK MaxHealth {..} = Int
maxHealthNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxHealthMax

instance ToJSON MaxHealth where
    toJSON :: MaxHealth -> Value
toJSON h :: MaxHealth
h@MaxHealth {..} =
        [Pair] -> Value
object
            [ "count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
maxHealthNum
            , "max"   Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
maxHealthMax
            , "ok"    Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
h
            ]

instance FromJSON MaxHealth where
    parseJSON :: Value -> Parser MaxHealth
parseJSON =
        String -> (Object -> Parser MaxHealth) -> Value -> Parser MaxHealth
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "MaxHealth" ((Object -> Parser MaxHealth) -> Value -> Parser MaxHealth)
-> (Object -> Parser MaxHealth) -> Value -> Parser MaxHealth
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Int
maxHealthNum <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "count"
            Int
maxHealthMax <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "max"
            MaxHealth -> Parser MaxHealth
forall (m :: * -> *) a. Monad m => a -> m a
return $WMaxHealth :: Int -> Int -> MaxHealth
MaxHealth {..}

data HealthCheck =
    HealthCheck
        { HealthCheck -> BlockHealth
healthBlocks     :: !BlockHealth
        , HealthCheck -> TimeHealth
healthLastBlock  :: !TimeHealth
        , HealthCheck -> TimeHealth
healthLastTx     :: !TimeHealth
        , HealthCheck -> MaxHealth
healthPendingTxs :: !MaxHealth
        , HealthCheck -> CountHealth
healthPeers      :: !CountHealth
        , HealthCheck -> String
healthNetwork    :: !String
        , HealthCheck -> String
healthVersion    :: !String
        }
    deriving (Int -> HealthCheck -> ShowS
[HealthCheck] -> ShowS
HealthCheck -> String
(Int -> HealthCheck -> ShowS)
-> (HealthCheck -> String)
-> ([HealthCheck] -> ShowS)
-> Show HealthCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HealthCheck] -> ShowS
$cshowList :: [HealthCheck] -> ShowS
show :: HealthCheck -> String
$cshow :: HealthCheck -> String
showsPrec :: Int -> HealthCheck -> ShowS
$cshowsPrec :: Int -> HealthCheck -> ShowS
Show, HealthCheck -> HealthCheck -> Bool
(HealthCheck -> HealthCheck -> Bool)
-> (HealthCheck -> HealthCheck -> Bool) -> Eq HealthCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HealthCheck -> HealthCheck -> Bool
$c/= :: HealthCheck -> HealthCheck -> Bool
== :: HealthCheck -> HealthCheck -> Bool
$c== :: HealthCheck -> HealthCheck -> Bool
Eq, (forall x. HealthCheck -> Rep HealthCheck x)
-> (forall x. Rep HealthCheck x -> HealthCheck)
-> Generic HealthCheck
forall x. Rep HealthCheck x -> HealthCheck
forall x. HealthCheck -> Rep HealthCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HealthCheck x -> HealthCheck
$cfrom :: forall x. HealthCheck -> Rep HealthCheck x
Generic, HealthCheck -> ()
(HealthCheck -> ()) -> NFData HealthCheck
forall a. (a -> ()) -> NFData a
rnf :: HealthCheck -> ()
$crnf :: HealthCheck -> ()
NFData)

instance Serialize HealthCheck where
    put :: Putter HealthCheck
put h :: HealthCheck
h@HealthCheck {..} = do
        Putter Bool
forall t. Serialize t => Putter t
put (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h)
        Putter BlockHealth
forall t. Serialize t => Putter t
put BlockHealth
healthBlocks
        Putter TimeHealth
forall t. Serialize t => Putter t
put TimeHealth
healthLastBlock
        Putter TimeHealth
forall t. Serialize t => Putter t
put TimeHealth
healthLastTx
        Putter MaxHealth
forall t. Serialize t => Putter t
put MaxHealth
healthPendingTxs
        Putter CountHealth
forall t. Serialize t => Putter t
put CountHealth
healthPeers
        Putter String
forall t. Serialize t => Putter t
put String
healthNetwork
        Putter String
forall t. Serialize t => Putter t
put String
healthVersion
    get :: Get HealthCheck
get = do
        Bool
k <- Get Bool
forall t. Serialize t => Get t
get
        BlockHealth
healthBlocks        <- Get BlockHealth
forall t. Serialize t => Get t
get
        TimeHealth
healthLastBlock     <- Get TimeHealth
forall t. Serialize t => Get t
get
        TimeHealth
healthLastTx        <- Get TimeHealth
forall t. Serialize t => Get t
get
        MaxHealth
healthPendingTxs    <- Get MaxHealth
forall t. Serialize t => Get t
get
        CountHealth
healthPeers         <- Get CountHealth
forall t. Serialize t => Get t
get
        String
healthNetwork       <- Get String
forall t. Serialize t => Get t
get
        String
healthVersion       <- Get String
forall t. Serialize t => Get t
get
        let h :: HealthCheck
h = $WHealthCheck :: BlockHealth
-> TimeHealth
-> TimeHealth
-> MaxHealth
-> CountHealth
-> String
-> String
-> HealthCheck
HealthCheck {..}
        Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h)
        HealthCheck -> Get HealthCheck
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
h

instance Healthy HealthCheck where
    isOK :: HealthCheck -> Bool
isOK HealthCheck {..} =
        BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
healthBlocks Bool -> Bool -> Bool
&&
        TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
healthLastBlock Bool -> Bool -> Bool
&&
        TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
healthLastTx Bool -> Bool -> Bool
&&
        MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
healthPendingTxs Bool -> Bool -> Bool
&&
        CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
healthPeers

instance ToJSON HealthCheck where
    toJSON :: HealthCheck -> Value
toJSON h :: HealthCheck
h@HealthCheck {..} =
        [Pair] -> Value
object
            [ "blocks"      Text -> BlockHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHealth
healthBlocks
            , "last-block"  Text -> TimeHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TimeHealth
healthLastBlock
            , "last-tx"     Text -> TimeHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TimeHealth
healthLastTx
            , "pending-txs" Text -> MaxHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MaxHealth
healthPendingTxs
            , "peers"       Text -> CountHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= CountHealth
healthPeers
            , "net"         Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
healthNetwork
            , "version"     Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
healthVersion
            , "ok"          Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h
            ]

instance FromJSON HealthCheck where
    parseJSON :: Value -> Parser HealthCheck
parseJSON =
        String
-> (Object -> Parser HealthCheck) -> Value -> Parser HealthCheck
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "HealthCheck" ((Object -> Parser HealthCheck) -> Value -> Parser HealthCheck)
-> (Object -> Parser HealthCheck) -> Value -> Parser HealthCheck
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            BlockHealth
healthBlocks     <- Object
o Object -> Text -> Parser BlockHealth
forall a. FromJSON a => Object -> Text -> Parser a
.: "blocks"
            TimeHealth
healthLastBlock  <- Object
o Object -> Text -> Parser TimeHealth
forall a. FromJSON a => Object -> Text -> Parser a
.: "last-block"
            TimeHealth
healthLastTx     <- Object
o Object -> Text -> Parser TimeHealth
forall a. FromJSON a => Object -> Text -> Parser a
.: "last-tx"
            MaxHealth
healthPendingTxs <- Object
o Object -> Text -> Parser MaxHealth
forall a. FromJSON a => Object -> Text -> Parser a
.: "pending-txs"
            CountHealth
healthPeers      <- Object
o Object -> Text -> Parser CountHealth
forall a. FromJSON a => Object -> Text -> Parser a
.: "peers"
            String
healthNetwork    <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "net"
            String
healthVersion    <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "version"
            HealthCheck -> Parser HealthCheck
forall (m :: * -> *) a. Monad m => a -> m a
return $WHealthCheck :: BlockHealth
-> TimeHealth
-> TimeHealth
-> MaxHealth
-> CountHealth
-> String
-> String
-> HealthCheck
HealthCheck {..}

data Event
    = EventBlock !BlockHash
    | EventTx !TxHash
    deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic, Get Event
Putter Event
Putter Event -> Get Event -> Serialize Event
forall t. Putter t -> Get t -> Serialize t
get :: Get Event
$cget :: Get Event
put :: Putter Event
$cput :: Putter Event
Serialize, Event -> ()
(Event -> ()) -> NFData Event
forall a. (a -> ()) -> NFData a
rnf :: Event -> ()
$crnf :: Event -> ()
NFData)

instance ToJSON Event where
    toJSON :: Event -> Value
toJSON (EventTx h :: TxHash
h)    = [Pair] -> Value
object ["type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "tx", "id" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
h]
    toJSON (EventBlock h :: BlockHash
h) = [Pair] -> Value
object ["type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "block", "id" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
h]
    toEncoding :: Event -> Encoding
toEncoding (EventTx h :: TxHash
h) =
        Series -> Encoding
pairs ("type" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text "tx" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "id" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (TxHash -> Text
txHashToHex TxHash
h))
    toEncoding (EventBlock h :: BlockHash
h) =
        Series -> Encoding
pairs
            ("type" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text "block" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "id" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (BlockHash -> Text
blockHashToHex BlockHash
h))

instance FromJSON Event where
    parseJSON :: Value -> Parser Event
parseJSON =
        String -> (Object -> Parser Event) -> Value -> Parser Event
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "event" ((Object -> Parser Event) -> Value -> Parser Event)
-> (Object -> Parser Event) -> Value -> Parser Event
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            String
t <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
            case String
t of
                "tx" -> do
                    TxHash
i <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
                    Event -> Parser Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Parser Event) -> Event -> Parser Event
forall a b. (a -> b) -> a -> b
$ TxHash -> Event
EventTx TxHash
i
                "block" -> do
                    BlockHash
i <- Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
                    Event -> Parser Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Parser Event) -> Event -> Parser Event
forall a b. (a -> b) -> a -> b
$ BlockHash -> Event
EventBlock BlockHash
i
                _ -> String -> Parser Event
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Event) -> String -> Parser Event
forall a b. (a -> b) -> a -> b
$ "Could not recognize event type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t

newtype GenericResult a =
    GenericResult
        { GenericResult a -> a
getResult :: a
        }
    deriving (Int -> GenericResult a -> ShowS
[GenericResult a] -> ShowS
GenericResult a -> String
(Int -> GenericResult a -> ShowS)
-> (GenericResult a -> String)
-> ([GenericResult a] -> ShowS)
-> Show (GenericResult a)
forall a. Show a => Int -> GenericResult a -> ShowS
forall a. Show a => [GenericResult a] -> ShowS
forall a. Show a => GenericResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericResult a] -> ShowS
$cshowList :: forall a. Show a => [GenericResult a] -> ShowS
show :: GenericResult a -> String
$cshow :: forall a. Show a => GenericResult a -> String
showsPrec :: Int -> GenericResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericResult a -> ShowS
Show, GenericResult a -> GenericResult a -> Bool
(GenericResult a -> GenericResult a -> Bool)
-> (GenericResult a -> GenericResult a -> Bool)
-> Eq (GenericResult a)
forall a. Eq a => GenericResult a -> GenericResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericResult a -> GenericResult a -> Bool
$c/= :: forall a. Eq a => GenericResult a -> GenericResult a -> Bool
== :: GenericResult a -> GenericResult a -> Bool
$c== :: forall a. Eq a => GenericResult a -> GenericResult a -> Bool
Eq, (forall x. GenericResult a -> Rep (GenericResult a) x)
-> (forall x. Rep (GenericResult a) x -> GenericResult a)
-> Generic (GenericResult a)
forall x. Rep (GenericResult a) x -> GenericResult a
forall x. GenericResult a -> Rep (GenericResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (GenericResult a) x -> GenericResult a
forall a x. GenericResult a -> Rep (GenericResult a) x
$cto :: forall a x. Rep (GenericResult a) x -> GenericResult a
$cfrom :: forall a x. GenericResult a -> Rep (GenericResult a) x
Generic, Get (GenericResult a)
Putter (GenericResult a)
Putter (GenericResult a)
-> Get (GenericResult a) -> Serialize (GenericResult a)
forall a. Serialize a => Get (GenericResult a)
forall a. Serialize a => Putter (GenericResult a)
forall t. Putter t -> Get t -> Serialize t
get :: Get (GenericResult a)
$cget :: forall a. Serialize a => Get (GenericResult a)
put :: Putter (GenericResult a)
$cput :: forall a. Serialize a => Putter (GenericResult a)
Serialize, GenericResult a -> ()
(GenericResult a -> ()) -> NFData (GenericResult a)
forall a. NFData a => GenericResult a -> ()
forall a. (a -> ()) -> NFData a
rnf :: GenericResult a -> ()
$crnf :: forall a. NFData a => GenericResult a -> ()
NFData)

instance ToJSON a => ToJSON (GenericResult a) where
    toJSON :: GenericResult a -> Value
toJSON (GenericResult b :: a
b) = [Pair] -> Value
object ["result" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
b]
    toEncoding :: GenericResult a -> Encoding
toEncoding (GenericResult b :: a
b) = Series -> Encoding
pairs ("result" Text -> a -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
b)

instance FromJSON a => FromJSON (GenericResult a) where
    parseJSON :: Value -> Parser (GenericResult a)
parseJSON =
        String
-> (Object -> Parser (GenericResult a))
-> Value
-> Parser (GenericResult a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "GenericResult" ((Object -> Parser (GenericResult a))
 -> Value -> Parser (GenericResult a))
-> (Object -> Parser (GenericResult a))
-> Value
-> Parser (GenericResult a)
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> a -> GenericResult a
forall a. a -> GenericResult a
GenericResult (a -> GenericResult a) -> Parser a -> Parser (GenericResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: "result"

newtype RawResult a =
    RawResult
        { RawResult a -> a
getRawResult :: a
        }
    deriving (Int -> RawResult a -> ShowS
[RawResult a] -> ShowS
RawResult a -> String
(Int -> RawResult a -> ShowS)
-> (RawResult a -> String)
-> ([RawResult a] -> ShowS)
-> Show (RawResult a)
forall a. Show a => Int -> RawResult a -> ShowS
forall a. Show a => [RawResult a] -> ShowS
forall a. Show a => RawResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawResult a] -> ShowS
$cshowList :: forall a. Show a => [RawResult a] -> ShowS
show :: RawResult a -> String
$cshow :: forall a. Show a => RawResult a -> String
showsPrec :: Int -> RawResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RawResult a -> ShowS
Show, RawResult a -> RawResult a -> Bool
(RawResult a -> RawResult a -> Bool)
-> (RawResult a -> RawResult a -> Bool) -> Eq (RawResult a)
forall a. Eq a => RawResult a -> RawResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawResult a -> RawResult a -> Bool
$c/= :: forall a. Eq a => RawResult a -> RawResult a -> Bool
== :: RawResult a -> RawResult a -> Bool
$c== :: forall a. Eq a => RawResult a -> RawResult a -> Bool
Eq, (forall x. RawResult a -> Rep (RawResult a) x)
-> (forall x. Rep (RawResult a) x -> RawResult a)
-> Generic (RawResult a)
forall x. Rep (RawResult a) x -> RawResult a
forall x. RawResult a -> Rep (RawResult a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RawResult a) x -> RawResult a
forall a x. RawResult a -> Rep (RawResult a) x
$cto :: forall a x. Rep (RawResult a) x -> RawResult a
$cfrom :: forall a x. RawResult a -> Rep (RawResult a) x
Generic, Get (RawResult a)
Putter (RawResult a)
Putter (RawResult a)
-> Get (RawResult a) -> Serialize (RawResult a)
forall a. Serialize a => Get (RawResult a)
forall a. Serialize a => Putter (RawResult a)
forall t. Putter t -> Get t -> Serialize t
get :: Get (RawResult a)
$cget :: forall a. Serialize a => Get (RawResult a)
put :: Putter (RawResult a)
$cput :: forall a. Serialize a => Putter (RawResult a)
Serialize, RawResult a -> ()
(RawResult a -> ()) -> NFData (RawResult a)
forall a. NFData a => RawResult a -> ()
forall a. (a -> ()) -> NFData a
rnf :: RawResult a -> ()
$crnf :: forall a. NFData a => RawResult a -> ()
NFData)

instance S.Serialize a => ToJSON (RawResult a) where
    toJSON :: RawResult a -> Value
toJSON (RawResult b :: a
b) =
        [Pair] -> Value
object [ "result" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
A.String (ByteString -> Text
encodeHex (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Serialize a => a -> ByteString
S.encode a
b)]
    toEncoding :: RawResult a -> Encoding
toEncoding (RawResult b :: a
b) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "result" Text -> Encoding -> Series
`pair` Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding Builder
str
      where
        str :: Builder
str = Char -> Builder
char7 '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteStringHex (Put -> ByteString
S.runPutLazy (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter a
forall t. Serialize t => Putter t
put a
b) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 '"'

instance S.Serialize a => FromJSON (RawResult a) where
    parseJSON :: Value -> Parser (RawResult a)
parseJSON =
        String
-> (Object -> Parser (RawResult a))
-> Value
-> Parser (RawResult a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "RawResult" ((Object -> Parser (RawResult a)) -> Value -> Parser (RawResult a))
-> (Object -> Parser (RawResult a))
-> Value
-> Parser (RawResult a)
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Text
res <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "result"
            let valM :: Maybe a
valM = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a)
-> (ByteString -> Either String a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
S.decode (ByteString -> Maybe a) -> Maybe ByteString -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe ByteString
decodeHex Text
res
            Parser (RawResult a)
-> (a -> Parser (RawResult a)) -> Maybe a -> Parser (RawResult a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser (RawResult a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero (RawResult a -> Parser (RawResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawResult a -> Parser (RawResult a))
-> (a -> RawResult a) -> a -> Parser (RawResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RawResult a
forall a. a -> RawResult a
RawResult) Maybe a
valM

newtype RawResultList a =
    RawResultList
        { RawResultList a -> [a]
getRawResultList :: [a]
        }
    deriving (Int -> RawResultList a -> ShowS
[RawResultList a] -> ShowS
RawResultList a -> String
(Int -> RawResultList a -> ShowS)
-> (RawResultList a -> String)
-> ([RawResultList a] -> ShowS)
-> Show (RawResultList a)
forall a. Show a => Int -> RawResultList a -> ShowS
forall a. Show a => [RawResultList a] -> ShowS
forall a. Show a => RawResultList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawResultList a] -> ShowS
$cshowList :: forall a. Show a => [RawResultList a] -> ShowS
show :: RawResultList a -> String
$cshow :: forall a. Show a => RawResultList a -> String
showsPrec :: Int -> RawResultList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RawResultList a -> ShowS
Show, RawResultList a -> RawResultList a -> Bool
(RawResultList a -> RawResultList a -> Bool)
-> (RawResultList a -> RawResultList a -> Bool)
-> Eq (RawResultList a)
forall a. Eq a => RawResultList a -> RawResultList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawResultList a -> RawResultList a -> Bool
$c/= :: forall a. Eq a => RawResultList a -> RawResultList a -> Bool
== :: RawResultList a -> RawResultList a -> Bool
$c== :: forall a. Eq a => RawResultList a -> RawResultList a -> Bool
Eq, (forall x. RawResultList a -> Rep (RawResultList a) x)
-> (forall x. Rep (RawResultList a) x -> RawResultList a)
-> Generic (RawResultList a)
forall x. Rep (RawResultList a) x -> RawResultList a
forall x. RawResultList a -> Rep (RawResultList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RawResultList a) x -> RawResultList a
forall a x. RawResultList a -> Rep (RawResultList a) x
$cto :: forall a x. Rep (RawResultList a) x -> RawResultList a
$cfrom :: forall a x. RawResultList a -> Rep (RawResultList a) x
Generic, Get (RawResultList a)
Putter (RawResultList a)
Putter (RawResultList a)
-> Get (RawResultList a) -> Serialize (RawResultList a)
forall a. Serialize a => Get (RawResultList a)
forall a. Serialize a => Putter (RawResultList a)
forall t. Putter t -> Get t -> Serialize t
get :: Get (RawResultList a)
$cget :: forall a. Serialize a => Get (RawResultList a)
put :: Putter (RawResultList a)
$cput :: forall a. Serialize a => Putter (RawResultList a)
Serialize, RawResultList a -> ()
(RawResultList a -> ()) -> NFData (RawResultList a)
forall a. NFData a => RawResultList a -> ()
forall a. (a -> ()) -> NFData a
rnf :: RawResultList a -> ()
$crnf :: forall a. NFData a => RawResultList a -> ()
NFData)

instance Semigroup (RawResultList a) where
    (RawResultList a :: [a]
a) <> :: RawResultList a -> RawResultList a -> RawResultList a
<> (RawResultList b :: [a]
b) = [a] -> RawResultList a
forall a. [a] -> RawResultList a
RawResultList ([a] -> RawResultList a) -> [a] -> RawResultList a
forall a b. (a -> b) -> a -> b
$ [a]
a [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
b

instance Monoid (RawResultList a) where
    mempty :: RawResultList a
mempty = [a] -> RawResultList a
forall a. [a] -> RawResultList a
RawResultList [a]
forall a. Monoid a => a
mempty

instance S.Serialize a => ToJSON (RawResultList a) where
    toJSON :: RawResultList a -> Value
toJSON (RawResultList xs :: [a]
xs) =
        [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> [Text] -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHex (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
    toEncoding :: RawResultList a -> Encoding
toEncoding (RawResultList xs :: [a]
xs) =
        (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Builder -> Encoding
forall a. Builder -> Encoding' a
unsafeToEncoding (Builder -> Encoding) -> (a -> Builder) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall t. Serialize t => t -> Builder
str) [a]
xs
      where
        str :: t -> Builder
str x :: t
x =
            Char -> Builder
char7 '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteStringHex (Put -> ByteString
S.runPutLazy (Putter t
forall t. Serialize t => Putter t
put t
x)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 '"'

instance S.Serialize a => FromJSON (RawResultList a) where
    parseJSON :: Value -> Parser (RawResultList a)
parseJSON =
        String
-> (Array -> Parser (RawResultList a))
-> Value
-> Parser (RawResultList a)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray "RawResultList" ((Array -> Parser (RawResultList a))
 -> Value -> Parser (RawResultList a))
-> (Array -> Parser (RawResultList a))
-> Value
-> Parser (RawResultList a)
forall a b. (a -> b) -> a -> b
$ \vec :: Array
vec ->
            [a] -> RawResultList a
forall a. [a] -> RawResultList a
RawResultList ([a] -> RawResultList a) -> Parser [a] -> Parser (RawResultList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser a) -> [Value] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser a
parseElem (Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
vec)
      where
        parseElem :: Value -> Parser a
parseElem = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText "RawResultListElem" ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Parser a) -> (Text -> Maybe a) -> Text -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe a
f
        f :: Text -> Maybe a
f = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a)
-> (ByteString -> Either String a) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
S.decode (ByteString -> Maybe a)
-> (Text -> Maybe ByteString) -> Text -> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeHex

newtype TxId =
    TxId TxHash
    deriving (Int -> TxId -> ShowS
[TxId] -> ShowS
TxId -> String
(Int -> TxId -> ShowS)
-> (TxId -> String) -> ([TxId] -> ShowS) -> Show TxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxId] -> ShowS
$cshowList :: [TxId] -> ShowS
show :: TxId -> String
$cshow :: TxId -> String
showsPrec :: Int -> TxId -> ShowS
$cshowsPrec :: Int -> TxId -> ShowS
Show, TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c== :: TxId -> TxId -> Bool
Eq, (forall x. TxId -> Rep TxId x)
-> (forall x. Rep TxId x -> TxId) -> Generic TxId
forall x. Rep TxId x -> TxId
forall x. TxId -> Rep TxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxId x -> TxId
$cfrom :: forall x. TxId -> Rep TxId x
Generic, Get TxId
Putter TxId
Putter TxId -> Get TxId -> Serialize TxId
forall t. Putter t -> Get t -> Serialize t
get :: Get TxId
$cget :: Get TxId
put :: Putter TxId
$cput :: Putter TxId
Serialize, TxId -> ()
(TxId -> ()) -> NFData TxId
forall a. (a -> ()) -> NFData a
rnf :: TxId -> ()
$crnf :: TxId -> ()
NFData)

instance ToJSON TxId where
    toJSON :: TxId -> Value
toJSON (TxId h :: TxHash
h) = [Pair] -> Value
object ["txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
h]
    toEncoding :: TxId -> Encoding
toEncoding (TxId h :: TxHash
h) = Series -> Encoding
pairs ("txid" Text -> Encoding -> Series
`pair` Text -> Encoding
forall a. Text -> Encoding' a
text (TxHash -> Text
txHashToHex TxHash
h))

instance FromJSON TxId where
    parseJSON :: Value -> Parser TxId
parseJSON = String -> (Object -> Parser TxId) -> Value -> Parser TxId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "txid" ((Object -> Parser TxId) -> Value -> Parser TxId)
-> (Object -> Parser TxId) -> Value -> Parser TxId
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> TxHash -> TxId
TxId (TxHash -> TxId) -> Parser TxHash -> Parser TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "txid"

data Except
    = ThingNotFound
    | ServerError
    | BadRequest
    | UserError !String
    | StringError !String
    | BlockTooLarge
    deriving (Int -> Except -> ShowS
[Except] -> ShowS
Except -> String
(Int -> Except -> ShowS)
-> (Except -> String) -> ([Except] -> ShowS) -> Show Except
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Except] -> ShowS
$cshowList :: [Except] -> ShowS
show :: Except -> String
$cshow :: Except -> String
showsPrec :: Int -> Except -> ShowS
$cshowsPrec :: Int -> Except -> ShowS
Show, Except -> Except -> Bool
(Except -> Except -> Bool)
-> (Except -> Except -> Bool) -> Eq Except
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Except -> Except -> Bool
$c/= :: Except -> Except -> Bool
== :: Except -> Except -> Bool
$c== :: Except -> Except -> Bool
Eq, Eq Except
Eq Except =>
(Except -> Except -> Ordering)
-> (Except -> Except -> Bool)
-> (Except -> Except -> Bool)
-> (Except -> Except -> Bool)
-> (Except -> Except -> Bool)
-> (Except -> Except -> Except)
-> (Except -> Except -> Except)
-> Ord Except
Except -> Except -> Bool
Except -> Except -> Ordering
Except -> Except -> Except
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Except -> Except -> Except
$cmin :: Except -> Except -> Except
max :: Except -> Except -> Except
$cmax :: Except -> Except -> Except
>= :: Except -> Except -> Bool
$c>= :: Except -> Except -> Bool
> :: Except -> Except -> Bool
$c> :: Except -> Except -> Bool
<= :: Except -> Except -> Bool
$c<= :: Except -> Except -> Bool
< :: Except -> Except -> Bool
$c< :: Except -> Except -> Bool
compare :: Except -> Except -> Ordering
$ccompare :: Except -> Except -> Ordering
$cp1Ord :: Eq Except
Ord, Get Except
Putter Except
Putter Except -> Get Except -> Serialize Except
forall t. Putter t -> Get t -> Serialize t
get :: Get Except
$cget :: Get Except
put :: Putter Except
$cput :: Putter Except
Serialize, (forall x. Except -> Rep Except x)
-> (forall x. Rep Except x -> Except) -> Generic Except
forall x. Rep Except x -> Except
forall x. Except -> Rep Except x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Except x -> Except
$cfrom :: forall x. Except -> Rep Except x
Generic, Except -> ()
(Except -> ()) -> NFData Except
forall a. (a -> ()) -> NFData a
rnf :: Except -> ()
$crnf :: Except -> ()
NFData)

instance Exception Except

instance ScottyError Except where
    stringError :: String -> Except
stringError = String -> Except
StringError
    showError :: Except -> Text
showError = String -> Text
TL.pack (String -> Text) -> (Except -> String) -> Except -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except -> String
forall a. Show a => a -> String
show

instance ToJSON Except where
    toJSON :: Except -> Value
toJSON e :: Except
e =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        case Except
e of
            ThingNotFound ->
                ["error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "not-found"]
            ServerError ->
                ["error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "server-error"]
            BadRequest ->
                ["error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "bad-request"]
            UserError msg :: String
msg ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "user-error"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
msg)
                ]
            StringError msg :: String
msg ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "string-error"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
msg)
                ]
            BlockTooLarge ->
                ["error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "block-too-large"]

instance FromJSON Except where
    parseJSON :: Value -> Parser Except
parseJSON =
        String -> (Object -> Parser Except) -> Value -> Parser Except
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "Except" ((Object -> Parser Except) -> Value -> Parser Except)
-> (Object -> Parser Except) -> Value -> Parser Except
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Value
ctr <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "error"
            String
msg <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe String -> String) -> Parser (Maybe String) -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "message"
            case Value
ctr of
                String "not-found"       -> Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ThingNotFound
                String "server-error"    -> Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ServerError
                String "bad-request"     -> Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
BadRequest
                String "user-error"      -> Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return (Except -> Parser Except) -> Except -> Parser Except
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
msg
                String "string-error"    -> Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return (Except -> Parser Except) -> Except -> Parser Except
forall a b. (a -> b) -> a -> b
$ String -> Except
StringError String
msg
                String "block-too-large" -> Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
BlockTooLarge
                _                        -> Parser Except
forall (m :: * -> *) a. MonadPlus m => m a
mzero


---------------------------------------
-- Blockchain.info API Compatibility --
---------------------------------------

type BinfoTxIndex = Int64

isBinfoTxIndexNull :: BinfoTxIndex -> Bool
isBinfoTxIndexNull :: BinfoTxIndex -> Bool
isBinfoTxIndexNull = (0 BinfoTxIndex -> BinfoTxIndex -> Bool
forall a. Ord a => a -> a -> Bool
>)

isBinfoTxIndexBlock :: BinfoTxIndex -> Bool
isBinfoTxIndexBlock :: BinfoTxIndex -> Bool
isBinfoTxIndexBlock n :: BinfoTxIndex
n = 0 BinfoTxIndex -> BinfoTxIndex -> Bool
forall a. Ord a => a -> a -> Bool
<= BinfoTxIndex
n Bool -> Bool -> Bool
&& Bool -> Bool
not (BinfoTxIndex -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit BinfoTxIndex
n 48)

isBinfoTxIndexHash :: BinfoTxIndex -> Bool
isBinfoTxIndexHash :: BinfoTxIndex -> Bool
isBinfoTxIndexHash n :: BinfoTxIndex
n = 0 BinfoTxIndex -> BinfoTxIndex -> Bool
forall a. Ord a => a -> a -> Bool
<= BinfoTxIndex
n Bool -> Bool -> Bool
&& BinfoTxIndex -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit BinfoTxIndex
n 48

encodeBinfoTxIndexHash :: BinfoTxIndex -> Maybe ByteString
encodeBinfoTxIndexHash :: BinfoTxIndex -> Maybe ByteString
encodeBinfoTxIndexHash n :: BinfoTxIndex
n =
    if BinfoTxIndex -> Bool
isBinfoTxIndexHash BinfoTxIndex
n
    then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop 2 (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ BinfoTxIndex -> ByteString
forall a. Serialize a => a -> ByteString
S.encode BinfoTxIndex
n
    else Maybe ByteString
forall a. Maybe a
Nothing

hashToBinfoTxIndex :: TxHash -> BinfoTxIndex
hashToBinfoTxIndex :: TxHash -> BinfoTxIndex
hashToBinfoTxIndex h :: TxHash
h =
    BinfoTxIndex -> Either String BinfoTxIndex -> BinfoTxIndex
forall b a. b -> Either a b -> b
fromRight (String -> BinfoTxIndex
forall a. HasCallStack => String -> a
error "weird monkeys dancing") (Either String BinfoTxIndex -> BinfoTxIndex)
-> (ByteString -> Either String BinfoTxIndex)
-> ByteString
-> BinfoTxIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String BinfoTxIndex
forall a. Serialize a => ByteString -> Either String a
S.decode (ByteString -> BinfoTxIndex) -> ByteString -> BinfoTxIndex
forall a b. (a -> b) -> a -> b
$
    0x00 Word8 -> ByteString -> ByteString
`B.cons` 0x01 Word8 -> ByteString -> ByteString
`B.cons` Int -> ByteString -> ByteString
B.take 6 (TxHash -> ByteString
forall a. Serialize a => a -> ByteString
S.encode TxHash
h)

blockToBinfoTxIndex :: BlockHeight -> Word32 -> BinfoTxIndex
blockToBinfoTxIndex :: Fingerprint -> Fingerprint -> BinfoTxIndex
blockToBinfoTxIndex h :: Fingerprint
h p :: Fingerprint
p =
    let norm :: Fingerprint -> BinfoTxIndex
norm = BinfoTxIndex -> BinfoTxIndex -> BinfoTxIndex
forall a. Bits a => a -> a -> a
(.&.) (2 BinfoTxIndex -> BlockWork -> BinfoTxIndex
forall a b. (Num a, Integral b) => a -> b -> a
^ 24 BinfoTxIndex -> BinfoTxIndex -> BinfoTxIndex
forall a. Num a => a -> a -> a
- 1) (BinfoTxIndex -> BinfoTxIndex)
-> (Fingerprint -> BinfoTxIndex) -> Fingerprint -> BinfoTxIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fingerprint -> BinfoTxIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral
     in Fingerprint -> BinfoTxIndex
norm Fingerprint
h BinfoTxIndex -> Int -> BinfoTxIndex
forall a. Bits a => a -> Int -> a
`shift` 24 BinfoTxIndex -> BinfoTxIndex -> BinfoTxIndex
forall a. Bits a => a -> a -> a
.|. Fingerprint -> BinfoTxIndex
norm Fingerprint
p

matchBinfoTxHash :: Int64 -> TxHash -> Bool
matchBinfoTxHash :: BinfoTxIndex -> TxHash -> Bool
matchBinfoTxHash n :: BinfoTxIndex
n h :: TxHash
h =
    let bn :: ByteString
bn = Int -> ByteString -> ByteString
B.drop 2 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BinfoTxIndex -> ByteString
forall a. Serialize a => a -> ByteString
S.encode BinfoTxIndex
n
        bh :: ByteString
bh = Int -> ByteString -> ByteString
B.take 6 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TxHash -> ByteString
forall a. Serialize a => a -> ByteString
S.encode TxHash
h
    in BinfoTxIndex -> Bool
isBinfoTxIndexHash BinfoTxIndex
n Bool -> Bool -> Bool
&& ByteString
bn ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bh

binfoTxIndexBlock :: BinfoTxIndex -> Maybe (BlockHeight, Word32)
binfoTxIndexBlock :: BinfoTxIndex -> Maybe (Fingerprint, Fingerprint)
binfoTxIndexBlock n :: BinfoTxIndex
n =
    let norm :: BinfoTxIndex -> Fingerprint
norm = Fingerprint -> Fingerprint -> Fingerprint
forall a. Bits a => a -> a -> a
(.&.) (2 Fingerprint -> BlockWork -> Fingerprint
forall a b. (Num a, Integral b) => a -> b -> a
^ 24 Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
- 1) (Fingerprint -> Fingerprint)
-> (BinfoTxIndex -> Fingerprint) -> BinfoTxIndex -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinfoTxIndex -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        height :: Fingerprint
height = BinfoTxIndex -> Fingerprint
norm (BinfoTxIndex -> Fingerprint) -> BinfoTxIndex -> Fingerprint
forall a b. (a -> b) -> a -> b
$ BinfoTxIndex
n BinfoTxIndex -> Int -> BinfoTxIndex
forall a. Bits a => a -> Int -> a
`shift` (-24)
        pos :: Fingerprint
pos = BinfoTxIndex -> Fingerprint
norm BinfoTxIndex
n
    in if BinfoTxIndex -> Bool
isBinfoTxIndexBlock BinfoTxIndex
n
       then (Fingerprint, Fingerprint) -> Maybe (Fingerprint, Fingerprint)
forall a. a -> Maybe a
Just (Fingerprint
height, Fingerprint
pos)
       else Maybe (Fingerprint, Fingerprint)
forall a. Maybe a
Nothing

binfoTransactionIndex :: Bool -> Transaction -> BinfoTxId
binfoTransactionIndex :: Bool -> Transaction -> BinfoTxId
binfoTransactionIndex True t :: Transaction
t = TxHash -> BinfoTxId
BinfoTxIdHash (Tx -> TxHash
txHash (Transaction -> Tx
transactionData Transaction
t))
binfoTransactionIndex False Transaction{transactionDeleted :: Transaction -> Bool
transactionDeleted = Bool
True} =
    BinfoTxIndex -> BinfoTxId
BinfoTxIdIndex (-1)
binfoTransactionIndex False t :: Transaction
t@Transaction{transactionBlock :: Transaction -> BlockRef
transactionBlock = MemRef _} =
    BinfoTxIndex -> BinfoTxId
BinfoTxIdIndex (TxHash -> BinfoTxIndex
hashToBinfoTxIndex (Tx -> TxHash
txHash (Transaction -> Tx
transactionData Transaction
t)))
binfoTransactionIndex False Transaction{transactionBlock :: Transaction -> BlockRef
transactionBlock = BlockRef h :: Fingerprint
h p :: Fingerprint
p} =
    BinfoTxIndex -> BinfoTxId
BinfoTxIdIndex (Fingerprint -> Fingerprint -> BinfoTxIndex
blockToBinfoTxIndex Fingerprint
h Fingerprint
p)

data BinfoTxId
    = BinfoTxIdHash !TxHash
    | BinfoTxIdIndex !BinfoTxIndex
    deriving (BinfoTxId -> BinfoTxId -> Bool
(BinfoTxId -> BinfoTxId -> Bool)
-> (BinfoTxId -> BinfoTxId -> Bool) -> Eq BinfoTxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoTxId -> BinfoTxId -> Bool
$c/= :: BinfoTxId -> BinfoTxId -> Bool
== :: BinfoTxId -> BinfoTxId -> Bool
$c== :: BinfoTxId -> BinfoTxId -> Bool
Eq, Int -> BinfoTxId -> ShowS
[BinfoTxId] -> ShowS
BinfoTxId -> String
(Int -> BinfoTxId -> ShowS)
-> (BinfoTxId -> String)
-> ([BinfoTxId] -> ShowS)
-> Show BinfoTxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoTxId] -> ShowS
$cshowList :: [BinfoTxId] -> ShowS
show :: BinfoTxId -> String
$cshow :: BinfoTxId -> String
showsPrec :: Int -> BinfoTxId -> ShowS
$cshowsPrec :: Int -> BinfoTxId -> ShowS
Show, ReadPrec [BinfoTxId]
ReadPrec BinfoTxId
Int -> ReadS BinfoTxId
ReadS [BinfoTxId]
(Int -> ReadS BinfoTxId)
-> ReadS [BinfoTxId]
-> ReadPrec BinfoTxId
-> ReadPrec [BinfoTxId]
-> Read BinfoTxId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinfoTxId]
$creadListPrec :: ReadPrec [BinfoTxId]
readPrec :: ReadPrec BinfoTxId
$creadPrec :: ReadPrec BinfoTxId
readList :: ReadS [BinfoTxId]
$creadList :: ReadS [BinfoTxId]
readsPrec :: Int -> ReadS BinfoTxId
$creadsPrec :: Int -> ReadS BinfoTxId
Read, (forall x. BinfoTxId -> Rep BinfoTxId x)
-> (forall x. Rep BinfoTxId x -> BinfoTxId) -> Generic BinfoTxId
forall x. Rep BinfoTxId x -> BinfoTxId
forall x. BinfoTxId -> Rep BinfoTxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoTxId x -> BinfoTxId
$cfrom :: forall x. BinfoTxId -> Rep BinfoTxId x
Generic, Get BinfoTxId
Putter BinfoTxId
Putter BinfoTxId -> Get BinfoTxId -> Serialize BinfoTxId
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoTxId
$cget :: Get BinfoTxId
put :: Putter BinfoTxId
$cput :: Putter BinfoTxId
Serialize, BinfoTxId -> ()
(BinfoTxId -> ()) -> NFData BinfoTxId
forall a. (a -> ()) -> NFData a
rnf :: BinfoTxId -> ()
$crnf :: BinfoTxId -> ()
NFData)

instance Parsable BinfoTxId where
    parseParam :: Text -> Either Text BinfoTxId
parseParam t :: Text
t =
        case Text -> Maybe TxHash
hexToTxHash (Text -> Text
TL.toStrict Text
t) of
            Nothing -> BinfoTxIndex -> BinfoTxId
BinfoTxIdIndex (BinfoTxIndex -> BinfoTxId)
-> Either Text BinfoTxIndex -> Either Text BinfoTxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text BinfoTxIndex
forall a. Parsable a => Text -> Either Text a
parseParam Text
t
            Just h :: TxHash
h  -> BinfoTxId -> Either Text BinfoTxId
forall a b. b -> Either a b
Right (TxHash -> BinfoTxId
BinfoTxIdHash TxHash
h)

getBinfoTxId :: Maybe (HashMap TxHash Transaction) -> TxHash -> BinfoTxId
getBinfoTxId :: Maybe (HashMap TxHash Transaction) -> TxHash -> BinfoTxId
getBinfoTxId Nothing h :: TxHash
h = TxHash -> BinfoTxId
BinfoTxIdHash TxHash
h
getBinfoTxId (Just m :: HashMap TxHash Transaction
m) h :: TxHash
h =
    case TxHash -> HashMap TxHash Transaction -> Maybe Transaction
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TxHash
h HashMap TxHash Transaction
m of
        Nothing -> BinfoTxIndex -> BinfoTxId
BinfoTxIdIndex (-1)
        Just t :: Transaction
t  -> Bool -> Transaction -> BinfoTxId
binfoTransactionIndex Bool
False Transaction
t

instance ToJSON BinfoTxId where
    toJSON :: BinfoTxId -> Value
toJSON (BinfoTxIdHash h :: TxHash
h)  = TxHash -> Value
forall a. ToJSON a => a -> Value
toJSON TxHash
h
    toJSON (BinfoTxIdIndex i :: BinfoTxIndex
i) = BinfoTxIndex -> Value
forall a. ToJSON a => a -> Value
toJSON BinfoTxIndex
i
    toEncoding :: BinfoTxId -> Encoding
toEncoding (BinfoTxIdHash h :: TxHash
h)  = TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding TxHash
h
    toEncoding (BinfoTxIdIndex i :: BinfoTxIndex
i) = BinfoTxIndex -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoTxIndex
i

instance FromJSON BinfoTxId where
    parseJSON :: Value -> Parser BinfoTxId
parseJSON v :: Value
v = TxHash -> BinfoTxId
BinfoTxIdHash (TxHash -> BinfoTxId) -> Parser TxHash -> Parser BinfoTxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TxHash
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser BinfoTxId -> Parser BinfoTxId -> Parser BinfoTxId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  BinfoTxIndex -> BinfoTxId
BinfoTxIdIndex (BinfoTxIndex -> BinfoTxId)
-> Parser BinfoTxIndex -> Parser BinfoTxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser BinfoTxIndex
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data BinfoMultiAddr
    = BinfoMultiAddr
        { BinfoMultiAddr -> [BinfoAddress]
getBinfoMultiAddrAddresses    :: ![BinfoAddress]
        , BinfoMultiAddr -> BinfoWallet
getBinfoMultiAddrWallet       :: !BinfoWallet
        , BinfoMultiAddr -> [BinfoTx]
getBinfoMultiAddrTxs          :: ![BinfoTx]
        , BinfoMultiAddr -> BinfoInfo
getBinfoMultiAddrInfo         :: !BinfoInfo
        , BinfoMultiAddr -> Bool
getBinfoMultiAddrRecommendFee :: !Bool
        , BinfoMultiAddr -> Bool
getBinfoMultiAddrCashAddr     :: !Bool
        }
    deriving (BinfoMultiAddr -> BinfoMultiAddr -> Bool
(BinfoMultiAddr -> BinfoMultiAddr -> Bool)
-> (BinfoMultiAddr -> BinfoMultiAddr -> Bool) -> Eq BinfoMultiAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
$c/= :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
== :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
$c== :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
Eq, Int -> BinfoMultiAddr -> ShowS
[BinfoMultiAddr] -> ShowS
BinfoMultiAddr -> String
(Int -> BinfoMultiAddr -> ShowS)
-> (BinfoMultiAddr -> String)
-> ([BinfoMultiAddr] -> ShowS)
-> Show BinfoMultiAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoMultiAddr] -> ShowS
$cshowList :: [BinfoMultiAddr] -> ShowS
show :: BinfoMultiAddr -> String
$cshow :: BinfoMultiAddr -> String
showsPrec :: Int -> BinfoMultiAddr -> ShowS
$cshowsPrec :: Int -> BinfoMultiAddr -> ShowS
Show, (forall x. BinfoMultiAddr -> Rep BinfoMultiAddr x)
-> (forall x. Rep BinfoMultiAddr x -> BinfoMultiAddr)
-> Generic BinfoMultiAddr
forall x. Rep BinfoMultiAddr x -> BinfoMultiAddr
forall x. BinfoMultiAddr -> Rep BinfoMultiAddr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoMultiAddr x -> BinfoMultiAddr
$cfrom :: forall x. BinfoMultiAddr -> Rep BinfoMultiAddr x
Generic, BinfoMultiAddr -> ()
(BinfoMultiAddr -> ()) -> NFData BinfoMultiAddr
forall a. (a -> ()) -> NFData a
rnf :: BinfoMultiAddr -> ()
$crnf :: BinfoMultiAddr -> ()
NFData)

binfoMultiAddrToJSON :: Network -> BinfoMultiAddr -> Value
binfoMultiAddrToJSON :: Network -> BinfoMultiAddr -> Value
binfoMultiAddrToJSON net' :: Network
net' BinfoMultiAddr {..} =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ "addresses" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BinfoAddress -> Value) -> [BinfoAddress] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> BinfoAddress -> Value
binfoAddressToJSON Network
net) [BinfoAddress]
getBinfoMultiAddrAddresses
        , "wallet"    Text -> BinfoWallet -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoWallet
getBinfoMultiAddrWallet
        , "txs"       Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> BinfoTx -> Value
binfoTxToJSON Network
net) [BinfoTx]
getBinfoMultiAddrTxs
        , "info"      Text -> BinfoInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoInfo
getBinfoMultiAddrInfo
        , "recommend_include_fee" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoMultiAddrRecommendFee
        ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
        [ "cash_addr" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True | Bool
getBinfoMultiAddrCashAddr ]
  where
    net :: Network
net = if Bool -> Bool
not Bool
getBinfoMultiAddrCashAddr Bool -> Bool -> Bool
&& Network
net' Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch then Network
btc else Network
net'

binfoMultiAddrParseJSON :: Network -> Value -> Parser BinfoMultiAddr
binfoMultiAddrParseJSON :: Network -> Value -> Parser BinfoMultiAddr
binfoMultiAddrParseJSON net :: Network
net = String
-> (Object -> Parser BinfoMultiAddr)
-> Value
-> Parser BinfoMultiAddr
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "multiaddr" ((Object -> Parser BinfoMultiAddr)
 -> Value -> Parser BinfoMultiAddr)
-> (Object -> Parser BinfoMultiAddr)
-> Value
-> Parser BinfoMultiAddr
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    [BinfoAddress]
getBinfoMultiAddrAddresses <-
        (Value -> Parser BinfoAddress) -> [Value] -> Parser [BinfoAddress]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoAddress
binfoAddressParseJSON Network
net) ([Value] -> Parser [BinfoAddress])
-> Parser [Value] -> Parser [BinfoAddress]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "addresses"
    BinfoWallet
getBinfoMultiAddrWallet <- Object
o Object -> Text -> Parser BinfoWallet
forall a. FromJSON a => Object -> Text -> Parser a
.: "wallet"
    [BinfoTx]
getBinfoMultiAddrTxs <-
        (Value -> Parser BinfoTx) -> [Value] -> Parser [BinfoTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoTx
binfoTxParseJSON Network
net) ([Value] -> Parser [BinfoTx]) -> Parser [Value] -> Parser [BinfoTx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "txs"
    BinfoInfo
getBinfoMultiAddrInfo <- Object
o Object -> Text -> Parser BinfoInfo
forall a. FromJSON a => Object -> Text -> Parser a
.: "info"
    Bool
getBinfoMultiAddrRecommendFee <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "recommend_include_fee"
    Bool
getBinfoMultiAddrCashAddr <- Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "cash_addr" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    BinfoMultiAddr -> Parser BinfoMultiAddr
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoMultiAddr :: [BinfoAddress]
-> BinfoWallet
-> [BinfoTx]
-> BinfoInfo
-> Bool
-> Bool
-> BinfoMultiAddr
BinfoMultiAddr {..}

binfoMultiAddrToEncoding :: Network -> BinfoMultiAddr -> Encoding
binfoMultiAddrToEncoding :: Network -> BinfoMultiAddr -> Encoding
binfoMultiAddrToEncoding net' :: Network
net' BinfoMultiAddr {..} =
    Series -> Encoding
pairs
        (  "addresses" Text -> Encoding -> Series
`pair` Encoding
as
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "wallet"    Text -> BinfoWallet -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoWallet
getBinfoMultiAddrWallet
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "txs"       Text -> Encoding -> Series
`pair` Encoding
ts
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "info"      Text -> BinfoInfo -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoInfo
getBinfoMultiAddrInfo
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "recommend_include_fee" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoMultiAddrRecommendFee
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> if Bool
getBinfoMultiAddrCashAddr then "cash_addr" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True else Series
forall a. Monoid a => a
mempty
        )
  where
    as :: Encoding
as = (BinfoAddress -> Encoding) -> [BinfoAddress] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BinfoAddress -> Encoding
binfoAddressToEncoding Network
net) [BinfoAddress]
getBinfoMultiAddrAddresses
    ts :: Encoding
ts = (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BinfoTx -> Encoding
binfoTxToEncoding Network
net) [BinfoTx]
getBinfoMultiAddrTxs
    net :: Network
net = if Bool -> Bool
not Bool
getBinfoMultiAddrCashAddr Bool -> Bool -> Bool
&& Network
net' Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch then Network
btc else Network
net'

data BinfoAddress
    = BinfoAddress
        { BinfoAddress -> Address
getBinfoAddress      :: !Address
        , BinfoAddress -> Word64
getBinfoAddrTxCount  :: !Word64
        , BinfoAddress -> Word64
getBinfoAddrReceived :: !Word64
        , BinfoAddress -> Word64
getBinfoAddrSent     :: !Word64
        , BinfoAddress -> Word64
getBinfoAddrBalance  :: !Word64
        }
    | BinfoXPubKey
        { BinfoAddress -> XPubKey
getBinfoXPubKey          :: !XPubKey
        , getBinfoAddrTxCount      :: !Word64
        , getBinfoAddrReceived     :: !Word64
        , getBinfoAddrSent         :: !Word64
        , getBinfoAddrBalance      :: !Word64
        , BinfoAddress -> Fingerprint
getBinfoXPubAccountIndex :: !Word32
        , BinfoAddress -> Fingerprint
getBinfoXPubChangeIndex  :: !Word32
        }
    deriving (BinfoAddress -> BinfoAddress -> Bool
(BinfoAddress -> BinfoAddress -> Bool)
-> (BinfoAddress -> BinfoAddress -> Bool) -> Eq BinfoAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoAddress -> BinfoAddress -> Bool
$c/= :: BinfoAddress -> BinfoAddress -> Bool
== :: BinfoAddress -> BinfoAddress -> Bool
$c== :: BinfoAddress -> BinfoAddress -> Bool
Eq, Int -> BinfoAddress -> ShowS
[BinfoAddress] -> ShowS
BinfoAddress -> String
(Int -> BinfoAddress -> ShowS)
-> (BinfoAddress -> String)
-> ([BinfoAddress] -> ShowS)
-> Show BinfoAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoAddress] -> ShowS
$cshowList :: [BinfoAddress] -> ShowS
show :: BinfoAddress -> String
$cshow :: BinfoAddress -> String
showsPrec :: Int -> BinfoAddress -> ShowS
$cshowsPrec :: Int -> BinfoAddress -> ShowS
Show, (forall x. BinfoAddress -> Rep BinfoAddress x)
-> (forall x. Rep BinfoAddress x -> BinfoAddress)
-> Generic BinfoAddress
forall x. Rep BinfoAddress x -> BinfoAddress
forall x. BinfoAddress -> Rep BinfoAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoAddress x -> BinfoAddress
$cfrom :: forall x. BinfoAddress -> Rep BinfoAddress x
Generic, Get BinfoAddress
Putter BinfoAddress
Putter BinfoAddress -> Get BinfoAddress -> Serialize BinfoAddress
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoAddress
$cget :: Get BinfoAddress
put :: Putter BinfoAddress
$cput :: Putter BinfoAddress
Serialize, BinfoAddress -> ()
(BinfoAddress -> ()) -> NFData BinfoAddress
forall a. (a -> ()) -> NFData a
rnf :: BinfoAddress -> ()
$crnf :: BinfoAddress -> ()
NFData)

binfoAddressToJSON :: Network -> BinfoAddress -> Value
binfoAddressToJSON :: Network -> BinfoAddress -> Value
binfoAddressToJSON net :: Network
net BinfoAddress {..} =
    [Pair] -> Value
object
        [ "address"        Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> Address -> Value
addrToJSON Network
net Address
getBinfoAddress
        , "final_balance"  Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrBalance
        , "n_tx"           Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrTxCount
        , "total_received" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrReceived
        , "total_sent"     Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrSent
        ]
binfoAddressToJSON net :: Network
net BinfoXPubKey {..} =
    [Pair] -> Value
object
        [ "address"        Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> XPubKey -> Value
xPubToJSON Network
net XPubKey
getBinfoXPubKey
        , "change_index"   Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoXPubChangeIndex
        , "account_index"  Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoXPubAccountIndex
        , "final_balance"  Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrBalance
        , "n_tx"           Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrTxCount
        , "total_received" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrReceived
        , "total_sent"     Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrSent
        ]

binfoAddressParseJSON :: Network -> Value -> Parser BinfoAddress
binfoAddressParseJSON :: Network -> Value -> Parser BinfoAddress
binfoAddressParseJSON net :: Network
net = String
-> (Object -> Parser BinfoAddress) -> Value -> Parser BinfoAddress
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "address" ((Object -> Parser BinfoAddress) -> Value -> Parser BinfoAddress)
-> (Object -> Parser BinfoAddress) -> Value -> Parser BinfoAddress
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Object -> Parser BinfoAddress
x Object
o Parser BinfoAddress -> Parser BinfoAddress -> Parser BinfoAddress
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser BinfoAddress
a Object
o
  where
    x :: Object -> Parser BinfoAddress
x o :: Object
o = do
        XPubKey
getBinfoXPubKey <- Network -> Value -> Parser XPubKey
xPubFromJSON Network
net (Value -> Parser XPubKey) -> Parser Value -> Parser XPubKey
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "address"
        Fingerprint
getBinfoXPubChangeIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "change_index"
        Fingerprint
getBinfoXPubAccountIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "account_index"
        Word64
getBinfoAddrBalance <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "final_balance"
        Word64
getBinfoAddrTxCount <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "n_tx"
        Word64
getBinfoAddrReceived <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_received"
        Word64
getBinfoAddrSent <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_sent"
        BinfoAddress -> Parser BinfoAddress
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoXPubKey :: XPubKey
-> Word64
-> Word64
-> Word64
-> Word64
-> Fingerprint
-> Fingerprint
-> BinfoAddress
BinfoXPubKey{..}
    a :: Object -> Parser BinfoAddress
a o :: Object
o = do
        Address
getBinfoAddress <- Network -> Value -> Parser Address
addrFromJSON Network
net (Value -> Parser Address) -> Parser Value -> Parser Address
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "address"
        Word64
getBinfoAddrBalance <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "final_balance"
        Word64
getBinfoAddrTxCount <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "n_tx"
        Word64
getBinfoAddrReceived <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_received"
        Word64
getBinfoAddrSent <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_sent"
        BinfoAddress -> Parser BinfoAddress
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoAddress :: Address -> Word64 -> Word64 -> Word64 -> Word64 -> BinfoAddress
BinfoAddress{..}

binfoAddressToEncoding :: Network -> BinfoAddress -> Encoding
binfoAddressToEncoding :: Network -> BinfoAddress -> Encoding
binfoAddressToEncoding net :: Network
net BinfoAddress {..} =
    Series -> Encoding
pairs
        (  "address"         Text -> Encoding -> Series
`pair` Network -> Address -> Encoding
addrToEncoding Network
net Address
getBinfoAddress
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "final_balance"   Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrBalance
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "n_tx"            Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrTxCount
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "total_received"  Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrReceived
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "total_sent"      Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrSent
        )
binfoAddressToEncoding net :: Network
net BinfoXPubKey {..} =
    Series -> Encoding
pairs
        (  "address"         Text -> Encoding -> Series
`pair` Network -> XPubKey -> Encoding
xPubToEncoding Network
net XPubKey
getBinfoXPubKey
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "change_index"    Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoXPubChangeIndex
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "account_index"   Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoXPubAccountIndex
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "final_balance"   Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrBalance
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "n_tx"            Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrTxCount
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "total_received"  Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrReceived
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "total_sent"      Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoAddrSent
        )

data BinfoWallet
    = BinfoWallet
        { BinfoWallet -> Word64
getBinfoWalletBalance       :: !Word64
        , BinfoWallet -> Word64
getBinfoWalletTxCount       :: !Word64
        , BinfoWallet -> Word64
getBinfoWalletFilteredCount :: !Word64
        , BinfoWallet -> Word64
getBinfoWalletTotalReceived :: !Word64
        , BinfoWallet -> Word64
getBinfoWalletTotalSent     :: !Word64
        }
    deriving (BinfoWallet -> BinfoWallet -> Bool
(BinfoWallet -> BinfoWallet -> Bool)
-> (BinfoWallet -> BinfoWallet -> Bool) -> Eq BinfoWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoWallet -> BinfoWallet -> Bool
$c/= :: BinfoWallet -> BinfoWallet -> Bool
== :: BinfoWallet -> BinfoWallet -> Bool
$c== :: BinfoWallet -> BinfoWallet -> Bool
Eq, Int -> BinfoWallet -> ShowS
[BinfoWallet] -> ShowS
BinfoWallet -> String
(Int -> BinfoWallet -> ShowS)
-> (BinfoWallet -> String)
-> ([BinfoWallet] -> ShowS)
-> Show BinfoWallet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoWallet] -> ShowS
$cshowList :: [BinfoWallet] -> ShowS
show :: BinfoWallet -> String
$cshow :: BinfoWallet -> String
showsPrec :: Int -> BinfoWallet -> ShowS
$cshowsPrec :: Int -> BinfoWallet -> ShowS
Show, (forall x. BinfoWallet -> Rep BinfoWallet x)
-> (forall x. Rep BinfoWallet x -> BinfoWallet)
-> Generic BinfoWallet
forall x. Rep BinfoWallet x -> BinfoWallet
forall x. BinfoWallet -> Rep BinfoWallet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoWallet x -> BinfoWallet
$cfrom :: forall x. BinfoWallet -> Rep BinfoWallet x
Generic, Get BinfoWallet
Putter BinfoWallet
Putter BinfoWallet -> Get BinfoWallet -> Serialize BinfoWallet
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoWallet
$cget :: Get BinfoWallet
put :: Putter BinfoWallet
$cput :: Putter BinfoWallet
Serialize, BinfoWallet -> ()
(BinfoWallet -> ()) -> NFData BinfoWallet
forall a. (a -> ()) -> NFData a
rnf :: BinfoWallet -> ()
$crnf :: BinfoWallet -> ()
NFData)

instance ToJSON BinfoWallet where
    toJSON :: BinfoWallet -> Value
toJSON BinfoWallet {..} =
        [Pair] -> Value
object
            [ "final_balance"     Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletBalance
            , "n_tx"              Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletTxCount
            , "n_tx_filtered"     Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletFilteredCount
            , "total_received"    Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletTotalReceived
            , "total_sent"        Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletTotalSent
            ]
    toEncoding :: BinfoWallet -> Encoding
toEncoding BinfoWallet {..} =
        Series -> Encoding
pairs
            (  "final_balance"    Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletBalance
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "n_tx"             Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletTxCount
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "n_tx_filtered"    Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletFilteredCount
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "total_received"   Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletTotalReceived
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "total_sent"       Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoWalletTotalSent
            )

instance FromJSON BinfoWallet where
    parseJSON :: Value -> Parser BinfoWallet
parseJSON = String
-> (Object -> Parser BinfoWallet) -> Value -> Parser BinfoWallet
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "wallet" ((Object -> Parser BinfoWallet) -> Value -> Parser BinfoWallet)
-> (Object -> Parser BinfoWallet) -> Value -> Parser BinfoWallet
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Word64
getBinfoWalletBalance <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "final_balance"
        Word64
getBinfoWalletTxCount <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "n_tx"
        Word64
getBinfoWalletFilteredCount <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "n_tx_filtered"
        Word64
getBinfoWalletTotalReceived <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_received"
        Word64
getBinfoWalletTotalSent <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "total_sent"
        BinfoWallet -> Parser BinfoWallet
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoWallet :: Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> BinfoWallet
BinfoWallet {..}

data BinfoTx
    = BinfoTx
        { BinfoTx -> TxHash
getBinfoTxHash        :: !TxHash
        , BinfoTx -> Fingerprint
getBinfoTxVer         :: !Word32
        , BinfoTx -> Fingerprint
getBinfoTxVinSz       :: !Word32
        , BinfoTx -> Fingerprint
getBinfoTxVoutSz      :: !Word32
        , BinfoTx -> Fingerprint
getBinfoTxSize        :: !Word32
        , BinfoTx -> Fingerprint
getBinfoTxWeight      :: !Word32
        , BinfoTx -> Word64
getBinfoTxFee         :: !Word64
        , BinfoTx -> ByteString
getBinfoTxRelayedBy   :: !ByteString
        , BinfoTx -> Fingerprint
getBinfoTxLockTime    :: !Word32
        , BinfoTx -> BinfoTxId
getBinfoTxIndex       :: !BinfoTxId
        , BinfoTx -> Bool
getBinfoTxDoubleSpend :: !Bool
        , BinfoTx -> Maybe (BinfoTxIndex, BinfoTxIndex)
getBinfoTxResultBal   :: !(Maybe (Int64, Int64))
        , BinfoTx -> Word64
getBinfoTxTime        :: !Word64
        , BinfoTx -> Maybe Fingerprint
getBinfoTxBlockIndex  :: !(Maybe Word32)
        , BinfoTx -> Maybe Fingerprint
getBinfoTxBlockHeight :: !(Maybe Word32)
        , BinfoTx -> [BinfoTxInput]
getBinfoTxInputs      :: [BinfoTxInput]
        , BinfoTx -> [BinfoTxOutput]
getBinfoTxOutputs     :: [BinfoTxOutput]
        }
    deriving (BinfoTx -> BinfoTx -> Bool
(BinfoTx -> BinfoTx -> Bool)
-> (BinfoTx -> BinfoTx -> Bool) -> Eq BinfoTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoTx -> BinfoTx -> Bool
$c/= :: BinfoTx -> BinfoTx -> Bool
== :: BinfoTx -> BinfoTx -> Bool
$c== :: BinfoTx -> BinfoTx -> Bool
Eq, Int -> BinfoTx -> ShowS
[BinfoTx] -> ShowS
BinfoTx -> String
(Int -> BinfoTx -> ShowS)
-> (BinfoTx -> String) -> ([BinfoTx] -> ShowS) -> Show BinfoTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoTx] -> ShowS
$cshowList :: [BinfoTx] -> ShowS
show :: BinfoTx -> String
$cshow :: BinfoTx -> String
showsPrec :: Int -> BinfoTx -> ShowS
$cshowsPrec :: Int -> BinfoTx -> ShowS
Show, (forall x. BinfoTx -> Rep BinfoTx x)
-> (forall x. Rep BinfoTx x -> BinfoTx) -> Generic BinfoTx
forall x. Rep BinfoTx x -> BinfoTx
forall x. BinfoTx -> Rep BinfoTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoTx x -> BinfoTx
$cfrom :: forall x. BinfoTx -> Rep BinfoTx x
Generic, Get BinfoTx
Putter BinfoTx
Putter BinfoTx -> Get BinfoTx -> Serialize BinfoTx
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoTx
$cget :: Get BinfoTx
put :: Putter BinfoTx
$cput :: Putter BinfoTx
Serialize, BinfoTx -> ()
(BinfoTx -> ()) -> NFData BinfoTx
forall a. (a -> ()) -> NFData a
rnf :: BinfoTx -> ()
$crnf :: BinfoTx -> ()
NFData)

binfoTxToJSON :: Network -> BinfoTx -> Value
binfoTxToJSON :: Network -> BinfoTx -> Value
binfoTxToJSON net :: Network
net BinfoTx {..} =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ "hash" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
getBinfoTxHash
        , "ver" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxVer
        , "vin_sz" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxVinSz
        , "vout_sz" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxVoutSz
        , "size" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxSize
        , "weight" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxWeight
        , "fee" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoTxFee
        , "relayed_by" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
decodeUtf8 ByteString
getBinfoTxRelayedBy
        , "lock_time" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxLockTime
        , "tx_index" Text -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoTxIndex
        , "double_spend" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoTxDoubleSpend
        , "time" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoTxTime
        , "block_index" Text -> Maybe Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Fingerprint
getBinfoTxBlockIndex
        , "block_height" Text -> Maybe Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Fingerprint
getBinfoTxBlockHeight
        , "inputs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BinfoTxInput -> Value) -> [BinfoTxInput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> BinfoTxInput -> Value
binfoTxInputToJSON Network
net) [BinfoTxInput]
getBinfoTxInputs
        , "out" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BinfoTxOutput -> Value) -> [BinfoTxOutput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> BinfoTxOutput -> Value
binfoTxOutputToJSON Network
net) [BinfoTxOutput]
getBinfoTxOutputs
        ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
        case Maybe (BinfoTxIndex, BinfoTxIndex)
getBinfoTxResultBal of
            Nothing         -> []
            Just (res :: BinfoTxIndex
res, bal :: BinfoTxIndex
bal) -> ["result" Text -> BinfoTxIndex -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxIndex
res, "balance" Text -> BinfoTxIndex -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxIndex
bal]

binfoTxToEncoding :: Network -> BinfoTx -> Encoding
binfoTxToEncoding :: Network -> BinfoTx -> Encoding
binfoTxToEncoding net :: Network
net BinfoTx {..} =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        "hash" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
getBinfoTxHash Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "ver" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxVer Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "vin_sz" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxVinSz Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "vout_sz" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxVoutSz Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "size" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxSize Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "weight" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxWeight Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "fee" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoTxFee Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "relayed_by" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
decodeUtf8 ByteString
getBinfoTxRelayedBy Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "lock_time" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxLockTime Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "tx_index" Text -> BinfoTxId -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoTxIndex Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "double_spend" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoTxDoubleSpend Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "time" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoTxTime Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "block_index" Text -> Maybe Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Fingerprint
getBinfoTxBlockIndex Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "block_height" Text -> Maybe Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Fingerprint
getBinfoTxBlockHeight Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "inputs" Text -> Encoding -> Series
`pair` (BinfoTxInput -> Encoding) -> [BinfoTxInput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BinfoTxInput -> Encoding
binfoTxInputToEncoding Network
net) [BinfoTxInput]
getBinfoTxInputs Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "out" Text -> Encoding -> Series
`pair` (BinfoTxOutput -> Encoding) -> [BinfoTxOutput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
list (Network -> BinfoTxOutput -> Encoding
binfoTxOutputToEncoding Network
net) [BinfoTxOutput]
getBinfoTxOutputs Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        case Maybe (BinfoTxIndex, BinfoTxIndex)
getBinfoTxResultBal of
            Nothing         -> Series
forall a. Monoid a => a
mempty
            Just (res :: BinfoTxIndex
res, bal :: BinfoTxIndex
bal) -> "result" Text -> BinfoTxIndex -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxIndex
res Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "balance" Text -> BinfoTxIndex -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxIndex
bal

binfoTxParseJSON :: Network -> Value -> Parser BinfoTx
binfoTxParseJSON :: Network -> Value -> Parser BinfoTx
binfoTxParseJSON net :: Network
net = String -> (Object -> Parser BinfoTx) -> Value -> Parser BinfoTx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "tx" ((Object -> Parser BinfoTx) -> Value -> Parser BinfoTx)
-> (Object -> Parser BinfoTx) -> Value -> Parser BinfoTx
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    TxHash
getBinfoTxHash <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "hash"
    Fingerprint
getBinfoTxVer <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "ver"
    Fingerprint
getBinfoTxVinSz <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "vin_sz"
    Fingerprint
getBinfoTxVoutSz <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "vout_sz"
    Fingerprint
getBinfoTxSize <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
    Fingerprint
getBinfoTxWeight <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "weight"
    Word64
getBinfoTxFee <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "fee"
    ByteString
getBinfoTxRelayedBy <- Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Parser Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "relayed_by"
    Fingerprint
getBinfoTxLockTime <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "lock_time"
    BinfoTxId
getBinfoTxIndex <- Object
o Object -> Text -> Parser BinfoTxId
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx_index"
    Bool
getBinfoTxDoubleSpend <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "double_spend"
    Word64
getBinfoTxTime <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "time"
    Maybe Fingerprint
getBinfoTxBlockIndex <- Object
o Object -> Text -> Parser (Maybe Fingerprint)
forall a. FromJSON a => Object -> Text -> Parser a
.: "block_index"
    Maybe Fingerprint
getBinfoTxBlockHeight <- Object
o Object -> Text -> Parser (Maybe Fingerprint)
forall a. FromJSON a => Object -> Text -> Parser a
.: "block_height"
    [BinfoTxInput]
getBinfoTxInputs <- Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "inputs" Parser [Value]
-> ([Value] -> Parser [BinfoTxInput]) -> Parser [BinfoTxInput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser BinfoTxInput) -> [Value] -> Parser [BinfoTxInput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoTxInput
binfoTxInputParseJSON Network
net)
    [BinfoTxOutput]
getBinfoTxOutputs <- Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "out" Parser [Value]
-> ([Value] -> Parser [BinfoTxOutput]) -> Parser [BinfoTxOutput]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser BinfoTxOutput)
-> [Value] -> Parser [BinfoTxOutput]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoTxOutput
binfoTxOutputParseJSON Network
net)
    Maybe BinfoTxIndex
res <- Object
o Object -> Text -> Parser (Maybe BinfoTxIndex)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "result"
    Maybe BinfoTxIndex
bal <- Object
o Object -> Text -> Parser (Maybe BinfoTxIndex)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "balance"
    let getBinfoTxResultBal :: Maybe (BinfoTxIndex, BinfoTxIndex)
getBinfoTxResultBal = (,) (BinfoTxIndex -> BinfoTxIndex -> (BinfoTxIndex, BinfoTxIndex))
-> Maybe BinfoTxIndex
-> Maybe (BinfoTxIndex -> (BinfoTxIndex, BinfoTxIndex))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BinfoTxIndex
res Maybe (BinfoTxIndex -> (BinfoTxIndex, BinfoTxIndex))
-> Maybe BinfoTxIndex -> Maybe (BinfoTxIndex, BinfoTxIndex)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe BinfoTxIndex
bal
    BinfoTx -> Parser BinfoTx
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoTx :: TxHash
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Word64
-> ByteString
-> Fingerprint
-> BinfoTxId
-> Bool
-> Maybe (BinfoTxIndex, BinfoTxIndex)
-> Word64
-> Maybe Fingerprint
-> Maybe Fingerprint
-> [BinfoTxInput]
-> [BinfoTxOutput]
-> BinfoTx
BinfoTx {..}

data BinfoTxInput
    = BinfoTxInput
        { BinfoTxInput -> Fingerprint
getBinfoTxInputSeq     :: !Word32
        , BinfoTxInput -> ByteString
getBinfoTxInputWitness :: !ByteString
        , BinfoTxInput -> ByteString
getBinfoTxInputScript  :: !ByteString
        , BinfoTxInput -> Fingerprint
getBinfoTxInputIndex   :: !Word32
        , BinfoTxInput -> Maybe BinfoTxOutput
getBinfoTxInputPrevOut :: !(Maybe BinfoTxOutput)
        }
    deriving (BinfoTxInput -> BinfoTxInput -> Bool
(BinfoTxInput -> BinfoTxInput -> Bool)
-> (BinfoTxInput -> BinfoTxInput -> Bool) -> Eq BinfoTxInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoTxInput -> BinfoTxInput -> Bool
$c/= :: BinfoTxInput -> BinfoTxInput -> Bool
== :: BinfoTxInput -> BinfoTxInput -> Bool
$c== :: BinfoTxInput -> BinfoTxInput -> Bool
Eq, Int -> BinfoTxInput -> ShowS
[BinfoTxInput] -> ShowS
BinfoTxInput -> String
(Int -> BinfoTxInput -> ShowS)
-> (BinfoTxInput -> String)
-> ([BinfoTxInput] -> ShowS)
-> Show BinfoTxInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoTxInput] -> ShowS
$cshowList :: [BinfoTxInput] -> ShowS
show :: BinfoTxInput -> String
$cshow :: BinfoTxInput -> String
showsPrec :: Int -> BinfoTxInput -> ShowS
$cshowsPrec :: Int -> BinfoTxInput -> ShowS
Show, (forall x. BinfoTxInput -> Rep BinfoTxInput x)
-> (forall x. Rep BinfoTxInput x -> BinfoTxInput)
-> Generic BinfoTxInput
forall x. Rep BinfoTxInput x -> BinfoTxInput
forall x. BinfoTxInput -> Rep BinfoTxInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoTxInput x -> BinfoTxInput
$cfrom :: forall x. BinfoTxInput -> Rep BinfoTxInput x
Generic, Get BinfoTxInput
Putter BinfoTxInput
Putter BinfoTxInput -> Get BinfoTxInput -> Serialize BinfoTxInput
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoTxInput
$cget :: Get BinfoTxInput
put :: Putter BinfoTxInput
$cput :: Putter BinfoTxInput
Serialize, BinfoTxInput -> ()
(BinfoTxInput -> ()) -> NFData BinfoTxInput
forall a. (a -> ()) -> NFData a
rnf :: BinfoTxInput -> ()
$crnf :: BinfoTxInput -> ()
NFData)

binfoTxInputToJSON :: Network -> BinfoTxInput -> Value
binfoTxInputToJSON :: Network -> BinfoTxInput -> Value
binfoTxInputToJSON net :: Network
net BinfoTxInput {..} =
    [Pair] -> Value
object
        [ "sequence" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxInputSeq
        , "witness"  Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoTxInputWitness
        , "script"   Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoTxInputScript
        , "index"    Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxInputIndex
        , "prev_out" Text -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Network -> BinfoTxOutput -> Value
binfoTxOutputToJSON Network
net (BinfoTxOutput -> Value) -> Maybe BinfoTxOutput -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BinfoTxOutput
getBinfoTxInputPrevOut)
        ]

binfoTxInputToEncoding :: Network -> BinfoTxInput -> Encoding
binfoTxInputToEncoding :: Network -> BinfoTxInput -> Encoding
binfoTxInputToEncoding net :: Network
net BinfoTxInput {..} =
    Series -> Encoding
pairs
        (  "sequence" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxInputSeq
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "witness"  Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoTxInputWitness
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "script"   Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoTxInputScript
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "index"    Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxInputIndex
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "prev_out" Text -> Maybe Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Network -> BinfoTxOutput -> Value
binfoTxOutputToJSON Network
net (BinfoTxOutput -> Value) -> Maybe BinfoTxOutput -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BinfoTxOutput
getBinfoTxInputPrevOut)
        )

binfoTxInputParseJSON :: Network -> Value -> Parser BinfoTxInput
binfoTxInputParseJSON :: Network -> Value -> Parser BinfoTxInput
binfoTxInputParseJSON net :: Network
net = String
-> (Object -> Parser BinfoTxInput) -> Value -> Parser BinfoTxInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "txin" ((Object -> Parser BinfoTxInput) -> Value -> Parser BinfoTxInput)
-> (Object -> Parser BinfoTxInput) -> Value -> Parser BinfoTxInput
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    Fingerprint
getBinfoTxInputSeq <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "sequence"
    ByteString
getBinfoTxInputWitness <- Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                              Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "witness"
    ByteString
getBinfoTxInputScript <- Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                             Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "script"
    Fingerprint
getBinfoTxInputIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "index"
    Maybe BinfoTxOutput
getBinfoTxInputPrevOut <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "prev_out" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe BinfoTxOutput))
-> Parser (Maybe BinfoTxOutput)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                              (Value -> Parser BinfoTxOutput)
-> Maybe Value -> Parser (Maybe BinfoTxOutput)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoTxOutput
binfoTxOutputParseJSON Network
net)
    BinfoTxInput -> Parser BinfoTxInput
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoTxInput :: Fingerprint
-> ByteString
-> ByteString
-> Fingerprint
-> Maybe BinfoTxOutput
-> BinfoTxInput
BinfoTxInput {..}

data BinfoTxOutput
    = BinfoTxOutput
        { BinfoTxOutput -> Int
getBinfoTxOutputType     :: !Int
        , BinfoTxOutput -> Bool
getBinfoTxOutputSpent    :: !Bool
        , BinfoTxOutput -> Word64
getBinfoTxOutputValue    :: !Word64
        , BinfoTxOutput -> Fingerprint
getBinfoTxOutputIndex    :: !Word32
        , BinfoTxOutput -> BinfoTxId
getBinfoTxOutputTxIndex  :: !BinfoTxId
        , BinfoTxOutput -> ByteString
getBinfoTxOutputScript   :: !ByteString
        , BinfoTxOutput -> [BinfoSpender]
getBinfoTxOutputSpenders :: ![BinfoSpender]
        , BinfoTxOutput -> Maybe Address
getBinfoTxOutputAddress  :: !(Maybe Address)
        , BinfoTxOutput -> Maybe BinfoXPubPath
getBinfoTxOutputXPub     :: !(Maybe BinfoXPubPath)
        }
    deriving (BinfoTxOutput -> BinfoTxOutput -> Bool
(BinfoTxOutput -> BinfoTxOutput -> Bool)
-> (BinfoTxOutput -> BinfoTxOutput -> Bool) -> Eq BinfoTxOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoTxOutput -> BinfoTxOutput -> Bool
$c/= :: BinfoTxOutput -> BinfoTxOutput -> Bool
== :: BinfoTxOutput -> BinfoTxOutput -> Bool
$c== :: BinfoTxOutput -> BinfoTxOutput -> Bool
Eq, Int -> BinfoTxOutput -> ShowS
[BinfoTxOutput] -> ShowS
BinfoTxOutput -> String
(Int -> BinfoTxOutput -> ShowS)
-> (BinfoTxOutput -> String)
-> ([BinfoTxOutput] -> ShowS)
-> Show BinfoTxOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoTxOutput] -> ShowS
$cshowList :: [BinfoTxOutput] -> ShowS
show :: BinfoTxOutput -> String
$cshow :: BinfoTxOutput -> String
showsPrec :: Int -> BinfoTxOutput -> ShowS
$cshowsPrec :: Int -> BinfoTxOutput -> ShowS
Show, (forall x. BinfoTxOutput -> Rep BinfoTxOutput x)
-> (forall x. Rep BinfoTxOutput x -> BinfoTxOutput)
-> Generic BinfoTxOutput
forall x. Rep BinfoTxOutput x -> BinfoTxOutput
forall x. BinfoTxOutput -> Rep BinfoTxOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoTxOutput x -> BinfoTxOutput
$cfrom :: forall x. BinfoTxOutput -> Rep BinfoTxOutput x
Generic, Get BinfoTxOutput
Putter BinfoTxOutput
Putter BinfoTxOutput
-> Get BinfoTxOutput -> Serialize BinfoTxOutput
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoTxOutput
$cget :: Get BinfoTxOutput
put :: Putter BinfoTxOutput
$cput :: Putter BinfoTxOutput
Serialize, BinfoTxOutput -> ()
(BinfoTxOutput -> ()) -> NFData BinfoTxOutput
forall a. (a -> ()) -> NFData a
rnf :: BinfoTxOutput -> ()
$crnf :: BinfoTxOutput -> ()
NFData)

binfoTxOutputToJSON :: Network -> BinfoTxOutput -> Value
binfoTxOutputToJSON :: Network -> BinfoTxOutput -> Value
binfoTxOutputToJSON net :: Network
net BinfoTxOutput {..} =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ "type" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
getBinfoTxOutputType
        , "spent" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoTxOutputSpent
        , "value" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoTxOutputValue
        , "spending_outpoints" Text -> [BinfoSpender] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BinfoSpender]
getBinfoTxOutputSpenders
        , "n" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxOutputIndex
        , "tx_index" Text -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoTxOutputTxIndex
        , "script" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoTxOutputScript
        ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
        [ "addr" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> Address -> Value
addrToJSON Network
net Address
a
        | Address
a <- Maybe Address -> [Address]
forall a. Maybe a -> [a]
maybeToList Maybe Address
getBinfoTxOutputAddress
        ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
        [ "xpub" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> BinfoXPubPath -> Value
binfoXPubPathToJSON Network
net BinfoXPubPath
x
        | BinfoXPubPath
x <- Maybe BinfoXPubPath -> [BinfoXPubPath]
forall a. Maybe a -> [a]
maybeToList Maybe BinfoXPubPath
getBinfoTxOutputXPub
        ]

binfoTxOutputToEncoding :: Network -> BinfoTxOutput -> Encoding
binfoTxOutputToEncoding :: Network -> BinfoTxOutput -> Encoding
binfoTxOutputToEncoding net :: Network
net BinfoTxOutput {..} =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$
        [ "type" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
getBinfoTxOutputType
        , "spent" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoTxOutputSpent
        , "value" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoTxOutputValue
        , "spending_outpoints" Text -> [BinfoSpender] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BinfoSpender]
getBinfoTxOutputSpenders
        , "n" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoTxOutputIndex
        , "tx_index" Text -> BinfoTxId -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoTxOutputTxIndex
        , "script" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoTxOutputScript
        ] [Series] -> [Series] -> [Series]
forall a. Semigroup a => a -> a -> a
<>
        [ "addr" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> Address -> Value
addrToJSON Network
net Address
a
        | Address
a <- Maybe Address -> [Address]
forall a. Maybe a -> [a]
maybeToList Maybe Address
getBinfoTxOutputAddress
        ] [Series] -> [Series] -> [Series]
forall a. Semigroup a => a -> a -> a
<>
        [ "xpub" Text -> Value -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> BinfoXPubPath -> Value
binfoXPubPathToJSON Network
net BinfoXPubPath
x
        | BinfoXPubPath
x <- Maybe BinfoXPubPath -> [BinfoXPubPath]
forall a. Maybe a -> [a]
maybeToList Maybe BinfoXPubPath
getBinfoTxOutputXPub
        ]

binfoTxOutputParseJSON :: Network -> Value -> Parser BinfoTxOutput
binfoTxOutputParseJSON :: Network -> Value -> Parser BinfoTxOutput
binfoTxOutputParseJSON net :: Network
net = String
-> (Object -> Parser BinfoTxOutput)
-> Value
-> Parser BinfoTxOutput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "txout" ((Object -> Parser BinfoTxOutput) -> Value -> Parser BinfoTxOutput)
-> (Object -> Parser BinfoTxOutput)
-> Value
-> Parser BinfoTxOutput
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    Int
getBinfoTxOutputType <- Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
    Bool
getBinfoTxOutputSpent <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "spent"
    Word64
getBinfoTxOutputValue <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
    [BinfoSpender]
getBinfoTxOutputSpenders <- Object
o Object -> Text -> Parser [BinfoSpender]
forall a. FromJSON a => Object -> Text -> Parser a
.: "spending_outpoints"
    Fingerprint
getBinfoTxOutputIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "n"
    BinfoTxId
getBinfoTxOutputTxIndex <- Object
o Object -> Text -> Parser BinfoTxId
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx_index"
    ByteString
getBinfoTxOutputScript <- Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "script"
    Maybe Address
getBinfoTxOutputAddress <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "addr" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Address) -> Maybe Value -> Parser (Maybe Address)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser Address
addrFromJSON Network
net)
    Maybe BinfoXPubPath
getBinfoTxOutputXPub <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "xpub" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe BinfoXPubPath))
-> Parser (Maybe BinfoXPubPath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser BinfoXPubPath)
-> Maybe Value -> Parser (Maybe BinfoXPubPath)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoXPubPath
binfoXPubPathParseJSON Network
net)
    BinfoTxOutput -> Parser BinfoTxOutput
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoTxOutput :: Int
-> Bool
-> Word64
-> Fingerprint
-> BinfoTxId
-> ByteString
-> [BinfoSpender]
-> Maybe Address
-> Maybe BinfoXPubPath
-> BinfoTxOutput
BinfoTxOutput {..}

data BinfoSpender
    = BinfoSpender
        { BinfoSpender -> BinfoTxId
getBinfoSpenderTxIndex :: !BinfoTxId
        , BinfoSpender -> Fingerprint
getBinfoSpenderIndex   :: !Word32
        }
    deriving (BinfoSpender -> BinfoSpender -> Bool
(BinfoSpender -> BinfoSpender -> Bool)
-> (BinfoSpender -> BinfoSpender -> Bool) -> Eq BinfoSpender
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoSpender -> BinfoSpender -> Bool
$c/= :: BinfoSpender -> BinfoSpender -> Bool
== :: BinfoSpender -> BinfoSpender -> Bool
$c== :: BinfoSpender -> BinfoSpender -> Bool
Eq, Int -> BinfoSpender -> ShowS
[BinfoSpender] -> ShowS
BinfoSpender -> String
(Int -> BinfoSpender -> ShowS)
-> (BinfoSpender -> String)
-> ([BinfoSpender] -> ShowS)
-> Show BinfoSpender
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoSpender] -> ShowS
$cshowList :: [BinfoSpender] -> ShowS
show :: BinfoSpender -> String
$cshow :: BinfoSpender -> String
showsPrec :: Int -> BinfoSpender -> ShowS
$cshowsPrec :: Int -> BinfoSpender -> ShowS
Show, (forall x. BinfoSpender -> Rep BinfoSpender x)
-> (forall x. Rep BinfoSpender x -> BinfoSpender)
-> Generic BinfoSpender
forall x. Rep BinfoSpender x -> BinfoSpender
forall x. BinfoSpender -> Rep BinfoSpender x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoSpender x -> BinfoSpender
$cfrom :: forall x. BinfoSpender -> Rep BinfoSpender x
Generic, Get BinfoSpender
Putter BinfoSpender
Putter BinfoSpender -> Get BinfoSpender -> Serialize BinfoSpender
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoSpender
$cget :: Get BinfoSpender
put :: Putter BinfoSpender
$cput :: Putter BinfoSpender
Serialize, BinfoSpender -> ()
(BinfoSpender -> ()) -> NFData BinfoSpender
forall a. (a -> ()) -> NFData a
rnf :: BinfoSpender -> ()
$crnf :: BinfoSpender -> ()
NFData)

instance ToJSON BinfoSpender where
    toJSON :: BinfoSpender -> Value
toJSON BinfoSpender {..} =
        [Pair] -> Value
object
            [ "tx_index" Text -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoSpenderTxIndex
            , "n" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoSpenderIndex
            ]
    toEncoding :: BinfoSpender -> Encoding
toEncoding BinfoSpender {..} =
        Series -> Encoding
pairs
            (  "tx_index" Text -> BinfoTxId -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoSpenderTxIndex
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "n"        Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoSpenderIndex
            )

instance FromJSON BinfoSpender where
    parseJSON :: Value -> Parser BinfoSpender
parseJSON = String
-> (Object -> Parser BinfoSpender) -> Value -> Parser BinfoSpender
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "spender" ((Object -> Parser BinfoSpender) -> Value -> Parser BinfoSpender)
-> (Object -> Parser BinfoSpender) -> Value -> Parser BinfoSpender
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        BinfoTxId
getBinfoSpenderTxIndex <- Object
o Object -> Text -> Parser BinfoTxId
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx_index"
        Fingerprint
getBinfoSpenderIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "n"
        BinfoSpender -> Parser BinfoSpender
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoSpender :: BinfoTxId -> Fingerprint -> BinfoSpender
BinfoSpender {..}

data BinfoXPubPath
    = BinfoXPubPath
        { BinfoXPubPath -> XPubKey
getBinfoXPubPathKey   :: !XPubKey
        , BinfoXPubPath -> SoftPath
getBinfoXPubPathDeriv :: !SoftPath
        }
    deriving (BinfoXPubPath -> BinfoXPubPath -> Bool
(BinfoXPubPath -> BinfoXPubPath -> Bool)
-> (BinfoXPubPath -> BinfoXPubPath -> Bool) -> Eq BinfoXPubPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoXPubPath -> BinfoXPubPath -> Bool
$c/= :: BinfoXPubPath -> BinfoXPubPath -> Bool
== :: BinfoXPubPath -> BinfoXPubPath -> Bool
$c== :: BinfoXPubPath -> BinfoXPubPath -> Bool
Eq, Int -> BinfoXPubPath -> ShowS
[BinfoXPubPath] -> ShowS
BinfoXPubPath -> String
(Int -> BinfoXPubPath -> ShowS)
-> (BinfoXPubPath -> String)
-> ([BinfoXPubPath] -> ShowS)
-> Show BinfoXPubPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoXPubPath] -> ShowS
$cshowList :: [BinfoXPubPath] -> ShowS
show :: BinfoXPubPath -> String
$cshow :: BinfoXPubPath -> String
showsPrec :: Int -> BinfoXPubPath -> ShowS
$cshowsPrec :: Int -> BinfoXPubPath -> ShowS
Show, (forall x. BinfoXPubPath -> Rep BinfoXPubPath x)
-> (forall x. Rep BinfoXPubPath x -> BinfoXPubPath)
-> Generic BinfoXPubPath
forall x. Rep BinfoXPubPath x -> BinfoXPubPath
forall x. BinfoXPubPath -> Rep BinfoXPubPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoXPubPath x -> BinfoXPubPath
$cfrom :: forall x. BinfoXPubPath -> Rep BinfoXPubPath x
Generic, Get BinfoXPubPath
Putter BinfoXPubPath
Putter BinfoXPubPath
-> Get BinfoXPubPath -> Serialize BinfoXPubPath
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoXPubPath
$cget :: Get BinfoXPubPath
put :: Putter BinfoXPubPath
$cput :: Putter BinfoXPubPath
Serialize, BinfoXPubPath -> ()
(BinfoXPubPath -> ()) -> NFData BinfoXPubPath
forall a. (a -> ()) -> NFData a
rnf :: BinfoXPubPath -> ()
$crnf :: BinfoXPubPath -> ()
NFData)

binfoXPubPathToJSON :: Network -> BinfoXPubPath -> Value
binfoXPubPathToJSON :: Network -> BinfoXPubPath -> Value
binfoXPubPathToJSON net :: Network
net BinfoXPubPath {..} =
    [Pair] -> Value
object
        [ "m" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> XPubKey -> Value
xPubToJSON Network
net XPubKey
getBinfoXPubPathKey
        , "path" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("M" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SoftPath -> String
forall t. DerivPathI t -> String
pathToStr SoftPath
getBinfoXPubPathDeriv)
        ]

binfoXPubPathToEncoding :: Network -> BinfoXPubPath -> Encoding
binfoXPubPathToEncoding :: Network -> BinfoXPubPath -> Encoding
binfoXPubPathToEncoding net :: Network
net BinfoXPubPath {..} =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        "m" Text -> Encoding -> Series
`pair` Network -> XPubKey -> Encoding
xPubToEncoding Network
net XPubKey
getBinfoXPubPathKey Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "path" Text -> String -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ("M" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SoftPath -> String
forall t. DerivPathI t -> String
pathToStr SoftPath
getBinfoXPubPathDeriv)

binfoXPubPathParseJSON :: Network -> Value -> Parser BinfoXPubPath
binfoXPubPathParseJSON :: Network -> Value -> Parser BinfoXPubPath
binfoXPubPathParseJSON net :: Network
net = String
-> (Object -> Parser BinfoXPubPath)
-> Value
-> Parser BinfoXPubPath
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "xpub" ((Object -> Parser BinfoXPubPath) -> Value -> Parser BinfoXPubPath)
-> (Object -> Parser BinfoXPubPath)
-> Value
-> Parser BinfoXPubPath
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    XPubKey
getBinfoXPubPathKey <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "m" Parser Value -> (Value -> Parser XPubKey) -> Parser XPubKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Network -> Value -> Parser XPubKey
xPubFromJSON Network
net
    SoftPath
getBinfoXPubPathDeriv <-
        SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe "bad xpub path" (Maybe SoftPath -> SoftPath)
-> (String -> Maybe SoftPath) -> String -> SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe SoftPath
parseSoft (String -> SoftPath) -> Parser String -> Parser SoftPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "path"
    BinfoXPubPath -> Parser BinfoXPubPath
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoXPubPath :: XPubKey -> SoftPath -> BinfoXPubPath
BinfoXPubPath {..}

data BinfoInfo
    = BinfoInfo
        { BinfoInfo -> Fingerprint
getBinfoConnected   :: !Word32
        , BinfoInfo -> Double
getBinfoConversion  :: !Double
        , BinfoInfo -> BinfoSymbol
getBinfoLocal       :: !BinfoSymbol
        , BinfoInfo -> BinfoSymbol
getBinfoBTC         :: !BinfoSymbol
        , BinfoInfo -> BinfoBlockInfo
getBinfoLatestBlock :: !BinfoBlockInfo
        }
    deriving (BinfoInfo -> BinfoInfo -> Bool
(BinfoInfo -> BinfoInfo -> Bool)
-> (BinfoInfo -> BinfoInfo -> Bool) -> Eq BinfoInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoInfo -> BinfoInfo -> Bool
$c/= :: BinfoInfo -> BinfoInfo -> Bool
== :: BinfoInfo -> BinfoInfo -> Bool
$c== :: BinfoInfo -> BinfoInfo -> Bool
Eq, Int -> BinfoInfo -> ShowS
[BinfoInfo] -> ShowS
BinfoInfo -> String
(Int -> BinfoInfo -> ShowS)
-> (BinfoInfo -> String)
-> ([BinfoInfo] -> ShowS)
-> Show BinfoInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoInfo] -> ShowS
$cshowList :: [BinfoInfo] -> ShowS
show :: BinfoInfo -> String
$cshow :: BinfoInfo -> String
showsPrec :: Int -> BinfoInfo -> ShowS
$cshowsPrec :: Int -> BinfoInfo -> ShowS
Show, (forall x. BinfoInfo -> Rep BinfoInfo x)
-> (forall x. Rep BinfoInfo x -> BinfoInfo) -> Generic BinfoInfo
forall x. Rep BinfoInfo x -> BinfoInfo
forall x. BinfoInfo -> Rep BinfoInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoInfo x -> BinfoInfo
$cfrom :: forall x. BinfoInfo -> Rep BinfoInfo x
Generic, BinfoInfo -> ()
(BinfoInfo -> ()) -> NFData BinfoInfo
forall a. (a -> ()) -> NFData a
rnf :: BinfoInfo -> ()
$crnf :: BinfoInfo -> ()
NFData)

instance ToJSON BinfoInfo where
    toJSON :: BinfoInfo -> Value
toJSON BinfoInfo {..} =
        [Pair] -> Value
object
            [ "nconnected" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoConnected
            , "conversion" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
getBinfoConversion
            , "symbol_local" Text -> BinfoSymbol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoSymbol
getBinfoLocal
            , "symbol_btc" Text -> BinfoSymbol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoSymbol
getBinfoBTC
            , "latest_block" Text -> BinfoBlockInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoBlockInfo
getBinfoLatestBlock
            ]
    toEncoding :: BinfoInfo -> Encoding
toEncoding BinfoInfo {..} =
        Series -> Encoding
pairs
            (  "nconnected" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoConnected
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "conversion" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
getBinfoConversion
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "symbol_local" Text -> BinfoSymbol -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoSymbol
getBinfoLocal
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "symbol_btc" Text -> BinfoSymbol -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoSymbol
getBinfoBTC
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "latest_block" Text -> BinfoBlockInfo -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoBlockInfo
getBinfoLatestBlock
            )

instance FromJSON BinfoInfo where
    parseJSON :: Value -> Parser BinfoInfo
parseJSON = String -> (Object -> Parser BinfoInfo) -> Value -> Parser BinfoInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "info" ((Object -> Parser BinfoInfo) -> Value -> Parser BinfoInfo)
-> (Object -> Parser BinfoInfo) -> Value -> Parser BinfoInfo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Fingerprint
getBinfoConnected <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "nconnected"
        Double
getBinfoConversion <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "conversion"
        BinfoSymbol
getBinfoLocal <- Object
o Object -> Text -> Parser BinfoSymbol
forall a. FromJSON a => Object -> Text -> Parser a
.: "symbol_local"
        BinfoSymbol
getBinfoBTC <- Object
o Object -> Text -> Parser BinfoSymbol
forall a. FromJSON a => Object -> Text -> Parser a
.: "symbol_btc"
        BinfoBlockInfo
getBinfoLatestBlock <- Object
o Object -> Text -> Parser BinfoBlockInfo
forall a. FromJSON a => Object -> Text -> Parser a
.: "latest_block"
        BinfoInfo -> Parser BinfoInfo
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoInfo :: Fingerprint
-> Double
-> BinfoSymbol
-> BinfoSymbol
-> BinfoBlockInfo
-> BinfoInfo
BinfoInfo {..}

data BinfoBlockInfo
    = BinfoBlockInfo
        { BinfoBlockInfo -> BlockHash
getBinfoBlockInfoHash   :: !BlockHash
        , BinfoBlockInfo -> Fingerprint
getBinfoBlockInfoHeight :: !BlockHeight
        , BinfoBlockInfo -> Fingerprint
getBinfoBlockInfoTime   :: !Word32
        , BinfoBlockInfo -> Fingerprint
getBinfoBlockInfoIndex  :: !BlockHeight
        }
    deriving (BinfoBlockInfo -> BinfoBlockInfo -> Bool
(BinfoBlockInfo -> BinfoBlockInfo -> Bool)
-> (BinfoBlockInfo -> BinfoBlockInfo -> Bool) -> Eq BinfoBlockInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
$c/= :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
== :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
$c== :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
Eq, Int -> BinfoBlockInfo -> ShowS
[BinfoBlockInfo] -> ShowS
BinfoBlockInfo -> String
(Int -> BinfoBlockInfo -> ShowS)
-> (BinfoBlockInfo -> String)
-> ([BinfoBlockInfo] -> ShowS)
-> Show BinfoBlockInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoBlockInfo] -> ShowS
$cshowList :: [BinfoBlockInfo] -> ShowS
show :: BinfoBlockInfo -> String
$cshow :: BinfoBlockInfo -> String
showsPrec :: Int -> BinfoBlockInfo -> ShowS
$cshowsPrec :: Int -> BinfoBlockInfo -> ShowS
Show, (forall x. BinfoBlockInfo -> Rep BinfoBlockInfo x)
-> (forall x. Rep BinfoBlockInfo x -> BinfoBlockInfo)
-> Generic BinfoBlockInfo
forall x. Rep BinfoBlockInfo x -> BinfoBlockInfo
forall x. BinfoBlockInfo -> Rep BinfoBlockInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoBlockInfo x -> BinfoBlockInfo
$cfrom :: forall x. BinfoBlockInfo -> Rep BinfoBlockInfo x
Generic, Get BinfoBlockInfo
Putter BinfoBlockInfo
Putter BinfoBlockInfo
-> Get BinfoBlockInfo -> Serialize BinfoBlockInfo
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoBlockInfo
$cget :: Get BinfoBlockInfo
put :: Putter BinfoBlockInfo
$cput :: Putter BinfoBlockInfo
Serialize, BinfoBlockInfo -> ()
(BinfoBlockInfo -> ()) -> NFData BinfoBlockInfo
forall a. (a -> ()) -> NFData a
rnf :: BinfoBlockInfo -> ()
$crnf :: BinfoBlockInfo -> ()
NFData)

instance ToJSON BinfoBlockInfo where
    toJSON :: BinfoBlockInfo -> Value
toJSON BinfoBlockInfo {..} =
        [Pair] -> Value
object
            [ "hash" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
getBinfoBlockInfoHash
            , "height" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockInfoHeight
            , "time" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockInfoTime
            , "block_index" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockInfoIndex
            ]
    toEncoding :: BinfoBlockInfo -> Encoding
toEncoding BinfoBlockInfo {..} =
        Series -> Encoding
pairs
            (  "hash" Text -> BlockHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
getBinfoBlockInfoHash
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "height" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockInfoHeight
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "time" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockInfoTime
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "block_index" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockInfoIndex
            )

instance FromJSON BinfoBlockInfo where
    parseJSON :: Value -> Parser BinfoBlockInfo
parseJSON = String
-> (Object -> Parser BinfoBlockInfo)
-> Value
-> Parser BinfoBlockInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "block_info" ((Object -> Parser BinfoBlockInfo)
 -> Value -> Parser BinfoBlockInfo)
-> (Object -> Parser BinfoBlockInfo)
-> Value
-> Parser BinfoBlockInfo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        BlockHash
getBinfoBlockInfoHash <- Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "hash"
        Fingerprint
getBinfoBlockInfoHeight <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "height"
        Fingerprint
getBinfoBlockInfoTime <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "time"
        Fingerprint
getBinfoBlockInfoIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "block_index"
        BinfoBlockInfo -> Parser BinfoBlockInfo
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoBlockInfo :: BlockHash
-> Fingerprint -> Fingerprint -> Fingerprint -> BinfoBlockInfo
BinfoBlockInfo {..}

data BinfoTicker
    = BinfoTicker
        { BinfoTicker -> Double
binfoTicker15m    :: !Double
        , BinfoTicker -> Double
binfoTickerLast   :: !Double
        , BinfoTicker -> Double
binfoTickerBuy    :: !Double
        , BinfoTicker -> Double
binfoTickerSell   :: !Double
        , BinfoTicker -> Text
binfoTickerSymbol :: !Text
        }
    deriving (BinfoTicker -> BinfoTicker -> Bool
(BinfoTicker -> BinfoTicker -> Bool)
-> (BinfoTicker -> BinfoTicker -> Bool) -> Eq BinfoTicker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoTicker -> BinfoTicker -> Bool
$c/= :: BinfoTicker -> BinfoTicker -> Bool
== :: BinfoTicker -> BinfoTicker -> Bool
$c== :: BinfoTicker -> BinfoTicker -> Bool
Eq, Int -> BinfoTicker -> ShowS
[BinfoTicker] -> ShowS
BinfoTicker -> String
(Int -> BinfoTicker -> ShowS)
-> (BinfoTicker -> String)
-> ([BinfoTicker] -> ShowS)
-> Show BinfoTicker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoTicker] -> ShowS
$cshowList :: [BinfoTicker] -> ShowS
show :: BinfoTicker -> String
$cshow :: BinfoTicker -> String
showsPrec :: Int -> BinfoTicker -> ShowS
$cshowsPrec :: Int -> BinfoTicker -> ShowS
Show, (forall x. BinfoTicker -> Rep BinfoTicker x)
-> (forall x. Rep BinfoTicker x -> BinfoTicker)
-> Generic BinfoTicker
forall x. Rep BinfoTicker x -> BinfoTicker
forall x. BinfoTicker -> Rep BinfoTicker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoTicker x -> BinfoTicker
$cfrom :: forall x. BinfoTicker -> Rep BinfoTicker x
Generic, BinfoTicker -> ()
(BinfoTicker -> ()) -> NFData BinfoTicker
forall a. (a -> ()) -> NFData a
rnf :: BinfoTicker -> ()
$crnf :: BinfoTicker -> ()
NFData)

instance Default BinfoTicker where
    def :: BinfoTicker
def = $WBinfoTicker :: Double -> Double -> Double -> Double -> Text -> BinfoTicker
BinfoTicker{ binfoTickerSymbol :: Text
binfoTickerSymbol = "XXX"
                     , binfoTicker15m :: Double
binfoTicker15m = 0.0
                     , binfoTickerLast :: Double
binfoTickerLast = 0.0
                     , binfoTickerBuy :: Double
binfoTickerBuy = 0.0
                     , binfoTickerSell :: Double
binfoTickerSell = 0.0
                     }

instance ToJSON BinfoTicker where
    toJSON :: BinfoTicker -> Value
toJSON BinfoTicker{..} =
        [Pair] -> Value
object
            [ "symbol" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
binfoTickerSymbol
            , "sell" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTickerSell
            , "buy" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTickerBuy
            , "last" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTickerLast
            , "15m" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTicker15m
            ]
    toEncoding :: BinfoTicker -> Encoding
toEncoding BinfoTicker{..} =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        "symbol" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
binfoTickerSymbol Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "sell" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTickerSell Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "buy" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTickerBuy Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "last" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTickerLast Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
        "15m" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
binfoTicker15m

instance FromJSON BinfoTicker where
    parseJSON :: Value -> Parser BinfoTicker
parseJSON = String
-> (Object -> Parser BinfoTicker) -> Value -> Parser BinfoTicker
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "ticker" ((Object -> Parser BinfoTicker) -> Value -> Parser BinfoTicker)
-> (Object -> Parser BinfoTicker) -> Value -> Parser BinfoTicker
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Text
binfoTickerSymbol <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "symbol"
        Double
binfoTicker15m <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "15m"
        Double
binfoTickerSell <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "sell"
        Double
binfoTickerBuy <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "buy"
        Double
binfoTickerLast <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "last"
        BinfoTicker -> Parser BinfoTicker
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoTicker :: Double -> Double -> Double -> Double -> Text -> BinfoTicker
BinfoTicker{..}

data BinfoSymbol
    = BinfoSymbol
        { BinfoSymbol -> Text
getBinfoSymbolCode       :: !Text
        , BinfoSymbol -> Text
getBinfoSymbolString     :: !Text
        , BinfoSymbol -> Text
getBinfoSymbolName       :: !Text
        , BinfoSymbol -> Double
getBinfoSymbolConversion :: !Double
        , BinfoSymbol -> Bool
getBinfoSymbolAfter      :: !Bool
        , BinfoSymbol -> Bool
getBinfoSymbolLocal      :: !Bool
        }
    deriving (BinfoSymbol -> BinfoSymbol -> Bool
(BinfoSymbol -> BinfoSymbol -> Bool)
-> (BinfoSymbol -> BinfoSymbol -> Bool) -> Eq BinfoSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoSymbol -> BinfoSymbol -> Bool
$c/= :: BinfoSymbol -> BinfoSymbol -> Bool
== :: BinfoSymbol -> BinfoSymbol -> Bool
$c== :: BinfoSymbol -> BinfoSymbol -> Bool
Eq, Int -> BinfoSymbol -> ShowS
[BinfoSymbol] -> ShowS
BinfoSymbol -> String
(Int -> BinfoSymbol -> ShowS)
-> (BinfoSymbol -> String)
-> ([BinfoSymbol] -> ShowS)
-> Show BinfoSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoSymbol] -> ShowS
$cshowList :: [BinfoSymbol] -> ShowS
show :: BinfoSymbol -> String
$cshow :: BinfoSymbol -> String
showsPrec :: Int -> BinfoSymbol -> ShowS
$cshowsPrec :: Int -> BinfoSymbol -> ShowS
Show, (forall x. BinfoSymbol -> Rep BinfoSymbol x)
-> (forall x. Rep BinfoSymbol x -> BinfoSymbol)
-> Generic BinfoSymbol
forall x. Rep BinfoSymbol x -> BinfoSymbol
forall x. BinfoSymbol -> Rep BinfoSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoSymbol x -> BinfoSymbol
$cfrom :: forall x. BinfoSymbol -> Rep BinfoSymbol x
Generic, BinfoSymbol -> ()
(BinfoSymbol -> ()) -> NFData BinfoSymbol
forall a. (a -> ()) -> NFData a
rnf :: BinfoSymbol -> ()
$crnf :: BinfoSymbol -> ()
NFData)

instance Default BinfoSymbol where
    def :: BinfoSymbol
def = $WBinfoSymbol :: Text -> Text -> Text -> Double -> Bool -> Bool -> BinfoSymbol
BinfoSymbol{ getBinfoSymbolCode :: Text
getBinfoSymbolCode = "XXX"
                     , getBinfoSymbolString :: Text
getBinfoSymbolString = "¤"
                     , getBinfoSymbolName :: Text
getBinfoSymbolName = "No currency"
                     , getBinfoSymbolConversion :: Double
getBinfoSymbolConversion = 0.0
                     , getBinfoSymbolAfter :: Bool
getBinfoSymbolAfter = Bool
False
                     , getBinfoSymbolLocal :: Bool
getBinfoSymbolLocal = Bool
True
                     }

instance ToJSON BinfoSymbol where
    toJSON :: BinfoSymbol -> Value
toJSON BinfoSymbol {..} =
        [Pair] -> Value
object
            [ "code" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
getBinfoSymbolCode
            , "symbol" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
getBinfoSymbolString
            , "name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
getBinfoSymbolName
            , "conversion" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
getBinfoSymbolConversion
            , "symbolAppearsAfter" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoSymbolAfter
            , "local" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoSymbolLocal
            ]
    toEncoding :: BinfoSymbol -> Encoding
toEncoding BinfoSymbol {..} =
        Series -> Encoding
pairs
            (  "code" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
getBinfoSymbolCode
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "symbol" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
getBinfoSymbolString
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "name" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
getBinfoSymbolName
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "conversion" Text -> Double -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double
getBinfoSymbolConversion
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "symbolAppearsAfter" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoSymbolAfter
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "local" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoSymbolLocal
            )

instance FromJSON BinfoSymbol where
    parseJSON :: Value -> Parser BinfoSymbol
parseJSON = String
-> (Object -> Parser BinfoSymbol) -> Value -> Parser BinfoSymbol
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "symbol" ((Object -> Parser BinfoSymbol) -> Value -> Parser BinfoSymbol)
-> (Object -> Parser BinfoSymbol) -> Value -> Parser BinfoSymbol
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
        Text
getBinfoSymbolCode <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "code"
        Text
getBinfoSymbolString <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "symbol"
        Text
getBinfoSymbolName <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
        Double
getBinfoSymbolConversion <- Object
o Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.: "conversion"
        Bool
getBinfoSymbolAfter <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "symbolAppearsAfter"
        Bool
getBinfoSymbolLocal <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "local"
        BinfoSymbol -> Parser BinfoSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoSymbol :: Text -> Text -> Text -> Double -> Bool -> Bool -> BinfoSymbol
BinfoSymbol {..}

relevantTxs :: HashSet Address
            -> Bool
            -> Transaction
            -> HashSet TxHash
relevantTxs :: HashSet Address -> Bool -> Transaction -> HashSet TxHash
relevantTxs addrs :: HashSet Address
addrs prune :: Bool
prune t :: Transaction
t@Transaction{..} =
    let p :: Address -> Bool
p a :: Address
a = Bool
prune Bool -> Bool -> Bool
&& HashSet Address -> Transaction -> BinfoTxIndex
getTxResult HashSet Address
addrs Transaction
t BinfoTxIndex -> BinfoTxIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Bool -> Bool
not (Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Address
a HashSet Address
addrs)
        f :: StoreOutput -> Maybe TxHash
f StoreOutput{..} =
            case Maybe Spender
outputSpender of
                Nothing -> Maybe TxHash
forall a. Maybe a
Nothing
                Just Spender{..} ->
                    case Maybe Address
outputAddress of
                        Nothing -> Maybe TxHash
forall a. Maybe a
Nothing
                        Just a :: Address
a | Address -> Bool
p Address
a -> Maybe TxHash
forall a. Maybe a
Nothing
                               | Bool
otherwise -> TxHash -> Maybe TxHash
forall a. a -> Maybe a
Just TxHash
spenderHash
        outs :: [TxHash]
outs = (StoreOutput -> Maybe TxHash) -> [StoreOutput] -> [TxHash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StoreOutput -> Maybe TxHash
f [StoreOutput]
transactionOutputs
        g :: StoreInput -> Maybe TxHash
g StoreCoinbase{}                       = Maybe TxHash
forall a. Maybe a
Nothing
        g StoreInput{inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint{..}} = TxHash -> Maybe TxHash
forall a. a -> Maybe a
Just TxHash
outPointHash
        ins :: [TxHash]
ins = (StoreInput -> Maybe TxHash) -> [StoreInput] -> [TxHash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StoreInput -> Maybe TxHash
g [StoreInput]
transactionInputs
      in [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash) -> [TxHash] -> HashSet TxHash
forall a b. (a -> b) -> a -> b
$ [TxHash]
ins [TxHash] -> [TxHash] -> [TxHash]
forall a. Semigroup a => a -> a -> a
<> [TxHash]
outs

toBinfoAddrs :: HashMap Address Balance
             -> HashMap XPubKey [XPubBal]
             -> HashMap XPubKey Int
             -> [BinfoAddress]
toBinfoAddrs :: HashMap Address Balance
-> HashMap XPubKey [XPubBal]
-> HashMap XPubKey Int
-> [BinfoAddress]
toBinfoAddrs only_addrs :: HashMap Address Balance
only_addrs only_xpubs :: HashMap XPubKey [XPubBal]
only_xpubs xpub_txs :: HashMap XPubKey Int
xpub_txs =
    [BinfoAddress]
xpub_bals [BinfoAddress] -> [BinfoAddress] -> [BinfoAddress]
forall a. Semigroup a => a -> a -> a
<> [BinfoAddress]
addr_bals
  where
    xpub_bal :: XPubKey -> [XPubBal] -> BinfoAddress
xpub_bal k :: XPubKey
k xs :: [XPubBal]
xs =
        let f :: XPubBal -> Word64
f x :: XPubBal
x = case XPubBal -> [Fingerprint]
xPubBalPath XPubBal
x of
                [0, _] -> Balance -> Word64
balanceTotalReceived (XPubBal -> Balance
xPubBal XPubBal
x)
                _      -> 0
            g :: XPubBal -> Word64
g x :: XPubBal
x = Balance -> Word64
balanceAmount (XPubBal -> Balance
xPubBal XPubBal
x) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Balance -> Word64
balanceZero (XPubBal -> Balance
xPubBal XPubBal
x)
            i :: Fingerprint -> XPubBal -> Fingerprint
i m :: Fingerprint
m x :: XPubBal
x = case XPubBal -> [Fingerprint]
xPubBalPath XPubBal
x of
                [m' :: Fingerprint
m', n :: Fingerprint
n] | Fingerprint
m Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== Fingerprint
m' -> Fingerprint
n Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
+ 1
                _                 -> 0
            received :: Word64
received = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> Word64
f [XPubBal]
xs)
            bal :: Word64
bal = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((XPubBal -> Word64) -> [XPubBal] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map XPubBal -> Word64
g [XPubBal]
xs))
            sent :: Word64
sent = if Word64
bal Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
received then Word64
received Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
bal else 0
            count :: Word64
count = case XPubKey -> HashMap XPubKey Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup XPubKey
k HashMap XPubKey Int
xpub_txs of
                Nothing -> 0
                Just i :: Int
i  -> Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
            ax :: Fingerprint
ax = (Fingerprint -> Fingerprint -> Fingerprint)
-> Fingerprint -> [Fingerprint] -> Fingerprint
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Fingerprint -> Fingerprint -> Fingerprint
forall a. Ord a => a -> a -> a
max 0 ((XPubBal -> Fingerprint) -> [XPubBal] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint -> XPubBal -> Fingerprint
i 0) [XPubBal]
xs)
            cx :: Fingerprint
cx = (Fingerprint -> Fingerprint -> Fingerprint)
-> Fingerprint -> [Fingerprint] -> Fingerprint
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Fingerprint -> Fingerprint -> Fingerprint
forall a. Ord a => a -> a -> a
max 0 ((XPubBal -> Fingerprint) -> [XPubBal] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map (Fingerprint -> XPubBal -> Fingerprint
i 1) [XPubBal]
xs)
        in $WBinfoXPubKey :: XPubKey
-> Word64
-> Word64
-> Word64
-> Word64
-> Fingerprint
-> Fingerprint
-> BinfoAddress
BinfoXPubKey{ getBinfoXPubKey :: XPubKey
getBinfoXPubKey = XPubKey
k
                       , getBinfoAddrTxCount :: Word64
getBinfoAddrTxCount = Word64
count
                       , getBinfoAddrReceived :: Word64
getBinfoAddrReceived = Word64
received
                       , getBinfoAddrSent :: Word64
getBinfoAddrSent = Word64
sent
                       , getBinfoAddrBalance :: Word64
getBinfoAddrBalance = Word64
bal
                       , getBinfoXPubAccountIndex :: Fingerprint
getBinfoXPubAccountIndex = Fingerprint
ax
                       , getBinfoXPubChangeIndex :: Fingerprint
getBinfoXPubChangeIndex = Fingerprint
cx
                       }
    xpub_bals :: [BinfoAddress]
xpub_bals = ((XPubKey, [XPubBal]) -> BinfoAddress)
-> [(XPubKey, [XPubBal])] -> [BinfoAddress]
forall a b. (a -> b) -> [a] -> [b]
map ((XPubKey -> [XPubBal] -> BinfoAddress)
-> (XPubKey, [XPubBal]) -> BinfoAddress
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubKey -> [XPubBal] -> BinfoAddress
xpub_bal) (HashMap XPubKey [XPubBal] -> [(XPubKey, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubKey [XPubBal]
only_xpubs)
    addr_bals :: [BinfoAddress]
addr_bals =
        let f :: Balance -> BinfoAddress
f Balance{..} =
                let addr :: Address
addr = Address
balanceAddress
                    sent :: Word64
sent = Word64
recv Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
bal
                    recv :: Word64
recv = Word64
balanceTotalReceived
                    tx_count :: Word64
tx_count = Word64
balanceTxCount
                    bal :: Word64
bal = Word64
balanceAmount Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
balanceZero
                in $WBinfoAddress :: Address -> Word64 -> Word64 -> Word64 -> Word64 -> BinfoAddress
BinfoAddress{ getBinfoAddress :: Address
getBinfoAddress = Address
addr
                               , getBinfoAddrTxCount :: Word64
getBinfoAddrTxCount = Word64
tx_count
                               , getBinfoAddrReceived :: Word64
getBinfoAddrReceived = Word64
recv
                               , getBinfoAddrSent :: Word64
getBinfoAddrSent = Word64
sent
                               , getBinfoAddrBalance :: Word64
getBinfoAddrBalance = Word64
bal
                               }
         in (Balance -> BinfoAddress) -> [Balance] -> [BinfoAddress]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> BinfoAddress
f ([Balance] -> [BinfoAddress]) -> [Balance] -> [BinfoAddress]
forall a b. (a -> b) -> a -> b
$ HashMap Address Balance -> [Balance]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap Address Balance
only_addrs

toBinfoTxSimple :: Maybe (HashMap TxHash Transaction)
                -> Transaction
                -> BinfoTx
toBinfoTxSimple :: Maybe (HashMap TxHash Transaction) -> Transaction -> BinfoTx
toBinfoTxSimple etxs :: Maybe (HashMap TxHash Transaction)
etxs =
    Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet Address
-> Bool
-> BinfoTxIndex
-> Transaction
-> BinfoTx
toBinfoTx Maybe (HashMap TxHash Transaction)
etxs HashMap Address (Maybe BinfoXPubPath)
forall k v. HashMap k v
HashMap.empty HashSet Address
forall a. HashSet a
HashSet.empty Bool
False 0

toBinfoTxInputs :: Maybe (HashMap TxHash Transaction)
                -> HashMap Address (Maybe BinfoXPubPath)
                -> Transaction
                -> [BinfoTxInput]
toBinfoTxInputs :: Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> [BinfoTxInput]
toBinfoTxInputs etxs :: Maybe (HashMap TxHash Transaction)
etxs abook :: HashMap Address (Maybe BinfoXPubPath)
abook t :: Transaction
t =
    (Fingerprint -> StoreInput -> BinfoTxInput)
-> [Fingerprint] -> [StoreInput] -> [BinfoTxInput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Fingerprint -> StoreInput -> BinfoTxInput
f [0..] (Transaction -> [StoreInput]
transactionInputs Transaction
t)
  where
    f :: Fingerprint -> StoreInput -> BinfoTxInput
f n :: Fingerprint
n i :: StoreInput
i = $WBinfoTxInput :: Fingerprint
-> ByteString
-> ByteString
-> Fingerprint
-> Maybe BinfoTxOutput
-> BinfoTxInput
BinfoTxInput{ getBinfoTxInputIndex :: Fingerprint
getBinfoTxInputIndex = Fingerprint
n
                        , getBinfoTxInputSeq :: Fingerprint
getBinfoTxInputSeq = StoreInput -> Fingerprint
inputSequence StoreInput
i
                        , getBinfoTxInputScript :: ByteString
getBinfoTxInputScript = StoreInput -> ByteString
inputSigScript StoreInput
i
                        , getBinfoTxInputWitness :: ByteString
getBinfoTxInputWitness = StoreInput -> ByteString
wit StoreInput
i
                        , getBinfoTxInputPrevOut :: Maybe BinfoTxOutput
getBinfoTxInputPrevOut = Fingerprint -> StoreInput -> Maybe BinfoTxOutput
prev Fingerprint
n StoreInput
i
                        }
    wit :: StoreInput -> ByteString
wit i :: StoreInput
i =
        case StoreInput -> WitnessStack
inputWitness StoreInput
i of
            [] -> ByteString
B.empty
            ws :: WitnessStack
ws -> Put -> ByteString
S.runPut (WitnessStack -> Put
forall (t :: * -> *). Foldable t => t ByteString -> Put
put_witness WitnessStack
ws)
    prev :: Fingerprint -> StoreInput -> Maybe BinfoTxOutput
prev = Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> Fingerprint
-> StoreInput
-> Maybe BinfoTxOutput
inputToBinfoTxOutput Maybe (HashMap TxHash Transaction)
etxs HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t
    put_witness :: t ByteString -> Put
put_witness ws :: t ByteString
ws = do
        Putter Int
forall a. Integral a => a -> Put
putVarInt (t ByteString -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t ByteString
ws)
        (ByteString -> Put) -> t ByteString -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
put_item t ByteString
ws
    put_item :: ByteString -> Put
put_item bs :: ByteString
bs = do
        Putter Int
forall a. Integral a => a -> Put
putVarInt (ByteString -> Int
B.length ByteString
bs)
        ByteString -> Put
S.putByteString ByteString
bs

toBinfoBlockIndex :: Transaction -> Maybe BlockHeight
toBinfoBlockIndex :: Transaction -> Maybe Fingerprint
toBinfoBlockIndex Transaction{transactionDeleted :: Transaction -> Bool
transactionDeleted = Bool
True}       = Maybe Fingerprint
forall a. Maybe a
Nothing
toBinfoBlockIndex Transaction{transactionBlock :: Transaction -> BlockRef
transactionBlock = MemRef _}     = Maybe Fingerprint
forall a. Maybe a
Nothing
toBinfoBlockIndex Transaction{transactionBlock :: Transaction -> BlockRef
transactionBlock = BlockRef h :: Fingerprint
h _} = Fingerprint -> Maybe Fingerprint
forall a. a -> Maybe a
Just Fingerprint
h

toBinfoTx :: Maybe (HashMap TxHash Transaction)
          -> HashMap Address (Maybe BinfoXPubPath)
          -> HashSet Address
          -> Bool
          -> Int64
          -> Transaction
          -> BinfoTx
toBinfoTx :: Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> HashSet Address
-> Bool
-> BinfoTxIndex
-> Transaction
-> BinfoTx
toBinfoTx etxs :: Maybe (HashMap TxHash Transaction)
etxs abook :: HashMap Address (Maybe BinfoXPubPath)
abook saddrs :: HashSet Address
saddrs prune :: Bool
prune bal :: BinfoTxIndex
bal t :: Transaction
t@Transaction{..} =
    $WBinfoTx :: TxHash
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Word64
-> ByteString
-> Fingerprint
-> BinfoTxId
-> Bool
-> Maybe (BinfoTxIndex, BinfoTxIndex)
-> Word64
-> Maybe Fingerprint
-> Maybe Fingerprint
-> [BinfoTxInput]
-> [BinfoTxOutput]
-> BinfoTx
BinfoTx{ getBinfoTxHash :: TxHash
getBinfoTxHash = Tx -> TxHash
txHash (Transaction -> Tx
transactionData Transaction
t)
           , getBinfoTxVer :: Fingerprint
getBinfoTxVer = Fingerprint
transactionVersion
           , getBinfoTxVinSz :: Fingerprint
getBinfoTxVinSz = Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([StoreInput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StoreInput]
transactionInputs)
           , getBinfoTxVoutSz :: Fingerprint
getBinfoTxVoutSz = Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([StoreOutput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StoreOutput]
transactionOutputs)
           , getBinfoTxSize :: Fingerprint
getBinfoTxSize = Fingerprint
transactionSize
           , getBinfoTxWeight :: Fingerprint
getBinfoTxWeight = Fingerprint
transactionWeight
           , getBinfoTxFee :: Word64
getBinfoTxFee = Word64
transactionFees
           , getBinfoTxRelayedBy :: ByteString
getBinfoTxRelayedBy = "0.0.0.0"
           , getBinfoTxLockTime :: Fingerprint
getBinfoTxLockTime = Fingerprint
transactionLockTime
           , getBinfoTxIndex :: BinfoTxId
getBinfoTxIndex = Bool -> Transaction -> BinfoTxId
binfoTransactionIndex (Maybe (HashMap TxHash Transaction) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (HashMap TxHash Transaction)
etxs) Transaction
t
           , getBinfoTxDoubleSpend :: Bool
getBinfoTxDoubleSpend = Bool
transactionRBF
           , getBinfoTxTime :: Word64
getBinfoTxTime = Word64
transactionTime
           , getBinfoTxBlockIndex :: Maybe Fingerprint
getBinfoTxBlockIndex = Transaction -> Maybe Fingerprint
toBinfoBlockIndex Transaction
t
           , getBinfoTxBlockHeight :: Maybe Fingerprint
getBinfoTxBlockHeight = Transaction -> Maybe Fingerprint
toBinfoBlockIndex Transaction
t
           , getBinfoTxInputs :: [BinfoTxInput]
getBinfoTxInputs = Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> [BinfoTxInput]
toBinfoTxInputs Maybe (HashMap TxHash Transaction)
etxs HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t
           , getBinfoTxOutputs :: [BinfoTxOutput]
getBinfoTxOutputs = [BinfoTxOutput]
outs
           , getBinfoTxResultBal :: Maybe (BinfoTxIndex, BinfoTxIndex)
getBinfoTxResultBal = Maybe (BinfoTxIndex, BinfoTxIndex)
resbal
           }
  where
    simple :: Bool
simple = HashSet Address -> Bool
forall a. HashSet a -> Bool
HashSet.null HashSet Address
saddrs Bool -> Bool -> Bool
&& HashMap Address (Maybe BinfoXPubPath) -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Address (Maybe BinfoXPubPath)
abook Bool -> Bool -> Bool
&& BinfoTxIndex
bal BinfoTxIndex -> BinfoTxIndex -> Bool
forall a. Eq a => a -> a -> Bool
== 0
    resbal :: Maybe (BinfoTxIndex, BinfoTxIndex)
resbal = if Bool
simple then Maybe (BinfoTxIndex, BinfoTxIndex)
forall a. Maybe a
Nothing else (BinfoTxIndex, BinfoTxIndex) -> Maybe (BinfoTxIndex, BinfoTxIndex)
forall a. a -> Maybe a
Just (HashSet Address -> Transaction -> BinfoTxIndex
getTxResult HashSet Address
saddrs Transaction
t, BinfoTxIndex
bal)
    outs :: [BinfoTxOutput]
outs =
        let p :: Bool
p = Bool
prune Bool -> Bool -> Bool
&& HashSet Address -> Transaction -> BinfoTxIndex
getTxResult HashSet Address
saddrs Transaction
t BinfoTxIndex -> BinfoTxIndex -> Bool
forall a. Ord a => a -> a -> Bool
> 0
            f :: Fingerprint -> StoreOutput -> Maybe BinfoTxOutput
f = Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Transaction
-> Fingerprint
-> StoreOutput
-> Maybe BinfoTxOutput
toBinfoTxOutput Maybe (HashMap TxHash Transaction)
etxs HashMap Address (Maybe BinfoXPubPath)
abook Bool
p Transaction
t
        in [Maybe BinfoTxOutput] -> [BinfoTxOutput]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe BinfoTxOutput] -> [BinfoTxOutput])
-> [Maybe BinfoTxOutput] -> [BinfoTxOutput]
forall a b. (a -> b) -> a -> b
$ (Fingerprint -> StoreOutput -> Maybe BinfoTxOutput)
-> [Fingerprint] -> [StoreOutput] -> [Maybe BinfoTxOutput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Fingerprint -> StoreOutput -> Maybe BinfoTxOutput
f [0..] [StoreOutput]
transactionOutputs

getTxResult :: HashSet Address -> Transaction -> Int64
getTxResult :: HashSet Address -> Transaction -> BinfoTxIndex
getTxResult saddrs :: HashSet Address
saddrs Transaction{..} =
    let input_sum :: BinfoTxIndex
input_sum = [BinfoTxIndex] -> BinfoTxIndex
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([BinfoTxIndex] -> BinfoTxIndex) -> [BinfoTxIndex] -> BinfoTxIndex
forall a b. (a -> b) -> a -> b
$ (StoreInput -> BinfoTxIndex) -> [StoreInput] -> [BinfoTxIndex]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> BinfoTxIndex
forall p. Num p => StoreInput -> p
input_value [StoreInput]
transactionInputs
        input_value :: StoreInput -> p
input_value StoreCoinbase{} = 0
        input_value StoreInput{..} =
            case Maybe Address
inputAddress of
                Nothing -> 0
                Just a :: Address
a ->
                    if Address -> Bool
test_addr Address
a
                    then p -> p
forall a. Num a => a -> a
negate (p -> p) -> p -> p
forall a b. (a -> b) -> a -> b
$ Word64 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
inputAmount
                    else 0
        test_addr :: Address -> Bool
test_addr a :: Address
a = Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Address
a HashSet Address
saddrs
        output_sum :: BinfoTxIndex
output_sum = [BinfoTxIndex] -> BinfoTxIndex
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([BinfoTxIndex] -> BinfoTxIndex) -> [BinfoTxIndex] -> BinfoTxIndex
forall a b. (a -> b) -> a -> b
$ (StoreOutput -> BinfoTxIndex) -> [StoreOutput] -> [BinfoTxIndex]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> BinfoTxIndex
forall p. Num p => StoreOutput -> p
out_value [StoreOutput]
transactionOutputs
        out_value :: StoreOutput -> p
out_value StoreOutput{..} =
            case Maybe Address
outputAddress of
                Nothing -> 0
                Just a :: Address
a ->
                    if Address -> Bool
test_addr Address
a
                    then Word64 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
outputAmount
                    else 0
     in BinfoTxIndex
input_sum BinfoTxIndex -> BinfoTxIndex -> BinfoTxIndex
forall a. Num a => a -> a -> a
+ BinfoTxIndex
output_sum

toBinfoTxOutput :: Maybe (HashMap TxHash Transaction)
                -> HashMap Address (Maybe BinfoXPubPath)
                -> Bool
                -> Transaction
                -> Word32
                -> StoreOutput
                -> Maybe BinfoTxOutput
toBinfoTxOutput :: Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Transaction
-> Fingerprint
-> StoreOutput
-> Maybe BinfoTxOutput
toBinfoTxOutput etxs :: Maybe (HashMap TxHash Transaction)
etxs abook :: HashMap Address (Maybe BinfoXPubPath)
abook prune :: Bool
prune t :: Transaction
t n :: Fingerprint
n StoreOutput{..} =
    let getBinfoTxOutputType :: Int
getBinfoTxOutputType = 0
        getBinfoTxOutputSpent :: Bool
getBinfoTxOutputSpent = Maybe Spender -> Bool
forall a. Maybe a -> Bool
isJust Maybe Spender
outputSpender
        getBinfoTxOutputValue :: Word64
getBinfoTxOutputValue = Word64
outputAmount
        getBinfoTxOutputIndex :: Fingerprint
getBinfoTxOutputIndex = Fingerprint
n
        getBinfoTxOutputTxIndex :: BinfoTxId
getBinfoTxOutputTxIndex = Bool -> Transaction -> BinfoTxId
binfoTransactionIndex (Maybe (HashMap TxHash Transaction) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (HashMap TxHash Transaction)
etxs) Transaction
t
        getBinfoTxOutputScript :: ByteString
getBinfoTxOutputScript = ByteString
outputScript
        getBinfoTxOutputSpenders :: [BinfoSpender]
getBinfoTxOutputSpenders =
            Maybe BinfoSpender -> [BinfoSpender]
forall a. Maybe a -> [a]
maybeToList (Maybe BinfoSpender -> [BinfoSpender])
-> Maybe BinfoSpender -> [BinfoSpender]
forall a b. (a -> b) -> a -> b
$ Maybe (HashMap TxHash Transaction) -> Spender -> BinfoSpender
toBinfoSpender Maybe (HashMap TxHash Transaction)
etxs (Spender -> BinfoSpender) -> Maybe Spender -> Maybe BinfoSpender
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Spender
outputSpender
        getBinfoTxOutputAddress :: Maybe Address
getBinfoTxOutputAddress = Maybe Address
outputAddress
        getBinfoTxOutputXPub :: Maybe BinfoXPubPath
getBinfoTxOutputXPub =
            Maybe Address
outputAddress Maybe Address
-> (Address -> Maybe BinfoXPubPath) -> Maybe BinfoXPubPath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Maybe BinfoXPubPath) -> Maybe BinfoXPubPath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe BinfoXPubPath) -> Maybe BinfoXPubPath)
-> (Address -> Maybe (Maybe BinfoXPubPath))
-> Address
-> Maybe BinfoXPubPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address
-> HashMap Address (Maybe BinfoXPubPath)
-> Maybe (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap Address (Maybe BinfoXPubPath)
abook)
     in if Bool
prune Bool -> Bool -> Bool
&& Maybe (Maybe BinfoXPubPath) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Address
outputAddress Maybe Address
-> (Address -> Maybe (Maybe BinfoXPubPath))
-> Maybe (Maybe BinfoXPubPath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Address
-> HashMap Address (Maybe BinfoXPubPath)
-> Maybe (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap Address (Maybe BinfoXPubPath)
abook))
        then Maybe BinfoTxOutput
forall a. Maybe a
Nothing
        else BinfoTxOutput -> Maybe BinfoTxOutput
forall a. a -> Maybe a
Just $WBinfoTxOutput :: Int
-> Bool
-> Word64
-> Fingerprint
-> BinfoTxId
-> ByteString
-> [BinfoSpender]
-> Maybe Address
-> Maybe BinfoXPubPath
-> BinfoTxOutput
BinfoTxOutput{..}

toBinfoSpender :: Maybe (HashMap TxHash Transaction)
               -> Spender
               -> BinfoSpender
toBinfoSpender :: Maybe (HashMap TxHash Transaction) -> Spender -> BinfoSpender
toBinfoSpender etxs :: Maybe (HashMap TxHash Transaction)
etxs Spender{..} =
    let getBinfoSpenderTxIndex :: BinfoTxId
getBinfoSpenderTxIndex = Maybe (HashMap TxHash Transaction) -> TxHash -> BinfoTxId
getBinfoTxId Maybe (HashMap TxHash Transaction)
etxs TxHash
spenderHash
        getBinfoSpenderIndex :: Fingerprint
getBinfoSpenderIndex = Fingerprint
spenderIndex
     in $WBinfoSpender :: BinfoTxId -> Fingerprint -> BinfoSpender
BinfoSpender{..}

inputToBinfoTxOutput :: Maybe (HashMap TxHash Transaction)
                     -> HashMap Address (Maybe BinfoXPubPath)
                     -> Transaction
                     -> Word32
                     -> StoreInput
                     -> Maybe BinfoTxOutput
inputToBinfoTxOutput :: Maybe (HashMap TxHash Transaction)
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> Fingerprint
-> StoreInput
-> Maybe BinfoTxOutput
inputToBinfoTxOutput _ _ _ _ StoreCoinbase{} = Maybe BinfoTxOutput
forall a. Maybe a
Nothing
inputToBinfoTxOutput etxs :: Maybe (HashMap TxHash Transaction)
etxs abook :: HashMap Address (Maybe BinfoXPubPath)
abook t :: Transaction
t n :: Fingerprint
n StoreInput{..} =
    BinfoTxOutput -> Maybe BinfoTxOutput
forall a. a -> Maybe a
Just $WBinfoTxOutput :: Int
-> Bool
-> Word64
-> Fingerprint
-> BinfoTxId
-> ByteString
-> [BinfoSpender]
-> Maybe Address
-> Maybe BinfoXPubPath
-> BinfoTxOutput
BinfoTxOutput{ getBinfoTxOutputIndex :: Fingerprint
getBinfoTxOutputIndex = Fingerprint
out_index
                      , getBinfoTxOutputType :: Int
getBinfoTxOutputType = 0
                      , getBinfoTxOutputSpent :: Bool
getBinfoTxOutputSpent = Bool
True
                      , getBinfoTxOutputValue :: Word64
getBinfoTxOutputValue = Word64
inputAmount
                      , getBinfoTxOutputTxIndex :: BinfoTxId
getBinfoTxOutputTxIndex = Maybe (HashMap TxHash Transaction) -> TxHash -> BinfoTxId
getBinfoTxId Maybe (HashMap TxHash Transaction)
etxs TxHash
out_hash
                      , getBinfoTxOutputScript :: ByteString
getBinfoTxOutputScript = ByteString
inputPkScript
                      , getBinfoTxOutputSpenders :: [BinfoSpender]
getBinfoTxOutputSpenders = [BinfoSpender
spender]
                      , getBinfoTxOutputAddress :: Maybe Address
getBinfoTxOutputAddress = Maybe Address
inputAddress
                      , getBinfoTxOutputXPub :: Maybe BinfoXPubPath
getBinfoTxOutputXPub = Maybe BinfoXPubPath
xpub
                      }
  where
    OutPoint out_hash :: TxHash
out_hash out_index :: Fingerprint
out_index = OutPoint
inputPoint
    spender :: BinfoSpender
spender = BinfoTxId -> Fingerprint -> BinfoSpender
BinfoSpender (Bool -> Transaction -> BinfoTxId
binfoTransactionIndex (Maybe (HashMap TxHash Transaction) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (HashMap TxHash Transaction)
etxs) Transaction
t) Fingerprint
n
    xpub :: Maybe BinfoXPubPath
xpub = Maybe Address
inputAddress Maybe Address
-> (Address -> Maybe BinfoXPubPath) -> Maybe BinfoXPubPath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Maybe BinfoXPubPath) -> Maybe BinfoXPubPath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe BinfoXPubPath) -> Maybe BinfoXPubPath)
-> (Address -> Maybe (Maybe BinfoXPubPath))
-> Address
-> Maybe BinfoXPubPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address
-> HashMap Address (Maybe BinfoXPubPath)
-> Maybe (Maybe BinfoXPubPath)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap Address (Maybe BinfoXPubPath)
abook)

data BinfoAddr
    = BinfoAddr !Address
    | BinfoXpub !XPubKey
    deriving (BinfoAddr -> BinfoAddr -> Bool
(BinfoAddr -> BinfoAddr -> Bool)
-> (BinfoAddr -> BinfoAddr -> Bool) -> Eq BinfoAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoAddr -> BinfoAddr -> Bool
$c/= :: BinfoAddr -> BinfoAddr -> Bool
== :: BinfoAddr -> BinfoAddr -> Bool
$c== :: BinfoAddr -> BinfoAddr -> Bool
Eq, Int -> BinfoAddr -> ShowS
[BinfoAddr] -> ShowS
BinfoAddr -> String
(Int -> BinfoAddr -> ShowS)
-> (BinfoAddr -> String)
-> ([BinfoAddr] -> ShowS)
-> Show BinfoAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoAddr] -> ShowS
$cshowList :: [BinfoAddr] -> ShowS
show :: BinfoAddr -> String
$cshow :: BinfoAddr -> String
showsPrec :: Int -> BinfoAddr -> ShowS
$cshowsPrec :: Int -> BinfoAddr -> ShowS
Show, (forall x. BinfoAddr -> Rep BinfoAddr x)
-> (forall x. Rep BinfoAddr x -> BinfoAddr) -> Generic BinfoAddr
forall x. Rep BinfoAddr x -> BinfoAddr
forall x. BinfoAddr -> Rep BinfoAddr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoAddr x -> BinfoAddr
$cfrom :: forall x. BinfoAddr -> Rep BinfoAddr x
Generic, Get BinfoAddr
Putter BinfoAddr
Putter BinfoAddr -> Get BinfoAddr -> Serialize BinfoAddr
forall t. Putter t -> Get t -> Serialize t
get :: Get BinfoAddr
$cget :: Get BinfoAddr
put :: Putter BinfoAddr
$cput :: Putter BinfoAddr
Serialize, Int -> BinfoAddr -> Int
BinfoAddr -> Int
(Int -> BinfoAddr -> Int)
-> (BinfoAddr -> Int) -> Hashable BinfoAddr
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BinfoAddr -> Int
$chash :: BinfoAddr -> Int
hashWithSalt :: Int -> BinfoAddr -> Int
$chashWithSalt :: Int -> BinfoAddr -> Int
Hashable, BinfoAddr -> ()
(BinfoAddr -> ()) -> NFData BinfoAddr
forall a. (a -> ()) -> NFData a
rnf :: BinfoAddr -> ()
$crnf :: BinfoAddr -> ()
NFData)

parseBinfoAddr :: Network -> Text -> Maybe [BinfoAddr]
parseBinfoAddr :: Network -> Text -> Maybe [BinfoAddr]
parseBinfoAddr _ "" = [BinfoAddr] -> Maybe [BinfoAddr]
forall a. a -> Maybe a
Just []
parseBinfoAddr net :: Network
net s :: Text
s =
    (Text -> Maybe BinfoAddr) -> [Text] -> Maybe [BinfoAddr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Maybe BinfoAddr
f ([Text] -> Maybe [BinfoAddr]) -> [Text] -> Maybe [BinfoAddr]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn "|" Text
s
  where
    f :: Text -> Maybe BinfoAddr
f x :: Text
x = Address -> BinfoAddr
BinfoAddr (Address -> BinfoAddr) -> Maybe Address -> Maybe BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Text -> Maybe Address
textToAddr Network
net Text
x Maybe BinfoAddr -> Maybe BinfoAddr -> Maybe BinfoAddr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XPubKey -> BinfoAddr
BinfoXpub (XPubKey -> BinfoAddr) -> Maybe XPubKey -> Maybe BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Text -> Maybe XPubKey
xPubImport Network
net Text
x