{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Haskoin.Store.Database.Writer (WriterT, runWriter) where

import Control.Monad (join)
import Control.Monad.Reader (ReaderT (..))
import qualified Control.Monad.Reader as R
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as M
import qualified Data.HashTable.IO as H
import qualified Data.IntMap.Strict as IntMap
import Data.List (sortOn)
import Data.Ord (Down (..))
import Data.Tuple (swap)
import Database.RocksDB (BatchOp, DB)
import Database.RocksDB.Query
  ( deleteOp,
    deleteOpCF,
    insertOp,
    insertOpCF,
    writeBatch,
  )
import Haskoin
  ( Address,
    BlockHash,
    BlockHeight,
    Network,
    OutPoint (..),
    TxHash,
    headerHash,
    txHash,
  )
import Haskoin.Store.Common
import Haskoin.Store.Data
import Haskoin.Store.Database.Reader
import Haskoin.Store.Database.Types
import UnliftIO
  ( IORef,
    MonadIO,
    TVar,
    atomically,
    liftIO,
    modifyIORef,
    modifyTVar,
    newIORef,
    newTVarIO,
    readIORef,
    readTVarIO,
    writeIORef,
  )

data Writer = Writer
  { Writer -> DatabaseReader
getReader :: !DatabaseReader,
    Writer -> Memory
getState :: !Memory
  }

type WriterT = ReaderT Writer

instance MonadIO m => StoreReadBase (WriterT m) where
  getNetwork :: WriterT m Network
getNetwork = forall (m :: * -> *). MonadIO m => WriterT m Network
getNetworkI
  getBestBlock :: WriterT m (Maybe BlockHash)
getBestBlock = forall (m :: * -> *). MonadIO m => WriterT m (Maybe BlockHash)
getBestBlockI
  getBlocksAtHeight :: BlockHeight -> WriterT m [BlockHash]
getBlocksAtHeight = forall (m :: * -> *).
MonadIO m =>
BlockHeight -> WriterT m [BlockHash]
getBlocksAtHeightI
  getBlock :: BlockHash -> WriterT m (Maybe BlockData)
getBlock = forall (m :: * -> *).
MonadIO m =>
BlockHash -> WriterT m (Maybe BlockData)
getBlockI
  getTxData :: TxHash -> WriterT m (Maybe TxData)
getTxData = forall (m :: * -> *).
MonadIO m =>
TxHash -> WriterT m (Maybe TxData)
getTxDataI
  getSpender :: OutPoint -> WriterT m (Maybe Spender)
getSpender = forall (m :: * -> *).
MonadIO m =>
OutPoint -> WriterT m (Maybe Spender)
getSpenderI
  getUnspent :: OutPoint -> WriterT m (Maybe Unspent)
getUnspent = forall (m :: * -> *).
MonadIO m =>
OutPoint -> WriterT m (Maybe Unspent)
getUnspentI
  getBalance :: Address -> WriterT m (Maybe Balance)
getBalance = forall (m :: * -> *).
MonadIO m =>
Address -> WriterT m (Maybe Balance)
getBalanceI
  getMempool :: WriterT m [(UnixTime, TxHash)]
getMempool = forall (m :: * -> *). MonadIO m => WriterT m [(UnixTime, TxHash)]
getMempoolI

type NetRef = IORef (Maybe Network)

type BestRef = IORef (Maybe (Maybe BlockHash))

type BlockTable = H.BasicHashTable BlockHash (Maybe BlockData)

type HeightTable = H.BasicHashTable BlockHeight [BlockHash]

type TxTable = H.BasicHashTable TxHash (Maybe TxData)

type UnspentTable = H.BasicHashTable OutPoint (Maybe Unspent)

type BalanceTable = H.BasicHashTable Address (Maybe Balance)

type AddrTxTable = H.BasicHashTable (Address, TxRef) (Maybe ())

type AddrOutTable = H.BasicHashTable (Address, BlockRef, OutPoint) (Maybe OutVal)

type MempoolTable = H.BasicHashTable TxHash UnixTime

data Memory = Memory
  { Memory -> NetRef
hNet :: !NetRef,
    Memory -> BestRef
hBest :: !BestRef,
    Memory -> BlockTable
hBlock :: !BlockTable,
    Memory -> HeightTable
hHeight :: !HeightTable,
    Memory -> TxTable
hTx :: !TxTable,
    Memory -> UnspentTable
hUnspent :: !UnspentTable,
    Memory -> BalanceTable
hBalance :: !BalanceTable,
    Memory -> AddrTxTable
hAddrTx :: !AddrTxTable,
    Memory -> AddrOutTable
hAddrOut :: !AddrOutTable,
    Memory -> MempoolTable
hMempool :: !MempoolTable
  }

instance MonadIO m => StoreWrite (WriterT m) where
  setBest :: BlockHash -> WriterT m ()
setBest BlockHash
h =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef (Memory -> BestRef
hBest Memory
s) (forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just BlockHash
h))
  insertBlock :: BlockData -> WriterT m ()
