{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Network.Haskoin.Store.Data.KeyValue where
import Control.Monad.Reader
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Default
import Data.Hashable
import Data.Serialize as S
import Data.Word
import qualified Database.RocksDB.Query as R
import GHC.Generics
import Haskoin
import Network.Haskoin.Store.Data
data AddrTxKey
= AddrTxKey { addrTxKeyA :: !Address
, addrTxKeyT :: !BlockTx
}
| AddrTxKeyA { addrTxKeyA :: !Address }
| AddrTxKeyB { addrTxKeyA :: !Address
, addrTxKeyB :: !BlockRef
}
deriving (Show, Eq, Ord, Generic, Hashable)
instance Serialize AddrTxKey
where
put AddrTxKey { addrTxKeyA = a
, addrTxKeyT = BlockTx { blockTxBlock = b
, blockTxHash = t
}
} = do
putWord8 0x05
put a
put b
put t
put AddrTxKeyA {addrTxKeyA = a} = do
putWord8 0x05
put a
put AddrTxKeyB {addrTxKeyA = a, addrTxKeyB = b} = do
putWord8 0x05
put a
put b
get = do
guard . (== 0x05) =<< getWord8
a <- get
b <- get
t <- get
return
AddrTxKey
{ addrTxKeyA = a
, addrTxKeyT =
BlockTx
{ blockTxBlock = b
, blockTxHash = t
}
}
instance R.Key AddrTxKey
instance R.KeyValue AddrTxKey ()
data AddrOutKey
= AddrOutKey { addrOutKeyA :: !Address
, addrOutKeyB :: !BlockRef
, addrOutKeyP :: !OutPoint }
| AddrOutKeyA { addrOutKeyA :: !Address }
| AddrOutKeyB { addrOutKeyA :: !Address
, addrOutKeyB :: !BlockRef
}
deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize AddrOutKey
where
put AddrOutKey {addrOutKeyA = a, addrOutKeyB = b, addrOutKeyP = p} = do
putWord8 0x06
put a
put b
put p
put AddrOutKeyA {addrOutKeyA = a} = do
putWord8 0x06
put a
put AddrOutKeyB {addrOutKeyA = a, addrOutKeyB = b} = do
putWord8 0x06
put a
put b
get = do
guard . (== 0x06) =<< getWord8
AddrOutKey <$> get <*> get <*> get
instance R.Key AddrOutKey
data OutVal = OutVal
{ outValAmount :: !Word64
, outValScript :: !ByteString
} deriving (Show, Read, Eq, Ord, Generic, Hashable, Serialize)
instance R.KeyValue AddrOutKey OutVal
newtype TxKey = TxKey
{ txKey :: TxHash
} deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize TxKey where
put (TxKey h) = do
putWord8 0x02
put h
get = do
guard . (== 0x02) =<< getWord8
TxKey <$> get
instance R.Key TxKey
instance R.KeyValue TxKey TxData
data SpenderKey
= SpenderKey { outputPoint :: !OutPoint }
| SpenderKeyS { outputKeyS :: !TxHash }
deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize SpenderKey where
put (SpenderKey OutPoint {outPointHash = h, outPointIndex = i}) = do
putWord8 0x10
put h
put i
put (SpenderKeyS h) = do
putWord8 0x10
put h
get = do
guard . (== 0x10) =<< getWord8
op <- OutPoint <$> get <*> get
return $ SpenderKey op
instance R.Key SpenderKey
instance R.KeyValue SpenderKey Spender
data UnspentKey
= UnspentKey { unspentKey :: !OutPoint }
| UnspentKeyS { unspentKeyS :: !TxHash }
deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize UnspentKey where
put UnspentKey {unspentKey = OutPoint {outPointHash = h, outPointIndex = i}} = do
putWord8 0x09
put h
put i
put UnspentKeyS {unspentKeyS = t} = do
putWord8 0x09
put t
get = do
guard . (== 0x09) =<< getWord8
h <- get
i <- get
return $ UnspentKey OutPoint {outPointHash = h, outPointIndex = i}
data UnspentVal = UnspentVal
{ unspentValBlock :: !BlockRef
, unspentValAmount :: !Word64
, unspentValScript :: !ByteString
} deriving (Show, Read, Eq, Ord, Generic, Hashable, Serialize)
instance R.Key UnspentKey
instance R.KeyValue UnspentKey UnspentVal
data MemKey
= MemKey { memTime :: !PreciseUnixTime
, memKey :: !TxHash }
| MemKeyT { memTime :: !PreciseUnixTime }
| MemKeyS
deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize MemKey where
put (MemKey t h) = do
putWord8 0x07
put t
put h
put (MemKeyT t) = do
putWord8 0x07
put t
put MemKeyS = putWord8 0x07
get = do
guard . (== 0x07) =<< getWord8
MemKey <$> get <*> get
instance R.Key MemKey
instance R.KeyValue MemKey ()
newtype BlockKey = BlockKey
{ blockKey :: BlockHash
} deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize BlockKey where
put (BlockKey h) = do
putWord8 0x01
put h
get = do
guard . (== 0x01) =<< getWord8
BlockKey <$> get
instance R.KeyValue BlockKey BlockData
newtype HeightKey = HeightKey
{ heightKey :: BlockHeight
} deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize HeightKey where
put (HeightKey height) = do
putWord8 0x03
put height
get = do
guard . (== 0x03) =<< getWord8
HeightKey <$> get
instance R.Key HeightKey
instance R.KeyValue HeightKey [BlockHash]
newtype BalKey
= BalKey { balanceKey :: Address }
deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize BalKey where
put BalKey {balanceKey = a} = do
putWord8 0x04
put a
get = do
guard . (== 0x04) =<< getWord8
BalKey <$> get
instance R.Key BalKey
data BalVal = BalVal
{ balValAmount :: !Word64
, balValZero :: !Word64
, balValUnspentCount :: !Word64
, balValTxCount :: !Word64
, balValTotalReceived :: !Word64
} deriving (Show, Read, Eq, Ord, Generic, Hashable, Serialize)
instance Default BalVal where
def =
BalVal
{ balValAmount = 0
, balValZero = 0
, balValUnspentCount = 0
, balValTxCount = 0
, balValTotalReceived = 0
}
instance R.KeyValue BalKey BalVal
data BestKey =
BestKey
deriving (Show, Read, Eq, Ord, Generic, Hashable)
instance Serialize BestKey where
put BestKey = put (B.replicate 32 0x00)
get = do
guard . (== B.replicate 32 0x00) =<< getBytes 32
return BestKey
instance R.Key BestKey
instance R.KeyValue BestKey BlockHash
data VersionKey =
VersionKey
deriving (Eq, Show, Read, Ord, Generic, Hashable)
instance Serialize VersionKey where
put VersionKey = putWord8 0x0a
get = do
guard . (== 0x0a) =<< getWord8
return VersionKey
instance R.Key VersionKey
instance R.KeyValue VersionKey Word32