{-# 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 = WriterT m Network
forall (m :: * -> *). MonadIO m => WriterT m Network
getNetworkI
  getBestBlock :: WriterT m (Maybe BlockHash)
getBestBlock = WriterT m (Maybe BlockHash)
forall (m :: * -> *). MonadIO m => WriterT m (Maybe BlockHash)
getBestBlockI
  getBlocksAtHeight :: BlockHeight -> WriterT m [BlockHash]
getBlocksAtHeight = BlockHeight -> WriterT m [BlockHash]
forall (m :: * -> *).
MonadIO m =>
BlockHeight -> WriterT m [BlockHash]
getBlocksAtHeightI
  getBlock :: BlockHash -> WriterT m (Maybe BlockData)
getBlock = BlockHash -> WriterT m (Maybe BlockData)
forall (m :: * -> *).
MonadIO m =>
BlockHash -> WriterT m (Maybe BlockData)
getBlockI
  getTxData :: TxHash -> WriterT m (Maybe TxData)
getTxData = TxHash -> WriterT m (Maybe TxData)
forall (m :: * -> *).
MonadIO m =>
TxHash -> WriterT m (Maybe TxData)
getTxDataI
  getSpender :: OutPoint -> WriterT m (Maybe Spender)
getSpender = OutPoint -> WriterT m (Maybe Spender)
forall (m :: * -> *).
MonadIO m =>
OutPoint -> WriterT m (Maybe Spender)
getSpenderI
  getUnspent :: OutPoint -> WriterT m (Maybe Unspent)
getUnspent = OutPoint -> WriterT m (Maybe Unspent)
forall (m :: * -> *).
MonadIO m =>
OutPoint -> WriterT m (Maybe Unspent)
getUnspentI
  getBalance :: Address -> WriterT m (Maybe Balance)
getBalance = Address -> WriterT m (Maybe Balance)
forall (m :: * -> *).
MonadIO m =>
Address -> WriterT m (Maybe Balance)
getBalanceI
  getMempool :: WriterT m [(UnixTime, TxHash)]
getMempool = WriterT m [(UnixTime, TxHash)]
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 =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BestRef -> Maybe (Maybe BlockHash) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef (Memory -> BestRef
hBest Memory
s) (Maybe BlockHash -> Maybe (Maybe BlockHash)
forall a. a -> Maybe a
Just (BlockHash -> Maybe BlockHash
forall a. a -> Maybe a
Just BlockHash
h))
  insertBlock :: BlockData -> WriterT m ()
insertBlock BlockData
b =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BlockTable -> BlockHash -> Maybe BlockData -> IO ()
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)) (BlockData -> Maybe BlockData
forall a. a -> Maybe a
Just BlockData
b)
  setBlocksAtHeight :: [BlockHash] -> BlockHeight -> WriterT m ()
setBlocksAtHeight [BlockHash]
h BlockHeight
g =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ HeightTable -> BlockHeight -> [BlockHash] -> IO ()
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 =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TxTable -> TxHash -> Maybe TxData -> IO ()
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)) (TxData -> Maybe TxData
forall a. a -> Maybe a
Just TxData
t)
  insertAddrTx :: Address -> TxRef -> WriterT m ()
insertAddrTx Address
a TxRef
t =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AddrTxTable -> (Address, TxRef) -> Maybe () -> IO ()
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) (() -> Maybe ()
forall a. a -> Maybe a
Just ())
  deleteAddrTx :: Address -> TxRef -> WriterT m ()
deleteAddrTx Address
a TxRef
t =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AddrTxTable -> (Address, TxRef) -> Maybe () -> IO ()
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) Maybe ()
forall a. Maybe a
Nothing
  insertAddrUnspent :: Address -> Unspent -> WriterT m ()