insertBlock BlockData
b =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> BlockTable
hBlock Memory
s) (BlockHeader -> BlockHash
headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
b)) (forall a. a -> Maybe a
Just BlockData
b)
  setBlocksAtHeight :: [BlockHash] -> BlockHeight -> WriterT m ()
setBlocksAtHeight [BlockHash]
h BlockHeight
g =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> HeightTable
hHeight Memory
s) BlockHeight
g [BlockHash]
h
  insertTx :: TxData -> WriterT m ()
insertTx TxData
t =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> TxTable
hTx Memory
s) (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
t)) (forall a. a -> Maybe a
Just TxData
t)
  insertAddrTx :: Address -> TxRef -> WriterT m ()
insertAddrTx Address
a TxRef
t =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> AddrTxTable
hAddrTx Memory
s) (Address
a, TxRef
t) (forall a. a -> Maybe a
Just ())
  deleteAddrTx :: Address -> TxRef -> WriterT m ()
deleteAddrTx Address
a TxRef
t =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> AddrTxTable
hAddrTx Memory
s) (Address
a, TxRef
t) forall a. Maybe a
Nothing
  insertAddrUnspent :: Address -> Unspent -> WriterT m ()
insertAddrUnspent Address
a Unspent
u =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> AddrOutTable
hAddrOut Memory
s) (Address, BlockRef, OutPoint)
k (forall a. a -> Maybe a
Just OutVal
v)
    where
      k :: (Address, BlockRef, OutPoint)
k = (Address
a, Unspent -> BlockRef
unspentBlock Unspent
u, Unspent -> OutPoint
unspentPoint Unspent
u)
      v :: OutVal
v = OutVal {outValAmount :: UnixTime
outValAmount = Unspent -> UnixTime
unspentAmount Unspent
u, outValScript :: ByteString
outValScript = Unspent -> ByteString
unspentScript Unspent
u}
  deleteAddrUnspent :: Address -> Unspent -> WriterT m ()
deleteAddrUnspent Address
a Unspent
u =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> AddrOutTable
hAddrOut Memory
s) (Address, BlockRef, OutPoint)
k forall a. Maybe a
Nothing
    where
      k :: (Address, BlockRef, OutPoint)
k = (Address
a, Unspent -> BlockRef
unspentBlock Unspent
u, Unspent -> OutPoint
unspentPoint Unspent
u)
  addToMempool :: TxHash -> UnixTime -> WriterT m ()
addToMempool TxHash
x UnixTime
t =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> MempoolTable
hMempool Memory
s) TxHash
x UnixTime
t
  deleteFromMempool :: TxHash -> WriterT m ()
deleteFromMempool TxHash
x =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO ()
H.delete (Memory -> MempoolTable
hMempool Memory
s) TxHash
x
  setBalance :: Balance -> WriterT m ()
