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

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

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

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

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

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

     -- * Blockchain.info API
    , BinfoBlockId(..)
    , BinfoTxId(..)
    , encodeBinfoTxId
    , BinfoFilter(..)
    , BinfoMultiAddr(..)
    , binfoMultiAddrToJSON
    , binfoMultiAddrToEncoding
    , binfoMultiAddrParseJSON
    , BinfoBalance(..)
    , toBinfoAddrs
    , binfoBalanceToJSON
    , binfoBalanceToEncoding
    , binfoBalanceParseJSON
    , BinfoAddr(..)
    , parseBinfoAddr
    , BinfoWallet(..)
    , BinfoUnspent(..)
    , binfoUnspentToJSON
    , binfoUnspentToEncoding
    , binfoUnspentParseJSON
    , binfoHexValue
    , BinfoUnspents(..)
    , binfoUnspentsToJSON
    , binfoUnspentsToEncoding
    , binfoUnspentsParseJSON
    , BinfoBlock(..)
    , toBinfoBlock
    , binfoBlockToJSON
    , binfoBlockToEncoding
    , binfoBlockParseJSON
    , BinfoTx(..)
    , relevantTxs
    , toBinfoTx
    , toBinfoTxSimple
    , binfoTxToJSON
    , binfoTxToEncoding
    , binfoTxParseJSON
    , BinfoTxInput(..)
    , binfoTxInputToJSON
    , binfoTxInputToEncoding
    , binfoTxInputParseJSON
    , BinfoTxOutput(..)
    , binfoTxOutputToJSON
    , binfoTxOutputToEncoding
    , binfoTxOutputParseJSON
    , BinfoSpender(..)
    , BinfoXPubPath(..)
    , binfoXPubPathToJSON
    , binfoXPubPathToEncoding
    , binfoXPubPathParseJSON
    , BinfoInfo(..)
    , BinfoBlockInfo(..)
    , BinfoSymbol(..)
    , BinfoTicker(..)
    )

where

import           Control.Applicative     ((<|>))
import           Control.DeepSeq         (NFData)
import           Control.Exception       (Exception)
import           Control.Monad           (join, mzero, replicateM, unless,
                                          (<=<))
import           Data.Aeson              (Encoding, FromJSON (..),
                                          FromJSONKey (..), ToJSON (..),
                                          ToJSONKey (..), Value (..), (.!=),
                                          (.:), (.:?), (.=))
import qualified Data.Aeson              as A
import qualified Data.Aeson.Encoding     as AE
import           Data.Aeson.Types        (Parser)
import           Data.Binary             (Binary (get, put))
import           Data.Bits               (Bits (..))
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy    as BSL
import           Data.Bytes.Get
import qualified Data.Bytes.Get          as Bytes.Get
import           Data.Bytes.Put
import qualified Data.Bytes.Put          as Bytes.Put
import           Data.Bytes.Serial
import           Data.Bytes.Serial       (Serial (..))
import           Data.Default            (Default (..))
import           Data.Either             (fromRight, lefts, rights)
import           Data.Foldable           (toList)
import           Data.Function           (on)
import           Data.HashMap.Strict     (HashMap)
import qualified Data.HashMap.Strict     as HashMap
import           Data.HashSet            (HashSet)
import qualified Data.HashSet            as HashSet
import           Data.Hashable           (Hashable (..))
import           Data.Int                (Int32, Int64)
import qualified Data.IntMap             as IntMap
import           Data.IntMap.Strict      (IntMap)
import           Data.List               (unfoldr)
import           Data.Map.Strict         (Map)
import           Data.Maybe              (catMaybes, fromMaybe, isJust,
                                          isNothing, mapMaybe, maybeToList)
import           Data.Serialize          (Serialize (..))
import           Data.String.Conversions (cs)
import           Data.Text               (Text)
import qualified Data.Text               as T
import qualified Data.Text.Encoding      as TE
import qualified Data.Text.Lazy          as TL
import qualified Data.Text.Lazy.Encoding as TLE
import           Data.Word               (Word32, Word64, Word8)
import           GHC.Generics            (Generic)
import           Haskoin
import           Numeric.Natural         (Natural)
import           Text.Printf             (printf)
import           Text.Read               (readMaybe)
import           Web.Scotty.Trans        (Parsable (..), ScottyError (..))

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

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

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

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

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

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

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

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

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

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

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

type UnixTime = Word64
type BlockPos = Word32

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

-- | Serial entities will sort in reverse order.
instance Serial BlockRef where
    serialize :: BlockRef -> m ()
serialize MemRef {memRefTime :: BlockRef -> Word64
memRefTime = Word64
t} = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x00
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putUnixTime Word64
t
    serialize BlockRef {blockRefHeight :: BlockRef -> Fingerprint
blockRefHeight = Fingerprint
h, blockRefPos :: BlockRef -> Fingerprint
blockRefPos = Fingerprint
p} = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x01
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
- Fingerprint
h)
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
- Fingerprint
p)
    deserialize :: m BlockRef
deserialize =
        m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m BlockRef) -> m BlockRef
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        0x00 -> m BlockRef
getmemref
        0x01 -> m BlockRef
getblockref
        _    -> String -> m BlockRef
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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
            Fingerprint
h <- (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
-) (Fingerprint -> Fingerprint) -> m Fingerprint -> m Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
            Fingerprint
p <- (Fingerprint
forall a. Bounded a => a
maxBound Fingerprint -> Fingerprint -> Fingerprint
forall a. Num a => a -> a -> a
-) (Fingerprint -> Fingerprint) -> m Fingerprint -> m Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
            BlockRef -> m BlockRef
forall (m :: * -> *) a. Monad m => a -> m a
return $WBlockRef :: Fingerprint -> Fingerprint -> BlockRef
BlockRef {blockRefHeight :: Fingerprint
blockRefHeight = Fingerprint
h, blockRefPos :: Fingerprint
blockRefPos = Fingerprint
p}

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

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

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

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

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

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

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

    deserialize :: 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
deserialize m (TxHash -> TxRef) -> m TxHash -> m TxRef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

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

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

instance Serial Balance where
    serialize :: Balance -> m ()
serialize Balance{..} = do
        Address -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Address
balanceAddress
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
balanceAmount
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
balanceZero
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
balanceUnspentCount
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
balanceTxCount
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
balanceTotalReceived

    deserialize :: m Balance
deserialize = do
        Address
balanceAddress       <- m Address
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Word64
balanceAmount        <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
balanceZero          <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
balanceUnspentCount  <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
balanceTxCount       <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
balanceTotalReceived <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Balance -> m Balance
forall (m :: * -> *) a. Monad m => a -> m a
return $WBalance :: Address
-> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Balance
Balance{..}

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

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

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

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

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

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

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

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

instance Serial Unspent where
    serialize :: Unspent -> m ()
serialize Unspent{..} = do
        BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockRef
unspentBlock
        OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize OutPoint
unspentPoint
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
unspentAmount
        ByteString -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ByteString
