{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

module Haskoin.Store.Database.Types
  ( AddrTxKey (..),
    AddrOutKey (..),
    BestKey (..),
    BlockKey (..),
    BalKey (..),
    HeightKey (..),
    MemKey (..),
    TxKey (..),
    decodeTxKey,
    UnspentKey (..),
    VersionKey (..),
    BalVal (..),
    valToBalance,
    balanceToVal,
    UnspentVal (..),
    toUnspent,
    unspentToVal,
    valToUnspent,
    OutVal (..),
  )
where

import Control.DeepSeq (NFData)
import Control.Monad (guard)
import Data.Bits
  ( shift,
    (.&.),
  )
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Default (Default (..))
import Data.Hashable (Hashable)
import Data.Serialize
  ( Serialize (..),
    getBytes,
    getWord16be,
    getWord32be,
    getWord8,
    putWord64be,
    putWord8,
    runGet,
    runPut,
  )
import Data.Word (Word16, Word32, Word64, Word8)
import Database.RocksDB.Query (Key, KeyValue)
import GHC.Generics (Generic)
import Haskoin
  ( Address,
    BlockHash,
    BlockHeight,
    OutPoint (..),
    TxHash,
    eitherToMaybe,
    scriptToAddressBS,
  )
import Haskoin.Crypto
import Haskoin.Store.Data
  ( Balance (..),
    BlockData,
    BlockRef,
    TxData,
    TxRef (..),
    UnixTime,
    Unspent (..),
  )

-- | Database key for an address transaction.
data AddrTxKey
  = -- | key for a transaction affecting an address
    AddrTxKey
      { AddrTxKey -> Address
address :: !Address,
        AddrTxKey -> TxRef
tx :: !TxRef
      }
  | -- | short key that matches all entries
    AddrTxKeyA
      { address :: !Address
      }
  | AddrTxKeyB
      { address :: !Address,
        AddrTxKey -> BlockRef
block :: !BlockRef
      }
  | AddrTxKeyS
  deriving (Int -> AddrTxKey -> ShowS
[AddrTxKey] -> ShowS
AddrTxKey -> String
(Int -> AddrTxKey -> ShowS)
-> (AddrTxKey -> String)
-> ([AddrTxKey] -> ShowS)
-> Show AddrTxKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddrTxKey -> ShowS
showsPrec :: Int -> AddrTxKey -> ShowS
$cshow :: AddrTxKey -> String
show :: AddrTxKey -> String
$cshowList :: [AddrTxKey] -> ShowS
showList :: [AddrTxKey] -> ShowS
Show, AddrTxKey -> AddrTxKey -> Bool
(AddrTxKey -> AddrTxKey -> Bool)
-> (AddrTxKey -> AddrTxKey -> Bool) -> Eq AddrTxKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrTxKey -> AddrTxKey -> Bool
== :: AddrTxKey -> AddrTxKey -> Bool
$c/= :: AddrTxKey -> AddrTxKey -> Bool
/= :: AddrTxKey -> AddrTxKey -> Bool
Eq, Eq AddrTxKey
Eq AddrTxKey =>
(AddrTxKey -> AddrTxKey -> Ordering)
-> (AddrTxKey -> AddrTxKey -> Bool)
-> (AddrTxKey -> AddrTxKey -> Bool)
-> (AddrTxKey -> AddrTxKey -> Bool)
-> (AddrTxKey -> AddrTxKey -> Bool)
-> (AddrTxKey -> AddrTxKey -> AddrTxKey)
-> (AddrTxKey -> AddrTxKey -> AddrTxKey)
-> Ord AddrTxKey
AddrTxKey -> AddrTxKey -> Bool
AddrTxKey -> AddrTxKey -> Ordering
AddrTxKey -> AddrTxKey -> AddrTxKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AddrTxKey -> AddrTxKey -> Ordering
compare :: AddrTxKey -> AddrTxKey -> Ordering
$c< :: AddrTxKey -> AddrTxKey -> Bool
< :: AddrTxKey -> AddrTxKey -> Bool
$c<= :: AddrTxKey -> AddrTxKey -> Bool
<= :: AddrTxKey -> AddrTxKey -> Bool
$c> :: AddrTxKey -> AddrTxKey -> Bool
> :: AddrTxKey -> AddrTxKey -> Bool
$c>= :: AddrTxKey -> AddrTxKey -> Bool
>= :: AddrTxKey -> AddrTxKey -> Bool
$cmax :: AddrTxKey -> AddrTxKey -> AddrTxKey
max :: AddrTxKey -> AddrTxKey -> AddrTxKey
$cmin :: AddrTxKey -> AddrTxKey -> AddrTxKey
min :: AddrTxKey -> AddrTxKey -> AddrTxKey
Ord, (forall x. AddrTxKey -> Rep AddrTxKey x)
-> (forall x. Rep AddrTxKey x -> AddrTxKey) -> Generic AddrTxKey
forall x. Rep AddrTxKey x -> AddrTxKey
forall x. AddrTxKey -> Rep AddrTxKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddrTxKey -> Rep AddrTxKey x
from :: forall x. AddrTxKey -> Rep AddrTxKey x
$cto :: forall x. Rep AddrTxKey x -> AddrTxKey
to :: forall x. Rep AddrTxKey x -> AddrTxKey
Generic, Eq AddrTxKey
Eq AddrTxKey =>
(Int -> AddrTxKey -> Int)
-> (AddrTxKey -> Int) -> Hashable AddrTxKey
Int -> AddrTxKey -> Int
AddrTxKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AddrTxKey -> Int
hashWithSalt :: Int -> AddrTxKey -> Int
$chash :: AddrTxKey -> Int
hash :: AddrTxKey -> Int
Hashable)

instance Serialize AddrTxKey where
  -- 0x05 · Address · BlockRef · TxHash

  put :: Putter AddrTxKey
put
    AddrTxKey
      { $sel:address:AddrTxKey :: AddrTxKey -> Address
address = Address
a,
        $sel:tx:AddrTxKey :: AddrTxKey -> TxRef
tx = TxRef {$sel:block:TxRef :: TxRef -> BlockRef
block = BlockRef
b, $sel:txid:TxRef :: TxRef -> TxHash
txid = TxHash
t}
      } = do
      Putter AddrTxKey
forall t. Serialize t => Putter t
put AddrTxKeyB {$sel:address:AddrTxKey :: Address
address = Address
a, $sel:block:AddrTxKey :: BlockRef
block = BlockRef
b}
      Putter TxHash
forall t. Serialize t => Putter t
put TxHash
t
  -- 0x05 · Address
  put AddrTxKeyA {$sel:address:AddrTxKey :: AddrTxKey -> Address
address = Address
a} = do
    Putter AddrTxKey
forall t. Serialize t => Putter t
put AddrTxKey
AddrTxKeyS
    Putter Address
forall t. Serialize t => Putter t
put Address
a
  -- 0x05 · Address · BlockRef
  put AddrTxKeyB {$sel:address:AddrTxKey :: AddrTxKey -> Address
address = Address
a, $sel:block:AddrTxKey :: AddrTxKey -> BlockRef
block = BlockRef
b} = do
    Putter AddrTxKey
forall t. Serialize t => Putter t
put AddrTxKeyA {$sel:address:AddrTxKey :: Address
address = Address
a}
    Putter BlockRef
forall t. Serialize t => Putter t
put BlockRef
b
  -- 0x05
  put AddrTxKey
AddrTxKeyS = Putter Word8
putWord8 Word8
0x05
  get :: Get AddrTxKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x05) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    Address
a <- Get Address
forall t. Serialize t => Get t
get
    BlockRef
b <- Get BlockRef
forall t. Serialize t => Get t
get
    TxHash
t <- Get TxHash
forall t. Serialize t => Get t
get
    AddrTxKey -> Get AddrTxKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return
      AddrTxKey
        { $sel:address:AddrTxKey :: Address
address = Address
a,
          $sel:tx:AddrTxKey :: TxRef
tx = TxRef {$sel:block:TxRef :: BlockRef
block = BlockRef
b, $sel:txid:TxRef :: TxHash
txid = TxHash
t}
        }

instance Key AddrTxKey

instance KeyValue AddrTxKey ()