setBalance Balance
b =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> BalanceTable
hBalance Memory
s) (Balance -> Address
balanceAddress Balance
b) (forall a. a -> Maybe a
Just Balance
b)
  insertUnspent :: Unspent -> WriterT m ()
insertUnspent Unspent
u =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> UnspentTable
hUnspent Memory
s) (forall a b. (a, b) -> a
fst (Unspent -> (OutPoint, UnspentVal)
unspentToVal Unspent
u)) (forall a. a -> Maybe a
Just Unspent
u)
  deleteUnspent :: OutPoint -> WriterT m ()
deleteUnspent OutPoint
p =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert (Memory -> UnspentTable
hUnspent Memory
s) OutPoint
p forall a. Maybe a
Nothing

getLayered ::
  MonadIO m =>
  (Memory -> IO (Maybe a)) ->
  DatabaseReaderT m a ->
  WriterT m a
getLayered :: forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered Memory -> IO (Maybe a)
f DatabaseReaderT m a
g =
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getReader :: Writer -> DatabaseReader
getReader = DatabaseReader
db, getState :: Writer -> Memory
getState = Memory
s} ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Memory -> IO (Maybe a)
f Memory
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      Maybe a
Nothing -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DatabaseReaderT m a
g DatabaseReader
db

runWriter ::
  MonadIO m =>
  DatabaseReader ->
  WriterT m a ->
  m a
runWriter :: forall (m :: * -> *) a.
MonadIO m =>
DatabaseReader -> WriterT m a -> m a
runWriter bdb :: DatabaseReader
bdb@DatabaseReader {databaseHandle :: DatabaseReader -> DB
databaseHandle = DB
db} WriterT m a
f = do
  [(UnixTime, TxHash)]
mempool <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)]
getMempool DatabaseReader
bdb
  Memory
hm <- forall (m :: * -> *). MonadIO m => [(UnixTime, TxHash)] -> m Memory
newMemory [(UnixTime, TxHash)]
mempool
  a
x <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT WriterT m a
f Writer {getReader :: DatabaseReader
getReader = DatabaseReader
bdb, getState :: Memory
getState = Memory
hm}
  [BatchOp]
ops <- forall (m :: * -> *). MonadIO m => DB -> Memory -> m [BatchOp]
hashMapOps DB
db Memory
hm
  forall (m :: * -> *). MonadIO m => DB -> [BatchOp] -> m ()
writeBatch DB
db [BatchOp]
ops
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

hashMapOps :: MonadIO m => DB -> Memory -> m [BatchOp]
hashMapOps :: forall (m :: * -> *). MonadIO m => DB -> Memory -> m [BatchOp]
hashMapOps DB
db Memory
mem =
  forall a. Monoid a => [a] -> a
mconcat
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
      [ forall (m :: * -> *). MonadIO m => BestRef -> m [BatchOp]
bestBlockOp (Memory -> BestRef
hBest Memory
mem),
        forall (m :: * -> *). MonadIO m => DB -> BlockTable -> m [BatchOp]
blockHashOps DB
db (Memory -> BlockTable
hBlock Memory
mem),
        forall (m :: * -> *). MonadIO m => DB -> HeightTable -> m [BatchOp]
blockHeightOps DB
db (Memory -> HeightTable
hHeight Memory
mem),
        forall (m :: * -> *). MonadIO m => DB -> TxTable -> m [BatchOp]
txOps DB
db (Memory -> TxTable
hTx Memory
mem),
        forall (m :: * -> *).
MonadIO m =>
DB -> BalanceTable -> m [BatchOp]
balOps DB
db (Memory -> BalanceTable
hBalance Memory
mem),
        forall (m :: * -> *). MonadIO m => DB -> AddrTxTable -> m [BatchOp]
addrTxOps DB
db (Memory -> AddrTxTable
hAddrTx Memory
mem),
        forall (m :: * -> *).
MonadIO m =>
DB -> AddrOutTable -> m [BatchOp]
addrOutOps DB
db (Memory -> AddrOutTable
hAddrOut Memory
mem),
        forall (m :: * -> *). MonadIO m => MempoolTable -> m [BatchOp]
mempoolOp (Memory -> MempoolTable
hMempool Memory
mem),
        forall (m :: * -> *).
MonadIO m =>
DB -> UnspentTable -> m [BatchOp]
unspentOps DB
db (Memory -> UnspentTable
hUnspent Memory
mem)
      ]

