{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

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

import Control.Monad (join)
import Control.Monad.Reader (ReaderT (..))
import Control.Monad.Reader qualified as R
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as M
import Data.HashTable.IO qualified as H
import Data.IntMap.Strict qualified 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,
    Ctx,
    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
reader :: !DatabaseReader,
    Writer -> Memory
memory :: !Memory
  }

type WriterT = ReaderT Writer

instance (MonadIO m) => StoreReadBase (WriterT m) where
  getNetwork :: WriterT m Network
getNetwork = (Writer -> Network) -> WriterT m Network
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks (.reader.net)
  getCtx :: WriterT m Ctx
getCtx = (Writer -> Ctx) -> WriterT m Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
R.asks (.reader.ctx)
  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 -> Network
net :: !Network,
    Memory -> Ctx
ctx :: !Ctx,
    Memory -> IORef (Maybe (Maybe BlockHash))
best :: !BestRef,
    Memory -> BlockTable
blockTable :: !BlockTable,
    Memory -> HeightTable
heightTable :: !HeightTable,
    Memory -> TxTable
txTable :: !TxTable,
    Memory -> UnspentTable
unspentTable :: !UnspentTable,
    Memory -> BalanceTable
balanceTable :: !BalanceTable,
    Memory -> AddrTxTable
addressTable :: !AddrTxTable,
    Memory -> AddrOutTable
outputTable :: !AddrOutTable,
    Memory -> MempoolTable