-- | Database key for an address output.
data AddrOutKey
  = -- | full key
    AddrOutKey
      { AddrOutKey -> Address
address :: !Address,
        AddrOutKey -> BlockRef
block :: !BlockRef,
        AddrOutKey -> OutPoint
outpoint :: !OutPoint
      }
  | -- | short key for all spent or unspent outputs
    AddrOutKeyA
      { address :: !Address
      }
  | AddrOutKeyB
      { address :: !Address,
        block :: !BlockRef
      }
  | AddrOutKeyS
  deriving (Int -> AddrOutKey -> ShowS
[AddrOutKey] -> ShowS
AddrOutKey -> String
(Int -> AddrOutKey -> ShowS)
-> (AddrOutKey -> String)
-> ([AddrOutKey] -> ShowS)
-> Show AddrOutKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddrOutKey -> ShowS
showsPrec :: Int -> AddrOutKey -> ShowS
$cshow :: AddrOutKey -> String
show :: AddrOutKey -> String
$cshowList :: [AddrOutKey] -> ShowS
showList :: [AddrOutKey] -> ShowS
Show, ReadPrec [AddrOutKey]
ReadPrec AddrOutKey
Int -> ReadS AddrOutKey
ReadS [AddrOutKey]
(Int -> ReadS AddrOutKey)
-> ReadS [AddrOutKey]
-> ReadPrec AddrOutKey
-> ReadPrec [AddrOutKey]
-> Read AddrOutKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AddrOutKey
readsPrec :: Int -> ReadS AddrOutKey
$creadList :: ReadS [AddrOutKey]
readList :: ReadS [AddrOutKey]
$creadPrec :: ReadPrec AddrOutKey
readPrec :: ReadPrec AddrOutKey
$creadListPrec :: ReadPrec [AddrOutKey]
readListPrec :: ReadPrec [AddrOutKey]
Read, AddrOutKey -> AddrOutKey -> Bool
(AddrOutKey -> AddrOutKey -> Bool)
-> (AddrOutKey -> AddrOutKey -> Bool) -> Eq AddrOutKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrOutKey -> AddrOutKey -> Bool
== :: AddrOutKey -> AddrOutKey -> Bool
$c/= :: AddrOutKey -> AddrOutKey -> Bool
/= :: AddrOutKey -> AddrOutKey -> Bool
Eq, Eq AddrOutKey
Eq AddrOutKey =>
(AddrOutKey -> AddrOutKey -> Ordering)
-> (AddrOutKey -> AddrOutKey -> Bool)
-> (AddrOutKey -> AddrOutKey -> Bool)
-> (AddrOutKey -> AddrOutKey -> Bool)
-> (AddrOutKey -> AddrOutKey -> Bool)
-> (AddrOutKey -> AddrOutKey -> AddrOutKey)
-> (AddrOutKey -> AddrOutKey -> AddrOutKey)
-> Ord AddrOutKey
AddrOutKey -> AddrOutKey -> Bool
AddrOutKey -> AddrOutKey -> Ordering
AddrOutKey -> AddrOutKey -> AddrOutKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AddrOutKey -> AddrOutKey -> Ordering
compare :: AddrOutKey -> AddrOutKey -> Ordering
$c< :: AddrOutKey -> AddrOutKey -> Bool
< :: AddrOutKey -> AddrOutKey -> Bool
$c<= :: AddrOutKey -> AddrOutKey -> Bool
<= :: AddrOutKey -> AddrOutKey -> Bool
$c> :: AddrOutKey -> AddrOutKey -> Bool
> :: AddrOutKey -> AddrOutKey -> Bool
$c>= :: AddrOutKey -> AddrOutKey -> Bool
>= :: AddrOutKey -> AddrOutKey -> Bool
$cmax :: AddrOutKey -> AddrOutKey -> AddrOutKey
max :: AddrOutKey -> AddrOutKey -> AddrOutKey
$cmin :: AddrOutKey -> AddrOutKey -> AddrOutKey
min :: AddrOutKey -> AddrOutKey -> AddrOutKey
Ord, (forall x. AddrOutKey -> Rep AddrOutKey x)
-> (forall x. Rep AddrOutKey x -> AddrOutKey) -> Generic AddrOutKey
forall x. Rep AddrOutKey x -> AddrOutKey
forall x. AddrOutKey -> Rep AddrOutKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddrOutKey -> Rep AddrOutKey x
from :: forall x. AddrOutKey -> Rep AddrOutKey x
$cto :: forall x. Rep AddrOutKey x -> AddrOutKey
to :: forall x. Rep AddrOutKey x -> AddrOutKey
Generic, Eq AddrOutKey
Eq AddrOutKey =>
(Int -> AddrOutKey -> Int)
-> (AddrOutKey -> Int) -> Hashable AddrOutKey
Int -> AddrOutKey -> Int
AddrOutKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> AddrOutKey -> Int
hashWithSalt :: Int -> AddrOutKey -> Int
$chash :: AddrOutKey -> Int
hash :: AddrOutKey -> Int
Hashable)

instance Serialize AddrOutKey where
  -- 0x06 · StoreAddr · BlockRef · OutPoint

  put :: Putter AddrOutKey
put AddrOutKey {$sel:address:AddrOutKey :: AddrOutKey -> Address
address = Address
a, $sel:block:AddrOutKey :: AddrOutKey -> BlockRef
block = BlockRef
b, $sel:outpoint:AddrOutKey :: AddrOutKey -> OutPoint
outpoint = OutPoint
p} = do
    Putter AddrOutKey
forall t. Serialize t => Putter t
put AddrOutKeyB {$sel:address:AddrOutKey :: Address
address = Address
a, $sel:block:AddrOutKey :: BlockRef
block = BlockRef
b}
    Putter OutPoint
forall t. Serialize t => Putter t
put OutPoint
p
  -- 0x06 · StoreAddr · BlockRef
  put AddrOutKeyB {$sel:address:AddrOutKey :: AddrOutKey -> Address
address = Address
a, $sel:block:AddrOutKey :: AddrOutKey -> BlockRef
block = BlockRef
b} = do
    Putter AddrOutKey
forall t. Serialize t => Putter t
put AddrOutKeyA {$sel:address:AddrOutKey :: Address
address = Address
a}
    Putter BlockRef
forall t. Serialize t => Putter t
put BlockRef
b
  -- 0x06 · StoreAddr
  put AddrOutKeyA {$sel:address:AddrOutKey :: AddrOutKey -> Address
address = Address
a} = do
    Putter AddrOutKey
forall t. Serialize t => Putter t
put AddrOutKey
AddrOutKeyS
    Putter Address
forall t. Serialize t => Putter t
put Address
a
  -- 0x06
  put AddrOutKey
AddrOutKeyS = Putter Word8
putWord8 Word8
0x06
  get :: Get AddrOutKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x06) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    Address -> BlockRef -> OutPoint -> AddrOutKey