bestBlockOp :: MonadIO m => BestRef -> m [BatchOp]
bestBlockOp :: forall (m :: * -> *). MonadIO m => BestRef -> m [BatchOp]
bestBlockOp BestRef
r =
  forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef BestRef
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Maybe BlockHash)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Maybe BlockHash
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall key. (Key key, Serialize key) => key -> BatchOp
deleteOp BestKey
BestKey]
    Just (Just BlockHash
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
key -> value -> BatchOp
insertOp BestKey
BestKey BlockHash
b]

blockHashOps :: MonadIO m => DB -> BlockTable -> m [BatchOp]
blockHashOps :: forall (m :: * -> *). MonadIO m => DB -> BlockTable -> m [BatchOp]
blockHashOps DB
db BlockTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {value}.
(KeyValue BlockKey value, Serialize value) =>
BlockHash -> Maybe value -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList BlockTable
t)
  where
    f :: BlockHash -> Maybe value -> BatchOp
f BlockHash
k (Just value
d) = forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
blockCF DB
db) (BlockHash -> BlockKey
BlockKey BlockHash
k) value
d
    f BlockHash
k Maybe value
Nothing = forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF (DB -> ColumnFamily
blockCF DB
db) (BlockHash -> BlockKey
BlockKey BlockHash
k)

blockHeightOps :: MonadIO m => DB -> HeightTable -> m [BatchOp]
blockHeightOps :: forall (m :: * -> *). MonadIO m => DB -> HeightTable -> m [BatchOp]
blockHeightOps DB
db HeightTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BlockHeight -> [BlockHash] -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList HeightTable
t)
  where
    f :: BlockHeight -> [BlockHash] -> BatchOp
f = forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
heightCF DB
db) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeight -> HeightKey
HeightKey

txOps :: MonadIO m => DB -> TxTable -> m [BatchOp]
txOps :: forall (m :: * -> *). MonadIO m => DB -> TxTable -> m [BatchOp]
txOps DB
db TxTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {value}.
(KeyValue TxKey value, Serialize value) =>
TxHash -> Maybe value -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList TxTable
t)
  where
    f :: TxHash -> Maybe value -> BatchOp
f TxHash
k (Just value
t) = forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
txCF DB
db) (TxHash -> TxKey
TxKey TxHash
k) value
t
    f TxHash
k Maybe value
Nothing = forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF (DB -> ColumnFamily
txCF DB
db) (TxHash -> TxKey
TxKey TxHash
k)

balOps :: MonadIO m => DB -> BalanceTable -> m [BatchOp]
balOps :: forall (m :: * -> *).
MonadIO m =>
DB -> BalanceTable -> m [BatchOp]
balOps DB
db BalanceTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> Maybe Balance -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList BalanceTable
t)
  where
    f :: Address -> Maybe Balance -> BatchOp
f Address
a (Just Balance
b) = forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
balanceCF DB
db) (Address -> BalKey
BalKey Address
a) (Balance -> BalVal
balanceToVal Balance
b)
    f Address
a Maybe Balance
Nothing = forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF (DB -> ColumnFamily
balanceCF DB
db) (Address -> BalKey
BalKey Address
a)