unspentScript
        (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 ()
serialize Maybe Address
unspentAddress

    deserialize :: m Unspent
deserialize = do
        BlockRef
unspentBlock <- m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        OutPoint
unspentPoint <- m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Word64
unspentAmount <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        ByteString
unspentScript <- m ByteString
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Maybe Address
unspentAddress <- 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
deserialize
        Unspent -> m Unspent
forall (m :: * -> *) a. Monad m => a -> m a
return $WUnspent :: BlockRef
-> OutPoint -> Word64 -> ByteString -> Maybe Address -> Unspent
Unspent{..}

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

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

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

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

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

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

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

instance Serial BlockData where
    serialize :: BlockData -> m ()
serialize BlockData{..} = do
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
blockDataHeight
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Bool
blockDataMainChain
        Integer -> m ()
forall (m :: * -> *). MonadPut m => Integer -> m ()
putInteger Integer
blockDataWork
        BlockHeader -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHeader
blockDataHeader
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
blockDataSize
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
blockDataWeight
        (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 ()
serialize [TxHash]
blockDataTxs
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
blockDataOutputs
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
blockDataFees
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
blockDataSubsidy

    deserialize :: m BlockData
deserialize = do
        Fingerprint
blockDataHeight <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Bool
blockDataMainChain <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Integer
blockDataWork <- m Integer
forall (m :: * -> *). MonadGet m => m Integer
getInteger
        BlockHeader
blockDataHeader <- m BlockHeader
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Fingerprint
blockDataSize <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Fingerprint
blockDataWeight <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        [TxHash]
blockDataTxs <- 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
deserialize
        Word64
blockDataOutputs <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
blockDataFees <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
blockDataSubsidy <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        BlockData -> m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return $WBlockData :: Fingerprint
-> Bool
-> Integer
-> BlockHeader
-> Fingerprint
-> Fingerprint
-> [TxHash]
-> Word64
-> Word64
-> Word64
-> BlockData
BlockData{..}

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

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

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

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

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

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

instance Serial StoreInput where
    serialize :: StoreInput -> m ()
serialize StoreCoinbase{..} = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x00
        OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize OutPoint
inputPoint
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
inputSequence
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes ByteString
inputSigScript
        (ByteString -> m ()) -> WitnessStack -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes WitnessStack
inputWitness

    serialize StoreInput{..} = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x01
        OutPoint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize OutPoint
inputPoint
        Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Fingerprint
inputSequence
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes ByteString
inputSigScript
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes ByteString
inputPkScript
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
inputAmount
        (ByteString -> m ()) -> WitnessStack -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes WitnessStack
inputWitness
        (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 ()
serialize Maybe Address
inputAddress

    deserialize :: m StoreInput
deserialize =
        m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m StoreInput) -> m StoreInput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        0x00 -> do
            OutPoint
inputPoint <- m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            Fingerprint
inputSequence <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
            ByteString
inputSigScript <- m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
            WitnessStack
inputWitness <- m ByteString -> m WitnessStack
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
            StoreInput -> m StoreInput
forall (m :: * -> *) a. Monad m => a -> m a
return $WStoreCoinbase :: OutPoint -> Fingerprint -> ByteString -> WitnessStack -> StoreInput
StoreCoinbase{..}
        0x01 -> do
            OutPoint
inputPoint <- m OutPoint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            Fingerprint
inputSequence <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
            ByteString
inputSigScript <- m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
            ByteString
inputPkScript <- m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
            Word64
inputAmount <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
            WitnessStack
inputWitness <- m ByteString -> m WitnessStack
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
            Maybe Address
inputAddress <- 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
deserialize
            StoreInput -> m StoreInput
forall (m :: * -> *) a. Monad m => a -> m a
return $WStoreInput :: OutPoint
-> Fingerprint
-> ByteString
-> ByteString
-> Word64
-> WitnessStack
-> Maybe Address
-> StoreInput
StoreInput{..}

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

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

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

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

storeInputToJSON
    net :: Network
net
    StoreCoinbase
    {
        inputPoint :: StoreInput -> OutPoint
inputPoint = OutPoint oph :: TxHash
oph opi :: Fingerprint
opi,
        inputSequence :: StoreInput -> Fingerprint
inputSequence = Fingerprint
sq,
        inputSigScript :: StoreInput -> ByteString
inputSigScript = ByteString
ss,
        inputWitness :: StoreInput -> WitnessStack
inputWitness = WitnessStack
wit
    } =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "coinbase" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
True
    , "txid" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
oph
    , "output" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
opi
    , "sigscript" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (ByteString -> Text
encodeHex ByteString
ss)
    , "sequence" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
sq
    , "pkscript" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null
    , "value" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null
    , "address" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
Null
    , "witness" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (ByteString -> Text) -> WitnessStack -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
encodeHex WitnessStack
wit
    ]

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

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

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

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

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

instance Serial Spender where
    serialize :: Spender -> m ()
serialize Spender{..} = do
        TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TxHash
spenderHash
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
spenderIndex
    deserialize :: m Spender
deserialize = TxHash -> Fingerprint -> Spender
Spender (TxHash -> Fingerprint -> Spender)
-> m TxHash -> m (Fingerprint -> Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize m (Fingerprint -> Spender) -> m Fingerprint -> m Spender
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be

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

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

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

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

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

instance Serial StoreOutput where
    serialize :: StoreOutput -> m ()
serialize StoreOutput{..} = do
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
outputAmount
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes ByteString
outputScript
        (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 ()
serialize Maybe Spender
outputSpender
        (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 ()
serialize Maybe Address
outputAddr
    deserialize :: m StoreOutput
deserialize = do
        Word64
outputAmount <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        ByteString
outputScript <- m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
        Maybe Spender
outputSpender <- 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
deserialize
        Maybe Address
outputAddr <- 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
deserialize
        StoreOutput -> m StoreOutput
forall (m :: * -> *) a. Monad m => a -> m a
return $WStoreOutput :: Word64
-> ByteString -> Maybe Spender -> Maybe Address -> StoreOutput
StoreOutput{..}

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

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

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

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

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

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

instance Serial Prev where
    serialize :: Prev -> m ()
serialize Prev{..} = do
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes ByteString
prevScript
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
prevAmount
    deserialize :: m Prev
deserialize = do
        ByteString
prevScript <- m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
        Word64
prevAmount <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Prev -> m Prev
forall (m :: * -> *) a. Monad m => a -> m a
return $WPrev :: ByteString -> Word64 -> Prev
Prev{..}

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

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

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

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

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

instance Serial TxData where
    serialize :: TxData -> m ()
serialize TxData{..} = do
        BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockRef
txDataBlock
        Tx -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Tx
txData
        (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 ()
serialize IntMap Prev
txDataPrevs
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Bool
txDataDeleted
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Bool
txDataRBF
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
txDataTime
    deserialize :: m TxData
deserialize = do
        BlockRef
txDataBlock <- m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Tx
txData <- m Tx
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        IntMap Prev
txDataPrevs <- 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
deserialize
        Bool
txDataDeleted <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Bool
txDataRBF <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Word64
txDataTime <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        TxData -> m TxData
forall (m :: * -> *) a. Monad m => a -> m a
return $WTxData :: BlockRef -> Tx -> IntMap Prev -> Bool -> Bool -> Word64 -> TxData
TxData{..}

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

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

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

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

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

instance Serial Transaction where
    serialize :: Transaction -> m ()
serialize Transaction{..} = do
        BlockRef -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockRef
transactionBlock
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
transactionVersion
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
transactionLockTime
        (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 ()
serialize [StoreInput]
transactionInputs
        (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 ()
serialize [StoreOutput]
transactionOutputs
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Bool
transactionDeleted
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Bool
transactionRBF
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
transactionTime
        TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TxHash
transactionId
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
transactionSize
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
transactionWeight
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
transactionFees
    deserialize :: m Transaction
deserialize = do
        BlockRef
transactionBlock <- m BlockRef
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Fingerprint
transactionVersion <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Fingerprint
transactionLockTime <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        [StoreInput]
transactionInputs <- 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
deserialize
        [StoreOutput]
transactionOutputs <- 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
deserialize
        Bool
transactionDeleted <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Bool
transactionRBF <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Word64
transactionTime <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        TxHash
transactionId <- m TxHash
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Fingerprint
transactionSize <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Fingerprint
transactionWeight <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Word64
transactionFees <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Transaction -> m Transaction
forall (m :: * -> *) a. Monad m => a -> m a
return $WTransaction :: BlockRef
-> Fingerprint
-> Fingerprint
-> [StoreInput]
-> [StoreOutput]
-> Bool
-> Bool
-> Word64
-> TxHash
-> Fingerprint
-> Fingerprint
-> Word64
-> Transaction
Transaction{..}

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

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

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

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

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

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

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

instance Serial PeerInformation where
    serialize :: PeerInformation -> m ()
serialize PeerInformation{..} = do
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes ByteString
peerUserAgent
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes (Text -> ByteString
TE.encodeUtf8 (String -> Text
T.pack String
peerAddress))
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
peerVersion
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
peerServices
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Bool
peerRelay
    deserialize :: m PeerInformation
deserialize = do
        ByteString
peerUserAgent <- m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
        String
peerAddress <- Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> String) -> m ByteString -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
        Fingerprint
peerVersion <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Word64
peerServices <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Bool
peerRelay <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        PeerInformation -> m PeerInformation
forall (m :: * -> *) a. Monad m => a -> m a
return $WPeerInformation :: ByteString
-> String -> Fingerprint -> Word64 -> Bool -> PeerInformation
PeerInformation{..}

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

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

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

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

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

instance Serial XPubBal where
    serialize :: XPubBal -> m ()
serialize XPubBal{..} = do
        (Fingerprint -> m ()) -> [Fingerprint] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be [Fingerprint]
xPubBalPath
        Balance -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Balance
xPubBal
    deserialize :: m XPubBal
deserialize = do
        [Fingerprint]
xPubBalPath <- m Fingerprint -> m [Fingerprint]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Balance
xPubBal <- m Balance
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        XPubBal -> m XPubBal
forall (m :: * -> *) a. Monad m => a -> m a
return $WXPubBal :: [Fingerprint] -> Balance -> XPubBal
XPubBal{..}

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

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

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

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

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

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

instance Serial XPubUnspent where
    serialize :: XPubUnspent -> m ()
serialize XPubUnspent{..} = do
        (Fingerprint -> m ()) -> [Fingerprint] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be [Fingerprint]
xPubUnspentPath
        Unspent -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Unspent
xPubUnspent
    deserialize :: m XPubUnspent
deserialize = do
        [Fingerprint]
xPubUnspentPath <- m Fingerprint -> m [Fingerprint]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Unspent
xPubUnspent <- m Unspent
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        XPubUnspent -> m XPubUnspent
forall (m :: * -> *) a. Monad m => a -> m a
return $WXPubUnspent :: [Fingerprint] -> Unspent -> XPubUnspent
XPubUnspent{..}

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

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

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

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

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

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

instance Serial XPubSummary where
    serialize :: XPubSummary -> m ()
serialize XPubSummary{..} = do
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
xPubSummaryConfirmed
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
xPubSummaryZero
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
xPubSummaryReceived
        Word64 -> m ()
forall (m :: * -> *). MonadPut m => Word64 -> m ()
putWord64be Word64
xPubUnspentCount
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
xPubExternalIndex
        Fingerprint -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
putWord32be Fingerprint
xPubChangeIndex
    deserialize :: m XPubSummary
deserialize = do
        Word64
xPubSummaryConfirmed <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
xPubSummaryZero      <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
xPubSummaryReceived  <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Word64
xPubUnspentCount     <- m Word64
forall (m :: * -> *). MonadGet m => m Word64
getWord64be
        Fingerprint
xPubExternalIndex    <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        Fingerprint
xPubChangeIndex      <- m Fingerprint
forall (m :: * -> *). MonadGet m => m Fingerprint
getWord32be
        XPubSummary -> m XPubSummary
forall (m :: * -> *) a. Monad m => a -> m a
return $WXPubSummary :: Word64
-> Word64
-> Word64
-> Word64
-> Fingerprint
-> Fingerprint
-> XPubSummary
XPubSummary{..}

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

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

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

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

class Healthy a where
    isOK :: a -> Bool

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

instance Serial BlockHealth where
    serialize :: BlockHealth -> m ()
serialize h :: BlockHealth
h@BlockHealth{..} = do
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (BlockHealth -> Bool
forall a. Healthy a => a -> Bool
isOK BlockHealth
h)
        Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Fingerprint
blockHealthHeaders
        Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Fingerprint
blockHealthBlocks
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
blockHealthMaxDiff
    deserialize :: m BlockHealth
deserialize = do
        Bool
k                  <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Fingerprint
blockHealthHeaders <- m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Fingerprint
blockHealthBlocks  <- m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
blockHealthMaxDiff <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        let h :: BlockHealth
h = $WBlockHealth :: Fingerprint -> Fingerprint -> Int -> BlockHealth
BlockHealth{..}
        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 (m :: * -> *) a. MonadFail m => String -> m a
fail "Inconsistent health check"
        BlockHealth -> m BlockHealth
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 ()
serialize
    get :: Get BlockHealth
get = Get BlockHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

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

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

instance Serial TimeHealth where
    serialize :: TimeHealth -> m ()
serialize h :: TimeHealth
h@TimeHealth{..} = do
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (TimeHealth -> Bool
forall a. Healthy a => a -> Bool
isOK TimeHealth
h)
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
timeHealthAge
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
timeHealthMax
    deserialize :: m TimeHealth
deserialize = do
        Bool
k             <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
timeHealthAge <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
timeHealthMax <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        let t :: TimeHealth
t = $WTimeHealth :: Int -> Int -> TimeHealth
TimeHealth{..}
        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 (m :: * -> *) a. MonadFail m => String -> m a
fail "Inconsistent health check"
        TimeHealth -> m TimeHealth
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 ()
serialize
    get :: Get TimeHealth
get = Get TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

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

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

instance Serial CountHealth where
    serialize :: CountHealth -> m ()
serialize h :: CountHealth
h@CountHealth{..} = do
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (CountHealth -> Bool
forall a. Healthy a => a -> Bool
isOK CountHealth
h)
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
countHealthNum
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
countHealthMin
    deserialize :: m CountHealth
deserialize = do
        Bool
k              <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
countHealthNum <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
countHealthMin <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        let c :: CountHealth
c = $WCountHealth :: Int -> Int -> CountHealth
CountHealth{..}
        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 (m :: * -> *) a. MonadFail m => String -> m a
fail "Inconsistent health check"
        CountHealth -> m CountHealth
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 ()
serialize
    get :: Get CountHealth
get = Get CountHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

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

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

instance Serial MaxHealth where
    serialize :: MaxHealth -> m ()
serialize h :: MaxHealth
h@MaxHealth {..} = do
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ MaxHealth -> Bool
forall a. Healthy a => a -> Bool
isOK MaxHealth
h
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
maxHealthNum
        Int -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Int
maxHealthMax
    deserialize :: m MaxHealth
deserialize = do
        Bool
k            <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
maxHealthNum <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        Int
maxHealthMax <- m Int
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        let h :: MaxHealth
h = $WMaxHealth :: Int -> Int -> MaxHealth
MaxHealth{..}
        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 (m :: * -> *) a. MonadFail m => String -> m a
fail "Inconsistent health check"
        MaxHealth -> m MaxHealth
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 ()
serialize
    get :: Get MaxHealth
get = Get MaxHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

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

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

instance Serial HealthCheck where
    serialize :: HealthCheck -> m ()
serialize h :: HealthCheck
h@HealthCheck {..} = do
        Bool -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (HealthCheck -> Bool
forall a. Healthy a => a -> Bool
isOK HealthCheck
h)
        BlockHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize BlockHealth
healthBlocks
        TimeHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TimeHealth
healthLastBlock
        TimeHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TimeHealth
healthLastTx
        MaxHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize MaxHealth
healthPendingTxs
        CountHealth -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize CountHealth
healthPeers
        String -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize String
healthNetwork
        String -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize String
healthVersion
    deserialize :: m HealthCheck
deserialize = do
        Bool
k                   <- m Bool
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        BlockHealth
healthBlocks        <- m BlockHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        TimeHealth
healthLastBlock     <- m TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        TimeHealth
healthLastTx        <- m TimeHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        MaxHealth
healthPendingTxs    <- m MaxHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        CountHealth
healthPeers         <- m CountHealth
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        String
healthNetwork       <- m String
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        String
healthVersion       <- m String
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
        let h :: HealthCheck
h = $WHealthCheck :: BlockHealth
-> TimeHealth
-> TimeHealth
-> MaxHealth
-> CountHealth
-> String
-> String
-> HealthCheck
HealthCheck {..}
        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 (m :: * -> *) a. MonadFail m => String -> m a
fail "Inconsistent health check"
        HealthCheck -> m HealthCheck
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 ()
serialize
    get :: Get HealthCheck
get = Get HealthCheck
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

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

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

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

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

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

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

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

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

instance Serial a => Serial (GenericResult a) where
    serialize :: GenericResult a -> m ()
serialize (GenericResult x :: a
x) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
x
    deserialize :: 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
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 ()
serialize
    get :: Get (GenericResult a)
get = Get (GenericResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m 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 ()
serialize
    get :: Get (GenericResult a)
get = Get (GenericResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

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

instance Serial a => Serial (RawResult a) where
    serialize :: RawResult a -> m ()
serialize (RawResult x :: a
x) = a -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
x
    deserialize :: 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
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 ()
serialize
    get :: Get (RawResult a)
get = Get (RawResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m 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 ()
serialize
    get :: Get (RawResult a)
get = Get (RawResult a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial a => ToJSON (RawResult a) where
    toJSON :: RawResult a -> Value
toJSON (RawResult b :: a
b) =
        [Pair] -> Value
A.object ["result" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a -> Text
x a
b]
      where
        x :: a -> Text
x = ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            ByteString -> Builder
BSB.lazyByteStringHex (ByteString -> Builder) -> (a -> ByteString) -> a -> Builder
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 ()
serialize
    toEncoding :: RawResult a -> Encoding
toEncoding (RawResult b :: a
b) =
        Series -> Encoding
AE.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ "result" Text -> Encoding -> Series
`AE.pair` Builder -> Encoding
forall a. Builder -> Encoding' a
AE.unsafeToEncoding Builder
str
      where
        str :: Builder
str = Char -> Builder
BSB.char7 '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              ByteString -> Builder
BSB.lazyByteStringHex (Put -> ByteString
runPutL (a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
b)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              Char -> Builder
BSB.char7 '"'

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

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

instance Serial a => Serial (RawResultList a) where
    serialize :: RawResultList a -> m ()
serialize (RawResultList xs :: [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 ()
serialize [a]
xs
    deserialize :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            True -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            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
deserialize m ([a] -> [a]) -> m [a] -> m [a]
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 ()
serialize
    get :: Get (RawResultList a)
get = Get (RawResultList a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m 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 ()
serialize
    get :: Get (RawResultList a)
get = Get (RawResultList a)
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

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

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

instance Serial a => ToJSON (RawResultList a) where
    toJSON :: RawResultList a -> Value
toJSON (RawResultList xs :: [a]
xs) =
        [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> [Text] -> Value
forall a b. (a -> b) -> a -> b
$
        ByteString -> Text
TLE.decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ByteString -> Builder
BSB.lazyByteStringHex (ByteString -> Builder) -> (a -> ByteString) -> a -> Builder
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 ()
serialize (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
    toEncoding :: RawResultList a -> Encoding
toEncoding (RawResultList xs :: [a]
xs) =
        (a -> Encoding) -> [a] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
AE.list (Builder -> Encoding
forall a. Builder -> Encoding' a
AE.unsafeToEncoding (Builder -> Encoding) -> (a -> Builder) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. Serial a => a -> Builder
str) [a]
xs
      where
        str :: a -> Builder
str x :: a
x =
            Char -> Builder
BSB.char7 '"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
            ByteString -> Builder
BSB.lazyByteStringHex (Put -> ByteString
runPutL (a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize a
x)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
            Char -> Builder
BSB.char7 '"'

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

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

instance Serial TxId where
    serialize :: TxId -> m ()
serialize (TxId h :: TxHash
h) = TxHash -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize TxHash
h
    deserialize :: 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
deserialize

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

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

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

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

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

instance Serial Except where
    serialize :: Except -> m ()
serialize ThingNotFound =
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x00
    serialize ServerError =
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x01
    serialize BadRequest =
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x02
    serialize (UserError s :: String
s) = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x03
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes (Text -> ByteString
TE.encodeUtf8 (String -> Text
T.pack String
s))
    serialize (StringError s :: String
s) = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x04
        ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putLengthBytes (Text -> ByteString
TE.encodeUtf8 (String -> Text
T.pack String
s))
    serialize (TxIndexConflict ts :: [TxHash]
ts) = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 0x05
        (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 ()
serialize [TxHash]
ts

    deserialize :: m Except
deserialize =
        m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8 m Word8 -> (Word8 -> m Except) -> m Except
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        0x00 -> Except -> m Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ThingNotFound
        0x01 -> Except -> m Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ServerError
        0x02 -> Except -> m Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
BadRequest
        0x03 -> String -> Except
UserError (String -> Except)
-> (ByteString -> String) -> ByteString -> Except
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Except) -> m ByteString -> m Except
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
        0x04 -> String -> Except
StringError (String -> Except)
-> (ByteString -> String) -> ByteString -> Except
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Except) -> m ByteString -> m Except
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). MonadGet m => m ByteString
getLengthBytes
        0x05 -> [TxHash] -> Except
TxIndexConflict ([TxHash] -> Except) -> m [TxHash] -> m Except
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
deserialize
        _    -> String -> m Except
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Cannot recognize exception"

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

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

instance Exception Except

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

instance ToJSON Except where
    toJSON :: Except -> Value
toJSON e :: Except
e =
        [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        case Except
e of
            ThingNotFound ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "not-found-or-invalid-arg"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "Item not found or argument invalid"
                ]
            ServerError ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "server-error"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "Server error" ]
            BadRequest ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "bad-request"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "Invalid request" ]
            UserError msg :: String
msg ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "user-error"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
msg) ]
            StringError msg :: String
msg ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "string-error"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
msg) ]
            TxIndexConflict txids :: [TxHash]
txids ->
                [ "error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "multiple-tx-index"
                , "message" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String "Many txs match that tx_index"
                , "txids" Text -> [TxHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [TxHash]
txids ]

instance FromJSON Except where
    parseJSON :: Value -> Parser Except
parseJSON =
        String -> (Object -> Parser Except) -> Value -> Parser Except
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "Except" ((Object -> Parser Except) -> Value -> Parser Except)
-> (Object -> Parser Except) -> Value -> Parser Except
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
            Value
ctr <- Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: "error"
            String
msg <- Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "message" Parser (Maybe String) -> String -> Parser String
forall a. Parser (Maybe a) -> a -> Parser a
.!= ""
            case Value
ctr of
                String "not-found-or-invalid-arg" ->
                    Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ThingNotFound
                String "server-error" ->
                    Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
ServerError
                String "bad-request" ->
                    Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return Except
BadRequest
                String "user-error" ->
                    Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return (Except -> Parser Except) -> Except -> Parser Except
forall a b. (a -> b) -> a -> b
$ String -> Except
UserError String
msg
                String "string-error" ->
                    Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return (Except -> Parser Except) -> Except -> Parser Except
forall a b. (a -> b) -> a -> b
$ String -> Except
StringError String
msg
                String "multiple-tx-index" -> do
                    [TxHash]
txids <- Object
o Object -> Text -> Parser [TxHash]
forall a. FromJSON a => Object -> Text -> Parser a
.: "txids"
                    Except -> Parser Except
forall (m :: * -> *) a. Monad m => a -> m a
return (Except -> Parser Except) -> Except -> Parser Except
forall a b. (a -> b) -> a -> b
$ [TxHash] -> Except
TxIndexConflict [TxHash]
txids
                _ -> Parser Except
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

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


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

instance Parsable BinfoBlockId where
    parseParam :: Text -> Either Text BinfoBlockId
parseParam t :: 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
TL.toStrict Text
t) of
                Nothing -> Text -> Either Text BinfoBlockId
forall a b. a -> Either a b
Left "could not decode txid"
                Just h :: 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 = Fingerprint -> BinfoBlockId
BinfoBlockIndex (Fingerprint -> BinfoBlockId)
-> Either Text Fingerprint -> Either Text BinfoBlockId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Fingerprint
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
/= :: BinfoTxId -> BinfoTxId -> Bool
$c/= :: BinfoTxId -> BinfoTxId -> Bool
== :: BinfoTxId -> BinfoTxId -> Bool
$c== :: BinfoTxId -> BinfoTxId -> Bool
Eq, Int -> BinfoTxId -> ShowS
[BinfoTxId] -> ShowS
BinfoTxId -> String
(Int -> BinfoTxId -> ShowS)
-> (BinfoTxId -> String)
-> ([BinfoTxId] -> ShowS)
-> Show BinfoTxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinfoTxId] -> ShowS
$cshowList :: [BinfoTxId] -> ShowS
show :: BinfoTxId -> String
$cshow :: BinfoTxId -> String
showsPrec :: Int -> BinfoTxId -> ShowS
$cshowsPrec :: Int -> BinfoTxId -> ShowS
Show, ReadPrec [BinfoTxId]
ReadPrec BinfoTxId
Int -> ReadS BinfoTxId
ReadS [BinfoTxId]
(Int -> ReadS BinfoTxId)
-> ReadS [BinfoTxId]
-> ReadPrec BinfoTxId
-> ReadPrec [BinfoTxId]
-> Read BinfoTxId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinfoTxId]
$creadListPrec :: ReadPrec [BinfoTxId]
readPrec :: ReadPrec BinfoTxId
$creadPrec :: ReadPrec BinfoTxId
readList :: ReadS [BinfoTxId]
$creadList :: ReadS [BinfoTxId]
readsPrec :: Int -> ReadS BinfoTxId
$creadsPrec :: Int -> ReadS BinfoTxId
Read, (forall x. BinfoTxId -> Rep BinfoTxId x)
-> (forall x. Rep BinfoTxId x -> BinfoTxId) -> Generic BinfoTxId
forall x. Rep BinfoTxId x -> BinfoTxId
forall x. BinfoTxId -> Rep BinfoTxId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinfoTxId x -> BinfoTxId
$cfrom :: forall x. BinfoTxId -> Rep BinfoTxId x
Generic, BinfoTxId -> ()
(BinfoTxId -> ()) -> NFData BinfoTxId
forall a. (a -> ()) -> NFData a
rnf :: BinfoTxId -> ()
$crnf :: BinfoTxId -> ()
NFData)

encodeBinfoTxId :: Bool -> TxHash -> BinfoTxId
encodeBinfoTxId :: Bool -> TxHash -> BinfoTxId
encodeBinfoTxId False = TxHash -> BinfoTxId
BinfoTxIdHash
encodeBinfoTxId 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 t :: 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
TL.toStrict Text
t) of
                Nothing -> Text -> Either Text BinfoTxId
forall a b. a -> Either a b
Left "could not decode txid"
                Just h :: 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 h :: TxHash
h)  = TxHash -> Value
forall a. ToJSON a => a -> Value
toJSON TxHash
h
    toJSON (BinfoTxIdIndex i :: Word64
i) = Word64 -> Value
forall a. ToJSON a => a -> Value
toJSON Word64
i
    toEncoding :: BinfoTxId -> Encoding
toEncoding (BinfoTxIdHash h :: TxHash
h)  = TxHash -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding TxHash
h
    toEncoding (BinfoTxIdIndex i :: Word64
i) = Word64 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Word64
i

instance FromJSON BinfoTxId where
    parseJSON :: Value -> Parser BinfoTxId
parseJSON v :: Value
v = TxHash -> BinfoTxId
BinfoTxIdHash (TxHash -> BinfoTxId) -> Parser TxHash -> Parser BinfoTxId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TxHash
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser BinfoTxId -> Parser BinfoTxId -> Parser BinfoTxId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  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
/= :: BinfoFilter -> BinfoFilter -> Bool
$c/= :: BinfoFilter -> BinfoFilter -> Bool
== :: BinfoFilter -> BinfoFilter -> Bool
$c== :: 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
showList :: [BinfoFilter] -> ShowS
$cshowList :: [BinfoFilter] -> ShowS
show :: BinfoFilter -> String
$cshow :: BinfoFilter -> String
showsPrec :: Int -> BinfoFilter -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep BinfoFilter x -> BinfoFilter
$cfrom :: forall x. BinfoFilter -> Rep BinfoFilter x
Generic, BinfoFilter -> ()
(BinfoFilter -> ()) -> NFData BinfoFilter
forall a. (a -> ()) -> NFData a
rnf :: BinfoFilter -> ()
$crnf :: BinfoFilter -> ()
NFData)

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

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

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

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

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

data BinfoBalance
    = BinfoAddrBalance
        { BinfoBalance -> Address
getBinfoAddress      :: !Address
        , BinfoBalance -> Word64
getBinfoAddrTxCount  :: !Word64
        , BinfoBalance -> Word64
getBinfoAddrReceived :: !Word64
        , BinfoBalance -> Word64
getBinfoAddrSent     :: !Word64
        , BinfoBalance -> Word64
getBinfoAddrBalance  :: !Word64
        }
    | BinfoXPubBalance
        { BinfoBalance -> XPubKey
getBinfoXPubKey          :: !XPubKey
        , getBinfoAddrTxCount      :: !Word64
        , getBinfoAddrReceived     :: !Word64
        , getBinfoAddrSent         :: !Word64
        , getBinfoAddrBalance      :: !Word64
        , BinfoBalance -> Fingerprint
getBinfoXPubAccountIndex :: !Word32
        , BinfoBalance -> Fingerprint
getBinfoXPubChangeIndex  :: !Word32
        }
    deriving (BinfoBalance -> BinfoBalance -> Bool
(BinfoBalance -> BinfoBalance -> Bool)
-> (BinfoBalance -> BinfoBalance -> Bool) -> Eq BinfoBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoBalance -> BinfoBalance -> Bool
$c/= :: BinfoBalance -> BinfoBalance -> Bool
== :: BinfoBalance -> BinfoBalance -> Bool
$c== :: 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
showList :: [BinfoBalance] -> ShowS
$cshowList :: [BinfoBalance] -> ShowS
show :: BinfoBalance -> String
$cshow :: BinfoBalance -> String
showsPrec :: Int -> BinfoBalance -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep BinfoBalance x -> BinfoBalance
$cfrom :: forall x. BinfoBalance -> Rep BinfoBalance x
Generic, BinfoBalance -> ()
(BinfoBalance -> ()) -> NFData BinfoBalance
forall a. (a -> ()) -> NFData a
rnf :: BinfoBalance -> ()
$crnf :: BinfoBalance -> ()
NFData)

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

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

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

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

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

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

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

data BinfoUnspent
    = BinfoUnspent
      { BinfoUnspent -> TxHash
getBinfoUnspentHash          :: !TxHash
      , BinfoUnspent -> Fingerprint
getBinfoUnspentOutputIndex   :: !Word32
      , BinfoUnspent -> ByteString
getBinfoUnspentScript        :: !ByteString
      , BinfoUnspent -> Word64
getBinfoUnspentValue         :: !Word64
      , BinfoUnspent -> Int32
getBinfoUnspentConfirmations :: !Int32
      , BinfoUnspent -> BinfoTxId
getBinfoUnspentTxIndex       :: !BinfoTxId
      , BinfoUnspent -> Maybe BinfoXPubPath
getBinfoUnspentXPub          :: !(Maybe BinfoXPubPath)
      } deriving (BinfoUnspent -> BinfoUnspent -> Bool
(BinfoUnspent -> BinfoUnspent -> Bool)
-> (BinfoUnspent -> BinfoUnspent -> Bool) -> Eq BinfoUnspent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoUnspent -> BinfoUnspent -> Bool
$c/= :: BinfoUnspent -> BinfoUnspent -> Bool
== :: BinfoUnspent -> BinfoUnspent -> Bool
$c== :: 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
showList :: [BinfoUnspent] -> ShowS
$cshowList :: [BinfoUnspent] -> ShowS
show :: BinfoUnspent -> String
$cshow :: BinfoUnspent -> String
showsPrec :: Int -> BinfoUnspent -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep BinfoUnspent x -> BinfoUnspent
$cfrom :: forall x. BinfoUnspent -> Rep BinfoUnspent x
Generic, BinfoUnspent -> ()
(BinfoUnspent -> ()) -> NFData BinfoUnspent
forall a. (a -> ()) -> NFData a
rnf :: BinfoUnspent -> ()
$crnf :: BinfoUnspent -> ()
NFData)

binfoUnspentToJSON :: Network -> BinfoUnspent -> Value
binfoUnspentToJSON :: Network -> BinfoUnspent -> Value
binfoUnspentToJSON net :: Network
net BinfoUnspent{..} =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "tx_hash_big_endian" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
getBinfoUnspentHash
    , "tx_hash" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
        ByteString -> Text
encodeHex (Put -> ByteString
runPutS (ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (TxHash -> ChainCode
getTxHash TxHash
getBinfoUnspentHash)))
    , "tx_output_n" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoUnspentOutputIndex
    , "script" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoUnspentScript
    , "value" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoUnspentValue
    , "value_hex" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Text
binfoHexValue Word64
getBinfoUnspentValue
    , "confirmations" Text -> Int32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int32
getBinfoUnspentConfirmations
    , "tx_index" Text -> BinfoTxId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoUnspentTxIndex
    ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
    [ "xpub" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Network -> BinfoXPubPath -> Value
binfoXPubPathToJSON Network
net BinfoXPubPath
x
    | BinfoXPubPath
x <- Maybe BinfoXPubPath -> [BinfoXPubPath]
forall a. Maybe a -> [a]
maybeToList Maybe BinfoXPubPath
getBinfoUnspentXPub
    ]

binfoUnspentToEncoding :: Network -> BinfoUnspent -> Encoding
binfoUnspentToEncoding :: Network -> BinfoUnspent -> Encoding
binfoUnspentToEncoding net :: Network
net BinfoUnspent{..} =
    Series -> Encoding
AE.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
    "tx_hash_big_endian" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= TxHash
getBinfoUnspentHash Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "tx_hash" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=
    ByteString -> Text
encodeHex (Put -> ByteString
runPutS (ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (TxHash -> ChainCode
getTxHash TxHash
getBinfoUnspentHash))) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "tx_output_n" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoUnspentOutputIndex Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "script" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
encodeHex ByteString
getBinfoUnspentScript Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "value" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoUnspentValue Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "value_hex" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64 -> Text
binfoHexValue Word64
getBinfoUnspentValue Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "confirmations" Text -> Int32 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int32
getBinfoUnspentConfirmations Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "tx_index" Text -> BinfoTxId -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BinfoTxId
getBinfoUnspentTxIndex Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    Series
-> (BinfoXPubPath -> Series) -> Maybe BinfoXPubPath -> Series
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    Series
forall a. Monoid a => a
mempty
    (("xpub" Text -> Encoding -> Series
`AE.pair`) (Encoding -> Series)
-> (BinfoXPubPath -> Encoding) -> BinfoXPubPath -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> BinfoXPubPath -> Encoding
binfoXPubPathToEncoding Network
net)
    Maybe BinfoXPubPath
getBinfoUnspentXPub

binfoUnspentParseJSON :: Network -> Value -> Parser BinfoUnspent
binfoUnspentParseJSON :: Network -> Value -> Parser BinfoUnspent
binfoUnspentParseJSON net :: Network
net = String
-> (Object -> Parser BinfoUnspent) -> Value -> Parser BinfoUnspent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "unspent" ((Object -> Parser BinfoUnspent) -> Value -> Parser BinfoUnspent)
-> (Object -> Parser BinfoUnspent) -> Value -> Parser BinfoUnspent
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    TxHash
getBinfoUnspentHash <- Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx_hash_big_endian"
    Fingerprint
getBinfoUnspentOutputIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx_output_n"
    ByteString
getBinfoUnspentScript <- Parser ByteString
-> (ByteString -> Parser ByteString)
-> Maybe ByteString
-> Parser ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser ByteString
forall (m :: * -> *) a. MonadPlus m => m a
mzero ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Parser ByteString)
-> (Text -> Maybe ByteString) -> Text -> Parser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ByteString
decodeHex (Text -> Parser ByteString) -> Parser Text -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "script"
    Word64
getBinfoUnspentValue <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "value"
    Int32
getBinfoUnspentConfirmations <- Object
o Object -> Text -> Parser Int32
forall a. FromJSON a => Object -> Text -> Parser a
.: "confirmations"
    BinfoTxId
getBinfoUnspentTxIndex <- Object
o Object -> Text -> Parser BinfoTxId
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx_index"
    Maybe BinfoXPubPath
getBinfoUnspentXPub <- (Value -> Parser BinfoXPubPath)
-> Maybe Value -> Parser (Maybe BinfoXPubPath)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Network -> Value -> Parser BinfoXPubPath
binfoXPubPathParseJSON Network
net) (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 -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "xpub"
    BinfoUnspent -> Parser BinfoUnspent
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoUnspent :: TxHash
-> Fingerprint
-> ByteString
-> Word64
-> Int32
-> BinfoTxId
-> Maybe BinfoXPubPath
-> BinfoUnspent
BinfoUnspent{..}

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

binfoUnspentsToJSON :: Network -> BinfoUnspents -> Value
binfoUnspentsToJSON :: Network -> BinfoUnspents -> Value
binfoUnspentsToJSON net :: Network
net (BinfoUnspents us :: [BinfoUnspent]
us) =
    [Pair] -> Value
A.object
    [ "notice" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
T.empty
    , "unspent_outputs" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BinfoUnspent -> Value) -> [BinfoUnspent] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> BinfoUnspent -> Value
binfoUnspentToJSON Network
net) [BinfoUnspent]
us
    ]

