{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoFieldSelectors #-}

module Haskoin.Store.Data
  ( -- * Address Balances
    Balance (..),
    zeroBalance,
    nullBalance,

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

    -- * Transactions
    TxRef (..),
    TxData (..),
    txDataFee,
    isCoinbaseTx,
    Transaction (..),
    transactionData,
    fromTransaction,
    toTransaction,
    StoreInput (..),
    isCoinbase,
    StoreOutput (..),
    Prev (..),
    Spender (..),
    BlockRef (..),
    UnixTime,
    getUnixTime,
    putUnixTime,
    BlockPos,

    -- * Unspent Outputs
    Unspent (..),

    -- * Extended Public Keys
    XPubSpec (..),
    XPubBal (..),
    XPubUnspent (..),
    XPubSummary (..),
    DeriveType (..),
    textToDeriveType,
    deriveTypeToText,

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

    -- * Blockchain.info API
    BinfoInfo (..),
    BinfoBlockId (..),
    BinfoTxId (..),
    encodeBinfoTxId,
    BinfoFilter (..),
    BinfoMultiAddr (..),
    BinfoShortBal (..),
    BinfoBalance (..),
    toBinfoAddrs,
    BinfoRawAddr (..),
    BinfoAddr (..),
    parseBinfoAddr,
    BinfoWallet (..),
    BinfoUnspent (..),
    binfoHexValue,
    BinfoUnspents (..),
    BinfoBlock (..),
    toBinfoBlock,
    BinfoTx (..),
    relevantTxs,
    toBinfoTx,
    toBinfoTxSimple,
    BinfoTxInput (..),
    BinfoTxOutput (..),
    BinfoSpender (..),
    BinfoXPubPath (..),
    BinfoBlockInfo (..),
    toBinfoBlockInfo,
    BinfoSymbol (..),
    BinfoTicker (..),
    BinfoRate (..),
    BinfoHistory (..),
    toBinfoHistory,
    BinfoDate (..),
    BinfoHeader (..),
    BinfoMempool (..),
    BinfoBlockInfos (..),
  )
where

import Control.Applicative (optional, (<|>))
import Control.DeepSeq (NFData)
import Control.Exception (Exception)
import Control.Monad (guard, join, mzero, unless, (<=<))
import Data.Aeson
  ( Encoding,
    FromJSON (..),
    ToJSON (..),
    Value (..),
    (.!=),
    (.:),
    (.:?),
    (.=),
  )
import Data.Aeson qualified as A
import Data.Aeson.Encoding qualified as A
import Data.Aeson.Types (Parser)
import Data.Binary (Binary (get, put))
import Data.Bits (Bits (..))
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Builder qualified as Builder
import Data.Bytes.Get
import Data.Bytes.Get qualified as Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Default (Default (..))
import Data.Foldable (toList)
import Data.Function (on)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.Hashable (Hashable (..))
import Data.Int (Int32, Int64)
import Data.IntMap qualified as IntMap
import Data.IntMap.Strict (IntMap)
import Data.Maybe
  ( catMaybes,
    fromMaybe,
    isJust,
    isNothing,
    mapMaybe,
    maybeToList,
  )
import Data.Serialize (Serialize (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as LazyText
import Data.Text.Lazy.Encoding qualified as LazyText
import Data.Time (UTCTime (UTCTime), rfc822DateFormat)
import Data.Time.Clock.POSIX
  ( posixSecondsToUTCTime,
    utcTimeToPOSIXSeconds,
  )
import Data.Time.Format
  ( defaultTimeLocale,
    formatTime,
    parseTimeM,
  )
import Data.Time.Format.ISO8601
  ( iso8601ParseM,
    iso8601Show,
  )
import Data.Vector qualified as V
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Haskoin
import Web.Scotty.Trans (Parsable (..), 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
$cshowsPrec :: Int -> DeriveType -> ShowS
showsPrec :: Int -> DeriveType -> ShowS
$cshow :: DeriveType -> String
show :: DeriveType -> String
$cshowList :: [DeriveType] -> ShowS
showList :: [DeriveType] -> ShowS
Show, DeriveType -> DeriveType -> Bool
(DeriveType -> DeriveType -> Bool)
-> (DeriveType -> DeriveType -> Bool) -> Eq DeriveType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeriveType -> DeriveType -> Bool
== :: DeriveType -> DeriveType -> Bool
$c/= :: DeriveType -> DeriveType -> Bool
/= :: 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
$cfrom :: forall x. DeriveType -> Rep DeriveType x
from :: forall x. DeriveType -> Rep DeriveType x
$cto :: forall x. Rep DeriveType x -> DeriveType
to :: forall x. Rep DeriveType x -> DeriveType
Generic, DeriveType -> ()
(DeriveType -> ()) -> NFData DeriveType
forall a. (a -> ()) -> NFData a
$crnf :: DeriveType -> ()
rnf :: DeriveType -> ()
NFData)

textToDeriveType :: Text -> Maybe DeriveType
textToDeriveType :: Text -> Maybe DeriveType
textToDeriveType Text
"normal" = DeriveType -> Maybe DeriveType
forall a. a -> Maybe a
Just DeriveType
DeriveNormal
textToDeriveType Text
"compat" = DeriveType -> Maybe DeriveType
forall a. a -> Maybe a
Just DeriveType
DeriveP2SH
textToDeriveType Text
"segwit" = DeriveType -> Maybe DeriveType
forall a. a -> Maybe a
Just DeriveType
DeriveP2WPKH
textToDeriveType Text
_ = Maybe DeriveType
forall a. Maybe a
Nothing

deriveTypeToText :: DeriveType -> Text
deriveTypeToText :: DeriveType -> Text
deriveTypeToText DeriveType
DeriveNormal = Text
"normal"
deriveTypeToText DeriveType
DeriveP2SH = Text
"compat"
deriveTypeToText DeriveType
DeriveP2WPKH = Text
"segwit"

instance Serial DeriveType where
  serialize :: forall (m :: * -> *). MonadPut m => DeriveType -> m ()
serialize DeriveType
DeriveNormal = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00
  serialize DeriveType
DeriveP2SH = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01
  serialize DeriveType
DeriveP2WPKH = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x02

  deserialize :: forall (m :: * -> *). MonadGet m => m DeriveType
deserialize =
    m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m DeriveType) -> m DeriveType
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0x00 -> DeriveType -> m DeriveType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
DeriveNormal
      Word8
0x01 -> DeriveType -> m DeriveType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
DeriveP2SH
      Word8
0x02 -> DeriveType -> m DeriveType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
DeriveP2WPKH
      Word8
_ -> DeriveType -> m DeriveType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DeriveType
DeriveNormal

instance Binary DeriveType where
  put :: DeriveType -> Put
put = DeriveType -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => DeriveType -> m ()
serialize
  get :: Get DeriveType
get = Get DeriveType
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m DeriveType
deserialize

instance Serialize DeriveType where
  put :: Putter DeriveType
put = Putter DeriveType
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => DeriveType -> m ()
serialize
  get :: Get DeriveType
get = Get DeriveType
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m DeriveType
deserialize

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

instance Parsable DeriveType where
  parseParam :: Text -> Either Text DeriveType
parseParam Text
txt =
    case Text -> Maybe DeriveType
textToDeriveType (Text -> Text
LazyText.toStrict Text
txt) of
      Maybe DeriveType
Nothing -> Text -> Either Text DeriveType
forall a b. a -> Either a b
Left Text
"invalid derivation type"
      Just DeriveType
x -> DeriveType -> Either Text DeriveType
forall a b. b -> Either a b
Right DeriveType
x

data XPubSpec = XPubSpec
  { XPubSpec -> XPubKey
key :: !XPubKey,
    XPubSpec -> DeriveType
deriv :: !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
$cshowsPrec :: Int -> XPubSpec -> ShowS
showsPrec :: Int -> XPubSpec -> ShowS
$cshow :: XPubSpec -> String
show :: XPubSpec -> String
$cshowList :: [XPubSpec] -> ShowS
showList :: [XPubSpec] -> ShowS
Show, XPubSpec -> XPubSpec -> Bool
(XPubSpec -> XPubSpec -> Bool)
-> (XPubSpec -> XPubSpec -> Bool) -> Eq XPubSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPubSpec -> XPubSpec -> Bool
== :: XPubSpec -> XPubSpec -> Bool
$c/= :: XPubSpec -> XPubSpec -> Bool
/= :: 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
$cfrom :: forall x. XPubSpec -> Rep XPubSpec x
from :: forall x. XPubSpec -> Rep XPubSpec x
$cto :: forall x. Rep XPubSpec x -> XPubSpec
to :: forall x. Rep XPubSpec x -> XPubSpec
Generic, XPubSpec -> ()
(XPubSpec -> ()) -> NFData XPubSpec
forall a. (a -> ()) -> NFData a
$crnf :: XPubSpec -> ()
rnf :: XPubSpec -> ()
NFData)

instance Hashable XPubSpec where
  hashWithSalt :: Int -> XPubSpec -> Int
hashWithSalt Int
i = Int -> PubKey -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
i (PubKey -> Int) -> (XPubSpec -> PubKey) -> XPubSpec -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.key.key)

instance Serial XPubSpec where
  serialize :: forall (m :: * -> *). MonadPut m => XPubSpec -> m ()
serialize XPubSpec {$sel:key:XPubSpec :: XPubSpec -> XPubKey
key = XPubKey
k, $sel:deriv:XPubSpec :: XPubSpec -> DeriveType
deriv = DeriveType
t} = do
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 XPubKey
k.depth
    Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize XPubKey
k.parent
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be XPubKey
k.index
    Hash256 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize XPubKey
k.chain
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString XPubKey
k.key.get
    DeriveType -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => DeriveType -> m ()
serialize DeriveType
t
  deserialize :: forall (m :: * -> *). MonadGet m => m XPubSpec
deserialize = do
    Word8
depth <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    Fingerprint
parent <- m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize
    BlockHeight
index <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Hash256
chain <- m Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize
    PubKey
key <- WitnessStackItem -> PubKey
PubKey (WitnessStackItem -> PubKey) -> m WitnessStackItem -> m PubKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m WitnessStackItem
forall (m :: * -> *). MonadGet m => Int -> m WitnessStackItem
getByteString Int
64
    DeriveType
deriv <- m DeriveType
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m DeriveType
deserialize
    XPubSpec -> m XPubSpec
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubSpec {$sel:key:XPubSpec :: XPubKey
key = XPubKey {Word8
BlockHeight
Fingerprint
Hash256
PubKey
depth :: Word8
parent :: Fingerprint
index :: BlockHeight
chain :: Hash256
key :: PubKey
$sel:depth:XPubKey :: Word8
$sel:parent:XPubKey :: Fingerprint
$sel:index:XPubKey :: BlockHeight
$sel:chain:XPubKey :: Hash256
$sel:key:XPubKey :: PubKey
..}, DeriveType
$sel:deriv:XPubSpec :: DeriveType
deriv :: DeriveType
deriv}

instance Serialize XPubSpec where
  put :: Putter XPubSpec
put = Putter XPubSpec
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubSpec -> m ()
serialize
  get :: Get XPubSpec
get = Get XPubSpec
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubSpec
deserialize

instance Binary XPubSpec where
  put :: XPubSpec -> Put
put = XPubSpec -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubSpec -> m ()
serialize
  get :: Get XPubSpec
get = Get XPubSpec
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubSpec
deserialize

type UnixTime = Word64

type BlockPos = Word32

-- | Binary such that ordering is inverted.
putUnixTime :: (MonadPut m) => Word64 -> m ()
putUnixTime :: forall (m :: * -> *). MonadPut m => Word64 -> m ()
putUnixTime Word64
w = Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Word64 -> m ()) -> Word64 -> m ()
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 :: (MonadGet m) => m Word64
getUnixTime :: forall (m :: * -> *). MonadGet m => m Word64
getUnixTime = (Word64
forall a. Bounded a => a
maxBound Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-) (Word64 -> Word64) -> m Word64 -> m Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be

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

-- | Serial entities will sort in reverse order.
instance Serial BlockRef where
  serialize :: forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize MemRef {$sel:timestamp:BlockRef :: BlockRef -> Word64
timestamp = Word64
t} = do
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putUnixTime Word64
t
  serialize BlockRef {$sel:height:BlockRef :: BlockRef -> BlockHeight
height = BlockHeight
h, $sel:position:BlockRef :: BlockRef -> BlockHeight
position = BlockHeight
p} = do
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be (BlockHeight
forall a. Bounded a => a
maxBound BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
- BlockHeight
h)
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be (BlockHeight
forall a. Bounded a => a
maxBound BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
- BlockHeight
p)
  deserialize :: forall (m :: * -> *). MonadGet m => m BlockRef
deserialize =
    m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m BlockRef) -> m BlockRef
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0x00 -> m BlockRef
getmemref
      Word8
0x01 -> m BlockRef
getblockref
      Word8
_ -> String -> m BlockRef
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot decode BlockRef"
    where
      getmemref :: m BlockRef
getmemref = do
        Word64 -> BlockRef
MemRef (Word64 -> BlockRef) -> m Word64 -> m BlockRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getUnixTime
      getblockref :: m BlockRef
getblockref = do
        BlockHeight
h <- (BlockHeight
forall a. Bounded a => a
maxBound BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
-) (BlockHeight -> BlockHeight) -> m BlockHeight -> m BlockHeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
        BlockHeight
p <- (BlockHeight
forall a. Bounded a => a
maxBound BlockHeight -> BlockHeight -> BlockHeight
forall a. Num a => a -> a -> a
-) (BlockHeight -> BlockHeight) -> m BlockHeight -> m BlockHeight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
        BlockRef -> m BlockRef
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockRef {$sel:height:BlockRef :: BlockHeight
height = BlockHeight
h, $sel:position:BlockRef :: BlockHeight
position = BlockHeight
p}

instance Serialize BlockRef where
  put :: Putter BlockRef
put = Putter BlockRef
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize
  get :: Get BlockRef
get = Get BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockRef
deserialize

instance Binary BlockRef where
  put :: BlockRef -> Put
put = BlockRef -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize
  get :: Get BlockRef
get = Get BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockRef
deserialize

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

instance ToJSON BlockRef where
  toJSON :: BlockRef -> Value
toJSON BlockRef {$sel:height:BlockRef :: BlockRef -> BlockHeight
height = BlockHeight
h, $sel:position:BlockRef :: BlockRef -> BlockHeight
position = BlockHeight
p} =
    [Pair] -> Value
A.object
      [ Key
"height" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHeight
h,
        Key
"position" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHeight
p
      ]
  toJSON MemRef {$sel:timestamp:BlockRef :: BlockRef -> Word64
timestamp = Word64
t} =
    [Pair] -> Value
A.object [Key
"mempool" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Word64
t]
  toEncoding :: BlockRef -> Encoding
toEncoding BlockRef {$sel:height:BlockRef :: BlockRef -> BlockHeight
height = BlockHeight
h, $sel:position:BlockRef :: BlockRef -> BlockHeight
position = BlockHeight
p} =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"height" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockHeight
h,
          Key
"position" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockHeight
p
        ]
  toEncoding MemRef {$sel:timestamp:BlockRef :: BlockRef -> Word64
timestamp = Word64
t} =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"mempool" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 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 String
"BlockRef" ((Object -> Parser BlockRef) -> Value -> Parser BlockRef)
-> (Object -> Parser BlockRef) -> Value -> Parser BlockRef
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object -> Parser BlockRef
b Object
o Parser BlockRef -> Parser BlockRef -> Parser BlockRef
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser BlockRef
m Object
o
    where
      b :: Object -> Parser BlockRef
b Object
o = do
        BlockHeight
height <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
        BlockHeight
position <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
        BlockRef -> Parser BlockRef
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockRef {BlockHeight
$sel:height:BlockRef :: BlockHeight
$sel:position:BlockRef :: BlockHeight
height :: BlockHeight
position :: BlockHeight
..}
      m :: Object -> Parser BlockRef
m Object
o =
        Word64 -> BlockRef
MemRef (Word64 -> BlockRef) -> Parser Word64 -> Parser BlockRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mempool"

-- | Transaction in relation to an address.
data TxRef = TxRef
  { -- | block information
    TxRef -> BlockRef
block :: !BlockRef,
    -- | transaction hash
    TxRef -> TxHash
txid :: !TxHash
  }
  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
$cshowsPrec :: Int -> TxRef -> ShowS
showsPrec :: Int -> TxRef -> ShowS
$cshow :: TxRef -> String
show :: TxRef -> String
$cshowList :: [TxRef] -> ShowS
showList :: [TxRef] -> ShowS
Show, TxRef -> TxRef -> Bool
(TxRef -> TxRef -> Bool) -> (TxRef -> TxRef -> Bool) -> Eq TxRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxRef -> TxRef -> Bool
== :: TxRef -> TxRef -> Bool
$c/= :: TxRef -> TxRef -> Bool
/= :: 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
$ccompare :: TxRef -> TxRef -> Ordering
compare :: TxRef -> TxRef -> Ordering
$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
>= :: TxRef -> TxRef -> Bool
$cmax :: TxRef -> TxRef -> TxRef
max :: TxRef -> TxRef -> TxRef
$cmin :: TxRef -> TxRef -> TxRef
min :: TxRef -> TxRef -> 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
$cfrom :: forall x. TxRef -> Rep TxRef x
from :: forall x. TxRef -> Rep TxRef x
$cto :: forall x. Rep TxRef x -> TxRef
to :: forall x. Rep TxRef x -> TxRef
Generic, Eq TxRef
Eq TxRef
-> (Int -> TxRef -> Int) -> (TxRef -> Int) -> Hashable TxRef
Int -> TxRef -> Int
TxRef -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TxRef -> Int
hashWithSalt :: Int -> TxRef -> Int
$chash :: TxRef -> Int
hash :: TxRef -> Int
Hashable, TxRef -> ()
(TxRef -> ()) -> NFData TxRef
forall a. (a -> ()) -> NFData a
$crnf :: TxRef -> ()
rnf :: TxRef -> ()
NFData)

instance Serial TxRef where
  serialize :: forall (m :: * -> *). MonadPut m => TxRef -> m ()
serialize (TxRef BlockRef
b TxHash
h) = do
    BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize BlockRef
b
    TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize TxHash
h

  deserialize :: forall (m :: * -> *). MonadGet m => m TxRef
deserialize =
    BlockRef -> TxHash -> TxRef
TxRef (BlockRef -> TxHash -> TxRef) -> m BlockRef -> m (TxHash -> TxRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockRef
deserialize m (TxHash -> TxRef) -> m TxHash -> m TxRef
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxHash
deserialize

instance Binary TxRef where
  put :: TxRef -> Put
put = TxRef -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxRef -> m ()
serialize
  get :: Get TxRef
get = Get TxRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxRef
deserialize

instance Serialize TxRef where
  put :: Putter TxRef
put = Putter TxRef
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxRef -> m ()
serialize
  get :: Get TxRef
get = Get TxRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxRef
deserialize

instance ToJSON TxRef where
  toJSON :: TxRef -> Value
toJSON TxRef
x =
    [Pair] -> Value
A.object
      [ Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TxRef
x.txid,
        Key
"block" Key -> BlockRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TxRef
x.block
      ]
  toEncoding :: TxRef -> Encoding
toEncoding TxRef
btx =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding TxRef
btx.txid,
          Key
"block" Key -> Encoding -> Series
`A.pair` BlockRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding TxRef
btx.block
        ]

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 String
"TxRef" ((Object -> Parser TxRef) -> Value -> Parser TxRef)
-> (Object -> Parser TxRef) -> Value -> Parser TxRef
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      TxHash
txid <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid"
      BlockRef
block <- Object
o Object -> Key -> Parser BlockRef
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block"
      TxRef -> Parser TxRef
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TxRef {TxHash
BlockRef
$sel:block:TxRef :: BlockRef
$sel:txid:TxRef :: TxHash
txid :: TxHash
block :: BlockRef
..}

-- | Address balance information.
data Balance = Balance
  { -- | address balance
    Balance -> Address
address :: !Address,
    -- | confirmed balance
    Balance -> Word64
confirmed :: !Word64,
    -- | unconfirmed balance
    Balance -> Word64
unconfirmed :: !Word64,
    -- | number of unspent outputs
    Balance -> Word64
utxo :: !Word64,
    -- | number of transactions
    Balance -> Word64
txs :: !Word64,
    -- | total amount from all outputs in this address
    Balance -> Word64
received :: !Word64
  }
  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
$cshowsPrec :: Int -> Balance -> ShowS
showsPrec :: Int -> Balance -> ShowS
$cshow :: Balance -> String
show :: Balance -> String
$cshowList :: [Balance] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Balance
readsPrec :: Int -> ReadS Balance
$creadList :: ReadS [Balance]
readList :: ReadS [Balance]
$creadPrec :: ReadPrec Balance
readPrec :: ReadPrec Balance
$creadListPrec :: ReadPrec [Balance]
readListPrec :: ReadPrec [Balance]
Read, Balance -> Balance -> Bool
(Balance -> Balance -> Bool)
-> (Balance -> Balance -> Bool) -> Eq Balance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Balance -> Balance -> Bool
== :: Balance -> Balance -> Bool
$c/= :: Balance -> Balance -> Bool
/= :: 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
$ccompare :: Balance -> Balance -> Ordering
compare :: Balance -> Balance -> Ordering
$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
>= :: Balance -> Balance -> Bool
$cmax :: Balance -> Balance -> Balance
max :: Balance -> Balance -> Balance
$cmin :: Balance -> Balance -> Balance
min :: Balance -> Balance -> 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
$cfrom :: forall x. Balance -> Rep Balance x
from :: forall x. Balance -> Rep Balance x
$cto :: forall x. Rep Balance x -> Balance
to :: forall x. Rep Balance x -> Balance
Generic, Eq Balance
Eq Balance
-> (Int -> Balance -> Int) -> (Balance -> Int) -> Hashable Balance
Int -> Balance -> Int
Balance -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Balance -> Int
hashWithSalt :: Int -> Balance -> Int
$chash :: Balance -> Int
hash :: Balance -> Int
Hashable, Balance -> ()
(Balance -> ()) -> NFData Balance
forall a. (a -> ()) -> NFData a
$crnf :: Balance -> ()
rnf :: Balance -> ()
NFData)

instance Serial Balance where
  serialize :: forall (m :: * -> *). MonadPut m => Balance -> m ()
serialize Balance
b = do
    Address -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Address -> m ()
serialize Balance
b.address
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Balance
b.confirmed
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Balance
b.unconfirmed
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Balance
b.utxo
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Balance
b.txs
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Balance
b.received

  deserialize :: forall (m :: * -> *). MonadGet m => m Balance
deserialize = do
    Address
address <- m Address
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Address
deserialize
    Word64
confirmed <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
unconfirmed <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
utxo <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
txs <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
received <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Balance -> m Balance
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Balance {Word64
Address
$sel:address:Balance :: Address
$sel:confirmed:Balance :: Word64
$sel:unconfirmed:Balance :: Word64
$sel:utxo:Balance :: Word64
$sel:txs:Balance :: Word64
$sel:received:Balance :: Word64
address :: Address
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
..}

instance Binary Balance where
  put :: Balance -> Put
put = Balance -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Balance -> m ()
serialize
  get :: Get Balance
get = Get Balance
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Balance
deserialize

instance Serialize Balance where
  put :: Putter Balance
put = Putter Balance
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Balance -> m ()
serialize
  get :: Get Balance
get = Get Balance
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Balance
deserialize

zeroBalance :: Address -> Balance
zeroBalance :: Address -> Balance
zeroBalance Address
a =
  Balance
    { $sel:address:Balance :: Address
address = Address
a,
      $sel:confirmed:Balance :: Word64
confirmed = Word64
0,
      $sel:unconfirmed:Balance :: Word64
unconfirmed = Word64
0,
      $sel:utxo:Balance :: Word64
utxo = Word64
0,
      $sel:txs:Balance :: Word64
txs = Word64
0,
      $sel:received:Balance :: Word64
received = Word64
0
    }

nullBalance :: Balance -> Bool
nullBalance :: Balance -> Bool
nullBalance
  Balance
    { $sel:confirmed:Balance :: Balance -> Word64
confirmed = Word64
0,
      $sel:unconfirmed:Balance :: Balance -> Word64
unconfirmed = Word64
0,
      $sel:utxo:Balance :: Balance -> Word64
utxo = Word64
0,
      $sel:txs:Balance :: Balance -> Word64
txs = Word64
0,
      $sel:received:Balance :: Balance -> Word64
received = Word64
0
    } = Bool
True
nullBalance Balance
_ = Bool
False

instance MarshalJSON Network Balance where
  marshalValue :: Network -> Balance -> Value
marshalValue Network
net Balance
b =
    [Pair] -> Value
A.object
      [ Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net Balance
b.address,
        Key
"confirmed" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Balance
b.confirmed,
        Key
"unconfirmed" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Balance
b.unconfirmed,
        Key
"utxo" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Balance
b.utxo,
        Key
"txs" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Balance
b.txs,
        Key
"received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Balance
b.received
      ]

  marshalEncoding :: Network -> Balance -> Encoding
marshalEncoding Network
net Balance
b =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"address" Key -> Encoding -> Series
`A.pair` Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net Balance
b.address,
          Key
"confirmed" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Balance
b.confirmed,
          Key
"unconfirmed" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Balance
b.unconfirmed,
          Key
"utxo" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Balance
b.utxo,
          Key
"txs" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Balance
b.txs,
          Key
"received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Balance
b.received
        ]

  unmarshalValue :: Network -> Value -> Parser Balance
unmarshalValue Network
net =
    String -> (Object -> Parser Balance) -> Value -> Parser Balance
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Balance" ((Object -> Parser Balance) -> Value -> Parser Balance)
-> (Object -> Parser Balance) -> Value -> Parser Balance
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Word64
confirmed <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confirmed"
      Word64
unconfirmed <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unconfirmed"
      Word64
utxo <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"utxo"
      Word64
txs <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txs"
      Word64
received <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"received"
      Address
address <- Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue 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 -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
      Balance -> Parser Balance
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Balance {Word64
Address
$sel:address:Balance :: Address
$sel:confirmed:Balance :: Word64
$sel:unconfirmed:Balance :: Word64
$sel:utxo:Balance :: Word64
$sel:txs:Balance :: Word64
$sel:received:Balance :: Word64
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
address :: Address
..}

-- | Unspent output.
data Unspent = Unspent
  { Unspent -> BlockRef
block :: !BlockRef,
    Unspent -> OutPoint
outpoint :: !OutPoint,
    Unspent -> Word64
value :: !Word64,
    Unspent -> WitnessStackItem
script :: !ByteString,
    Unspent -> Maybe Address
address :: !(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
$cshowsPrec :: Int -> Unspent -> ShowS
showsPrec :: Int -> Unspent -> ShowS
$cshow :: Unspent -> String
show :: Unspent -> String
$cshowList :: [Unspent] -> ShowS
showList :: [Unspent] -> ShowS
Show, Unspent -> Unspent -> Bool
(Unspent -> Unspent -> Bool)
-> (Unspent -> Unspent -> Bool) -> Eq Unspent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unspent -> Unspent -> Bool
== :: Unspent -> Unspent -> Bool
$c/= :: Unspent -> Unspent -> Bool
/= :: Unspent -> Unspent -> Bool
Eq, (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
$cfrom :: forall x. Unspent -> Rep Unspent x
from :: forall x. Unspent -> Rep Unspent x
$cto :: forall x. Rep Unspent x -> Unspent
to :: forall x. Rep Unspent x -> Unspent
Generic, Eq Unspent
Eq Unspent
-> (Int -> Unspent -> Int) -> (Unspent -> Int) -> Hashable Unspent
Int -> Unspent -> Int
Unspent -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Unspent -> Int
hashWithSalt :: Int -> Unspent -> Int
$chash :: Unspent -> Int
hash :: Unspent -> Int
Hashable, Unspent -> ()
(Unspent -> ()) -> NFData Unspent
forall a. (a -> ()) -> NFData a
$crnf :: Unspent -> ()
rnf :: Unspent -> ()
NFData)

-- | Follow same order as in database and cache by inverting outpoint sort
-- order.
instance Ord Unspent where
  compare :: Unspent -> Unspent -> Ordering
compare Unspent
a Unspent
b =
    (BlockRef, BlockRef) -> (BlockRef, BlockRef) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
      (Unspent
a.block, Unspent
b.block)
      (Unspent
b.block, Unspent
a.block)

instance Serial Unspent where
  serialize :: forall (m :: * -> *). MonadPut m => Unspent -> m ()
serialize Unspent
u = do
    BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize Unspent
u.block
    OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => OutPoint -> m ()
serialize Unspent
u.outpoint
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Unspent
u.value
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes Unspent
u.script
    (Address -> m ()) -> Maybe Address -> m ()
forall (m :: * -> *) a.
MonadPut m =>
(a -> m ()) -> Maybe a -> m ()
putMaybe Address -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Address -> m ()
serialize Unspent
u.address

  deserialize :: forall (m :: * -> *). MonadGet m => m Unspent
deserialize = do
    BlockRef
block <- m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockRef
deserialize
    OutPoint
outpoint <- m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m OutPoint
deserialize
    Word64
value <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    WitnessStackItem
script <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    Maybe Address
address <- m Address -> m (Maybe Address)
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe m Address
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Address
deserialize
    Unspent -> m Unspent
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Unspent {Maybe Address
Word64
WitnessStackItem
OutPoint
BlockRef
$sel:block:Unspent :: BlockRef
$sel:outpoint:Unspent :: OutPoint
$sel:value:Unspent :: Word64
$sel:script:Unspent :: WitnessStackItem
$sel:address:Unspent :: Maybe Address
block :: BlockRef
outpoint :: OutPoint
value :: Word64
script :: WitnessStackItem
address :: Maybe Address
..}

instance Binary Unspent where
  put :: Unspent -> Put
put = Unspent -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Unspent -> m ()
serialize
  get :: Get Unspent
get = Get Unspent
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Unspent
deserialize

instance Serialize Unspent where
  put :: Putter Unspent
put = Putter Unspent
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Unspent -> m ()
serialize
  get :: Get Unspent
get = Get Unspent
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Unspent
deserialize

instance Coin Unspent where
  coinValue :: Unspent -> Word64
coinValue = (.value)

instance MarshalJSON Network Unspent where
  marshalValue :: Network -> Unspent -> Value
marshalValue Network
net Unspent
u =
    [Pair] -> Value
A.object
      [ Key
"address" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Address -> Value) -> Maybe Address -> Maybe Value
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net) Unspent
u.address,
        Key
"block" Key -> BlockRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Unspent
u.block,
        Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Unspent
u.outpoint.hash,
        Key
"index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Unspent
u.outpoint.index,
        Key
"pkscript" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex Unspent
u.script,
        Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Unspent
u.value
      ]

  marshalEncoding :: Network -> Unspent -> Encoding
marshalEncoding Network
net Unspent
u =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"address" Key -> Encoding -> Series
`A.pair` Encoding -> (Address -> Encoding) -> Maybe Address -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
A.null_ (Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net) Unspent
u.address,
          Key
"block" Key -> Encoding -> Series
`A.pair` BlockRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Unspent
u.block,
          Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Unspent
u.outpoint.hash,
          Key
"index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 Unspent
u.outpoint.index,
          Key
"pkscript" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict Unspent
u.script),
          Key
"value" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Unspent
u.value
        ]

  unmarshalValue :: Network -> Value -> Parser Unspent
unmarshalValue Network
net =
    String -> (Object -> Parser Unspent) -> Value -> Parser Unspent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Unspent" ((Object -> Parser Unspent) -> Value -> Parser Unspent)
-> (Object -> Parser Unspent) -> Value -> Parser Unspent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockRef
block <- Object
o Object -> Key -> Parser BlockRef
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block"
      TxHash
hash <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
      Word64
value <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      WitnessStackItem
script <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pkscript" Parser Text
-> (Text -> Parser WitnessStackItem) -> Parser WitnessStackItem
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser WitnessStackItem
jsonHex
      Maybe Address
address <-
        Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
          Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe Address)
-> (Value -> Parser (Maybe Address))
-> Maybe Value
-> Parser (Maybe Address)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Address -> Parser (Maybe Address)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing) (Parser Address -> Parser (Maybe Address)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Address -> Parser (Maybe Address))
-> (Value -> Parser Address) -> Value -> Parser (Maybe Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net)
      Unspent -> Parser Unspent
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Unspent {$sel:outpoint:Unspent :: OutPoint
outpoint = OutPoint {BlockHeight
TxHash
hash :: TxHash
index :: BlockHeight
$sel:hash:OutPoint :: TxHash
$sel:index:OutPoint :: BlockHeight
..}, Maybe Address
Word64
WitnessStackItem
BlockRef
$sel:block:Unspent :: BlockRef
$sel:value:Unspent :: Word64
$sel:script:Unspent :: WitnessStackItem
$sel:address:Unspent :: Maybe Address
block :: BlockRef
value :: Word64
script :: WitnessStackItem
address :: Maybe Address
..}

-- | Database value for a block entry.
data BlockData = BlockData
  { -- | height of the block in the chain
    BlockData -> BlockHeight
height :: !BlockHeight,
    -- | is this block in the main chain?
    BlockData -> Bool
main :: !Bool,
    -- | accumulated work in that block
    BlockData -> Integer
work :: !Integer,
    -- | block header
    BlockData -> BlockHeader
header :: !BlockHeader,
    -- | size of the block including witnesses
    BlockData -> BlockHeight
size :: !Word32,
    -- | weight of this block (for segwit networks)
    BlockData -> BlockHeight
weight :: !Word32,
    -- | block transactions
    BlockData -> [TxHash]
txs :: ![TxHash],
    -- | sum of all transaction outputs
    BlockData -> Word64
outputs :: !Word64,
    -- | sum of all transaction fee
    BlockData -> Word64
fee :: !Word64,
    -- | block subsidy
    BlockData -> Word64
subsidy :: !Word64
  }
  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
$cshowsPrec :: Int -> BlockData -> ShowS
showsPrec :: Int -> BlockData -> ShowS
$cshow :: BlockData -> String
show :: BlockData -> String
$cshowList :: [BlockData] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS BlockData
readsPrec :: Int -> ReadS BlockData
$creadList :: ReadS [BlockData]
readList :: ReadS [BlockData]
$creadPrec :: ReadPrec BlockData
readPrec :: ReadPrec BlockData
$creadListPrec :: ReadPrec [BlockData]
readListPrec :: ReadPrec [BlockData]
Read, BlockData -> BlockData -> Bool
(BlockData -> BlockData -> Bool)
-> (BlockData -> BlockData -> Bool) -> Eq BlockData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockData -> BlockData -> Bool
== :: BlockData -> BlockData -> Bool
$c/= :: BlockData -> BlockData -> Bool
/= :: 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
$ccompare :: BlockData -> BlockData -> Ordering
compare :: BlockData -> BlockData -> Ordering
$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
>= :: BlockData -> BlockData -> Bool
$cmax :: BlockData -> BlockData -> BlockData
max :: BlockData -> BlockData -> BlockData
$cmin :: BlockData -> BlockData -> BlockData
min :: BlockData -> BlockData -> 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
$cfrom :: forall x. BlockData -> Rep BlockData x
from :: forall x. BlockData -> Rep BlockData x
$cto :: forall x. Rep BlockData x -> BlockData
to :: forall x. Rep BlockData x -> BlockData
Generic, Eq BlockData
Eq BlockData
-> (Int -> BlockData -> Int)
-> (BlockData -> Int)
-> Hashable BlockData
Int -> BlockData -> Int
BlockData -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BlockData -> Int
hashWithSalt :: Int -> BlockData -> Int
$chash :: BlockData -> Int
hash :: BlockData -> Int
Hashable, BlockData -> ()
(BlockData -> ()) -> NFData BlockData
forall a. (a -> ()) -> NFData a
$crnf :: BlockData -> ()
rnf :: BlockData -> ()
NFData)

instance Serial BlockData where
  serialize :: forall (m :: * -> *). MonadPut m => BlockData -> m ()
serialize BlockData
b = do
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be BlockData
b.height
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize BlockData
b.main
    Integer -> m ()
forall (m :: * -> *). MonadPut m => Integer -> m ()
putInteger BlockData
b.work
    BlockHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHeader -> m ()
serialize BlockData
b.header
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be BlockData
b.size
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be BlockData
b.weight
    (TxHash -> m ()) -> [TxHash] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize BlockData
b.txs
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be BlockData
b.outputs
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be BlockData
b.fee
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be BlockData
b.subsidy

  deserialize :: forall (m :: * -> *). MonadGet m => m BlockData
deserialize = do
    BlockHeight
height <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Bool
main <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Integer
work <- m Integer
forall (m :: * -> *). MonadGet m => m Integer
getInteger
    BlockHeader
header <- m BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHeader
deserialize
    BlockHeight
size <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    BlockHeight
weight <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    [TxHash]
txs <- m TxHash -> m [TxHash]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxHash
deserialize
    Word64
outputs <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
fee <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
subsidy <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    BlockData -> m BlockData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData {Bool
Integer
[TxHash]
BlockHeight
Word64
BlockHeader
$sel:height:BlockData :: BlockHeight
$sel:main:BlockData :: Bool
$sel:work:BlockData :: Integer
$sel:header:BlockData :: BlockHeader
$sel:size:BlockData :: BlockHeight
$sel:weight:BlockData :: BlockHeight
$sel:txs:BlockData :: [TxHash]
$sel:outputs:BlockData :: Word64
$sel:fee:BlockData :: Word64
$sel:subsidy:BlockData :: Word64
height :: BlockHeight
main :: Bool
work :: Integer
header :: BlockHeader
size :: BlockHeight
weight :: BlockHeight
txs :: [TxHash]
outputs :: Word64
fee :: Word64
subsidy :: Word64
..}

instance Serialize BlockData where
  put :: Putter BlockData
put = Putter BlockData
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockData -> m ()
serialize
  get :: Get BlockData
get = Get BlockData
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockData
deserialize

instance Binary BlockData where
  put :: BlockData -> Put
put = BlockData -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockData -> m ()
serialize
  get :: Get BlockData
get = Get BlockData
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockData
deserialize

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 String
"BlockData" ((Object -> Parser BlockData) -> Value -> Parser BlockData)
-> (Object -> Parser BlockData) -> Value -> Parser BlockData
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHeight
height <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
      Bool
main <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mainchain"
      BlockHash
prev <- Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"previous"
      BlockHeight
timestamp <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      BlockHeight
version <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
      BlockHeight
bits <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bits"
      BlockHeight
nonce <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nonce"
      BlockHeight
size <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
      [TxHash]
txs <- Object
o Object -> Key -> Parser [TxHash]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx"
      TxHash Hash256
merkle <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"merkle"
      Word64
subsidy <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subsidy"
      Word64
fee <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fees"
      Word64
outputs <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs"
      Integer
work <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"work"
      BlockHeight
weight <- Object
o Object -> Key -> Parser (Maybe BlockHeight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"weight" Parser (Maybe BlockHeight) -> BlockHeight -> Parser BlockHeight
forall a. Parser (Maybe a) -> a -> Parser a
.!= BlockHeight
0
      BlockData -> Parser BlockData
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData {$sel:header:BlockData :: BlockHeader
header = BlockHeader {BlockHeight
Hash256
BlockHash
prev :: BlockHash
timestamp :: BlockHeight
version :: BlockHeight
bits :: BlockHeight
nonce :: BlockHeight
merkle :: Hash256
$sel:version:BlockHeader :: BlockHeight
$sel:prev:BlockHeader :: BlockHash
$sel:merkle:BlockHeader :: Hash256
$sel:timestamp:BlockHeader :: BlockHeight
$sel:bits:BlockHeader :: BlockHeight
$sel:nonce:BlockHeader :: BlockHeight
..}, Bool
Integer
[TxHash]
BlockHeight
Word64
$sel:height:BlockData :: BlockHeight
$sel:main:BlockData :: Bool
$sel:work:BlockData :: Integer
$sel:size:BlockData :: BlockHeight
$sel:weight:BlockData :: BlockHeight
$sel:txs:BlockData :: [TxHash]
$sel:outputs:BlockData :: Word64
$sel:fee:BlockData :: Word64
$sel:subsidy:BlockData :: Word64
height :: BlockHeight
main :: Bool
size :: BlockHeight
txs :: [TxHash]
subsidy :: Word64
fee :: Word64
outputs :: Word64
work :: Integer
weight :: BlockHeight
..}

instance MarshalJSON Network BlockData where
  marshalValue :: Network -> BlockData -> Value
marshalValue Network
net BlockData
b =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"hash" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHeader -> BlockHash
headerHash BlockData
b.header,
        Key
"height" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.height,
        Key
"mainchain" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.main,
        Key
"previous" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.header.prev,
        Key
"time" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.header.timestamp,
        Key
"version" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.header.version,
        Key
"bits" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.header.bits,
        Key
"nonce" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.header.nonce,
        Key
"size" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.size,
        Key
"tx" Key -> [TxHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.txs,
        Key
"merkle" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash256 -> TxHash
TxHash BlockData
b.header.merkle,
        Key
"subsidy" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.subsidy,
        Key
"fees" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.fee,
        Key
"outputs" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.outputs,
        Key
"work" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.work
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"weight" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockData
b.weight | Network
net.segWit]

  marshalEncoding :: Network -> BlockData -> Encoding
marshalEncoding Network
net BlockData
b =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"hash" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (BlockHeader -> BlockHash
headerHash BlockData
b.header),
          Key
"height" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.height,
          Key
"mainchain" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BlockData
b.main,
          Key
"previous" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BlockData
b.header.prev,
          Key
"time" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.header.timestamp,
          Key
"version" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.header.version,
          Key
"bits" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.header.bits,
          Key
"nonce" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.header.nonce,
          Key
"size" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.size,
          Key
"tx" Key -> Encoding -> Series
`A.pair` (TxHash -> Encoding) -> [TxHash] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BlockData
b.txs,
          Key
"merkle" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Hash256 -> TxHash
TxHash BlockData
b.header.merkle),
          Key
"subsidy" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BlockData
b.subsidy,
          Key
"fees" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BlockData
b.fee,
          Key
"outputs" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BlockData
b.outputs,
          Key
"work" Key -> Encoding -> Series
`A.pair` Integer -> Encoding
A.integer BlockData
b.work,
          Series -> Series -> Bool -> Series
forall a. a -> a -> Bool -> a
bool Series
forall a. Monoid a => a
mempty (Key
"weight" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BlockData
b.weight) Network
net.segWit
        ]

  unmarshalValue :: Network -> Value -> Parser BlockData
unmarshalValue Network
net = Value -> Parser BlockData
forall a. FromJSON a => Value -> Parser a
parseJSON

data StoreInput
  = StoreCoinbase
      { StoreInput -> OutPoint
outpoint :: !OutPoint,
        StoreInput -> BlockHeight
sequence :: !Word32,
        StoreInput -> WitnessStackItem
script :: !ByteString,
        StoreInput -> [WitnessStackItem]
witness :: !WitnessStack
      }
  | StoreInput
      { outpoint :: !OutPoint,
        sequence :: !Word32,
        script :: !ByteString,
        StoreInput -> WitnessStackItem
pkscript :: !ByteString,
        StoreInput -> Word64
value :: !Word64,
        witness :: !WitnessStack,
        StoreInput -> Maybe Address
address :: !(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
$cshowsPrec :: Int -> StoreInput -> ShowS
showsPrec :: Int -> StoreInput -> ShowS
$cshow :: StoreInput -> String
show :: StoreInput -> String
$cshowList :: [StoreInput] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS StoreInput
readsPrec :: Int -> ReadS StoreInput
$creadList :: ReadS [StoreInput]
readList :: ReadS [StoreInput]
$creadPrec :: ReadPrec StoreInput
readPrec :: ReadPrec StoreInput
$creadListPrec :: ReadPrec [StoreInput]
readListPrec :: ReadPrec [StoreInput]
Read, StoreInput -> StoreInput -> Bool
(StoreInput -> StoreInput -> Bool)
-> (StoreInput -> StoreInput -> Bool) -> Eq StoreInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreInput -> StoreInput -> Bool
== :: StoreInput -> StoreInput -> Bool
$c/= :: StoreInput -> StoreInput -> Bool
/= :: 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
$ccompare :: StoreInput -> StoreInput -> Ordering
compare :: StoreInput -> StoreInput -> Ordering
$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
>= :: StoreInput -> StoreInput -> Bool
$cmax :: StoreInput -> StoreInput -> StoreInput
max :: StoreInput -> StoreInput -> StoreInput
$cmin :: StoreInput -> StoreInput -> StoreInput
min :: StoreInput -> StoreInput -> 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
$cfrom :: forall x. StoreInput -> Rep StoreInput x
from :: forall x. StoreInput -> Rep StoreInput x
$cto :: forall x. Rep StoreInput x -> StoreInput
to :: forall x. Rep StoreInput x -> StoreInput
Generic, Eq StoreInput
Eq StoreInput
-> (Int -> StoreInput -> Int)
-> (StoreInput -> Int)
-> Hashable StoreInput
Int -> StoreInput -> Int
StoreInput -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StoreInput -> Int
hashWithSalt :: Int -> StoreInput -> Int
$chash :: StoreInput -> Int
hash :: StoreInput -> Int
Hashable, StoreInput -> ()
(StoreInput -> ()) -> NFData StoreInput
forall a. (a -> ()) -> NFData a
$crnf :: StoreInput -> ()
rnf :: StoreInput -> ()
NFData)

instance Serial StoreInput where
  serialize :: forall (m :: * -> *). MonadPut m => StoreInput -> m ()
serialize i :: StoreInput
i@StoreCoinbase {} = do
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00
    OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => OutPoint -> m ()
serialize StoreInput
i.outpoint
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be StoreInput
i.sequence
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes StoreInput
i.script
    (WitnessStackItem -> m ()) -> [WitnessStackItem] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes StoreInput
i.witness
  serialize i :: StoreInput
i@StoreInput {} = do
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01
    OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => OutPoint -> m ()
serialize StoreInput
i.outpoint
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be StoreInput
i.sequence
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes StoreInput
i.script
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes StoreInput
i.pkscript
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be StoreInput
i.value
    (WitnessStackItem -> m ()) -> [WitnessStackItem] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes StoreInput
i.witness
    (Address -> m ()) -> Maybe Address -> m ()
forall (m :: * -> *) a.
MonadPut m =>
(a -> m ()) -> Maybe a -> m ()
putMaybe Address -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Address -> m ()
serialize StoreInput
i.address

  deserialize :: forall (m :: * -> *). MonadGet m => m StoreInput
deserialize =
    m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m StoreInput) -> m StoreInput
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0x00 -> do
        OutPoint
outpoint <- m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m OutPoint
deserialize
        BlockHeight
sequence <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
        WitnessStackItem
script <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
        [WitnessStackItem]
witness <- m WitnessStackItem -> m [WitnessStackItem]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
        StoreInput -> m StoreInput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StoreCoinbase {[WitnessStackItem]
BlockHeight
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: OutPoint
$sel:sequence:StoreCoinbase :: BlockHeight
$sel:script:StoreCoinbase :: WitnessStackItem
$sel:witness:StoreCoinbase :: [WitnessStackItem]
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
witness :: [WitnessStackItem]
..}
      Word8
0x01 -> do
        OutPoint
outpoint <- m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m OutPoint
deserialize
        BlockHeight
sequence <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
        WitnessStackItem
script <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
        WitnessStackItem
pkscript <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
        Word64
value <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        [WitnessStackItem]
witness <- m WitnessStackItem -> m [WitnessStackItem]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
        Maybe Address
address <- m Address -> m (Maybe Address)
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe m Address
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Address
deserialize
        StoreInput -> m StoreInput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StoreInput {[WitnessStackItem]
Maybe Address
BlockHeight
Word64
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: OutPoint
$sel:sequence:StoreCoinbase :: BlockHeight
$sel:script:StoreCoinbase :: WitnessStackItem
$sel:witness:StoreCoinbase :: [WitnessStackItem]
$sel:pkscript:StoreCoinbase :: WitnessStackItem
$sel:value:StoreCoinbase :: Word64
$sel:address:StoreCoinbase :: Maybe Address
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
pkscript :: WitnessStackItem
value :: Word64
witness :: [WitnessStackItem]
address :: Maybe Address
..}
      Word8
x -> String -> m StoreInput
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m StoreInput) -> String -> m StoreInput
forall a b. (a -> b) -> a -> b
$ String
"Unknown input id: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a b. ConvertibleStrings a b => a -> b
cs (Word8 -> String
forall a. Show a => a -> String
show Word8
x)

instance Serialize StoreInput where
  put :: Putter StoreInput
put = Putter StoreInput
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => StoreInput -> m ()
serialize
  get :: Get StoreInput
get = Get StoreInput
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m StoreInput
deserialize

instance Binary StoreInput where
  put :: StoreInput -> Put
put = StoreInput -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => StoreInput -> m ()
serialize
  get :: Get StoreInput
get = Get StoreInput
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m StoreInput
deserialize

isCoinbaseTx :: Tx -> Bool
isCoinbaseTx :: Tx -> Bool
isCoinbaseTx = (TxIn -> Bool) -> [TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== OutPoint
nullOutPoint) (OutPoint -> Bool) -> (TxIn -> OutPoint) -> TxIn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.outpoint)) ([TxIn] -> Bool) -> (Tx -> [TxIn]) -> Tx -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.inputs)

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

instance MarshalJSON Network StoreInput where
  marshalValue :: Network -> StoreInput -> Value
marshalValue Network
net i :: StoreInput
i@StoreInput {} =
    [Pair] -> Value
A.object
      [ Key
"coinbase" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
False,
        Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.outpoint.hash,
        Key
"output" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.outpoint.index,
        Key
"sigscript" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (WitnessStackItem -> Text
encodeHex StoreInput
i.script),
        Key
"sequence" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.sequence,
        Key
"pkscript" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (WitnessStackItem -> Text
encodeHex StoreInput
i.pkscript),
        Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.value,
        Key
"address" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net (Address -> Value) -> Maybe Address -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreInput
i.address),
        Key
"witness" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (WitnessStackItem -> Text) -> [WitnessStackItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map WitnessStackItem -> Text
encodeHex StoreInput
i.witness
      ]
  marshalValue Network
net i :: StoreInput
i@StoreCoinbase {} =
    [Pair] -> Value
A.object
      [ Key
"coinbase" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True,
        Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.outpoint.hash,
        Key
"output" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.outpoint.index,
        Key
"sigscript" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (WitnessStackItem -> Text
encodeHex StoreInput
i.script),
        Key
"sequence" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreInput
i.sequence,
        Key
"pkscript" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
Null,
        Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
Null,
        Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
Null,
        Key
"witness" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (WitnessStackItem -> Text) -> [WitnessStackItem] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map WitnessStackItem -> Text
encodeHex StoreInput
i.witness
      ]

  marshalEncoding :: Network -> StoreInput -> Encoding
marshalEncoding Network
net i :: StoreInput
i@StoreInput {} =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"coinbase" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool Bool
False,
          Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding StoreInput
i.outpoint.hash,
          Key
"output" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 StoreInput
i.outpoint.index,
          Key
"sigscript" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict StoreInput
i.script),
          Key
"sequence" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 StoreInput
i.sequence,
          Key
"pkscript" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict StoreInput
i.pkscript),
          Key
"value" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 StoreInput
i.value,
          Key
"address" Key -> Encoding -> Series
`A.pair` Encoding -> (Address -> Encoding) -> Maybe Address -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
A.null_ (Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net) StoreInput
i.address,
          Key
"witness" Key -> Encoding -> Series
`A.pair` (WitnessStackItem -> Encoding) -> [WitnessStackItem] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list (ByteString -> Encoding
hexEncoding (ByteString -> Encoding)
-> (WitnessStackItem -> ByteString) -> WitnessStackItem -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> ByteString
B.fromStrict) StoreInput
i.witness
        ]
  marshalEncoding Network
net i :: StoreInput
i@StoreCoinbase {} =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"coinbase" Key -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= Bool
True,
          Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding StoreInput
i.outpoint.hash,
          Key
"output" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 StoreInput
i.outpoint.index,
          Key
"sigscript" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict StoreInput
i.script),
          Key
"sequence" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 StoreInput
i.sequence,
          Key
"pkscript" Key -> Encoding -> Series
`A.pair` Encoding
A.null_,
          Key
"value" Key -> Encoding -> Series
`A.pair` Encoding
A.null_,
          Key
"address" Key -> Encoding -> Series
`A.pair` Encoding
A.null_,
          Key
"witness" Key -> Encoding -> Series
`A.pair` (WitnessStackItem -> Encoding) -> [WitnessStackItem] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list (ByteString -> Encoding
hexEncoding (ByteString -> Encoding)
-> (WitnessStackItem -> ByteString) -> WitnessStackItem -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> ByteString
B.fromStrict) StoreInput
i.witness
        ]

  unmarshalValue :: Network -> Value -> Parser StoreInput
unmarshalValue Network
net =
    String
-> (Object -> Parser StoreInput) -> Value -> Parser StoreInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StoreInput" ((Object -> Parser StoreInput) -> Value -> Parser StoreInput)
-> (Object -> Parser StoreInput) -> Value -> Parser StoreInput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Bool
coinbase <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"coinbase"
      OutPoint
outpoint <- TxHash -> BlockHeight -> OutPoint
OutPoint (TxHash -> BlockHeight -> OutPoint)
-> Parser TxHash -> Parser (BlockHeight -> OutPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid" Parser (BlockHeight -> OutPoint)
-> Parser BlockHeight -> Parser OutPoint
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output"
      BlockHeight
sequence <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sequence"
      [WitnessStackItem]
witness <- (Text -> Parser WitnessStackItem)
-> [Text] -> Parser [WitnessStackItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Parser WitnessStackItem
jsonHex ([Text] -> Parser [WitnessStackItem])
-> Parser [Text] -> Parser [WitnessStackItem]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"witness" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      WitnessStackItem
script <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sigscript" Parser Text
-> (Text -> Parser WitnessStackItem) -> Parser WitnessStackItem
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser WitnessStackItem
jsonHex
      if Bool
coinbase
        then StoreInput -> Parser StoreInput
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StoreCoinbase {[WitnessStackItem]
BlockHeight
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: OutPoint
$sel:sequence:StoreCoinbase :: BlockHeight
$sel:script:StoreCoinbase :: WitnessStackItem
$sel:witness:StoreCoinbase :: [WitnessStackItem]
outpoint :: OutPoint
sequence :: BlockHeight
witness :: [WitnessStackItem]
script :: WitnessStackItem
..}
        else do
          WitnessStackItem
pkscript <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pkscript" Parser Text
-> (Text -> Parser WitnessStackItem) -> Parser WitnessStackItem
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser WitnessStackItem
jsonHex
          Word64
value <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
          Maybe Address
address <-
            Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
              Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe Address)
-> (Value -> Parser (Maybe Address))
-> Maybe Value
-> Parser (Maybe Address)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Address -> Parser (Maybe Address)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing) (Parser Address -> Parser (Maybe Address)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Address -> Parser (Maybe Address))
-> (Value -> Parser Address) -> Value -> Parser (Maybe Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net)
          StoreInput -> Parser StoreInput
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StoreInput {[WitnessStackItem]
Maybe Address
BlockHeight
Word64
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: OutPoint
$sel:sequence:StoreCoinbase :: BlockHeight
$sel:script:StoreCoinbase :: WitnessStackItem
$sel:witness:StoreCoinbase :: [WitnessStackItem]
$sel:pkscript:StoreCoinbase :: WitnessStackItem
$sel:value:StoreCoinbase :: Word64
$sel:address:StoreCoinbase :: Maybe Address
outpoint :: OutPoint
sequence :: BlockHeight
witness :: [WitnessStackItem]
script :: WitnessStackItem
pkscript :: WitnessStackItem
value :: Word64
address :: Maybe Address
..}

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

-- | Information about input spending output.
data Spender = Spender
  { -- | input transaction hash
    Spender -> TxHash
txid :: !TxHash,
    -- | input position in transaction
    Spender -> BlockHeight
index :: !Word32
  }
  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
$cshowsPrec :: Int -> Spender -> ShowS
showsPrec :: Int -> Spender -> ShowS
$cshow :: Spender -> String
show :: Spender -> String
$cshowList :: [Spender] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS Spender
readsPrec :: Int -> ReadS Spender
$creadList :: ReadS [Spender]
readList :: ReadS [Spender]
$creadPrec :: ReadPrec Spender
readPrec :: ReadPrec Spender
$creadListPrec :: ReadPrec [Spender]
readListPrec :: ReadPrec [Spender]
Read, Spender -> Spender -> Bool
(Spender -> Spender -> Bool)
-> (Spender -> Spender -> Bool) -> Eq Spender
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Spender -> Spender -> Bool
== :: Spender -> Spender -> Bool
$c/= :: Spender -> Spender -> Bool
/= :: 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
$ccompare :: Spender -> Spender -> Ordering
compare :: Spender -> Spender -> Ordering
$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
>= :: Spender -> Spender -> Bool
$cmax :: Spender -> Spender -> Spender
max :: Spender -> Spender -> Spender
$cmin :: Spender -> Spender -> Spender
min :: Spender -> Spender -> 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
$cfrom :: forall x. Spender -> Rep Spender x
from :: forall x. Spender -> Rep Spender x
$cto :: forall x. Rep Spender x -> Spender
to :: forall x. Rep Spender x -> Spender
Generic, Eq Spender
Eq Spender
-> (Int -> Spender -> Int) -> (Spender -> Int) -> Hashable Spender
Int -> Spender -> Int
Spender -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Spender -> Int
hashWithSalt :: Int -> Spender -> Int
$chash :: Spender -> Int
hash :: Spender -> Int
Hashable, Spender -> ()
(Spender -> ()) -> NFData Spender
forall a. (a -> ()) -> NFData a
$crnf :: Spender -> ()
rnf :: Spender -> ()
NFData)

instance Serial Spender where
  serialize :: forall (m :: * -> *). MonadPut m => Spender -> m ()
serialize Spender
s = do
    TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize Spender
s.txid
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be Spender
s.index
  deserialize :: forall (m :: * -> *). MonadGet m => m Spender
deserialize = TxHash -> BlockHeight -> Spender
Spender (TxHash -> BlockHeight -> Spender)
-> m TxHash -> m (BlockHeight -> Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxHash
deserialize m (BlockHeight -> Spender) -> m BlockHeight -> m Spender
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be

instance Serialize Spender where
  put :: Putter Spender
put = Putter Spender
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Spender -> m ()
serialize
  get :: Get Spender
get = Get Spender
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Spender
deserialize

instance Binary Spender where
  put :: Spender -> Put
put = Spender -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Spender -> m ()
serialize
  get :: Get Spender
get = Get Spender
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Spender
deserialize

instance ToJSON Spender where
  toJSON :: Spender -> Value
toJSON Spender
s =
    [Pair] -> Value
A.object
      [ Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Spender
s.txid,
        Key
"input" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Spender
s.index
      ]
  toEncoding :: Spender -> Encoding
toEncoding Spender
s =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Spender
s.txid,
          Key
"input" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 Spender
s.index
        ]

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 String
"Spender" ((Object -> Parser Spender) -> Value -> Parser Spender)
-> (Object -> Parser Spender) -> Value -> Parser Spender
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      TxHash -> BlockHeight -> Spender
Spender (TxHash -> BlockHeight -> Spender)
-> Parser TxHash -> Parser (BlockHeight -> Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid" Parser (BlockHeight -> Spender)
-> Parser BlockHeight -> Parser Spender
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"input"

-- | Output information.
data StoreOutput = StoreOutput
  { StoreOutput -> Word64
value :: !Word64,
    StoreOutput -> WitnessStackItem
script :: !ByteString,
    StoreOutput -> Maybe Spender
spender :: !(Maybe Spender),
    StoreOutput -> Maybe Address
address :: !(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
$cshowsPrec :: Int -> StoreOutput -> ShowS
showsPrec :: Int -> StoreOutput -> ShowS
$cshow :: StoreOutput -> String
show :: StoreOutput -> String
$cshowList :: [StoreOutput] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS StoreOutput
readsPrec :: Int -> ReadS StoreOutput
$creadList :: ReadS [StoreOutput]
readList :: ReadS [StoreOutput]
$creadPrec :: ReadPrec StoreOutput
readPrec :: ReadPrec StoreOutput
$creadListPrec :: ReadPrec [StoreOutput]
readListPrec :: ReadPrec [StoreOutput]
Read, StoreOutput -> StoreOutput -> Bool
(StoreOutput -> StoreOutput -> Bool)
-> (StoreOutput -> StoreOutput -> Bool) -> Eq StoreOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreOutput -> StoreOutput -> Bool
== :: StoreOutput -> StoreOutput -> Bool
$c/= :: StoreOutput -> StoreOutput -> Bool
/= :: 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
$ccompare :: StoreOutput -> StoreOutput -> Ordering
compare :: StoreOutput -> StoreOutput -> Ordering
$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
>= :: StoreOutput -> StoreOutput -> Bool
$cmax :: StoreOutput -> StoreOutput -> StoreOutput
max :: StoreOutput -> StoreOutput -> StoreOutput
$cmin :: StoreOutput -> StoreOutput -> StoreOutput
min :: StoreOutput -> StoreOutput -> 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
$cfrom :: forall x. StoreOutput -> Rep StoreOutput x
from :: forall x. StoreOutput -> Rep StoreOutput x
$cto :: forall x. Rep StoreOutput x -> StoreOutput
to :: forall x. Rep StoreOutput x -> StoreOutput
Generic, Eq StoreOutput
Eq StoreOutput
-> (Int -> StoreOutput -> Int)
-> (StoreOutput -> Int)
-> Hashable StoreOutput
Int -> StoreOutput -> Int
StoreOutput -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> StoreOutput -> Int
hashWithSalt :: Int -> StoreOutput -> Int
$chash :: StoreOutput -> Int
hash :: StoreOutput -> Int
Hashable, StoreOutput -> ()
(StoreOutput -> ()) -> NFData StoreOutput
forall a. (a -> ()) -> NFData a
$crnf :: StoreOutput -> ()
rnf :: StoreOutput -> ()
NFData)

instance Serial StoreOutput where
  serialize :: forall (m :: * -> *). MonadPut m => StoreOutput -> m ()
serialize StoreOutput
o = do
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be StoreOutput
o.value
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes StoreOutput
o.script
    (Spender -> m ()) -> Maybe Spender -> m ()
forall (m :: * -> *) a.
MonadPut m =>
(a -> m ()) -> Maybe a -> m ()
putMaybe Spender -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Spender -> m ()
serialize StoreOutput
o.spender
    (Address -> m ()) -> Maybe Address -> m ()
forall (m :: * -> *) a.
MonadPut m =>
(a -> m ()) -> Maybe a -> m ()
putMaybe Address -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Address -> m ()
serialize StoreOutput
o.address
  deserialize :: forall (m :: * -> *). MonadGet m => m StoreOutput
deserialize = do
    Word64
value <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    WitnessStackItem
script <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    Maybe Spender
spender <- m Spender -> m (Maybe Spender)
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe m Spender
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Spender
deserialize
    Maybe Address
address <- m Address -> m (Maybe Address)
forall (m :: * -> *) a. MonadGet m => m a -> m (Maybe a)
getMaybe m Address
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Address
deserialize
    StoreOutput -> m StoreOutput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return StoreOutput {Maybe Address
Maybe Spender
Word64
WitnessStackItem
$sel:value:StoreOutput :: Word64
$sel:script:StoreOutput :: WitnessStackItem
$sel:spender:StoreOutput :: Maybe Spender
$sel:address:StoreOutput :: Maybe Address
value :: Word64
script :: WitnessStackItem
spender :: Maybe Spender
address :: Maybe Address
..}

instance Serialize StoreOutput where
  put :: Putter StoreOutput
put = Putter StoreOutput
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => StoreOutput -> m ()
serialize
  get :: Get StoreOutput
get = Get StoreOutput
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m StoreOutput
deserialize

instance Binary StoreOutput where
  put :: StoreOutput -> Put
put = StoreOutput -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => StoreOutput -> m ()
serialize
  get :: Get StoreOutput
get = Get StoreOutput
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m StoreOutput
deserialize

instance MarshalJSON Network StoreOutput where
  marshalValue :: Network -> StoreOutput -> Value
marshalValue Network
net StoreOutput
o =
    [Pair] -> Value
A.object
      [ Key
"address" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net (Address -> Value) -> Maybe Address -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreOutput
o.address),
        Key
"pkscript" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex StoreOutput
o.script,
        Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreOutput
o.value,
        Key
"spent" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Spender -> Bool
forall a. Maybe a -> Bool
isJust StoreOutput
o.spender,
        Key
"spender" Key -> Maybe Spender -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= StoreOutput
o.spender
      ]

  marshalEncoding :: Network -> StoreOutput -> Encoding
marshalEncoding Network
net StoreOutput
o =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"address" Key -> Encoding -> Series
`A.pair` Encoding -> (Address -> Encoding) -> Maybe Address -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
A.null_ (Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net) StoreOutput
o.address,
          Key
"pkscript" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict StoreOutput
o.script),
          Key
"value" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 StoreOutput
o.value,
          Key
"spent" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool (Maybe Spender -> Bool
forall a. Maybe a -> Bool
isJust StoreOutput
o.spender),
          Key
"spender" Key -> Encoding -> Series
`A.pair` Maybe Spender -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding StoreOutput
o.spender
        ]

  unmarshalValue :: Network -> Value -> Parser StoreOutput
unmarshalValue Network
net =
    String
-> (Object -> Parser StoreOutput) -> Value -> Parser StoreOutput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"StoreOutput" ((Object -> Parser StoreOutput) -> Value -> Parser StoreOutput)
-> (Object -> Parser StoreOutput) -> Value -> Parser StoreOutput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Word64
value <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      WitnessStackItem
script <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pkscript" Parser Text
-> (Text -> Parser WitnessStackItem) -> Parser WitnessStackItem
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser WitnessStackItem
jsonHex
      Maybe Spender
spender <- Object
o Object -> Key -> Parser (Maybe Spender)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"spender"
      Maybe Address
address <-
        Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
          Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe Address)
-> (Value -> Parser (Maybe Address))
-> Maybe Value
-> Parser (Maybe Address)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Address -> Parser (Maybe Address)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Address
forall a. Maybe a
Nothing) (Parser Address -> Parser (Maybe Address)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Address -> Parser (Maybe Address))
-> (Value -> Parser Address) -> Value -> Parser (Maybe Address)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net)
      StoreOutput -> Parser StoreOutput
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return StoreOutput {Maybe Address
Maybe Spender
Word64
WitnessStackItem
$sel:value:StoreOutput :: Word64
$sel:script:StoreOutput :: WitnessStackItem
$sel:spender:StoreOutput :: Maybe Spender
$sel:address:StoreOutput :: Maybe Address
value :: Word64
script :: WitnessStackItem
spender :: Maybe Spender
address :: Maybe Address
..}

data Prev = Prev
  { Prev -> WitnessStackItem
script :: !ByteString,
    Prev -> Word64
value :: !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
$cshowsPrec :: Int -> Prev -> ShowS
showsPrec :: Int -> Prev -> ShowS
$cshow :: Prev -> String
show :: Prev -> String
$cshowList :: [Prev] -> ShowS
showList :: [Prev] -> ShowS
Show, Prev -> Prev -> Bool
(Prev -> Prev -> Bool) -> (Prev -> Prev -> Bool) -> Eq Prev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prev -> Prev -> Bool
== :: Prev -> Prev -> Bool
$c/= :: Prev -> Prev -> Bool
/= :: 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
$ccompare :: Prev -> Prev -> Ordering
compare :: Prev -> Prev -> Ordering
$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
>= :: Prev -> Prev -> Bool
$cmax :: Prev -> Prev -> Prev
max :: Prev -> Prev -> Prev
$cmin :: Prev -> Prev -> Prev
min :: Prev -> Prev -> 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
$cfrom :: forall x. Prev -> Rep Prev x
from :: forall x. Prev -> Rep Prev x
$cto :: forall x. Rep Prev x -> Prev
to :: forall x. Rep Prev x -> Prev
Generic, Eq Prev
Eq Prev -> (Int -> Prev -> Int) -> (Prev -> Int) -> Hashable Prev
Int -> Prev -> Int
Prev -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Prev -> Int
hashWithSalt :: Int -> Prev -> Int
$chash :: Prev -> Int
hash :: Prev -> Int
Hashable, Prev -> ()
(Prev -> ()) -> NFData Prev
forall a. (a -> ()) -> NFData a
$crnf :: Prev -> ()
rnf :: Prev -> ()
NFData)

instance Serial Prev where
  serialize :: forall (m :: * -> *). MonadPut m => Prev -> m ()
serialize Prev
p = do
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes Prev
p.script
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Prev
p.value
  deserialize :: forall (m :: * -> *). MonadGet m => m Prev
deserialize = do
    WitnessStackItem
script <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    Word64
value <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Prev -> m Prev
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Prev {Word64
WitnessStackItem
$sel:script:Prev :: WitnessStackItem
$sel:value:Prev :: Word64
script :: WitnessStackItem
value :: Word64
..}

instance Binary Prev where
  put :: Prev -> Put
put = Prev -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Prev -> m ()
serialize
  get :: Get Prev
get = Get Prev
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Prev
deserialize

instance Serialize Prev where
  put :: Putter Prev
put = Putter Prev
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Prev -> m ()
serialize
  get :: Get Prev
get = Get Prev
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Prev
deserialize

toInput :: Ctx -> TxIn -> Maybe Prev -> WitnessStack -> StoreInput
toInput :: Ctx -> TxIn -> Maybe Prev -> [WitnessStackItem] -> StoreInput
toInput Ctx
ctx TxIn
i Maybe Prev
Nothing [WitnessStackItem]
w =
  StoreCoinbase
    { $sel:outpoint:StoreCoinbase :: OutPoint
outpoint = TxIn
i.outpoint,
      $sel:sequence:StoreCoinbase :: BlockHeight
sequence = TxIn
i.sequence,
      $sel:script:StoreCoinbase :: WitnessStackItem
script = TxIn
i.script,
      $sel:witness:StoreCoinbase :: [WitnessStackItem]
witness = [WitnessStackItem]
w
    }
toInput Ctx
ctx TxIn
i (Just Prev
p) [WitnessStackItem]
w =
  StoreInput
    { $sel:outpoint:StoreCoinbase :: OutPoint
outpoint = TxIn
i.outpoint,
      $sel:sequence:StoreCoinbase :: BlockHeight
sequence = TxIn
i.sequence,
      $sel:script:StoreCoinbase :: WitnessStackItem
script = TxIn
i.script,
      $sel:pkscript:StoreCoinbase :: WitnessStackItem
pkscript = Prev
p.script,
      $sel:value:StoreCoinbase :: Word64
value = Prev
p.value,
      $sel:witness:StoreCoinbase :: [WitnessStackItem]
witness = [WitnessStackItem]
w,
      $sel:address:StoreCoinbase :: Maybe Address
address = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> WitnessStackItem -> Either String Address
scriptToAddressBS Ctx
ctx Prev
p.script)
    }

toOutput :: Ctx -> TxOut -> Maybe Spender -> StoreOutput
toOutput :: Ctx -> TxOut -> Maybe Spender -> StoreOutput
toOutput Ctx
ctx TxOut
o Maybe Spender
s =
  StoreOutput
    { $sel:value:StoreOutput :: Word64
value = TxOut
o.value,
      $sel:script:StoreOutput :: WitnessStackItem
script = TxOut
o.script,
      $sel:spender:StoreOutput :: Maybe Spender
spender = Maybe Spender
s,
      $sel:address:StoreOutput :: Maybe Address
address = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> WitnessStackItem -> Either String Address
scriptToAddressBS Ctx
ctx TxOut
o.script)
    }

data TxData = TxData
  { TxData -> BlockRef
block :: !BlockRef,
    TxData -> Tx
tx :: !Tx,
    TxData -> IntMap Prev
prevs :: !(IntMap Prev),
    TxData -> Bool
deleted :: !Bool,
    TxData -> Bool
rbf :: !Bool,
    TxData -> Word64
timestamp :: !Word64,
    TxData -> IntMap Spender
spenders :: !(IntMap Spender)
  }
  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
$cshowsPrec :: Int -> TxData -> ShowS
showsPrec :: Int -> TxData -> ShowS
$cshow :: TxData -> String
show :: TxData -> String
$cshowList :: [TxData] -> ShowS
showList :: [TxData] -> ShowS
Show, TxData -> TxData -> Bool
(TxData -> TxData -> Bool)
-> (TxData -> TxData -> Bool) -> Eq TxData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxData -> TxData -> Bool
== :: TxData -> TxData -> Bool
$c/= :: TxData -> TxData -> Bool
/= :: 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
$ccompare :: TxData -> TxData -> Ordering
compare :: TxData -> TxData -> Ordering
$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
>= :: TxData -> TxData -> Bool
$cmax :: TxData -> TxData -> TxData
max :: TxData -> TxData -> TxData
$cmin :: TxData -> TxData -> TxData
min :: TxData -> TxData -> 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
$cfrom :: forall x. TxData -> Rep TxData x
from :: forall x. TxData -> Rep TxData x
$cto :: forall x. Rep TxData x -> TxData
to :: forall x. Rep TxData x -> TxData
Generic, TxData -> ()
(TxData -> ()) -> NFData TxData
forall a. (a -> ()) -> NFData a
$crnf :: TxData -> ()
rnf :: TxData -> ()
NFData)

instance Serial TxData where
  serialize :: forall (m :: * -> *). MonadPut m => TxData -> m ()
serialize TxData
t = do
    BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize TxData
t.block
    Tx -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize TxData
t.tx
    (Int -> m ()) -> (Prev -> m ()) -> IntMap Prev -> m ()
forall (m :: * -> *) a.
MonadPut m =>
(Int -> m ()) -> (a -> m ()) -> IntMap a -> m ()
putIntMap (Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Word64 -> m ()) -> (Int -> Word64) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Prev -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Prev -> m ()
serialize TxData
t.prevs
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize TxData
t.deleted
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize TxData
t.rbf
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be TxData
t.timestamp
    (Int -> m ()) -> (Spender -> m ()) -> IntMap Spender -> m ()
forall (m :: * -> *) a.
MonadPut m =>
(Int -> m ()) -> (a -> m ()) -> IntMap a -> m ()
putIntMap (Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be (Word64 -> m ()) -> (Int -> Word64) -> Int -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Spender -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Spender -> m ()
serialize TxData
t.spenders
  deserialize :: forall (m :: * -> *). MonadGet m => m TxData
deserialize = do
    BlockRef
block <- m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockRef
deserialize
    Tx
tx <- m Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Tx
deserialize
    IntMap Prev
prevs <- m Int -> m Prev -> m (IntMap Prev)
forall (m :: * -> *) a. MonadGet m => m Int -> m a -> m (IntMap a)
getIntMap (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> m Word64 -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be) m Prev
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Prev
deserialize
    Bool
deleted <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Bool
rbf <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Word64
timestamp <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    IntMap Spender
spenders <- m Int -> m Spender -> m (IntMap Spender)
forall (m :: * -> *) a. MonadGet m => m Int -> m a -> m (IntMap a)
getIntMap (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> m Word64 -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be) m Spender
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Spender
deserialize
    TxData -> m TxData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxData {Bool
Word64
IntMap Prev
IntMap Spender
Tx
BlockRef
$sel:block:TxData :: BlockRef
$sel:tx:TxData :: Tx
$sel:prevs:TxData :: IntMap Prev
$sel:deleted:TxData :: Bool
$sel:rbf:TxData :: Bool
$sel:timestamp:TxData :: Word64
$sel:spenders:TxData :: IntMap Spender
block :: BlockRef
tx :: Tx
prevs :: IntMap Prev
deleted :: Bool
rbf :: Bool
timestamp :: Word64
spenders :: IntMap Spender
..}

instance Serialize TxData where
  put :: Putter TxData
put = Putter TxData
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxData -> m ()
serialize
  get :: Get TxData
get = Get TxData
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxData
deserialize

instance Binary TxData where
  put :: TxData -> Put
put = TxData -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxData -> m ()
serialize
  get :: Get TxData
get = Get TxData
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxData
deserialize

txDataFee :: TxData -> Word64
txDataFee :: TxData -> Word64
txDataFee TxData
t =
  if Tx -> Bool
isCoinbaseTx TxData
t.tx
    then Word64
0
    else Word64
inputs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
outputs
  where
    inputs :: Word64
inputs = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (Prev -> Word64) -> [Prev] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.value) ([Prev] -> [Word64]) -> [Prev] -> [Word64]
forall a b. (a -> b) -> a -> b
$ IntMap Prev -> [Prev]
forall a. IntMap a -> [a]
IntMap.elems TxData
t.prevs
    outputs :: Word64
outputs = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (TxOut -> Word64) -> [TxOut] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.value) TxData
t.tx.outputs

toTransaction :: Ctx -> TxData -> Transaction
toTransaction :: Ctx -> TxData -> Transaction
toTransaction Ctx
ctx TxData
t =
  Transaction
    { $sel:version:Transaction :: BlockHeight
version = TxData
t.tx.version,
      $sel:locktime:Transaction :: BlockHeight
locktime = TxData
t.tx.locktime,
      $sel:block:Transaction :: BlockRef
block = TxData
t.block,
      $sel:deleted:Transaction :: Bool
deleted = TxData
t.deleted,
      $sel:rbf:Transaction :: Bool
rbf = TxData
t.rbf,
      $sel:timestamp:Transaction :: Word64
timestamp = TxData
t.timestamp,
      $sel:txid:Transaction :: TxHash
txid = Tx -> TxHash
txHash TxData
t.tx,
      $sel:inputs:Transaction :: [StoreInput]
inputs = [StoreInput]
ins,
      $sel:outputs:Transaction :: [StoreOutput]
outputs = [StoreOutput]
outs,
      $sel:size:Transaction :: BlockHeight
size =
        Int -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockHeight) -> Int -> BlockHeight
forall a b. (a -> b) -> a -> b
$
          WitnessStackItem -> Int
B.length (WitnessStackItem -> Int) -> WitnessStackItem -> Int
forall a b. (a -> b) -> a -> b
$
            Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$
              Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize TxData
t.tx,
      $sel:weight:Transaction :: BlockHeight
weight =
        let b :: Int
b = WitnessStackItem -> Int
B.length (WitnessStackItem -> Int) -> WitnessStackItem -> Int
forall a b. (a -> b) -> a -> b
$ Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize Tx
witless
            x :: Int
x = WitnessStackItem -> Int
B.length (WitnessStackItem -> Int) -> WitnessStackItem -> Int
forall a b. (a -> b) -> a -> b
$ Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ Tx -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Tx -> m ()
serialize TxData
t.tx
         in Int -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockHeight) -> Int -> BlockHeight
forall a b. (a -> b) -> a -> b
$ Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x,
      $sel:fee:Transaction :: Word64
fee =
        if (StoreInput -> Bool) -> [StoreInput] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any StoreInput -> Bool
isCoinbase [StoreInput]
ins
          then Word64
0
          else Word64
inv Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
outv
    }
  where
    ins :: [StoreInput]
ins = (Int -> TxIn -> StoreInput) -> [Int] -> [TxIn] -> [StoreInput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> TxIn -> StoreInput
f [Int
0 ..] TxData
t.tx.inputs
    witless :: Tx
witless =
      let Tx {WitnessData
[TxOut]
[TxIn]
BlockHeight
version :: BlockHeight
inputs :: [TxIn]
outputs :: [TxOut]
witness :: WitnessData
locktime :: BlockHeight
$sel:version:Tx :: Tx -> BlockHeight
$sel:inputs:Tx :: Tx -> [TxIn]
$sel:outputs:Tx :: Tx -> [TxOut]
$sel:witness:Tx :: Tx -> WitnessData
$sel:locktime:Tx :: Tx -> BlockHeight
..} = TxData
t.tx
       in Tx {$sel:witness:Tx :: WitnessData
witness = [], [TxOut]
[TxIn]
BlockHeight
version :: BlockHeight
inputs :: [TxIn]
outputs :: [TxOut]
locktime :: BlockHeight
$sel:version:Tx :: BlockHeight
$sel:inputs:Tx :: [TxIn]
$sel:outputs:Tx :: [TxOut]
$sel:locktime:Tx :: BlockHeight
..}
    inv :: Word64
inv = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((StoreInput -> Word64) -> [StoreInput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.value) [StoreInput]
ins)
    outs :: [StoreOutput]
outs = (Int -> TxOut -> StoreOutput) -> [Int] -> [TxOut] -> [StoreOutput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> TxOut -> StoreOutput
g [Int
0 ..] TxData
t.tx.outputs
    outv :: Word64
outv = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (StoreOutput -> Word64) -> [StoreOutput] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (.value) [StoreOutput]
outs
    ws :: WitnessData
ws = Int -> WitnessData -> WitnessData
forall a. Int -> [a] -> [a]
take ([TxIn] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TxData
t.tx.inputs) (WitnessData -> WitnessData) -> WitnessData -> WitnessData
forall a b. (a -> b) -> a -> b
$ TxData
t.tx.witness WitnessData -> WitnessData -> WitnessData
forall a. Semigroup a => a -> a -> a
<> [WitnessStackItem] -> WitnessData
forall a. a -> [a]
repeat []
    f :: Int -> TxIn -> StoreInput
f Int
n TxIn
i = Ctx -> TxIn -> Maybe Prev -> [WitnessStackItem] -> StoreInput
toInput Ctx
ctx TxIn
i (Int -> IntMap Prev -> Maybe Prev
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n TxData
t.prevs) (WitnessData
ws WitnessData -> Int -> [WitnessStackItem]
forall a. HasCallStack => [a] -> Int -> a
!! Int
n)
    g :: Int -> TxOut -> StoreOutput
g Int
n TxOut
o = Ctx -> TxOut -> Maybe Spender -> StoreOutput
toOutput Ctx
ctx TxOut
o (Maybe Spender -> StoreOutput) -> Maybe Spender -> StoreOutput
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Spender -> Maybe Spender
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n TxData
t.spenders

fromTransaction :: Transaction -> TxData
fromTransaction :: Transaction -> TxData
fromTransaction Transaction
t =
  TxData
    { $sel:block:TxData :: BlockRef
block = Transaction
t.block,
      $sel:tx:TxData :: Tx
tx = Tx
tx,
      $sel:deleted:TxData :: Bool
deleted = Transaction
t.deleted,
      $sel:rbf:TxData :: Bool
rbf = Transaction
t.rbf,
      $sel:timestamp:TxData :: Word64
timestamp = Transaction
t.timestamp,
      $sel:prevs:TxData :: IntMap Prev
prevs =
        [(Int, Prev)] -> IntMap Prev
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Prev)] -> IntMap Prev) -> [(Int, Prev)] -> IntMap Prev
forall a b. (a -> b) -> a -> b
$
          [Maybe (Int, Prev)] -> [(Int, Prev)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, Prev)] -> [(Int, Prev)])
-> [Maybe (Int, Prev)] -> [(Int, 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 [Int
0 ..] Transaction
t.inputs,
      $sel:spenders:TxData :: IntMap Spender
spenders =
        [(Int, Spender)] -> IntMap Spender
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Spender)] -> IntMap Spender)
-> [(Int, Spender)] -> IntMap Spender
forall a b. (a -> b) -> a -> b
$
          [Maybe (Int, Spender)] -> [(Int, Spender)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Int, Spender)] -> [(Int, Spender)])
-> [Maybe (Int, Spender)] -> [(Int, 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 [Int
0 ..] Transaction
t.outputs
    }
  where
    tx :: Tx
tx = Transaction -> Tx
transactionData Transaction
t
    f :: a -> StoreInput -> Maybe (a, Prev)
f a
_ StoreCoinbase {} = Maybe (a, Prev)
forall a. Maybe a
Nothing
    f a
n StoreInput {$sel:script:StoreCoinbase :: StoreInput -> WitnessStackItem
script = WitnessStackItem
s, $sel:value:StoreCoinbase :: StoreInput -> Word64
value = Word64
v} =
      (a, Prev) -> Maybe (a, Prev)
forall a. a -> Maybe a
Just (a
n, Prev {$sel:script:Prev :: WitnessStackItem
script = WitnessStackItem
s, $sel:value:Prev :: Word64
value = Word64
v})
    g :: a -> StoreOutput -> Maybe (a, Spender)
g a
_ StoreOutput {$sel:spender:StoreOutput :: StoreOutput -> Maybe Spender
spender = Maybe Spender
Nothing} = Maybe (a, Spender)
forall a. Maybe a
Nothing
    g a
n StoreOutput {$sel:spender:StoreOutput :: StoreOutput -> Maybe Spender
spender = Just Spender
s} = (a, Spender) -> Maybe (a, Spender)
forall a. a -> Maybe a
Just (a
n, Spender
s)

-- | Detailed transaction information.
data Transaction = Transaction
  { -- | block information for this transaction
    Transaction -> BlockRef
block :: !BlockRef,
    -- | transaction version
    Transaction -> BlockHeight
version :: !Word32,
    -- | lock time
    Transaction -> BlockHeight
locktime :: !Word32,
    -- | transaction inputs
    Transaction -> [StoreInput]
inputs :: ![StoreInput],
    -- | transaction outputs
    Transaction -> [StoreOutput]
outputs :: ![StoreOutput],
    -- | this transaction has been deleted and is no longer valid
    Transaction -> Bool
deleted :: !Bool,
    -- | this transaction can be replaced in the mempool
    Transaction -> Bool
rbf :: !Bool,
    -- | time the transaction was first seen or time of block
    Transaction -> Word64
timestamp :: !Word64,
    -- | transaction id
    Transaction -> TxHash
txid :: !TxHash,
    -- | serialized transaction size (includes witness data)
    Transaction -> BlockHeight
size :: !Word32,
    -- | transaction weight
    Transaction -> BlockHeight
weight :: !Word32,
    -- | fees that this transaction pays (0 for coinbase)
    Transaction -> Word64
fee :: !Word64
  }
  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
$cshowsPrec :: Int -> Transaction -> ShowS
showsPrec :: Int -> Transaction -> ShowS
$cshow :: Transaction -> String
show :: Transaction -> String
$cshowList :: [Transaction] -> ShowS
showList :: [Transaction] -> ShowS
Show, Transaction -> Transaction -> Bool
(Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Bool) -> Eq Transaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transaction -> Transaction -> Bool
== :: Transaction -> Transaction -> Bool
$c/= :: Transaction -> Transaction -> Bool
/= :: 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
$ccompare :: Transaction -> Transaction -> Ordering
compare :: Transaction -> Transaction -> Ordering
$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
>= :: Transaction -> Transaction -> Bool
$cmax :: Transaction -> Transaction -> Transaction
max :: Transaction -> Transaction -> Transaction
$cmin :: Transaction -> Transaction -> Transaction
min :: Transaction -> Transaction -> 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
$cfrom :: forall x. Transaction -> Rep Transaction x
from :: forall x. Transaction -> Rep Transaction x
$cto :: forall x. Rep Transaction x -> Transaction
to :: forall x. Rep Transaction x -> Transaction
Generic, Eq Transaction
Eq Transaction
-> (Int -> Transaction -> Int)
-> (Transaction -> Int)
-> Hashable Transaction
Int -> Transaction -> Int
Transaction -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Transaction -> Int
hashWithSalt :: Int -> Transaction -> Int
$chash :: Transaction -> Int
hash :: Transaction -> Int
Hashable, Transaction -> ()
(Transaction -> ()) -> NFData Transaction
forall a. (a -> ()) -> NFData a
$crnf :: Transaction -> ()
rnf :: Transaction -> ()
NFData)

instance Serial Transaction where
  serialize :: forall (m :: * -> *). MonadPut m => Transaction -> m ()
serialize Transaction
t = do
    BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockRef -> m ()
serialize Transaction
t.block
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be Transaction
t.version
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be Transaction
t.locktime
    (StoreInput -> m ()) -> [StoreInput] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList StoreInput -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => StoreInput -> m ()
serialize Transaction
t.inputs
    (StoreOutput -> m ()) -> [StoreOutput] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList StoreOutput -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => StoreOutput -> m ()
serialize Transaction
t.outputs
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize Transaction
t.deleted
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize Transaction
t.rbf
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Transaction
t.timestamp
    TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize Transaction
t.txid
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be Transaction
t.size
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be Transaction
t.weight
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Transaction
t.fee
  deserialize :: forall (m :: * -> *). MonadGet m => m Transaction
deserialize = do
    BlockRef
block <- m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockRef
deserialize
    BlockHeight
version <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    BlockHeight
locktime <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    [StoreInput]
inputs <- m StoreInput -> m [StoreInput]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m StoreInput
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m StoreInput
deserialize
    [StoreOutput]
outputs <- m StoreOutput -> m [StoreOutput]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m StoreOutput
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m StoreOutput
deserialize
    Bool
deleted <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Bool
rbf <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Word64
timestamp <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    TxHash
txid <- m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxHash
deserialize
    BlockHeight
size <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    BlockHeight
weight <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Word64
fee <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Transaction -> m Transaction
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction {Bool
[StoreOutput]
[StoreInput]
BlockHeight
Word64
TxHash
BlockRef
$sel:version:Transaction :: BlockHeight
$sel:locktime:Transaction :: BlockHeight
$sel:block:Transaction :: BlockRef
$sel:deleted:Transaction :: Bool
$sel:rbf:Transaction :: Bool
$sel:timestamp:Transaction :: Word64
$sel:txid:Transaction :: TxHash
$sel:inputs:Transaction :: [StoreInput]
$sel:outputs:Transaction :: [StoreOutput]
$sel:size:Transaction :: BlockHeight
$sel:weight:Transaction :: BlockHeight
$sel:fee:Transaction :: Word64
block :: BlockRef
version :: BlockHeight
locktime :: BlockHeight
inputs :: [StoreInput]
outputs :: [StoreOutput]
deleted :: Bool
rbf :: Bool
timestamp :: Word64
txid :: TxHash
size :: BlockHeight
weight :: BlockHeight
fee :: Word64
..}

instance Serialize Transaction where
  put :: Putter Transaction
put = Putter Transaction
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Transaction -> m ()
serialize
  get :: Get Transaction
get = Get Transaction
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Transaction
deserialize

instance Binary Transaction where
  put :: Transaction -> Put
put = Transaction -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Transaction -> m ()
serialize
  get :: Get Transaction
get = Get Transaction
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Transaction
deserialize

transactionData :: Transaction -> Tx
transactionData :: Transaction -> Tx
transactionData Transaction
t =
  Tx
    { $sel:inputs:Tx :: [TxIn]
inputs = (StoreInput -> TxIn) -> [StoreInput] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> TxIn
i Transaction
t.inputs,
      $sel:outputs:Tx :: [TxOut]
outputs = (StoreOutput -> TxOut) -> [StoreOutput] -> [TxOut]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> TxOut
o Transaction
t.outputs,
      $sel:version:Tx :: BlockHeight
version = Transaction
t.version,
      $sel:locktime:Tx :: BlockHeight
locktime = Transaction
t.locktime,
      $sel:witness:Tx :: WitnessData
witness = WitnessData -> WitnessData
forall {t :: * -> *} {a}. Foldable t => [t a] -> [t a]
w (WitnessData -> WitnessData) -> WitnessData -> WitnessData
forall a b. (a -> b) -> a -> b
$ (StoreInput -> [WitnessStackItem]) -> [StoreInput] -> WitnessData
forall a b. (a -> b) -> [a] -> [b]
map (.witness) Transaction
t.inputs
    }
  where
    i :: StoreInput -> TxIn
i StoreCoinbase {[WitnessStackItem]
BlockHeight
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: StoreInput -> OutPoint
$sel:sequence:StoreCoinbase :: StoreInput -> BlockHeight
$sel:script:StoreCoinbase :: StoreInput -> WitnessStackItem
$sel:witness:StoreCoinbase :: StoreInput -> [WitnessStackItem]
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
witness :: [WitnessStackItem]
..} = TxIn {BlockHeight
WitnessStackItem
OutPoint
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
$sel:outpoint:TxIn :: OutPoint
$sel:script:TxIn :: WitnessStackItem
$sel:sequence:TxIn :: BlockHeight
..}
    i StoreInput {[WitnessStackItem]
Maybe Address
BlockHeight
Word64
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: StoreInput -> OutPoint
$sel:sequence:StoreCoinbase :: StoreInput -> BlockHeight
$sel:script:StoreCoinbase :: StoreInput -> WitnessStackItem
$sel:witness:StoreCoinbase :: StoreInput -> [WitnessStackItem]
$sel:pkscript:StoreCoinbase :: StoreInput -> WitnessStackItem
$sel:value:StoreCoinbase :: StoreInput -> Word64
$sel:address:StoreCoinbase :: StoreInput -> Maybe Address
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
pkscript :: WitnessStackItem
value :: Word64
witness :: [WitnessStackItem]
address :: Maybe Address
..} = TxIn {BlockHeight
WitnessStackItem
OutPoint
$sel:outpoint:TxIn :: OutPoint
$sel:script:TxIn :: WitnessStackItem
$sel:sequence:TxIn :: BlockHeight
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
..}
    o :: StoreOutput -> TxOut
o StoreOutput {Maybe Address
Maybe Spender
Word64
WitnessStackItem
$sel:value:StoreOutput :: StoreOutput -> Word64
$sel:script:StoreOutput :: StoreOutput -> WitnessStackItem
$sel:spender:StoreOutput :: StoreOutput -> Maybe Spender
$sel:address:StoreOutput :: StoreOutput -> Maybe Address
value :: Word64
script :: WitnessStackItem
spender :: Maybe Spender
address :: Maybe Address
..} = TxOut {Word64
WitnessStackItem
value :: Word64
script :: WitnessStackItem
$sel:value:TxOut :: Word64
$sel:script:TxOut :: WitnessStackItem
..}
    w :: [t a] -> [t a]
w [t a]
xs
      | (t a -> Bool) -> [t a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t a]
xs = []
      | Bool
otherwise = [t a]
xs

instance MarshalJSON Network Transaction where
  marshalValue :: Network -> Transaction -> Value
marshalValue Network
net Transaction
t =
    [Pair] -> Value
A.object
      [ Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.txid,
        Key
"size" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.size,
        Key
"version" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.version,
        Key
"locktime" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.locktime,
        Key
"fee" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.fee,
        Key
"inputs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (StoreInput -> Value) -> [StoreInput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> StoreInput -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net) Transaction
t.inputs,
        Key
"outputs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (StoreOutput -> Value) -> [StoreOutput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> StoreOutput -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net) Transaction
t.outputs,
        Key
"block" Key -> BlockRef -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.block,
        Key
"deleted" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.deleted,
        Key
"time" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.timestamp,
        Key
"rbf" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.rbf,
        Key
"weight" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Transaction
t.weight
      ]

  marshalEncoding :: Network -> Transaction -> Encoding
marshalEncoding Network
net Transaction
t =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Transaction
t.txid,
          Key
"size" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 Transaction
t.size,
          Key
"version" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 Transaction
t.version,
          Key
"locktime" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 Transaction
t.locktime,
          Key
"fee" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Transaction
t.fee,
          Key
"inputs" Key -> Encoding -> Series
`A.pair` (StoreInput -> Encoding) -> [StoreInput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list (Network -> StoreInput -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net) Transaction
t.inputs,
          Key
"outputs" Key -> Encoding -> Series
`A.pair` (StoreOutput -> Encoding) -> [StoreOutput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list (Network -> StoreOutput -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net) Transaction
t.outputs,
          Key
"block" Key -> Encoding -> Series
`A.pair` BlockRef -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Transaction
t.block,
          Key
"deleted" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool Transaction
t.deleted,
          Key
"time" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 Transaction
t.timestamp,
          Key
"rbf" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool Transaction
t.rbf,
          Key
"weight" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 Transaction
t.weight
        ]

  unmarshalValue :: Network -> Value -> Parser Transaction
unmarshalValue Network
net = String
-> (Object -> Parser Transaction) -> Value -> Parser Transaction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Transaction" ((Object -> Parser Transaction) -> Value -> Parser Transaction)
-> (Object -> Parser Transaction) -> Value -> Parser Transaction
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    BlockHeight
version <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    BlockHeight
locktime <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locktime"
    [StoreInput]
inputs <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs" Parser [Value]
-> ([Value] -> Parser [StoreInput]) -> Parser [StoreInput]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Network -> Value -> Parser StoreInput
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net)
    [StoreOutput]
outputs <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs" Parser [Value]
-> ([Value] -> Parser [StoreOutput]) -> Parser [StoreOutput]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Network -> Value -> Parser StoreOutput
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net)
    BlockRef
block <- Object
o Object -> Key -> Parser BlockRef
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block"
    Bool
deleted <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
    Word64
timestamp <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
    Bool
rbf <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rbf" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    BlockHeight
weight <- Object
o Object -> Key -> Parser (Maybe BlockHeight)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"weight" Parser (Maybe BlockHeight) -> BlockHeight -> Parser BlockHeight
forall a. Parser (Maybe a) -> a -> Parser a
.!= BlockHeight
0
    BlockHeight
size <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
    TxHash
txid <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid"
    Word64
fee <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fee"
    Transaction -> Parser Transaction
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Transaction {Bool
[StoreOutput]
[StoreInput]
BlockHeight
Word64
TxHash
BlockRef
$sel:version:Transaction :: BlockHeight
$sel:locktime:Transaction :: BlockHeight
$sel:block:Transaction :: BlockRef
$sel:deleted:Transaction :: Bool
$sel:rbf:Transaction :: Bool
$sel:timestamp:Transaction :: Word64
$sel:txid:Transaction :: TxHash
$sel:inputs:Transaction :: [StoreInput]
$sel:outputs:Transaction :: [StoreOutput]
$sel:size:Transaction :: BlockHeight
$sel:weight:Transaction :: BlockHeight
$sel:fee:Transaction :: Word64
version :: BlockHeight
locktime :: BlockHeight
inputs :: [StoreInput]
outputs :: [StoreOutput]
block :: BlockRef
deleted :: Bool
timestamp :: Word64
rbf :: Bool
weight :: BlockHeight
size :: BlockHeight
txid :: TxHash
fee :: Word64
..}

-- | Information about a connected peer.
data PeerInfo = PeerInfo
  { -- | user agent string
    PeerInfo -> WitnessStackItem
userAgent :: !ByteString,
    -- | network address
    PeerInfo -> String
address :: !String,
    -- | version number
    PeerInfo -> BlockHeight
version :: !Word32,
    -- | services field
    PeerInfo -> Word64
services :: !Word64,
    -- | will relay transactions
    PeerInfo -> Bool
relay :: !Bool
  }
  deriving (Int -> PeerInfo -> ShowS
[PeerInfo] -> ShowS
PeerInfo -> String
(Int -> PeerInfo -> ShowS)
-> (PeerInfo -> String) -> ([PeerInfo] -> ShowS) -> Show PeerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerInfo -> ShowS
showsPrec :: Int -> PeerInfo -> ShowS
$cshow :: PeerInfo -> String
show :: PeerInfo -> String
$cshowList :: [PeerInfo] -> ShowS
showList :: [PeerInfo] -> ShowS
Show, PeerInfo -> PeerInfo -> Bool
(PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> Bool) -> Eq PeerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerInfo -> PeerInfo -> Bool
== :: PeerInfo -> PeerInfo -> Bool
$c/= :: PeerInfo -> PeerInfo -> Bool
/= :: PeerInfo -> PeerInfo -> Bool
Eq, Eq PeerInfo
Eq PeerInfo
-> (PeerInfo -> PeerInfo -> Ordering)
-> (PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> Bool)
-> (PeerInfo -> PeerInfo -> PeerInfo)
-> (PeerInfo -> PeerInfo -> PeerInfo)
-> Ord PeerInfo
PeerInfo -> PeerInfo -> Bool
PeerInfo -> PeerInfo -> Ordering
PeerInfo -> PeerInfo -> PeerInfo
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
$ccompare :: PeerInfo -> PeerInfo -> Ordering
compare :: PeerInfo -> PeerInfo -> Ordering
$c< :: PeerInfo -> PeerInfo -> Bool
< :: PeerInfo -> PeerInfo -> Bool
$c<= :: PeerInfo -> PeerInfo -> Bool
<= :: PeerInfo -> PeerInfo -> Bool
$c> :: PeerInfo -> PeerInfo -> Bool
> :: PeerInfo -> PeerInfo -> Bool
$c>= :: PeerInfo -> PeerInfo -> Bool
>= :: PeerInfo -> PeerInfo -> Bool
$cmax :: PeerInfo -> PeerInfo -> PeerInfo
max :: PeerInfo -> PeerInfo -> PeerInfo
$cmin :: PeerInfo -> PeerInfo -> PeerInfo
min :: PeerInfo -> PeerInfo -> PeerInfo
Ord, (forall x. PeerInfo -> Rep PeerInfo x)
-> (forall x. Rep PeerInfo x -> PeerInfo) -> Generic PeerInfo
forall x. Rep PeerInfo x -> PeerInfo
forall x. PeerInfo -> Rep PeerInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeerInfo -> Rep PeerInfo x
from :: forall x. PeerInfo -> Rep PeerInfo x
$cto :: forall x. Rep PeerInfo x -> PeerInfo
to :: forall x. Rep PeerInfo x -> PeerInfo
Generic, PeerInfo -> ()
(PeerInfo -> ()) -> NFData PeerInfo
forall a. (a -> ()) -> NFData a
$crnf :: PeerInfo -> ()
rnf :: PeerInfo -> ()
NFData)

instance Serial PeerInfo where
  serialize :: forall (m :: * -> *). MonadPut m => PeerInfo -> m ()
serialize PeerInfo
p = do
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes PeerInfo
p.userAgent
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes (WitnessStackItem -> m ()) -> WitnessStackItem -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> WitnessStackItem
T.encodeUtf8 (Text -> WitnessStackItem) -> Text -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack PeerInfo
p.address
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be PeerInfo
p.version
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be PeerInfo
p.services
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize PeerInfo
p.relay
  deserialize :: forall (m :: * -> *). MonadGet m => m PeerInfo
deserialize = do
    WitnessStackItem
userAgent <- m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    String
address <- Text -> String
T.unpack (Text -> String)
-> (WitnessStackItem -> Text) -> WitnessStackItem -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> Text
T.decodeUtf8 (WitnessStackItem -> String) -> m WitnessStackItem -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    BlockHeight
version <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Word64
services <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Bool
relay <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    PeerInfo -> m PeerInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return PeerInfo {Bool
String
BlockHeight
Word64
WitnessStackItem
$sel:userAgent:PeerInfo :: WitnessStackItem
$sel:address:PeerInfo :: String
$sel:version:PeerInfo :: BlockHeight
$sel:services:PeerInfo :: Word64
$sel:relay:PeerInfo :: Bool
userAgent :: WitnessStackItem
address :: String
version :: BlockHeight
services :: Word64
relay :: Bool
..}

instance Serialize PeerInfo where
  put :: Putter PeerInfo
put = Putter PeerInfo
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => PeerInfo -> m ()
serialize
  get :: Get PeerInfo
get = Get PeerInfo
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m PeerInfo
deserialize

instance Binary PeerInfo where
  put :: PeerInfo -> Put
put = PeerInfo -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => PeerInfo -> m ()
serialize
  get :: Get PeerInfo
get = Get PeerInfo
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m PeerInfo
deserialize

instance ToJSON PeerInfo where
  toJSON :: PeerInfo -> Value
toJSON PeerInfo
p =
    [Pair] -> Value
A.object
      [ Key
"useragent" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (WitnessStackItem -> Text
T.decodeUtf8 PeerInfo
p.userAgent),
        Key
"address" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PeerInfo
p.address,
        Key
"version" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PeerInfo
p.version,
        Key
"services"
          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (WitnessStackItem -> Text
encodeHex (WitnessStackItem -> Text) -> WitnessStackItem -> Text
forall a b. (a -> b) -> a -> b
$ Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ Word64 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
serialize PeerInfo
p.services),
        Key
"relay" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= PeerInfo
p.relay
      ]
  toEncoding :: PeerInfo -> Encoding
toEncoding PeerInfo
p =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"useragent" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text (WitnessStackItem -> Text
T.decodeUtf8 PeerInfo
p.userAgent),
          Key
"address" Key -> Encoding -> Series
`A.pair` String -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding PeerInfo
p.address,
          Key
"version" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 PeerInfo
p.version,
          Key
"services" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (Put -> ByteString
runPutL (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
serialize PeerInfo
p.services),
          Key
"relay" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool PeerInfo
p.relay
        ]

instance FromJSON PeerInfo where
  parseJSON :: Value -> Parser PeerInfo
parseJSON =
    String -> (Object -> Parser PeerInfo) -> Value -> Parser PeerInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PeerInfo" ((Object -> Parser PeerInfo) -> Value -> Parser PeerInfo)
-> (Object -> Parser PeerInfo) -> Value -> Parser PeerInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      String Text
userAgentText <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"useragent"
      let userAgent :: WitnessStackItem
userAgent = Text -> WitnessStackItem
T.encodeUtf8 Text
userAgentText
      String
address <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
      BlockHeight
version <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
      Word64
services <-
        Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"services" Parser Text
-> (Text -> Parser WitnessStackItem) -> Parser WitnessStackItem
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser WitnessStackItem
jsonHex Parser WitnessStackItem
-> (WitnessStackItem -> Parser Word64) -> Parser Word64
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WitnessStackItem
b ->
          case Get Word64 -> WitnessStackItem -> Either String Word64
forall a. Get a -> WitnessStackItem -> Either String a
runGetS Get Word64
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Word64
deserialize WitnessStackItem
b of
            Left String
e -> String -> Parser Word64
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Word64) -> String -> Parser Word64
forall a b. (a -> b) -> a -> b
$ String
"Could not decode services: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
            Right Word64
s -> Word64 -> Parser Word64
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
s
      Bool
relay <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relay"
      PeerInfo -> Parser PeerInfo
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return PeerInfo {Bool
String
BlockHeight
Word64
WitnessStackItem
$sel:userAgent:PeerInfo :: WitnessStackItem
$sel:address:PeerInfo :: String
$sel:version:PeerInfo :: BlockHeight
$sel:services:PeerInfo :: Word64
$sel:relay:PeerInfo :: Bool
userAgent :: WitnessStackItem
address :: String
version :: BlockHeight
services :: Word64
relay :: Bool
..}

-- | Address balances for an extended public key.
data XPubBal = XPubBal
  { XPubBal -> [BlockHeight]
path :: ![KeyIndex],
    XPubBal -> Balance
balance :: !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
$cshowsPrec :: Int -> XPubBal -> ShowS
showsPrec :: Int -> XPubBal -> ShowS
$cshow :: XPubBal -> String
show :: XPubBal -> String
$cshowList :: [XPubBal] -> ShowS
showList :: [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
$ccompare :: XPubBal -> XPubBal -> Ordering
compare :: XPubBal -> XPubBal -> Ordering
$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
>= :: XPubBal -> XPubBal -> Bool
$cmax :: XPubBal -> XPubBal -> XPubBal
max :: XPubBal -> XPubBal -> XPubBal
$cmin :: XPubBal -> XPubBal -> XPubBal
min :: XPubBal -> XPubBal -> XPubBal
Ord, XPubBal -> XPubBal -> Bool
(XPubBal -> XPubBal -> Bool)
-> (XPubBal -> XPubBal -> Bool) -> Eq XPubBal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPubBal -> XPubBal -> Bool
== :: XPubBal -> XPubBal -> Bool
$c/= :: XPubBal -> XPubBal -> Bool
/= :: 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
$cfrom :: forall x. XPubBal -> Rep XPubBal x
from :: forall x. XPubBal -> Rep XPubBal x
$cto :: forall x. Rep XPubBal x -> XPubBal
to :: forall x. Rep XPubBal x -> XPubBal
Generic, XPubBal -> ()
(XPubBal -> ()) -> NFData XPubBal
forall a. (a -> ()) -> NFData a
$crnf :: XPubBal -> ()
rnf :: XPubBal -> ()
NFData)

instance Serial XPubBal where
  serialize :: forall (m :: * -> *). MonadPut m => XPubBal -> m ()
serialize XPubBal
b = do
    (BlockHeight -> m ()) -> [BlockHeight] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be XPubBal
b.path
    Balance -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Balance -> m ()
serialize XPubBal
b.balance
  deserialize :: forall (m :: * -> *). MonadGet m => m XPubBal
deserialize = do
    [BlockHeight]
path <- m BlockHeight -> m [BlockHeight]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Balance
balance <- m Balance
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Balance
deserialize
    XPubBal -> m XPubBal
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubBal {[BlockHeight]
Balance
$sel:path:XPubBal :: [BlockHeight]
$sel:balance:XPubBal :: Balance
path :: [BlockHeight]
balance :: Balance
..}

instance Serialize XPubBal where
  put :: Putter XPubBal
put = Putter XPubBal
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubBal -> m ()
serialize
  get :: Get XPubBal
get = Get XPubBal
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubBal
deserialize

instance Binary XPubBal where
  put :: XPubBal -> Put
put = XPubBal -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubBal -> m ()
serialize
  get :: Get XPubBal
get = Get XPubBal
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubBal
deserialize

instance MarshalJSON Network XPubBal where
  marshalValue :: Network -> XPubBal -> Value
marshalValue Network
net XPubBal
b =
    [Pair] -> Value
A.object
      [ Key
"path" Key -> [BlockHeight] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubBal
b.path,
        Key
"balance" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Network -> Balance -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net XPubBal
b.balance
      ]

  marshalEncoding :: Network -> XPubBal -> Encoding
marshalEncoding Network
net XPubBal
b =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"path" Key -> Encoding -> Series
`A.pair` (BlockHeight -> Encoding) -> [BlockHeight] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list BlockHeight -> Encoding
A.word32 XPubBal
b.path,
          Key
"balance" Key -> Encoding -> Series
`A.pair` Network -> Balance -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net XPubBal
b.balance
        ]

  unmarshalValue :: Network -> Value -> Parser XPubBal
unmarshalValue Network
net =
    String -> (Object -> Parser XPubBal) -> Value -> Parser XPubBal
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"XPubBal" ((Object -> Parser XPubBal) -> Value -> Parser XPubBal)
-> (Object -> Parser XPubBal) -> Value -> Parser XPubBal
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [BlockHeight]
path <- Object
o Object -> Key -> Parser [BlockHeight]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      Balance
balance <- Network -> Value -> Parser Balance
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue 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 -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance"
      XPubBal -> Parser XPubBal
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubBal {[BlockHeight]
Balance
$sel:path:XPubBal :: [BlockHeight]
$sel:balance:XPubBal :: Balance
path :: [BlockHeight]
balance :: Balance
..}

-- | Unspent transaction for extended public key.
data XPubUnspent = XPubUnspent
  { XPubUnspent -> Unspent
unspent :: !Unspent,
    XPubUnspent -> [BlockHeight]
path :: ![KeyIndex]
  }
  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
$cshowsPrec :: Int -> XPubUnspent -> ShowS
showsPrec :: Int -> XPubUnspent -> ShowS
$cshow :: XPubUnspent -> String
show :: XPubUnspent -> String
$cshowList :: [XPubUnspent] -> ShowS
showList :: [XPubUnspent] -> ShowS
Show, XPubUnspent -> XPubUnspent -> Bool
(XPubUnspent -> XPubUnspent -> Bool)
-> (XPubUnspent -> XPubUnspent -> Bool) -> Eq XPubUnspent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPubUnspent -> XPubUnspent -> Bool
== :: XPubUnspent -> XPubUnspent -> Bool
$c/= :: XPubUnspent -> XPubUnspent -> Bool
/= :: XPubUnspent -> XPubUnspent -> Bool
Eq, Eq XPubUnspent
Eq XPubUnspent
-> (XPubUnspent -> XPubUnspent -> Ordering)
-> (XPubUnspent -> XPubUnspent -> Bool)
-> (XPubUnspent -> XPubUnspent -> Bool)
-> (XPubUnspent -> XPubUnspent -> Bool)
-> (XPubUnspent -> XPubUnspent -> Bool)
-> (XPubUnspent -> XPubUnspent -> XPubUnspent)
-> (XPubUnspent -> XPubUnspent -> XPubUnspent)
-> Ord XPubUnspent
XPubUnspent -> XPubUnspent -> Bool
XPubUnspent -> XPubUnspent -> Ordering
XPubUnspent -> XPubUnspent -> XPubUnspent
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
$ccompare :: XPubUnspent -> XPubUnspent -> Ordering
compare :: XPubUnspent -> XPubUnspent -> Ordering
$c< :: XPubUnspent -> XPubUnspent -> Bool
< :: XPubUnspent -> XPubUnspent -> Bool
$c<= :: XPubUnspent -> XPubUnspent -> Bool
<= :: XPubUnspent -> XPubUnspent -> Bool
$c> :: XPubUnspent -> XPubUnspent -> Bool
> :: XPubUnspent -> XPubUnspent -> Bool
$c>= :: XPubUnspent -> XPubUnspent -> Bool
>= :: XPubUnspent -> XPubUnspent -> Bool
$cmax :: XPubUnspent -> XPubUnspent -> XPubUnspent
max :: XPubUnspent -> XPubUnspent -> XPubUnspent
$cmin :: XPubUnspent -> XPubUnspent -> XPubUnspent
min :: XPubUnspent -> XPubUnspent -> XPubUnspent
Ord, (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
$cfrom :: forall x. XPubUnspent -> Rep XPubUnspent x
from :: forall x. XPubUnspent -> Rep XPubUnspent x
$cto :: forall x. Rep XPubUnspent x -> XPubUnspent
to :: forall x. Rep XPubUnspent x -> XPubUnspent
Generic, XPubUnspent -> ()
(XPubUnspent -> ()) -> NFData XPubUnspent
forall a. (a -> ()) -> NFData a
$crnf :: XPubUnspent -> ()
rnf :: XPubUnspent -> ()
NFData)

instance Serial XPubUnspent where
  serialize :: forall (m :: * -> *). MonadPut m => XPubUnspent -> m ()
serialize XPubUnspent
u = do
    (BlockHeight -> m ()) -> [BlockHeight] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be XPubUnspent
u.path
    Unspent -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Unspent -> m ()
serialize XPubUnspent
u.unspent
  deserialize :: forall (m :: * -> *). MonadGet m => m XPubUnspent
deserialize = do
    [BlockHeight]
path <- m BlockHeight -> m [BlockHeight]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Unspent
unspent <- m Unspent
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Unspent
deserialize
    XPubUnspent -> m XPubUnspent
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubUnspent {[BlockHeight]
Unspent
$sel:unspent:XPubUnspent :: Unspent
$sel:path:XPubUnspent :: [BlockHeight]
path :: [BlockHeight]
unspent :: Unspent
..}

instance Serialize XPubUnspent where
  put :: Putter XPubUnspent
put = Putter XPubUnspent
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubUnspent -> m ()
serialize
  get :: Get XPubUnspent
get = Get XPubUnspent
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubUnspent
deserialize

instance Binary XPubUnspent where
  put :: XPubUnspent -> Put
put = XPubUnspent -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubUnspent -> m ()
serialize
  get :: Get XPubUnspent
get = Get XPubUnspent
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubUnspent
deserialize

instance MarshalJSON Network XPubUnspent where
  marshalValue :: Network -> XPubUnspent -> Value
marshalValue Network
net XPubUnspent
u =
    [Pair] -> Value
A.object
      [ Key
"unspent" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Network -> Unspent -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net XPubUnspent
u.unspent,
        Key
"path" Key -> [BlockHeight] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubUnspent
u.path
      ]

  marshalEncoding :: Network -> XPubUnspent -> Encoding
marshalEncoding Network
net XPubUnspent
u =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"unspent" Key -> Encoding -> Series
`A.pair` Network -> Unspent -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net XPubUnspent
u.unspent,
          Key
"path" Key -> Encoding -> Series
`A.pair` (BlockHeight -> Encoding) -> [BlockHeight] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list BlockHeight -> Encoding
A.word32 XPubUnspent
u.path
        ]

  unmarshalValue :: Network -> Value -> Parser XPubUnspent
unmarshalValue Network
net =
    String
-> (Object -> Parser XPubUnspent) -> Value -> Parser XPubUnspent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"XPubUnspent" ((Object -> Parser XPubUnspent) -> Value -> Parser XPubUnspent)
-> (Object -> Parser XPubUnspent) -> Value -> Parser XPubUnspent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Unspent
unspent <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unspent" Parser Value -> (Value -> Parser Unspent) -> Parser Unspent
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Network -> Value -> Parser Unspent
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net
      [BlockHeight]
path <- Object
o Object -> Key -> Parser [BlockHeight]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      XPubUnspent -> Parser XPubUnspent
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubUnspent {[BlockHeight]
Unspent
$sel:unspent:XPubUnspent :: Unspent
$sel:path:XPubUnspent :: [BlockHeight]
unspent :: Unspent
path :: [BlockHeight]
..}

data XPubSummary = XPubSummary
  { XPubSummary -> Word64
confirmed :: !Word64,
    XPubSummary -> Word64
unconfirmed :: !Word64,
    XPubSummary -> Word64
received :: !Word64,
    XPubSummary -> Word64
utxo :: !Word64,
    XPubSummary -> BlockHeight
external :: !Word32,
    XPubSummary -> BlockHeight
change :: !Word32
  }
  deriving (XPubSummary -> XPubSummary -> Bool
(XPubSummary -> XPubSummary -> Bool)
-> (XPubSummary -> XPubSummary -> Bool) -> Eq XPubSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPubSummary -> XPubSummary -> Bool
== :: XPubSummary -> XPubSummary -> Bool
$c/= :: XPubSummary -> XPubSummary -> Bool
/= :: 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
$cshowsPrec :: Int -> XPubSummary -> ShowS
showsPrec :: Int -> XPubSummary -> ShowS
$cshow :: XPubSummary -> String
show :: XPubSummary -> String
$cshowList :: [XPubSummary] -> ShowS
showList :: [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
$cfrom :: forall x. XPubSummary -> Rep XPubSummary x
from :: forall x. XPubSummary -> Rep XPubSummary x
$cto :: forall x. Rep XPubSummary x -> XPubSummary
to :: forall x. Rep XPubSummary x -> XPubSummary
Generic, XPubSummary -> ()
(XPubSummary -> ()) -> NFData XPubSummary
forall a. (a -> ()) -> NFData a
$crnf :: XPubSummary -> ()
rnf :: XPubSummary -> ()
NFData)

instance Serial XPubSummary where
  serialize :: forall (m :: * -> *). MonadPut m => XPubSummary -> m ()
serialize XPubSummary
s = do
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be XPubSummary
s.confirmed
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be XPubSummary
s.unconfirmed
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be XPubSummary
s.received
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be XPubSummary
s.utxo
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be XPubSummary
s.external
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be XPubSummary
s.change
  deserialize :: forall (m :: * -> *). MonadGet m => m XPubSummary
deserialize = do
    Word64
confirmed <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
unconfirmed <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
received <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    Word64
utxo <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    BlockHeight
external <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    BlockHeight
change <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    XPubSummary -> m XPubSummary
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubSummary {BlockHeight
Word64
$sel:confirmed:XPubSummary :: Word64
$sel:unconfirmed:XPubSummary :: Word64
$sel:received:XPubSummary :: Word64
$sel:utxo:XPubSummary :: Word64
$sel:external:XPubSummary :: BlockHeight
$sel:change:XPubSummary :: BlockHeight
confirmed :: Word64
unconfirmed :: Word64
received :: Word64
utxo :: Word64
external :: BlockHeight
change :: BlockHeight
..}

instance Binary XPubSummary where
  put :: XPubSummary -> Put
put = XPubSummary -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubSummary -> m ()
serialize
  get :: Get XPubSummary
get = Get XPubSummary
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubSummary
deserialize

instance Serialize XPubSummary where
  put :: Putter XPubSummary
put = Putter XPubSummary
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => XPubSummary -> m ()
serialize
  get :: Get XPubSummary
get = Get XPubSummary
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m XPubSummary
deserialize

instance ToJSON XPubSummary where
  toJSON :: XPubSummary -> Value
toJSON XPubSummary
s =
    [Pair] -> Value
A.object
      [ Key
"balance"
          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
A.object
            [ Key
"confirmed" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubSummary
s.confirmed,
              Key
"unconfirmed" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubSummary
s.unconfirmed,
              Key
"received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubSummary
s.received,
              Key
"utxo" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubSummary
s.utxo
            ],
        Key
"indices"
          Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
A.object
            [ Key
"change" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubSummary
s.change,
              Key
"external" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= XPubSummary
s.external
            ]
      ]
  toEncoding :: XPubSummary -> Encoding
toEncoding XPubSummary
s =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key -> Encoding -> Series
A.pair Key
"balance" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$
            Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
              [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
                [ Key
"confirmed" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 XPubSummary
s.confirmed,
                  Key
"unconfirmed" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 XPubSummary
s.unconfirmed,
                  Key
"received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 XPubSummary
s.received,
                  Key
"utxo" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 XPubSummary
s.utxo
                ],
          Key -> Encoding -> Series
A.pair Key
"indices" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$
            Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
              [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
                [ Key
"change" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 XPubSummary
s.change,
                  Key
"external" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 XPubSummary
s.external
                ]
        ]

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 String
"XPubSummary" ((Object -> Parser XPubSummary) -> Value -> Parser XPubSummary)
-> (Object -> Parser XPubSummary) -> Value -> Parser XPubSummary
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Object
b <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance"
      Object
i <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"indices"
      Word64
confirmed <- Object
b Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confirmed"
      Word64
unconfirmed <- Object
b Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unconfirmed"
      Word64
received <- Object
b Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"received"
      Word64
utxo <- Object
b Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"utxo"
      BlockHeight
change <- Object
i Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"change"
      BlockHeight
external <- Object
i Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"external"
      XPubSummary -> Parser XPubSummary
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubSummary {BlockHeight
Word64
$sel:confirmed:XPubSummary :: Word64
$sel:unconfirmed:XPubSummary :: Word64
$sel:received:XPubSummary :: Word64
$sel:utxo:XPubSummary :: Word64
$sel:external:XPubSummary :: BlockHeight
$sel:change:XPubSummary :: BlockHeight
confirmed :: Word64
unconfirmed :: Word64
received :: Word64
utxo :: Word64
change :: BlockHeight
external :: BlockHeight
..}

class Healthy a where
  isOK :: a -> Bool

data BlockHealth = BlockHealth
  { BlockHealth -> BlockHeight
headers :: !BlockHeight,
    BlockHealth -> BlockHeight
blocks :: !BlockHeight,
    BlockHealth -> Int32
max :: !Int32
  }
  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
$cshowsPrec :: Int -> BlockHealth -> ShowS
showsPrec :: Int -> BlockHealth -> ShowS
$cshow :: BlockHealth -> String
show :: BlockHealth -> String
$cshowList :: [BlockHealth] -> ShowS
showList :: [BlockHealth] -> ShowS
Show, BlockHealth -> BlockHealth -> Bool
(BlockHealth -> BlockHealth -> Bool)
-> (BlockHealth -> BlockHealth -> Bool) -> Eq BlockHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockHealth -> BlockHealth -> Bool
== :: BlockHealth -> BlockHealth -> Bool
$c/= :: BlockHealth -> BlockHealth -> Bool
/= :: 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
$cfrom :: forall x. BlockHealth -> Rep BlockHealth x
from :: forall x. BlockHealth -> Rep BlockHealth x
$cto :: forall x. Rep BlockHealth x -> BlockHealth
to :: forall x. Rep BlockHealth x -> BlockHealth
Generic, BlockHealth -> ()
(BlockHealth -> ()) -> NFData BlockHealth
forall a. (a -> ()) -> NFData a
$crnf :: BlockHealth -> ()
rnf :: BlockHealth -> ()
NFData)

instance Serial BlockHealth where
  serialize :: forall (m :: * -> *). MonadPut m => BlockHealth -> m ()
serialize BlockHealth
h = do
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize (BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h)
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be BlockHealth
h.headers
    BlockHeight -> m ()
forall (m :: * -> *). MonadPut m => BlockHeight -> m ()
putWord32be BlockHealth
h.blocks
    Int32 -> m ()
forall (m :: * -> *). MonadPut m => Int32 -> m ()
putInt32be BlockHealth
h.max
  deserialize :: forall (m :: * -> *). MonadGet m => m BlockHealth
deserialize = do
    Bool
k <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    BlockHeight
headers <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    BlockHeight
blocks <- m BlockHeight
forall (m :: * -> *). MonadGet m => m BlockHeight
getWord32be
    Int32
max <- m Int32
forall (m :: * -> *). MonadGet m => m Int32
getInt32be
    let h :: BlockHealth
h = BlockHealth {Int32
BlockHeight
$sel:headers:BlockHealth :: BlockHeight
$sel:blocks:BlockHealth :: BlockHeight
$sel:max:BlockHealth :: Int32
headers :: BlockHeight
blocks :: BlockHeight
max :: Int32
..}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Inconsistent health check"
    BlockHealth -> m BlockHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockHealth
h

instance Serialize BlockHealth where
  put :: Putter BlockHealth
put = Putter BlockHealth
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHealth -> m ()
serialize
  get :: Get BlockHealth
get = Get BlockHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHealth
deserialize

instance Binary BlockHealth where
  put :: BlockHealth -> Put
put = BlockHealth -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHealth -> m ()
serialize
  get :: Get BlockHealth
get = Get BlockHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHealth
deserialize

instance Healthy BlockHealth where
  isOK :: BlockHealth -> Bool
isOK BlockHealth
x =
    Int32
h Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
b Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= BlockHealth
x.max
    where
      h :: Int32
h = BlockHeight -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHealth
x.headers
      b :: Int32
b = BlockHeight -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral BlockHealth
x.blocks

instance ToJSON BlockHealth where
  toJSON :: BlockHealth -> Value
toJSON BlockHealth
h =
    [Pair] -> Value
A.object
      [ Key
"headers" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHealth
h.headers,
        Key
"blocks" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHealth
h.blocks,
        Key
"diff" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
diff,
        Key
"max" Key -> Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHealth
h.max,
        Key
"ok" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h
      ]
    where
      diff :: Integer
diff = BlockHeight -> Integer
forall a. Integral a => a -> Integer
toInteger BlockHealth
h.headers Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- BlockHeight -> Integer
forall a. Integral a => a -> Integer
toInteger BlockHealth
h.blocks

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 String
"BlockHealth" ((Object -> Parser BlockHealth) -> Value -> Parser BlockHealth)
-> (Object -> Parser BlockHealth) -> Value -> Parser BlockHealth
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHeight
headers <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"headers"
      BlockHeight
blocks <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocks"
      Int32
max <- Object
o Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max"
      BlockHealth -> Parser BlockHealth
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockHealth {Int32
BlockHeight
$sel:headers:BlockHealth :: BlockHeight
$sel:blocks:BlockHealth :: BlockHeight
$sel:max:BlockHealth :: Int32
headers :: BlockHeight
blocks :: BlockHeight
max :: Int32
..}

data TimeHealth = TimeHealth
  { TimeHealth -> Int64
age :: !Int64,
    TimeHealth -> Int64
max :: !Int64
  }
  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
$cshowsPrec :: Int -> TimeHealth -> ShowS
showsPrec :: Int -> TimeHealth -> ShowS
$cshow :: TimeHealth -> String
show :: TimeHealth -> String
$cshowList :: [TimeHealth] -> ShowS
showList :: [TimeHealth] -> ShowS
Show, TimeHealth -> TimeHealth -> Bool
(TimeHealth -> TimeHealth -> Bool)
-> (TimeHealth -> TimeHealth -> Bool) -> Eq TimeHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeHealth -> TimeHealth -> Bool
== :: TimeHealth -> TimeHealth -> Bool
$c/= :: TimeHealth -> TimeHealth -> Bool
/= :: 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
$cfrom :: forall x. TimeHealth -> Rep TimeHealth x
from :: forall x. TimeHealth -> Rep TimeHealth x
$cto :: forall x. Rep TimeHealth x -> TimeHealth
to :: forall x. Rep TimeHealth x -> TimeHealth
Generic, TimeHealth -> ()
(TimeHealth -> ()) -> NFData TimeHealth
forall a. (a -> ()) -> NFData a
$crnf :: TimeHealth -> ()
rnf :: TimeHealth -> ()
NFData)

instance Serial TimeHealth where
  serialize :: forall (m :: * -> *). MonadPut m => TimeHealth -> m ()
serialize TimeHealth
h = do
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize (TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
h)
    Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt64be TimeHealth
h.age
    Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt64be TimeHealth
h.max
  deserialize :: forall (m :: * -> *). MonadGet m => m TimeHealth
deserialize = do
    Bool
k <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Int64
age <- m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt64be
    Int64
max <- m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt64be
    let t :: TimeHealth
t = TimeHealth {Int64
$sel:age:TimeHealth :: Int64
$sel:max:TimeHealth :: Int64
age :: Int64
max :: Int64
..}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
t) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Inconsistent health check"
    TimeHealth -> m TimeHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeHealth
t

instance Binary TimeHealth where
  put :: TimeHealth -> Put
put = TimeHealth -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TimeHealth -> m ()
serialize
  get :: Get TimeHealth
get = Get TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TimeHealth
deserialize

instance Serialize TimeHealth where
  put :: Putter TimeHealth
put = Putter TimeHealth
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TimeHealth -> m ()
serialize
  get :: Get TimeHealth
get = Get TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TimeHealth
deserialize

instance Healthy TimeHealth where
  isOK :: TimeHealth -> Bool
isOK TimeHealth {Int64
$sel:age:TimeHealth :: TimeHealth -> Int64
$sel:max:TimeHealth :: TimeHealth -> Int64
age :: Int64
max :: Int64
..} =
    Int64
age Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
max

instance ToJSON TimeHealth where
  toJSON :: TimeHealth -> Value
toJSON TimeHealth
h =
    [Pair] -> Value
A.object
      [ Key
"age" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TimeHealth
h.age,
        Key
"max" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TimeHealth
h.max,
        Key
"ok" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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 String
"TimeHealth" ((Object -> Parser TimeHealth) -> Value -> Parser TimeHealth)
-> (Object -> Parser TimeHealth) -> Value -> Parser TimeHealth
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Int64
age <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"age"
      Int64
max <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max"
      TimeHealth -> Parser TimeHealth
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TimeHealth {Int64
$sel:age:TimeHealth :: Int64
$sel:max:TimeHealth :: Int64
age :: Int64
max :: Int64
..}

data CountHealth = CountHealth
  { CountHealth -> Int64
count :: !Int64,
    CountHealth -> Int64
min :: !Int64
  }
  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
$cshowsPrec :: Int -> CountHealth -> ShowS
showsPrec :: Int -> CountHealth -> ShowS
$cshow :: CountHealth -> String
show :: CountHealth -> String
$cshowList :: [CountHealth] -> ShowS
showList :: [CountHealth] -> ShowS
Show, CountHealth -> CountHealth -> Bool
(CountHealth -> CountHealth -> Bool)
-> (CountHealth -> CountHealth -> Bool) -> Eq CountHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CountHealth -> CountHealth -> Bool
== :: CountHealth -> CountHealth -> Bool
$c/= :: CountHealth -> CountHealth -> Bool
/= :: 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
$cfrom :: forall x. CountHealth -> Rep CountHealth x
from :: forall x. CountHealth -> Rep CountHealth x
$cto :: forall x. Rep CountHealth x -> CountHealth
to :: forall x. Rep CountHealth x -> CountHealth
Generic, CountHealth -> ()
(CountHealth -> ()) -> NFData CountHealth
forall a. (a -> ()) -> NFData a
$crnf :: CountHealth -> ()
rnf :: CountHealth -> ()
NFData)

instance Serial CountHealth where
  serialize :: forall (m :: * -> *). MonadPut m => CountHealth -> m ()
serialize CountHealth
h = do
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize (CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
h)
    Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt64be CountHealth
h.count
    Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt64be CountHealth
h.min
  deserialize :: forall (m :: * -> *). MonadGet m => m CountHealth
deserialize = do
    Bool
k <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Int64
count <- m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt64be
    Int64
min <- m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt64be
    let c :: CountHealth
c = CountHealth {Int64
$sel:count:CountHealth :: Int64
$sel:min:CountHealth :: Int64
count :: Int64
min :: Int64
..}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
c) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Inconsistent health check"
    CountHealth -> m CountHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CountHealth
c

instance Serialize CountHealth where
  put :: Putter CountHealth
put = Putter CountHealth
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => CountHealth -> m ()
serialize
  get :: Get CountHealth
get = Get CountHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CountHealth
deserialize

instance Binary CountHealth where
  put :: CountHealth -> Put
put = CountHealth -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => CountHealth -> m ()
serialize
  get :: Get CountHealth
get = Get CountHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CountHealth
deserialize

instance Healthy CountHealth where
  isOK :: CountHealth -> Bool
isOK CountHealth {Int64
$sel:count:CountHealth :: CountHealth -> Int64
$sel:min:CountHealth :: CountHealth -> Int64
count :: Int64
min :: Int64
..} = Int64
min Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
count

instance ToJSON CountHealth where
  toJSON :: CountHealth -> Value
toJSON CountHealth
h =
    [Pair] -> Value
A.object
      [ Key
"count" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CountHealth
h.count,
        Key
"min" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CountHealth
h.min,
        Key
"ok" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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 String
"CountHealth" ((Object -> Parser CountHealth) -> Value -> Parser CountHealth)
-> (Object -> Parser CountHealth) -> Value -> Parser CountHealth
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Int64
count <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"
      Int64
min <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"min"
      CountHealth -> Parser CountHealth
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return CountHealth {Int64
$sel:count:CountHealth :: Int64
$sel:min:CountHealth :: Int64
count :: Int64
min :: Int64
..}

data MaxHealth = MaxHealth
  { MaxHealth -> Int64
count :: !Int64,
    MaxHealth -> Int64
max :: !Int64
  }
  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
$cshowsPrec :: Int -> MaxHealth -> ShowS
showsPrec :: Int -> MaxHealth -> ShowS
$cshow :: MaxHealth -> String
show :: MaxHealth -> String
$cshowList :: [MaxHealth] -> ShowS
showList :: [MaxHealth] -> ShowS
Show, MaxHealth -> MaxHealth -> Bool
(MaxHealth -> MaxHealth -> Bool)
-> (MaxHealth -> MaxHealth -> Bool) -> Eq MaxHealth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxHealth -> MaxHealth -> Bool
== :: MaxHealth -> MaxHealth -> Bool
$c/= :: MaxHealth -> MaxHealth -> Bool
/= :: 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
$cfrom :: forall x. MaxHealth -> Rep MaxHealth x
from :: forall x. MaxHealth -> Rep MaxHealth x
$cto :: forall x. Rep MaxHealth x -> MaxHealth
to :: forall x. Rep MaxHealth x -> MaxHealth
Generic, MaxHealth -> ()
(MaxHealth -> ()) -> NFData MaxHealth
forall a. (a -> ()) -> NFData a
$crnf :: MaxHealth -> ()
rnf :: MaxHealth -> ()
NFData)

instance Serial MaxHealth where
  serialize :: forall (m :: * -> *). MonadPut m => MaxHealth -> m ()
serialize MaxHealth
h = do
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
h
    Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt64be MaxHealth
h.count
    Int64 -> m ()
forall (m :: * -> *). MonadPut m => Int64 -> m ()
putInt64be MaxHealth
h.max
  deserialize :: forall (m :: * -> *). MonadGet m => m MaxHealth
deserialize = do
    Bool
k <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    Int64
count <- m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt64be
    Int64
max <- m Int64
forall (m :: * -> *). MonadGet m => m Int64
getInt64be
    let h :: MaxHealth
h = MaxHealth {Int64
$sel:count:MaxHealth :: Int64
$sel:max:MaxHealth :: Int64
count :: Int64
max :: Int64
..}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
h) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Inconsistent health check"
    MaxHealth -> m MaxHealth
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MaxHealth
h

instance Binary MaxHealth where
  put :: MaxHealth -> Put
put = MaxHealth -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MaxHealth -> m ()
serialize
  get :: Get MaxHealth
get = Get MaxHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MaxHealth
deserialize

instance Serialize MaxHealth where
  put :: Putter MaxHealth
put = Putter MaxHealth
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MaxHealth -> m ()
serialize
  get :: Get MaxHealth
get = Get MaxHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MaxHealth
deserialize

instance Healthy MaxHealth where
  isOK :: MaxHealth -> Bool
isOK MaxHealth {Int64
$sel:count:MaxHealth :: MaxHealth -> Int64
$sel:max:MaxHealth :: MaxHealth -> Int64
count :: Int64
max :: Int64
..} = Int64
count Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
max

instance ToJSON MaxHealth where
  toJSON :: MaxHealth -> Value
toJSON MaxHealth
h =
    [Pair] -> Value
A.object
      [ Key
"count" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MaxHealth
h.count,
        Key
"max" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MaxHealth
h.max,
        Key
"ok" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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 String
"MaxHealth" ((Object -> Parser MaxHealth) -> Value -> Parser MaxHealth)
-> (Object -> Parser MaxHealth) -> Value -> Parser MaxHealth
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Int64
count <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"
      Int64
max <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max"
      MaxHealth -> Parser MaxHealth
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return MaxHealth {Int64
$sel:count:MaxHealth :: Int64
$sel:max:MaxHealth :: Int64
count :: Int64
max :: Int64
..}

data HealthCheck = HealthCheck
  { HealthCheck -> BlockHealth
blocks :: !BlockHealth,
    HealthCheck -> TimeHealth
lastBlock :: !TimeHealth,
    HealthCheck -> TimeHealth
lastTx :: !TimeHealth,
    HealthCheck -> MaxHealth
pendingTxs :: !MaxHealth,
    HealthCheck -> CountHealth
peers :: !CountHealth,
    HealthCheck -> String
network :: !String,
    HealthCheck -> String
version :: !String,
    HealthCheck -> Word64
time :: !Word64
  }
  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
$cshowsPrec :: Int -> HealthCheck -> ShowS
showsPrec :: Int -> HealthCheck -> ShowS
$cshow :: HealthCheck -> String
show :: HealthCheck -> String
$cshowList :: [HealthCheck] -> ShowS
showList :: [HealthCheck] -> ShowS
Show, HealthCheck -> HealthCheck -> Bool
(HealthCheck -> HealthCheck -> Bool)
-> (HealthCheck -> HealthCheck -> Bool) -> Eq HealthCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HealthCheck -> HealthCheck -> Bool
== :: HealthCheck -> HealthCheck -> Bool
$c/= :: HealthCheck -> HealthCheck -> Bool
/= :: 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
$cfrom :: forall x. HealthCheck -> Rep HealthCheck x
from :: forall x. HealthCheck -> Rep HealthCheck x
$cto :: forall x. Rep HealthCheck x -> HealthCheck
to :: forall x. Rep HealthCheck x -> HealthCheck
Generic, HealthCheck -> ()
(HealthCheck -> ()) -> NFData HealthCheck
forall a. (a -> ()) -> NFData a
$crnf :: HealthCheck -> ()
rnf :: HealthCheck -> ()
NFData)

instance Serial HealthCheck where
  serialize :: forall (m :: * -> *). MonadPut m => HealthCheck -> m ()
serialize HealthCheck
h = do
    Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Bool -> m ()
serialize (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h
    BlockHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHealth -> m ()
serialize HealthCheck
h.blocks
    TimeHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TimeHealth -> m ()
serialize HealthCheck
h.lastBlock
    TimeHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TimeHealth -> m ()
serialize HealthCheck
h.lastTx
    MaxHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => MaxHealth -> m ()
serialize HealthCheck
h.pendingTxs
    CountHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => CountHealth -> m ()
serialize HealthCheck
h.peers
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes (WitnessStackItem -> m ()) -> WitnessStackItem -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> WitnessStackItem
T.encodeUtf8 (Text -> WitnessStackItem) -> Text -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack HealthCheck
h.network
    WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putLengthBytes (WitnessStackItem -> m ()) -> WitnessStackItem -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> WitnessStackItem
T.encodeUtf8 (Text -> WitnessStackItem) -> Text -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack HealthCheck
h.version
    Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be HealthCheck
h.time
  deserialize :: forall (m :: * -> *). MonadGet m => m HealthCheck
deserialize = do
    Bool
k <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Bool
deserialize
    BlockHealth
blocks <- m BlockHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHealth
deserialize
    TimeHealth
lastBlock <- m TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TimeHealth
deserialize
    TimeHealth
lastTx <- m TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TimeHealth
deserialize
    MaxHealth
pendingTxs <- m MaxHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m MaxHealth
deserialize
    CountHealth
peers <- m CountHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m CountHealth
deserialize
    String
network <- Text -> String
T.unpack (Text -> String)
-> (WitnessStackItem -> Text) -> WitnessStackItem -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> Text
T.decodeUtf8 (WitnessStackItem -> String) -> m WitnessStackItem -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    String
version <- Text -> String
T.unpack (Text -> String)
-> (WitnessStackItem -> Text) -> WitnessStackItem -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> Text
T.decodeUtf8 (WitnessStackItem -> String) -> m WitnessStackItem -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WitnessStackItem
forall (m :: * -> *). MonadGet m => m WitnessStackItem
getLengthBytes
    Word64
time <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
    let h :: HealthCheck
h = HealthCheck {String
Word64
MaxHealth
CountHealth
TimeHealth
BlockHealth
$sel:blocks:HealthCheck :: BlockHealth
$sel:lastBlock:HealthCheck :: TimeHealth
$sel:lastTx:HealthCheck :: TimeHealth
$sel:pendingTxs:HealthCheck :: MaxHealth
$sel:peers:HealthCheck :: CountHealth
$sel:network:HealthCheck :: String
$sel:version:HealthCheck :: String
$sel:time:HealthCheck :: Word64
blocks :: BlockHealth
lastBlock :: TimeHealth
lastTx :: TimeHealth
pendingTxs :: MaxHealth
peers :: CountHealth
network :: String
version :: String
time :: Word64
..}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
k Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Inconsistent health check"
    HealthCheck -> m HealthCheck
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck
h

instance Binary HealthCheck where
  put :: HealthCheck -> Put
put = HealthCheck -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => HealthCheck -> m ()
serialize
  get :: Get HealthCheck
get = Get HealthCheck
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m HealthCheck
deserialize

instance Serialize HealthCheck where
  put :: Putter HealthCheck
put = Putter HealthCheck
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => HealthCheck -> m ()
serialize
  get :: Get HealthCheck
get = Get HealthCheck
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m HealthCheck
deserialize

instance Healthy HealthCheck where
  isOK :: HealthCheck -> Bool
isOK HealthCheck
h =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
      [ BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h.blocks,
        TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h.lastBlock,
        TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h.lastTx,
        MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h.pendingTxs,
        CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h.peers
      ]

instance ToJSON HealthCheck where
  toJSON :: HealthCheck -> Value
toJSON HealthCheck
h =
    [Pair] -> Value
A.object
      [ Key
"blocks" Key -> BlockHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.blocks,
        Key
"last-block" Key -> TimeHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.lastBlock,
        Key
"last-tx" Key -> TimeHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.lastTx,
        Key
"pending-txs" Key -> MaxHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.pendingTxs,
        Key
"peers" Key -> CountHealth -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.peers,
        Key
"net" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.network,
        Key
"version" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HealthCheck
h.version,
        Key
"time" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UTCTime -> String
forall a. Show a => a -> String
show (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Word64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral HealthCheck
h.time),
        Key
"ok" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= 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 String
"HealthCheck" ((Object -> Parser HealthCheck) -> Value -> Parser HealthCheck)
-> (Object -> Parser HealthCheck) -> Value -> Parser HealthCheck
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHealth
blocks <- Object
o Object -> Key -> Parser BlockHealth
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocks"
      TimeHealth
lastBlock <- Object
o Object -> Key -> Parser TimeHealth
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last-block"
      TimeHealth
lastTx <- Object
o Object -> Key -> Parser TimeHealth
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last-tx"
      MaxHealth
pendingTxs <- Object
o Object -> Key -> Parser MaxHealth
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pending-txs"
      CountHealth
peers <- Object
o Object -> Key -> Parser CountHealth
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"peers"
      String
network <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"net"
      String
version <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
      UTCTime
utcTime <- String -> UTCTime
forall a. Read a => String -> a
read (String -> UTCTime) -> Parser String -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      let time :: Word64
time = POSIXTime -> Word64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Word64) -> POSIXTime -> Word64
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utcTime
      HealthCheck -> Parser HealthCheck
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return HealthCheck {String
Word64
MaxHealth
CountHealth
TimeHealth
BlockHealth
$sel:blocks:HealthCheck :: BlockHealth
$sel:lastBlock:HealthCheck :: TimeHealth
$sel:lastTx:HealthCheck :: TimeHealth
$sel:pendingTxs:HealthCheck :: MaxHealth
$sel:peers:HealthCheck :: CountHealth
$sel:network:HealthCheck :: String
$sel:version:HealthCheck :: String
$sel:time:HealthCheck :: Word64
blocks :: BlockHealth
lastBlock :: TimeHealth
lastTx :: TimeHealth
pendingTxs :: MaxHealth
peers :: CountHealth
network :: String
version :: String
time :: Word64
..}

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
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: 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
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
Generic, Event -> ()
(Event -> ()) -> NFData Event
forall a. (a -> ()) -> NFData a
$crnf :: Event -> ()
rnf :: Event -> ()
NFData)

instance Serial Event where
  serialize :: forall (m :: * -> *). MonadPut m => Event -> m ()
serialize (EventBlock BlockHash
bh) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BlockHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => BlockHash -> m ()
serialize BlockHash
bh
  serialize (EventTx TxHash
th) = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x01 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize TxHash
th
  deserialize :: forall (m :: * -> *). MonadGet m => m Event
deserialize =
    m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m Event) -> m Event
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0x00 -> BlockHash -> Event
EventBlock (BlockHash -> Event) -> m BlockHash -> m Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m BlockHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m BlockHash
deserialize
      Word8
0x01 -> TxHash -> Event
EventTx (TxHash -> Event) -> m TxHash -> m Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxHash
deserialize
      Word8
_ -> String -> m Event
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Event"

instance Serialize Event where
  put :: Putter Event
put = Putter Event
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Event -> m ()
serialize
  get :: Get Event
get = Get Event
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Event
deserialize

instance Binary Event where
  put :: Event -> Put
put = Event -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Event -> m ()
serialize
  get :: Get Event
get = Get Event
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Event
deserialize

instance ToJSON Event where
  toJSON :: Event -> Value
toJSON (EventTx TxHash
h) =
    [Pair] -> Value
A.object [Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"tx", Key
"id" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TxHash
h]
  toJSON (EventBlock BlockHash
h) =
    [Pair] -> Value
A.object [Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"block", Key
"id" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BlockHash
h]
  toEncoding :: Event -> Encoding
toEncoding (EventTx TxHash
h) =
    Series -> Encoding
A.pairs (Key
"type" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text Text
"tx" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"id" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding TxHash
h)
  toEncoding (EventBlock BlockHash
h) =
    Series -> Encoding
A.pairs (Key
"type" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text Text
"block" Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"id" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding 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 String
"event" ((Object -> Parser Event) -> Value -> Parser Event)
-> (Object -> Parser Event) -> Value -> Parser Event
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      String
t <- Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case String
t of
        String
"tx" -> do
          TxHash
i <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Event -> Parser Event
forall a. a -> Parser a
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
        String
"block" -> do
          BlockHash
i <- Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Event -> Parser Event
forall a. a -> Parser a
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
_ -> String -> Parser Event
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Event) -> String -> Parser Event
forall a b. (a -> b) -> a -> b
$ String
"Could not recognize event type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t

newtype GenericResult a = GenericResult {forall a. GenericResult a -> a
get :: 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
$cshowsPrec :: forall a. Show a => Int -> GenericResult a -> ShowS
showsPrec :: Int -> GenericResult a -> ShowS
$cshow :: forall a. Show a => GenericResult a -> String
show :: GenericResult a -> String
$cshowList :: forall a. Show a => [GenericResult a] -> ShowS
showList :: [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
$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
/= :: 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
$cfrom :: forall a x. GenericResult a -> Rep (GenericResult a) x
from :: forall x. GenericResult a -> Rep (GenericResult a) x
$cto :: forall a x. Rep (GenericResult a) x -> GenericResult a
to :: forall x. Rep (GenericResult a) x -> GenericResult a
Generic, GenericResult a -> ()
(GenericResult a -> ()) -> NFData (GenericResult a)
forall a. NFData a => GenericResult a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => GenericResult a -> ()
rnf :: GenericResult a -> ()
NFData)

instance (Serial a) => Serial (GenericResult a) where
  serialize :: forall (m :: * -> *). MonadPut m => GenericResult a -> m ()
serialize (GenericResult a
x) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize a
x
  deserialize :: forall (m :: * -> *). MonadGet m => m (GenericResult a)
deserialize = a -> GenericResult a
forall a. a -> GenericResult a
GenericResult (a -> GenericResult a) -> m a -> m (GenericResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize

instance (Serial a) => Serialize (GenericResult a) where
  put :: Putter (GenericResult a)
put = Putter (GenericResult a)
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => GenericResult a -> m ()
serialize
  get :: Get (GenericResult a)
get = Get (GenericResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (GenericResult a)
deserialize

instance (Serial a) => Binary (GenericResult a) where
  put :: GenericResult a -> Put
put = GenericResult a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => GenericResult a -> m ()
serialize
  get :: Get (GenericResult a)
get = Get (GenericResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (GenericResult a)
deserialize

instance (ToJSON a) => ToJSON (GenericResult a) where
  toJSON :: GenericResult a -> Value
toJSON (GenericResult a
b) = [Pair] -> Value
A.object [Key
"result" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= a
b]
  toEncoding :: GenericResult a -> Encoding
toEncoding (GenericResult a
b) = Series -> Encoding
A.pairs (Key
"result" Key -> Encoding -> Series
`A.pair` a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding 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 String
"GenericResult" ((Object -> Parser (GenericResult a))
 -> Value -> Parser (GenericResult a))
-> (Object -> Parser (GenericResult a))
-> Value
-> Parser (GenericResult a)
forall a b. (a -> b) -> a -> b
$ \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 -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"

newtype RawResult a = RawResult {forall a. RawResult a -> a
get :: 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
$cshowsPrec :: forall a. Show a => Int -> RawResult a -> ShowS
showsPrec :: Int -> RawResult a -> ShowS
$cshow :: forall a. Show a => RawResult a -> String
show :: RawResult a -> String
$cshowList :: forall a. Show a => [RawResult a] -> ShowS
showList :: [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
$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
/= :: 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
$cfrom :: forall a x. RawResult a -> Rep (RawResult a) x
from :: forall x. RawResult a -> Rep (RawResult a) x
$cto :: forall a x. Rep (RawResult a) x -> RawResult a
to :: forall x. Rep (RawResult a) x -> RawResult a
Generic, RawResult a -> ()
(RawResult a -> ()) -> NFData (RawResult a)
forall a. NFData a => RawResult a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => RawResult a -> ()
rnf :: RawResult a -> ()
NFData)

instance (Serial a) => Serial (RawResult a) where
  serialize :: forall (m :: * -> *). MonadPut m => RawResult a -> m ()
serialize (RawResult a
x) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize a
x
  deserialize :: forall (m :: * -> *). MonadGet m => m (RawResult a)
deserialize = a -> RawResult a
forall a. a -> RawResult a
RawResult (a -> RawResult a) -> m a -> m (RawResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize

instance (Serial a) => Serialize (RawResult a) where
  put :: Putter (RawResult a)
put = Putter (RawResult a)
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => RawResult a -> m ()
serialize
  get :: Get (RawResult a)
get = Get (RawResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (RawResult a)
deserialize

instance (Serial a) => Binary (RawResult a) where
  put :: RawResult a -> Put
put = RawResult a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => RawResult a -> m ()
serialize
  get :: Get (RawResult a)
get = Get (RawResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (RawResult a)
deserialize

instance (Serial a) => ToJSON (RawResult a) where
  toJSON :: RawResult a -> Value
toJSON (RawResult a
b) =
    [Pair] -> Value
A.object [Key
"result" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (WitnessStackItem -> Text
encodeHex (WitnessStackItem -> Text) -> WitnessStackItem -> Text
forall a b. (a -> b) -> a -> b
$ Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$ a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize a
b)]
  toEncoding :: RawResult a -> Encoding
toEncoding (RawResult a
b) =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"result" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (Put -> ByteString
runPutL (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize a
b)

instance (Serial 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 String
"RawResult" ((Object -> Parser (RawResult a)) -> Value -> Parser (RawResult a))
-> (Object -> Parser (RawResult a))
-> Value
-> Parser (RawResult a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
res <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"
      let m :: Maybe a
m =
            Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a)
-> (WitnessStackItem -> Either String a)
-> WitnessStackItem
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> WitnessStackItem -> Either String a
forall a. Get a -> WitnessStackItem -> Either String a
Bytes.Get.runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize
              (WitnessStackItem -> Maybe a) -> Maybe WitnessStackItem -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe WitnessStackItem
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 a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero (RawResult a -> Parser (RawResult a)
forall a. a -> Parser 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
m

newtype SerialList a = SerialList {forall a. SerialList a -> [a]
get :: [a]}
  deriving (Int -> SerialList a -> ShowS
[SerialList a] -> ShowS
SerialList a -> String
(Int -> SerialList a -> ShowS)
-> (SerialList a -> String)
-> ([SerialList a] -> ShowS)
-> Show (SerialList a)
forall a. Show a => Int -> SerialList a -> ShowS
forall a. Show a => [SerialList a] -> ShowS
forall a. Show a => SerialList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SerialList a -> ShowS
showsPrec :: Int -> SerialList a -> ShowS
$cshow :: forall a. Show a => SerialList a -> String
show :: SerialList a -> String
$cshowList :: forall a. Show a => [SerialList a] -> ShowS
showList :: [SerialList a] -> ShowS
Show, SerialList a -> SerialList a -> Bool
(SerialList a -> SerialList a -> Bool)
-> (SerialList a -> SerialList a -> Bool) -> Eq (SerialList a)
forall a. Eq a => SerialList a -> SerialList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SerialList a -> SerialList a -> Bool
== :: SerialList a -> SerialList a -> Bool
$c/= :: forall a. Eq a => SerialList a -> SerialList a -> Bool
/= :: SerialList a -> SerialList a -> Bool
Eq, (forall x. SerialList a -> Rep (SerialList a) x)
-> (forall x. Rep (SerialList a) x -> SerialList a)
-> Generic (SerialList a)
forall x. Rep (SerialList a) x -> SerialList a
forall x. SerialList a -> Rep (SerialList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SerialList a) x -> SerialList a
forall a x. SerialList a -> Rep (SerialList a) x
$cfrom :: forall a x. SerialList a -> Rep (SerialList a) x
from :: forall x. SerialList a -> Rep (SerialList a) x
$cto :: forall a x. Rep (SerialList a) x -> SerialList a
to :: forall x. Rep (SerialList a) x -> SerialList a
Generic, SerialList a -> ()
(SerialList a -> ()) -> NFData (SerialList a)
forall a. NFData a => SerialList a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => SerialList a -> ()
rnf :: SerialList a -> ()
NFData)

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

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

instance (Serial a) => Serial (SerialList a) where
  serialize :: forall (m :: * -> *). MonadPut m => SerialList a -> m ()
serialize (SerialList [a]
ls) = (a -> m ()) -> [a] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize [a]
ls
  deserialize :: forall (m :: * -> *). MonadGet m => m (SerialList a)
deserialize = [a] -> SerialList a
forall a. [a] -> SerialList a
SerialList ([a] -> SerialList a) -> m [a] -> m (SerialList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m [a]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize

instance (ToJSON a) => ToJSON (SerialList a) where
  toJSON :: SerialList a -> Value
toJSON (SerialList [a]
ls) = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON [a]
ls
  toEncoding :: SerialList a -> Encoding
toEncoding (SerialList [a]
ls) = (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding [a]
ls

instance (FromJSON a) => FromJSON (SerialList a) where
  parseJSON :: Value -> Parser (SerialList a)
parseJSON = ([a] -> SerialList a) -> Parser [a] -> Parser (SerialList a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> SerialList a
forall a. [a] -> SerialList a
SerialList (Parser [a] -> Parser (SerialList a))
-> (Value -> Parser [a]) -> Value -> Parser (SerialList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON

newtype RawResultList a = RawResultList {forall a. RawResultList a -> [a]
get :: [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
$cshowsPrec :: forall a. Show a => Int -> RawResultList a -> ShowS
showsPrec :: Int -> RawResultList a -> ShowS
$cshow :: forall a. Show a => RawResultList a -> String
show :: RawResultList a -> String
$cshowList :: forall a. Show a => [RawResultList a] -> ShowS
showList :: [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
$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
/= :: 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
$cfrom :: forall a x. RawResultList a -> Rep (RawResultList a) x
from :: forall x. RawResultList a -> Rep (RawResultList a) x
$cto :: forall a x. Rep (RawResultList a) x -> RawResultList a
to :: forall x. Rep (RawResultList a) x -> RawResultList a
Generic, RawResultList a -> ()
(RawResultList a -> ()) -> NFData (RawResultList a)
forall a. NFData a => RawResultList a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => RawResultList a -> ()
rnf :: RawResultList a -> ()
NFData)

instance (Serial a) => Serial (RawResultList a) where
  serialize :: forall (m :: * -> *). MonadPut m => RawResultList a -> m ()
serialize (RawResultList [a]
xs) =
    (a -> m ()) -> [a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize [a]
xs
  deserialize :: forall (m :: * -> *). MonadGet m => m (RawResultList a)
deserialize = [a] -> RawResultList a
forall a. [a] -> RawResultList a
RawResultList ([a] -> RawResultList a) -> m [a] -> m (RawResultList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [a]
go
    where
      go :: m [a]
go =
        m Bool
forall (m :: * -> *). MonadGet m => m Bool
isEmpty m Bool -> (Bool -> m [a]) -> m [a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          Bool
False -> (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [a]
go

instance (Serial a) => Serialize (RawResultList a) where
  put :: Putter (RawResultList a)
put = Putter (RawResultList a)
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => RawResultList a -> m ()
serialize
  get :: Get (RawResultList a)
get = Get (RawResultList a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (RawResultList a)
deserialize

instance (Serial a) => Binary (RawResultList a) where
  put :: RawResultList a -> Put
put = RawResultList a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => RawResultList a -> m ()
serialize
  get :: Get (RawResultList a)
get = Get (RawResultList a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m (RawResultList a)
deserialize

instance Semigroup (RawResultList a) where
  (RawResultList [a]
a) <> :: RawResultList a -> RawResultList a -> RawResultList a
<> (RawResultList [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 (Serial a) => ToJSON (RawResultList a) where
  toJSON :: RawResultList a -> Value
toJSON (RawResultList [a]
xs) =
    [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessStackItem -> Text
encodeHex (WitnessStackItem -> Text) -> (a -> WitnessStackItem) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> (a -> Put) -> a -> WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize (a -> Value) -> [a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
  toEncoding :: RawResultList a -> Encoding
toEncoding (RawResultList [a]
xs) =
    (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list (ByteString -> Encoding
hexEncoding (ByteString -> Encoding) -> (a -> ByteString) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize) [a]
xs

instance (Serial 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 String
"RawResultList" ((Array -> Parser (RawResultList a))
 -> Value -> Parser (RawResultList a))
-> (Array -> Parser (RawResultList a))
-> Value
-> Parser (RawResultList a)
forall a b. (a -> b) -> a -> b
$ \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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser a
parseElem (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
vec)
    where
      deser :: WitnessStackItem -> Maybe a
deser = Either String a -> Maybe a
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String a -> Maybe a)
-> (WitnessStackItem -> Either String a)
-> WitnessStackItem
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> WitnessStackItem -> Either String a
forall a. Get a -> WitnessStackItem -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize
      parseElem :: Value -> Parser a
parseElem =
        String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"RawResultListItem" ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Text
t ->
          Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser a
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero a -> Parser a
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe WitnessStackItem
decodeHex Text
t Maybe WitnessStackItem -> (WitnessStackItem -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WitnessStackItem -> Maybe a
deser)

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
$cshowsPrec :: Int -> TxId -> ShowS
showsPrec :: Int -> TxId -> ShowS
$cshow :: TxId -> String
show :: TxId -> String
$cshowList :: [TxId] -> ShowS
showList :: [TxId] -> ShowS
Show, TxId -> TxId -> Bool
(TxId -> TxId -> Bool) -> (TxId -> TxId -> Bool) -> Eq TxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId -> TxId -> Bool
== :: TxId -> TxId -> Bool
$c/= :: TxId -> TxId -> Bool
/= :: 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
$cfrom :: forall x. TxId -> Rep TxId x
from :: forall x. TxId -> Rep TxId x
$cto :: forall x. Rep TxId x -> TxId
to :: forall x. Rep TxId x -> TxId
Generic, TxId -> ()
(TxId -> ()) -> NFData TxId
forall a. (a -> ()) -> NFData a
$crnf :: TxId -> ()
rnf :: TxId -> ()
NFData)

instance Serial TxId where
  serialize :: forall (m :: * -> *). MonadPut m => TxId -> m ()
serialize (TxId TxHash
h) = TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize TxHash
h
  deserialize :: forall (m :: * -> *). MonadGet m => m TxId
deserialize = TxHash -> TxId
TxId (TxHash -> TxId) -> m TxHash -> m TxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxHash
deserialize

instance Serialize TxId where
  put :: Putter TxId
put = Putter TxId
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxId -> m ()
serialize
  get :: Get TxId
get = Get TxId
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxId
deserialize

instance Binary TxId where
  put :: TxId -> Put
put = TxId -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxId -> m ()
serialize
  get :: Get TxId
get = Get TxId
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m TxId
deserialize

instance ToJSON TxId where
  toJSON :: TxId -> Value
toJSON (TxId TxHash
h) = [Pair] -> Value
A.object [Key
"txid" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TxHash
h]
  toEncoding :: TxId -> Encoding
toEncoding (TxId TxHash
h) = Series -> Encoding
A.pairs (Key
"txid" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding 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 String
"txid" ((Object -> Parser TxId) -> Value -> Parser TxId)
-> (Object -> Parser TxId) -> Value -> Parser TxId
forall a b. (a -> b) -> a -> b
$ \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 -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txid"

data Except
  = ThingNotFound
  | ServerError
  | BadRequest
  | UserError !String
  | StringError !String
  | TxIndexConflict ![TxHash]
  | ServerTimeout
  | RequestTooLarge
  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
$cshowsPrec :: Int -> Except -> ShowS
showsPrec :: Int -> Except -> ShowS
$cshow :: Except -> String
show :: Except -> String
$cshowList :: [Except] -> ShowS
showList :: [Except] -> ShowS
Show, Except -> Except -> Bool
(Except -> Except -> Bool)
-> (Except -> Except -> Bool) -> Eq Except
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Except -> Except -> Bool
== :: Except -> Except -> Bool
$c/= :: Except -> Except -> Bool
/= :: 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
$ccompare :: Except -> Except -> Ordering
compare :: Except -> Except -> Ordering
$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
>= :: Except -> Except -> Bool
$cmax :: Except -> Except -> Except
max :: Except -> Except -> Except
$cmin :: Except -> Except -> Except
min :: Except -> Except -> Except
Ord, (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
$cfrom :: forall x. Except -> Rep Except x
from :: forall x. Except -> Rep Except x
$cto :: forall x. Rep Except x -> Except
to :: forall x. Rep Except x -> Except
Generic, Except -> ()
(Except -> ()) -> NFData Except
forall a. (a -> ()) -> NFData a
$crnf :: Except -> ()
rnf :: Except -> ()
NFData)

instance Exception Except

instance ScottyError Except where
  stringError :: String -> Except
stringError = String -> Except
StringError
  showError :: Except -> Text
showError = String -> Text
LazyText.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 Except
e =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      case Except
e of
        Except
ThingNotFound ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"not-found-or-invalid-arg",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Item not found or argument invalid"
          ]
        Except
ServerError ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"server-error",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Server error"
          ]
        Except
BadRequest ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"bad-request",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Invalid request"
          ]
        UserError String
msg' ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"user-error",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
msg')
          ]
        StringError String
msg' ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"string-error",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
msg')
          ]
        TxIndexConflict [TxHash]
txids ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"multiple-tx-index",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Multiple txs match that index",
            Key
"txids" Key -> [TxHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [TxHash]
txids
          ]
        Except
ServerTimeout ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"server-timeout",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Request is taking too long"
          ]
        Except
RequestTooLarge ->
          [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"request-too-large",
            Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
String Text
"Request body 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 String
"Except" ((Object -> Parser Except) -> Value -> Parser Except)
-> (Object -> Parser Except) -> Value -> Parser Except
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Value
ctr <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
      String
msg' <- Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= String
""
      case Value
ctr of
        String Text
"not-found-or-invalid-arg" ->
          Except -> Parser Except
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ThingNotFound
        String Text
"server-error" ->
          Except -> Parser Except
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ServerError
        String Text
"bad-request" ->
          Except -> Parser Except
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Except
BadRequest
        String Text
"user-error" ->
          Except -> Parser Except
forall a. a -> Parser a
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 Text
"string-error" ->
          Except -> Parser Except
forall a. a -> Parser a
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 Text
"multiple-tx-index" -> do
          [TxHash]
txids <- Object
o Object -> Key -> Parser [TxHash]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txids"
          Except -> Parser Except
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Except -> Parser Except) -> Except -> Parser Except
forall a b. (a -> b) -> a -> b
$ [TxHash] -> Except
TxIndexConflict [TxHash]
txids
        String Text
"server-timeout" ->
          Except -> Parser Except
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ServerTimeout
        String Text
"request-too-large" ->
          Except -> Parser Except
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Except
RequestTooLarge
        Value
_ -> Parser Except
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

toIntTxId :: TxHash -> Word64
toIntTxId :: TxHash -> Word64
toIntTxId TxHash
h =
  let bs :: WitnessStackItem
bs = Put -> WitnessStackItem
runPutS (TxHash -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => TxHash -> m ()
serialize TxHash
h)
      Right Word64
w64 = Get Word64 -> WitnessStackItem -> Either String Word64
forall a. Get a -> WitnessStackItem -> Either String a
runGetS Get Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be WitnessStackItem
bs
   in Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` (-Int
11)

data BinfoBlockId
  = BinfoBlockHash !BlockHash
  | BinfoBlockIndex !Word32
  deriving (BinfoBlockId -> BinfoBlockId -> Bool
(BinfoBlockId -> BinfoBlockId -> Bool)
-> (BinfoBlockId -> BinfoBlockId -> Bool) -> Eq BinfoBlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoBlockId -> BinfoBlockId -> Bool
== :: BinfoBlockId -> BinfoBlockId -> Bool
$c/= :: BinfoBlockId -> BinfoBlockId -> Bool
/= :: BinfoBlockId -> BinfoBlockId -> Bool
Eq, Int -> BinfoBlockId -> ShowS
[BinfoBlockId] -> ShowS
BinfoBlockId -> String
(Int -> BinfoBlockId -> ShowS)
-> (BinfoBlockId -> String)
-> ([BinfoBlockId] -> ShowS)
-> Show BinfoBlockId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoBlockId -> ShowS
showsPrec :: Int -> BinfoBlockId -> ShowS
$cshow :: BinfoBlockId -> String
show :: BinfoBlockId -> String
$cshowList :: [BinfoBlockId] -> ShowS
showList :: [BinfoBlockId] -> ShowS
Show, ReadPrec [BinfoBlockId]
ReadPrec BinfoBlockId
Int -> ReadS BinfoBlockId
ReadS [BinfoBlockId]
(Int -> ReadS BinfoBlockId)
-> ReadS [BinfoBlockId]
-> ReadPrec BinfoBlockId
-> ReadPrec [BinfoBlockId]
-> Read BinfoBlockId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BinfoBlockId
readsPrec :: Int -> ReadS BinfoBlockId
$creadList :: ReadS [BinfoBlockId]
readList :: ReadS [BinfoBlockId]
$creadPrec :: ReadPrec BinfoBlockId
readPrec :: ReadPrec BinfoBlockId
$creadListPrec :: ReadPrec [BinfoBlockId]
readListPrec :: ReadPrec [BinfoBlockId]
Read, (forall x. BinfoBlockId -> Rep BinfoBlockId x)
-> (forall x. Rep BinfoBlockId x -> BinfoBlockId)
-> Generic BinfoBlockId
forall x. Rep BinfoBlockId x -> BinfoBlockId
forall x. BinfoBlockId -> Rep BinfoBlockId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoBlockId -> Rep BinfoBlockId x
from :: forall x. BinfoBlockId -> Rep BinfoBlockId x
$cto :: forall x. Rep BinfoBlockId x -> BinfoBlockId
to :: forall x. Rep BinfoBlockId x -> BinfoBlockId
Generic, BinfoBlockId -> ()
(BinfoBlockId -> ()) -> NFData BinfoBlockId
forall a. (a -> ()) -> NFData a
$crnf :: BinfoBlockId -> ()
rnf :: BinfoBlockId -> ()
NFData)

instance Parsable BinfoBlockId where
  parseParam :: Text -> Either Text BinfoBlockId
parseParam Text
t =
    Either Text BinfoBlockId
hex Either Text BinfoBlockId
-> Either Text BinfoBlockId -> Either Text BinfoBlockId
forall a. Semigroup a => a -> a -> a
<> Either Text BinfoBlockId
igr
    where
      hex :: Either Text BinfoBlockId
hex = case Text -> Maybe BlockHash
hexToBlockHash (Text -> Text
LazyText.toStrict Text
t) of
        Maybe BlockHash
Nothing -> Text -> Either Text BinfoBlockId
forall a b. a -> Either a b
Left Text
"could not decode txid"
        Just BlockHash
h -> BinfoBlockId -> Either Text BinfoBlockId
forall a b. b -> Either a b
Right (BinfoBlockId -> Either Text BinfoBlockId)
-> BinfoBlockId -> Either Text BinfoBlockId
forall a b. (a -> b) -> a -> b
$ BlockHash -> BinfoBlockId
BinfoBlockHash BlockHash
h
      igr :: Either Text BinfoBlockId
igr = BlockHeight -> BinfoBlockId
BinfoBlockIndex (BlockHeight -> BinfoBlockId)
-> Either Text BlockHeight -> Either Text BinfoBlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text BlockHeight
forall a. Parsable a => Text -> Either Text a
parseParam Text
t

data BinfoTxId
  = BinfoTxIdHash !TxHash
  | BinfoTxIdIndex !Word64
  deriving (BinfoTxId -> BinfoTxId -> Bool
(BinfoTxId -> BinfoTxId -> Bool)
-> (BinfoTxId -> BinfoTxId -> Bool) -> Eq BinfoTxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoTxId -> BinfoTxId -> Bool
== :: BinfoTxId -> BinfoTxId -> Bool
$c/= :: BinfoTxId -> BinfoTxId -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoTxId -> ShowS
showsPrec :: Int -> BinfoTxId -> ShowS
$cshow :: BinfoTxId -> String
show :: BinfoTxId -> String
$cshowList :: [BinfoTxId] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS BinfoTxId
readsPrec :: Int -> ReadS BinfoTxId
$creadList :: ReadS [BinfoTxId]
readList :: ReadS [BinfoTxId]
$creadPrec :: ReadPrec BinfoTxId
readPrec :: ReadPrec BinfoTxId
$creadListPrec :: ReadPrec [BinfoTxId]
readListPrec :: ReadPrec [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
$cfrom :: forall x. BinfoTxId -> Rep BinfoTxId x
from :: forall x. BinfoTxId -> Rep BinfoTxId x
$cto :: forall x. Rep BinfoTxId x -> BinfoTxId
to :: forall x. Rep BinfoTxId x -> BinfoTxId
Generic, BinfoTxId -> ()
(BinfoTxId -> ()) -> NFData BinfoTxId
forall a. (a -> ()) -> NFData a
$crnf :: BinfoTxId -> ()
rnf :: BinfoTxId -> ()
NFData)

encodeBinfoTxId :: Bool -> TxHash -> BinfoTxId
encodeBinfoTxId :: Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
False = TxHash -> BinfoTxId
BinfoTxIdHash
encodeBinfoTxId Bool
True = Word64 -> BinfoTxId
BinfoTxIdIndex (Word64 -> BinfoTxId) -> (TxHash -> Word64) -> TxHash -> BinfoTxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> Word64
toIntTxId

instance Parsable BinfoTxId where
  parseParam :: Text -> Either Text BinfoTxId
parseParam Text
t =
    Either Text BinfoTxId
hex Either Text BinfoTxId
-> Either Text BinfoTxId -> Either Text BinfoTxId
forall a. Semigroup a => a -> a -> a
<> Either Text BinfoTxId
igr
    where
      hex :: Either Text BinfoTxId
hex =
        case Text -> Maybe TxHash
hexToTxHash (Text -> Text
LazyText.toStrict Text
t) of
          Maybe TxHash
Nothing -> Text -> Either Text BinfoTxId
forall a b. a -> Either a b
Left Text
"could not decode txid"
          Just TxHash
h -> BinfoTxId -> Either Text BinfoTxId
forall a b. b -> Either a b
Right (BinfoTxId -> Either Text BinfoTxId)
-> BinfoTxId -> Either Text BinfoTxId
forall a b. (a -> b) -> a -> b
$ TxHash -> BinfoTxId
BinfoTxIdHash TxHash
h
      igr :: Either Text BinfoTxId
igr = Word64 -> BinfoTxId
BinfoTxIdIndex (Word64 -> BinfoTxId)
-> Either Text Word64 -> Either Text BinfoTxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Word64
forall a. Parsable a => Text -> Either Text a
parseParam Text
t

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

instance FromJSON BinfoTxId where
  parseJSON :: Value -> Parser BinfoTxId
parseJSON 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 a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word64 -> BinfoTxId
BinfoTxIdIndex (Word64 -> BinfoTxId) -> Parser Word64 -> Parser BinfoTxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Word64
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

data BinfoFilter
  = BinfoFilterAll
  | BinfoFilterSent
  | BinfoFilterReceived
  | BinfoFilterMoved
  | BinfoFilterConfirmed
  | BinfoFilterMempool
  deriving (BinfoFilter -> BinfoFilter -> Bool
(BinfoFilter -> BinfoFilter -> Bool)
-> (BinfoFilter -> BinfoFilter -> Bool) -> Eq BinfoFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoFilter -> BinfoFilter -> Bool
== :: BinfoFilter -> BinfoFilter -> Bool
$c/= :: BinfoFilter -> BinfoFilter -> Bool
/= :: BinfoFilter -> BinfoFilter -> Bool
Eq, Int -> BinfoFilter -> ShowS
[BinfoFilter] -> ShowS
BinfoFilter -> String
(Int -> BinfoFilter -> ShowS)
-> (BinfoFilter -> String)
-> ([BinfoFilter] -> ShowS)
-> Show BinfoFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoFilter -> ShowS
showsPrec :: Int -> BinfoFilter -> ShowS
$cshow :: BinfoFilter -> String
show :: BinfoFilter -> String
$cshowList :: [BinfoFilter] -> ShowS
showList :: [BinfoFilter] -> ShowS
Show, (forall x. BinfoFilter -> Rep BinfoFilter x)
-> (forall x. Rep BinfoFilter x -> BinfoFilter)
-> Generic BinfoFilter
forall x. Rep BinfoFilter x -> BinfoFilter
forall x. BinfoFilter -> Rep BinfoFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoFilter -> Rep BinfoFilter x
from :: forall x. BinfoFilter -> Rep BinfoFilter x
$cto :: forall x. Rep BinfoFilter x -> BinfoFilter
to :: forall x. Rep BinfoFilter x -> BinfoFilter
Generic, BinfoFilter -> ()
(BinfoFilter -> ()) -> NFData BinfoFilter
forall a. (a -> ()) -> NFData a
$crnf :: BinfoFilter -> ()
rnf :: BinfoFilter -> ()
NFData)

instance Parsable BinfoFilter where
  parseParam :: Text -> Either Text BinfoFilter
parseParam Text
t =
    Text -> Either Text Int
forall a. Parsable a => Text -> Either Text a
parseParam Text
t Either Text Int
-> (Int -> Either Text BinfoFilter) -> Either Text BinfoFilter
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Int
0 :: Int) -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterAll
      Int
1 -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterSent
      Int
2 -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterReceived
      Int
3 -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterMoved
      Int
5 -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterConfirmed
      Int
6 -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterAll
      Int
7 -> BinfoFilter -> Either Text BinfoFilter
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoFilter
BinfoFilterMempool
      Int
_ -> Text -> Either Text BinfoFilter
forall a b. a -> Either a b
Left Text
"could not parse filter parameter"

data BinfoMultiAddr = BinfoMultiAddr
  { BinfoMultiAddr -> [BinfoBalance]
addresses :: ![BinfoBalance],
    BinfoMultiAddr -> BinfoWallet
wallet :: !BinfoWallet,
    BinfoMultiAddr -> [BinfoTx]
txs :: ![BinfoTx],
    BinfoMultiAddr -> BinfoInfo
info :: !BinfoInfo,
    BinfoMultiAddr -> Bool
recommendFee :: !Bool,
    BinfoMultiAddr -> Bool
cashAddr :: !Bool
  }
  deriving (BinfoMultiAddr -> BinfoMultiAddr -> Bool
(BinfoMultiAddr -> BinfoMultiAddr -> Bool)
-> (BinfoMultiAddr -> BinfoMultiAddr -> Bool) -> Eq BinfoMultiAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
== :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
$c/= :: BinfoMultiAddr -> BinfoMultiAddr -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoMultiAddr -> ShowS
showsPrec :: Int -> BinfoMultiAddr -> ShowS
$cshow :: BinfoMultiAddr -> String
show :: BinfoMultiAddr -> String
$cshowList :: [BinfoMultiAddr] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoMultiAddr -> Rep BinfoMultiAddr x
from :: forall x. BinfoMultiAddr -> Rep BinfoMultiAddr x
$cto :: forall x. Rep BinfoMultiAddr x -> BinfoMultiAddr
to :: forall x. Rep BinfoMultiAddr x -> BinfoMultiAddr
Generic, BinfoMultiAddr -> ()
(BinfoMultiAddr -> ()) -> NFData BinfoMultiAddr
forall a. (a -> ()) -> NFData a
$crnf :: BinfoMultiAddr -> ()
rnf :: BinfoMultiAddr -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoMultiAddr where
  marshalValue :: (Network, Ctx) -> BinfoMultiAddr -> Value
marshalValue (Network
net', Ctx
ctx) BinfoMultiAddr
m =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"addresses" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoBalance -> Value) -> [BinfoBalance] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoBalance -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) BinfoMultiAddr
m.addresses,
        Key
"wallet" Key -> BinfoWallet -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoMultiAddr
m.wallet,
        Key
"txs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTx -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) BinfoMultiAddr
m.txs,
        Key
"info" Key -> BinfoInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoMultiAddr
m.info,
        Key
"recommend_include_fee" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoMultiAddr
m.recommendFee
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"cash_addr" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True | BinfoMultiAddr
m.cashAddr]
    where
      net :: Network
net = if Bool -> Bool
not BinfoMultiAddr
m.cashAddr Bool -> Bool -> Bool
&& Network
net' Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch then Network
btc else Network
net'

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoMultiAddr
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoMultiAddr)
-> Value
-> Parser BinfoMultiAddr
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoMultiAddr" ((Object -> Parser BinfoMultiAddr)
 -> Value -> Parser BinfoMultiAddr)
-> (Object -> Parser BinfoMultiAddr)
-> Value
-> Parser BinfoMultiAddr
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [BinfoBalance]
addresses <- (Value -> Parser BinfoBalance) -> [Value] -> Parser [BinfoBalance]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoBalance
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) ([Value] -> Parser [BinfoBalance])
-> Parser [Value] -> Parser [BinfoBalance]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"addresses"
      BinfoWallet
wallet <- Object
o Object -> Key -> Parser BinfoWallet
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"wallet"
      [BinfoTx]
txs <- (Value -> Parser BinfoTx) -> [Value] -> Parser [BinfoTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoTx
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) ([Value] -> Parser [BinfoTx]) -> Parser [Value] -> Parser [BinfoTx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txs"
      BinfoInfo
info <- Object
o Object -> Key -> Parser BinfoInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"info"
      Bool
recommendFee <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"recommend_include_fee"
      Bool
cashAddr <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cash_addr" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      BinfoMultiAddr -> Parser BinfoMultiAddr
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoMultiAddr {Bool
[BinfoTx]
[BinfoBalance]
BinfoInfo
BinfoWallet
$sel:addresses:BinfoMultiAddr :: [BinfoBalance]
$sel:wallet:BinfoMultiAddr :: BinfoWallet
$sel:txs:BinfoMultiAddr :: [BinfoTx]
$sel:info:BinfoMultiAddr :: BinfoInfo
$sel:recommendFee:BinfoMultiAddr :: Bool
$sel:cashAddr:BinfoMultiAddr :: Bool
addresses :: [BinfoBalance]
wallet :: BinfoWallet
txs :: [BinfoTx]
info :: BinfoInfo
recommendFee :: Bool
cashAddr :: Bool
..}

  marshalEncoding :: (Network, Ctx) -> BinfoMultiAddr -> Encoding
marshalEncoding (Network
net', Ctx
ctx) BinfoMultiAddr
m =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"addresses" Key -> Encoding -> Series
`A.pair` (BinfoBalance -> Encoding) -> [BinfoBalance] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoBalance -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoMultiAddr
m.addresses,
          Key
"wallet" Key -> Encoding -> Series
`A.pair` BinfoWallet -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoMultiAddr
m.wallet,
          Key
"txs" Key -> Encoding -> Series
`A.pair` (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTx -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoMultiAddr
m.txs,
          Key
"info" Key -> Encoding -> Series
`A.pair` BinfoInfo -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoMultiAddr
m.info,
          Key
"recommend_include_fee" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BinfoMultiAddr
m.recommendFee,
          if BinfoMultiAddr
m.cashAddr then Key
"cash_addr" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool Bool
True else Series
forall a. Monoid a => a
mempty
        ]
    where
      net :: Network
net = if Bool -> Bool
not BinfoMultiAddr
m.cashAddr Bool -> Bool -> Bool
&& Network
net' Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
bch then Network
btc else Network
net'

data BinfoRawAddr = BinfoRawAddr
  { BinfoRawAddr -> BinfoAddr
address :: !BinfoAddr,
    BinfoRawAddr -> Word64
balance :: !Word64,
    BinfoRawAddr -> Word64
ntx :: !Word64,
    BinfoRawAddr -> Word64
utxo :: !Word64,
    BinfoRawAddr -> Word64
received :: !Word64,
    BinfoRawAddr -> Int64
sent :: !Int64,
    BinfoRawAddr -> [BinfoTx]
txs :: ![BinfoTx]
  }
  deriving (BinfoRawAddr -> BinfoRawAddr -> Bool
(BinfoRawAddr -> BinfoRawAddr -> Bool)
-> (BinfoRawAddr -> BinfoRawAddr -> Bool) -> Eq BinfoRawAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoRawAddr -> BinfoRawAddr -> Bool
== :: BinfoRawAddr -> BinfoRawAddr -> Bool
$c/= :: BinfoRawAddr -> BinfoRawAddr -> Bool
/= :: BinfoRawAddr -> BinfoRawAddr -> Bool
Eq, Int -> BinfoRawAddr -> ShowS
[BinfoRawAddr] -> ShowS
BinfoRawAddr -> String
(Int -> BinfoRawAddr -> ShowS)
-> (BinfoRawAddr -> String)
-> ([BinfoRawAddr] -> ShowS)
-> Show BinfoRawAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoRawAddr -> ShowS
showsPrec :: Int -> BinfoRawAddr -> ShowS
$cshow :: BinfoRawAddr -> String
show :: BinfoRawAddr -> String
$cshowList :: [BinfoRawAddr] -> ShowS
showList :: [BinfoRawAddr] -> ShowS
Show, (forall x. BinfoRawAddr -> Rep BinfoRawAddr x)
-> (forall x. Rep BinfoRawAddr x -> BinfoRawAddr)
-> Generic BinfoRawAddr
forall x. Rep BinfoRawAddr x -> BinfoRawAddr
forall x. BinfoRawAddr -> Rep BinfoRawAddr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoRawAddr -> Rep BinfoRawAddr x
from :: forall x. BinfoRawAddr -> Rep BinfoRawAddr x
$cto :: forall x. Rep BinfoRawAddr x -> BinfoRawAddr
to :: forall x. Rep BinfoRawAddr x -> BinfoRawAddr
Generic, BinfoRawAddr -> ()
(BinfoRawAddr -> ()) -> NFData BinfoRawAddr
forall a. (a -> ()) -> NFData a
$crnf :: BinfoRawAddr -> ()
rnf :: BinfoRawAddr -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoRawAddr where
  marshalValue :: (Network, Ctx) -> BinfoRawAddr -> Value
marshalValue (Network
net, Ctx
ctx) BinfoRawAddr
r =
    [Pair] -> Value
A.object
      [ Key
"hash160" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
h160,
        Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
address,
        Key
"n_tx" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRawAddr
r.ntx,
        Key
"n_unredeemed" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRawAddr
r.utxo,
        Key
"total_received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRawAddr
r.received,
        Key
"total_sent" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRawAddr
r.sent,
        Key
"final_balance" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRawAddr
r.balance,
        Key
"txs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTx -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) BinfoRawAddr
r.txs
      ]
    where
      address :: Value
address = case BinfoRawAddr
r.address of
        BinfoAddr Address
a -> Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net Address
a
        BinfoXpub XPubKey
x -> (Network, Ctx) -> XPubKey -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx) XPubKey
x
      h160 :: Maybe Text
h160 =
        WitnessStackItem -> Text
encodeHex (WitnessStackItem -> Text)
-> (Hash160 -> WitnessStackItem) -> Hash160 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem)
-> (Hash160 -> Put) -> Hash160 -> WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize
          (Hash160 -> Text) -> Maybe Hash160 -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case BinfoRawAddr
r.address of
            BinfoAddr Address
a -> case Address
a of
              PubKeyAddress Hash160
h -> Hash160 -> Maybe Hash160
forall a. a -> Maybe a
Just Hash160
h
              ScriptAddress Hash160
h -> Hash160 -> Maybe Hash160
forall a. a -> Maybe a
Just Hash160
h
              WitnessPubKeyAddress Hash160
h -> Hash160 -> Maybe Hash160
forall a. a -> Maybe a
Just Hash160
h
              Address
_ -> Maybe Hash160
forall a. Maybe a
Nothing
            BinfoAddr
_ -> Maybe Hash160
forall a. Maybe a
Nothing

  marshalEncoding :: (Network, Ctx) -> BinfoRawAddr -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoRawAddr
r =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"hash160" Key -> Encoding -> Series
`A.pair` Encoding -> Maybe Encoding -> Encoding
forall a. a -> Maybe a -> a
fromMaybe Encoding
A.null_ Maybe Encoding
h160,
          Key
"address" Key -> Encoding -> Series
`A.pair` Encoding
address,
          Key
"n_tx" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoRawAddr
r.ntx,
          Key
"n_unredeemed" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoRawAddr
r.utxo,
          Key
"total_received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoRawAddr
r.received,
          Key
"total_sent" Key -> Encoding -> Series
`A.pair` Int64 -> Encoding
A.int64 BinfoRawAddr
r.sent,
          Key
"final_balance" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoRawAddr
r.balance,
          Key
"txs" Key -> Encoding -> Series
`A.pair` (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTx -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoRawAddr
r.txs
        ]
    where
      address :: Encoding
address = case BinfoRawAddr
r.address of
        BinfoAddr Address
a -> Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net Address
a
        BinfoXpub XPubKey
x -> (Network, Ctx) -> XPubKey -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) XPubKey
x
      h160 :: Maybe Encoding
h160 =
        ByteString -> Encoding
hexEncoding (ByteString -> Encoding)
-> (Hash160 -> ByteString) -> Hash160 -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (Hash160 -> Put) -> Hash160 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize
          (Hash160 -> Encoding) -> Maybe Hash160 -> Maybe Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case BinfoRawAddr
r.address of
            BinfoAddr Address
a -> case Address
a of
              PubKeyAddress Hash160
h -> Hash160 -> Maybe Hash160
forall a. a -> Maybe a
Just Hash160
h
              ScriptAddress Hash160
h -> Hash160 -> Maybe Hash160
forall a. a -> Maybe a
Just Hash160
h
              WitnessPubKeyAddress Hash160
h -> Hash160 -> Maybe Hash160
forall a. a -> Maybe a
Just Hash160
h
              Address
_ -> Maybe Hash160
forall a. Maybe a
Nothing
            BinfoAddr
_ -> Maybe Hash160
forall a. Maybe a
Nothing

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoRawAddr
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoRawAddr) -> Value -> Parser BinfoRawAddr
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoRawAddr" ((Object -> Parser BinfoRawAddr) -> Value -> Parser BinfoRawAddr)
-> (Object -> Parser BinfoRawAddr) -> Value -> Parser BinfoRawAddr
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Value
addr <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
      BinfoAddr
address <-
        Address -> BinfoAddr
BinfoAddr (Address -> BinfoAddr) -> Parser Address -> Parser BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net Value
addr
          Parser BinfoAddr -> Parser BinfoAddr -> Parser BinfoAddr
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XPubKey -> BinfoAddr
BinfoXpub (XPubKey -> BinfoAddr) -> Parser XPubKey -> Parser BinfoAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Network, Ctx) -> Value -> Parser XPubKey
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx) Value
addr
      Word64
balance <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"final_balance"
      Word64
utxo <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_unredeemed"
      Word64
ntx <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx"
      Word64
received <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_received"
      Int64
sent <- Object
o Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_sent"
      [BinfoTx]
txs <- (Value -> Parser BinfoTx) -> [Value] -> Parser [BinfoTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoTx
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) ([Value] -> Parser [BinfoTx]) -> Parser [Value] -> Parser [BinfoTx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txs"
      BinfoRawAddr -> Parser BinfoRawAddr
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoRawAddr {Int64
[BinfoTx]
Word64
BinfoAddr
$sel:address:BinfoRawAddr :: BinfoAddr
$sel:balance:BinfoRawAddr :: Word64
$sel:ntx:BinfoRawAddr :: Word64
$sel:utxo:BinfoRawAddr :: Word64
$sel:received:BinfoRawAddr :: Word64
$sel:sent:BinfoRawAddr :: Int64
$sel:txs:BinfoRawAddr :: [BinfoTx]
address :: BinfoAddr
balance :: Word64
utxo :: Word64
ntx :: Word64
received :: Word64
sent :: Int64
txs :: [BinfoTx]
..}

data BinfoShortBal = BinfoShortBal
  { BinfoShortBal -> Word64
final :: !Word64,
    BinfoShortBal -> Word64
ntx :: !Word64,
    BinfoShortBal -> Word64
received :: !Word64
  }
  deriving (BinfoShortBal -> BinfoShortBal -> Bool
(BinfoShortBal -> BinfoShortBal -> Bool)
-> (BinfoShortBal -> BinfoShortBal -> Bool) -> Eq BinfoShortBal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoShortBal -> BinfoShortBal -> Bool
== :: BinfoShortBal -> BinfoShortBal -> Bool
$c/= :: BinfoShortBal -> BinfoShortBal -> Bool
/= :: BinfoShortBal -> BinfoShortBal -> Bool
Eq, Int -> BinfoShortBal -> ShowS
[BinfoShortBal] -> ShowS
BinfoShortBal -> String
(Int -> BinfoShortBal -> ShowS)
-> (BinfoShortBal -> String)
-> ([BinfoShortBal] -> ShowS)
-> Show BinfoShortBal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoShortBal -> ShowS
showsPrec :: Int -> BinfoShortBal -> ShowS
$cshow :: BinfoShortBal -> String
show :: BinfoShortBal -> String
$cshowList :: [BinfoShortBal] -> ShowS
showList :: [BinfoShortBal] -> ShowS
Show, ReadPrec [BinfoShortBal]
ReadPrec BinfoShortBal
Int -> ReadS BinfoShortBal
ReadS [BinfoShortBal]
(Int -> ReadS BinfoShortBal)
-> ReadS [BinfoShortBal]
-> ReadPrec BinfoShortBal
-> ReadPrec [BinfoShortBal]
-> Read BinfoShortBal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BinfoShortBal
readsPrec :: Int -> ReadS BinfoShortBal
$creadList :: ReadS [BinfoShortBal]
readList :: ReadS [BinfoShortBal]
$creadPrec :: ReadPrec BinfoShortBal
readPrec :: ReadPrec BinfoShortBal
$creadListPrec :: ReadPrec [BinfoShortBal]
readListPrec :: ReadPrec [BinfoShortBal]
Read, (forall x. BinfoShortBal -> Rep BinfoShortBal x)
-> (forall x. Rep BinfoShortBal x -> BinfoShortBal)
-> Generic BinfoShortBal
forall x. Rep BinfoShortBal x -> BinfoShortBal
forall x. BinfoShortBal -> Rep BinfoShortBal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoShortBal -> Rep BinfoShortBal x
from :: forall x. BinfoShortBal -> Rep BinfoShortBal x
$cto :: forall x. Rep BinfoShortBal x -> BinfoShortBal
to :: forall x. Rep BinfoShortBal x -> BinfoShortBal
Generic, BinfoShortBal -> ()
(BinfoShortBal -> ()) -> NFData BinfoShortBal
forall a. (a -> ()) -> NFData a
$crnf :: BinfoShortBal -> ()
rnf :: BinfoShortBal -> ()
NFData)

instance ToJSON BinfoShortBal where
  toJSON :: BinfoShortBal -> Value
toJSON BinfoShortBal
b =
    [Pair] -> Value
A.object
      [ Key
"final_balance" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoShortBal
b.final,
        Key
"n_tx" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoShortBal
b.ntx,
        Key
"total_received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoShortBal
b.received
      ]
  toEncoding :: BinfoShortBal -> Encoding
toEncoding BinfoShortBal
b =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"final_balance" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoShortBal
b.final,
          Key
"n_tx" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoShortBal
b.ntx,
          Key
"total_received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoShortBal
b.received
        ]

instance FromJSON BinfoShortBal where
  parseJSON :: Value -> Parser BinfoShortBal
parseJSON =
    String
-> (Object -> Parser BinfoShortBal)
-> Value
-> Parser BinfoShortBal
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoShortBal" ((Object -> Parser BinfoShortBal) -> Value -> Parser BinfoShortBal)
-> (Object -> Parser BinfoShortBal)
-> Value
-> Parser BinfoShortBal
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Word64
final <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"final_balance"
      Word64
ntx <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx"
      Word64
received <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_received"
      BinfoShortBal -> Parser BinfoShortBal
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoShortBal {Word64
$sel:final:BinfoShortBal :: Word64
$sel:ntx:BinfoShortBal :: Word64
$sel:received:BinfoShortBal :: Word64
final :: Word64
ntx :: Word64
received :: Word64
..}

data BinfoBalance
  = BinfoAddrBalance
      { BinfoBalance -> Address
address :: !Address,
        BinfoBalance -> Word64
txs :: !Word64,
        BinfoBalance -> Word64
received :: !Word64,
        BinfoBalance -> Word64
sent :: !Word64,
        BinfoBalance -> Word64
balance :: !Word64
      }
  | BinfoXPubBalance
      { BinfoBalance -> XPubKey
xpub :: !XPubKey,
        txs :: !Word64,
        received :: !Word64,
        sent :: !Word64,
        balance :: !Word64,
        BinfoBalance -> BlockHeight
external :: !Word32,
        BinfoBalance -> BlockHeight
change :: !Word32
      }
  deriving (BinfoBalance -> BinfoBalance -> Bool
(BinfoBalance -> BinfoBalance -> Bool)
-> (BinfoBalance -> BinfoBalance -> Bool) -> Eq BinfoBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoBalance -> BinfoBalance -> Bool
== :: BinfoBalance -> BinfoBalance -> Bool
$c/= :: BinfoBalance -> BinfoBalance -> Bool
/= :: BinfoBalance -> BinfoBalance -> Bool
Eq, Int -> BinfoBalance -> ShowS
[BinfoBalance] -> ShowS
BinfoBalance -> String
(Int -> BinfoBalance -> ShowS)
-> (BinfoBalance -> String)
-> ([BinfoBalance] -> ShowS)
-> Show BinfoBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoBalance -> ShowS
showsPrec :: Int -> BinfoBalance -> ShowS
$cshow :: BinfoBalance -> String
show :: BinfoBalance -> String
$cshowList :: [BinfoBalance] -> ShowS
showList :: [BinfoBalance] -> ShowS
Show, (forall x. BinfoBalance -> Rep BinfoBalance x)
-> (forall x. Rep BinfoBalance x -> BinfoBalance)
-> Generic BinfoBalance
forall x. Rep BinfoBalance x -> BinfoBalance
forall x. BinfoBalance -> Rep BinfoBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoBalance -> Rep BinfoBalance x
from :: forall x. BinfoBalance -> Rep BinfoBalance x
$cto :: forall x. Rep BinfoBalance x -> BinfoBalance
to :: forall x. Rep BinfoBalance x -> BinfoBalance
Generic, BinfoBalance -> ()
(BinfoBalance -> ()) -> NFData BinfoBalance
forall a. (a -> ()) -> NFData a
$crnf :: BinfoBalance -> ()
rnf :: BinfoBalance -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoBalance where
  marshalValue :: (Network, Ctx) -> BinfoBalance -> Value
marshalValue (Network
net, Ctx
ctx) b :: BinfoBalance
b@BinfoAddrBalance {} =
    [Pair] -> Value
A.object
      [ Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net BinfoBalance
b.address,
        Key
"final_balance" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.balance,
        Key
"n_tx" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.txs,
        Key
"total_received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.received,
        Key
"total_sent" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.sent
      ]
  marshalValue (Network
net, Ctx
ctx) b :: BinfoBalance
b@BinfoXPubBalance {} =
    [Pair] -> Value
A.object
      [ Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network, Ctx) -> XPubKey -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx) BinfoBalance
b.xpub,
        Key
"change_index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.change,
        Key
"account_index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.external,
        Key
"final_balance" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.balance,
        Key
"n_tx" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.txs,
        Key
"total_received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.received,
        Key
"total_sent" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBalance
b.sent
      ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoBalance
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoBalance) -> Value -> Parser BinfoBalance
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoBalance" ((Object -> Parser BinfoBalance) -> Value -> Parser BinfoBalance)
-> (Object -> Parser BinfoBalance) -> Value -> Parser BinfoBalance
forall a b. (a -> b) -> a -> b
$ \Object
o -> Object -> Parser BinfoBalance
x Object
o Parser BinfoBalance -> Parser BinfoBalance -> Parser BinfoBalance
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser BinfoBalance
a Object
o
    where
      x :: Object -> Parser BinfoBalance
x Object
o = do
        XPubKey
xpub <- (Network, Ctx) -> Value -> Parser XPubKey
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx) (Value -> Parser XPubKey) -> Parser Value -> Parser XPubKey
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
        BlockHeight
change <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"change_index"
        BlockHeight
external <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account_index"
        Word64
balance <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"final_balance"
        Word64
txs <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx"
        Word64
received <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_received"
        Word64
sent <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_sent"
        BinfoBalance -> Parser BinfoBalance
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoXPubBalance {BlockHeight
Word64
XPubKey
$sel:txs:BinfoAddrBalance :: Word64
$sel:received:BinfoAddrBalance :: Word64
$sel:sent:BinfoAddrBalance :: Word64
$sel:balance:BinfoAddrBalance :: Word64
$sel:xpub:BinfoAddrBalance :: XPubKey
$sel:external:BinfoAddrBalance :: BlockHeight
$sel:change:BinfoAddrBalance :: BlockHeight
xpub :: XPubKey
change :: BlockHeight
external :: BlockHeight
balance :: Word64
txs :: Word64
received :: Word64
sent :: Word64
..}
      a :: Object -> Parser BinfoBalance
a Object
o = do
        Address
address <- Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue 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 -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
        Word64
balance <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"final_balance"
        Word64
txs <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx"
        Word64
received <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_received"
        Word64
sent <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_sent"
        BinfoBalance -> Parser BinfoBalance
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoAddrBalance {Word64
Address
$sel:address:BinfoAddrBalance :: Address
$sel:txs:BinfoAddrBalance :: Word64
$sel:received:BinfoAddrBalance :: Word64
$sel:sent:BinfoAddrBalance :: Word64
$sel:balance:BinfoAddrBalance :: Word64
address :: Address
balance :: Word64
txs :: Word64
received :: Word64
sent :: Word64
..}

  marshalEncoding :: (Network, Ctx) -> BinfoBalance -> Encoding
marshalEncoding (Network
net, Ctx
ctx) b :: BinfoBalance
b@BinfoAddrBalance {} =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"address" Key -> Encoding -> Series
`A.pair` Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net BinfoBalance
b.address,
          Key
"final_balance" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.balance,
          Key
"n_tx" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.txs,
          Key
"total_received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.received,
          Key
"total_sent" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.sent
        ]
  marshalEncoding (Network
net, Ctx
ctx) b :: BinfoBalance
b@BinfoXPubBalance {} =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"address" Key -> Encoding -> Series
`A.pair` (Network, Ctx) -> XPubKey -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoBalance
b.xpub,
          Key
"change_index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBalance
b.change,
          Key
"account_index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBalance
b.external,
          Key
"final_balance" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.balance,
          Key
"n_tx" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.txs,
          Key
"total_received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.received,
          Key
"total_sent" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBalance
b.sent
        ]

instance MarshalJSON (Network, Ctx) [BinfoBalance] where
  marshalValue :: (Network, Ctx) -> [BinfoBalance] -> Value
marshalValue (Network
net, Ctx
ctx) [BinfoBalance]
addrs =
    [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (BinfoBalance -> Value) -> [BinfoBalance] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoBalance -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) [BinfoBalance]
addrs
  marshalEncoding :: (Network, Ctx) -> [BinfoBalance] -> Encoding
marshalEncoding (Network
net, Ctx
ctx) =
    (BinfoBalance -> Encoding) -> [BinfoBalance] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoBalance -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx))
  unmarshalValue :: (Network, Ctx) -> Value -> Parser [BinfoBalance]
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Array -> Parser [BinfoBalance])
-> Value
-> Parser [BinfoBalance]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray String
"[BinfoBalance]" ((Array -> Parser [BinfoBalance])
 -> Value -> Parser [BinfoBalance])
-> (Array -> Parser [BinfoBalance])
-> Value
-> Parser [BinfoBalance]
forall a b. (a -> b) -> a -> b
$
      (Vector BinfoBalance -> [BinfoBalance])
-> Parser (Vector BinfoBalance) -> Parser [BinfoBalance]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector BinfoBalance -> [BinfoBalance]
forall a. Vector a -> [a]
V.toList (Parser (Vector BinfoBalance) -> Parser [BinfoBalance])
-> (Array -> Parser (Vector BinfoBalance))
-> Array
-> Parser [BinfoBalance]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser BinfoBalance)
-> Array -> Parser (Vector BinfoBalance)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM ((Network, Ctx) -> Value -> Parser BinfoBalance
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx))

data BinfoWallet = BinfoWallet
  { BinfoWallet -> Word64
balance :: !Word64,
    BinfoWallet -> Word64
txs :: !Word64,
    BinfoWallet -> Word64
filtered :: !Word64,
    BinfoWallet -> Word64
received :: !Word64,
    BinfoWallet -> Word64
sent :: !Word64
  }
  deriving (BinfoWallet -> BinfoWallet -> Bool
(BinfoWallet -> BinfoWallet -> Bool)
-> (BinfoWallet -> BinfoWallet -> Bool) -> Eq BinfoWallet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoWallet -> BinfoWallet -> Bool
== :: BinfoWallet -> BinfoWallet -> Bool
$c/= :: BinfoWallet -> BinfoWallet -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoWallet -> ShowS
showsPrec :: Int -> BinfoWallet -> ShowS
$cshow :: BinfoWallet -> String
show :: BinfoWallet -> String
$cshowList :: [BinfoWallet] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoWallet -> Rep BinfoWallet x
from :: forall x. BinfoWallet -> Rep BinfoWallet x
$cto :: forall x. Rep BinfoWallet x -> BinfoWallet
to :: forall x. Rep BinfoWallet x -> BinfoWallet
Generic, BinfoWallet -> ()
(BinfoWallet -> ()) -> NFData BinfoWallet
forall a. (a -> ()) -> NFData a
$crnf :: BinfoWallet -> ()
rnf :: BinfoWallet -> ()
NFData)

instance ToJSON BinfoWallet where
  toJSON :: BinfoWallet -> Value
toJSON BinfoWallet
w =
    [Pair] -> Value
A.object
      [ Key
"final_balance" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoWallet
w.balance,
        Key
"n_tx" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoWallet
w.txs,
        Key
"n_tx_filtered" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoWallet
w.filtered,
        Key
"total_received" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoWallet
w.received,
        Key
"total_sent" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoWallet
w.sent
      ]
  toEncoding :: BinfoWallet -> Encoding
toEncoding BinfoWallet
w =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"final_balance" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoWallet
w.balance,
          Key
"n_tx" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoWallet
w.txs,
          Key
"n_tx_filtered" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoWallet
w.filtered,
          Key
"total_received" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoWallet
w.received,
          Key
"total_sent" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoWallet
w.sent
        ]

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
A.withObject String
"BinfoWallet" ((Object -> Parser BinfoWallet) -> Value -> Parser BinfoWallet)
-> (Object -> Parser BinfoWallet) -> Value -> Parser BinfoWallet
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Word64
balance <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"final_balance"
      Word64
txs <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx"
      Word64
filtered <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx_filtered"
      Word64
received <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_received"
      Word64
sent <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_sent"
      BinfoWallet -> Parser BinfoWallet
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoWallet {Word64
$sel:balance:BinfoWallet :: Word64
$sel:txs:BinfoWallet :: Word64
$sel:filtered:BinfoWallet :: Word64
$sel:received:BinfoWallet :: Word64
$sel:sent:BinfoWallet :: Word64
balance :: Word64
txs :: Word64
filtered :: Word64
received :: Word64
sent :: Word64
..}

binfoHexValue :: Word64 -> Text
binfoHexValue :: Word64 -> Text
binfoHexValue Word64
w64 =
  WitnessStackItem -> Text
encodeHex (WitnessStackItem -> Text) -> WitnessStackItem -> Text
forall a b. (a -> b) -> a -> b
$
    if WitnessStackItem -> Bool
B.null WitnessStackItem
bs Bool -> Bool -> Bool
|| HasCallStack => WitnessStackItem -> Word8
WitnessStackItem -> Word8
B.head WitnessStackItem
bs Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
      then Word8 -> WitnessStackItem -> WitnessStackItem
B.cons Word8
0x00 WitnessStackItem
bs
      else WitnessStackItem
bs
  where
    bs :: WitnessStackItem
bs =
      (Word8 -> Bool) -> WitnessStackItem -> WitnessStackItem
B.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00) (WitnessStackItem -> WitnessStackItem)
-> WitnessStackItem -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$
        Put -> WitnessStackItem
runPutS (Put -> WitnessStackItem) -> Put -> WitnessStackItem
forall a b. (a -> b) -> a -> b
$
          Word64 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
serialize Word64
w64

data BinfoUnspent = BinfoUnspent
  { BinfoUnspent -> TxHash
txid :: !TxHash,
    BinfoUnspent -> BlockHeight
index :: !Word32,
    BinfoUnspent -> WitnessStackItem
script :: !ByteString,
    BinfoUnspent -> Word64
value :: !Word64,
    BinfoUnspent -> Int32
confirmations :: !Int32,
    BinfoUnspent -> BinfoTxId
txidx :: !BinfoTxId,
    BinfoUnspent -> Maybe BinfoXPubPath
xpub :: !(Maybe BinfoXPubPath)
  }
  deriving (BinfoUnspent -> BinfoUnspent -> Bool
(BinfoUnspent -> BinfoUnspent -> Bool)
-> (BinfoUnspent -> BinfoUnspent -> Bool) -> Eq BinfoUnspent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoUnspent -> BinfoUnspent -> Bool
== :: BinfoUnspent -> BinfoUnspent -> Bool
$c/= :: BinfoUnspent -> BinfoUnspent -> Bool
/= :: BinfoUnspent -> BinfoUnspent -> Bool
Eq, Int -> BinfoUnspent -> ShowS
[BinfoUnspent] -> ShowS
BinfoUnspent -> String
(Int -> BinfoUnspent -> ShowS)
-> (BinfoUnspent -> String)
-> ([BinfoUnspent] -> ShowS)
-> Show BinfoUnspent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoUnspent -> ShowS
showsPrec :: Int -> BinfoUnspent -> ShowS
$cshow :: BinfoUnspent -> String
show :: BinfoUnspent -> String
$cshowList :: [BinfoUnspent] -> ShowS
showList :: [BinfoUnspent] -> ShowS
Show, (forall x. BinfoUnspent -> Rep BinfoUnspent x)
-> (forall x. Rep BinfoUnspent x -> BinfoUnspent)
-> Generic BinfoUnspent
forall x. Rep BinfoUnspent x -> BinfoUnspent
forall x. BinfoUnspent -> Rep BinfoUnspent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoUnspent -> Rep BinfoUnspent x
from :: forall x. BinfoUnspent -> Rep BinfoUnspent x
$cto :: forall x. Rep BinfoUnspent x -> BinfoUnspent
to :: forall x. Rep BinfoUnspent x -> BinfoUnspent
Generic, BinfoUnspent -> ()
(BinfoUnspent -> ()) -> NFData BinfoUnspent
forall a. (a -> ()) -> NFData a
$crnf :: BinfoUnspent -> ()
rnf :: BinfoUnspent -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoUnspent where
  marshalValue :: (Network, Ctx) -> BinfoUnspent -> Value
marshalValue (Network
net, Ctx
ctx) BinfoUnspent
u =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"tx_hash_big_endian" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoUnspent
u.txid,
        Key
"tx_hash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex (Put -> WitnessStackItem
runPutS (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize BinfoUnspent
u.txid.get)),
        Key
"tx_output_n" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoUnspent
u.index,
        Key
"script" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex BinfoUnspent
u.script,
        Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoUnspent
u.value,
        Key
"value_hex" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Word64 -> Text
binfoHexValue BinfoUnspent
u.value,
        Key
"confirmations" Key -> Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoUnspent
u.confirmations,
        Key
"tx_index" Key -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoUnspent
u.txidx
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"xpub" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network, Ctx) -> BinfoXPubPath -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx) BinfoXPubPath
x
             | BinfoXPubPath
x <- Maybe BinfoXPubPath -> [BinfoXPubPath]
forall a. Maybe a -> [a]
maybeToList BinfoUnspent
u.xpub
           ]

  marshalEncoding :: (Network, Ctx) -> BinfoUnspent -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoUnspent
u =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"tx_hash_big_endian" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoUnspent
u.txid,
          Key
"tx_hash" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (Put -> ByteString
runPutL (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize BinfoUnspent
u.txid.get)),
          Key
"tx_output_n" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoUnspent
u.index,
          Key
"script" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict BinfoUnspent
u.script),
          Key
"value" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoUnspent
u.value,
          Key
"value_hex" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text (Word64 -> Text
binfoHexValue BinfoUnspent
u.value),
          Key
"confirmations" Key -> Encoding -> Series
`A.pair` Int32 -> Encoding
A.int32 BinfoUnspent
u.confirmations,
          Key
"tx_index" Key -> Encoding -> Series
`A.pair` BinfoTxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoUnspent
u.txidx,
          Series
-> (BinfoXPubPath -> Series) -> Maybe BinfoXPubPath -> Series
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Series
forall a. Monoid a => a
mempty ((Key
"xpub" Key -> Encoding -> Series
`A.pair`) (Encoding -> Series)
-> (BinfoXPubPath -> Encoding) -> BinfoXPubPath -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Network, Ctx) -> BinfoXPubPath -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoUnspent
u.xpub
        ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoUnspent
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoUnspent) -> Value -> Parser BinfoUnspent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoUnspent" ((Object -> Parser BinfoUnspent) -> Value -> Parser BinfoUnspent)
-> (Object -> Parser BinfoUnspent) -> Value -> Parser BinfoUnspent
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      TxHash
txid <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_hash_big_endian"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_output_n"
      WitnessStackItem
script <- Parser WitnessStackItem
-> (WitnessStackItem -> Parser WitnessStackItem)
-> Maybe WitnessStackItem
-> Parser WitnessStackItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser WitnessStackItem
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero WitnessStackItem -> Parser WitnessStackItem
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WitnessStackItem -> Parser WitnessStackItem)
-> (Text -> Maybe WitnessStackItem)
-> Text
-> Parser WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe WitnessStackItem
decodeHex (Text -> Parser WitnessStackItem)
-> Parser Text -> Parser WitnessStackItem
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script"
      Word64
value <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Int32
confirmations <- Object
o Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confirmations"
      BinfoTxId
txidx <- Object
o Object -> Key -> Parser BinfoTxId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_index"
      Maybe BinfoXPubPath
xpub <- (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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ((Network, Ctx) -> Value -> Parser BinfoXPubPath
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) (Maybe Value -> Parser (Maybe BinfoXPubPath))
-> Parser (Maybe Value) -> Parser (Maybe BinfoXPubPath)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"xpub"
      BinfoUnspent -> Parser BinfoUnspent
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoUnspent {Int32
Maybe BinfoXPubPath
BlockHeight
Word64
WitnessStackItem
TxHash
BinfoTxId
$sel:txid:BinfoUnspent :: TxHash
$sel:index:BinfoUnspent :: BlockHeight
$sel:script:BinfoUnspent :: WitnessStackItem
$sel:value:BinfoUnspent :: Word64
$sel:confirmations:BinfoUnspent :: Int32
$sel:txidx:BinfoUnspent :: BinfoTxId
$sel:xpub:BinfoUnspent :: Maybe BinfoXPubPath
txid :: TxHash
index :: BlockHeight
script :: WitnessStackItem
value :: Word64
confirmations :: Int32
txidx :: BinfoTxId
xpub :: Maybe BinfoXPubPath
..}

newtype BinfoUnspents = BinfoUnspents [BinfoUnspent]
  deriving (BinfoUnspents -> BinfoUnspents -> Bool
(BinfoUnspents -> BinfoUnspents -> Bool)
-> (BinfoUnspents -> BinfoUnspents -> Bool) -> Eq BinfoUnspents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoUnspents -> BinfoUnspents -> Bool
== :: BinfoUnspents -> BinfoUnspents -> Bool
$c/= :: BinfoUnspents -> BinfoUnspents -> Bool
/= :: BinfoUnspents -> BinfoUnspents -> Bool
Eq, Int -> BinfoUnspents -> ShowS
[BinfoUnspents] -> ShowS
BinfoUnspents -> String
(Int -> BinfoUnspents -> ShowS)
-> (BinfoUnspents -> String)
-> ([BinfoUnspents] -> ShowS)
-> Show BinfoUnspents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoUnspents -> ShowS
showsPrec :: Int -> BinfoUnspents -> ShowS
$cshow :: BinfoUnspents -> String
show :: BinfoUnspents -> String
$cshowList :: [BinfoUnspents] -> ShowS
showList :: [BinfoUnspents] -> ShowS
Show, (forall x. BinfoUnspents -> Rep BinfoUnspents x)
-> (forall x. Rep BinfoUnspents x -> BinfoUnspents)
-> Generic BinfoUnspents
forall x. Rep BinfoUnspents x -> BinfoUnspents
forall x. BinfoUnspents -> Rep BinfoUnspents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoUnspents -> Rep BinfoUnspents x
from :: forall x. BinfoUnspents -> Rep BinfoUnspents x
$cto :: forall x. Rep BinfoUnspents x -> BinfoUnspents
to :: forall x. Rep BinfoUnspents x -> BinfoUnspents
Generic, BinfoUnspents -> ()
(BinfoUnspents -> ()) -> NFData BinfoUnspents
forall a. (a -> ()) -> NFData a
$crnf :: BinfoUnspents -> ()
rnf :: BinfoUnspents -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoUnspents where
  marshalValue :: (Network, Ctx) -> BinfoUnspents -> Value
marshalValue (Network
net, Ctx
ctx) (BinfoUnspents [BinfoUnspent]
us) =
    [Pair] -> Value
A.object
      [ Key
"notice" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
T.empty,
        Key
"unspent_outputs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoUnspent -> Value) -> [BinfoUnspent] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoUnspent -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) [BinfoUnspent]
us
      ]

  marshalEncoding :: (Network, Ctx) -> BinfoUnspents -> Encoding
marshalEncoding (Network
net, Ctx
ctx) (BinfoUnspents [BinfoUnspent]
us) =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"notice" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text Text
T.empty,
          Key
"unspent_outputs" Key -> Encoding -> Series
`A.pair` (BinfoUnspent -> Encoding) -> [BinfoUnspent] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoUnspent -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) [BinfoUnspent]
us
        ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoUnspents
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoUnspents)
-> Value
-> Parser BinfoUnspents
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoUnspents" ((Object -> Parser BinfoUnspents) -> Value -> Parser BinfoUnspents)
-> (Object -> Parser BinfoUnspents)
-> Value
-> Parser BinfoUnspents
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      [BinfoUnspent]
us <- (Value -> Parser BinfoUnspent) -> [Value] -> Parser [BinfoUnspent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoUnspent
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) ([Value] -> Parser [BinfoUnspent])
-> Parser [Value] -> Parser [BinfoUnspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unspent_outputs"
      BinfoUnspents -> Parser BinfoUnspents
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([BinfoUnspent] -> BinfoUnspents
BinfoUnspents [BinfoUnspent]
us)

toBinfoBlock :: BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock :: BlockData -> [BinfoTx] -> [BlockHash] -> BinfoBlock
toBinfoBlock BlockData
b [BinfoTx]
transactions [BlockHash]
next_blocks =
  BinfoBlock
    { $sel:hash:BinfoBlock :: BlockHash
hash = BlockHeader -> BlockHash
headerHash BlockData
b.header,
      $sel:version:BinfoBlock :: BlockHeight
version = BlockData
b.header.version,
      $sel:prev:BinfoBlock :: BlockHash
prev = BlockData
b.header.prev,
      $sel:merkle:BinfoBlock :: Hash256
merkle = BlockData
b.header.merkle,
      $sel:timestamp:BinfoBlock :: BlockHeight
timestamp = BlockData
b.header.timestamp,
      $sel:bits:BinfoBlock :: BlockHeight
bits = BlockData
b.header.bits,
      $sel:next:BinfoBlock :: [BlockHash]
next = [BlockHash]
next_blocks,
      $sel:fee:BinfoBlock :: Word64
fee = BlockData
b.fee,
      $sel:nonce:BinfoBlock :: BlockHeight
nonce = BlockData
b.header.nonce,
      $sel:ntx:BinfoBlock :: BlockHeight
ntx = Int -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([BinfoTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
transactions),
      $sel:size:BinfoBlock :: BlockHeight
size = BlockData
b.size,
      $sel:index:BinfoBlock :: BlockHeight
index = BlockData
b.height,
      $sel:main:BinfoBlock :: Bool
main = BlockData
b.main,
      $sel:height:BinfoBlock :: BlockHeight
height = BlockData
b.height,
      $sel:weight:BinfoBlock :: BlockHeight
weight = BlockData
b.weight,
      $sel:txs:BinfoBlock :: [BinfoTx]
txs = [BinfoTx]
transactions
    }

data BinfoBlock = BinfoBlock
  { BinfoBlock -> BlockHash
hash :: !BlockHash,
    BinfoBlock -> BlockHeight
version :: !Word32,
    BinfoBlock -> BlockHash
prev :: !BlockHash,
    BinfoBlock -> Hash256
merkle :: !Hash256,
    BinfoBlock -> BlockHeight
timestamp :: !Word32,
    BinfoBlock -> BlockHeight
bits :: !Word32,
    BinfoBlock -> [BlockHash]
next :: ![BlockHash],
    BinfoBlock -> Word64
fee :: !Word64,
    BinfoBlock -> BlockHeight
nonce :: !Word32,
    BinfoBlock -> BlockHeight
ntx :: !Word32,
    BinfoBlock -> BlockHeight
size :: !Word32,
    BinfoBlock -> BlockHeight
index :: !Word32,
    BinfoBlock -> Bool
main :: !Bool,
    BinfoBlock -> BlockHeight
height :: !Word32,
    BinfoBlock -> BlockHeight
weight :: !Word32,
    BinfoBlock -> [BinfoTx]
txs :: ![BinfoTx]
  }
  deriving (BinfoBlock -> BinfoBlock -> Bool
(BinfoBlock -> BinfoBlock -> Bool)
-> (BinfoBlock -> BinfoBlock -> Bool) -> Eq BinfoBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoBlock -> BinfoBlock -> Bool
== :: BinfoBlock -> BinfoBlock -> Bool
$c/= :: BinfoBlock -> BinfoBlock -> Bool
/= :: BinfoBlock -> BinfoBlock -> Bool
Eq, Int -> BinfoBlock -> ShowS
[BinfoBlock] -> ShowS
BinfoBlock -> String
(Int -> BinfoBlock -> ShowS)
-> (BinfoBlock -> String)
-> ([BinfoBlock] -> ShowS)
-> Show BinfoBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoBlock -> ShowS
showsPrec :: Int -> BinfoBlock -> ShowS
$cshow :: BinfoBlock -> String
show :: BinfoBlock -> String
$cshowList :: [BinfoBlock] -> ShowS
showList :: [BinfoBlock] -> ShowS
Show, (forall x. BinfoBlock -> Rep BinfoBlock x)
-> (forall x. Rep BinfoBlock x -> BinfoBlock) -> Generic BinfoBlock
forall x. Rep BinfoBlock x -> BinfoBlock
forall x. BinfoBlock -> Rep BinfoBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoBlock -> Rep BinfoBlock x
from :: forall x. BinfoBlock -> Rep BinfoBlock x
$cto :: forall x. Rep BinfoBlock x -> BinfoBlock
to :: forall x. Rep BinfoBlock x -> BinfoBlock
Generic, BinfoBlock -> ()
(BinfoBlock -> ()) -> NFData BinfoBlock
forall a. (a -> ()) -> NFData a
$crnf :: BinfoBlock -> ()
rnf :: BinfoBlock -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoBlock where
  marshalValue :: (Network, Ctx) -> BinfoBlock -> Value
marshalValue (Network
net, Ctx
ctx) BinfoBlock
b =
    [Pair] -> Value
A.object
      [ Key
"hash" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.hash,
        Key
"ver" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.version,
        Key
"prev_block" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.prev,
        Key
"mrkl_root" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash256 -> TxHash
TxHash BinfoBlock
b.merkle,
        Key
"time" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.timestamp,
        Key
"bits" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.bits,
        Key
"next_block" Key -> [BlockHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.next,
        Key
"fee" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.fee,
        Key
"nonce" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.nonce,
        Key
"n_tx" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.ntx,
        Key
"size" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.size,
        Key
"block_index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.index,
        Key
"main_chain" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.main,
        Key
"height" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.height,
        Key
"weight" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlock
b.weight,
        Key
"tx" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTx -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) BinfoBlock
b.txs
      ]

  marshalEncoding :: (Network, Ctx) -> BinfoBlock -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoBlock
b =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"hash" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoBlock
b.hash,
          Key
"ver" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.version,
          Key
"prev_block" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoBlock
b.prev,
          Key
"mrkl_root" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Hash256 -> TxHash
TxHash BinfoBlock
b.merkle),
          Key
"time" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.timestamp,
          Key
"bits" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.bits,
          Key
"next_block" Key -> Encoding -> Series
`A.pair` [BlockHash] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoBlock
b.next,
          Key
"fee" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoBlock
b.fee,
          Key
"nonce" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.nonce,
          Key
"n_tx" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.ntx,
          Key
"size" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.size,
          Key
"block_index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.index,
          Key
"main_chain" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BinfoBlock
b.main,
          Key
"height" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.height,
          Key
"weight" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlock
b.weight,
          Key
"tx" Key -> Encoding -> Series
`A.pair` (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTx -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoBlock
b.txs
        ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoBlock
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoBlock) -> Value -> Parser BinfoBlock
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoBlock" ((Object -> Parser BinfoBlock) -> Value -> Parser BinfoBlock)
-> (Object -> Parser BinfoBlock) -> Value -> Parser BinfoBlock
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHash
hash <- Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash"
      BlockHeight
version <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ver"
      BlockHash
prev <- Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prev_block"
      Hash256
merkle <- (\(TxHash Hash256
h) -> Hash256
h) (TxHash -> Hash256) -> Parser TxHash -> Parser Hash256
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mrkl_root"
      BlockHeight
timestamp <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      BlockHeight
bits <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bits"
      [BlockHash]
next <- Object
o Object -> Key -> Parser [BlockHash]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"next_block"
      Word64
fee <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fee"
      BlockHeight
nonce <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nonce"
      BlockHeight
ntx <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n_tx"
      BlockHeight
size <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_index"
      Bool
main <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"main_chain"
      BlockHeight
height <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
      BlockHeight
weight <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"weight"
      [BinfoTx]
txs <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx" Parser [Value] -> ([Value] -> Parser [BinfoTx]) -> Parser [BinfoTx]
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser BinfoTx) -> [Value] -> Parser [BinfoTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoTx
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx))
      BinfoBlock -> Parser BinfoBlock
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoBlock {Bool
[BlockHash]
[BinfoTx]
BlockHeight
Word64
Hash256
BlockHash
$sel:hash:BinfoBlock :: BlockHash
$sel:version:BinfoBlock :: BlockHeight
$sel:prev:BinfoBlock :: BlockHash
$sel:merkle:BinfoBlock :: Hash256
$sel:timestamp:BinfoBlock :: BlockHeight
$sel:bits:BinfoBlock :: BlockHeight
$sel:next:BinfoBlock :: [BlockHash]
$sel:fee:BinfoBlock :: Word64
$sel:nonce:BinfoBlock :: BlockHeight
$sel:ntx:BinfoBlock :: BlockHeight
$sel:size:BinfoBlock :: BlockHeight
$sel:index:BinfoBlock :: BlockHeight
$sel:main:BinfoBlock :: Bool
$sel:height:BinfoBlock :: BlockHeight
$sel:weight:BinfoBlock :: BlockHeight
$sel:txs:BinfoBlock :: [BinfoTx]
hash :: BlockHash
version :: BlockHeight
prev :: BlockHash
merkle :: Hash256
timestamp :: BlockHeight
bits :: BlockHeight
next :: [BlockHash]
fee :: Word64
nonce :: BlockHeight
ntx :: BlockHeight
size :: BlockHeight
index :: BlockHeight
main :: Bool
height :: BlockHeight
weight :: BlockHeight
txs :: [BinfoTx]
..}

instance MarshalJSON (Network, Ctx) [BinfoBlock] where
  marshalValue :: (Network, Ctx) -> [BinfoBlock] -> Value
marshalValue (Network
net, Ctx
ctx) [BinfoBlock]
blocks =
    [Pair] -> Value
A.object [Key
"blocks" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoBlock -> Value) -> [BinfoBlock] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoBlock -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) [BinfoBlock]
blocks]

  marshalEncoding :: (Network, Ctx) -> [BinfoBlock] -> Encoding
marshalEncoding (Network
net, Ctx
ctx) [BinfoBlock]
blocks =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key
"blocks" Key -> Encoding -> Series
`A.pair` (BinfoBlock -> Encoding) -> [BinfoBlock] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoBlock -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) [BinfoBlock]
blocks

  unmarshalValue :: (Network, Ctx) -> Value -> Parser [BinfoBlock]
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser [BinfoBlock]) -> Value -> Parser [BinfoBlock]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"blocks" ((Object -> Parser [BinfoBlock]) -> Value -> Parser [BinfoBlock])
-> (Object -> Parser [BinfoBlock]) -> Value -> Parser [BinfoBlock]
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      (Value -> Parser BinfoBlock) -> [Value] -> Parser [BinfoBlock]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoBlock
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) ([Value] -> Parser [BinfoBlock])
-> Parser [Value] -> Parser [BinfoBlock]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocks"

data BinfoTx = BinfoTx
  { BinfoTx -> TxHash
txid :: !TxHash,
    BinfoTx -> BlockHeight
version :: !Word32,
    BinfoTx -> BlockHeight
inputCount :: !Word32,
    BinfoTx -> BlockHeight
outputCount :: !Word32,
    BinfoTx -> BlockHeight
size :: !Word32,
    BinfoTx -> BlockHeight
weight :: !Word32,
    BinfoTx -> Word64
fee :: !Word64,
    BinfoTx -> WitnessStackItem
relayed :: !ByteString,
    BinfoTx -> BlockHeight
locktime :: !Word32,
    BinfoTx -> BinfoTxId
index :: !BinfoTxId,
    BinfoTx -> Bool
doubleSpend :: !Bool,
    BinfoTx -> Bool
rbf :: !Bool,
    BinfoTx -> Maybe (Int64, Int64)
balance :: !(Maybe (Int64, Int64)),
    BinfoTx -> Word64
timestamp :: !Word64,
    BinfoTx -> Maybe BlockHeight
blockIndex :: !(Maybe Word32),
    BinfoTx -> Maybe BlockHeight
blockHeight :: !(Maybe Word32),
    BinfoTx -> [BinfoTxInput]
inputs :: ![BinfoTxInput],
    BinfoTx -> [BinfoTxOutput]
outputs :: ![BinfoTxOutput]
  }
  deriving (BinfoTx -> BinfoTx -> Bool
(BinfoTx -> BinfoTx -> Bool)
-> (BinfoTx -> BinfoTx -> Bool) -> Eq BinfoTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoTx -> BinfoTx -> Bool
== :: BinfoTx -> BinfoTx -> Bool
$c/= :: BinfoTx -> BinfoTx -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoTx -> ShowS
showsPrec :: Int -> BinfoTx -> ShowS
$cshow :: BinfoTx -> String
show :: BinfoTx -> String
$cshowList :: [BinfoTx] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoTx -> Rep BinfoTx x
from :: forall x. BinfoTx -> Rep BinfoTx x
$cto :: forall x. Rep BinfoTx x -> BinfoTx
to :: forall x. Rep BinfoTx x -> BinfoTx
Generic, BinfoTx -> ()
(BinfoTx -> ()) -> NFData BinfoTx
forall a. (a -> ()) -> NFData a
$crnf :: BinfoTx -> ()
rnf :: BinfoTx -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoTx where
  marshalValue :: (Network, Ctx) -> BinfoTx -> Value
marshalValue (Network
net, Ctx
ctx) BinfoTx
t =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"hash" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.txid,
        Key
"ver" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.version,
        Key
"vin_sz" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.inputCount,
        Key
"vout_sz" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.outputCount,
        Key
"size" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.size,
        Key
"weight" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.weight,
        Key
"fee" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.fee,
        Key
"relayed_by" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
T.decodeUtf8 BinfoTx
t.relayed,
        Key
"lock_time" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.locktime,
        Key
"tx_index" Key -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.index,
        Key
"double_spend" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.doubleSpend,
        Key
"time" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.timestamp,
        Key
"block_index" Key -> Maybe BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.blockIndex,
        Key
"block_height" Key -> Maybe BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTx
t.blockHeight,
        Key
"inputs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoTxInput -> Value) -> [BinfoTxInput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTxInput -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) BinfoTx
t.inputs,
        Key
"out" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoTxOutput -> Value) -> [BinfoTxOutput] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTxOutput -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) BinfoTx
t.outputs
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
bal
        [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
rbf
    where
      bal :: [Pair]
bal =
        case BinfoTx
t.balance of
          Maybe (Int64, Int64)
Nothing -> []
          Just (Int64
r, Int64
b) -> [Key
"result" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int64
r, Key
"balance" Key -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Int64
b]
      rbf :: [Pair]
rbf = [Key
"rbf" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
True | BinfoTx
t.rbf]

  marshalEncoding :: (Network, Ctx) -> BinfoTx -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoTx
t =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"hash" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoTx
t.txid,
          Key
"ver" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTx
t.version,
          Key
"vin_sz" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTx
t.inputCount,
          Key
"vout_sz" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTx
t.outputCount,
          Key
"size" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTx
t.size,
          Key
"weight" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTx
t.weight,
          Key
"fee" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoTx
t.fee,
          Key
"relayed_by" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text (WitnessStackItem -> Text
T.decodeUtf8 BinfoTx
t.relayed),
          Key
"lock_time" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTx
t.locktime,
          Key
"tx_index" Key -> Encoding -> Series
`A.pair` BinfoTxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoTx
t.index,
          Key
"double_spend" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BinfoTx
t.doubleSpend,
          Key
"time" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoTx
t.timestamp,
          Key
"block_index" Key -> Encoding -> Series
`A.pair` Maybe BlockHeight -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoTx
t.blockIndex,
          Key
"block_height" Key -> Encoding -> Series
`A.pair` Encoding
-> (BlockHeight -> Encoding) -> Maybe BlockHeight -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
A.null_ BlockHeight -> Encoding
A.word32 BinfoTx
t.blockHeight,
          Key
"inputs" Key -> Encoding -> Series
`A.pair` (BinfoTxInput -> Encoding) -> [BinfoTxInput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTxInput -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoTx
t.inputs,
          Key
"out" Key -> Encoding -> Series
`A.pair` (BinfoTxOutput -> Encoding) -> [BinfoTxOutput] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTxOutput -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) BinfoTx
t.outputs,
          Series
bal,
          Series
rbf
        ]
    where
      bal :: Series
bal =
        case BinfoTx
t.balance of
          Maybe (Int64, Int64)
Nothing -> Series
forall a. Monoid a => a
mempty
          Just (Int64
r, Int64
b) ->
            Key
"result" Key -> Encoding -> Series
`A.pair` Int64 -> Encoding
A.int64 Int64
r Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"balance" Key -> Encoding -> Series
`A.pair` Int64 -> Encoding
A.int64 Int64
b
      rbf :: Series
rbf = if BinfoTx
t.rbf then Key
"rbf" Key -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Series
.= Bool
True else Series
forall a. Monoid a => a
mempty

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoTx
unmarshalValue (Network
net, Ctx
ctx) = String -> (Object -> Parser BinfoTx) -> Value -> Parser BinfoTx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoTx" ((Object -> Parser BinfoTx) -> Value -> Parser BinfoTx)
-> (Object -> Parser BinfoTx) -> Value -> Parser BinfoTx
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TxHash
txid <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash"
    BlockHeight
version <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ver"
    BlockHeight
inputCount <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vin_sz"
    BlockHeight
outputCount <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vout_sz"
    BlockHeight
size <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
    BlockHeight
weight <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"weight"
    Word64
fee <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fee"
    WitnessStackItem
relayed <- Text -> WitnessStackItem
T.encodeUtf8 (Text -> WitnessStackItem)
-> Parser Text -> Parser WitnessStackItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"relayed_by"
    BlockHeight
locktime <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lock_time"
    BinfoTxId
index <- Object
o Object -> Key -> Parser BinfoTxId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_index"
    Bool
doubleSpend <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"double_spend"
    Word64
timestamp <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
    Maybe BlockHeight
blockIndex <- Object
o Object -> Key -> Parser (Maybe BlockHeight)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_index"
    Maybe BlockHeight
blockHeight <- Object
o Object -> Key -> Parser (Maybe BlockHeight)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_height"
    [BinfoTxInput]
inputs <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs" Parser [Value]
-> ([Value] -> Parser [BinfoTxInput]) -> Parser [BinfoTxInput]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoTxInput
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx))
    [BinfoTxOutput]
outputs <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"out" Parser [Value]
-> ([Value] -> Parser [BinfoTxOutput]) -> Parser [BinfoTxOutput]
forall a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoTxOutput
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx))
    Bool
rbf <- Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rbf" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Maybe Int64
res <- Object
o Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"result"
    Maybe Int64
bal <- Object
o Object -> Key -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"balance"
    let balance :: Maybe (Int64, Int64)
balance = (,) (Int64 -> Int64 -> (Int64, Int64))
-> Maybe Int64 -> Maybe (Int64 -> (Int64, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
res Maybe (Int64 -> (Int64, Int64))
-> Maybe Int64 -> Maybe (Int64, Int64)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int64
bal
    BinfoTx -> Parser BinfoTx
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoTx {Bool
[BinfoTxOutput]
[BinfoTxInput]
Maybe BlockHeight
Maybe (Int64, Int64)
BlockHeight
Word64
WitnessStackItem
TxHash
BinfoTxId
$sel:txid:BinfoTx :: TxHash
$sel:version:BinfoTx :: BlockHeight
$sel:inputCount:BinfoTx :: BlockHeight
$sel:outputCount:BinfoTx :: BlockHeight
$sel:size:BinfoTx :: BlockHeight
$sel:weight:BinfoTx :: BlockHeight
$sel:fee:BinfoTx :: Word64
$sel:relayed:BinfoTx :: WitnessStackItem
$sel:locktime:BinfoTx :: BlockHeight
$sel:index:BinfoTx :: BinfoTxId
$sel:doubleSpend:BinfoTx :: Bool
$sel:rbf:BinfoTx :: Bool
$sel:balance:BinfoTx :: Maybe (Int64, Int64)
$sel:timestamp:BinfoTx :: Word64
$sel:blockIndex:BinfoTx :: Maybe BlockHeight
$sel:blockHeight:BinfoTx :: Maybe BlockHeight
$sel:inputs:BinfoTx :: [BinfoTxInput]
$sel:outputs:BinfoTx :: [BinfoTxOutput]
txid :: TxHash
version :: BlockHeight
inputCount :: BlockHeight
outputCount :: BlockHeight
size :: BlockHeight
weight :: BlockHeight
fee :: Word64
relayed :: WitnessStackItem
locktime :: BlockHeight
index :: BinfoTxId
doubleSpend :: Bool
timestamp :: Word64
blockIndex :: Maybe BlockHeight
blockHeight :: Maybe BlockHeight
inputs :: [BinfoTxInput]
outputs :: [BinfoTxOutput]
rbf :: Bool
balance :: Maybe (Int64, Int64)
..}

instance MarshalJSON (Network, Ctx) [BinfoTx] where
  marshalValue :: (Network, Ctx) -> [BinfoTx] -> Value
marshalValue (Network
net, Ctx
ctx) [BinfoTx]
txs =
    [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTx -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) [BinfoTx]
txs
  marshalEncoding :: (Network, Ctx) -> [BinfoTx] -> Encoding
marshalEncoding (Network
net, Ctx
ctx) =
    (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTx -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx))
  unmarshalValue :: (Network, Ctx) -> Value -> Parser [BinfoTx]
unmarshalValue (Network
net, Ctx
ctx) =
    String -> (Array -> Parser [BinfoTx]) -> Value -> Parser [BinfoTx]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray String
"[BinfoTx]" ((Array -> Parser [BinfoTx]) -> Value -> Parser [BinfoTx])
-> (Array -> Parser [BinfoTx]) -> Value -> Parser [BinfoTx]
forall a b. (a -> b) -> a -> b
$
      (Vector BinfoTx -> [BinfoTx])
-> Parser (Vector BinfoTx) -> Parser [BinfoTx]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector BinfoTx -> [BinfoTx]
forall a. Vector a -> [a]
V.toList (Parser (Vector BinfoTx) -> Parser [BinfoTx])
-> (Array -> Parser (Vector BinfoTx)) -> Array -> Parser [BinfoTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser BinfoTx) -> Array -> Parser (Vector BinfoTx)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM ((Network, Ctx) -> Value -> Parser BinfoTx
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx))

data BinfoTxInput = BinfoTxInput
  { BinfoTxInput -> BlockHeight
sequence :: !Word32,
    BinfoTxInput -> WitnessStackItem
witness :: !ByteString,
    BinfoTxInput -> WitnessStackItem
script :: !ByteString,
    BinfoTxInput -> BlockHeight
index :: !Word32,
    BinfoTxInput -> BinfoTxOutput
output :: !BinfoTxOutput
  }
  deriving (BinfoTxInput -> BinfoTxInput -> Bool
(BinfoTxInput -> BinfoTxInput -> Bool)
-> (BinfoTxInput -> BinfoTxInput -> Bool) -> Eq BinfoTxInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoTxInput -> BinfoTxInput -> Bool
== :: BinfoTxInput -> BinfoTxInput -> Bool
$c/= :: BinfoTxInput -> BinfoTxInput -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoTxInput -> ShowS
showsPrec :: Int -> BinfoTxInput -> ShowS
$cshow :: BinfoTxInput -> String
show :: BinfoTxInput -> String
$cshowList :: [BinfoTxInput] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoTxInput -> Rep BinfoTxInput x
from :: forall x. BinfoTxInput -> Rep BinfoTxInput x
$cto :: forall x. Rep BinfoTxInput x -> BinfoTxInput
to :: forall x. Rep BinfoTxInput x -> BinfoTxInput
Generic, BinfoTxInput -> ()
(BinfoTxInput -> ()) -> NFData BinfoTxInput
forall a. (a -> ()) -> NFData a
$crnf :: BinfoTxInput -> ()
rnf :: BinfoTxInput -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoTxInput where
  marshalValue :: (Network, Ctx) -> BinfoTxInput -> Value
marshalValue (Network
net, Ctx
ctx) BinfoTxInput
i =
    [Pair] -> Value
A.object
      [ Key
"sequence" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxInput
i.sequence,
        Key
"witness" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex BinfoTxInput
i.witness,
        Key
"script" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex BinfoTxInput
i.script,
        Key
"index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxInput
i.index,
        Key
"prev_out" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network, Ctx) -> BinfoTxOutput -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx) BinfoTxInput
i.output
      ]

  marshalEncoding :: (Network, Ctx) -> BinfoTxInput -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoTxInput
i =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"sequence" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTxInput
i.sequence,
          Key
"witness" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict BinfoTxInput
i.witness),
          Key
"script" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict BinfoTxInput
i.script),
          Key
"index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTxInput
i.index,
          Key
"prev_out" Key -> Encoding -> Series
`A.pair` (Network, Ctx) -> BinfoTxOutput -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoTxInput
i.output
        ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoTxInput
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoTxInput) -> Value -> Parser BinfoTxInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoTxInput" ((Object -> Parser BinfoTxInput) -> Value -> Parser BinfoTxInput)
-> (Object -> Parser BinfoTxInput) -> Value -> Parser BinfoTxInput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHeight
sequence <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sequence"
      WitnessStackItem
witness <-
        Parser WitnessStackItem
-> (WitnessStackItem -> Parser WitnessStackItem)
-> Maybe WitnessStackItem
-> Parser WitnessStackItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser WitnessStackItem
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero WitnessStackItem -> Parser WitnessStackItem
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WitnessStackItem -> Parser WitnessStackItem)
-> (Text -> Maybe WitnessStackItem)
-> Text
-> Parser WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe WitnessStackItem
decodeHex
          (Text -> Parser WitnessStackItem)
-> Parser Text -> Parser WitnessStackItem
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"witness"
      WitnessStackItem
script <-
        Parser WitnessStackItem
-> (WitnessStackItem -> Parser WitnessStackItem)
-> Maybe WitnessStackItem
-> Parser WitnessStackItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser WitnessStackItem
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero WitnessStackItem -> Parser WitnessStackItem
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WitnessStackItem -> Parser WitnessStackItem)
-> (Text -> Maybe WitnessStackItem)
-> Text
-> Parser WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe WitnessStackItem
decodeHex
          (Text -> Parser WitnessStackItem)
-> Parser Text -> Parser WitnessStackItem
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
      BinfoTxOutput
output <-
        Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prev_out"
          Parser Value
-> (Value -> Parser BinfoTxOutput) -> Parser BinfoTxOutput
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Network, Ctx) -> Value -> Parser BinfoTxOutput
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)
      BinfoTxInput -> Parser BinfoTxInput
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoTxInput {BlockHeight
WitnessStackItem
BinfoTxOutput
$sel:sequence:BinfoTxInput :: BlockHeight
$sel:witness:BinfoTxInput :: WitnessStackItem
$sel:script:BinfoTxInput :: WitnessStackItem
$sel:index:BinfoTxInput :: BlockHeight
$sel:output:BinfoTxInput :: BinfoTxOutput
sequence :: BlockHeight
witness :: WitnessStackItem
script :: WitnessStackItem
index :: BlockHeight
output :: BinfoTxOutput
..}

data BinfoTxOutput = BinfoTxOutput
  { BinfoTxOutput -> Int
typ :: !Int,
    BinfoTxOutput -> Bool
spent :: !Bool,
    BinfoTxOutput -> Word64
value :: !Word64,
    BinfoTxOutput -> BlockHeight
index :: !Word32,
    BinfoTxOutput -> BinfoTxId
txidx :: !BinfoTxId,
    BinfoTxOutput -> WitnessStackItem
script :: !ByteString,
    BinfoTxOutput -> [BinfoSpender]
spenders :: ![BinfoSpender],
    BinfoTxOutput -> Maybe Address
address :: !(Maybe Address),
    BinfoTxOutput -> Maybe BinfoXPubPath
xpub :: !(Maybe BinfoXPubPath)
  }
  deriving (BinfoTxOutput -> BinfoTxOutput -> Bool
(BinfoTxOutput -> BinfoTxOutput -> Bool)
-> (BinfoTxOutput -> BinfoTxOutput -> Bool) -> Eq BinfoTxOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoTxOutput -> BinfoTxOutput -> Bool
== :: BinfoTxOutput -> BinfoTxOutput -> Bool
$c/= :: BinfoTxOutput -> BinfoTxOutput -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoTxOutput -> ShowS
showsPrec :: Int -> BinfoTxOutput -> ShowS
$cshow :: BinfoTxOutput -> String
show :: BinfoTxOutput -> String
$cshowList :: [BinfoTxOutput] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoTxOutput -> Rep BinfoTxOutput x
from :: forall x. BinfoTxOutput -> Rep BinfoTxOutput x
$cto :: forall x. Rep BinfoTxOutput x -> BinfoTxOutput
to :: forall x. Rep BinfoTxOutput x -> BinfoTxOutput
Generic, BinfoTxOutput -> ()
(BinfoTxOutput -> ()) -> NFData BinfoTxOutput
forall a. (a -> ()) -> NFData a
$crnf :: BinfoTxOutput -> ()
rnf :: BinfoTxOutput -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoTxOutput where
  marshalValue :: (Network, Ctx) -> BinfoTxOutput -> Value
marshalValue (Network
net, Ctx
ctx) BinfoTxOutput
o =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Key
"type" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxOutput
o.typ,
        Key
"spent" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxOutput
o.spent,
        Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxOutput
o.value,
        Key
"spending_outpoints" Key -> [BinfoSpender] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxOutput
o.spenders,
        Key
"n" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxOutput
o.index,
        Key
"tx_index" Key -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTxOutput
o.txidx,
        Key
"script" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WitnessStackItem -> Text
encodeHex BinfoTxOutput
o.script
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"addr" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Network -> Address -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue Network
net Address
a
             | Address
a <- Maybe Address -> [Address]
forall a. Maybe a -> [a]
maybeToList BinfoTxOutput
o.address
           ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"xpub" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network, Ctx) -> BinfoXPubPath -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx) BinfoXPubPath
x
             | BinfoXPubPath
x <- Maybe BinfoXPubPath -> [BinfoXPubPath]
forall a. Maybe a -> [a]
maybeToList BinfoTxOutput
o.xpub
           ]

  marshalEncoding :: (Network, Ctx) -> BinfoTxOutput -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoTxOutput
o =
    Series -> Encoding
A.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
$
        [ Key
"type" Key -> Encoding -> Series
`A.pair` Int -> Encoding
A.int BinfoTxOutput
o.typ,
          Key
"spent" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BinfoTxOutput
o.spent,
          Key
"value" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoTxOutput
o.value,
          Key
"spending_outpoints" Key -> Encoding -> Series
`A.pair` (BinfoSpender -> Encoding) -> [BinfoSpender] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list BinfoSpender -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoTxOutput
o.spenders,
          Key
"n" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoTxOutput
o.index,
          Key
"tx_index" Key -> Encoding -> Series
`A.pair` BinfoTxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoTxOutput
o.txidx,
          Key
"script" Key -> Encoding -> Series
`A.pair` ByteString -> Encoding
hexEncoding (WitnessStackItem -> ByteString
B.fromStrict BinfoTxOutput
o.script)
        ]
          [Series] -> [Series] -> [Series]
forall a. Semigroup a => a -> a -> a
<> [ Key
"addr" Key -> Encoding -> Series
`A.pair` Network -> Address -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding Network
net Address
a
               | Address
a <- Maybe Address -> [Address]
forall a. Maybe a -> [a]
maybeToList BinfoTxOutput
o.address
             ]
          [Series] -> [Series] -> [Series]
forall a. Semigroup a => a -> a -> a
<> [ Key
"xpub" Key -> Encoding -> Series
`A.pair` (Network, Ctx) -> BinfoXPubPath -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoXPubPath
x
               | BinfoXPubPath
x <- Maybe BinfoXPubPath -> [BinfoXPubPath]
forall a. Maybe a -> [a]
maybeToList BinfoTxOutput
o.xpub
             ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoTxOutput
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoTxOutput)
-> Value
-> Parser BinfoTxOutput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoTxOutput" ((Object -> Parser BinfoTxOutput) -> Value -> Parser BinfoTxOutput)
-> (Object -> Parser BinfoTxOutput)
-> Value
-> Parser BinfoTxOutput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Int
typ <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      Bool
spent <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"spent"
      Word64
value <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      [BinfoSpender]
spenders <- Object
o Object -> Key -> Parser [BinfoSpender]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"spending_outpoints"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n"
      BinfoTxId
txidx <- Object
o Object -> Key -> Parser BinfoTxId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_index"
      WitnessStackItem
script <- Parser WitnessStackItem
-> (WitnessStackItem -> Parser WitnessStackItem)
-> Maybe WitnessStackItem
-> Parser WitnessStackItem
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser WitnessStackItem
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero WitnessStackItem -> Parser WitnessStackItem
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WitnessStackItem -> Parser WitnessStackItem)
-> (Text -> Maybe WitnessStackItem)
-> Text
-> Parser WitnessStackItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe WitnessStackItem
decodeHex (Text -> Parser WitnessStackItem)
-> Parser Text -> Parser WitnessStackItem
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script"
      Maybe Address
address <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"addr" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe Address))
-> Parser (Maybe Address)
forall a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Network -> Value -> Parser Address
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue Network
net)
      Maybe BinfoXPubPath
xpub <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"xpub" Parser (Maybe Value)
-> (Maybe Value -> Parser (Maybe BinfoXPubPath))
-> Parser (Maybe BinfoXPubPath)
forall a b. Parser a -> (a -> Parser b) -> Parser b
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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ((Network, Ctx) -> Value -> Parser BinfoXPubPath
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx))
      BinfoTxOutput -> Parser BinfoTxOutput
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoTxOutput {Bool
Int
[BinfoSpender]
Maybe Address
Maybe BinfoXPubPath
BlockHeight
Word64
WitnessStackItem
BinfoTxId
$sel:typ:BinfoTxOutput :: Int
$sel:spent:BinfoTxOutput :: Bool
$sel:value:BinfoTxOutput :: Word64
$sel:index:BinfoTxOutput :: BlockHeight
$sel:txidx:BinfoTxOutput :: BinfoTxId
$sel:script:BinfoTxOutput :: WitnessStackItem
$sel:spenders:BinfoTxOutput :: [BinfoSpender]
$sel:address:BinfoTxOutput :: Maybe Address
$sel:xpub:BinfoTxOutput :: Maybe BinfoXPubPath
typ :: Int
spent :: Bool
value :: Word64
spenders :: [BinfoSpender]
index :: BlockHeight
txidx :: BinfoTxId
script :: WitnessStackItem
address :: Maybe Address
xpub :: Maybe BinfoXPubPath
..}

data BinfoSpender = BinfoSpender
  { BinfoSpender -> BinfoTxId
txidx :: !BinfoTxId,
    BinfoSpender -> BlockHeight
input :: !Word32
  }
  deriving (BinfoSpender -> BinfoSpender -> Bool
(BinfoSpender -> BinfoSpender -> Bool)
-> (BinfoSpender -> BinfoSpender -> Bool) -> Eq BinfoSpender
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoSpender -> BinfoSpender -> Bool
== :: BinfoSpender -> BinfoSpender -> Bool
$c/= :: BinfoSpender -> BinfoSpender -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoSpender -> ShowS
showsPrec :: Int -> BinfoSpender -> ShowS
$cshow :: BinfoSpender -> String
show :: BinfoSpender -> String
$cshowList :: [BinfoSpender] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoSpender -> Rep BinfoSpender x
from :: forall x. BinfoSpender -> Rep BinfoSpender x
$cto :: forall x. Rep BinfoSpender x -> BinfoSpender
to :: forall x. Rep BinfoSpender x -> BinfoSpender
Generic, BinfoSpender -> ()
(BinfoSpender -> ()) -> NFData BinfoSpender
forall a. (a -> ()) -> NFData a
$crnf :: BinfoSpender -> ()
rnf :: BinfoSpender -> ()
NFData)

instance ToJSON BinfoSpender where
  toJSON :: BinfoSpender -> Value
toJSON BinfoSpender
s =
    [Pair] -> Value
A.object
      [ Key
"tx_index" Key -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSpender
s.txidx,
        Key
"n" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSpender
s.input
      ]
  toEncoding :: BinfoSpender -> Encoding
toEncoding BinfoSpender
s =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"tx_index" Key -> Encoding -> Series
`A.pair` BinfoTxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoSpender
s.txidx,
          Key
"n" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoSpender
s.input
        ]

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
A.withObject String
"BinfoSpender" ((Object -> Parser BinfoSpender) -> Value -> Parser BinfoSpender)
-> (Object -> Parser BinfoSpender) -> Value -> Parser BinfoSpender
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BinfoTxId
txidx <- Object
o Object -> Key -> Parser BinfoTxId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_index"
      BlockHeight
input <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"n"
      BinfoSpender -> Parser BinfoSpender
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoSpender {BlockHeight
BinfoTxId
$sel:txidx:BinfoSpender :: BinfoTxId
$sel:input:BinfoSpender :: BlockHeight
txidx :: BinfoTxId
input :: BlockHeight
..}

data BinfoXPubPath = BinfoXPubPath
  { BinfoXPubPath -> XPubKey
key :: !XPubKey,
    BinfoXPubPath -> SoftPath
deriv :: !SoftPath
  }
  deriving (BinfoXPubPath -> BinfoXPubPath -> Bool
(BinfoXPubPath -> BinfoXPubPath -> Bool)
-> (BinfoXPubPath -> BinfoXPubPath -> Bool) -> Eq BinfoXPubPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoXPubPath -> BinfoXPubPath -> Bool
== :: BinfoXPubPath -> BinfoXPubPath -> Bool
$c/= :: BinfoXPubPath -> BinfoXPubPath -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoXPubPath -> ShowS
showsPrec :: Int -> BinfoXPubPath -> ShowS
$cshow :: BinfoXPubPath -> String
show :: BinfoXPubPath -> String
$cshowList :: [BinfoXPubPath] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoXPubPath -> Rep BinfoXPubPath x
from :: forall x. BinfoXPubPath -> Rep BinfoXPubPath x
$cto :: forall x. Rep BinfoXPubPath x -> BinfoXPubPath
to :: forall x. Rep BinfoXPubPath x -> BinfoXPubPath
Generic, BinfoXPubPath -> ()
(BinfoXPubPath -> ()) -> NFData BinfoXPubPath
forall a. (a -> ()) -> NFData a
$crnf :: BinfoXPubPath -> ()
rnf :: BinfoXPubPath -> ()
NFData)

instance Ord BinfoXPubPath where
  compare :: BinfoXPubPath -> BinfoXPubPath -> Ordering
compare = (Fingerprint, SoftPath) -> (Fingerprint, SoftPath) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Fingerprint, SoftPath) -> (Fingerprint, SoftPath) -> Ordering)
-> (BinfoXPubPath -> (Fingerprint, SoftPath))
-> BinfoXPubPath
-> BinfoXPubPath
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` BinfoXPubPath -> (Fingerprint, SoftPath)
forall {r} {r} {b} {a}.
(HasField "key" r r, HasField "deriv" r b,
 HasField "parent" r a) =>
r -> (a, b)
f
    where
      f :: r -> (a, b)
f r
b =
        ( r
b.key.parent,
          r
b.deriv
        )

instance MarshalJSON (Network, Ctx) BinfoXPubPath where
  marshalValue :: (Network, Ctx) -> BinfoXPubPath -> Value
marshalValue (Network
net, Ctx
ctx) BinfoXPubPath
p =
    [Pair] -> Value
A.object
      [ Key
"m" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Network, Ctx) -> XPubKey -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx) BinfoXPubPath
p.key,
        Key
"path" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SoftPath -> String
forall t. DerivPathI t -> String
pathToStr BinfoXPubPath
p.deriv)
      ]

  marshalEncoding :: (Network, Ctx) -> BinfoXPubPath -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoXPubPath
p =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"m" Key -> Encoding -> Series
`A.pair` (Network, Ctx) -> XPubKey -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx) BinfoXPubPath
p.key,
          Key
"path" Key -> Encoding -> Series
`A.pair` String -> Encoding
forall a. String -> Encoding' a
A.string (String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SoftPath -> String
forall t. DerivPathI t -> String
pathToStr BinfoXPubPath
p.deriv)
        ]

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoXPubPath
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoXPubPath)
-> Value
-> Parser BinfoXPubPath
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoXPubPath" ((Object -> Parser BinfoXPubPath) -> Value -> Parser BinfoXPubPath)
-> (Object -> Parser BinfoXPubPath)
-> Value
-> Parser BinfoXPubPath
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      XPubKey
key <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"m" Parser Value -> (Value -> Parser XPubKey) -> Parser XPubKey
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Network, Ctx) -> Value -> Parser XPubKey
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)
      SoftPath
deriv <- SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
"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 -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      BinfoXPubPath -> Parser BinfoXPubPath
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoXPubPath {SoftPath
XPubKey
$sel:key:BinfoXPubPath :: XPubKey
$sel:deriv:BinfoXPubPath :: SoftPath
key :: XPubKey
deriv :: SoftPath
..}

data BinfoInfo = BinfoInfo
  { BinfoInfo -> BlockHeight
connected :: !Word32,
    BinfoInfo -> Double
conversion :: !Double,
    BinfoInfo -> BinfoSymbol
fiat :: !BinfoSymbol,
    BinfoInfo -> BinfoSymbol
crypto :: !BinfoSymbol,
    BinfoInfo -> BinfoBlockInfo
head :: !BinfoBlockInfo
  }
  deriving (BinfoInfo -> BinfoInfo -> Bool
(BinfoInfo -> BinfoInfo -> Bool)
-> (BinfoInfo -> BinfoInfo -> Bool) -> Eq BinfoInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoInfo -> BinfoInfo -> Bool
== :: BinfoInfo -> BinfoInfo -> Bool
$c/= :: BinfoInfo -> BinfoInfo -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoInfo -> ShowS
showsPrec :: Int -> BinfoInfo -> ShowS
$cshow :: BinfoInfo -> String
show :: BinfoInfo -> String
$cshowList :: [BinfoInfo] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoInfo -> Rep BinfoInfo x
from :: forall x. BinfoInfo -> Rep BinfoInfo x
$cto :: forall x. Rep BinfoInfo x -> BinfoInfo
to :: forall x. Rep BinfoInfo x -> BinfoInfo
Generic, BinfoInfo -> ()
(BinfoInfo -> ()) -> NFData BinfoInfo
forall a. (a -> ()) -> NFData a
$crnf :: BinfoInfo -> ()
rnf :: BinfoInfo -> ()
NFData)

instance ToJSON BinfoInfo where
  toJSON :: BinfoInfo -> Value
toJSON BinfoInfo
i =
    [Pair] -> Value
A.object
      [ Key
"nconnected" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoInfo
i.connected,
        Key
"conversion" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoInfo
i.conversion,
        Key
"symbol_local" Key -> BinfoSymbol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoInfo
i.fiat,
        Key
"symbol_btc" Key -> BinfoSymbol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoInfo
i.crypto,
        Key
"latest_block" Key -> BinfoBlockInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoInfo
i.head
      ]
  toEncoding :: BinfoInfo -> Encoding
toEncoding BinfoInfo
i =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"nconnected" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoInfo
i.connected,
          Key
"conversion" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoInfo
i.conversion,
          Key
"symbol_local" Key -> Encoding -> Series
`A.pair` BinfoSymbol -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoInfo
i.fiat,
          Key
"symbol_btc" Key -> Encoding -> Series
`A.pair` BinfoSymbol -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoInfo
i.crypto,
          Key
"latest_block" Key -> Encoding -> Series
`A.pair` BinfoBlockInfo -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoInfo
i.head
        ]

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
A.withObject String
"BinfoInfo" ((Object -> Parser BinfoInfo) -> Value -> Parser BinfoInfo)
-> (Object -> Parser BinfoInfo) -> Value -> Parser BinfoInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHeight
connected <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nconnected"
      Double
conversion <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conversion"
      BinfoSymbol
fiat <- Object
o Object -> Key -> Parser BinfoSymbol
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbol_local"
      BinfoSymbol
crypto <- Object
o Object -> Key -> Parser BinfoSymbol
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbol_btc"
      BinfoBlockInfo
head <- Object
o Object -> Key -> Parser BinfoBlockInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"latest_block"
      BinfoInfo -> Parser BinfoInfo
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoInfo {Double
BlockHeight
BinfoSymbol
BinfoBlockInfo
$sel:connected:BinfoInfo :: BlockHeight
$sel:conversion:BinfoInfo :: Double
$sel:fiat:BinfoInfo :: BinfoSymbol
$sel:crypto:BinfoInfo :: BinfoSymbol
$sel:head:BinfoInfo :: BinfoBlockInfo
connected :: BlockHeight
conversion :: Double
fiat :: BinfoSymbol
crypto :: BinfoSymbol
head :: BinfoBlockInfo
..}

data BinfoBlockInfo = BinfoBlockInfo
  { BinfoBlockInfo -> BlockHash
hash :: !BlockHash,
    BinfoBlockInfo -> BlockHeight
height :: !BlockHeight,
    BinfoBlockInfo -> BlockHeight
timestamp :: !Word32,
    BinfoBlockInfo -> BlockHeight
index :: !BlockHeight
  }
  deriving (BinfoBlockInfo -> BinfoBlockInfo -> Bool
(BinfoBlockInfo -> BinfoBlockInfo -> Bool)
-> (BinfoBlockInfo -> BinfoBlockInfo -> Bool) -> Eq BinfoBlockInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
== :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
$c/= :: BinfoBlockInfo -> BinfoBlockInfo -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoBlockInfo -> ShowS
showsPrec :: Int -> BinfoBlockInfo -> ShowS
$cshow :: BinfoBlockInfo -> String
show :: BinfoBlockInfo -> String
$cshowList :: [BinfoBlockInfo] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoBlockInfo -> Rep BinfoBlockInfo x
from :: forall x. BinfoBlockInfo -> Rep BinfoBlockInfo x
$cto :: forall x. Rep BinfoBlockInfo x -> BinfoBlockInfo
to :: forall x. Rep BinfoBlockInfo x -> BinfoBlockInfo
Generic, BinfoBlockInfo -> ()
(BinfoBlockInfo -> ()) -> NFData BinfoBlockInfo
forall a. (a -> ()) -> NFData a
$crnf :: BinfoBlockInfo -> ()
rnf :: BinfoBlockInfo -> ()
NFData)

instance ToJSON BinfoBlockInfo where
  toJSON :: BinfoBlockInfo -> Value
toJSON BinfoBlockInfo
i =
    [Pair] -> Value
A.object
      [ Key
"hash" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlockInfo
i.hash,
        Key
"height" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlockInfo
i.height,
        Key
"time" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlockInfo
i.timestamp,
        Key
"block_index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlockInfo
i.index
      ]
  toEncoding :: BinfoBlockInfo -> Encoding
toEncoding BinfoBlockInfo
i =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"hash" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoBlockInfo
i.hash,
          Key
"height" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlockInfo
i.height,
          Key
"time" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlockInfo
i.timestamp,
          Key
"block_index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoBlockInfo
i.index
        ]

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
A.withObject String
"BinfoBlockInfo" ((Object -> Parser BinfoBlockInfo)
 -> Value -> Parser BinfoBlockInfo)
-> (Object -> Parser BinfoBlockInfo)
-> Value
-> Parser BinfoBlockInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHash
hash <- Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash"
      BlockHeight
height <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
      BlockHeight
timestamp <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_index"
      BinfoBlockInfo -> Parser BinfoBlockInfo
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoBlockInfo {BlockHeight
BlockHash
$sel:hash:BinfoBlockInfo :: BlockHash
$sel:height:BinfoBlockInfo :: BlockHeight
$sel:timestamp:BinfoBlockInfo :: BlockHeight
$sel:index:BinfoBlockInfo :: BlockHeight
hash :: BlockHash
height :: BlockHeight
timestamp :: BlockHeight
index :: BlockHeight
..}

toBinfoBlockInfo :: BlockData -> BinfoBlockInfo
toBinfoBlockInfo :: BlockData -> BinfoBlockInfo
toBinfoBlockInfo BlockData
d =
  BinfoBlockInfo
    { $sel:hash:BinfoBlockInfo :: BlockHash
hash = BlockHeader -> BlockHash
headerHash BlockData
d.header,
      $sel:height:BinfoBlockInfo :: BlockHeight
height = BlockData
d.height,
      $sel:timestamp:BinfoBlockInfo :: BlockHeight
timestamp = BlockData
d.header.timestamp,
      $sel:index:BinfoBlockInfo :: BlockHeight
index = BlockData
d.height
    }

data BinfoRate = BinfoRate
  { BinfoRate -> Word64
timestamp :: !Word64,
    BinfoRate -> Double
price :: !Double,
    BinfoRate -> Double
vol24 :: !Double
  }
  deriving (BinfoRate -> BinfoRate -> Bool
(BinfoRate -> BinfoRate -> Bool)
-> (BinfoRate -> BinfoRate -> Bool) -> Eq BinfoRate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoRate -> BinfoRate -> Bool
== :: BinfoRate -> BinfoRate -> Bool
$c/= :: BinfoRate -> BinfoRate -> Bool
/= :: BinfoRate -> BinfoRate -> Bool
Eq, Int -> BinfoRate -> ShowS
[BinfoRate] -> ShowS
BinfoRate -> String
(Int -> BinfoRate -> ShowS)
-> (BinfoRate -> String)
-> ([BinfoRate] -> ShowS)
-> Show BinfoRate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoRate -> ShowS
showsPrec :: Int -> BinfoRate -> ShowS
$cshow :: BinfoRate -> String
show :: BinfoRate -> String
$cshowList :: [BinfoRate] -> ShowS
showList :: [BinfoRate] -> ShowS
Show, (forall x. BinfoRate -> Rep BinfoRate x)
-> (forall x. Rep BinfoRate x -> BinfoRate) -> Generic BinfoRate
forall x. Rep BinfoRate x -> BinfoRate
forall x. BinfoRate -> Rep BinfoRate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoRate -> Rep BinfoRate x
from :: forall x. BinfoRate -> Rep BinfoRate x
$cto :: forall x. Rep BinfoRate x -> BinfoRate
to :: forall x. Rep BinfoRate x -> BinfoRate
Generic, BinfoRate -> ()
(BinfoRate -> ()) -> NFData BinfoRate
forall a. (a -> ()) -> NFData a
$crnf :: BinfoRate -> ()
rnf :: BinfoRate -> ()
NFData)

instance ToJSON BinfoRate where
  toJSON :: BinfoRate -> Value
toJSON BinfoRate
r =
    [Pair] -> Value
A.object
      [ Key
"timestamp" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRate
r.timestamp,
        Key
"price" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRate
r.price,
        Key
"volume24h" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoRate
r.vol24
      ]
  toEncoding :: BinfoRate -> Encoding
toEncoding BinfoRate
r =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"timestamp" Key -> Encoding -> Series
`A.pair` Word64 -> Encoding
A.word64 BinfoRate
r.timestamp,
          Key
"price" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoRate
r.price,
          Key
"volume24h" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoRate
r.vol24
        ]

instance FromJSON BinfoRate where
  parseJSON :: Value -> Parser BinfoRate
parseJSON =
    String -> (Object -> Parser BinfoRate) -> Value -> Parser BinfoRate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoRate" ((Object -> Parser BinfoRate) -> Value -> Parser BinfoRate)
-> (Object -> Parser BinfoRate) -> Value -> Parser BinfoRate
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Word64
timestamp <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp"
      Double
price <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"price"
      Double
vol24 <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"volume24h"
      BinfoRate -> Parser BinfoRate
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoRate {Double
Word64
$sel:timestamp:BinfoRate :: Word64
$sel:price:BinfoRate :: Double
$sel:vol24:BinfoRate :: Double
timestamp :: Word64
price :: Double
vol24 :: Double
..}

data BinfoHistory = BinfoHistory
  { BinfoHistory -> Text
date :: !Text,
    BinfoHistory -> Text
time :: !Text,
    BinfoHistory -> Text
typ :: !Text,
    BinfoHistory -> Double
amount :: !Double,
    BinfoHistory -> Double
valueThen :: !Double,
    BinfoHistory -> Double
valueNow :: !Double,
    BinfoHistory -> Double
rateThen :: !Double,
    BinfoHistory -> TxHash
txid :: !TxHash,
    BinfoHistory -> Double
fee :: !Double
  }
  deriving (BinfoHistory -> BinfoHistory -> Bool
(BinfoHistory -> BinfoHistory -> Bool)
-> (BinfoHistory -> BinfoHistory -> Bool) -> Eq BinfoHistory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoHistory -> BinfoHistory -> Bool
== :: BinfoHistory -> BinfoHistory -> Bool
$c/= :: BinfoHistory -> BinfoHistory -> Bool
/= :: BinfoHistory -> BinfoHistory -> Bool
Eq, Int -> BinfoHistory -> ShowS
[BinfoHistory] -> ShowS
BinfoHistory -> String
(Int -> BinfoHistory -> ShowS)
-> (BinfoHistory -> String)
-> ([BinfoHistory] -> ShowS)
-> Show BinfoHistory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoHistory -> ShowS
showsPrec :: Int -> BinfoHistory -> ShowS
$cshow :: BinfoHistory -> String
show :: BinfoHistory -> String
$cshowList :: [BinfoHistory] -> ShowS
showList :: [BinfoHistory] -> ShowS
Show, (forall x. BinfoHistory -> Rep BinfoHistory x)
-> (forall x. Rep BinfoHistory x -> BinfoHistory)
-> Generic BinfoHistory
forall x. Rep BinfoHistory x -> BinfoHistory
forall x. BinfoHistory -> Rep BinfoHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoHistory -> Rep BinfoHistory x
from :: forall x. BinfoHistory -> Rep BinfoHistory x
$cto :: forall x. Rep BinfoHistory x -> BinfoHistory
to :: forall x. Rep BinfoHistory x -> BinfoHistory
Generic, BinfoHistory -> ()
(BinfoHistory -> ()) -> NFData BinfoHistory
forall a. (a -> ()) -> NFData a
$crnf :: BinfoHistory -> ()
rnf :: BinfoHistory -> ()
NFData)

instance ToJSON BinfoHistory where
  toJSON :: BinfoHistory -> Value
toJSON BinfoHistory
h =
    [Pair] -> Value
A.object
      [ Key
"date" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.date,
        Key
"time" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.time,
        Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.typ,
        Key
"amount" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.amount,
        Key
"value_then" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.valueThen,
        Key
"value_now" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.valueNow,
        Key
"exchange_rate_then" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.rateThen,
        Key
"tx" Key -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.txid,
        Key
"fee" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHistory
h.fee
      ]
  toEncoding :: BinfoHistory -> Encoding
toEncoding BinfoHistory
h =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"date" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoHistory
h.date,
          Key
"time" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoHistory
h.time,
          Key
"type" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoHistory
h.typ,
          Key
"amount" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoHistory
h.amount,
          Key
"value_then" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoHistory
h.valueThen,
          Key
"value_now" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoHistory
h.valueNow,
          Key
"exchange_rate_then" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoHistory
h.rateThen,
          Key
"tx" Key -> Encoding -> Series
`A.pair` TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoHistory
h.txid,
          Key
"fee" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoHistory
h.fee
        ]

instance FromJSON BinfoHistory where
  parseJSON :: Value -> Parser BinfoHistory
parseJSON =
    String
-> (Object -> Parser BinfoHistory) -> Value -> Parser BinfoHistory
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoHistory" ((Object -> Parser BinfoHistory) -> Value -> Parser BinfoHistory)
-> (Object -> Parser BinfoHistory) -> Value -> Parser BinfoHistory
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
date <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"date"
      Text
time <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      Text
typ <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      Double
amount <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"amount"
      Double
valueThen <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value_then"
      Double
valueNow <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value_now"
      Double
rateThen <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exchange_rate_then"
      TxHash
txid <- Object
o Object -> Key -> Parser TxHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx"
      Double
fee <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fee"
      BinfoHistory -> Parser BinfoHistory
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoHistory {Double
Text
TxHash
$sel:date:BinfoHistory :: Text
$sel:time:BinfoHistory :: Text
$sel:typ:BinfoHistory :: Text
$sel:amount:BinfoHistory :: Double
$sel:valueThen:BinfoHistory :: Double
$sel:valueNow:BinfoHistory :: Double
$sel:rateThen:BinfoHistory :: Double
$sel:txid:BinfoHistory :: TxHash
$sel:fee:BinfoHistory :: Double
date :: Text
time :: Text
typ :: Text
amount :: Double
valueThen :: Double
valueNow :: Double
rateThen :: Double
txid :: TxHash
fee :: Double
..}

toBinfoHistory ::
  Int64 ->
  Word64 ->
  Double ->
  Double ->
  Word64 ->
  TxHash ->
  BinfoHistory
toBinfoHistory :: Int64
-> Word64 -> Double -> Double -> Word64 -> TxHash -> BinfoHistory
toBinfoHistory Int64
satoshi Word64
timestamp Double
rateThen Double
rateNow Word64
fee TxHash
txid =
  BinfoHistory
    { $sel:date:BinfoHistory :: Text
date = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d" UTCTime
t,
      $sel:time:BinfoHistory :: Text
time = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S GMT %Ez" UTCTime
t,
      $sel:typ:BinfoHistory :: Text
typ = if Int64
satoshi Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 then Text
"sent" else Text
"received",
      $sel:amount:BinfoHistory :: Double
amount = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
v,
      $sel:fee:BinfoHistory :: Double
fee = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
f,
      $sel:valueThen:BinfoHistory :: Double
valueThen = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
v1,
      $sel:valueNow:BinfoHistory :: Double
valueNow = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
v2,
      Double
$sel:rateThen:BinfoHistory :: Double
rateThen :: Double
rateThen,
      TxHash
$sel:txid:BinfoHistory :: TxHash
txid :: TxHash
txid
    }
  where
    t :: UTCTime
t = POSIXTime -> UTCTime
posixSecondsToUTCTime (Word64 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
timestamp)
    v :: Rational
v = Int64 -> Rational
forall a. Real a => a -> Rational
toRational Int64
satoshi Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
100 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000)
    r1 :: Rational
r1 = Double -> Rational
forall a. Real a => a -> Rational
toRational Double
rateThen
    r2 :: Rational
r2 = Double -> Rational
forall a. Real a => a -> Rational
toRational Double
rateNow
    f :: Rational
f = Word64 -> Rational
forall a. Real a => a -> Rational
toRational Word64
fee Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
100 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000)
    v1 :: Rational
v1 = Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r1
    v2 :: Rational
v2 = Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r2

newtype BinfoDate = BinfoDate Word64
  deriving (BinfoDate -> BinfoDate -> Bool
(BinfoDate -> BinfoDate -> Bool)
-> (BinfoDate -> BinfoDate -> Bool) -> Eq BinfoDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoDate -> BinfoDate -> Bool
== :: BinfoDate -> BinfoDate -> Bool
$c/= :: BinfoDate -> BinfoDate -> Bool
/= :: BinfoDate -> BinfoDate -> Bool
Eq, Int -> BinfoDate -> ShowS
[BinfoDate] -> ShowS
BinfoDate -> String
(Int -> BinfoDate -> ShowS)
-> (BinfoDate -> String)
-> ([BinfoDate] -> ShowS)
-> Show BinfoDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoDate -> ShowS
showsPrec :: Int -> BinfoDate -> ShowS
$cshow :: BinfoDate -> String
show :: BinfoDate -> String
$cshowList :: [BinfoDate] -> ShowS
showList :: [BinfoDate] -> ShowS
Show, ReadPrec [BinfoDate]
ReadPrec BinfoDate
Int -> ReadS BinfoDate
ReadS [BinfoDate]
(Int -> ReadS BinfoDate)
-> ReadS [BinfoDate]
-> ReadPrec BinfoDate
-> ReadPrec [BinfoDate]
-> Read BinfoDate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BinfoDate
readsPrec :: Int -> ReadS BinfoDate
$creadList :: ReadS [BinfoDate]
readList :: ReadS [BinfoDate]
$creadPrec :: ReadPrec BinfoDate
readPrec :: ReadPrec BinfoDate
$creadListPrec :: ReadPrec [BinfoDate]
readListPrec :: ReadPrec [BinfoDate]
Read, (forall x. BinfoDate -> Rep BinfoDate x)
-> (forall x. Rep BinfoDate x -> BinfoDate) -> Generic BinfoDate
forall x. Rep BinfoDate x -> BinfoDate
forall x. BinfoDate -> Rep BinfoDate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoDate -> Rep BinfoDate x
from :: forall x. BinfoDate -> Rep BinfoDate x
$cto :: forall x. Rep BinfoDate x -> BinfoDate
to :: forall x. Rep BinfoDate x -> BinfoDate
Generic, BinfoDate -> ()
(BinfoDate -> ()) -> NFData BinfoDate
forall a. (a -> ()) -> NFData a
$crnf :: BinfoDate -> ()
rnf :: BinfoDate -> ()
NFData)

instance Parsable BinfoDate where
  parseParam :: Text -> Either Text BinfoDate
parseParam Text
t =
    Text -> Maybe BinfoDate -> Either Text BinfoDate
forall b a. b -> Maybe a -> Either b a
maybeToEither Text
"Cannot parse date"
      (Maybe BinfoDate -> Either Text BinfoDate)
-> (Maybe UTCTime -> Maybe BinfoDate)
-> Maybe UTCTime
-> Either Text BinfoDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> BinfoDate) -> Maybe UTCTime -> Maybe BinfoDate
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> BinfoDate
BinfoDate (Word64 -> BinfoDate)
-> (UTCTime -> Word64) -> UTCTime -> BinfoDate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Word64
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Word64)
-> (UTCTime -> POSIXTime) -> UTCTime -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds)
      (Maybe UTCTime -> Either Text BinfoDate)
-> Maybe UTCTime -> Either Text BinfoDate
forall a b. (a -> b) -> a -> b
$ String -> Maybe UTCTime
forall {m :: * -> *} {t}.
(MonadFail m, ParseTime t) =>
String -> m t
p String
"%d-%m-%Y" Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe UTCTime
forall {m :: * -> *} {t}.
(MonadFail m, ParseTime t) =>
String -> m t
p String
"%d/%m/%Y"
    where
      s :: String
s = Text -> String
LazyText.unpack Text
t
      p :: String -> m t
p String
fmt = Bool -> TimeLocale -> String -> String -> m t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale String
fmt String
s

data BinfoTicker = BinfoTicker
  { BinfoTicker -> Double
fifteen :: !Double,
    BinfoTicker -> Double
last :: !Double,
    BinfoTicker -> Double
buy :: !Double,
    BinfoTicker -> Double
sell :: !Double,
    BinfoTicker -> Text
symbol :: !Text
  }
  deriving (BinfoTicker -> BinfoTicker -> Bool
(BinfoTicker -> BinfoTicker -> Bool)
-> (BinfoTicker -> BinfoTicker -> Bool) -> Eq BinfoTicker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoTicker -> BinfoTicker -> Bool
== :: BinfoTicker -> BinfoTicker -> Bool
$c/= :: BinfoTicker -> BinfoTicker -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoTicker -> ShowS
showsPrec :: Int -> BinfoTicker -> ShowS
$cshow :: BinfoTicker -> String
show :: BinfoTicker -> String
$cshowList :: [BinfoTicker] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoTicker -> Rep BinfoTicker x
from :: forall x. BinfoTicker -> Rep BinfoTicker x
$cto :: forall x. Rep BinfoTicker x -> BinfoTicker
to :: forall x. Rep BinfoTicker x -> BinfoTicker
Generic, BinfoTicker -> ()
(BinfoTicker -> ()) -> NFData BinfoTicker
forall a. (a -> ()) -> NFData a
$crnf :: BinfoTicker -> ()
rnf :: BinfoTicker -> ()
NFData)

instance Default BinfoTicker where
  def :: BinfoTicker
def =
    BinfoTicker
      { $sel:symbol:BinfoTicker :: Text
symbol = Text
"XXX",
        $sel:fifteen:BinfoTicker :: Double
fifteen = Double
0.0,
        $sel:last:BinfoTicker :: Double
last = Double
0.0,
        $sel:buy:BinfoTicker :: Double
buy = Double
0.0,
        $sel:sell:BinfoTicker :: Double
sell = Double
0.0
      }

instance ToJSON BinfoTicker where
  toJSON :: BinfoTicker -> Value
toJSON BinfoTicker
t =
    [Pair] -> Value
A.object
      [ Key
"symbol" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTicker
t.symbol,
        Key
"sell" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTicker
t.sell,
        Key
"buy" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTicker
t.buy,
        Key
"last" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTicker
t.last,
        Key
"15m" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoTicker
t.fifteen
      ]
  toEncoding :: BinfoTicker -> Encoding
toEncoding BinfoTicker
t =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"symbol" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoTicker
t.symbol,
          Key
"sell" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoTicker
t.sell,
          Key
"buy" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoTicker
t.buy,
          Key
"last" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoTicker
t.last,
          Key
"15m" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoTicker
t.fifteen
        ]

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
A.withObject String
"BinfoTicker" ((Object -> Parser BinfoTicker) -> Value -> Parser BinfoTicker)
-> (Object -> Parser BinfoTicker) -> Value -> Parser BinfoTicker
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
symbol <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbol"
      Double
fifteen <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"15m"
      Double
sell <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sell"
      Double
buy <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"buy"
      Double
last <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last"
      BinfoTicker -> Parser BinfoTicker
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoTicker {Double
Text
$sel:fifteen:BinfoTicker :: Double
$sel:last:BinfoTicker :: Double
$sel:buy:BinfoTicker :: Double
$sel:sell:BinfoTicker :: Double
$sel:symbol:BinfoTicker :: Text
symbol :: Text
fifteen :: Double
sell :: Double
buy :: Double
last :: Double
..}

data BinfoSymbol = BinfoSymbol
  { BinfoSymbol -> Text
code :: !Text,
    BinfoSymbol -> Text
symbol :: !Text,
    BinfoSymbol -> Text
name :: !Text,
    BinfoSymbol -> Double
conversion :: !Double,
    BinfoSymbol -> Bool
after :: !Bool,
    BinfoSymbol -> Bool
local :: !Bool
  }
  deriving (BinfoSymbol -> BinfoSymbol -> Bool
(BinfoSymbol -> BinfoSymbol -> Bool)
-> (BinfoSymbol -> BinfoSymbol -> Bool) -> Eq BinfoSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoSymbol -> BinfoSymbol -> Bool
== :: BinfoSymbol -> BinfoSymbol -> Bool
$c/= :: BinfoSymbol -> BinfoSymbol -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoSymbol -> ShowS
showsPrec :: Int -> BinfoSymbol -> ShowS
$cshow :: BinfoSymbol -> String
show :: BinfoSymbol -> String
$cshowList :: [BinfoSymbol] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoSymbol -> Rep BinfoSymbol x
from :: forall x. BinfoSymbol -> Rep BinfoSymbol x
$cto :: forall x. Rep BinfoSymbol x -> BinfoSymbol
to :: forall x. Rep BinfoSymbol x -> BinfoSymbol
Generic, BinfoSymbol -> ()
(BinfoSymbol -> ()) -> NFData BinfoSymbol
forall a. (a -> ()) -> NFData a
$crnf :: BinfoSymbol -> ()
rnf :: BinfoSymbol -> ()
NFData)

instance Default BinfoSymbol where
  def :: BinfoSymbol
def =
    BinfoSymbol
      { $sel:code:BinfoSymbol :: Text
code = Text
"XXX",
        $sel:symbol:BinfoSymbol :: Text
symbol = Text
"¤",
        $sel:name:BinfoSymbol :: Text
name = Text
"No currency",
        $sel:conversion:BinfoSymbol :: Double
conversion = Double
0.0,
        $sel:after:BinfoSymbol :: Bool
after = Bool
False,
        $sel:local:BinfoSymbol :: Bool
local = Bool
True
      }

instance ToJSON BinfoSymbol where
  toJSON :: BinfoSymbol -> Value
toJSON BinfoSymbol
s =
    [Pair] -> Value
A.object
      [ Key
"code" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSymbol
s.code,
        Key
"symbol" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSymbol
s.symbol,
        Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSymbol
s.name,
        Key
"conversion" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSymbol
s.conversion,
        Key
"symbolAppearsAfter" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSymbol
s.after,
        Key
"local" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoSymbol
s.local
      ]
  toEncoding :: BinfoSymbol -> Encoding
toEncoding BinfoSymbol
s =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"code" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoSymbol
s.code,
          Key
"symbol" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoSymbol
s.symbol,
          Key
"name" Key -> Encoding -> Series
`A.pair` Text -> Encoding
forall a. Text -> Encoding' a
A.text BinfoSymbol
s.name,
          Key
"conversion" Key -> Encoding -> Series
`A.pair` Double -> Encoding
A.double BinfoSymbol
s.conversion,
          Key
"symbolAppearsAfter" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BinfoSymbol
s.after,
          Key
"local" Key -> Encoding -> Series
`A.pair` Bool -> Encoding
A.bool BinfoSymbol
s.local
        ]

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
A.withObject String
"BinfoSymbol" ((Object -> Parser BinfoSymbol) -> Value -> Parser BinfoSymbol)
-> (Object -> Parser BinfoSymbol) -> Value -> Parser BinfoSymbol
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
code <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
      Text
symbol <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbol"
      Text
name <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Double
conversion <- Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"conversion"
      Bool
after <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"symbolAppearsAfter"
      Bool
local <- Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"local"
      BinfoSymbol -> Parser BinfoSymbol
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoSymbol {Bool
Double
Text
$sel:code:BinfoSymbol :: Text
$sel:symbol:BinfoSymbol :: Text
$sel:name:BinfoSymbol :: Text
$sel:conversion:BinfoSymbol :: Double
$sel:after:BinfoSymbol :: Bool
$sel:local:BinfoSymbol :: Bool
code :: Text
symbol :: Text
name :: Text
conversion :: Double
after :: Bool
local :: Bool
..}

relevantTxs ::
  HashSet Address ->
  Bool ->
  Transaction ->
  HashSet TxHash
relevantTxs :: HashSet Address -> Bool -> Transaction -> HashSet TxHash
relevantTxs HashSet Address
addrs Bool
prune Transaction
t =
  [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
  where
    p :: Address -> Bool
p Address
a =
      Bool
prune
        Bool -> Bool -> Bool
&& HashSet Address -> Transaction -> Int64
getTxResult HashSet Address
addrs Transaction
t Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
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 :: r -> m TxHash
f r
o = do
      Spender {BlockHeight
TxHash
$sel:txid:Spender :: Spender -> TxHash
$sel:index:Spender :: Spender -> BlockHeight
txid :: TxHash
index :: BlockHeight
..} <- r
o.spender
      Address
a <- r
o.address
      Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Address -> Bool
p Address
a
      TxHash -> m TxHash
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxHash
txid
    outs :: [TxHash]
outs = (StoreOutput -> Maybe TxHash) -> [StoreOutput] -> [TxHash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StoreOutput -> Maybe TxHash
forall {m :: * -> *} {r}.
(Monad m, HasField "address" r (m Address),
 HasField "spender" r (m Spender), Alternative m) =>
r -> m TxHash
f Transaction
t.outputs
    g :: StoreInput -> Maybe TxHash
g StoreCoinbase {} = Maybe TxHash
forall a. Maybe a
Nothing
    g StoreInput {$sel:outpoint:StoreCoinbase :: StoreInput -> OutPoint
outpoint = OutPoint TxHash
h BlockHeight
i} = TxHash -> Maybe TxHash
forall a. a -> Maybe a
Just TxHash
h
    ins :: [TxHash]
ins = (StoreInput -> Maybe TxHash) -> [StoreInput] -> [TxHash]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe StoreInput -> Maybe TxHash
g Transaction
t.inputs

toBinfoAddrs ::
  HashMap Address Balance ->
  HashMap XPubSpec [XPubBal] ->
  HashMap XPubSpec Word64 ->
  [BinfoBalance]
toBinfoAddrs :: HashMap Address Balance
-> HashMap XPubSpec [XPubBal]
-> HashMap XPubSpec Word64
-> [BinfoBalance]
toBinfoAddrs HashMap Address Balance
onlyAddrs HashMap XPubSpec [XPubBal]
onlyXpubs HashMap XPubSpec Word64
xpubTxs =
  [BinfoBalance]
xpubBals [BinfoBalance] -> [BinfoBalance] -> [BinfoBalance]
forall a. Semigroup a => a -> a -> a
<> [BinfoBalance]
addrBals
  where
    xpubBal :: XPubSpec -> [a] -> BinfoBalance
xpubBal XPubSpec
k [a]
xs =
      let f :: r -> a
f r
x =
            case r
x.path of
              [a
0, a
_] -> r
x.balance.received
              [a]
_ -> a
0
          g :: r -> a
g r
x = r
x.balance.confirmed a -> a -> a
forall a. Num a => a -> a -> a
+ r
x.balance.unconfirmed
          i :: a -> r -> a
i a
m r
x =
            case r
x.path of
              [a
m', a
n] | a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m' -> a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
              [a]
_ -> a
0
          received :: Word64
received = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (a -> Word64) -> [a] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map a -> Word64
forall {a} {r} {r} {a}.
(Eq a, HasField "path" r [a], HasField "balance" r r,
 HasField "received" r a, Num a, Num a) =>
r -> a
f [a]
xs
          bal :: Word64
bal = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word64) -> a -> Word64
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
forall {a} {r} {r}.
(Num a, HasField "balance" r r, HasField "confirmed" r a,
 HasField "unconfirmed" r a) =>
r -> a
g [a]
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 Word64
0
          count :: Word64
count = Word64 -> XPubSpec -> HashMap XPubSpec Word64 -> Word64
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.lookupDefault Word64
0 XPubSpec
k HashMap XPubSpec Word64
xpubTxs
          ax :: BlockHeight
ax = (BlockHeight -> BlockHeight -> BlockHeight)
-> BlockHeight -> [BlockHeight] -> BlockHeight
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BlockHeight -> BlockHeight -> BlockHeight
forall a. Ord a => a -> a -> a
max BlockHeight
0 ([BlockHeight] -> BlockHeight) -> [BlockHeight] -> BlockHeight
forall a b. (a -> b) -> a -> b
$ (a -> BlockHeight) -> [a] -> [BlockHeight]
forall a b. (a -> b) -> [a] -> [b]
map (BlockHeight -> a -> BlockHeight
forall {r} {a}. (HasField "path" r [a], Eq a, Num a) => a -> r -> a
i BlockHeight
0) [a]
xs
          cx :: BlockHeight
cx = (BlockHeight -> BlockHeight -> BlockHeight)
-> BlockHeight -> [BlockHeight] -> BlockHeight
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BlockHeight -> BlockHeight -> BlockHeight
forall a. Ord a => a -> a -> a
max BlockHeight
0 ([BlockHeight] -> BlockHeight) -> [BlockHeight] -> BlockHeight
forall a b. (a -> b) -> a -> b
$ (a -> BlockHeight) -> [a] -> [BlockHeight]
forall a b. (a -> b) -> [a] -> [b]
map (BlockHeight -> a -> BlockHeight
forall {r} {a}. (HasField "path" r [a], Eq a, Num a) => a -> r -> a
i BlockHeight
1) [a]
xs
       in BinfoXPubBalance
            { $sel:xpub:BinfoAddrBalance :: XPubKey
xpub = XPubSpec
k.key,
              $sel:txs:BinfoAddrBalance :: Word64
txs = Word64
count,
              $sel:received:BinfoAddrBalance :: Word64
received = Word64
received,
              $sel:sent:BinfoAddrBalance :: Word64
sent = Word64
sent,
              $sel:balance:BinfoAddrBalance :: Word64
balance = Word64
bal,
              $sel:external:BinfoAddrBalance :: BlockHeight
external = BlockHeight
ax,
              $sel:change:BinfoAddrBalance :: BlockHeight
change = BlockHeight
cx
            }
    xpubBals :: [BinfoBalance]
xpubBals = ((XPubSpec, [XPubBal]) -> BinfoBalance)
-> [(XPubSpec, [XPubBal])] -> [BinfoBalance]
forall a b. (a -> b) -> [a] -> [b]
map ((XPubSpec -> [XPubBal] -> BinfoBalance)
-> (XPubSpec, [XPubBal]) -> BinfoBalance
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry XPubSpec -> [XPubBal] -> BinfoBalance
forall {a} {a} {r}.
(Integral a, HasField "path" a [BlockHeight],
 HasField "balance" a r, HasField "confirmed" r a,
 HasField "unconfirmed" r a, HasField "received" r Word64) =>
XPubSpec -> [a] -> BinfoBalance
xpubBal) ([(XPubSpec, [XPubBal])] -> [BinfoBalance])
-> [(XPubSpec, [XPubBal])] -> [BinfoBalance]
forall a b. (a -> b) -> a -> b
$ HashMap XPubSpec [XPubBal] -> [(XPubSpec, [XPubBal])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap XPubSpec [XPubBal]
onlyXpubs
    addrBals :: [BinfoBalance]
addrBals =
      let f :: Balance -> BinfoBalance
f Balance {Word64
Address
$sel:address:Balance :: Balance -> Address
$sel:confirmed:Balance :: Balance -> Word64
$sel:unconfirmed:Balance :: Balance -> Word64
$sel:utxo:Balance :: Balance -> Word64
$sel:txs:Balance :: Balance -> Word64
$sel:received:Balance :: Balance -> Word64
address :: Address
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
..} =
            let sent :: Word64
sent = Word64
received Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
balance
                balance :: Word64
balance = Word64
confirmed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
unconfirmed
             in BinfoAddrBalance {Word64
Address
$sel:address:BinfoAddrBalance :: Address
$sel:txs:BinfoAddrBalance :: Word64
$sel:received:BinfoAddrBalance :: Word64
$sel:sent:BinfoAddrBalance :: Word64
$sel:balance:BinfoAddrBalance :: Word64
address :: Address
txs :: Word64
received :: Word64
sent :: Word64
balance :: Word64
..}
       in (Balance -> BinfoBalance) -> [Balance] -> [BinfoBalance]
forall a b. (a -> b) -> [a] -> [b]
map Balance -> BinfoBalance
f ([Balance] -> [BinfoBalance]) -> [Balance] -> [BinfoBalance]
forall a b. (a -> b) -> a -> b
$ HashMap Address Balance -> [Balance]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap Address Balance
onlyAddrs

toBinfoTxSimple ::
  Bool ->
  Transaction ->
  BinfoTx
toBinfoTxSimple :: Bool -> Transaction -> BinfoTx
toBinfoTxSimple Bool
numtxid =
  Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Int64
-> Transaction
-> BinfoTx
toBinfoTx Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
forall k v. HashMap k v
HashMap.empty Bool
False Int64
0

toBinfoTxInputs ::
  Bool ->
  HashMap Address (Maybe BinfoXPubPath) ->
  Transaction ->
  [BinfoTxInput]
toBinfoTxInputs :: Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> [BinfoTxInput]
toBinfoTxInputs Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t =
  (BlockHeight -> StoreInput -> BinfoTxInput)
-> [BlockHeight] -> [StoreInput] -> [BinfoTxInput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith BlockHeight -> StoreInput -> BinfoTxInput
f [BlockHeight
0 ..] Transaction
t.inputs
  where
    f :: BlockHeight -> StoreInput -> BinfoTxInput
f BlockHeight
n StoreInput
i =
      BinfoTxInput
        { $sel:index:BinfoTxInput :: BlockHeight
index = BlockHeight
n,
          $sel:sequence:BinfoTxInput :: BlockHeight
sequence = StoreInput
i.sequence,
          $sel:script:BinfoTxInput :: WitnessStackItem
script = StoreInput
i.script,
          $sel:witness:BinfoTxInput :: WitnessStackItem
witness = StoreInput -> WitnessStackItem
forall {r}.
HasField "witness" r [WitnessStackItem] =>
r -> WitnessStackItem
wit StoreInput
i,
          $sel:output:BinfoTxInput :: BinfoTxOutput
output = BlockHeight -> StoreInput -> BinfoTxOutput
prev BlockHeight
n StoreInput
i
        }
    wit :: r -> WitnessStackItem
wit r
i =
      case r
i.witness of
        [] -> WitnessStackItem
B.empty
        [WitnessStackItem]
ws -> Put -> WitnessStackItem
runPutS ([WitnessStackItem] -> Put
forall {m :: * -> *} {t :: * -> *}.
(MonadPut m, Foldable t) =>
t WitnessStackItem -> m ()
put_witness [WitnessStackItem]
ws)
    prev :: BlockHeight -> StoreInput -> BinfoTxOutput
prev = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> BlockHeight
-> StoreInput
-> BinfoTxOutput
inputToBinfoTxOutput Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t
    put_witness :: t WitnessStackItem -> m ()
put_witness t WitnessStackItem
ws = do
      Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (t WitnessStackItem -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t WitnessStackItem
ws)
      (WitnessStackItem -> m ()) -> t WitnessStackItem -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
put_item t WitnessStackItem
ws
    put_item :: WitnessStackItem -> m ()
put_item WitnessStackItem
bs = do
      Int -> m ()
forall (m :: * -> *) a. (MonadPut m, Integral a) => a -> m ()
putVarInt (WitnessStackItem -> Int
B.length WitnessStackItem
bs)
      WitnessStackItem -> m ()
forall (m :: * -> *). MonadPut m => WitnessStackItem -> m ()
putByteString WitnessStackItem
bs

transactionHeight :: Transaction -> Maybe BlockHeight
transactionHeight :: Transaction -> Maybe BlockHeight
transactionHeight Transaction {$sel:deleted:Transaction :: Transaction -> Bool
deleted = Bool
True} = Maybe BlockHeight
forall a. Maybe a
Nothing
transactionHeight Transaction {$sel:block:Transaction :: Transaction -> BlockRef
block = MemRef Word64
_} = Maybe BlockHeight
forall a. Maybe a
Nothing
transactionHeight Transaction {$sel:block:Transaction :: Transaction -> BlockRef
block = BlockRef BlockHeight
h BlockHeight
_} = BlockHeight -> Maybe BlockHeight
forall a. a -> Maybe a
Just BlockHeight
h

toBinfoTx ::
  Bool ->
  HashMap Address (Maybe BinfoXPubPath) ->
  Bool ->
  Int64 ->
  Transaction ->
  BinfoTx
toBinfoTx :: Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Int64
-> Transaction
-> BinfoTx
toBinfoTx Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Bool
prune Int64
bal Transaction
t =
  BinfoTx
    { $sel:version:BinfoTx :: BlockHeight
version = Transaction
t.version,
      $sel:weight:BinfoTx :: BlockHeight
weight = Transaction
t.weight,
      $sel:relayed:BinfoTx :: WitnessStackItem
relayed = WitnessStackItem
"0.0.0.0",
      $sel:txid:BinfoTx :: TxHash
txid = Tx -> TxHash
txHash Tx
tx,
      $sel:index:BinfoTx :: BinfoTxId
index = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid (Tx -> TxHash
txHash Tx
tx),
      $sel:inputCount:BinfoTx :: BlockHeight
inputCount = Int -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockHeight) -> Int -> BlockHeight
forall a b. (a -> b) -> a -> b
$ [StoreInput] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Transaction
t.inputs,
      $sel:outputCount:BinfoTx :: BlockHeight
outputCount = Int -> BlockHeight
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> BlockHeight) -> Int -> BlockHeight
forall a b. (a -> b) -> a -> b
$ [StoreOutput] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Transaction
t.outputs,
      $sel:blockIndex:BinfoTx :: Maybe BlockHeight
blockIndex = Transaction -> Maybe BlockHeight
transactionHeight Transaction
t,
      $sel:blockHeight:BinfoTx :: Maybe BlockHeight
blockHeight = Transaction -> Maybe BlockHeight
transactionHeight Transaction
t,
      $sel:doubleSpend:BinfoTx :: Bool
doubleSpend = Transaction
t.deleted,
      $sel:balance:BinfoTx :: Maybe (Int64, Int64)
balance =
        if Bool
simple
          then Maybe (Int64, Int64)
forall a. Maybe a
Nothing
          else (Int64, Int64) -> Maybe (Int64, Int64)
forall a. a -> Maybe a
Just (HashSet Address -> Transaction -> Int64
getTxResult HashSet Address
aset Transaction
t, Int64
bal),
      $sel:outputs:BinfoTx :: [BinfoTxOutput]
outputs =
        let p :: Bool
p = Bool
prune Bool -> Bool -> Bool
&& HashSet Address -> Transaction -> Int64
getTxResult HashSet Address
aset Transaction
t Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
            f :: BlockHeight -> StoreOutput -> Maybe BinfoTxOutput
f = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Transaction
-> BlockHeight
-> StoreOutput
-> Maybe BinfoTxOutput
toBinfoTxOutput Bool
numtxid 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
$ (BlockHeight -> StoreOutput -> Maybe BinfoTxOutput)
-> [BlockHeight] -> [StoreOutput] -> [Maybe BinfoTxOutput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith BlockHeight -> StoreOutput -> Maybe BinfoTxOutput
f [BlockHeight
0 ..] Transaction
t.outputs,
      $sel:inputs:BinfoTx :: [BinfoTxInput]
inputs = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> [BinfoTxInput]
toBinfoTxInputs Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t,
      $sel:size:BinfoTx :: BlockHeight
size = Transaction
t.size,
      $sel:rbf:BinfoTx :: Bool
rbf = Transaction
t.rbf,
      $sel:fee:BinfoTx :: Word64
fee = Transaction
t.fee,
      $sel:locktime:BinfoTx :: BlockHeight
locktime = Transaction
t.locktime,
      $sel:timestamp:BinfoTx :: Word64
timestamp = Transaction
t.timestamp
    }
  where
    tx :: Tx
tx = Transaction -> Tx
transactionData Transaction
t
    aset :: HashSet Address
aset = HashMap Address (Maybe BinfoXPubPath) -> HashSet Address
forall k a. HashMap k a -> HashSet k
HashMap.keysSet HashMap Address (Maybe BinfoXPubPath)
abook
    simple :: Bool
simple = HashMap Address (Maybe BinfoXPubPath) -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap Address (Maybe BinfoXPubPath)
abook Bool -> Bool -> Bool
&& Int64
bal Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0

getTxResult :: HashSet Address -> Transaction -> Int64
getTxResult :: HashSet Address -> Transaction -> Int64
getTxResult HashSet Address
aset Transaction
t =
  Int64
inputSum Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
outputSum
  where
    inputSum :: Int64
inputSum = [Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int64] -> Int64) -> [Int64] -> Int64
forall a b. (a -> b) -> a -> b
$ (StoreInput -> Int64) -> [StoreInput] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map StoreInput -> Int64
forall {a}. Num a => StoreInput -> a
inputValue Transaction
t.inputs
    inputValue :: StoreInput -> a
inputValue StoreCoinbase {} = a
0
    inputValue StoreInput {[WitnessStackItem]
Maybe Address
BlockHeight
Word64
WitnessStackItem
OutPoint
$sel:outpoint:StoreCoinbase :: StoreInput -> OutPoint
$sel:sequence:StoreCoinbase :: StoreInput -> BlockHeight
$sel:script:StoreCoinbase :: StoreInput -> WitnessStackItem
$sel:witness:StoreCoinbase :: StoreInput -> [WitnessStackItem]
$sel:pkscript:StoreCoinbase :: StoreInput -> WitnessStackItem
$sel:value:StoreCoinbase :: StoreInput -> Word64
$sel:address:StoreCoinbase :: StoreInput -> Maybe Address
outpoint :: OutPoint
sequence :: BlockHeight
script :: WitnessStackItem
pkscript :: WitnessStackItem
value :: Word64
witness :: [WitnessStackItem]
address :: Maybe Address
..} =
      case Maybe Address
address of
        Maybe Address
Nothing -> a
0
        Just Address
a ->
          if Address -> Bool
testAddr Address
a
            then a -> a
forall a. Num a => a -> a
negate (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value
            else a
0
    testAddr :: Address -> Bool
testAddr Address
a = Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Address
a HashSet Address
aset
    outputSum :: Int64
outputSum = [Int64] -> Int64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int64] -> Int64) -> [Int64] -> Int64
forall a b. (a -> b) -> a -> b
$ (StoreOutput -> Int64) -> [StoreOutput] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map StoreOutput -> Int64
forall {a}. Num a => StoreOutput -> a
outValue Transaction
t.outputs
    outValue :: StoreOutput -> a
outValue StoreOutput {Maybe Address
Maybe Spender
Word64
WitnessStackItem
$sel:value:StoreOutput :: StoreOutput -> Word64
$sel:script:StoreOutput :: StoreOutput -> WitnessStackItem
$sel:spender:StoreOutput :: StoreOutput -> Maybe Spender
$sel:address:StoreOutput :: StoreOutput -> Maybe Address
value :: Word64
script :: WitnessStackItem
spender :: Maybe Spender
address :: Maybe Address
..} =
      case Maybe Address
address of
        Maybe Address
Nothing -> a
0
        Just Address
a ->
          if Address -> Bool
testAddr Address
a
            then Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value
            else a
0

toBinfoTxOutput ::
  Bool ->
  HashMap Address (Maybe BinfoXPubPath) ->
  Bool ->
  Transaction ->
  Word32 ->
  StoreOutput ->
  Maybe BinfoTxOutput
toBinfoTxOutput :: Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Transaction
-> BlockHeight
-> StoreOutput
-> Maybe BinfoTxOutput
toBinfoTxOutput Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Bool
prune Transaction
t BlockHeight
index StoreOutput
o =
  if Bool
prune Bool -> Bool -> Bool
&& Bool
notInBook
    then Maybe BinfoTxOutput
forall a. Maybe a
Nothing
    else
      BinfoTxOutput -> Maybe BinfoTxOutput
forall a. a -> Maybe a
Just
        BinfoTxOutput
          { $sel:typ:BinfoTxOutput :: Int
typ = Int
0,
            $sel:spent:BinfoTxOutput :: Bool
spent = Maybe Spender -> Bool
forall a. Maybe a -> Bool
isJust StoreOutput
o.spender,
            $sel:value:BinfoTxOutput :: Word64
value = StoreOutput
o.value,
            $sel:index:BinfoTxOutput :: BlockHeight
index = BlockHeight
index,
            $sel:txidx:BinfoTxOutput :: BinfoTxId
txidx = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid (TxHash -> BinfoTxId) -> TxHash -> BinfoTxId
forall a b. (a -> b) -> a -> b
$ Tx -> TxHash
txHash (Tx -> TxHash) -> Tx -> TxHash
forall a b. (a -> b) -> a -> b
$ Transaction -> Tx
transactionData Transaction
t,
            $sel:script:BinfoTxOutput :: WitnessStackItem
script = StoreOutput
o.script,
            $sel:spenders:BinfoTxOutput :: [BinfoSpender]
spenders = Maybe BinfoSpender -> [BinfoSpender]
forall a. Maybe a -> [a]
maybeToList (Maybe BinfoSpender -> [BinfoSpender])
-> Maybe BinfoSpender -> [BinfoSpender]
forall a b. (a -> b) -> a -> b
$ Bool -> Spender -> BinfoSpender
toBinfoSpender Bool
numtxid (Spender -> BinfoSpender) -> Maybe Spender -> Maybe BinfoSpender
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreOutput
o.spender,
            $sel:address:BinfoTxOutput :: Maybe Address
address = StoreOutput
o.address,
            $sel:xpub:BinfoTxOutput :: Maybe BinfoXPubPath
xpub = StoreOutput
o.address Maybe Address
-> (Address -> Maybe BinfoXPubPath) -> Maybe BinfoXPubPath
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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))
-> HashMap Address (Maybe BinfoXPubPath)
-> Address
-> Maybe (Maybe BinfoXPubPath)
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
          }
  where
    notInBook :: Bool
notInBook = Maybe (Maybe BinfoXPubPath) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Maybe BinfoXPubPath) -> Bool)
-> Maybe (Maybe BinfoXPubPath) -> Bool
forall a b. (a -> b) -> a -> b
$ StoreOutput
o.address Maybe Address
-> (Address -> Maybe (Maybe BinfoXPubPath))
-> Maybe (Maybe BinfoXPubPath)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Address
 -> HashMap Address (Maybe BinfoXPubPath)
 -> Maybe (Maybe BinfoXPubPath))
-> HashMap Address (Maybe BinfoXPubPath)
-> Address
-> Maybe (Maybe BinfoXPubPath)
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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

toBinfoSpender :: Bool -> Spender -> BinfoSpender
toBinfoSpender :: Bool -> Spender -> BinfoSpender
toBinfoSpender Bool
numtxid Spender
s =
  BinfoSpender
    { $sel:txidx:BinfoSpender :: BinfoTxId
txidx = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid Spender
s.txid,
      $sel:input:BinfoSpender :: BlockHeight
input = Spender
s.index
    }

inputToBinfoTxOutput ::
  Bool ->
  HashMap Address (Maybe BinfoXPubPath) ->
  Transaction ->
  Word32 ->
  StoreInput ->
  BinfoTxOutput
inputToBinfoTxOutput :: Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> BlockHeight
-> StoreInput
-> BinfoTxOutput
inputToBinfoTxOutput Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t BlockHeight
n StoreInput
i =
  BinfoTxOutput
    { $sel:typ:BinfoTxOutput :: Int
typ = Int
0,
      $sel:spent:BinfoTxOutput :: Bool
spent = Bool
True,
      $sel:txidx:BinfoTxOutput :: BinfoTxId
txidx = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid StoreInput
i.outpoint.hash,
      $sel:value:BinfoTxOutput :: Word64
value =
        case StoreInput
i of
          StoreCoinbase {} -> Word64
0
          StoreInput {Word64
$sel:value:StoreCoinbase :: StoreInput -> Word64
value :: Word64
value} -> Word64
value,
      $sel:script:BinfoTxOutput :: WitnessStackItem
script =
        case StoreInput
i of
          StoreCoinbase {} -> WitnessStackItem
B.empty
          StoreInput {WitnessStackItem
$sel:pkscript:StoreCoinbase :: StoreInput -> WitnessStackItem
pkscript :: WitnessStackItem
pkscript} -> WitnessStackItem
pkscript,
      $sel:address:BinfoTxOutput :: Maybe Address
address =
        case StoreInput
i of
          StoreCoinbase {} -> Maybe Address
forall a. Maybe a
Nothing
          StoreInput {Maybe Address
$sel:address:StoreCoinbase :: StoreInput -> Maybe Address
address :: Maybe Address
address} -> Maybe Address
address,
      $sel:index:BinfoTxOutput :: BlockHeight
index = StoreInput
i.outpoint.index,
      $sel:spenders:BinfoTxOutput :: [BinfoSpender]
spenders =
        [ BinfoTxId -> BlockHeight -> BinfoSpender
BinfoSpender
            (Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid (Tx -> TxHash
txHash (Transaction -> Tx
transactionData Transaction
t)))
            BlockHeight
n
        ],
      $sel:xpub:BinfoTxOutput :: Maybe BinfoXPubPath
xpub = StoreInput
i.address Maybe Address
-> (Address -> Maybe BinfoXPubPath) -> Maybe BinfoXPubPath
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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))
-> HashMap Address (Maybe BinfoXPubPath)
-> Address
-> Maybe (Maybe BinfoXPubPath)
forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
$c== :: BinfoAddr -> BinfoAddr -> Bool
== :: BinfoAddr -> BinfoAddr -> Bool
$c/= :: BinfoAddr -> BinfoAddr -> Bool
/= :: 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
$cshowsPrec :: Int -> BinfoAddr -> ShowS
showsPrec :: Int -> BinfoAddr -> ShowS
$cshow :: BinfoAddr -> String
show :: BinfoAddr -> String
$cshowList :: [BinfoAddr] -> ShowS
showList :: [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
$cfrom :: forall x. BinfoAddr -> Rep BinfoAddr x
from :: forall x. BinfoAddr -> Rep BinfoAddr x
$cto :: forall x. Rep BinfoAddr x -> BinfoAddr
to :: forall x. Rep BinfoAddr x -> BinfoAddr
Generic, Eq BinfoAddr
Eq BinfoAddr
-> (Int -> BinfoAddr -> Int)
-> (BinfoAddr -> Int)
-> Hashable BinfoAddr
Int -> BinfoAddr -> Int
BinfoAddr -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BinfoAddr -> Int
hashWithSalt :: Int -> BinfoAddr -> Int
$chash :: BinfoAddr -> Int
hash :: BinfoAddr -> Int
Hashable, BinfoAddr -> ()
(BinfoAddr -> ()) -> NFData BinfoAddr
forall a. (a -> ()) -> NFData a
$crnf :: BinfoAddr -> ()
rnf :: BinfoAddr -> ()
NFData)

parseBinfoAddr :: Network -> Ctx -> Text -> Maybe [BinfoAddr]
parseBinfoAddr :: Network -> Ctx -> Text -> Maybe [BinfoAddr]
parseBinfoAddr Network
net Ctx
ctx Text
"" = [BinfoAddr] -> Maybe [BinfoAddr]
forall a. a -> Maybe a
Just []
parseBinfoAddr Network
net Ctx
ctx 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe BinfoAddr
f ([Text] -> Maybe [BinfoAddr]) -> [Text] -> Maybe [BinfoAddr]
forall a b. (a -> b) -> a -> b
$
    (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
      (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
",") (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"|" Text
s)
  where
    f :: Text -> Maybe BinfoAddr
f 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 a. Maybe a -> Maybe a -> Maybe a
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 -> Ctx -> Text -> Maybe XPubKey
xPubImport Network
net Ctx
ctx Text
x

data BinfoHeader = BinfoHeader
  { BinfoHeader -> BlockHash
hash :: !BlockHash,
    BinfoHeader -> BlockHeight
timestamp :: !Timestamp,
    BinfoHeader -> BlockHeight
index :: !Word32,
    BinfoHeader -> BlockHeight
height :: !BlockHeight,
    BinfoHeader -> [BinfoTxId]
txids :: ![BinfoTxId]
  }
  deriving (BinfoHeader -> BinfoHeader -> Bool
(BinfoHeader -> BinfoHeader -> Bool)
-> (BinfoHeader -> BinfoHeader -> Bool) -> Eq BinfoHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoHeader -> BinfoHeader -> Bool
== :: BinfoHeader -> BinfoHeader -> Bool
$c/= :: BinfoHeader -> BinfoHeader -> Bool
/= :: BinfoHeader -> BinfoHeader -> Bool
Eq, Int -> BinfoHeader -> ShowS
[BinfoHeader] -> ShowS
BinfoHeader -> String
(Int -> BinfoHeader -> ShowS)
-> (BinfoHeader -> String)
-> ([BinfoHeader] -> ShowS)
-> Show BinfoHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoHeader -> ShowS
showsPrec :: Int -> BinfoHeader -> ShowS
$cshow :: BinfoHeader -> String
show :: BinfoHeader -> String
$cshowList :: [BinfoHeader] -> ShowS
showList :: [BinfoHeader] -> ShowS
Show, (forall x. BinfoHeader -> Rep BinfoHeader x)
-> (forall x. Rep BinfoHeader x -> BinfoHeader)
-> Generic BinfoHeader
forall x. Rep BinfoHeader x -> BinfoHeader
forall x. BinfoHeader -> Rep BinfoHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoHeader -> Rep BinfoHeader x
from :: forall x. BinfoHeader -> Rep BinfoHeader x
$cto :: forall x. Rep BinfoHeader x -> BinfoHeader
to :: forall x. Rep BinfoHeader x -> BinfoHeader
Generic, BinfoHeader -> ()
(BinfoHeader -> ()) -> NFData BinfoHeader
forall a. (a -> ()) -> NFData a
$crnf :: BinfoHeader -> ()
rnf :: BinfoHeader -> ()
NFData)

instance ToJSON BinfoHeader where
  toJSON :: BinfoHeader -> Value
toJSON BinfoHeader
h =
    [Pair] -> Value
A.object
      [ Key
"hash" Key -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHeader
h.hash,
        Key
"time" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHeader
h.timestamp,
        Key
"block_index" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHeader
h.index,
        Key
"height" Key -> BlockHeight -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHeader
h.height,
        Key
"txIndexes" Key -> [BinfoTxId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoHeader
h.txids
      ]
  toEncoding :: BinfoHeader -> Encoding
toEncoding BinfoHeader
h =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"hash" Key -> Encoding -> Series
`A.pair` BlockHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoHeader
h.hash,
          Key
"time" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoHeader
h.timestamp,
          Key
"block_index" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoHeader
h.index,
          Key
"height" Key -> Encoding -> Series
`A.pair` BlockHeight -> Encoding
A.word32 BinfoHeader
h.height,
          Key
"txIndexes" Key -> Encoding -> Series
`A.pair` (BinfoTxId -> Encoding) -> [BinfoTxId] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list BinfoTxId -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoHeader
h.txids
        ]

instance FromJSON BinfoHeader where
  parseJSON :: Value -> Parser BinfoHeader
parseJSON =
    String
-> (Object -> Parser BinfoHeader) -> Value -> Parser BinfoHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoHeader" ((Object -> Parser BinfoHeader) -> Value -> Parser BinfoHeader)
-> (Object -> Parser BinfoHeader) -> Value -> Parser BinfoHeader
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      BlockHash
hash <- Object
o Object -> Key -> Parser BlockHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hash"
      BlockHeight
timestamp <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
      BlockHeight
index <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"block_index"
      BlockHeight
height <- Object
o Object -> Key -> Parser BlockHeight
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
      [BinfoTxId]
txids <- Object
o Object -> Key -> Parser [BinfoTxId]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txIndexes"
      BinfoHeader -> Parser BinfoHeader
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return BinfoHeader {[BinfoTxId]
BlockHeight
BlockHash
$sel:hash:BinfoHeader :: BlockHash
$sel:timestamp:BinfoHeader :: BlockHeight
$sel:index:BinfoHeader :: BlockHeight
$sel:height:BinfoHeader :: BlockHeight
$sel:txids:BinfoHeader :: [BinfoTxId]
hash :: BlockHash
timestamp :: BlockHeight
index :: BlockHeight
height :: BlockHeight
txids :: [BinfoTxId]
..}

newtype BinfoMempool = BinfoMempool {BinfoMempool -> [BinfoTx]
get :: [BinfoTx]}
  deriving (BinfoMempool -> BinfoMempool -> Bool
(BinfoMempool -> BinfoMempool -> Bool)
-> (BinfoMempool -> BinfoMempool -> Bool) -> Eq BinfoMempool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoMempool -> BinfoMempool -> Bool
== :: BinfoMempool -> BinfoMempool -> Bool
$c/= :: BinfoMempool -> BinfoMempool -> Bool
/= :: BinfoMempool -> BinfoMempool -> Bool
Eq, Int -> BinfoMempool -> ShowS
[BinfoMempool] -> ShowS
BinfoMempool -> String
(Int -> BinfoMempool -> ShowS)
-> (BinfoMempool -> String)
-> ([BinfoMempool] -> ShowS)
-> Show BinfoMempool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoMempool -> ShowS
showsPrec :: Int -> BinfoMempool -> ShowS
$cshow :: BinfoMempool -> String
show :: BinfoMempool -> String
$cshowList :: [BinfoMempool] -> ShowS
showList :: [BinfoMempool] -> ShowS
Show, (forall x. BinfoMempool -> Rep BinfoMempool x)
-> (forall x. Rep BinfoMempool x -> BinfoMempool)
-> Generic BinfoMempool
forall x. Rep BinfoMempool x -> BinfoMempool
forall x. BinfoMempool -> Rep BinfoMempool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoMempool -> Rep BinfoMempool x
from :: forall x. BinfoMempool -> Rep BinfoMempool x
$cto :: forall x. Rep BinfoMempool x -> BinfoMempool
to :: forall x. Rep BinfoMempool x -> BinfoMempool
Generic, BinfoMempool -> ()
(BinfoMempool -> ()) -> NFData BinfoMempool
forall a. (a -> ()) -> NFData a
$crnf :: BinfoMempool -> ()
rnf :: BinfoMempool -> ()
NFData)

instance MarshalJSON (Network, Ctx) BinfoMempool where
  marshalValue :: (Network, Ctx) -> BinfoMempool -> Value
marshalValue (Network
net, Ctx
ctx) (BinfoMempool [BinfoTx]
txs) =
    [Pair] -> Value
A.object [Key
"txs" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ((Network, Ctx) -> BinfoTx -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue (Network
net, Ctx
ctx)) [BinfoTx]
txs]

  marshalEncoding :: (Network, Ctx) -> BinfoMempool -> Encoding
marshalEncoding (Network
net, Ctx
ctx) (BinfoMempool [BinfoTx]
txs) =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
A.pair Key
"txs" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list ((Network, Ctx) -> BinfoTx -> Encoding
forall s a. MarshalJSON s a => s -> a -> Encoding
marshalEncoding (Network
net, Ctx
ctx)) [BinfoTx]
txs

  unmarshalValue :: (Network, Ctx) -> Value -> Parser BinfoMempool
unmarshalValue (Network
net, Ctx
ctx) =
    String
-> (Object -> Parser BinfoMempool) -> Value -> Parser BinfoMempool
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoMempool" ((Object -> Parser BinfoMempool) -> Value -> Parser BinfoMempool)
-> (Object -> Parser BinfoMempool) -> Value -> Parser BinfoMempool
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      [BinfoTx] -> BinfoMempool
BinfoMempool ([BinfoTx] -> BinfoMempool)
-> Parser [BinfoTx] -> Parser BinfoMempool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Value -> Parser BinfoTx) -> [Value] -> Parser [BinfoTx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Network, Ctx) -> Value -> Parser BinfoTx
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue (Network
net, Ctx
ctx)) ([Value] -> Parser [BinfoTx]) -> Parser [Value] -> Parser [BinfoTx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"txs")

newtype BinfoBlockInfos = BinfoBlockInfos {BinfoBlockInfos -> [BinfoBlockInfo]
get :: [BinfoBlockInfo]}
  deriving (BinfoBlockInfos -> BinfoBlockInfos -> Bool
(BinfoBlockInfos -> BinfoBlockInfos -> Bool)
-> (BinfoBlockInfos -> BinfoBlockInfos -> Bool)
-> Eq BinfoBlockInfos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinfoBlockInfos -> BinfoBlockInfos -> Bool
== :: BinfoBlockInfos -> BinfoBlockInfos -> Bool
$c/= :: BinfoBlockInfos -> BinfoBlockInfos -> Bool
/= :: BinfoBlockInfos -> BinfoBlockInfos -> Bool
Eq, Int -> BinfoBlockInfos -> ShowS
[BinfoBlockInfos] -> ShowS
BinfoBlockInfos -> String
(Int -> BinfoBlockInfos -> ShowS)
-> (BinfoBlockInfos -> String)
-> ([BinfoBlockInfos] -> ShowS)
-> Show BinfoBlockInfos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BinfoBlockInfos -> ShowS
showsPrec :: Int -> BinfoBlockInfos -> ShowS
$cshow :: BinfoBlockInfos -> String
show :: BinfoBlockInfos -> String
$cshowList :: [BinfoBlockInfos] -> ShowS
showList :: [BinfoBlockInfos] -> ShowS
Show, (forall x. BinfoBlockInfos -> Rep BinfoBlockInfos x)
-> (forall x. Rep BinfoBlockInfos x -> BinfoBlockInfos)
-> Generic BinfoBlockInfos
forall x. Rep BinfoBlockInfos x -> BinfoBlockInfos
forall x. BinfoBlockInfos -> Rep BinfoBlockInfos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BinfoBlockInfos -> Rep BinfoBlockInfos x
from :: forall x. BinfoBlockInfos -> Rep BinfoBlockInfos x
$cto :: forall x. Rep BinfoBlockInfos x -> BinfoBlockInfos
to :: forall x. Rep BinfoBlockInfos x -> BinfoBlockInfos
Generic, BinfoBlockInfos -> ()
(BinfoBlockInfos -> ()) -> NFData BinfoBlockInfos
forall a. (a -> ()) -> NFData a
$crnf :: BinfoBlockInfos -> ()
rnf :: BinfoBlockInfos -> ()
NFData)

instance ToJSON BinfoBlockInfos where
  toJSON :: BinfoBlockInfos -> Value
toJSON BinfoBlockInfos
b = [Pair] -> Value
A.object [Key
"blocks" Key -> [BinfoBlockInfo] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BinfoBlockInfos
b.get]
  toEncoding :: BinfoBlockInfos -> Encoding
toEncoding BinfoBlockInfos
b =
    Series -> Encoding
A.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Key -> Encoding -> Series
A.pair Key
"blocks" (Encoding -> Series) -> Encoding -> Series
forall a b. (a -> b) -> a -> b
$ (BinfoBlockInfo -> Encoding) -> [BinfoBlockInfo] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
A.list BinfoBlockInfo -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding BinfoBlockInfos
b.get

instance FromJSON BinfoBlockInfos where
  parseJSON :: Value -> Parser BinfoBlockInfos
parseJSON =
    String
-> (Object -> Parser BinfoBlockInfos)
-> Value
-> Parser BinfoBlockInfos
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"BinfoBlockInfos" ((Object -> Parser BinfoBlockInfos)
 -> Value -> Parser BinfoBlockInfos)
-> (Object -> Parser BinfoBlockInfos)
-> Value
-> Parser BinfoBlockInfos
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      [BinfoBlockInfo] -> BinfoBlockInfos
BinfoBlockInfos ([BinfoBlockInfo] -> BinfoBlockInfos)
-> Parser [BinfoBlockInfo] -> Parser BinfoBlockInfos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [BinfoBlockInfo]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blocks"