insertAddrUnspent Address
a Unspent
u =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AddrOutTable
-> (Address, BlockRef, OutPoint) -> Maybe OutVal -> IO ()
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 (OutVal -> Maybe OutVal
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 :: UnixTime -> ByteString -> OutVal
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 =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ AddrOutTable
-> (Address, BlockRef, OutPoint) -> Maybe OutVal -> IO ()
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 Maybe OutVal
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 =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MempoolTable -> TxHash -> UnixTime -> IO ()
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 =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MempoolTable -> TxHash -> IO ()
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 =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ BalanceTable -> Address -> Maybe Balance -> IO ()
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) (Balance -> Maybe Balance
forall a. a -> Maybe a
Just Balance
b)
  insertUnspent :: Unspent -> WriterT m ()
insertUnspent Unspent
u =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ UnspentTable -> OutPoint -> Maybe Unspent -> IO ()
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, UnspentVal) -> OutPoint
forall a b. (a, b) -> a
fst (Unspent -> (OutPoint, UnspentVal)
unspentToVal Unspent
u)) (Unspent -> Maybe Unspent
forall a. a -> Maybe a
Just Unspent
u)
  deleteUnspent :: OutPoint -> WriterT m ()
deleteUnspent OutPoint
p =
    (Writer -> m ()) -> WriterT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m ()) -> WriterT m ())
-> (Writer -> m ()) -> WriterT m ()
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ UnspentTable -> OutPoint -> Maybe Unspent -> IO ()
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 Maybe Unspent
forall a. Maybe a
Nothing

getLayered ::
  MonadIO m =>
  (Memory -> IO (Maybe a)) ->
  DatabaseReaderT m a ->
  WriterT m a
getLayered :: (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered Memory -> IO (Maybe a)
f DatabaseReaderT m a
g =
  (Writer -> m a) -> WriterT m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m a) -> WriterT m a) -> (Writer -> m a) -> WriterT m a
forall a b. (a -> b) -> a -> b
$ \Writer {getReader :: Writer -> DatabaseReader
getReader = DatabaseReader
db, getState :: Writer -> Memory
getState = Memory
s} ->
    IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Memory -> IO (Maybe a)
f Memory
s) m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      Maybe a
Nothing -> DatabaseReaderT m a -> DatabaseReader -> m a
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 :: 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 <- ReaderT DatabaseReader m [(UnixTime, TxHash)]
-> DatabaseReader -> m [(UnixTime, TxHash)]
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT DatabaseReader m [(UnixTime, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)]
getMempool DatabaseReader
bdb
  Memory
hm <- [(UnixTime, TxHash)] -> m Memory
forall (m :: * -> *). MonadIO m => [(UnixTime, TxHash)] -> m Memory
newMemory [(UnixTime, TxHash)]
mempool
  a
x <- WriterT m a -> Writer -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT WriterT m a
f Writer :: DatabaseReader -> Memory -> Writer
Writer {getReader :: DatabaseReader
getReader = DatabaseReader
bdb, getState :: Memory
getState = Memory
hm}
  [BatchOp]
ops <- DB -> Memory -> m [BatchOp]
forall (m :: * -> *). MonadIO m => DB -> Memory -> m [BatchOp]
hashMapOps DB
db Memory
hm
  DB -> [BatchOp] -> m ()
forall (m :: * -> *). MonadIO m => DB -> [BatchOp] -> m ()
writeBatch DB
db [BatchOp]
ops
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

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

bestBlockOp :: MonadIO m => BestRef -> m [BatchOp]
bestBlockOp :: BestRef -> m [BatchOp]
bestBlockOp BestRef
r =
  BestRef -> m (Maybe (Maybe BlockHash))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef BestRef