binfoUnspentsToEncoding :: Network -> BinfoUnspents -> Encoding
binfoUnspentsToEncoding :: Network -> BinfoUnspents -> Encoding
binfoUnspentsToEncoding net :: Network
net (BinfoUnspents us :: [BinfoUnspent]
us) =
    Series -> Encoding
AE.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
    "notice" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
T.empty Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "unspent_outputs" Text -> Encoding -> Series
`AE.pair` (BinfoUnspent -> Encoding) -> [BinfoUnspent] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
AE.list (Network -> BinfoUnspent -> Encoding
binfoUnspentToEncoding Network
net) [BinfoUnspent]
us

binfoUnspentsParseJSON :: Network -> Value -> Parser BinfoUnspents
binfoUnspentsParseJSON :: Network -> Value -> Parser BinfoUnspents
binfoUnspentsParseJSON net :: Network
net = String
-> (Object -> Parser BinfoUnspents)
-> Value
-> Parser BinfoUnspents
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "unspents" ((Object -> Parser BinfoUnspents) -> Value -> Parser BinfoUnspents)
-> (Object -> Parser BinfoUnspents)
-> Value
-> Parser BinfoUnspents
forall a b. (a -> b) -> a -> b
$ \o :: 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)
mapM (Network -> Value -> Parser BinfoUnspent
binfoUnspentParseJSON Network
net) ([Value] -> Parser [BinfoUnspent])
-> Parser [Value] -> Parser [BinfoUnspent]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "unspent_outputs"
    BinfoUnspents -> Parser BinfoUnspents
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{..} txs :: [BinfoTx]
txs next_blocks :: [BlockHash]
next_blocks =
    $WBinfoBlock :: BlockHash