addrTxOps :: MonadIO m => DB -> AddrTxTable -> m [BatchOp]
addrTxOps :: forall (m :: * -> *). MonadIO m => DB -> AddrTxTable -> m [BatchOp]
addrTxOps DB
db AddrTxTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Address, TxRef) -> Maybe () -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList AddrTxTable
t)
  where
    f :: (Address, TxRef) -> Maybe () -> BatchOp
f (Address
a, TxRef
t) (Just ()) = forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
addrTxCF DB
db) (Address -> TxRef -> AddrTxKey
AddrTxKey Address
a TxRef
t) ()
    f (Address
a, TxRef
t) Maybe ()
Nothing = forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF (DB -> ColumnFamily
addrTxCF DB
db) (Address -> TxRef -> AddrTxKey
AddrTxKey Address
a TxRef
t)

addrOutOps :: MonadIO m => DB -> AddrOutTable -> m [BatchOp]
addrOutOps :: forall (m :: * -> *).
MonadIO m =>
DB -> AddrOutTable -> m [BatchOp]
addrOutOps DB
db AddrOutTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall {value}.
(KeyValue AddrOutKey value, Serialize value) =>
(Address, BlockRef, OutPoint) -> Maybe value -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList AddrOutTable
t)
  where
    f :: (Address, BlockRef, OutPoint) -> Maybe value -> BatchOp
f (Address
a, BlockRef
b, OutPoint
p) (Just value
l) =
      forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF
        (DB -> ColumnFamily
addrOutCF DB
db)
        ( AddrOutKey
            { addrOutKeyA :: Address
addrOutKeyA = Address
a,
              addrOutKeyB :: BlockRef
addrOutKeyB = BlockRef
b,
              addrOutKeyP :: OutPoint
addrOutKeyP = OutPoint
p
            }
        )
        value
l
    f (Address
a, BlockRef
b, OutPoint
p) Maybe value
Nothing =
      forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF
        (DB -> ColumnFamily
addrOutCF DB
db)
        AddrOutKey
          { addrOutKeyA :: Address
addrOutKeyA = Address
a,
            addrOutKeyB :: BlockRef
addrOutKeyB = BlockRef
b,
            addrOutKeyP :: OutPoint
addrOutKeyP = OutPoint
p
          }

mempoolOp :: MonadIO m => MempoolTable -> m [BatchOp]
mempoolOp :: forall (m :: * -> *). MonadIO m => MempoolTable -> m [BatchOp]
mempoolOp MempoolTable
t =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
key -> value -> BatchOp
insertOp MemKey
MemKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList MempoolTable
t)

unspentOps :: MonadIO m => DB -> UnspentTable -> m [BatchOp]
unspentOps :: forall (m :: * -> *).
MonadIO m =>
DB -> UnspentTable -> m [BatchOp]
unspentOps DB
db UnspentTable
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OutPoint -> Maybe Unspent -> BatchOp
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList UnspentTable
t)
  where
    f :: OutPoint -> Maybe Unspent -> BatchOp
f OutPoint
p (Just Unspent
u) =
      forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
unspentCF DB
db) (OutPoint -> UnspentKey
UnspentKey OutPoint
p) (forall a b. (a, b) -> b
snd (Unspent -> (OutPoint, UnspentVal)
unspentToVal Unspent
u))
    f OutPoint
p Maybe Unspent
Nothing =
      forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF (DB -> ColumnFamily
unspentCF DB
db) (OutPoint -> UnspentKey
UnspentKey OutPoint
p)

getNetworkI :: MonadIO m => WriterT m Network
getNetworkI :: forall (m :: * -> *). MonadIO m => WriterT m Network
getNetworkI = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Memory -> NetRef
hNet) forall (m :: * -> *). StoreReadBase m => m Network
getNetwork

getBestBlockI :: MonadIO m => WriterT m (Maybe BlockHash)
getBestBlockI :: forall (m :: * -> *). MonadIO m => WriterT m (Maybe BlockHash)
getBestBlockI = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered Memory -> IO (Maybe (Maybe BlockHash))
getBestBlockH forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock

getBlocksAtHeightI :: MonadIO m => BlockHeight -> WriterT m [BlockHash]
getBlocksAtHeightI :: forall (m :: * -> *).
MonadIO m =>
BlockHeight -> WriterT m [BlockHash]
getBlocksAtHeightI BlockHeight
bh =
  forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (BlockHeight -> Memory -> IO (Maybe [BlockHash])
getBlocksAtHeightH BlockHeight
bh) (forall (m :: * -> *).
StoreReadBase m =>
BlockHeight -> m [BlockHash]
getBlocksAtHeight BlockHeight
bh)

getBlockI :: MonadIO m => BlockHash -> WriterT m (Maybe BlockData)
getBlockI :: forall (m :: * -> *).
MonadIO m =>
BlockHash -> WriterT m (Maybe BlockData)
getBlockI BlockHash
bh = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (BlockHash -> Memory -> IO (Maybe (Maybe BlockData))
getBlockH BlockHash
bh) (forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh)

getTxDataI :: MonadIO m => TxHash -> WriterT m (Maybe TxData)
getTxDataI :: forall (m :: * -> *).
MonadIO m =>
TxHash -> WriterT m (Maybe TxData)
getTxDataI TxHash
th = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (TxHash -> Memory -> IO (Maybe (Maybe TxData))
getTxDataH TxHash
th) (forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th)

getSpenderI :: MonadIO m => OutPoint -> WriterT m (Maybe Spender)
getSpenderI :: forall (m :: * -> *).
MonadIO m =>
OutPoint -> WriterT m (Maybe Spender)
getSpenderI OutPoint
op = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (OutPoint -> Memory -> IO (Maybe (Maybe Spender))
getSpenderH OutPoint
op) (forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender OutPoint
op)

getBalanceI :: MonadIO m => Address -> WriterT m (Maybe Balance)
getBalanceI :: forall (m :: * -> *).
MonadIO m =>
Address -> WriterT m (Maybe Balance)
getBalanceI Address
a = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (Address -> Memory -> IO (Maybe (Maybe Balance))
getBalanceH Address
a) (forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a)

getUnspentI :: MonadIO m => OutPoint -> WriterT m (Maybe Unspent)
getUnspentI :: forall (m :: * -> *).
MonadIO m =>
OutPoint -> WriterT m (Maybe Unspent)
getUnspentI OutPoint
op = forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (OutPoint -> Memory -> IO (Maybe (Maybe Unspent))
getUnspentH OutPoint
op) (forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op)

getMempoolI :: MonadIO m => WriterT m [(UnixTime, TxHash)]
getMempoolI :: forall (m :: * -> *). MonadIO m => WriterT m [(UnixTime, TxHash)]
getMempoolI =
  forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList (Memory -> MempoolTable
hMempool Memory
s)

newMemory :: MonadIO m => [(UnixTime, TxHash)] -> m Memory
newMemory :: forall (m :: * -> *). MonadIO m => [(UnixTime, TxHash)] -> m Memory
newMemory [(UnixTime, TxHash)]
mempool = do
  NetRef
hNet <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing
  BestRef
hBest <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef forall a. Maybe a
Nothing
  HashTable RealWorld BlockHash (Maybe BlockData)
hBlock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld BlockHeight [BlockHash]
hHeight <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld TxHash (Maybe TxData)
hTx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld OutPoint (Maybe Unspent)
hUnspent <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld Address (Maybe Balance)
hBalance <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld (Address, TxRef) (Maybe ())
hAddrTx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
hAddrOut <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld TxHash UnixTime
hMempool <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
[(k, v)] -> IO (IOHashTable h k v)
H.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap [(UnixTime, TxHash)]
mempool)
  forall (m :: * -> *) a. Monad m => a -> m a