r m (Maybe (Maybe BlockHash))
-> (Maybe (Maybe BlockHash) -> m [BatchOp]) -> m [BatchOp]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Maybe BlockHash)
Nothing -> [BatchOp] -> m [BatchOp]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Maybe BlockHash
Nothing -> [BatchOp] -> m [BatchOp]
forall (m :: * -> *) a. Monad m => a -> m a
return [BestKey -> BatchOp
forall key. (Key key, Serialize key) => key -> BatchOp
deleteOp BestKey
BestKey]
    Just (Just BlockHash
b) -> [BatchOp] -> m [BatchOp]
forall (m :: * -> *) a. Monad m => a -> m a
return [BestKey -> BlockHash -> BatchOp
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 :: DB -> BlockTable -> m [BatchOp]
blockHashOps DB
db BlockTable
t = ((BlockHash, Maybe BlockData) -> BatchOp)
-> [(BlockHash, Maybe BlockData)] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map ((BlockHash -> Maybe BlockData -> BatchOp)
-> (BlockHash, Maybe BlockData) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BlockHash -> Maybe BlockData -> BatchOp
forall value.
(KeyValue BlockKey value, Serialize value) =>
BlockHash -> Maybe value -> BatchOp
f) ([(BlockHash, Maybe BlockData)] -> [BatchOp])
-> m [(BlockHash, Maybe BlockData)] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(BlockHash, Maybe BlockData)]
-> m [(BlockHash, Maybe BlockData)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BlockTable -> IO [(BlockHash, Maybe BlockData)]
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) = ColumnFamily -> BlockKey -> value -> BatchOp
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 = ColumnFamily -> BlockKey -> BatchOp
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 :: DB -> HeightTable -> m [BatchOp]
blockHeightOps DB
db HeightTable
t = ((BlockHeight, [BlockHash]) -> BatchOp)
-> [(BlockHeight, [BlockHash])] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map ((BlockHeight -> [BlockHash] -> BatchOp)
-> (BlockHeight, [BlockHash]) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BlockHeight -> [BlockHash] -> BatchOp
f) ([(BlockHeight, [BlockHash])] -> [BatchOp])
-> m [(BlockHeight, [BlockHash])] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(BlockHeight, [BlockHash])] -> m [(BlockHeight, [BlockHash])]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (HeightTable -> IO [(BlockHeight, [BlockHash])]
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 = ColumnFamily -> HeightKey -> [BlockHash] -> BatchOp
forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF (DB -> ColumnFamily
heightCF DB
db) (HeightKey -> [BlockHash] -> BatchOp)
-> (BlockHeight -> HeightKey)
-> BlockHeight
-> [BlockHash]
-> BatchOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeight -> HeightKey
HeightKey

txOps :: MonadIO m => DB -> TxTable -> m [BatchOp]
txOps :: DB -> TxTable -> m [BatchOp]
txOps DB
db TxTable
t = ((TxHash, Maybe TxData) -> BatchOp)
-> [(TxHash, Maybe TxData)] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map ((TxHash -> Maybe TxData -> BatchOp)
-> (TxHash, Maybe TxData) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxHash -> Maybe TxData -> BatchOp
forall value.
(KeyValue TxKey value, Serialize value) =>
TxHash -> Maybe value -> BatchOp
f) ([(TxHash, Maybe TxData)] -> [BatchOp])
-> m [(TxHash, Maybe TxData)] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(TxHash, Maybe TxData)] -> m [(TxHash, Maybe TxData)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (TxTable -> IO [(TxHash, Maybe TxData)]
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) = ColumnFamily -> TxKey -> value -> BatchOp
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 = ColumnFamily -> TxKey -> BatchOp
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 :: DB -> BalanceTable -> m [BatchOp]
balOps DB
db BalanceTable
t = ((Address, Maybe Balance) -> BatchOp)
-> [(Address, Maybe Balance)] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map ((Address -> Maybe Balance -> BatchOp)
-> (Address, Maybe Balance) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Address -> Maybe Balance -> BatchOp
f) ([(Address, Maybe Balance)] -> [BatchOp])
-> m [(Address, Maybe Balance)] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(Address, Maybe Balance)] -> m [(Address, Maybe Balance)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BalanceTable -> IO [(Address, Maybe Balance)]
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) = ColumnFamily -> BalKey -> BalVal -> BatchOp
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 = ColumnFamily -> BalKey -> BatchOp
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 :: DB -> AddrTxTable -> m [BatchOp]
addrTxOps DB
db AddrTxTable
t = (((Address, TxRef), Maybe ()) -> BatchOp)
-> [((Address, TxRef), Maybe ())] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map (((Address, TxRef) -> Maybe () -> BatchOp)
-> ((Address, TxRef), Maybe ()) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Address, TxRef) -> Maybe () -> BatchOp
f) ([((Address, TxRef), Maybe ())] -> [BatchOp])
-> m [((Address, TxRef), Maybe ())] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [((Address, TxRef), Maybe ())]
-> m [((Address, TxRef), Maybe ())]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AddrTxTable -> IO [((Address, TxRef), Maybe ())]
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 ()) = ColumnFamily -> AddrTxKey -> () -> BatchOp
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 = ColumnFamily -> AddrTxKey -> BatchOp
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 :: DB -> AddrOutTable -> m [BatchOp]
addrOutOps DB
db AddrOutTable
t = (((Address, BlockRef, OutPoint), Maybe OutVal) -> BatchOp)
-> [((Address, BlockRef, OutPoint), Maybe OutVal)] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map (((Address, BlockRef, OutPoint) -> Maybe OutVal -> BatchOp)
-> ((Address, BlockRef, OutPoint), Maybe OutVal) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Address, BlockRef, OutPoint) -> Maybe OutVal -> BatchOp
forall value.
(KeyValue AddrOutKey value, Serialize value) =>
(Address, BlockRef, OutPoint) -> Maybe value -> BatchOp
f) ([((Address, BlockRef, OutPoint), Maybe OutVal)] -> [BatchOp])
-> m [((Address, BlockRef, OutPoint), Maybe OutVal)] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [((Address, BlockRef, OutPoint), Maybe OutVal)]
-> m [((Address, BlockRef, OutPoint), Maybe OutVal)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (AddrOutTable -> IO [((Address, BlockRef, OutPoint), Maybe OutVal)]
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) =
      ColumnFamily -> AddrOutKey -> value -> BatchOp
forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
ColumnFamily -> key -> value -> BatchOp
insertOpCF
        (DB -> ColumnFamily
addrOutCF DB
db)
        ( AddrOutKey :: Address -> BlockRef -> OutPoint -> AddrOutKey
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 =
      ColumnFamily -> AddrOutKey -> BatchOp
forall key.
(Key key, Serialize key) =>
ColumnFamily -> key -> BatchOp
deleteOpCF
        (DB -> ColumnFamily
addrOutCF DB
db)
        AddrOutKey :: Address -> BlockRef -> OutPoint -> AddrOutKey
AddrOutKey
          { addrOutKeyA :: Address
addrOutKeyA = Address
a,
            addrOutKeyB :: BlockRef
addrOutKeyB = BlockRef
b,
            addrOutKeyP :: OutPoint
addrOutKeyP = OutPoint
p
          }

mempoolOp :: MonadIO m => MempoolTable -> m [BatchOp]
mempoolOp :: MempoolTable -> m [BatchOp]
mempoolOp MempoolTable
t =
  BatchOp -> [BatchOp]
forall (m :: * -> *) a. Monad m => a -> m a
return (BatchOp -> [BatchOp])
-> ([(TxHash, UnixTime)] -> BatchOp)
-> [(TxHash, UnixTime)]
-> [BatchOp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemKey -> [(UnixTime, TxHash)] -> BatchOp
forall key value.
(KeyValue key value, Serialize key, Serialize value) =>
key -> value -> BatchOp
insertOp MemKey
MemKey ([(UnixTime, TxHash)] -> BatchOp)
-> ([(TxHash, UnixTime)] -> [(UnixTime, TxHash)])
-> [(TxHash, UnixTime)]
-> BatchOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnixTime, TxHash) -> Down (UnixTime, TxHash))
-> [(UnixTime, TxHash)] -> [(UnixTime, TxHash)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (UnixTime, TxHash) -> Down (UnixTime, TxHash)
forall a. a -> Down a
Down ([(UnixTime, TxHash)] -> [(UnixTime, TxHash)])
-> ([(TxHash, UnixTime)] -> [(UnixTime, TxHash)])
-> [(TxHash, UnixTime)]
-> [(UnixTime, TxHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxHash, UnixTime) -> (UnixTime, TxHash))
-> [(TxHash, UnixTime)] -> [(UnixTime, TxHash)]
forall a b. (a -> b) -> [a] -> [b]
map (TxHash, UnixTime) -> (UnixTime, TxHash)
forall a b. (a, b) -> (b, a)
swap ([(TxHash, UnixTime)] -> [BatchOp])
-> m [(TxHash, UnixTime)] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(TxHash, UnixTime)] -> m [(TxHash, UnixTime)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MempoolTable -> IO [(TxHash, UnixTime)]
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 :: DB -> UnspentTable -> m [BatchOp]
unspentOps DB
db UnspentTable
t = ((OutPoint, Maybe Unspent) -> BatchOp)
-> [(OutPoint, Maybe Unspent)] -> [BatchOp]
forall a b. (a -> b) -> [a] -> [b]
map ((OutPoint -> Maybe Unspent -> BatchOp)
-> (OutPoint, Maybe Unspent) -> BatchOp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OutPoint -> Maybe Unspent -> BatchOp
f) ([(OutPoint, Maybe Unspent)] -> [BatchOp])
-> m [(OutPoint, Maybe Unspent)] -> m [BatchOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(OutPoint, Maybe Unspent)] -> m [(OutPoint, Maybe Unspent)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (UnspentTable -> IO [(OutPoint, Maybe Unspent)]
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) =
      ColumnFamily -> UnspentKey -> UnspentVal -> BatchOp
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) ((OutPoint, UnspentVal) -> UnspentVal
forall a b. (a, b) -> b
snd (Unspent -> (OutPoint, UnspentVal)
unspentToVal Unspent
u))
    f OutPoint
p Maybe Unspent
Nothing =
      ColumnFamily -> UnspentKey -> BatchOp
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 :: WriterT m Network
getNetworkI = (Memory -> IO (Maybe Network))
-> DatabaseReaderT m Network -> WriterT m Network
forall (m :: * -> *) a.
MonadIO m =>
(Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a
getLayered (IO (Maybe Network) -> IO (Maybe Network)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Network) -> IO (Maybe Network))
-> (Memory -> IO (Maybe Network)) -> Memory -> IO (Maybe Network)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetRef -> IO (Maybe Network)
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (NetRef -> IO (Maybe Network))
-> (Memory -> NetRef) -> Memory -> IO (Maybe Network)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Memory -> NetRef
hNet) DatabaseReaderT m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork

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

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

getBlockI :: MonadIO m => BlockHash -> WriterT m (Maybe BlockData)
getBlockI :: BlockHash -> WriterT m (Maybe BlockData)
getBlockI BlockHash
bh = (Memory -> IO (Maybe (Maybe BlockData)))
-> DatabaseReaderT m (Maybe BlockData)
-> WriterT m (Maybe BlockData)
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) (BlockHash -> DatabaseReaderT m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
bh)