-> Fingerprint
-> BlockHash
-> ChainCode
-> Fingerprint
-> Fingerprint
-> [BlockHash]
-> Word64
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Bool
-> Fingerprint
-> Fingerprint
-> [BinfoTx]
-> BinfoBlock
BinfoBlock
        { getBinfoBlockHash :: BlockHash
getBinfoBlockHash = BlockHeader -> BlockHash
headerHash BlockHeader
blockDataHeader
        , getBinfoBlockVer :: Fingerprint
getBinfoBlockVer = BlockHeader -> Fingerprint
blockVersion BlockHeader
blockDataHeader
        , getBinfoPrevBlock :: BlockHash
getBinfoPrevBlock = BlockHeader -> BlockHash
prevBlock BlockHeader
blockDataHeader
        , getBinfoMerkleRoot :: ChainCode
getBinfoMerkleRoot = BlockHeader -> ChainCode
merkleRoot BlockHeader
blockDataHeader
        , getBinfoBlockTime :: Fingerprint
getBinfoBlockTime = BlockHeader -> Fingerprint
blockTimestamp BlockHeader
blockDataHeader
        , getBinfoBlockBits :: Fingerprint
getBinfoBlockBits = BlockHeader -> Fingerprint
blockBits BlockHeader
blockDataHeader
        , getBinfoNextBlock :: [BlockHash]
getBinfoNextBlock = [BlockHash]
next_blocks
        , getBinfoBlockFee :: Word64
getBinfoBlockFee = Word64
blockDataFees
        , getBinfoBlockNonce :: Fingerprint
getBinfoBlockNonce = BlockHeader -> Fingerprint
bhNonce BlockHeader
blockDataHeader
        , getBinfoBlockTxCount :: Fingerprint
getBinfoBlockTxCount = Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([BinfoTx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BinfoTx]
txs)
        , getBinfoBlockSize :: Fingerprint
getBinfoBlockSize = Fingerprint
blockDataSize
        , getBinfoBlockIndex :: Fingerprint
getBinfoBlockIndex = Fingerprint
blockDataHeight
        , getBinfoBlockMain :: Bool
getBinfoBlockMain = Bool
blockDataMainChain
        , getBinfoBlockHeight :: Fingerprint
getBinfoBlockHeight = Fingerprint
blockDataHeight
        , getBinfoBlockWeight :: Fingerprint
getBinfoBlockWeight = Fingerprint
blockDataWeight
        , getBinfoBlockTx :: [BinfoTx]
getBinfoBlockTx = [BinfoTx]
txs
        }