AddrOutKey (Address -> BlockRef -> OutPoint -> AddrOutKey)
-> Get Address -> Get (BlockRef -> OutPoint -> AddrOutKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Address
forall t. Serialize t => Get t
get Get (BlockRef -> OutPoint -> AddrOutKey)
-> Get BlockRef -> Get (OutPoint -> AddrOutKey)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BlockRef
forall t. Serialize t => Get t
get Get (OutPoint -> AddrOutKey) -> Get OutPoint -> Get AddrOutKey
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get OutPoint
forall t. Serialize t => Get t
get

instance Key AddrOutKey

data OutVal = OutVal
  { OutVal -> Word64
value :: !Word64,
    OutVal -> ByteString
script :: !ByteString
  }
  deriving (Int -> OutVal -> ShowS
[OutVal] -> ShowS
OutVal -> String
(Int -> OutVal -> ShowS)
-> (OutVal -> String) -> ([OutVal] -> ShowS) -> Show OutVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutVal -> ShowS
showsPrec :: Int -> OutVal -> ShowS
$cshow :: OutVal -> String
show :: OutVal -> String
$cshowList :: [OutVal] -> ShowS
showList :: [OutVal] -> ShowS
Show, ReadPrec [OutVal]
ReadPrec OutVal
Int -> ReadS OutVal
ReadS [OutVal]
(Int -> ReadS OutVal)
-> ReadS [OutVal]
-> ReadPrec OutVal
-> ReadPrec [OutVal]
-> Read OutVal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS OutVal
readsPrec :: Int -> ReadS OutVal
$creadList :: ReadS [OutVal]
readList :: ReadS [OutVal]
$creadPrec :: ReadPrec OutVal
readPrec :: ReadPrec OutVal
$creadListPrec :: ReadPrec [OutVal]
readListPrec :: ReadPrec [OutVal]
Read, OutVal -> OutVal -> Bool
(OutVal -> OutVal -> Bool)
-> (OutVal -> OutVal -> Bool) -> Eq OutVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutVal -> OutVal -> Bool
== :: OutVal -> OutVal -> Bool
$c/= :: OutVal -> OutVal -> Bool
/= :: OutVal -> OutVal -> Bool
Eq, Eq OutVal
Eq OutVal =>
(OutVal -> OutVal -> Ordering)
-> (OutVal -> OutVal -> Bool)
-> (OutVal -> OutVal -> Bool)
-> (OutVal -> OutVal -> Bool)
-> (OutVal -> OutVal -> Bool)
-> (OutVal -> OutVal -> OutVal)
-> (OutVal -> OutVal -> OutVal)
-> Ord OutVal
OutVal -> OutVal -> Bool
OutVal -> OutVal -> Ordering
OutVal -> OutVal -> OutVal
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OutVal -> OutVal -> Ordering
compare :: OutVal -> OutVal -> Ordering
$c< :: OutVal -> OutVal -> Bool
< :: OutVal -> OutVal -> Bool
$c<= :: OutVal -> OutVal -> Bool
<= :: OutVal -> OutVal -> Bool
$c> :: OutVal -> OutVal -> Bool
> :: OutVal -> OutVal -> Bool
$c>= :: OutVal -> OutVal -> Bool
>= :: OutVal -> OutVal -> Bool
$cmax :: OutVal -> OutVal -> OutVal
max :: OutVal -> OutVal -> OutVal
$cmin :: OutVal -> OutVal -> OutVal
min :: OutVal -> OutVal -> OutVal
Ord, (forall x. OutVal -> Rep OutVal x)
-> (forall x. Rep OutVal x -> OutVal) -> Generic OutVal
forall x. Rep OutVal x -> OutVal
forall x. OutVal -> Rep OutVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutVal -> Rep OutVal x
from :: forall x. OutVal -> Rep OutVal x
$cto :: forall x. Rep OutVal x -> OutVal
to :: forall x. Rep OutVal x -> OutVal
Generic, Eq OutVal
Eq OutVal =>
(Int -> OutVal -> Int) -> (OutVal -> Int) -> Hashable OutVal
Int -> OutVal -> Int
OutVal -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> OutVal -> Int
hashWithSalt :: Int -> OutVal -> Int
$chash :: OutVal -> Int
hash :: OutVal -> Int
Hashable, Get OutVal
Putter OutVal
Putter OutVal -> Get OutVal -> Serialize OutVal
forall t. Putter t -> Get t -> Serialize t
$cput :: Putter OutVal
put :: Putter OutVal
$cget :: Get OutVal
get :: Get OutVal
Serialize)

instance KeyValue AddrOutKey OutVal

-- | Transaction database key.
data TxKey
  = TxKey {TxKey -> TxHash
txid :: TxHash}
  | TxKeyS {TxKey -> (Word32, Word16)
short :: (Word32, Word16)}
  deriving (Int -> TxKey -> ShowS
[TxKey] -> ShowS
TxKey -> String
(Int -> TxKey -> ShowS)
-> (TxKey -> String) -> ([TxKey] -> ShowS) -> Show TxKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxKey -> ShowS
showsPrec :: Int -> TxKey -> ShowS
$cshow :: TxKey -> String
show :: TxKey -> String
$cshowList :: [TxKey] -> ShowS
showList :: [TxKey] -> ShowS
Show, ReadPrec [TxKey]
ReadPrec TxKey
Int -> ReadS TxKey
ReadS [TxKey]
(Int -> ReadS TxKey)
-> ReadS [TxKey]
-> ReadPrec TxKey
-> ReadPrec [TxKey]
-> Read TxKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TxKey
readsPrec :: Int -> ReadS TxKey
$creadList :: ReadS [TxKey]
readList :: ReadS [TxKey]
$creadPrec :: ReadPrec TxKey
readPrec :: ReadPrec TxKey
$creadListPrec :: ReadPrec [TxKey]
readListPrec :: ReadPrec [TxKey]
Read, TxKey -> TxKey -> Bool
(TxKey -> TxKey -> Bool) -> (TxKey -> TxKey -> Bool) -> Eq TxKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxKey -> TxKey -> Bool
== :: TxKey -> TxKey -> Bool
$c/= :: TxKey -> TxKey -> Bool
/= :: TxKey -> TxKey -> Bool
Eq, Eq TxKey
Eq TxKey =>
(TxKey -> TxKey -> Ordering)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> Bool)
-> (TxKey -> TxKey -> TxKey)
-> (TxKey -> TxKey -> TxKey)
-> Ord TxKey
TxKey -> TxKey -> Bool
TxKey -> TxKey -> Ordering
TxKey -> TxKey -> TxKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxKey -> TxKey -> Ordering
compare :: TxKey -> TxKey -> Ordering
$c< :: TxKey -> TxKey -> Bool
< :: TxKey -> TxKey -> Bool
$c<= :: TxKey -> TxKey -> Bool
<= :: TxKey -> TxKey -> Bool
$c> :: TxKey -> TxKey -> Bool
> :: TxKey -> TxKey -> Bool
$c>= :: TxKey -> TxKey -> Bool
>= :: TxKey -> TxKey -> Bool
$cmax :: TxKey -> TxKey -> TxKey
max :: TxKey -> TxKey -> TxKey
$cmin :: TxKey -> TxKey -> TxKey
min :: TxKey -> TxKey -> TxKey
Ord, (forall x. TxKey -> Rep TxKey x)
-> (forall x. Rep TxKey x -> TxKey) -> Generic TxKey
forall x. Rep TxKey x -> TxKey
forall x. TxKey -> Rep TxKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxKey -> Rep TxKey x
from :: forall x. TxKey -> Rep TxKey x
$cto :: forall x. Rep TxKey x -> TxKey
to :: forall x. Rep TxKey x -> TxKey
Generic, Eq TxKey
Eq TxKey =>
(Int -> TxKey -> Int) -> (TxKey -> Int) -> Hashable TxKey
Int -> TxKey -> Int
TxKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> TxKey -> Int
hashWithSalt :: Int -> TxKey -> Int
$chash :: TxKey -> Int
hash :: TxKey -> Int
Hashable)

instance Serialize TxKey where
  -- 0x02 · TxHash
  put :: Putter TxKey
put (TxKey TxHash
h) = do
    Putter Word8
putWord8 Word8
0x02
    Putter TxHash
forall t. Serialize t => Putter t
put TxHash
h
  put (TxKeyS (Word32, Word16)
h) = do
    Putter Word8
putWord8 Word8
0x02
    Putter (Word32, Word16)
forall t. Serialize t => Putter t
put (Word32, Word16)
h
  get :: Get TxKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x02) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    TxHash -> TxKey
TxKey (TxHash -> TxKey) -> Get TxHash -> Get TxKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get TxHash
forall t. Serialize t => Get t
get

decodeTxKey :: Word64 -> ((Word32, Word16), Word8)
decodeTxKey :: Word64 -> ((Word32, Word16), Word8)
decodeTxKey Word64
i =
  let masked :: Word64
masked = Word64
i Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x001fffffffffffff
      wb :: Word64