getTxDataI :: MonadIO m => TxHash -> WriterT m (Maybe TxData)
getTxDataI :: TxHash -> WriterT m (Maybe TxData)
getTxDataI TxHash
th = (Memory -> IO (Maybe (Maybe TxData)))
-> DatabaseReaderT m (Maybe TxData) -> WriterT m (Maybe TxData)
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) (TxHash -> DatabaseReaderT m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getTxData TxHash
th)

getSpenderI :: MonadIO m => OutPoint -> WriterT m (Maybe Spender)
getSpenderI :: OutPoint -> WriterT m (Maybe Spender)
getSpenderI OutPoint
op = (Memory -> IO (Maybe (Maybe Spender)))
-> DatabaseReaderT m (Maybe Spender) -> WriterT m (Maybe Spender)
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) (OutPoint -> DatabaseReaderT m (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender OutPoint
op)

getBalanceI :: MonadIO m => Address -> WriterT m (Maybe Balance)
getBalanceI :: Address -> WriterT m (Maybe Balance)
getBalanceI Address
a = (Memory -> IO (Maybe (Maybe Balance)))
-> DatabaseReaderT m (Maybe Balance) -> WriterT m (Maybe Balance)
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) (Address -> DatabaseReaderT m (Maybe Balance)
forall (m :: * -> *).
StoreReadBase m =>
Address -> m (Maybe Balance)
getBalance Address
a)

