{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

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
  ( Bits,
    shift,
    shiftL,
    shiftR,
    (.&.),
    (.|.),
  )
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Default (Default (..))
import Data.Either (fromRight)
import Data.Hashable (Hashable)
import Data.Serialize
  ( Serialize (..),
    decode,
    encode,
    getBytes,
    getWord16be,
    getWord32be,
    getWord8,
    putWord32be,
    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.Store.Data
  ( Balance (..),
    BlockData,
    BlockRef,
    Spender,
    TxData,
    TxRef (..),
    UnixTime,
    Unspent (..),
  )

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

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

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

instance Key AddrTxKey

instance KeyValue AddrTxKey ()

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

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

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

instance Key AddrOutKey

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

instance KeyValue AddrOutKey OutVal

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

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

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

instance Key TxKey

instance KeyValue TxKey TxData

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

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

instance Key UnspentKey

instance KeyValue UnspentKey UnspentVal

toUnspent :: AddrOutKey -> OutVal -> Unspent
toUnspent :: AddrOutKey -> OutVal -> Unspent
toUnspent AddrOutKey
b OutVal
v =
  Unspent
    { unspentBlock :: BlockRef
unspentBlock = AddrOutKey -> BlockRef
addrOutKeyB AddrOutKey
b,
      unspentAmount :: Word64
unspentAmount = OutVal -> Word64
outValAmount OutVal
v,
      unspentScript :: ByteString
unspentScript = OutVal -> ByteString
outValScript OutVal
v,
      unspentPoint :: OutPoint
unspentPoint = AddrOutKey -> OutPoint
addrOutKeyP AddrOutKey
b,
      unspentAddress :: Maybe Address
unspentAddress = forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS (OutVal -> ByteString
outValScript OutVal
v))
    }

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

instance Serialize MemKey where
  -- 0x07
  put :: Putter MemKey
put MemKey
MemKey = Putter Word8
putWord8 Word8
0x07
  get :: Get MemKey
get = do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word8
0x07) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    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
blockKey :: BlockHash
  }
  deriving (Int -> BlockKey -> ShowS
[BlockKey] -> ShowS
BlockKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockKey] -> ShowS
$cshowList :: [BlockKey] -> ShowS
show :: BlockKey -> String
$cshow :: BlockKey -> String
showsPrec :: Int -> BlockKey -> ShowS
$cshowsPrec :: Int -> BlockKey -> ShowS
Show, ReadPrec [BlockKey]
ReadPrec BlockKey
Int -> ReadS BlockKey
ReadS [BlockKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BlockKey]
$creadListPrec :: ReadPrec [BlockKey]
readPrec :: ReadPrec BlockKey
$creadPrec :: ReadPrec BlockKey
readList :: ReadS [BlockKey]
$creadList :: ReadS [BlockKey]
readsPrec :: Int -> ReadS BlockKey
$creadsPrec :: Int -> ReadS BlockKey
Read, BlockKey -> BlockKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockKey -> BlockKey -> Bool
$c/= :: BlockKey -> BlockKey -> Bool
== :: BlockKey -> BlockKey -> Bool
$c== :: BlockKey -> BlockKey -> Bool
Eq, Eq 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
min :: BlockKey -> BlockKey -> BlockKey
$cmin :: BlockKey -> BlockKey -> BlockKey
max :: BlockKey -> BlockKey -> BlockKey
$cmax :: BlockKey -> BlockKey -> BlockKey
>= :: BlockKey -> BlockKey -> Bool
$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
compare :: BlockKey -> BlockKey -> Ordering
$ccompare :: BlockKey -> BlockKey -> Ordering
Ord, 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
$cto :: forall x. Rep BlockKey x -> BlockKey
$cfrom :: forall x. BlockKey -> Rep BlockKey x
Generic, Eq BlockKey
Int -> BlockKey -> Int
BlockKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BlockKey -> Int
$chash :: BlockKey -> Int
hashWithSalt :: Int -> BlockKey -> Int
$chashWithSalt :: Int -> BlockKey -> Int
Hashable)

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

instance Key BlockKey

instance KeyValue BlockKey BlockData

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

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

instance Key HeightKey

instance KeyValue HeightKey [BlockHash]

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

instance Serialize BalKey where
  -- 0x04 · Address
  put :: Putter BalKey