wb = Word64
masked Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` Int
11
      bs :: ByteString
bs = Put -> ByteString
runPut (Putter Word64
putWord64be Word64
wb)
      g :: Get (Word32, Word16, Word8)
g = do
        Word32
w1 <- Get Word32
getWord32be
        Word16
w2 <- Get Word16
getWord16be
        Word8
w3 <- Get Word8
getWord8
        (Word32, Word16, Word8) -> Get (Word32, Word16, Word8)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
w1, Word16
w2, Word8
w3)
      Right (Word32
w1, Word16
w2, Word8
w3) = Get (Word32, Word16, Word8)
-> ByteString -> Either String (Word32, Word16, Word8)
forall a. Get a -> ByteString -> Either String a
runGet Get (Word32, Word16, Word8)
g ByteString
bs
   in ((Word32
w1, Word16
w2), Word8
w3)

instance Key TxKey

instance KeyValue TxKey TxData

-- | Unspent output database key.
data UnspentKey
  = UnspentKey {UnspentKey -> OutPoint
outpoint :: !OutPoint}
  | UnspentKeyS {UnspentKey -> TxHash
txid :: !TxHash}
  | UnspentKeyB
  deriving (Int -> UnspentKey -> ShowS
[UnspentKey] -> ShowS
UnspentKey -> String
(Int -> UnspentKey -> ShowS)
-> (UnspentKey -> String)
-> ([UnspentKey] -> ShowS)
-> Show UnspentKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnspentKey -> ShowS
showsPrec :: Int -> UnspentKey -> ShowS
$cshow :: UnspentKey -> String
show :: UnspentKey -> String
$cshowList :: [UnspentKey] -> ShowS
showList :: [UnspentKey] -> ShowS
Show, ReadPrec [UnspentKey]
ReadPrec UnspentKey
Int -> ReadS UnspentKey
ReadS [UnspentKey]
(Int -> ReadS UnspentKey)
-> ReadS [UnspentKey]
-> ReadPrec UnspentKey
-> ReadPrec [UnspentKey]
-> Read UnspentKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnspentKey
readsPrec :: Int -> ReadS UnspentKey
$creadList :: ReadS [UnspentKey]
readList :: ReadS [UnspentKey]
$creadPrec :: ReadPrec UnspentKey
readPrec :: ReadPrec UnspentKey
$creadListPrec :: ReadPrec [UnspentKey]
readListPrec :: ReadPrec [UnspentKey]
Read, UnspentKey -> UnspentKey -> Bool
(UnspentKey -> UnspentKey -> Bool)
-> (UnspentKey -> UnspentKey -> Bool) -> Eq UnspentKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnspentKey -> UnspentKey -> Bool
== :: UnspentKey -> UnspentKey -> Bool
$c/= :: UnspentKey -> UnspentKey -> Bool
/= :: UnspentKey -> UnspentKey -> Bool
Eq, Eq UnspentKey
Eq UnspentKey =>
(UnspentKey -> UnspentKey -> Ordering)
-> (UnspentKey -> UnspentKey -> Bool)
-> (UnspentKey -> UnspentKey -> Bool)
-> (UnspentKey -> UnspentKey -> Bool)
-> (UnspentKey -> UnspentKey -> Bool)
-> (UnspentKey -> UnspentKey -> UnspentKey)
-> (UnspentKey -> UnspentKey -> UnspentKey)
-> Ord UnspentKey
UnspentKey -> UnspentKey -> Bool
UnspentKey -> UnspentKey -> Ordering
UnspentKey -> UnspentKey -> UnspentKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnspentKey -> UnspentKey -> Ordering
compare :: UnspentKey -> UnspentKey -> Ordering
$c< :: UnspentKey -> UnspentKey -> Bool
< :: UnspentKey -> UnspentKey -> Bool
$c<= :: UnspentKey -> UnspentKey -> Bool
<= :: UnspentKey -> UnspentKey -> Bool
$c> :: UnspentKey -> UnspentKey -> Bool
> :: UnspentKey -> UnspentKey -> Bool
$c>= :: UnspentKey -> UnspentKey -> Bool
>= :: UnspentKey -> UnspentKey -> Bool
$cmax :: UnspentKey -> UnspentKey -> UnspentKey
max :: UnspentKey -> UnspentKey -> UnspentKey
$cmin :: UnspentKey -> UnspentKey -> UnspentKey
min :: UnspentKey -> UnspentKey -> UnspentKey
Ord, (forall x. UnspentKey -> Rep UnspentKey x)
-> (forall x. Rep UnspentKey x -> UnspentKey) -> Generic UnspentKey
forall x. Rep UnspentKey x -> UnspentKey
forall x. UnspentKey -> Rep UnspentKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnspentKey -> Rep UnspentKey x
from :: forall x. UnspentKey -> Rep UnspentKey x
$cto :: forall x. Rep UnspentKey x -> UnspentKey
to :: forall x. Rep UnspentKey x -> UnspentKey
Generic, Eq UnspentKey
Eq UnspentKey =>
(Int -> UnspentKey -> Int)
-> (UnspentKey -> Int) -> Hashable UnspentKey
Int -> UnspentKey -> Int
UnspentKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> UnspentKey -> Int
hashWithSalt :: Int -> UnspentKey -> Int
$chash :: UnspentKey -> Int
hash :: UnspentKey -> Int
Hashable)

instance Serialize UnspentKey where
  -- 0x09 · TxHash · Index
  put :: Putter UnspentKey
put UnspentKey {$sel:outpoint:UnspentKey :: UnspentKey -> OutPoint
outpoint = OutPoint {$sel:hash:OutPoint :: OutPoint -> TxHash
hash = TxHash
h, $sel:index:OutPoint :: OutPoint -> Word32
index = Word32
i}} = do
    Putter Word8
putWord8 Word8
0x09
    Putter TxHash
forall t. Serialize t => Putter t
put TxHash
h
    Putter Word32
forall t. Serialize t => Putter t
put Word32
i
  -- 0x09 · TxHash
  put UnspentKeyS {$sel:txid:UnspentKey :: UnspentKey -> TxHash
txid = TxHash
t} = do
    Putter Word8
putWord8 Word8
0x09
    Putter TxHash
forall t. Serialize t => Putter t
put TxHash
t
  -- 0x09
  put UnspentKey
UnspentKeyB = Putter Word8
putWord8 Word8
0x09
  get :: Get UnspentKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    TxHash
h <- Get TxHash
forall t. Serialize t => Get t
get
    Word32
i <- Get Word32
forall t. Serialize t => Get t
get
    UnspentKey -> Get UnspentKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnspentKey -> Get UnspentKey) -> UnspentKey -> Get UnspentKey
forall a b. (a -> b) -> a -> b
$ OutPoint -> UnspentKey
UnspentKey OutPoint {$sel:hash:OutPoint :: TxHash
hash = TxHash
h, $sel:index:OutPoint :: Word32
index = Word32
i}

instance Key UnspentKey

instance KeyValue UnspentKey UnspentVal

toUnspent :: Ctx -> AddrOutKey -> OutVal -> Unspent
toUnspent :: Ctx -> AddrOutKey -> OutVal -> Unspent
toUnspent Ctx
ctx AddrOutKey {OutPoint
Address
BlockRef
$sel:address:AddrOutKey :: AddrOutKey -> Address
$sel:block:AddrOutKey :: AddrOutKey -> BlockRef
$sel:outpoint:AddrOutKey :: AddrOutKey -> OutPoint
address :: Address
block :: BlockRef
outpoint :: OutPoint
..} OutVal {Word64
ByteString
$sel:value:OutVal :: OutVal -> Word64
$sel:script:OutVal :: OutVal -> ByteString
value :: Word64
script :: ByteString
..} =
  Unspent
    { $sel:block:Unspent :: BlockRef
block = BlockRef
block,
      $sel:value:Unspent :: Word64
value = Word64
value,
      $sel:script:Unspent :: ByteString
script = ByteString
script,
      $sel:outpoint:Unspent :: OutPoint
outpoint = OutPoint
outpoint,
      $sel:address:Unspent :: Maybe Address
address = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx ByteString
script)
    }

-- | Mempool transaction database key.
data MemKey
  = MemKey
  deriving (Int -> MemKey -> ShowS
[MemKey] -> ShowS
MemKey -> String
(Int -> MemKey -> ShowS)
-> (MemKey -> String) -> ([MemKey] -> ShowS) -> Show MemKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MemKey -> ShowS
showsPrec :: Int -> MemKey -> ShowS
$cshow :: MemKey -> String
show :: MemKey -> String
$cshowList :: [MemKey] -> ShowS
showList :: [MemKey] -> ShowS
Show, ReadPrec [MemKey]
ReadPrec MemKey
Int -> ReadS MemKey
ReadS [MemKey]
(Int -> ReadS MemKey)
-> ReadS [MemKey]
-> ReadPrec MemKey
-> ReadPrec [MemKey]
-> Read MemKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MemKey
readsPrec :: Int -> ReadS MemKey
$creadList :: ReadS [MemKey]
readList :: ReadS [MemKey]
$creadPrec :: ReadPrec MemKey
readPrec :: ReadPrec MemKey
$creadListPrec :: ReadPrec [MemKey]
readListPrec :: ReadPrec [MemKey]
Read)

instance Serialize MemKey where
  -- 0x07
  put :: Putter MemKey
put MemKey
MemKey = Putter Word8
putWord8 Word8
0x07
  get :: Get MemKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x07) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    MemKey -> Get MemKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return MemKey
MemKey

instance Key MemKey

instance KeyValue MemKey [(UnixTime, TxHash)]

-- | Block entry database key.
newtype BlockKey = BlockKey
  { BlockKey -> BlockHash
hash :: BlockHash
  }
  deriving (Int -> BlockKey -> ShowS
[BlockKey] -> ShowS
BlockKey -> String
(Int -> BlockKey -> ShowS)
-> (BlockKey -> String) -> ([BlockKey] -> ShowS) -> Show BlockKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockKey -> ShowS
showsPrec :: Int -> BlockKey -> ShowS
$cshow :: BlockKey -> String
show :: BlockKey -> String
$cshowList :: [BlockKey] -> ShowS
showList :: [BlockKey] -> ShowS
Show, ReadPrec [BlockKey]
ReadPrec BlockKey
Int -> ReadS BlockKey
ReadS [BlockKey]
(Int -> ReadS BlockKey)
-> ReadS [BlockKey]
-> ReadPrec BlockKey
-> ReadPrec [BlockKey]
-> Read BlockKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BlockKey
readsPrec :: Int -> ReadS BlockKey
$creadList :: ReadS [BlockKey]
readList :: ReadS [BlockKey]
$creadPrec :: ReadPrec BlockKey
readPrec :: ReadPrec BlockKey
$creadListPrec :: ReadPrec [BlockKey]
readListPrec :: ReadPrec [BlockKey]
Read, BlockKey -> BlockKey -> Bool
(BlockKey -> BlockKey -> Bool)
-> (BlockKey -> BlockKey -> Bool) -> Eq BlockKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockKey -> BlockKey -> Bool
== :: BlockKey -> BlockKey -> Bool
$c/= :: BlockKey -> BlockKey -> Bool
/= :: BlockKey -> BlockKey -> Bool
Eq, Eq BlockKey
Eq BlockKey =>
(BlockKey -> BlockKey -> Ordering)
-> (BlockKey -> BlockKey -> Bool)
-> (BlockKey -> BlockKey -> Bool)
-> (BlockKey -> BlockKey -> Bool)
-> (BlockKey -> BlockKey -> Bool)
-> (BlockKey -> BlockKey -> BlockKey)
-> (BlockKey -> BlockKey -> BlockKey)
-> Ord BlockKey
BlockKey -> BlockKey -> Bool
BlockKey -> BlockKey -> Ordering
BlockKey -> BlockKey -> BlockKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BlockKey -> BlockKey -> Ordering
compare :: BlockKey -> BlockKey -> Ordering
$c< :: BlockKey -> BlockKey -> Bool
< :: BlockKey -> BlockKey -> Bool
$c<= :: BlockKey -> BlockKey -> Bool
<= :: BlockKey -> BlockKey -> Bool
$c> :: BlockKey -> BlockKey -> Bool
> :: BlockKey -> BlockKey -> Bool
$c>= :: BlockKey -> BlockKey -> Bool
>= :: BlockKey -> BlockKey -> Bool
$cmax :: BlockKey -> BlockKey -> BlockKey
max :: BlockKey -> BlockKey -> BlockKey
$cmin :: BlockKey -> BlockKey -> BlockKey
min :: BlockKey -> BlockKey -> BlockKey
Ord, (forall x. BlockKey -> Rep BlockKey x)
-> (forall x. Rep BlockKey x -> BlockKey) -> Generic BlockKey
forall x. Rep BlockKey x -> BlockKey
forall x. BlockKey -> Rep BlockKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockKey -> Rep BlockKey x
from :: forall x. BlockKey -> Rep BlockKey x
$cto :: forall x. Rep BlockKey x -> BlockKey
to :: forall x. Rep BlockKey x -> BlockKey
Generic, Eq BlockKey
Eq BlockKey =>
(Int -> BlockKey -> Int) -> (BlockKey -> Int) -> Hashable BlockKey
Int -> BlockKey -> Int
BlockKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BlockKey -> Int
hashWithSalt :: Int -> BlockKey -> Int
$chash :: BlockKey -> Int
hash :: BlockKey -> Int
Hashable)

instance Serialize BlockKey where
  -- 0x01 · BlockHash
  put :: Putter BlockKey
put (BlockKey BlockHash
h) = do
    Putter Word8
putWord8 Word8
0x01
    Putter BlockHash
forall t. Serialize t => Putter t
put BlockHash
h
  get :: Get BlockKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x01) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    BlockHash -> BlockKey
BlockKey (BlockHash -> BlockKey) -> Get BlockHash -> Get BlockKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BlockHash
forall t. Serialize t => Get t
get

instance Key BlockKey

instance KeyValue BlockKey BlockData

-- | Block height database key.
newtype HeightKey = HeightKey
  { HeightKey -> Word32
height :: BlockHeight
  }
  deriving (Int -> HeightKey -> ShowS
[HeightKey] -> ShowS
HeightKey -> String
(Int -> HeightKey -> ShowS)
-> (HeightKey -> String)
-> ([HeightKey] -> ShowS)
-> Show HeightKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeightKey -> ShowS
showsPrec :: Int -> HeightKey -> ShowS
$cshow :: HeightKey -> String
show :: HeightKey -> String
$cshowList :: [HeightKey] -> ShowS
showList :: [HeightKey] -> ShowS
Show, ReadPrec [HeightKey]
ReadPrec HeightKey
Int -> ReadS HeightKey
ReadS [HeightKey]
(Int -> ReadS HeightKey)
-> ReadS [HeightKey]
-> ReadPrec HeightKey
-> ReadPrec [HeightKey]
-> Read HeightKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HeightKey
readsPrec :: Int -> ReadS HeightKey
$creadList :: ReadS [HeightKey]
readList :: ReadS [HeightKey]
$creadPrec :: ReadPrec HeightKey
readPrec :: ReadPrec HeightKey
$creadListPrec :: ReadPrec [HeightKey]
readListPrec :: ReadPrec [HeightKey]
Read, HeightKey -> HeightKey -> Bool
(HeightKey -> HeightKey -> Bool)
-> (HeightKey -> HeightKey -> Bool) -> Eq HeightKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeightKey -> HeightKey -> Bool
== :: HeightKey -> HeightKey -> Bool
$c/= :: HeightKey -> HeightKey -> Bool
/= :: HeightKey -> HeightKey -> Bool
Eq, Eq HeightKey
Eq HeightKey =>
(HeightKey -> HeightKey -> Ordering)
-> (HeightKey -> HeightKey -> Bool)
-> (HeightKey -> HeightKey -> Bool)
-> (HeightKey -> HeightKey -> Bool)
-> (HeightKey -> HeightKey -> Bool)
-> (HeightKey -> HeightKey -> HeightKey)
-> (HeightKey -> HeightKey -> HeightKey)
-> Ord HeightKey
HeightKey -> HeightKey -> Bool
HeightKey -> HeightKey -> Ordering
HeightKey -> HeightKey -> HeightKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HeightKey -> HeightKey -> Ordering
compare :: HeightKey -> HeightKey -> Ordering
$c< :: HeightKey -> HeightKey -> Bool
< :: HeightKey -> HeightKey -> Bool
$c<= :: HeightKey -> HeightKey -> Bool
<= :: HeightKey -> HeightKey -> Bool
$c> :: HeightKey -> HeightKey -> Bool
> :: HeightKey -> HeightKey -> Bool
$c>= :: HeightKey -> HeightKey -> Bool
>= :: HeightKey -> HeightKey -> Bool
$cmax :: HeightKey -> HeightKey -> HeightKey
max :: HeightKey -> HeightKey -> HeightKey
$cmin :: HeightKey -> HeightKey -> HeightKey
min :: HeightKey -> HeightKey -> HeightKey
Ord, (forall x. HeightKey -> Rep HeightKey x)
-> (forall x. Rep HeightKey x -> HeightKey) -> Generic HeightKey
forall x. Rep HeightKey x -> HeightKey
forall x. HeightKey -> Rep HeightKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeightKey -> Rep HeightKey x
from :: forall x. HeightKey -> Rep HeightKey x
$cto :: forall x. Rep HeightKey x -> HeightKey
to :: forall x. Rep HeightKey x -> HeightKey
Generic, Eq HeightKey
Eq HeightKey =>
(Int -> HeightKey -> Int)
-> (HeightKey -> Int) -> Hashable HeightKey
Int -> HeightKey -> Int
HeightKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> HeightKey -> Int
hashWithSalt :: Int -> HeightKey -> Int
$chash :: HeightKey -> Int
hash :: HeightKey -> Int
Hashable)

instance Serialize HeightKey where
  -- 0x03 · BlockHeight
  put :: Putter HeightKey
put (HeightKey Word32
h) = do
    Putter Word8
putWord8 Word8
0x03
    Putter Word32
forall t. Serialize t => Putter t
put Word32
h
  get :: Get HeightKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x03) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    Word32 -> HeightKey
HeightKey (Word32 -> HeightKey) -> Get Word32 -> Get HeightKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
forall t. Serialize t => Get t
get

instance Key HeightKey

instance KeyValue HeightKey [BlockHash]

-- | Address balance database key.
data BalKey
  = BalKey
      { BalKey -> Address
address :: !Address
      }
  | BalKeyS
  deriving (Int -> BalKey -> ShowS
[BalKey] -> ShowS
BalKey -> String
(Int -> BalKey -> ShowS)
-> (BalKey -> String) -> ([BalKey] -> ShowS) -> Show BalKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalKey -> ShowS
showsPrec :: Int -> BalKey -> ShowS
$cshow :: BalKey -> String
show :: BalKey -> String
$cshowList :: [BalKey] -> ShowS
showList :: [BalKey] -> ShowS
Show, ReadPrec [BalKey]
ReadPrec BalKey
Int -> ReadS BalKey
ReadS [BalKey]
(Int -> ReadS BalKey)
-> ReadS [BalKey]
-> ReadPrec BalKey
-> ReadPrec [BalKey]
-> Read BalKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BalKey
readsPrec :: Int -> ReadS BalKey
$creadList :: ReadS [BalKey]
readList :: ReadS [BalKey]
$creadPrec :: ReadPrec BalKey
readPrec :: ReadPrec BalKey
$creadListPrec :: ReadPrec [BalKey]
readListPrec :: ReadPrec [BalKey]
Read, BalKey -> BalKey -> Bool
(BalKey -> BalKey -> Bool)
-> (BalKey -> BalKey -> Bool) -> Eq BalKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalKey -> BalKey -> Bool
== :: BalKey -> BalKey -> Bool
$c/= :: BalKey -> BalKey -> Bool
/= :: BalKey -> BalKey -> Bool
Eq, Eq BalKey
Eq BalKey =>
(BalKey -> BalKey -> Ordering)
-> (BalKey -> BalKey -> Bool)
-> (BalKey -> BalKey -> Bool)
-> (BalKey -> BalKey -> Bool)
-> (BalKey -> BalKey -> Bool)
-> (BalKey -> BalKey -> BalKey)
-> (BalKey -> BalKey -> BalKey)
-> Ord BalKey
BalKey -> BalKey -> Bool
BalKey -> BalKey -> Ordering
BalKey -> BalKey -> BalKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BalKey -> BalKey -> Ordering
compare :: BalKey -> BalKey -> Ordering
$c< :: BalKey -> BalKey -> Bool
< :: BalKey -> BalKey -> Bool
$c<= :: BalKey -> BalKey -> Bool
<= :: BalKey -> BalKey -> Bool
$c> :: BalKey -> BalKey -> Bool
> :: BalKey -> BalKey -> Bool
$c>= :: BalKey -> BalKey -> Bool
>= :: BalKey -> BalKey -> Bool
$cmax :: BalKey -> BalKey -> BalKey
max :: BalKey -> BalKey -> BalKey
$cmin :: BalKey -> BalKey -> BalKey
min :: BalKey -> BalKey -> BalKey
Ord, (forall x. BalKey -> Rep BalKey x)
-> (forall x. Rep BalKey x -> BalKey) -> Generic BalKey
forall x. Rep BalKey x -> BalKey
forall x. BalKey -> Rep BalKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BalKey -> Rep BalKey x
from :: forall x. BalKey -> Rep BalKey x
$cto :: forall x. Rep BalKey x -> BalKey
to :: forall x. Rep BalKey x -> BalKey
Generic, Eq BalKey
Eq BalKey =>
(Int -> BalKey -> Int) -> (BalKey -> Int) -> Hashable BalKey
Int -> BalKey -> Int
BalKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BalKey -> Int
hashWithSalt :: Int -> BalKey -> Int
$chash :: BalKey -> Int
hash :: BalKey -> Int
Hashable)

instance Serialize BalKey where
  -- 0x04 · Address
  put :: Putter BalKey
put (BalKey Address
a) = do
    Putter Word8
putWord8 Word8
0x04
    Putter Address
forall t. Serialize t => Putter t
put Address
a
  -- 0x04
  put BalKey
BalKeyS = Putter Word8
putWord8 Word8
0x04
  get :: Get BalKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x04) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    Address -> BalKey
BalKey (Address -> BalKey) -> Get Address -> Get BalKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Address
forall t. Serialize t => Get t
get

instance Key BalKey

instance KeyValue BalKey BalVal

-- | Key for best block in database.
data BestKey
  = BestKey
  deriving (Int -> BestKey -> ShowS
[BestKey] -> ShowS
BestKey -> String
(Int -> BestKey -> ShowS)
-> (BestKey -> String) -> ([BestKey] -> ShowS) -> Show BestKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BestKey -> ShowS
showsPrec :: Int -> BestKey -> ShowS
$cshow :: BestKey -> String
show :: BestKey -> String
$cshowList :: [BestKey] -> ShowS
showList :: [BestKey] -> ShowS
Show, ReadPrec [BestKey]
ReadPrec BestKey
Int -> ReadS BestKey
ReadS [BestKey]
(Int -> ReadS BestKey)
-> ReadS [BestKey]
-> ReadPrec BestKey
-> ReadPrec [BestKey]
-> Read BestKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BestKey
readsPrec :: Int -> ReadS BestKey
$creadList :: ReadS [BestKey]
readList :: ReadS [BestKey]
$creadPrec :: ReadPrec BestKey
readPrec :: ReadPrec BestKey
$creadListPrec :: ReadPrec [BestKey]
readListPrec :: ReadPrec [BestKey]
Read, BestKey -> BestKey -> Bool
(BestKey -> BestKey -> Bool)
-> (BestKey -> BestKey -> Bool) -> Eq BestKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BestKey -> BestKey -> Bool
== :: BestKey -> BestKey -> Bool
$c/= :: BestKey -> BestKey -> Bool
/= :: BestKey -> BestKey -> Bool
Eq, Eq BestKey
Eq BestKey =>
(BestKey -> BestKey -> Ordering)
-> (BestKey -> BestKey -> Bool)
-> (BestKey -> BestKey -> Bool)
-> (BestKey -> BestKey -> Bool)
-> (BestKey -> BestKey -> Bool)
-> (BestKey -> BestKey -> BestKey)
-> (BestKey -> BestKey -> BestKey)
-> Ord BestKey
BestKey -> BestKey -> Bool
BestKey -> BestKey -> Ordering
BestKey -> BestKey -> BestKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BestKey -> BestKey -> Ordering
compare :: BestKey -> BestKey -> Ordering
$c< :: BestKey -> BestKey -> Bool
< :: BestKey -> BestKey -> Bool
$c<= :: BestKey -> BestKey -> Bool
<= :: BestKey -> BestKey -> Bool
$c> :: BestKey -> BestKey -> Bool
> :: BestKey -> BestKey -> Bool
$c>= :: BestKey -> BestKey -> Bool
>= :: BestKey -> BestKey -> Bool
$cmax :: BestKey -> BestKey -> BestKey
max :: BestKey -> BestKey -> BestKey
$cmin :: BestKey -> BestKey -> BestKey
min :: BestKey -> BestKey -> BestKey
Ord, (forall x. BestKey -> Rep BestKey x)
-> (forall x. Rep BestKey x -> BestKey) -> Generic BestKey
forall x. Rep BestKey x -> BestKey
forall x. BestKey -> Rep BestKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BestKey -> Rep BestKey x
from :: forall x. BestKey -> Rep BestKey x
$cto :: forall x. Rep BestKey x -> BestKey
to :: forall x. Rep BestKey x -> BestKey
Generic, Eq BestKey
Eq BestKey =>
(Int -> BestKey -> Int) -> (BestKey -> Int) -> Hashable BestKey
Int -> BestKey -> Int
BestKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BestKey -> Int
hashWithSalt :: Int -> BestKey -> Int
$chash :: BestKey -> Int
hash :: BestKey -> Int
Hashable)

instance Serialize BestKey where
  -- 0x00 × 32
  put :: Putter BestKey
put BestKey
BestKey = Putter ByteString
forall t. Serialize t => Putter t
put (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00)
  get :: Get BestKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (ByteString -> Bool) -> ByteString -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00) (ByteString -> Get ()) -> Get ByteString -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Get ByteString
getBytes Int
32
    BestKey -> Get BestKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return BestKey
BestKey

instance Key BestKey

instance KeyValue BestKey BlockHash

-- | Key for database version.
data VersionKey
  = VersionKey
  deriving (VersionKey -> VersionKey -> Bool
(VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool) -> Eq VersionKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionKey -> VersionKey -> Bool
== :: VersionKey -> VersionKey -> Bool
$c/= :: VersionKey -> VersionKey -> Bool
/= :: VersionKey -> VersionKey -> Bool
Eq, Int -> VersionKey -> ShowS
[VersionKey] -> ShowS
VersionKey -> String
(Int -> VersionKey -> ShowS)
-> (VersionKey -> String)
-> ([VersionKey] -> ShowS)
-> Show VersionKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionKey -> ShowS
showsPrec :: Int -> VersionKey -> ShowS
$cshow :: VersionKey -> String
show :: VersionKey -> String
$cshowList :: [VersionKey] -> ShowS
showList :: [VersionKey] -> ShowS
Show, ReadPrec [VersionKey]
ReadPrec VersionKey
Int -> ReadS VersionKey
ReadS [VersionKey]
(Int -> ReadS VersionKey)
-> ReadS [VersionKey]
-> ReadPrec VersionKey
-> ReadPrec [VersionKey]
-> Read VersionKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VersionKey
readsPrec :: Int -> ReadS VersionKey
$creadList :: ReadS [VersionKey]
readList :: ReadS [VersionKey]
$creadPrec :: ReadPrec VersionKey
readPrec :: ReadPrec VersionKey
$creadListPrec :: ReadPrec [VersionKey]
readListPrec :: ReadPrec [VersionKey]
Read, Eq VersionKey
Eq VersionKey =>
(VersionKey -> VersionKey -> Ordering)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> Bool)
-> (VersionKey -> VersionKey -> VersionKey)
-> (VersionKey -> VersionKey -> VersionKey)
-> Ord VersionKey
VersionKey -> VersionKey -> Bool
VersionKey -> VersionKey -> Ordering
VersionKey -> VersionKey -> VersionKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VersionKey -> VersionKey -> Ordering
compare :: VersionKey -> VersionKey -> Ordering
$c< :: VersionKey -> VersionKey -> Bool
< :: VersionKey -> VersionKey -> Bool
$c<= :: VersionKey -> VersionKey -> Bool
<= :: VersionKey -> VersionKey -> Bool
$c> :: VersionKey -> VersionKey -> Bool
> :: VersionKey -> VersionKey -> Bool
$c>= :: VersionKey -> VersionKey -> Bool
>= :: VersionKey -> VersionKey -> Bool
$cmax :: VersionKey -> VersionKey -> VersionKey
max :: VersionKey -> VersionKey -> VersionKey
$cmin :: VersionKey -> VersionKey -> VersionKey
min :: VersionKey -> VersionKey -> VersionKey
Ord, (forall x. VersionKey -> Rep VersionKey x)
-> (forall x. Rep VersionKey x -> VersionKey) -> Generic VersionKey
forall x. Rep VersionKey x -> VersionKey
forall x. VersionKey -> Rep VersionKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionKey -> Rep VersionKey x
from :: forall x. VersionKey -> Rep VersionKey x
$cto :: forall x. Rep VersionKey x -> VersionKey
to :: forall x. Rep VersionKey x -> VersionKey
Generic, Eq VersionKey
Eq VersionKey =>
(Int -> VersionKey -> Int)
-> (VersionKey -> Int) -> Hashable VersionKey
Int -> VersionKey -> Int
VersionKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> VersionKey -> Int
hashWithSalt :: Int -> VersionKey -> Int
$chash :: VersionKey -> Int
hash :: VersionKey -> Int
Hashable)

instance Serialize VersionKey where
  -- 0x0a
  put :: Putter VersionKey
put VersionKey
VersionKey = Putter Word8
putWord8 Word8
0x0a
  get :: Get VersionKey
get = do
    Bool -> Get ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Get ()) -> (Word8 -> Bool) -> Word8 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a) (Word8 -> Get ()) -> Get Word8 -> Get ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    VersionKey -> Get VersionKey
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return VersionKey
VersionKey

instance Key VersionKey

instance KeyValue VersionKey Word32

data BalVal = BalVal
  { BalVal -> Word64
confirmed :: !Word64,
    BalVal -> Word64
unconfirmed :: !Word64,
    BalVal -> Word64
utxo :: !Word64,
    BalVal -> Word64
txs :: !Word64,
    BalVal -> Word64
received :: !Word64
  }
  deriving (Int -> BalVal -> ShowS
[BalVal] -> ShowS
BalVal -> String
(Int -> BalVal -> ShowS)
-> (BalVal -> String) -> ([BalVal] -> ShowS) -> Show BalVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalVal -> ShowS
showsPrec :: Int -> BalVal -> ShowS
$cshow :: BalVal -> String
show :: BalVal -> String
$cshowList :: [BalVal] -> ShowS
showList :: [BalVal] -> ShowS
Show, ReadPrec [BalVal]
ReadPrec BalVal
Int -> ReadS BalVal
ReadS [BalVal]
(Int -> ReadS BalVal)
-> ReadS [BalVal]
-> ReadPrec BalVal
-> ReadPrec [BalVal]
-> Read BalVal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BalVal
readsPrec :: Int -> ReadS BalVal
$creadList :: ReadS [BalVal]
readList :: ReadS [BalVal]
$creadPrec :: ReadPrec BalVal
readPrec :: ReadPrec BalVal
$creadListPrec :: ReadPrec [BalVal]
readListPrec :: ReadPrec [BalVal]
Read, BalVal -> BalVal -> Bool
(BalVal -> BalVal -> Bool)
-> (BalVal -> BalVal -> Bool) -> Eq BalVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalVal -> BalVal -> Bool
== :: BalVal -> BalVal -> Bool
$c/= :: BalVal -> BalVal -> Bool
/= :: BalVal -> BalVal -> Bool
Eq, Eq BalVal
Eq BalVal =>
(BalVal -> BalVal -> Ordering)
-> (BalVal -> BalVal -> Bool)
-> (BalVal -> BalVal -> Bool)
-> (BalVal -> BalVal -> Bool)
-> (BalVal -> BalVal -> Bool)
-> (BalVal -> BalVal -> BalVal)
-> (BalVal -> BalVal -> BalVal)
-> Ord BalVal
BalVal -> BalVal -> Bool
BalVal -> BalVal -> Ordering
BalVal -> BalVal -> BalVal
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BalVal -> BalVal -> Ordering
compare :: BalVal -> BalVal -> Ordering
$c< :: BalVal -> BalVal -> Bool
< :: BalVal -> BalVal -> Bool
$c<= :: BalVal -> BalVal -> Bool
<= :: BalVal -> BalVal -> Bool
$c> :: BalVal -> BalVal -> Bool
> :: BalVal -> BalVal -> Bool
$c>= :: BalVal -> BalVal -> Bool
>= :: BalVal -> BalVal -> Bool
$cmax :: BalVal -> BalVal -> BalVal
max :: BalVal -> BalVal -> BalVal
$cmin :: BalVal -> BalVal -> BalVal
min :: BalVal -> BalVal -> BalVal
Ord, (forall x. BalVal -> Rep BalVal x)
-> (forall x. Rep BalVal x -> BalVal) -> Generic BalVal
forall x. Rep BalVal x -> BalVal
forall x. BalVal -> Rep BalVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BalVal -> Rep BalVal x
from :: forall x. BalVal -> Rep BalVal x
$cto :: forall x. Rep BalVal x -> BalVal
to :: forall x. Rep BalVal x -> BalVal
Generic, Eq BalVal
Eq BalVal =>
(Int -> BalVal -> Int) -> (BalVal -> Int) -> Hashable BalVal
Int -> BalVal -> Int
BalVal -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> BalVal -> Int
hashWithSalt :: Int -> BalVal -> Int
$chash :: BalVal -> Int
hash :: BalVal -> Int
Hashable, Get BalVal
Putter BalVal
Putter BalVal -> Get BalVal -> Serialize BalVal
forall t. Putter t -> Get t -> Serialize t
$cput :: Putter BalVal
put :: Putter BalVal
$cget :: Get BalVal
get :: Get BalVal
Serialize, BalVal -> ()
(BalVal -> ()) -> NFData BalVal
forall a. (a -> ()) -> NFData a
$crnf :: BalVal -> ()
rnf :: BalVal -> ()
NFData)

valToBalance :: Address -> BalVal -> Balance
valToBalance :: Address -> BalVal -> Balance
valToBalance Address
address BalVal {Word64
$sel:confirmed:BalVal :: BalVal -> Word64
$sel:unconfirmed:BalVal :: BalVal -> Word64
$sel:utxo:BalVal :: BalVal -> Word64
$sel:txs:BalVal :: BalVal -> Word64
$sel:received:BalVal :: BalVal -> Word64
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
..} =
  Balance {Word64
Address
address :: Address
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
$sel:address:Balance :: Address
$sel:confirmed:Balance :: Word64
$sel:unconfirmed:Balance :: Word64
$sel:utxo:Balance :: Word64
$sel:txs:Balance :: Word64
$sel:received:Balance :: Word64
..}

balanceToVal :: Balance -> BalVal
balanceToVal :: Balance -> BalVal
balanceToVal Balance {Word64
Address
$sel:address:Balance :: Balance -> Address
$sel:confirmed:Balance :: Balance -> Word64
$sel:unconfirmed:Balance :: Balance -> Word64
$sel:utxo:Balance :: Balance -> Word64
$sel:txs:Balance :: Balance -> Word64
$sel:received:Balance :: Balance -> Word64
address :: Address
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
..} =
  BalVal {Word64
$sel:confirmed:BalVal :: Word64
$sel:unconfirmed:BalVal :: Word64
$sel:utxo:BalVal :: Word64
$sel:txs:BalVal :: Word64
$sel:received:BalVal :: Word64
confirmed :: Word64
unconfirmed :: Word64
utxo :: Word64
txs :: Word64
received :: Word64
..}

-- | Default balance for an address.
instance Default BalVal where
  def :: BalVal
def =
    BalVal
      { $sel:confirmed:BalVal :: Word64
confirmed = Word64
0,
        $sel:unconfirmed:BalVal :: Word64
unconfirmed = Word64
0,
        $sel:utxo:BalVal :: Word64
utxo = Word64
0,
        $sel:txs:BalVal :: Word64
txs = Word64
0,
        $sel:received:BalVal :: Word64
received = Word64
0
      }

data UnspentVal = UnspentVal
  { UnspentVal -> BlockRef
block :: !BlockRef,
    UnspentVal -> Word64
value :: !Word64,
    UnspentVal -> ByteString
script :: !ByteString
  }
  deriving (Int -> UnspentVal -> ShowS
[UnspentVal] -> ShowS
UnspentVal -> String
(Int -> UnspentVal -> ShowS)
-> (UnspentVal -> String)
-> ([UnspentVal] -> ShowS)
-> Show UnspentVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnspentVal -> ShowS
showsPrec :: Int -> UnspentVal -> ShowS
$cshow :: UnspentVal -> String
show :: UnspentVal -> String
$cshowList :: [UnspentVal] -> ShowS
showList :: [UnspentVal] -> ShowS
Show, ReadPrec [UnspentVal]
ReadPrec UnspentVal
Int -> ReadS UnspentVal
ReadS [UnspentVal]
(Int -> ReadS UnspentVal)
-> ReadS [UnspentVal]
-> ReadPrec UnspentVal
-> ReadPrec [UnspentVal]
-> Read UnspentVal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnspentVal
readsPrec :: Int -> ReadS UnspentVal
$creadList :: ReadS [UnspentVal]
readList :: ReadS [UnspentVal]
$creadPrec :: ReadPrec UnspentVal
readPrec :: ReadPrec UnspentVal
$creadListPrec :: ReadPrec [UnspentVal]
readListPrec :: ReadPrec [UnspentVal]
Read, UnspentVal -> UnspentVal -> Bool
(UnspentVal -> UnspentVal -> Bool)
-> (UnspentVal -> UnspentVal -> Bool) -> Eq UnspentVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnspentVal -> UnspentVal -> Bool
== :: UnspentVal -> UnspentVal -> Bool
$c/= :: UnspentVal -> UnspentVal -> Bool
/= :: UnspentVal -> UnspentVal -> Bool
Eq, Eq UnspentVal
Eq UnspentVal =>
(UnspentVal -> UnspentVal -> Ordering)
-> (UnspentVal -> UnspentVal -> Bool)
-> (UnspentVal -> UnspentVal -> Bool)
-> (UnspentVal -> UnspentVal -> Bool)
-> (UnspentVal -> UnspentVal -> Bool)
-> (UnspentVal -> UnspentVal -> UnspentVal)
-> (UnspentVal -> UnspentVal -> UnspentVal)
-> Ord UnspentVal
UnspentVal -> UnspentVal -> Bool
UnspentVal -> UnspentVal -> Ordering
UnspentVal -> UnspentVal -> UnspentVal
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnspentVal -> UnspentVal -> Ordering
compare :: UnspentVal -> UnspentVal -> Ordering
$c< :: UnspentVal -> UnspentVal -> Bool
< :: UnspentVal -> UnspentVal -> Bool
$c<= :: UnspentVal -> UnspentVal -> Bool
<= :: UnspentVal -> UnspentVal -> Bool
$c> :: UnspentVal -> UnspentVal -> Bool
> :: UnspentVal -> UnspentVal -> Bool
$c>= :: UnspentVal -> UnspentVal -> Bool
>= :: UnspentVal -> UnspentVal -> Bool
$cmax :: UnspentVal -> UnspentVal -> UnspentVal
max :: UnspentVal -> UnspentVal -> UnspentVal
$cmin :: UnspentVal -> UnspentVal -> UnspentVal
min :: UnspentVal -> UnspentVal -> UnspentVal
Ord, (forall x. UnspentVal -> Rep UnspentVal x)
-> (forall x. Rep UnspentVal x -> UnspentVal) -> Generic UnspentVal
forall x. Rep UnspentVal x -> UnspentVal
forall x. UnspentVal -> Rep UnspentVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnspentVal -> Rep UnspentVal x
from :: forall x. UnspentVal -> Rep UnspentVal x
$cto :: forall x. Rep UnspentVal x -> UnspentVal
to :: forall x. Rep UnspentVal x -> UnspentVal
Generic, Eq UnspentVal
Eq UnspentVal =>
(Int -> UnspentVal -> Int)
-> (UnspentVal -> Int) -> Hashable UnspentVal
Int -> UnspentVal -> Int
UnspentVal -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> UnspentVal -> Int
hashWithSalt :: Int -> UnspentVal -> Int
$chash :: UnspentVal -> Int
hash :: UnspentVal -> Int
Hashable, Get UnspentVal
Putter UnspentVal
Putter UnspentVal -> Get UnspentVal -> Serialize UnspentVal
forall t. Putter t -> Get t -> Serialize t
$cput :: Putter UnspentVal
put :: Putter UnspentVal
$cget :: Get UnspentVal
get :: Get UnspentVal
Serialize, UnspentVal -> ()
(UnspentVal -> ()) -> NFData UnspentVal
forall a. (a -> ()) -> NFData a
$crnf :: UnspentVal -> ()
rnf :: UnspentVal -> ()
NFData)

unspentToVal :: Unspent -> (OutPoint, UnspentVal)
unspentToVal :: Unspent -> (OutPoint, UnspentVal)
unspentToVal Unspent {Maybe Address
Word64
ByteString
OutPoint
BlockRef
$sel:block:Unspent :: Unspent -> BlockRef
$sel:value:Unspent :: Unspent -> Word64
$sel:script:Unspent :: Unspent -> ByteString
$sel:outpoint:Unspent :: Unspent -> OutPoint
$sel:address:Unspent :: Unspent -> Maybe Address
block :: BlockRef
outpoint :: OutPoint
value :: Word64
script :: ByteString
address :: Maybe Address
..} = (OutPoint
outpoint, UnspentVal {Word64
ByteString
BlockRef
$sel:block:UnspentVal :: BlockRef
$sel:value:UnspentVal :: Word64
$sel:script:UnspentVal :: ByteString
block :: BlockRef
value :: Word64
script :: ByteString
..})

valToUnspent :: Ctx -> OutPoint -> UnspentVal -> Unspent
valToUnspent :: Ctx -> OutPoint -> UnspentVal -> Unspent
valToUnspent Ctx
ctx OutPoint
outpoint UnspentVal {Word64
ByteString
BlockRef
$sel:block:UnspentVal :: UnspentVal -> BlockRef
$sel:value:UnspentVal :: UnspentVal -> Word64
$sel:script:UnspentVal :: UnspentVal -> ByteString
block :: BlockRef
value :: Word64
script :: ByteString
..} =
  Unspent {Maybe Address
Word64
ByteString
OutPoint
BlockRef
$sel:block:Unspent :: BlockRef
$sel:value:Unspent :: Word64
$sel:script:Unspent :: ByteString
$sel:outpoint:Unspent :: OutPoint
$sel:address:Unspent :: Maybe Address
outpoint :: OutPoint
block :: BlockRef
value :: Word64
script :: ByteString
address :: Maybe Address
..}
  where
    address :: Maybe Address
address = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx ByteString
script)