diff --git a/haskoin-store.cabal b/haskoin-store.cabal --- a/haskoin-store.cabal +++ b/haskoin-store.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 32be1f4a3da179a635d98745d8b60cd57647439c7d934b319b38e5e3d370e336 +-- hash: b813ab65689ab034b88aea9ae3e0c2745ba68a5df6f022afb2162a18d3ac88d7 name: haskoin-store -version: 0.29.0 +version: 0.29.1 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store and index Bitcoin or Bitcoin Cash blocks, transactions, balances and unspent outputs. All data is available via REST API in JSON or binary format. @@ -57,7 +57,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.3 , haskoin-node >=0.13.0 - , haskoin-store-data ==0.29.0 + , haskoin-store-data ==0.29.1 , hedis >=0.12.13 , http-types >=0.12.3 , monad-logger >=0.3.32 @@ -99,7 +99,7 @@ , haskoin-core >=0.13.3 , haskoin-node >=0.13.0 , haskoin-store - , haskoin-store-data ==0.29.0 + , haskoin-store-data ==0.29.1 , monad-logger >=0.3.32 , mtl >=2.2.2 , nqe >=0.6.1 @@ -149,7 +149,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.3 , haskoin-node >=0.13.0 - , haskoin-store-data ==0.29.0 + , haskoin-store-data ==0.29.1 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3 diff --git a/src/Haskoin/Store/BlockStore.hs b/src/Haskoin/Store/BlockStore.hs --- a/src/Haskoin/Store/BlockStore.hs +++ b/src/Haskoin/Store/BlockStore.hs @@ -176,7 +176,7 @@ ReaderT $ \BlockRead {myConfig = BlockStoreConfig {blockConfDB = db}} -> runReaderT f db -instance MonadIO m => StoreRead (ReaderT BlockRead m) where +instance MonadUnliftIO m => StoreRead (ReaderT BlockRead m) where getMaxGap = runRocksDB getMaxGap getInitialGap = runRocksDB getInitialGap getNetwork = runRocksDB getNetwork diff --git a/src/Haskoin/Store/Common.hs b/src/Haskoin/Store/Common.hs --- a/src/Haskoin/Store/Common.hs +++ b/src/Haskoin/Store/Common.hs @@ -51,13 +51,14 @@ txHash) import Haskoin.Node (Peer) import Haskoin.Store.Data (Balance (..), BlockData (..), - TxRef (..), DeriveType (..), - Spender, Transaction, TxData, + DeriveType (..), Spender, + Transaction, TxData, TxRef (..), UnixTime, Unspent (..), XPubBal (..), XPubSpec (..), XPubSummary (..), XPubUnspent (..), nullBalance, toTransaction) import Network.Socket (SockAddr) +import UnliftIO (MonadUnliftIO, async, wait) type DeriveAddr = XPubKey -> KeyIndex -> Address @@ -85,7 +86,7 @@ instance Default Limits where def = defaultLimits -class Monad m => +class MonadUnliftIO m => StoreRead m where getNetwork :: m Network @@ -110,13 +111,13 @@ xPubBals :: XPubSpec -> m [XPubBal] xPubBals xpub = do igap <- getInitialGap - gap <- getMaxGap - ext1 <- derive_until_gap gap 0 (take (fromIntegral igap) (aderiv 0 0)) + gap <- fromIntegral <$> getMaxGap + ext1 <- go gap 0 0 0 [] (take (fromIntegral igap) (aderiv 0 0)) if all (nullBalance . xPubBal) ext1 then return [] else do - ext2 <- derive_until_gap gap 0 (aderiv 0 igap) - chg <- derive_until_gap gap 1 (aderiv 1 0) + ext2 <- go gap 0 igap 0 [] (aderiv 0 igap) + chg <- go gap 1 0 0 [] (aderiv 1 0) return (ext1 <> ext2 <> chg) where aderiv m n = @@ -124,15 +125,22 @@ (deriveFunction (xPubDeriveType xpub)) (pubSubKey (xPubSpecKey xpub) m) n - xbalance m b n = XPubBal {xPubBalPath = [m, n], xPubBal = b} - derive_until_gap _ _ [] = return [] - derive_until_gap gap m as = do - let (as1, as2) = splitAt (fromIntegral gap) as - bs <- getBalances (map snd as1) - let xbs = zipWith (xbalance m) bs (map fst as1) - if all nullBalance bs - then return xbs - else (xbs <>) <$> derive_until_gap gap m as2 + xbal m n b = XPubBal {xPubBalPath = [m, n], xPubBal = b} + go _gap _m _n _z [] [] = return [] + go gap m n z ls as + | z >= gap = return [] + | not (null as) && length ls < gap = do + let (as1, as2) = splitAt (gap - length ls) as + ls2 <- mapM (async . getBalance) (map snd as1) + go gap m n z (ls <> ls2) as2 + | otherwise = do + let (l:ls2) = ls + b <- wait l + let z' = + if nullBalance b + then z + 1 + else 0 + (xbal m n b :) <$> go gap m (n + 1) z' ls2 as xPubSummary :: XPubSpec -> m XPubSummary xPubSummary xpub = do bs <- filter (not . nullBalance . xPubBal) <$> xPubBals xpub @@ -163,24 +171,37 @@ xPubUnspents :: XPubSpec -> Limits -> m [XPubUnspent] xPubUnspents xpub limits = do xs <- filter positive <$> xPubBals xpub - sortBy (compare `on` unsblock) . applyLimits limits <$> go xs + as <- + mapM + (async . + (`getAddressUnspents` deOffset limits) . + balanceAddress . xPubBal) + xs + sortBy (compare `on` unsblock) . applyLimits limits <$> go (zip xs as) where unsblock = unspentBlock . xPubUnspent positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0 go [] = return [] - go (XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}}:xs) = do - uns <- getAddressUnspents a (deOffset limits) + go ((xbal, a'):xs) = do + uns <- wait a' let xuns = map (\t -> - XPubUnspent {xPubUnspentPath = p, xPubUnspent = t}) + XPubUnspent + { xPubUnspentPath = xPubBalPath xbal + , xPubUnspent = t + }) uns (xuns <>) <$> go xs xPubTxs :: XPubSpec -> Limits -> m [TxRef] xPubTxs xpub limits = do bs <- xPubBals xpub - let as = map (balanceAddress . xPubBal) bs - ts <- concat <$> mapM (\a -> getAddressTxs a (deOffset limits)) as + as <- + mapM + (async . + (`getAddressTxs` deOffset limits) . balanceAddress . xPubBal) + bs + ts <- concat <$> mapM wait as let ts' = sortBy (flip compare `on` txRefBlock) (nub' ts) return $ applyLimits limits ts' getMaxGap :: m Word32 diff --git a/src/Haskoin/Store/Database/Memory.hs b/src/Haskoin/Store/Database/Memory.hs --- a/src/Haskoin/Store/Database/Memory.hs +++ b/src/Haskoin/Store/Database/Memory.hs @@ -222,7 +222,7 @@ (hUnspent db) } -instance MonadIO m => StoreRead (ReaderT MemoryState m) where +instance MonadUnliftIO m => StoreRead (ReaderT MemoryState m) where getBestBlock = do v <- R.asks memoryDatabase >>= readTVarIO return $ getBestBlockH v diff --git a/src/Haskoin/Store/Database/Reader.hs b/src/Haskoin/Store/Database/Reader.hs --- a/src/Haskoin/Store/Database/Reader.hs +++ b/src/Haskoin/Store/Database/Reader.hs @@ -40,7 +40,7 @@ TxKey (..), UnspentKey (..), VersionKey (..), toUnspent, valToBalance, valToUnspent) -import UnliftIO (MonadIO, liftIO) +import UnliftIO (MonadUnliftIO, MonadIO, liftIO) type DatabaseReaderT = ReaderT DatabaseReader @@ -224,7 +224,7 @@ matchingSkip db opts (AddrOutKeyA a) (AddrOutKeyB a b) _ -> matching db opts (AddrOutKeyA a) -instance MonadIO m => StoreRead (DatabaseReaderT m) where +instance MonadUnliftIO m => StoreRead (DatabaseReaderT m) where getNetwork = asks databaseNetwork getBestBlock = ask >>= getBestDatabaseReader getBlocksAtHeight h = ask >>= getBlocksAtHeightDB h diff --git a/src/Haskoin/Store/Database/Writer.hs b/src/Haskoin/Store/Database/Writer.hs --- a/src/Haskoin/Store/Database/Writer.hs +++ b/src/Haskoin/Store/Database/Writer.hs @@ -25,8 +25,8 @@ OutPoint (..), TxHash) import Haskoin.Store.Common (StoreRead (..), StoreWrite (..)) import Haskoin.Store.Data (Balance, BlockData, - BlockRef (..), TxRef (..), - Spender, TxData, Unspent, + BlockRef (..), Spender, TxData, + TxRef (..), Unspent, nullBalance, zeroBalance) import Haskoin.Store.Database.Memory (MemoryDatabase (..), MemoryState (..), @@ -43,7 +43,8 @@ OutVal, SpenderKey (..), TxKey (..), UnspentKey (..), UnspentVal (..)) -import UnliftIO (MonadIO, newTVarIO, readTVarIO) +import UnliftIO (MonadIO, MonadUnliftIO, + newTVarIO, readTVarIO) data DatabaseWriter = DatabaseWriter { databaseWriterReader :: !DatabaseReader @@ -218,48 +219,58 @@ setMempoolI :: MonadIO m => [TxRef] -> DatabaseWriter -> m () setMempoolI xs DatabaseWriter {databaseWriterState = hm} = withMemoryDatabase hm $ setMempool xs -getBestBlockI :: MonadIO m => DatabaseWriter -> m (Maybe BlockHash) +getBestBlockI :: MonadUnliftIO m => DatabaseWriter -> m (Maybe BlockHash) getBestBlockI DatabaseWriter {databaseWriterState = hm, databaseWriterReader = db} = runMaybeT $ MaybeT f <|> MaybeT g where f = withMemoryDatabase hm getBestBlock g = withDatabaseReader db getBestBlock -getBlocksAtHeightI :: MonadIO m => BlockHeight -> DatabaseWriter -> m [BlockHash] -getBlocksAtHeightI bh DatabaseWriter {databaseWriterState = hm, databaseWriterReader = db} = do +getBlocksAtHeightI :: + MonadUnliftIO m => BlockHeight -> DatabaseWriter -> m [BlockHash] +getBlocksAtHeightI bh DatabaseWriter { databaseWriterState = hm + , databaseWriterReader = db + } = do xs <- withMemoryDatabase hm $ getBlocksAtHeight bh ys <- withDatabaseReader db $ getBlocksAtHeight bh return . nub $ xs <> ys -getBlockI :: MonadIO m => BlockHash -> DatabaseWriter -> m (Maybe BlockData) -getBlockI bh DatabaseWriter {databaseWriterReader = db, databaseWriterState = hm} = - runMaybeT $ MaybeT f <|> MaybeT g +getBlockI :: + MonadUnliftIO m => BlockHash -> DatabaseWriter -> m (Maybe BlockData) +getBlockI bh DatabaseWriter { databaseWriterReader = db + , databaseWriterState = hm + } = runMaybeT $ MaybeT f <|> MaybeT g where f = withMemoryDatabase hm $ getBlock bh g = withDatabaseReader db $ getBlock bh -getTxDataI :: - MonadIO m => TxHash -> DatabaseWriter -> m (Maybe TxData) -getTxDataI th DatabaseWriter {databaseWriterReader = db, databaseWriterState = hm} = - runMaybeT $ MaybeT f <|> MaybeT g +getTxDataI :: MonadUnliftIO m => TxHash -> DatabaseWriter -> m (Maybe TxData) +getTxDataI th DatabaseWriter { databaseWriterReader = db + , databaseWriterState = hm + } = runMaybeT $ MaybeT f <|> MaybeT g where f = withMemoryDatabase hm $ getTxData th g = withDatabaseReader db $ getTxData th -getSpenderI :: MonadIO m => OutPoint -> DatabaseWriter -> m (Maybe Spender) -getSpenderI op DatabaseWriter {databaseWriterReader = db, databaseWriterState = hm} = - fmap join . runMaybeT $ MaybeT f <|> MaybeT g +getSpenderI :: + MonadUnliftIO m => OutPoint -> DatabaseWriter -> m (Maybe Spender) +getSpenderI op DatabaseWriter { databaseWriterReader = db + , databaseWriterState = hm + } = fmap join . runMaybeT $ MaybeT f <|> MaybeT g where f = getSpenderH op <$> readTVarIO (memoryDatabase hm) g = Just <$> withDatabaseReader db (getSpender op) -getSpendersI :: MonadIO m => TxHash -> DatabaseWriter -> m (IntMap Spender) -getSpendersI t DatabaseWriter {databaseWriterReader = db, databaseWriterState = hm} = do +getSpendersI :: + MonadUnliftIO m => TxHash -> DatabaseWriter -> m (IntMap Spender) +getSpendersI t DatabaseWriter { databaseWriterReader = db + , databaseWriterState = hm + } = do hsm <- getSpendersH t <$> readTVarIO (memoryDatabase hm) dsm <- I.map Just <$> withDatabaseReader db (getSpenders t) return . I.map fromJust . I.filter isJust $ hsm <> dsm -getBalanceI :: MonadIO m => Address -> DatabaseWriter -> m Balance +getBalanceI :: MonadUnliftIO m => Address -> DatabaseWriter -> m Balance getBalanceI a DatabaseWriter { databaseWriterReader = db , databaseWriterState = hm } = @@ -284,7 +295,8 @@ setBalanceI b DatabaseWriter {databaseWriterState = hm} = withMemoryDatabase hm $ setBalance b -getUnspentI :: MonadIO m => OutPoint -> DatabaseWriter -> m (Maybe Unspent) +getUnspentI :: + MonadUnliftIO m => OutPoint -> DatabaseWriter -> m (Maybe Unspent) getUnspentI op DatabaseWriter { databaseWriterReader = db , databaseWriterState = hm } = fmap join . runMaybeT $ MaybeT f <|> MaybeT g @@ -301,7 +313,7 @@ withMemoryDatabase hm $ deleteUnspent p getMempoolI :: - MonadIO m + MonadUnliftIO m => DatabaseWriter -> m [TxRef] getMempoolI DatabaseWriter {databaseWriterState = hm, databaseWriterReader = db} = @@ -309,7 +321,7 @@ Just xs -> return xs Nothing -> withDatabaseReader db getMempool -instance MonadIO m => StoreRead (ReaderT DatabaseWriter m) where +instance MonadUnliftIO m => StoreRead (ReaderT DatabaseWriter m) where getInitialGap = R.asks (databaseInitialGap . databaseWriterReader) getNetwork = R.asks (databaseNetwork . databaseWriterReader) getBestBlock = R.ask >>= getBestBlockI diff --git a/src/Haskoin/Store/Logic.hs b/src/Haskoin/Store/Logic.hs --- a/src/Haskoin/Store/Logic.hs +++ b/src/Haskoin/Store/Logic.hs @@ -93,7 +93,7 @@ let f tx = map g (txOut tx) g to = case scriptToAddressBS (scriptOutput to) of - Left _ -> Nothing + Left _ -> Nothing Right a -> Just a oaddrs = catMaybes (concatMap f txs) balas' <- @@ -109,7 +109,9 @@ inops = filter (not . (`HashSet.member` newops) . outPointHash) - (concatMap (map prevOutput . txIn) txs) + (concatMap + (filter (not . (== nullOutPoint)) . map prevOutput . txIn) + txs) getAccelBalance :: (MonadUnliftIO m, StoreRead m) => BlockAccel -> Address -> m Balance diff --git a/src/Haskoin/Store/Web.hs b/src/Haskoin/Store/Web.hs --- a/src/Haskoin/Store/Web.hs +++ b/src/Haskoin/Store/Web.hs @@ -183,7 +183,7 @@ return StartParamTime {startParamTime = x} runInWebReader :: - MonadIO m + MonadUnliftIO m => CacheT (DatabaseReaderT m) a -> ReaderT WebConfig m a runInWebReader f = do @@ -218,27 +218,6 @@ xPubUnspents xpub = runInWebReader . xPubUnspents xpub xPubTxs xpub = runInWebReader . xPubTxs xpub -instance (MonadUnliftIO m, MonadLoggerIO m) => StoreRead (WebT m) where - getNetwork = lift getNetwork - getBestBlock = lift getBestBlock - getBlocksAtHeight = lift . getBlocksAtHeight - getBlock = lift . getBlock - getTxData = lift . getTxData - getSpender = lift . getSpender - getSpenders = lift . getSpenders - getUnspent = lift . getUnspent - getBalance = lift . getBalance - getBalances = lift . getBalances - getMempool = lift getMempool - getAddressesTxs as = lift . getAddressesTxs as - getAddressesUnspents as = lift . getAddressesUnspents as - xPubBals = lift . xPubBals - xPubSummary = lift . xPubSummary - xPubUnspents xpub = lift . xPubUnspents xpub - xPubTxs xpub = lift . xPubTxs xpub - getMaxGap = lift getMaxGap - getInitialGap = lift getInitialGap - defHandler :: Monad m => Except -> WebT m () defHandler e = do proto <- setupBin @@ -298,8 +277,8 @@ proto <- setupBin bm <- runMaybeT $ do - h <- MaybeT getBestBlock - MaybeT $ getBlock h + h <- MaybeT (lift getBestBlock) + MaybeT (lift (getBlock h)) b <- case bm of Nothing -> S.raise ThingNotFound @@ -307,7 +286,7 @@ if raw then do refuseLargeBlock limits b - rawBlock b >>= protoSerial proto + lift (rawBlock b) >>= protoSerial proto else protoSerialNet proto blockDataToEncoding (pruneTx n b) scottyBlock :: (MonadUnliftIO m, MonadLoggerIO m) => Bool -> WebT m () @@ -318,13 +297,13 @@ n <- parseNoTx proto <- setupBin b <- - getBlock block >>= \case + lift (getBlock block) >>= \case Nothing -> S.raise ThingNotFound Just b -> return b if raw then do refuseLargeBlock limits b - rawBlock b >>= protoSerial proto + lift (rawBlock b) >>= protoSerial proto else protoSerialNet proto blockDataToEncoding (pruneTx n b) scottyBlockHeight :: (MonadUnliftIO m, MonadLoggerIO m) => Bool -> WebT m () @@ -334,15 +313,15 @@ height <- S.param "height" n <- parseNoTx proto <- setupBin - hs <- getBlocksAtHeight height + hs <- lift (getBlocksAtHeight height) if raw then do - blocks <- catMaybes <$> mapM getBlock hs + blocks <- catMaybes <$> mapM (lift . getBlock) hs mapM_ (refuseLargeBlock limits) blocks - rawblocks <- mapM rawBlock blocks + rawblocks <- mapM (lift . rawBlock) blocks protoSerial proto rawblocks else do - blocks <- catMaybes <$> mapM getBlock hs + blocks <- catMaybes <$> mapM (lift . getBlock) hs let blocks' = map (pruneTx n) blocks protoSerialNet proto (list . blockDataToEncoding) blocks' @@ -353,14 +332,14 @@ q <- S.param "time" n <- parseNoTx proto <- setupBin - m <- fmap (pruneTx n) <$> blockAtOrBefore q + m <- fmap (pruneTx n) <$> lift (blockAtOrBefore q) if raw then maybeSerial proto =<< case m of Nothing -> return Nothing Just d -> do refuseLargeBlock limits d - Just <$> rawBlock d + Just <$> lift (rawBlock d) else maybeSerialNet proto blockDataToEncoding m scottyBlockHeights :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -369,8 +348,8 @@ heights <- S.param "heights" n <- parseNoTx proto <- setupBin - bhs <- concat <$> mapM getBlocksAtHeight (heights :: [BlockHeight]) - blocks <- map (pruneTx n) . catMaybes <$> mapM getBlock bhs + bhs <- concat <$> mapM (lift . getBlocksAtHeight) (heights :: [BlockHeight]) + blocks <- map (pruneTx n) . catMaybes <$> mapM (lift . getBlock) bhs protoSerialNet proto (list . blockDataToEncoding) blocks scottyBlockLatest :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -378,7 +357,7 @@ setHeaders n <- parseNoTx proto <- setupBin - getBestBlock >>= \case + lift getBestBlock >>= \case Just h -> do blocks <- reverse <$> go 100 n h protoSerialNet proto (list . blockDataToEncoding) blocks @@ -386,7 +365,7 @@ where go 0 _ _ = return [] go i n h = - getBlock h >>= \case + lift (getBlock h) >>= \case Nothing -> return [] Just b -> let b' = pruneTx n b @@ -403,14 +382,14 @@ bhs <- map (\(MyBlockHash h) -> h) <$> S.param "blocks" n <- parseNoTx proto <- setupBin - bks <- map (pruneTx n) . catMaybes <$> mapM getBlock (nub bhs) + bks <- map (pruneTx n) . catMaybes <$> mapM (lift . getBlock) (nub bhs) protoSerialNet proto (list . blockDataToEncoding) bks scottyMempool :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyMempool = do setHeaders proto <- setupBin - txs <- map txRefHash <$> getMempool + txs <- map txRefHash <$> lift getMempool protoSerial proto txs scottyTransaction :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -418,7 +397,7 @@ setHeaders MyTxHash txid <- S.param "txid" proto <- setupBin - res <- getTransaction txid + res <- lift (getTransaction txid) maybeSerialNet proto transactionToEncoding res scottyRawTransaction :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -426,7 +405,7 @@ setHeaders MyTxHash txid <- S.param "txid" proto <- setupBin - res <- fmap transactionData <$> getTransaction txid + res <- fmap transactionData <$> lift (getTransaction txid) maybeSerial proto res scottyTxAfterHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -435,7 +414,7 @@ MyTxHash txid <- S.param "txid" height <- S.param "height" proto <- setupBin - res <- cbAfterHeight 10000 height txid + res <- lift (cbAfterHeight 10000 height txid) protoSerial proto res scottyTransactions :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -443,7 +422,7 @@ setHeaders txids <- map (\(MyTxHash h) -> h) <$> S.param "txids" proto <- setupBin - txs <- catMaybes <$> mapM getTransaction (nub txids) + txs <- catMaybes <$> mapM (lift . getTransaction) (nub txids) protoSerialNet proto (list . transactionToEncoding) txs scottyBlockTransactions :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -452,11 +431,11 @@ setHeaders MyBlockHash h <- S.param "block" proto <- setupBin - getBlock h >>= \case + lift (getBlock h) >>= \case Just b -> do refuseLargeBlock limits b let ths = blockDataTxs b - txs <- catMaybes <$> mapM getTransaction ths + txs <- catMaybes <$> mapM (lift . getTransaction) ths protoSerialNet proto (list . transactionToEncoding) txs Nothing -> S.raise ThingNotFound @@ -466,7 +445,9 @@ setHeaders txids <- map (\(MyTxHash h) -> h) <$> S.param "txids" proto <- setupBin - txs <- map transactionData . catMaybes <$> mapM getTransaction (nub txids) + txs <- + map transactionData . catMaybes <$> + mapM (lift . getTransaction) (nub txids) protoSerial proto txs rawBlock :: (Monad m, StoreRead m) => BlockData -> m Block @@ -483,11 +464,13 @@ setHeaders MyBlockHash h <- S.param "block" proto <- setupBin - getBlock h >>= \case + lift (getBlock h) >>= \case Just b -> do refuseLargeBlock limits b let ths = blockDataTxs b - txs <- map transactionData . catMaybes <$> mapM getTransaction ths + txs <- + map transactionData . catMaybes <$> + mapM (lift . getTransaction) ths protoSerial proto txs Nothing -> S.raise ThingNotFound @@ -499,10 +482,10 @@ proto <- setupBin if full then do - getAddressTxsFull l a >>= + lift (getAddressTxsFull l a) >>= protoSerialNet proto (list . transactionToEncoding) else do - getAddressTxsLimit l a >>= protoSerial proto + lift (getAddressTxsLimit l a) >>= protoSerial proto scottyAddressesTxs :: (MonadUnliftIO m, MonadLoggerIO m) => Bool -> WebT m () @@ -512,9 +495,9 @@ l <- getLimits full proto <- setupBin if full - then getAddressesTxsFull l as >>= + then lift (getAddressesTxsFull l as) >>= protoSerialNet proto (list . transactionToEncoding) - else getAddressesTxsLimit l as >>= protoSerial proto + else lift (getAddressesTxsLimit l as) >>= protoSerial proto scottyAddressUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyAddressUnspent = do @@ -522,7 +505,7 @@ a <- parseAddress l <- getLimits False proto <- setupBin - uns <- getAddressUnspentsLimit l a + uns <- lift (getAddressUnspentsLimit l a) protoSerialNet proto (list . unspentToEncoding) uns scottyAddressesUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -531,7 +514,7 @@ as <- parseAddresses l <- getLimits False proto <- setupBin - uns <- getAddressesUnspentsLimit l as + uns <- lift (getAddressesUnspentsLimit l as) protoSerialNet proto (list . unspentToEncoding) uns scottyAddressBalance :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -539,7 +522,7 @@ setHeaders a <- parseAddress proto <- setupBin - res <- getBalance a + res <- lift (getBalance a) protoSerialNet proto balanceToEncoding res scottyAddressesBalances :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -547,7 +530,7 @@ setHeaders as <- parseAddresses proto <- setupBin - res <- getBalances as + res <- lift (getBalances as) protoSerialNet proto (list . balanceToEncoding) res scottyXpubBalances :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () @@ -759,16 +742,16 @@ where start_height h = return $ AtBlock h start_block h = do - b <- MaybeT $ getBlock (BlockHash h) + b <- MaybeT $ lift (getBlock (BlockHash h)) return $ AtBlock (blockDataHeight b) start_tx h = do - _ <- MaybeT $ getTxData (TxHash h) + _ <- MaybeT $ lift (getTxData (TxHash h)) return $ AtTx (TxHash h) start_time q = do - d <- MaybeT getBestBlock >>= MaybeT . getBlock + d <- MaybeT (lift getBestBlock) >>= MaybeT . lift . getBlock if q <= fromIntegral (blockTimestamp (blockDataHeader d)) then do - b <- MaybeT $ blockAtOrBefore q + b <- MaybeT (lift (blockAtOrBefore q)) let g = blockDataHeight b return $ AtBlock g else mzero