put BalKey {balanceKey :: BalKey -> Address
balanceKey = Address
a} = do
    Putter Word8
putWord8 Word8
0x04
    forall t. Serialize t => Putter t
put Address
a
  -- 0x04
  put BalKey
BalKeyS = Putter Word8
putWord8 Word8
0x04
  get :: Get BalKey
get = do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Word8
0x04) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Word8
getWord8
    Address -> BalKey
BalKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BestKey] -> ShowS
$cshowList :: [BestKey] -> ShowS
show :: BestKey -> String
$cshow :: BestKey -> String
showsPrec :: Int -> BestKey -> ShowS
$cshowsPrec :: Int -> BestKey -> ShowS
Show, ReadPrec [BestKey]
ReadPrec BestKey
Int -> ReadS BestKey
ReadS [BestKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BestKey]
$creadListPrec :: ReadPrec [BestKey]
readPrec :: ReadPrec BestKey
$creadPrec :: ReadPrec BestKey
readList :: ReadS [BestKey]
$creadList :: ReadS [BestKey]
readsPrec :: Int -> ReadS BestKey
$creadsPrec :: Int -> ReadS BestKey
Read, BestKey -> BestKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BestKey -> BestKey -> Bool
$c/= :: BestKey -> BestKey -> Bool
== :: BestKey -> BestKey -> Bool
$c== :: BestKey -> BestKey -> Bool
Eq, Eq 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
min :: BestKey -> BestKey -> BestKey
$cmin :: BestKey -> BestKey -> BestKey
max :: BestKey -> BestKey -> BestKey
$cmax :: BestKey -> BestKey -> BestKey
>= :: BestKey -> BestKey -> Bool
$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
compare :: BestKey -> BestKey -> Ordering
$ccompare :: BestKey -> BestKey -> Ordering
Ord, 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
$cto :: forall x. Rep BestKey x -> BestKey
$cfrom :: forall x. BestKey -> Rep BestKey x
Generic, Eq BestKey
Int -> BestKey -> Int
BestKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: BestKey -> Int
$chash :: BestKey -> Int
hashWithSalt :: Int -> BestKey -> Int
$chashWithSalt :: Int -> BestKey -> Int
Hashable)

instance Serialize BestKey where
  -- 0x00 × 32
  put :: Putter BestKey
put BestKey
BestKey = forall t. Serialize t => Putter t
put (Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00)
  get :: Get BestKey
get = do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0x00) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Get ByteString
getBytes Int
32
    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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionKey -> VersionKey -> Bool
$c/= :: VersionKey -> VersionKey -> Bool
== :: VersionKey -> VersionKey -> Bool
$c== :: VersionKey -> VersionKey -> Bool
Eq, Int -> VersionKey -> ShowS
[VersionKey] -> ShowS
VersionKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionKey] -> ShowS
$cshowList :: [VersionKey] -> ShowS
show :: VersionKey -> String
$cshow :: VersionKey -> String
showsPrec :: Int -> VersionKey -> ShowS
$cshowsPrec :: Int -> VersionKey -> ShowS
Show, ReadPrec [VersionKey]
ReadPrec VersionKey
Int -> ReadS VersionKey
ReadS [VersionKey]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VersionKey]
$creadListPrec :: ReadPrec [VersionKey]
readPrec :: ReadPrec VersionKey
$creadPrec :: ReadPrec VersionKey
readList :: ReadS [VersionKey]
$creadList :: ReadS [VersionKey]
readsPrec :: Int -> ReadS VersionKey
$creadsPrec :: Int -> ReadS VersionKey
Read, Eq 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
min :: VersionKey -> VersionKey -> VersionKey
$cmin :: VersionKey -> VersionKey -> VersionKey
max :: VersionKey -> VersionKey -> VersionKey
$cmax :: VersionKey -> VersionKey -> VersionKey
>= :: VersionKey -> VersionKey -> Bool
$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
compare :: VersionKey -> VersionKey -> Ordering
$ccompare :: VersionKey -> VersionKey -> Ordering
Ord, 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
$cto :: forall x. Rep VersionKey x -> VersionKey
$cfrom :: forall x. VersionKey -> Rep VersionKey x
Generic, Eq VersionKey
Int -> VersionKey -> Int
VersionKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: VersionKey -> Int
$chash :: VersionKey -> Int
hashWithSalt :: Int -> VersionKey -> Int
$chashWithSalt :: Int -> VersionKey -> Int
Hashable)

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