data BinfoBlock
    = BinfoBlock
        { BinfoBlock -> BlockHash
getBinfoBlockHash    :: !BlockHash
        , BinfoBlock -> Fingerprint
getBinfoBlockVer     :: !Word32
        , BinfoBlock -> BlockHash
getBinfoPrevBlock    :: !BlockHash
        , BinfoBlock -> ChainCode
getBinfoMerkleRoot   :: !Hash256
        , BinfoBlock -> Fingerprint
getBinfoBlockTime    :: !Word32
        , BinfoBlock -> Fingerprint
getBinfoBlockBits    :: !Word32
        , BinfoBlock -> [BlockHash]
getBinfoNextBlock    :: ![BlockHash]
        , BinfoBlock -> Word64
getBinfoBlockFee     :: !Word64
        , BinfoBlock -> Fingerprint
getBinfoBlockNonce   :: !Word32
        , BinfoBlock -> Fingerprint
getBinfoBlockTxCount :: !Word32
        , BinfoBlock -> Fingerprint
getBinfoBlockSize    :: !Word32
        , BinfoBlock -> Fingerprint
getBinfoBlockIndex   :: !Word32
        , BinfoBlock -> Bool
getBinfoBlockMain    :: !Bool
        , BinfoBlock -> Fingerprint
getBinfoBlockHeight  :: !Word32
        , BinfoBlock -> Fingerprint
getBinfoBlockWeight  :: !Word32
        , BinfoBlock -> [BinfoTx]
getBinfoBlockTx      :: ![BinfoTx]
        }
    deriving (BinfoBlock -> BinfoBlock -> Bool
(BinfoBlock -> BinfoBlock -> Bool)
-> (BinfoBlock -> BinfoBlock -> Bool) -> Eq BinfoBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinfoBlock -> BinfoBlock -> Bool
$c/= :: BinfoBlock -> BinfoBlock -> Bool
== :: BinfoBlock -> BinfoBlock -> Bool
$c== :: 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
showList :: [BinfoBlock] -> ShowS
$cshowList :: [BinfoBlock] -> ShowS
show :: BinfoBlock -> String
$cshow :: BinfoBlock -> String
showsPrec :: Int -> BinfoBlock -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep BinfoBlock x -> BinfoBlock
$cfrom :: forall x. BinfoBlock -> Rep BinfoBlock x
Generic, BinfoBlock -> ()
(BinfoBlock -> ()) -> NFData BinfoBlock
forall a. (a -> ()) -> NFData a
rnf :: BinfoBlock -> ()
$crnf :: BinfoBlock -> ()
NFData)