getUnspentI :: MonadIO m => OutPoint -> WriterT m (Maybe Unspent)
getUnspentI :: OutPoint -> WriterT m (Maybe Unspent)
getUnspentI OutPoint
op = (Memory -> IO (Maybe (Maybe Unspent)))
-> DatabaseReaderT m (Maybe Unspent) -> WriterT m (Maybe Unspent)
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) (OutPoint -> DatabaseReaderT m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op)

getMempoolI :: MonadIO m => WriterT m [(UnixTime, TxHash)]
getMempoolI :: WriterT m [(UnixTime, TxHash)]
getMempoolI =
  (Writer -> m [(UnixTime, TxHash)])
-> WriterT m [(UnixTime, TxHash)]
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m [(UnixTime, TxHash)])
 -> WriterT m [(UnixTime, TxHash)])
-> (Writer -> m [(UnixTime, TxHash)])
-> WriterT m [(UnixTime, TxHash)]
forall a b. (a -> b) -> a -> b
$ \Writer {getState :: Writer -> Memory
getState = Memory
s} ->
    IO [(UnixTime, TxHash)] -> m [(UnixTime, TxHash)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(UnixTime, TxHash)] -> m [(UnixTime, TxHash)])
-> IO [(UnixTime, TxHash)] -> m [(UnixTime, TxHash)]
forall a b. (a -> b) -> a -> b
$ ((TxHash, UnixTime) -> (UnixTime, TxHash))
-> [(TxHash, UnixTime)] -> [(UnixTime, TxHash)]
forall a b. (a -> b) -> [a] -> [b]
map (TxHash, UnixTime) -> (UnixTime, TxHash)
forall a b. (a, b) -> (b, a)
swap ([(TxHash, UnixTime)] -> [(UnixTime, TxHash)])
-> IO [(TxHash, UnixTime)] -> IO [(UnixTime, TxHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MempoolTable -> IO [(TxHash, UnixTime)]
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 :: [(UnixTime, TxHash)] -> m Memory
newMemory [(UnixTime, TxHash)]
mempool = do
  NetRef
hNet <- Maybe Network -> m NetRef
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe Network
forall a. Maybe a
Nothing
  BestRef
hBest <- Maybe (Maybe BlockHash) -> m BestRef
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe (Maybe BlockHash)
forall a. Maybe a
Nothing
  HashTable RealWorld BlockHash (Maybe BlockData)
hBlock <- IO (HashTable RealWorld BlockHash (Maybe BlockData))
-> m (HashTable RealWorld BlockHash (Maybe BlockData))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld BlockHash (Maybe BlockData))
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld BlockHeight [BlockHash]
hHeight <- IO (HashTable RealWorld BlockHeight [BlockHash])
-> m (HashTable RealWorld BlockHeight [BlockHash])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld BlockHeight [BlockHash])
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld TxHash (Maybe TxData)
hTx <- IO (HashTable RealWorld TxHash (Maybe TxData))
-> m (HashTable RealWorld TxHash (Maybe TxData))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld TxHash (Maybe TxData))
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld OutPoint (Maybe Unspent)
hUnspent <- IO (HashTable RealWorld OutPoint (Maybe Unspent))
-> m (HashTable RealWorld OutPoint (Maybe Unspent))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld OutPoint (Maybe Unspent))
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld Address (Maybe Balance)
hBalance <- IO (HashTable RealWorld Address (Maybe Balance))
-> m (HashTable RealWorld Address (Maybe Balance))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld Address (Maybe Balance))
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld (Address, TxRef) (Maybe ())
hAddrTx <- IO (HashTable RealWorld (Address, TxRef) (Maybe ()))
-> m (HashTable RealWorld (Address, TxRef) (Maybe ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld (Address, TxRef) (Maybe ()))
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
hAddrOut <- IO
  (HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal))