instance Key VersionKey

instance KeyValue VersionKey Word32

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

valToBalance :: Address -> BalVal -> Balance
valToBalance :: Address -> BalVal -> Balance
valToBalance
  Address
a
  BalVal
    { balValAmount :: BalVal -> Word64
balValAmount = Word64
v,
      balValZero :: BalVal -> Word64
balValZero = Word64
z,
      balValUnspentCount :: BalVal -> Word64
balValUnspentCount = Word64
u,
      balValTxCount :: BalVal -> Word64
balValTxCount = Word64
t,
      balValTotalReceived :: BalVal -> Word64
balValTotalReceived = Word64
r
    } =
    Balance
      { balanceAddress :: Address
balanceAddress = Address
a,
        balanceAmount :: Word64
balanceAmount = Word64
v,
        balanceZero :: Word64
balanceZero = Word64
z,
        balanceUnspentCount :: Word64
balanceUnspentCount = Word64
u,
        balanceTxCount :: Word64
balanceTxCount = Word64
t,
        balanceTotalReceived :: Word64
balanceTotalReceived = Word64
r
      }

balanceToVal :: Balance -> BalVal
balanceToVal :: Balance -> BalVal
balanceToVal
  Balance
    { balanceAmount :: Balance -> Word64
balanceAmount = Word64
v,
      balanceZero :: Balance -> Word64
balanceZero = Word64
z,
      balanceUnspentCount :: Balance -> Word64
balanceUnspentCount = Word64
u,
      balanceTxCount :: Balance -> Word64
balanceTxCount = Word64
t,
      balanceTotalReceived :: Balance -> Word64
balanceTotalReceived = Word64
r
    } =
    BalVal
      { balValAmount :: Word64
balValAmount = Word64
v,
        balValZero :: Word64
balValZero = Word64
z,
        balValUnspentCount :: Word64
balValUnspentCount = Word64
u,
        balValTxCount :: Word64
balValTxCount = Word64
t,
        balValTotalReceived :: Word64
balValTotalReceived = Word64
r
      }

-- | Default balance for an address.
instance Default BalVal where
  def :: BalVal
def =
    BalVal
      { balValAmount :: Word64
balValAmount = Word64
0,
        balValZero :: Word64
balValZero = Word64
0,
        balValUnspentCount :: Word64
balValUnspentCount = Word64
0,
        balValTxCount :: Word64
balValTxCount = Word64
0,
        balValTotalReceived :: Word64
balValTotalReceived = Word64
0
      }

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

unspentToVal :: Unspent -> (OutPoint, UnspentVal)
unspentToVal :: Unspent -> (OutPoint, UnspentVal)
unspentToVal
  Unspent
    { unspentBlock :: Unspent -> BlockRef
unspentBlock = BlockRef
b,
      unspentPoint :: Unspent -> OutPoint
unspentPoint = OutPoint
p,
      unspentAmount :: Unspent -> Word64
unspentAmount = Word64
v,
      unspentScript :: Unspent -> ByteString
unspentScript = ByteString
s
    } =
    ( OutPoint
p,
      UnspentVal
        { unspentValBlock :: BlockRef
unspentValBlock = BlockRef
b,
          unspentValAmount :: Word64
unspentValAmount = Word64
v,
          unspentValScript :: ByteString
unspentValScript = ByteString
s
        }
    )

valToUnspent :: OutPoint -> UnspentVal -> Unspent
valToUnspent :: OutPoint -> UnspentVal -> Unspent
valToUnspent
  OutPoint
p
  UnspentVal
    { unspentValBlock :: UnspentVal -> BlockRef
unspentValBlock = BlockRef
b,
      unspentValAmount :: UnspentVal -> Word64
unspentValAmount = Word64
v,
      unspentValScript :: UnspentVal -> ByteString
unspentValScript = ByteString
s
    } =
    Unspent
      { unspentBlock :: BlockRef
unspentBlock = BlockRef
b,
        unspentPoint :: OutPoint
unspentPoint = OutPoint
p,
        unspentAmount :: Word64
unspentAmount = Word64
v,
        unspentScript :: ByteString
unspentScript = ByteString
s,
        unspentAddress :: Maybe Address
unspentAddress = forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS ByteString
s)
      }