binfoBlockToJSON :: Network -> BinfoBlock -> Value
binfoBlockToJSON :: Network -> BinfoBlock -> Value
binfoBlockToJSON net :: Network
net BinfoBlock{..} =
    [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ "hash" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
getBinfoBlockHash
    , "ver" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockVer
    , "prev_block" Text -> BlockHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
getBinfoPrevBlock
    , "mrkl_root" Text -> TxHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChainCode -> TxHash
TxHash ChainCode
getBinfoMerkleRoot
    , "time" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockTime
    , "bits" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockBits
    , "next_block" Text -> [BlockHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BlockHash]
getBinfoNextBlock
    , "fee" Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoBlockFee
    , "nonce" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockNonce
    , "n_tx" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockTxCount
    , "size" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockSize
    , "block_index" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockIndex
    , "main_chain" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoBlockMain
    , "height" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockHeight
    , "weight" Text -> Fingerprint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockWeight
    , "tx" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (BinfoTx -> Value) -> [BinfoTx] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Network -> BinfoTx -> Value
binfoTxToJSON Network
net) [BinfoTx]
getBinfoBlockTx
    ]

binfoBlockToEncoding :: Network -> BinfoBlock -> Encoding
binfoBlockToEncoding :: Network -> BinfoBlock -> Encoding
binfoBlockToEncoding net :: Network
net BinfoBlock{..} =
    Series -> Encoding