-> m (HashTable
        RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO
  (HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal))
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld TxHash UnixTime
hMempool <- IO (HashTable RealWorld TxHash UnixTime)
-> m (HashTable RealWorld TxHash UnixTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashTable RealWorld TxHash UnixTime)
 -> m (HashTable RealWorld TxHash UnixTime))
-> IO (HashTable RealWorld TxHash UnixTime)
-> m (HashTable RealWorld TxHash UnixTime)
forall a b. (a -> b) -> a -> b
$ [(TxHash, UnixTime)] -> IO MempoolTable
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
[(k, v)] -> IO (IOHashTable h k v)
H.fromList (((UnixTime, TxHash) -> (TxHash, UnixTime))
-> [(UnixTime, TxHash)] -> [(TxHash, UnixTime)]
forall a b. (a -> b) -> [a] -> [b]
map (UnixTime, TxHash) -> (TxHash, UnixTime)
forall a b. (a, b) -> (b, a)
swap [(UnixTime, TxHash)]
mempool)
  Memory -> m Memory
forall (m :: * -> *) a. Monad m => a -> m a
return Memory :: NetRef
-> BestRef
-> BlockTable
-> HeightTable
-> TxTable
-> UnspentTable
-> BalanceTable
-> AddrTxTable
-> AddrOutTable
-> MempoolTable
-> Memory
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
HeightTable
AddrTxTable
AddrOutTable
BalanceTable
BlockTable
UnspentTable
TxTable
MempoolTable
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 = BestRef -> IO (Maybe (Maybe BlockHash))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef (BestRef -> IO (Maybe (Maybe BlockHash)))
-> (Memory -> BestRef) -> Memory -> IO (Maybe (Maybe BlockHash))
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 = HeightTable -> BlockHeight -> IO (Maybe [BlockHash])
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 = BlockTable -> BlockHash -> IO (Maybe (Maybe BlockData))
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 = TxTable -> TxHash -> IO (Maybe (Maybe TxData))
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
  (Maybe TxData -> Maybe Spender)
