{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Haskoin.Store.Database.Writer (WriterT, runWriter) where import Control.Monad (join) import Control.Monad.Reader (ReaderT (..)) import qualified Control.Monad.Reader as R import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M import qualified Data.HashTable.IO as H import qualified Data.IntMap.Strict as IntMap import Data.List (sortOn) import Data.Ord (Down (..)) import Data.Tuple (swap) import Database.RocksDB (BatchOp, DB) import Database.RocksDB.Query ( deleteOp, deleteOpCF, insertOp, insertOpCF, writeBatch, ) import Haskoin ( Address, BlockHash, BlockHeight, Network, OutPoint (..), TxHash, headerHash, txHash, ) import Haskoin.Store.Common import Haskoin.Store.Data import Haskoin.Store.Database.Reader import Haskoin.Store.Database.Types import UnliftIO ( IORef, MonadIO, TVar, atomically, liftIO, modifyIORef, modifyTVar, newIORef, newTVarIO, readIORef, readTVarIO, writeIORef, ) data Writer = Writer { Writer -> DatabaseReader getReader :: !DatabaseReader, Writer -> Memory getState :: !Memory } type WriterT = ReaderT Writer instance MonadIO m => StoreReadBase (WriterT m) where getNetwork :: WriterT m Network getNetwork = forall (m :: * -> *). MonadIO m => WriterT m Network getNetworkI getBestBlock :: WriterT m (Maybe BlockHash) getBestBlock = forall (m :: * -> *). MonadIO m => WriterT m (Maybe BlockHash) getBestBlockI getBlocksAtHeight :: BlockHeight -> WriterT m [BlockHash] getBlocksAtHeight = forall (m :: * -> *). MonadIO m => BlockHeight -> WriterT m [BlockHash] getBlocksAtHeightI getBlock :: BlockHash -> WriterT m (Maybe BlockData) getBlock = forall (m :: * -> *). MonadIO m => BlockHash -> WriterT m (Maybe BlockData) getBlockI getTxData :: TxHash -> WriterT m (Maybe TxData) getTxData = forall (m :: * -> *). MonadIO m => TxHash -> WriterT m (Maybe TxData) getTxDataI getSpender :: OutPoint -> WriterT m (Maybe Spender) getSpender = forall (m :: * -> *). MonadIO m => OutPoint -> WriterT m (Maybe Spender) getSpenderI getUnspent :: OutPoint -> WriterT m (Maybe Unspent) getUnspent = forall (m :: * -> *). MonadIO m => OutPoint -> WriterT m (Maybe Unspent) getUnspentI getBalance :: Address -> WriterT m (Maybe Balance) getBalance = forall (m :: * -> *). MonadIO m => Address -> WriterT m (Maybe Balance) getBalanceI getMempool :: WriterT m [(UnixTime, TxHash)] getMempool = forall (m :: * -> *). MonadIO m => WriterT m [(UnixTime, TxHash)] getMempoolI type NetRef = IORef (Maybe Network) type BestRef = IORef (Maybe (Maybe BlockHash)) type BlockTable = H.BasicHashTable BlockHash (Maybe BlockData) type HeightTable = H.BasicHashTable BlockHeight [BlockHash] type TxTable = H.BasicHashTable TxHash (Maybe TxData) type UnspentTable = H.BasicHashTable OutPoint (Maybe Unspent) type BalanceTable = H.BasicHashTable Address (Maybe Balance) type AddrTxTable = H.BasicHashTable (Address, TxRef) (Maybe ()) type AddrOutTable = H.BasicHashTable (Address, BlockRef, OutPoint) (Maybe OutVal) type MempoolTable = H.BasicHashTable TxHash UnixTime data Memory = Memory { Memory -> NetRef hNet :: !NetRef, Memory -> BestRef hBest :: !BestRef, Memory -> BlockTable hBlock :: !BlockTable, Memory -> HeightTable hHeight :: !HeightTable, Memory -> TxTable hTx :: !TxTable, Memory -> UnspentTable hUnspent :: !UnspentTable, Memory -> BalanceTable hBalance :: !BalanceTable, Memory -> AddrTxTable hAddrTx :: !AddrTxTable, Memory -> AddrOutTable hAddrOut :: !AddrOutTable, Memory -> MempoolTable hMempool :: !MempoolTable } instance MonadIO m => StoreWrite (WriterT m) where setBest :: BlockHash -> WriterT m () setBest BlockHash h = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. MonadIO m => IORef a -> a -> m () writeIORef (Memory -> BestRef hBest Memory s) (forall a. a -> Maybe a Just (forall a. a -> Maybe a Just BlockHash h)) insertBlock :: BlockData -> WriterT m () insertBlock BlockData b = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> BlockTable hBlock Memory s) (BlockHeader -> BlockHash headerHash (BlockData -> BlockHeader blockDataHeader BlockData b)) (forall a. a -> Maybe a Just BlockData b) setBlocksAtHeight :: [BlockHash] -> BlockHeight -> WriterT m () setBlocksAtHeight [BlockHash] h BlockHeight g = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> HeightTable hHeight Memory s) BlockHeight g [BlockHash] h insertTx :: TxData -> WriterT m () insertTx TxData t = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> TxTable hTx Memory s) (Tx -> TxHash txHash (TxData -> Tx txData TxData t)) (forall a. a -> Maybe a Just TxData t) insertAddrTx :: Address -> TxRef -> WriterT m () insertAddrTx Address a TxRef t = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> AddrTxTable hAddrTx Memory s) (Address a, TxRef t) (forall a. a -> Maybe a Just ()) deleteAddrTx :: Address -> TxRef -> WriterT m () deleteAddrTx Address a TxRef t = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> AddrTxTable hAddrTx Memory s) (Address a, TxRef t) forall a. Maybe a Nothing insertAddrUnspent :: Address -> Unspent -> WriterT m () insertAddrUnspent Address a Unspent u = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> AddrOutTable hAddrOut Memory s) (Address, BlockRef, OutPoint) k (forall a. a -> Maybe a Just OutVal v) where k :: (Address, BlockRef, OutPoint) k = (Address a, Unspent -> BlockRef unspentBlock Unspent u, Unspent -> OutPoint unspentPoint Unspent u) v :: OutVal v = OutVal {outValAmount :: UnixTime outValAmount = Unspent -> UnixTime unspentAmount Unspent u, outValScript :: ByteString outValScript = Unspent -> ByteString unspentScript Unspent u} deleteAddrUnspent :: Address -> Unspent -> WriterT m () deleteAddrUnspent Address a Unspent u = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> AddrOutTable hAddrOut Memory s) (Address, BlockRef, OutPoint) k forall a. Maybe a Nothing where k :: (Address, BlockRef, OutPoint) k = (Address a, Unspent -> BlockRef unspentBlock Unspent u, Unspent -> OutPoint unspentPoint Unspent u) addToMempool :: TxHash -> UnixTime -> WriterT m () addToMempool TxHash x UnixTime t = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> MempoolTable hMempool Memory s) TxHash x UnixTime t deleteFromMempool :: TxHash -> WriterT m () deleteFromMempool TxHash x = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO () H.delete (Memory -> MempoolTable hMempool Memory s) TxHash x setBalance :: Balance -> WriterT m () setBalance Balance b = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> BalanceTable hBalance Memory s) (Balance -> Address balanceAddress Balance b) (forall a. a -> Maybe a Just Balance b) insertUnspent :: Unspent -> WriterT m () insertUnspent Unspent u = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> UnspentTable hUnspent Memory s) (forall a b. (a, b) -> a fst (Unspent -> (OutPoint, UnspentVal) unspentToVal Unspent u)) (forall a. a -> Maybe a Just Unspent u) deleteUnspent :: OutPoint -> WriterT m () deleteUnspent OutPoint p = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert (Memory -> UnspentTable hUnspent Memory s) OutPoint p forall a. Maybe a Nothing getLayered :: MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered :: forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered Memory -> IO (Maybe a) f DatabaseReaderT m a g = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getReader :: Writer -> DatabaseReader getReader = DatabaseReader db, getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Memory -> IO (Maybe a) f Memory s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Just a x -> forall (m :: * -> *) a. Monad m => a -> m a return a x Maybe a Nothing -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT DatabaseReaderT m a g DatabaseReader db runWriter :: MonadIO m => DatabaseReader -> WriterT m a -> m a runWriter :: forall (m :: * -> *) a. MonadIO m => DatabaseReader -> WriterT m a -> m a runWriter bdb :: DatabaseReader bdb@DatabaseReader {databaseHandle :: DatabaseReader -> DB databaseHandle = DB db} WriterT m a f = do [(UnixTime, TxHash)] mempool <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a runReaderT forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)] getMempool DatabaseReader bdb Memory hm <- forall (m :: * -> *). MonadIO m => [(UnixTime, TxHash)] -> m Memory newMemory [(UnixTime, TxHash)] mempool a x <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a R.runReaderT WriterT m a f Writer {getReader :: DatabaseReader getReader = DatabaseReader bdb, getState :: Memory getState = Memory hm} [BatchOp] ops <- forall (m :: * -> *). MonadIO m => DB -> Memory -> m [BatchOp] hashMapOps DB db Memory hm forall (m :: * -> *). MonadIO m => DB -> [BatchOp] -> m () writeBatch DB db [BatchOp] ops forall (m :: * -> *) a. Monad m => a -> m a return a x hashMapOps :: MonadIO m => DB -> Memory -> m [BatchOp] hashMapOps :: forall (m :: * -> *). MonadIO m => DB -> Memory -> m [BatchOp] hashMapOps DB db Memory mem = forall a. Monoid a => [a] -> a mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence [ forall (m :: * -> *). MonadIO m => BestRef -> m [BatchOp] bestBlockOp (Memory -> BestRef hBest Memory mem), forall (m :: * -> *). MonadIO m => DB -> BlockTable -> m [BatchOp] blockHashOps DB db (Memory -> BlockTable hBlock Memory mem), forall (m :: * -> *). MonadIO m => DB -> HeightTable -> m [BatchOp] blockHeightOps DB db (Memory -> HeightTable hHeight Memory mem), forall (m :: * -> *). MonadIO m => DB -> TxTable -> m [BatchOp] txOps DB db (Memory -> TxTable hTx Memory mem), forall (m :: * -> *). MonadIO m => DB -> BalanceTable -> m [BatchOp] balOps DB db (Memory -> BalanceTable hBalance Memory mem), forall (m :: * -> *). MonadIO m => DB -> AddrTxTable -> m [BatchOp] addrTxOps DB db (Memory -> AddrTxTable hAddrTx Memory mem), forall (m :: * -> *). MonadIO m => DB -> AddrOutTable -> m [BatchOp] addrOutOps DB db (Memory -> AddrOutTable hAddrOut Memory mem), forall (m :: * -> *). MonadIO m => MempoolTable -> m [BatchOp] mempoolOp (Memory -> MempoolTable hMempool Memory mem), forall (m :: * -> *). MonadIO m => DB -> UnspentTable -> m [BatchOp] unspentOps DB db (Memory -> UnspentTable hUnspent Memory mem) ] bestBlockOp :: MonadIO m => BestRef -> m [BatchOp] bestBlockOp :: forall (m :: * -> *). MonadIO m => BestRef -> m [BatchOp] bestBlockOp BestRef r = forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef BestRef r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe (Maybe BlockHash) Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return [] Just Maybe BlockHash Nothing -> forall (m :: * -> *) a. Monad m => a -> m a return [forall key. (Key key, Serialize key) => key -> BatchOp deleteOp BestKey BestKey] Just (Just BlockHash b) -> forall (m :: * -> *) a. Monad m => a -> m a return [forall key value. (KeyValue key value, Serialize key, Serialize value) => key -> value -> BatchOp insertOp BestKey BestKey BlockHash b] blockHashOps :: MonadIO m => DB -> BlockTable -> m [BatchOp] blockHashOps :: forall (m :: * -> *). MonadIO m => DB -> BlockTable -> m [BatchOp] blockHashOps DB db BlockTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall {value}. (KeyValue BlockKey value, Serialize value) => BlockHash -> Maybe value -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList BlockTable t) where f :: BlockHash -> Maybe value -> BatchOp f BlockHash k (Just value d) = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily blockCF DB db) (BlockHash -> BlockKey BlockKey BlockHash k) value d f BlockHash k Maybe value Nothing = forall key. (Key key, Serialize key) => ColumnFamily -> key -> BatchOp deleteOpCF (DB -> ColumnFamily blockCF DB db) (BlockHash -> BlockKey BlockKey BlockHash k) blockHeightOps :: MonadIO m => DB -> HeightTable -> m [BatchOp] blockHeightOps :: forall (m :: * -> *). MonadIO m => DB -> HeightTable -> m [BatchOp] blockHeightOps DB db HeightTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry BlockHeight -> [BlockHash] -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList HeightTable t) where f :: BlockHeight -> [BlockHash] -> BatchOp f = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily heightCF DB db) forall b c a. (b -> c) -> (a -> b) -> a -> c . BlockHeight -> HeightKey HeightKey txOps :: MonadIO m => DB -> TxTable -> m [BatchOp] txOps :: forall (m :: * -> *). MonadIO m => DB -> TxTable -> m [BatchOp] txOps DB db TxTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall {value}. (KeyValue TxKey value, Serialize value) => TxHash -> Maybe value -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList TxTable t) where f :: TxHash -> Maybe value -> BatchOp f TxHash k (Just value t) = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily txCF DB db) (TxHash -> TxKey TxKey TxHash k) value t f TxHash k Maybe value Nothing = forall key. (Key key, Serialize key) => ColumnFamily -> key -> BatchOp deleteOpCF (DB -> ColumnFamily txCF DB db) (TxHash -> TxKey TxKey TxHash k) balOps :: MonadIO m => DB -> BalanceTable -> m [BatchOp] balOps :: forall (m :: * -> *). MonadIO m => DB -> BalanceTable -> m [BatchOp] balOps DB db BalanceTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry Address -> Maybe Balance -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList BalanceTable t) where f :: Address -> Maybe Balance -> BatchOp f Address a (Just Balance b) = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily balanceCF DB db) (Address -> BalKey BalKey Address a) (Balance -> BalVal balanceToVal Balance b) f Address a Maybe Balance Nothing = forall key. (Key key, Serialize key) => ColumnFamily -> key -> BatchOp deleteOpCF (DB -> ColumnFamily balanceCF DB db) (Address -> BalKey BalKey Address a) addrTxOps :: MonadIO m => DB -> AddrTxTable -> m [BatchOp] addrTxOps :: forall (m :: * -> *). MonadIO m => DB -> AddrTxTable -> m [BatchOp] addrTxOps DB db AddrTxTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry (Address, TxRef) -> Maybe () -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList AddrTxTable t) where f :: (Address, TxRef) -> Maybe () -> BatchOp f (Address a, TxRef t) (Just ()) = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily addrTxCF DB db) (Address -> TxRef -> AddrTxKey AddrTxKey Address a TxRef t) () f (Address a, TxRef t) Maybe () Nothing = forall key. (Key key, Serialize key) => ColumnFamily -> key -> BatchOp deleteOpCF (DB -> ColumnFamily addrTxCF DB db) (Address -> TxRef -> AddrTxKey AddrTxKey Address a TxRef t) addrOutOps :: MonadIO m => DB -> AddrOutTable -> m [BatchOp] addrOutOps :: forall (m :: * -> *). MonadIO m => DB -> AddrOutTable -> m [BatchOp] addrOutOps DB db AddrOutTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry forall {value}. (KeyValue AddrOutKey value, Serialize value) => (Address, BlockRef, OutPoint) -> Maybe value -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList AddrOutTable t) where f :: (Address, BlockRef, OutPoint) -> Maybe value -> BatchOp f (Address a, BlockRef b, OutPoint p) (Just value l) = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily addrOutCF DB db) ( AddrOutKey { addrOutKeyA :: Address addrOutKeyA = Address a, addrOutKeyB :: BlockRef addrOutKeyB = BlockRef b, addrOutKeyP :: OutPoint addrOutKeyP = OutPoint p } ) value l f (Address a, BlockRef b, OutPoint p) Maybe value Nothing = forall key. (Key key, Serialize key) => ColumnFamily -> key -> BatchOp deleteOpCF (DB -> ColumnFamily addrOutCF DB db) AddrOutKey { addrOutKeyA :: Address addrOutKeyA = Address a, addrOutKeyB :: BlockRef addrOutKeyB = BlockRef b, addrOutKeyP :: OutPoint addrOutKeyP = OutPoint p } mempoolOp :: MonadIO m => MempoolTable -> m [BatchOp] mempoolOp :: forall (m :: * -> *). MonadIO m => MempoolTable -> m [BatchOp] mempoolOp MempoolTable t = forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . forall key value. (KeyValue key value, Serialize key, Serialize value) => key -> value -> BatchOp insertOp MemKey MemKey forall b c a. (b -> c) -> (a -> b) -> a -> c . forall b a. Ord b => (a -> b) -> [a] -> [a] sortOn forall a. a -> Down a Down forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> (b, a) swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList MempoolTable t) unspentOps :: MonadIO m => DB -> UnspentTable -> m [BatchOp] unspentOps :: forall (m :: * -> *). MonadIO m => DB -> UnspentTable -> m [BatchOp] unspentOps DB db UnspentTable t = forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry OutPoint -> Maybe Unspent -> BatchOp f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList UnspentTable t) where f :: OutPoint -> Maybe Unspent -> BatchOp f OutPoint p (Just Unspent u) = forall key value. (KeyValue key value, Serialize key, Serialize value) => ColumnFamily -> key -> value -> BatchOp insertOpCF (DB -> ColumnFamily unspentCF DB db) (OutPoint -> UnspentKey UnspentKey OutPoint p) (forall a b. (a, b) -> b snd (Unspent -> (OutPoint, UnspentVal) unspentToVal Unspent u)) f OutPoint p Maybe Unspent Nothing = forall key. (Key key, Serialize key) => ColumnFamily -> key -> BatchOp deleteOpCF (DB -> ColumnFamily unspentCF DB db) (OutPoint -> UnspentKey UnspentKey OutPoint p) getNetworkI :: MonadIO m => WriterT m Network getNetworkI :: forall (m :: * -> *). MonadIO m => WriterT m Network getNetworkI = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c . Memory -> NetRef hNet) forall (m :: * -> *). StoreReadBase m => m Network getNetwork getBestBlockI :: MonadIO m => WriterT m (Maybe BlockHash) getBestBlockI :: forall (m :: * -> *). MonadIO m => WriterT m (Maybe BlockHash) getBestBlockI = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered Memory -> IO (Maybe (Maybe BlockHash)) getBestBlockH forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash) getBestBlock getBlocksAtHeightI :: MonadIO m => BlockHeight -> WriterT m [BlockHash] getBlocksAtHeightI :: forall (m :: * -> *). MonadIO m => BlockHeight -> WriterT m [BlockHash] getBlocksAtHeightI BlockHeight bh = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (BlockHeight -> Memory -> IO (Maybe [BlockHash]) getBlocksAtHeightH BlockHeight bh) (forall (m :: * -> *). StoreReadBase m => BlockHeight -> m [BlockHash] getBlocksAtHeight BlockHeight bh) getBlockI :: MonadIO m => BlockHash -> WriterT m (Maybe BlockData) getBlockI :: forall (m :: * -> *). MonadIO m => BlockHash -> WriterT m (Maybe BlockData) getBlockI BlockHash bh = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (BlockHash -> Memory -> IO (Maybe (Maybe BlockData)) getBlockH BlockHash bh) (forall (m :: * -> *). StoreReadBase m => BlockHash -> m (Maybe BlockData) getBlock BlockHash bh) getTxDataI :: MonadIO m => TxHash -> WriterT m (Maybe TxData) getTxDataI :: forall (m :: * -> *). MonadIO m => TxHash -> WriterT m (Maybe TxData) getTxDataI TxHash th = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (TxHash -> Memory -> IO (Maybe (Maybe TxData)) getTxDataH TxHash th) (forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData) getTxData TxHash th) getSpenderI :: MonadIO m => OutPoint -> WriterT m (Maybe Spender) getSpenderI :: forall (m :: * -> *). MonadIO m => OutPoint -> WriterT m (Maybe Spender) getSpenderI OutPoint op = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (OutPoint -> Memory -> IO (Maybe (Maybe Spender)) getSpenderH OutPoint op) (forall (m :: * -> *). StoreReadBase m => OutPoint -> m (Maybe Spender) getSpender OutPoint op) getBalanceI :: MonadIO m => Address -> WriterT m (Maybe Balance) getBalanceI :: forall (m :: * -> *). MonadIO m => Address -> WriterT m (Maybe Balance) getBalanceI Address a = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (Address -> Memory -> IO (Maybe (Maybe Balance)) getBalanceH Address a) (forall (m :: * -> *). StoreReadBase m => Address -> m (Maybe Balance) getBalance Address a) getUnspentI :: MonadIO m => OutPoint -> WriterT m (Maybe Unspent) getUnspentI :: forall (m :: * -> *). MonadIO m => OutPoint -> WriterT m (Maybe Unspent) getUnspentI OutPoint op = forall (m :: * -> *) a. MonadIO m => (Memory -> IO (Maybe a)) -> DatabaseReaderT m a -> WriterT m a getLayered (OutPoint -> Memory -> IO (Maybe (Maybe Unspent)) getUnspentH OutPoint op) (forall (m :: * -> *). StoreReadBase m => OutPoint -> m (Maybe Unspent) getUnspent OutPoint op) getMempoolI :: MonadIO m => WriterT m [(UnixTime, TxHash)] getMempoolI :: forall (m :: * -> *). MonadIO m => WriterT m [(UnixTime, TxHash)] getMempoolI = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a ReaderT forall a b. (a -> b) -> a -> b $ \Writer {getState :: Writer -> Memory getState = Memory s} -> forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> (b, a) swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList (Memory -> MempoolTable hMempool Memory s) newMemory :: MonadIO m => [(UnixTime, TxHash)] -> m Memory newMemory :: forall (m :: * -> *). MonadIO m => [(UnixTime, TxHash)] -> m Memory newMemory [(UnixTime, TxHash)] mempool = do NetRef hNet <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef forall a. Maybe a Nothing BestRef hBest <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a) newIORef forall a. Maybe a Nothing HashTable RealWorld BlockHash (Maybe BlockData) hBlock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld BlockHeight [BlockHash] hHeight <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld TxHash (Maybe TxData) hTx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld OutPoint (Maybe Unspent) hUnspent <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld Address (Maybe Balance) hBalance <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld (Address, TxRef) (Maybe ()) hAddrTx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal) hAddrOut <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new HashTable RealWorld TxHash UnixTime hMempool <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => [(k, v)] -> IO (IOHashTable h k v) H.fromList (forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> (b, a) swap [(UnixTime, TxHash)] mempool) forall (m :: * -> *) a. Monad m => a -> m a return Memory {BestRef NetRef HashTable RealWorld BlockHeight [BlockHash] HashTable RealWorld (Address, TxRef) (Maybe ()) HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal) HashTable RealWorld Address (Maybe Balance) HashTable RealWorld BlockHash (Maybe BlockData) HashTable RealWorld OutPoint (Maybe Unspent) HashTable RealWorld TxHash (Maybe TxData) HashTable RealWorld TxHash UnixTime hMempool :: HashTable RealWorld TxHash UnixTime hAddrOut :: HashTable RealWorld (Address, BlockRef, OutPoint) (Maybe OutVal) hAddrTx :: HashTable RealWorld (Address, TxRef) (Maybe ()) hBalance :: HashTable RealWorld Address (Maybe Balance) hUnspent :: HashTable RealWorld OutPoint (Maybe Unspent) hTx :: HashTable RealWorld TxHash (Maybe TxData) hHeight :: HashTable RealWorld BlockHeight [BlockHash] hBlock :: HashTable RealWorld BlockHash (Maybe BlockData) hBest :: BestRef hNet :: NetRef hMempool :: MempoolTable hAddrOut :: AddrOutTable hAddrTx :: AddrTxTable hBalance :: BalanceTable hUnspent :: UnspentTable hTx :: TxTable hHeight :: HeightTable hBlock :: BlockTable hBest :: BestRef hNet :: NetRef ..} getBestBlockH :: Memory -> IO (Maybe (Maybe BlockHash)) getBestBlockH :: Memory -> IO (Maybe (Maybe BlockHash)) getBestBlockH = forall (m :: * -> *) a. MonadIO m => IORef a -> m a readIORef forall b c a. (b -> c) -> (a -> b) -> a -> c . Memory -> BestRef hBest getBlocksAtHeightH :: BlockHeight -> Memory -> IO (Maybe [BlockHash]) getBlocksAtHeightH :: BlockHeight -> Memory -> IO (Maybe [BlockHash]) getBlocksAtHeightH BlockHeight h Memory s = forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO (Maybe v) H.lookup (Memory -> HeightTable hHeight Memory s) BlockHeight h getBlockH :: BlockHash -> Memory -> IO (Maybe (Maybe BlockData)) getBlockH :: BlockHash -> Memory -> IO (Maybe (Maybe BlockData)) getBlockH BlockHash h Memory s = forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO (Maybe v) H.lookup (Memory -> BlockTable hBlock Memory s) BlockHash h getTxDataH :: TxHash -> Memory -> IO (Maybe (Maybe TxData)) getTxDataH :: TxHash -> Memory -> IO (Maybe (Maybe TxData)) getTxDataH TxHash t Memory s = forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO (Maybe v) H.lookup (Memory -> TxTable hTx Memory s) TxHash t getSpenderH :: OutPoint -> Memory -> IO (Maybe (Maybe Spender)) getSpenderH :: OutPoint -> Memory -> IO (Maybe (Maybe Spender)) getSpenderH OutPoint op Memory s = do forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall (m :: * -> *) a. Monad m => m (m a) -> m a join forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap TxData -> Maybe Spender f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TxHash -> Memory -> IO (Maybe (Maybe TxData)) getTxDataH (OutPoint -> TxHash outPointHash OutPoint op) Memory s where f :: TxData -> Maybe Spender f = forall a. Key -> IntMap a -> Maybe a IntMap.lookup (forall a b. (Integral a, Num b) => a -> b fromIntegral (OutPoint -> BlockHeight outPointIndex OutPoint op)) forall b c a. (b -> c) -> (a -> b) -> a -> c . TxData -> IntMap Spender txDataSpenders getBalanceH :: Address -> Memory -> IO (Maybe (Maybe Balance)) getBalanceH :: Address -> Memory -> IO (Maybe (Maybe Balance)) getBalanceH Address a Memory s = forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO (Maybe v) H.lookup (Memory -> BalanceTable hBalance Memory s) Address a getMempoolH :: Memory -> IO [(UnixTime, TxHash)] getMempoolH :: Memory -> IO [(UnixTime, TxHash)] getMempoolH Memory s = forall b a. Ord b => (a -> b) -> [a] -> [a] sortOn forall a. a -> Down a Down forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> (b, a) swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> IO [(k, v)] H.toList (Memory -> MempoolTable hMempool Memory s) getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent)) getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent)) getUnspentH OutPoint p Memory s = forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO (Maybe v) H.lookup (Memory -> UnspentTable hUnspent Memory s) OutPoint p