return Memory {BestRef
NetRef
HashTable RealWorld BlockHeight [BlockHash]
HashTable RealWorld (Address, TxRef) (Maybe ())
HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
HashTable RealWorld Address (Maybe Balance)
HashTable RealWorld BlockHash (Maybe BlockData)
HashTable RealWorld OutPoint (Maybe Unspent)
HashTable RealWorld TxHash (Maybe TxData)
HashTable RealWorld TxHash UnixTime
hMempool :: HashTable RealWorld TxHash UnixTime
hAddrOut :: HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
hAddrTx :: HashTable RealWorld (Address, TxRef) (Maybe ())
hBalance :: HashTable RealWorld Address (Maybe Balance)
hUnspent :: HashTable RealWorld OutPoint (Maybe Unspent)
hTx :: HashTable RealWorld TxHash (Maybe TxData)
hHeight :: HashTable RealWorld BlockHeight [BlockHash]
hBlock :: HashTable RealWorld BlockHash (Maybe BlockData)
hBest :: BestRef
hNet :: NetRef
hMempool :: MempoolTable
hAddrOut :: AddrOutTable
hAddrTx :: AddrTxTable
hBalance :: BalanceTable
hUnspent :: UnspentTable
hTx :: TxTable
hHeight :: HeightTable
hBlock :: BlockTable
hBest :: BestRef
hNet :: NetRef
..}

getBestBlockH :: Memory -> IO (Maybe (Maybe BlockHash))
getBestBlockH :: Memory -> IO (Maybe (Maybe BlockHash))
getBestBlockH = forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Memory -> BestRef
hBest

getBlocksAtHeightH :: BlockHeight -> Memory -> IO (Maybe [BlockHash])
getBlocksAtHeightH :: BlockHeight -> Memory -> IO (Maybe [BlockHash])
getBlocksAtHeightH BlockHeight
h Memory
s = forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup (Memory -> HeightTable
hHeight Memory
s) BlockHeight
h

getBlockH :: BlockHash -> Memory -> IO (Maybe (Maybe BlockData))
getBlockH :: BlockHash -> Memory -> IO (Maybe (Maybe BlockData))
getBlockH BlockHash
h Memory
s = forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup (Memory -> BlockTable
hBlock Memory
s) BlockHash
h

getTxDataH :: TxHash -> Memory -> IO (Maybe (Maybe TxData))
getTxDataH :: TxHash -> Memory -> IO (Maybe (Maybe TxData))
getTxDataH TxHash
t Memory
s = forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup (Memory -> TxTable
hTx Memory
s) TxHash
t

getSpenderH :: OutPoint -> Memory -> IO (Maybe (Maybe Spender))
getSpenderH :: OutPoint -> Memory -> IO (Maybe (Maybe Spender))
getSpenderH OutPoint
op Memory
s = do
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxData -> Maybe Spender
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> Memory -> IO (Maybe (Maybe TxData))
getTxDataH (OutPoint -> TxHash
outPointHash OutPoint
op) Memory
s
  where
    f :: TxData -> Maybe Spender
f = forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral (OutPoint -> BlockHeight
outPointIndex OutPoint
op)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxData -> IntMap Spender
txDataSpenders

getBalanceH :: Address -> Memory -> IO (Maybe (Maybe Balance))
getBalanceH :: Address -> Memory -> IO (Maybe (Maybe Balance))
getBalanceH Address
a Memory
s = forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup (Memory -> BalanceTable
hBalance Memory
s) Address
a

getMempoolH :: Memory -> IO [(UnixTime, TxHash)]
getMempoolH :: Memory -> IO [(UnixTime, TxHash)]
getMempoolH Memory
s = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList (Memory -> MempoolTable
hMempool Memory
s)

getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent))
getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent))
getUnspentH OutPoint
p Memory
s = forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup (Memory -> UnspentTable
hUnspent Memory
s) OutPoint
p