-> Maybe (Maybe TxData) -> Maybe (Maybe Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Maybe Spender) -> Maybe Spender
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Spender) -> Maybe Spender)
-> (Maybe TxData -> Maybe (Maybe Spender))
-> Maybe TxData
-> Maybe Spender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxData -> Maybe Spender) -> Maybe TxData -> Maybe (Maybe Spender)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxData -> Maybe Spender
f) (Maybe (Maybe TxData) -> Maybe (Maybe Spender))
-> IO (Maybe (Maybe TxData)) -> IO (Maybe (Maybe Spender))
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 = Key -> IntMap Spender -> Maybe Spender
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (BlockHeight -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral (OutPoint -> BlockHeight
outPointIndex OutPoint
op)) (IntMap Spender -> Maybe Spender)
-> (TxData -> IntMap Spender) -> TxData -> Maybe Spender
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 = BalanceTable -> Address -> IO (Maybe (Maybe Balance))
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 = ((UnixTime, TxHash) -> Down (UnixTime, TxHash))
-> [(UnixTime, TxHash)] -> [(UnixTime, TxHash)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (UnixTime, TxHash) -> Down (UnixTime, TxHash)
forall a. a -> Down a
Down ([(UnixTime, TxHash)] -> [(UnixTime, TxHash)])
-> ([(TxHash, UnixTime)] -> [(UnixTime, TxHash)])
-> [(TxHash, UnixTime)]
-> [(UnixTime, TxHash)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxHash, UnixTime) -> (UnixTime, TxHash))
-> [(TxHash, UnixTime)] -> [(UnixTime, TxHash)]
forall a b. (a -> b) -> [a] -> [b]
map (TxHash, UnixTime) -> (UnixTime, TxHash)
forall a b. (a, b) -> (b, a)
swap ([(TxHash, UnixTime)] -> [(UnixTime, TxHash)])
-> IO [(TxHash, UnixTime)] -> IO [(UnixTime, TxHash)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MempoolTable -> IO [(TxHash, UnixTime)]
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 = UnspentTable -> OutPoint -> IO (Maybe (Maybe Unspent))
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