AE.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
    "hash" Text -> BlockHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
getBinfoBlockHash Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "ver" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockVer Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "prev_block" Text -> BlockHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= BlockHash
getBinfoPrevBlock Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "mrkl_root" Text -> TxHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ChainCode -> TxHash
TxHash ChainCode
getBinfoMerkleRoot Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "time" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockTime Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "bits" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockBits Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "next_block" Text -> [BlockHash] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [BlockHash]
getBinfoNextBlock Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "fee" Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
getBinfoBlockFee Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "nonce" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockNonce Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "n_tx" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockTxCount Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "size" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockSize Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "block_index" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockIndex Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "main_chain" Text -> Bool -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
getBinfoBlockMain Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "height" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockHeight Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "weight" Text -> Fingerprint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Fingerprint
getBinfoBlockWeight Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
    "tx" Text -> Encoding -> Series
`AE.pair` (BinfoTx -> Encoding) -> [BinfoTx] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
AE.list (Network -> BinfoTx -> Encoding
binfoTxToEncoding Network
net) [BinfoTx]
getBinfoBlockTx

binfoBlockParseJSON :: Network -> Value -> Parser BinfoBlock
binfoBlockParseJSON :: Network -> Value -> Parser BinfoBlock
binfoBlockParseJSON net :: Network
net = String
-> (Object -> Parser BinfoBlock) -> Value -> Parser BinfoBlock
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject "block" ((Object -> Parser BinfoBlock) -> Value -> Parser BinfoBlock)
-> (Object -> Parser BinfoBlock) -> Value -> Parser BinfoBlock
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
    BlockHash
getBinfoBlockHash <- Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "hash"
    Fingerprint
getBinfoBlockVer <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "ver"
    BlockHash
getBinfoPrevBlock <- Object
o Object -> Text -> Parser BlockHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "prev_block"
    ChainCode
getBinfoMerkleRoot <- TxHash -> ChainCode
getTxHash (TxHash -> ChainCode) -> Parser TxHash -> Parser ChainCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser TxHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "mrkl_root"
    Fingerprint
getBinfoBlockTime <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "time"
    Fingerprint
getBinfoBlockBits <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "bits"
    [BlockHash]