mempoolTable :: !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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe (Maybe BlockHash)) -> Maybe (Maybe BlockHash) -> IO ()
forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m ()
writeIORef IORef (Maybe (Maybe BlockHash))
best (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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 BlockTable
blockTable (BlockHeader -> BlockHash
headerHash BlockData
b.header) (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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 HeightTable
heightTable 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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 TxTable
txTable (Tx -> TxHash
txHash TxData
t.tx) (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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 AddrTxTable
addressTable (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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 AddrTxTable
addressTable (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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 AddrOutTable
outputTable (Address, BlockRef, OutPoint)
k (OutVal -> Maybe OutVal
forall a. a -> Maybe a
Just OutVal
v)
    where
      k :: (Address, BlockRef, OutPoint)
k = (Address
a, Unspent
u.block, Unspent
u.outpoint)
      v :: OutVal
v = OutVal {$sel:value:OutVal :: UnixTime
value = Unspent
u.value, $sel:script:OutVal :: ByteString
script = Unspent
u.script}
  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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 AddrOutTable
outputTable (Address, BlockRef, OutPoint)
k Maybe OutVal
forall a. Maybe a
Nothing
    where
      k :: (Address, BlockRef, OutPoint)
k = (Address
a, Unspent
u.block, Unspent
u.outpoint)
  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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 MempoolTable
mempoolTable 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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 MempoolTable
mempoolTable 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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 BalanceTable
balanceTable Balance
b.address (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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 UnspentTable
unspentTable ((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 {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
      IO () -> m ()
forall a. IO a -> m a
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 UnspentTable
unspentTable OutPoint
p Maybe Unspent
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 =
  (Writer -> m a) -> ReaderT Writer m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m a) -> ReaderT Writer m a)
-> (Writer -> m a) -> ReaderT Writer m a
forall a b. (a -> b) -> a -> b
$ \Writer {$sel:reader:Writer :: Writer -> DatabaseReader
reader = DatabaseReader
db, $sel:memory:Writer :: Writer -> Memory
memory = Memory
s} ->
    IO (Maybe a) -> m (Maybe a)
forall a. IO a -> m 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just a
x -> a -> m a
forall a. 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) =>
  Network ->
  Ctx ->
  DatabaseReader ->
  WriterT m a ->
  m a
runWriter :: forall (m :: * -> *) a.
MonadIO m =>
Network -> Ctx -> DatabaseReader -> WriterT m a -> m a
runWriter Network
net Ctx
ctx bdb :: DatabaseReader
bdb@DatabaseReader {DB
db :: DB
$sel:db:DatabaseReader :: DatabaseReader -> 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 <- Network -> Ctx -> [(UnixTime, TxHash)] -> m Memory
forall (m :: * -> *).
MonadIO m =>
Network -> Ctx -> [(UnixTime, TxHash)] -> m Memory
newMemory Network
net Ctx
ctx [(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 {$sel:reader:Writer :: DatabaseReader
reader = DatabaseReader
bdb, $sel:memory:Writer :: Memory
memory = 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 a. a -> m a
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 {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..} =
  [[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)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [ IORef (Maybe (Maybe BlockHash)) -> m [BatchOp]
forall (m :: * -> *).
MonadIO m =>
IORef (Maybe (Maybe BlockHash)) -> m [BatchOp]
bestBlockOp IORef (Maybe (Maybe BlockHash))
best,
        DB -> BlockTable -> m [BatchOp]
forall (m :: * -> *). MonadIO m => DB -> BlockTable -> m [BatchOp]
blockHashOps DB
db BlockTable
blockTable,
        DB -> HeightTable -> m [BatchOp]
forall (m :: * -> *). MonadIO m => DB -> HeightTable -> m [BatchOp]
blockHeightOps DB
db HeightTable
heightTable,
        DB -> TxTable -> m [BatchOp]
forall (m :: * -> *). MonadIO m => DB -> TxTable -> m [BatchOp]
txOps DB
db TxTable
txTable,
        DB -> BalanceTable -> m [BatchOp]
forall (m :: * -> *).
MonadIO m =>
DB -> BalanceTable -> m [BatchOp]
balOps DB
db BalanceTable
balanceTable,
        DB -> AddrTxTable -> m [BatchOp]
forall (m :: * -> *). MonadIO m => DB -> AddrTxTable -> m [BatchOp]
addrTxOps DB
db AddrTxTable
addressTable,
        DB -> AddrOutTable -> m [BatchOp]
forall (m :: * -> *).
MonadIO m =>
DB -> AddrOutTable -> m [BatchOp]
addrOutOps DB
db AddrOutTable
outputTable,
        MempoolTable -> m [BatchOp]
forall (m :: * -> *). MonadIO m => MempoolTable -> m [BatchOp]
mempoolOp MempoolTable
mempoolTable,
        DB -> UnspentTable -> m [BatchOp]
forall (m :: * -> *).
MonadIO m =>
DB -> UnspentTable -> m [BatchOp]
unspentOps DB
db UnspentTable
unspentTable
      ]

bestBlockOp :: (MonadIO m) => BestRef -> m [BatchOp]
bestBlockOp :: forall (m :: * -> *).
MonadIO m =>
IORef (Maybe (Maybe BlockHash)) -> m [BatchOp]
bestBlockOp IORef (Maybe (Maybe BlockHash))
r =
  IORef (Maybe (Maybe BlockHash)) -> m (Maybe (Maybe BlockHash))
forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef (Maybe (Maybe BlockHash))
r m (Maybe (Maybe BlockHash))
-> (Maybe (Maybe BlockHash) -> m [BatchOp]) -> m [BatchOp]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Maybe BlockHash)
Nothing -> [BatchOp] -> m [BatchOp]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just Maybe BlockHash
Nothing -> [BatchOp] -> m [BatchOp]
forall a. a -> m a
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 a. a -> m a
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 :: forall (m :: * -> *). MonadIO m => 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 a. IO a -> m a
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 :: forall (m :: * -> *). MonadIO m => 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 a. IO a -> m a
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 :: forall (m :: * -> *). MonadIO m => 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 a. IO a -> m a
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 :: forall (m :: * -> *).
MonadIO m =>
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 a. IO a -> m a
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 :: forall (m :: * -> *). MonadIO m => 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 a. IO a -> m a
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 :: forall (m :: * -> *).
MonadIO m =>
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 a. IO a -> m a
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
            { $sel:address:AddrOutKey :: Address
address = Address
a,
              $sel:block:AddrOutKey :: BlockRef
block = BlockRef
b,
              $sel:outpoint:AddrOutKey :: OutPoint
outpoint = 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
          { $sel:address:AddrOutKey :: Address
address = Address
a,
            $sel:block:AddrOutKey :: BlockRef
block = BlockRef
b,
            $sel:outpoint:AddrOutKey :: OutPoint
outpoint = OutPoint
p
          }

mempoolOp :: (MonadIO m) => MempoolTable -> m [BatchOp]
mempoolOp :: forall (m :: * -> *). MonadIO m => MempoolTable -> m [BatchOp]
mempoolOp MempoolTable
t =
  BatchOp -> [BatchOp]
forall a. a -> [a]
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 a. IO a -> m a
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 :: forall (m :: * -> *).
MonadIO m =>
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 a. IO a -> m a
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)

getBestBlockI :: (MonadIO m) => WriterT m (Maybe BlockHash)
getBestBlockI :: forall (m :: * -> *). MonadIO m => 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 :: forall (m :: * -> *).
MonadIO m =>
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 :: forall (m :: * -> *).
MonadIO m =>
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 :: forall (m :: * -> *).
MonadIO m =>
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 :: forall (m :: * -> *).
MonadIO m =>
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 :: forall (m :: * -> *).
MonadIO m =>
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 :: forall (m :: * -> *).
MonadIO m =>
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 :: forall (m :: * -> *). MonadIO m => WriterT m [(UnixTime, TxHash)]
getMempoolI =
  (Writer -> m [(UnixTime, TxHash)])
-> ReaderT Writer m [(UnixTime, TxHash)]
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Writer -> m [(UnixTime, TxHash)])
 -> ReaderT Writer m [(UnixTime, TxHash)])
-> (Writer -> m [(UnixTime, TxHash)])
-> ReaderT Writer m [(UnixTime, TxHash)]
forall a b. (a -> b) -> a -> b
$ \Writer {$sel:memory:Writer :: Writer -> Memory
memory = Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..}} ->
    IO [(UnixTime, TxHash)] -> m [(UnixTime, TxHash)]
forall a. IO a -> m a
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 MempoolTable
mempoolTable

newMemory ::
  (MonadIO m) =>
  Network ->
  Ctx ->
  [(UnixTime, TxHash)] ->
  m Memory
newMemory :: forall (m :: * -> *).
MonadIO m =>
Network -> Ctx -> [(UnixTime, TxHash)] -> m Memory
newMemory Network
net Ctx
ctx [(UnixTime, TxHash)]
mempool = do
  IORef (Maybe (Maybe BlockHash))
best <- Maybe (Maybe BlockHash) -> m (IORef (Maybe (Maybe BlockHash)))
forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef Maybe (Maybe BlockHash)
forall a. Maybe a
Nothing
  HashTable RealWorld BlockHash (Maybe BlockData)
blockTable <- IO (HashTable RealWorld BlockHash (Maybe BlockData))
-> m (HashTable RealWorld BlockHash (Maybe BlockData))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld BlockHash (Maybe BlockData))
IO BlockTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld BlockHeight [BlockHash]
heightTable <- IO (HashTable RealWorld BlockHeight [BlockHash])
-> m (HashTable RealWorld BlockHeight [BlockHash])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld BlockHeight [BlockHash])
IO HeightTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld TxHash (Maybe TxData)
txTable <- IO (HashTable RealWorld TxHash (Maybe TxData))
-> m (HashTable RealWorld TxHash (Maybe TxData))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld TxHash (Maybe TxData))
IO TxTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld OutPoint (Maybe Unspent)
unspentTable <- IO (HashTable RealWorld OutPoint (Maybe Unspent))
-> m (HashTable RealWorld OutPoint (Maybe Unspent))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld OutPoint (Maybe Unspent))
IO UnspentTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld Address (Maybe Balance)
balanceTable <- IO (HashTable RealWorld Address (Maybe Balance))
-> m (HashTable RealWorld Address (Maybe Balance))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld Address (Maybe Balance))
IO BalanceTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld (Address, TxRef) (Maybe ())
addressTable <- IO (HashTable RealWorld (Address, TxRef) (Maybe ()))
-> m (HashTable RealWorld (Address, TxRef) (Maybe ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (HashTable RealWorld (Address, TxRef) (Maybe ()))
IO AddrTxTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
outputTable <- IO
  (HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal))
-> m (HashTable
        RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO
  (HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal))
IO AddrOutTable
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
  HashTable RealWorld TxHash UnixTime
mempoolTable <- IO (HashTable RealWorld TxHash UnixTime)
-> m (HashTable RealWorld TxHash UnixTime)
forall a. IO a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Memory {IORef (Maybe (Maybe BlockHash))
HashTable RealWorld BlockHeight [BlockHash]
HashTable RealWorld (Address, TxRef) (Maybe ())
HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
HashTable RealWorld OutPoint (Maybe Unspent)
HashTable RealWorld TxHash (Maybe TxData)
HashTable RealWorld TxHash UnixTime
HashTable RealWorld BlockHash (Maybe BlockData)
HashTable RealWorld Address (Maybe Balance)
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Network
$sel:ctx:Memory :: Ctx
$sel:best:Memory :: IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: BlockTable
$sel:heightTable:Memory :: HeightTable
$sel:txTable:Memory :: TxTable
$sel:unspentTable:Memory :: UnspentTable
$sel:balanceTable:Memory :: BalanceTable
$sel:addressTable:Memory :: AddrTxTable
$sel:outputTable:Memory :: AddrOutTable
$sel:mempoolTable:Memory :: MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: HashTable RealWorld BlockHash (Maybe BlockData)
heightTable :: HashTable RealWorld BlockHeight [BlockHash]
txTable :: HashTable RealWorld TxHash (Maybe TxData)
unspentTable :: HashTable RealWorld OutPoint (Maybe Unspent)
balanceTable :: HashTable RealWorld Address (Maybe Balance)
addressTable :: HashTable RealWorld (Address, TxRef) (Maybe ())
outputTable :: HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal)
mempoolTable :: HashTable RealWorld TxHash UnixTime
..}

getNetworkH :: (Monad m) => Memory -> m Network
getNetworkH :: forall (m :: * -> *). Monad m => Memory -> m Network
getNetworkH Memory {Network
$sel:net:Memory :: Memory -> Network
net :: Network
net} = Network -> m Network
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Network
net

getCtxH :: (Monad m) => Memory -> m Ctx
getCtxH :: forall (m :: * -> *). Monad m => Memory -> m Ctx
getCtxH Memory {Ctx
$sel:ctx:Memory :: Memory -> Ctx
ctx :: Ctx
ctx} = Ctx -> m Ctx
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ctx
ctx

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

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
s.heightTable 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
s.blockTable 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
s.txTable 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxData -> Maybe Spender
f (TxData -> Maybe Spender) -> Maybe TxData -> Maybe Spender
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (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
op.hash 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
op.index) (IntMap Spender -> Maybe Spender)
-> (TxData -> IntMap Spender) -> TxData -> Maybe Spender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.spenders)

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
s.balanceTable Address
a

getMempoolH :: Memory -> IO [(UnixTime, TxHash)]
getMempoolH :: Memory -> IO [(UnixTime, TxHash)]
getMempoolH Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..} = ((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 MempoolTable
mempoolTable

getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent))
getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent))
getUnspentH OutPoint
p Memory {IORef (Maybe (Maybe BlockHash))
HeightTable
AddrTxTable
AddrOutTable
UnspentTable
TxTable
MempoolTable
BlockTable
BalanceTable
Network
Ctx
$sel:net:Memory :: Memory -> Network
$sel:ctx:Memory :: Memory -> Ctx
$sel:best:Memory :: Memory -> IORef (Maybe (Maybe BlockHash))
$sel:blockTable:Memory :: Memory -> BlockTable
$sel:heightTable:Memory :: Memory -> HeightTable
$sel:txTable:Memory :: Memory -> TxTable
$sel:unspentTable:Memory :: Memory -> UnspentTable
$sel:balanceTable:Memory :: Memory -> BalanceTable
$sel:addressTable:Memory :: Memory -> AddrTxTable
$sel:outputTable:Memory :: Memory -> AddrOutTable
$sel:mempoolTable:Memory :: Memory -> MempoolTable
net :: Network
ctx :: Ctx
best :: IORef (Maybe (Maybe BlockHash))
blockTable :: BlockTable
heightTable :: HeightTable
txTable :: TxTable
unspentTable :: UnspentTable
balanceTable :: BalanceTable
addressTable :: AddrTxTable
outputTable :: AddrOutTable
mempoolTable :: MempoolTable
..} = 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 UnspentTable
unspentTable OutPoint
p