getBinfoNextBlock <- Object
o Object -> Text -> Parser [BlockHash]
forall a. FromJSON a => Object -> Text -> Parser a
.: "next_block"
    Word64
getBinfoBlockFee <- Object
o Object -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "fee"
    Fingerprint
getBinfoBlockNonce <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "nonce"
    Fingerprint
getBinfoBlockTxCount <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "n_tx"
    Fingerprint
getBinfoBlockSize <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "size"
    Fingerprint
getBinfoBlockIndex <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "block_index"
    Bool
getBinfoBlockMain <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "main_chain"
    Fingerprint
getBinfoBlockHeight <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "height"
    Fingerprint
getBinfoBlockWeight <- Object
o Object -> Text -> Parser Fingerprint
forall a. FromJSON a => Object -> Text -> Parser a
.: "weight"
    [BinfoTx]
getBinfoBlockTx <- Object
o Object -> Text -> Parser [Value]
forall a. FromJSON a => Object -> Text -> Parser a
.: "tx" Parser [Value] -> ([Value] -> Parser [BinfoTx]) -> Parser [BinfoTx]
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)
mapM (Network -> Value -> Parser BinfoTx
binfoTxParseJSON Network
net)
    BinfoBlock -> Parser BinfoBlock
forall (m :: * -> *) a. Monad m => a -> m a
return $WBinfoBlock :: BlockHash
-> Fingerprint
-> BlockHash
-> ChainCode
-> Fingerprint
-> Fingerprint
-> [BlockHash]
-> Word64
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Bool
-> Fingerprint
-> Fingerprint
-> [BinfoTx]
-> BinfoBlock
BinfoBlock{..}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

toBinfoTxSimple :: Bool
                -> Transaction
                -> BinfoTx
toBinfoTxSimple :: Bool -> Transaction -> BinfoTx
toBinfoTxSimple numtxid :: 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 0

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

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

toBinfoTx :: Bool
          -> HashMap Address (Maybe BinfoXPubPath)
          -> Bool
          -> Int64
          -> Transaction
          -> BinfoTx
toBinfoTx :: Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Int64
-> Transaction
-> BinfoTx
toBinfoTx numtxid :: Bool
numtxid abook :: HashMap Address (Maybe BinfoXPubPath)
abook prune :: Bool
prune bal :: Int64
bal t :: Transaction
t@Transaction{..} =
    $WBinfoTx :: TxHash
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Fingerprint
-> Word64
-> ByteString
-> Fingerprint
-> BinfoTxId
-> Bool
-> Bool
-> Maybe (Int64, Int64)
-> Word64
-> Maybe Fingerprint
-> Maybe Fingerprint
-> [BinfoTxInput]
-> [BinfoTxOutput]
-> BinfoTx
BinfoTx{ getBinfoTxHash :: TxHash
getBinfoTxHash = Tx -> TxHash
txHash (Transaction -> Tx
transactionData Transaction
t)
           , getBinfoTxVer :: Fingerprint
getBinfoTxVer = Fingerprint
transactionVersion
           , getBinfoTxVinSz :: Fingerprint
getBinfoTxVinSz = Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([StoreInput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StoreInput]
transactionInputs)
           , getBinfoTxVoutSz :: Fingerprint
getBinfoTxVoutSz = Int -> Fingerprint
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([StoreOutput] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StoreOutput]
transactionOutputs)
           , getBinfoTxSize :: Fingerprint
getBinfoTxSize = Fingerprint
transactionSize
           , getBinfoTxWeight :: Fingerprint
getBinfoTxWeight = Fingerprint
transactionWeight
           , getBinfoTxFee :: Word64
getBinfoTxFee = Word64
transactionFees
           , getBinfoTxRelayedBy :: ByteString
getBinfoTxRelayedBy = "0.0.0.0"
           , getBinfoTxLockTime :: Fingerprint
getBinfoTxLockTime = Fingerprint
transactionLockTime
           , getBinfoTxIndex :: BinfoTxId
getBinfoTxIndex =
                   Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid (Tx -> TxHash
txHash (Transaction -> Tx
transactionData Transaction
t))
           , getBinfoTxDoubleSpend :: Bool
getBinfoTxDoubleSpend = Bool
transactionDeleted
           , getBinfoTxRBF :: Bool
getBinfoTxRBF = Bool
transactionRBF
           , getBinfoTxTime :: Word64
getBinfoTxTime = Word64
transactionTime
           , getBinfoTxBlockIndex :: Maybe Fingerprint
getBinfoTxBlockIndex = Transaction -> Maybe Fingerprint
toBinfoBlockIndex Transaction
t
           , getBinfoTxBlockHeight :: Maybe Fingerprint
getBinfoTxBlockHeight = Transaction -> Maybe Fingerprint
toBinfoBlockIndex Transaction
t
           , getBinfoTxInputs :: [BinfoTxInput]
getBinfoTxInputs = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Transaction
-> [BinfoTxInput]
toBinfoTxInputs Bool
numtxid HashMap Address (Maybe BinfoXPubPath)
abook Transaction
t
           , getBinfoTxOutputs :: [BinfoTxOutput]
getBinfoTxOutputs = [BinfoTxOutput]
outs
           , getBinfoTxResultBal :: Maybe (Int64, Int64)
getBinfoTxResultBal = Maybe (Int64, Int64)
resbal
           }
  where
    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
== 0
    resbal :: Maybe (Int64, Int64)
resbal = 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)
    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
    outs :: [BinfoTxOutput]
outs =
        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
> 0
            f :: Fingerprint -> StoreOutput -> Maybe BinfoTxOutput
f = Bool
-> HashMap Address (Maybe BinfoXPubPath)
-> Bool
-> Transaction
-> Fingerprint
-> 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
$ (Fingerprint -> StoreOutput -> Maybe BinfoTxOutput)
-> [Fingerprint] -> [StoreOutput] -> [Maybe BinfoTxOutput]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Fingerprint -> StoreOutput -> Maybe BinfoTxOutput
f [0..] [StoreOutput]
transactionOutputs

getTxResult :: HashSet Address -> Transaction -> Int64
getTxResult :: HashSet Address -> Transaction -> Int64
getTxResult aset :: HashSet Address
aset Transaction{..} =
    let input_sum :: Int64
input_sum = [Int64] -> Int64
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 p. Num p => StoreInput -> p
input_value [StoreInput]
transactionInputs
        input_value :: StoreInput -> p
input_value StoreCoinbase{} = 0
        input_value StoreInput{..} =
            case Maybe Address
inputAddress of
                Nothing -> 0
                Just a :: Address
a ->
                    if Address -> Bool
test_addr Address
a
                    then p -> p
forall a. Num a => a -> a
negate (p -> p) -> p -> p
forall a b. (a -> b) -> a -> b
$ Word64 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
inputAmount
                    else 0
        test_addr :: Address -> Bool
test_addr a :: Address
a = Address -> HashSet Address -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Address
a HashSet Address
aset
        output_sum :: Int64
output_sum = [Int64] -> Int64
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 p. Num p => StoreOutput -> p
out_value [StoreOutput]
transactionOutputs
        out_value :: StoreOutput -> p
out_value StoreOutput{..} =
            case Maybe Address
outputAddr of
                Nothing -> 0
                Just a :: Address
a ->
                    if Address -> Bool
test_addr Address
a
                    then Word64 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
outputAmount
                    else 0
     in Int64
input_sum Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
output_sum

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

toBinfoSpender :: Bool -> Spender -> BinfoSpender
toBinfoSpender :: Bool -> Spender -> BinfoSpender
toBinfoSpender numtxid :: Bool
numtxid Spender{..} =
    let getBinfoSpenderTxIndex :: BinfoTxId
getBinfoSpenderTxIndex = Bool -> TxHash -> BinfoTxId
encodeBinfoTxId Bool
numtxid TxHash
spenderHash
        getBinfoSpenderIndex :: Fingerprint
getBinfoSpenderIndex = Fingerprint
spenderIndex
     in $WBinfoSpender :: BinfoTxId -> Fingerprint -> BinfoSpender
BinfoSpender{..}

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

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

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