{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module Haskoin.Store.Logic
( ImportException (..)
, MonadImport
, initBest
, revertBlock
, importBlock
, newMempoolTx
, deleteUnconfirmedTx
, streamThings
, joinStreams
) where
import Conduit (ConduitT, await, lift, sealConduitT,
yield, ($$++))
import Control.Monad (forM, forM_, guard, unless, void, when,
zipWithM_)
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.Logger (MonadLoggerIO (..), logDebugS,
logErrorS)
import qualified Data.ByteString as B
import qualified Data.ByteString.Short as B.Short
import Data.Either (rights)
import Data.Function (on)
import qualified Data.IntMap.Strict as I
import Data.List (nub, sortBy)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing,
mapMaybe)
import Data.Serialize (encode)
import Data.Word (Word32, Word64)
import Haskoin (Address, Block (..), BlockHash,
BlockHeader (..), BlockNode (..),
Network (..), OutPoint (..), Tx (..),
TxHash, TxIn (..), TxOut (..),
blockHashToHex, computeSubsidy,
eitherToMaybe, genesisBlock,
genesisNode, headerHash, isGenesis,
nullOutPoint, scriptToAddressBS, txHash,
txHashToHex)
import Haskoin.Store.Common
import Haskoin.Store.Data (Balance (..), BlockData (..),
BlockRef (..), Prev (..), Spender (..),
TxData (..), TxRef (..), UnixTime,
Unspent (..), confirmed)
import UnliftIO (Exception)
type MonadImport m =
( MonadError ImportException m
, MonadLoggerIO m
, StoreReadBase m
, StoreWrite m
)
data ImportException
= PrevBlockNotBest
| Orphan
| UnexpectedCoinbase
| BestBlockNotFound
| BlockNotBest
| TxNotFound
| DoubleSpend
| TxConfirmed
| InsufficientFunds
| DuplicatePrevOutput
| TxSpent
| OrphanLoop
deriving (ImportException -> ImportException -> Bool
(ImportException -> ImportException -> Bool)
-> (ImportException -> ImportException -> Bool)
-> Eq ImportException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportException -> ImportException -> Bool
$c/= :: ImportException -> ImportException -> Bool
== :: ImportException -> ImportException -> Bool
$c== :: ImportException -> ImportException -> Bool
Eq, Eq ImportException
Eq ImportException =>
(ImportException -> ImportException -> Ordering)
-> (ImportException -> ImportException -> Bool)
-> (ImportException -> ImportException -> Bool)
-> (ImportException -> ImportException -> Bool)
-> (ImportException -> ImportException -> Bool)
-> (ImportException -> ImportException -> ImportException)
-> (ImportException -> ImportException -> ImportException)
-> Ord ImportException
ImportException -> ImportException -> Bool
ImportException -> ImportException -> Ordering
ImportException -> ImportException -> ImportException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ImportException -> ImportException -> ImportException
$cmin :: ImportException -> ImportException -> ImportException
max :: ImportException -> ImportException -> ImportException
$cmax :: ImportException -> ImportException -> ImportException
>= :: ImportException -> ImportException -> Bool
$c>= :: ImportException -> ImportException -> Bool
> :: ImportException -> ImportException -> Bool
$c> :: ImportException -> ImportException -> Bool
<= :: ImportException -> ImportException -> Bool
$c<= :: ImportException -> ImportException -> Bool
< :: ImportException -> ImportException -> Bool
$c< :: ImportException -> ImportException -> Bool
compare :: ImportException -> ImportException -> Ordering
$ccompare :: ImportException -> ImportException -> Ordering
$cp1Ord :: Eq ImportException
Ord, Show ImportException
Typeable ImportException
(Typeable ImportException, Show ImportException) =>
(ImportException -> SomeException)
-> (SomeException -> Maybe ImportException)
-> (ImportException -> String)
-> Exception ImportException
SomeException -> Maybe ImportException
ImportException -> String
ImportException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
displayException :: ImportException -> String
$cdisplayException :: ImportException -> String
fromException :: SomeException -> Maybe ImportException
$cfromException :: SomeException -> Maybe ImportException
toException :: ImportException -> SomeException
$ctoException :: ImportException -> SomeException
$cp2Exception :: Show ImportException
$cp1Exception :: Typeable ImportException
Exception)
instance Show ImportException where
show :: ImportException -> String
show PrevBlockNotBest = "Previous block not best"
show Orphan = "Orphan"
show UnexpectedCoinbase = "Unexpected coinbase"
show BestBlockNotFound = "Best block not found"
show BlockNotBest = "Block not best"
show TxNotFound = "Transaction not found"
show DoubleSpend = "Double spend"
show TxConfirmed = "Transaction confirmed"
show InsufficientFunds = "Insufficient funds"
show DuplicatePrevOutput = "Duplicate previous output"
show TxSpent = "Transaction is spent"
show OrphanLoop = "Orphan loop"
initBest :: MonadImport m => m ()
initBest :: m ()
initBest = do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
logDebugS) "BlockStore" "Initializing best block"
Network
net <- m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
Maybe BlockHash
m <- m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe BlockHash -> Bool
forall a. Maybe a -> Bool
isNothing Maybe BlockHash
m) (m () -> m ()) -> (m () -> m ()) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" "Importing Genesis block"
Block -> BlockNode -> m ()
forall (m :: * -> *). MonadImport m => Block -> BlockNode -> m ()
importBlock (Network -> Block
genesisBlock Network
net) (Network -> BlockNode
genesisNode Network
net)
getOldMempool :: StoreReadBase m => UnixTime -> m [TxHash]
getOldMempool :: UnixTime -> m [TxHash]
getOldMempool now :: UnixTime
now =
((UnixTime, TxHash) -> TxHash) -> [(UnixTime, TxHash)] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (UnixTime, TxHash) -> TxHash
forall a b. (a, b) -> b
snd ([(UnixTime, TxHash)] -> [TxHash])
-> ([(UnixTime, TxHash)] -> [(UnixTime, TxHash)])
-> [(UnixTime, TxHash)]
-> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnixTime, TxHash) -> Bool)
-> [(UnixTime, TxHash)] -> [(UnixTime, TxHash)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
< UnixTime
now UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
- 3600 UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
* 72) (UnixTime -> Bool)
-> ((UnixTime, TxHash) -> UnixTime) -> (UnixTime, TxHash) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnixTime, TxHash) -> UnixTime
forall a b. (a, b) -> a
fst) ([(UnixTime, TxHash)] -> [TxHash])
-> m [(UnixTime, TxHash)] -> m [TxHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [(UnixTime, TxHash)]
forall (m :: * -> *). StoreReadBase m => m [(UnixTime, TxHash)]
getMempool
newMempoolTx :: MonadImport m => Tx -> UnixTime -> m Bool
newMempoolTx :: Tx -> UnixTime -> m Bool
newMempoolTx tx :: Tx
tx w :: UnixTime
w =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData (Tx -> TxHash
txHash Tx
tx) m (Maybe TxData) -> (Maybe TxData -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just _ ->
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Nothing -> do
Bool -> Bool -> Tx -> m ()
forall (m :: * -> *). MonadImport m => Bool -> Bool -> Tx -> m ()
freeOutputs Bool
True Bool
True Tx
tx
Bool
rbf <- BlockRef -> Tx -> m Bool
forall (m :: * -> *). StoreReadBase m => BlockRef -> Tx -> m Bool
isRBF (UnixTime -> BlockRef
MemRef UnixTime
w) Tx
tx
Tx -> m ()
forall (m :: * -> *). MonadImport m => Tx -> m ()
checkNewTx Tx
tx
BlockRef -> UnixTime -> Bool -> Tx -> m ()
forall (m :: * -> *).
MonadImport m =>
BlockRef -> UnixTime -> Bool -> Tx -> m ()
importTx (UnixTime -> BlockRef
MemRef UnixTime
w) UnixTime
w Bool
rbf Tx
tx
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
bestBlockData :: MonadImport m => m BlockData
bestBlockData :: m BlockData
bestBlockData = do
BlockHash
h <- m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock m (Maybe BlockHash)
-> (Maybe BlockHash -> m BlockHash) -> m BlockHash
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" "Best block unknown"
ImportException -> m BlockHash
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
Just h :: BlockHash
h -> BlockHash -> m BlockHash
forall (m :: * -> *) a. Monad m => a -> m a
return BlockHash
h
BlockHash -> m (Maybe BlockData)
forall (m :: * -> *).
StoreReadBase m =>
BlockHash -> m (Maybe BlockData)
getBlock BlockHash
h m (Maybe BlockData)
-> (Maybe BlockData -> m BlockData) -> m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" "Best block not found"
ImportException -> m BlockData
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
Just b :: BlockData
b -> BlockData -> m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
revertBlock :: MonadImport m => BlockHash -> m ()
revertBlock :: BlockHash -> m ()
revertBlock bh :: BlockHash
bh = do
BlockData
bd <- m BlockData
forall (m :: * -> *). MonadImport m => m BlockData
bestBlockData m BlockData -> (BlockData -> m BlockData) -> m BlockData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: BlockData
b ->
if BlockHeader -> BlockHash
headerHash (BlockData -> BlockHeader
blockDataHeader BlockData
b) BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bh
then BlockData -> m BlockData
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
else do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Cannot revert non-head block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bh
ImportException -> m BlockData
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BlockNotBest
[TxData]
tds <- (TxHash -> m TxData) -> [TxHash] -> m [TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> m TxData
forall (m :: * -> *). MonadImport m => TxHash -> m TxData
getImportTxData (BlockData -> [TxHash]
blockDataTxs BlockData
bd)
BlockHash -> m ()
forall (m :: * -> *). StoreWrite m => BlockHash -> m ()
setBest (BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bd))
BlockData -> m ()
forall (m :: * -> *). StoreWrite m => BlockData -> m ()
insertBlock BlockData
bd {blockDataMainChain :: Bool
blockDataMainChain = Bool
False}
[TxData] -> (TxData -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([TxData] -> [TxData]
forall a. [a] -> [a]
tail [TxData]
tds) TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
unConfirmTx
TxHash -> m ()
forall (m :: * -> *). MonadImport m => TxHash -> m ()
deleteConfirmedTx (Tx -> TxHash
txHash (TxData -> Tx
txData ([TxData] -> TxData
forall a. [a] -> a
head [TxData]
tds)))
checkNewBlock :: MonadImport m => Block -> BlockNode -> m ()
checkNewBlock :: Block -> BlockNode -> m ()
checkNewBlock b :: Block
b n :: BlockNode
n =
m (Maybe BlockHash)
forall (m :: * -> *). StoreReadBase m => m (Maybe BlockHash)
getBestBlock m (Maybe BlockHash) -> (Maybe BlockHash -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing
| BlockNode -> Bool
isGenesis BlockNode
n -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Cannot import non-genesis block: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (Block -> BlockHeader
blockHeader Block
b))
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
Just h :: BlockHash
h
| BlockHeader -> BlockHash
prevBlock (Block -> BlockHeader
blockHeader Block
b) BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
h -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Block does not build on head: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (Block -> BlockHeader
blockHeader Block
b))
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
PrevBlockNotBest
importOrConfirm :: MonadImport m => BlockNode -> [Tx] -> m ()
importOrConfirm :: BlockNode -> [Tx] -> m ()
importOrConfirm bn :: BlockNode
bn txns :: [Tx]
txns = do
((Word32, Tx) -> m ()) -> [(Word32, Tx)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Bool -> Tx -> m ()
forall (m :: * -> *). MonadImport m => Bool -> Bool -> Tx -> m ()
freeOutputs Bool
True Bool
False (Tx -> m ()) -> ((Word32, Tx) -> Tx) -> (Word32, Tx) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, Tx) -> Tx
forall a b. (a, b) -> b
snd) ([(Word32, Tx)] -> [(Word32, Tx)]
forall a. [a] -> [a]
reverse [(Word32, Tx)]
txs)
((Word32, Tx) -> m (Maybe Any)) -> [(Word32, Tx)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Word32 -> Tx -> m (Maybe Any)) -> (Word32, Tx) -> m (Maybe Any)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word32 -> Tx -> m (Maybe Any)
forall (m :: * -> *) a.
(StoreReadBase m, MonadError ImportException m, MonadLoggerIO m,
StoreWrite m) =>
Word32 -> Tx -> m (Maybe a)
action) [(Word32, Tx)]
txs
where
txs :: [(Word32, Tx)]
txs = [Tx] -> [(Word32, Tx)]
sortTxs [Tx]
txns
br :: Word32 -> BlockRef
br i :: Word32
i = $WBlockRef :: Word32 -> Word32 -> BlockRef
BlockRef {blockRefHeight :: Word32
blockRefHeight = BlockNode -> Word32
nodeHeight BlockNode
bn, blockRefPos :: Word32
blockRefPos = Word32
i}
bn_time :: UnixTime
bn_time = Word32 -> UnixTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> UnixTime)
-> (BlockHeader -> Word32) -> BlockHeader -> UnixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHeader -> Word32
blockTimestamp (BlockHeader -> UnixTime) -> BlockHeader -> UnixTime
forall a b. (a -> b) -> a -> b
$ BlockNode -> BlockHeader
nodeHeader BlockNode
bn
action :: Word32 -> Tx -> m (Maybe a)
action i :: Word32
i tx :: Tx
tx =
Tx -> m Bool
forall (m :: * -> *). StoreReadBase m => Tx -> m Bool
testPresent Tx
tx m Bool -> (Bool -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
False -> Word32 -> Tx -> m (Maybe a)
forall (m :: * -> *) a.
(MonadError ImportException m, MonadLoggerIO m, StoreReadBase m,
StoreWrite m) =>
Word32 -> Tx -> m (Maybe a)
import_it Word32
i Tx
tx
True -> Word32 -> Tx -> m (Maybe a)
forall (m :: * -> *) a.
(StoreReadBase m, MonadError ImportException m, MonadLoggerIO m,
StoreWrite m) =>
Word32 -> Tx -> m (Maybe a)
confirm_it Word32
i Tx
tx
confirm_it :: Word32 -> Tx -> m (Maybe a)
confirm_it i :: Word32
i tx :: Tx
tx =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData (Tx -> TxHash
txHash Tx
tx) m (Maybe TxData) -> (Maybe TxData -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just t :: TxData
t -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Confirming tx: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
TxData -> BlockRef -> m ()
forall (m :: * -> *). MonadImport m => TxData -> BlockRef -> m ()
confirmTx TxData
t (Word32 -> BlockRef
br Word32
i)
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Cannot find tx to confirm: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m (Maybe a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
import_it :: Word32 -> Tx -> m (Maybe a)
import_it i :: Word32
i tx :: Tx
tx = do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Importing tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
BlockRef -> UnixTime -> Bool -> Tx -> m ()
forall (m :: * -> *).
MonadImport m =>
BlockRef -> UnixTime -> Bool -> Tx -> m ()
importTx (Word32 -> BlockRef
br Word32
i) UnixTime
bn_time Bool
False Tx
tx
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
importBlock :: MonadImport m => Block -> BlockNode -> m ()
importBlock :: Block -> BlockNode -> m ()
importBlock b :: Block
b n :: BlockNode
n = do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Checking new block: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n))
Block -> BlockNode -> m ()
forall (m :: * -> *). MonadImport m => Block -> BlockNode -> m ()
checkNewBlock Block
b BlockNode
n
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" "Passed check"
Network
net <- m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
let subsidy :: UnixTime
subsidy = Network -> Word32 -> UnixTime
computeSubsidy Network
net (BlockNode -> Word32
nodeHeight BlockNode
n)
[BlockHash]
bs <- Word32 -> m [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight (BlockNode -> Word32
nodeHeight BlockNode
n)
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Inserting block entries for: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n))
BlockData -> m ()
forall (m :: * -> *). StoreWrite m => BlockData -> m ()
insertBlock
$WBlockData :: Word32
-> Bool
-> BlockWork
-> BlockHeader
-> Word32
-> Word32
-> [TxHash]
-> UnixTime
-> UnixTime
-> UnixTime
-> BlockData
BlockData
{ blockDataHeight :: Word32
blockDataHeight = BlockNode -> Word32
nodeHeight BlockNode
n
, blockDataMainChain :: Bool
blockDataMainChain = Bool
True
, blockDataWork :: BlockWork
blockDataWork = BlockNode -> BlockWork
nodeWork BlockNode
n
, blockDataHeader :: BlockHeader
blockDataHeader = BlockNode -> BlockHeader
nodeHeader BlockNode
n
, blockDataSize :: Word32
blockDataSize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (Block -> ByteString
forall a. Serialize a => a -> ByteString
encode Block
b))
, blockDataTxs :: [TxHash]
blockDataTxs = (Tx -> TxHash) -> [Tx] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map Tx -> TxHash
txHash (Block -> [Tx]
blockTxns Block
b)
, blockDataWeight :: Word32
blockDataWeight = if Network -> Bool
getSegWit Network
net then Word32
w else 0
, blockDataSubsidy :: UnixTime
blockDataSubsidy = UnixTime
subsidy
, blockDataFees :: UnixTime
blockDataFees = UnixTime
cb_out_val UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
- UnixTime
subsidy
, blockDataOutputs :: UnixTime
blockDataOutputs = UnixTime
ts_out_val
}
[BlockHash] -> Word32 -> m ()
forall (m :: * -> *). StoreWrite m => [BlockHash] -> Word32 -> m ()
setBlocksAtHeight
([BlockHash] -> [BlockHash]
forall a. Eq a => [a] -> [a]
nub (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n) BlockHash -> [BlockHash] -> [BlockHash]
forall a. a -> [a] -> [a]
: [BlockHash]
bs))
(BlockNode -> Word32
nodeHeight BlockNode
n)
BlockHash -> m ()
forall (m :: * -> *). StoreWrite m => BlockHash -> m ()
setBest (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n))
BlockNode -> [Tx] -> m ()
forall (m :: * -> *). MonadImport m => BlockNode -> [Tx] -> m ()
importOrConfirm BlockNode
n (Block -> [Tx]
blockTxns Block
b)
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Finished importing transactions for: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n))
where
cb_out_val :: UnixTime
cb_out_val =
[UnixTime] -> UnixTime
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([UnixTime] -> UnixTime) -> [UnixTime] -> UnixTime
forall a b. (a -> b) -> a -> b
$ (TxOut -> UnixTime) -> [TxOut] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map TxOut -> UnixTime
outValue ([TxOut] -> [UnixTime]) -> [TxOut] -> [UnixTime]
forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut]
txOut (Tx -> [TxOut]) -> Tx -> [TxOut]
forall a b. (a -> b) -> a -> b
$ [Tx] -> Tx
forall a. [a] -> a
head ([Tx] -> Tx) -> [Tx] -> Tx
forall a b. (a -> b) -> a -> b
$ Block -> [Tx]
blockTxns Block
b
ts_out_val :: UnixTime
ts_out_val =
[UnixTime] -> UnixTime
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([UnixTime] -> UnixTime) -> [UnixTime] -> UnixTime
forall a b. (a -> b) -> a -> b
$ (Tx -> UnixTime) -> [Tx] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map ([UnixTime] -> UnixTime
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([UnixTime] -> UnixTime) -> (Tx -> [UnixTime]) -> Tx -> UnixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut -> UnixTime) -> [TxOut] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map TxOut -> UnixTime
outValue ([TxOut] -> [UnixTime]) -> (Tx -> [TxOut]) -> Tx -> [UnixTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxOut]
txOut) ([Tx] -> [UnixTime]) -> [Tx] -> [UnixTime]
forall a b. (a -> b) -> a -> b
$ [Tx] -> [Tx]
forall a. [a] -> [a]
tail ([Tx] -> [Tx]) -> [Tx] -> [Tx]
forall a b. (a -> b) -> a -> b
$ Block -> [Tx]
blockTxns Block
b
w :: Word32
w =
let f :: Tx -> Tx
f t :: Tx
t = Tx
t {txWitness :: WitnessData
txWitness = []}
b' :: Block
b' = Block
b {blockTxns :: [Tx]
blockTxns = (Tx -> Tx) -> [Tx] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map Tx -> Tx
f (Block -> [Tx]
blockTxns Block
b)}
x :: Int
x = ByteString -> Int
B.length (Block -> ByteString
forall a. Serialize a => a -> ByteString
encode Block
b)
s :: Int
s = ByteString -> Int
B.length (Block -> ByteString
forall a. Serialize a => a -> ByteString
encode Block
b')
in Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* 3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
checkNewTx :: MonadImport m => Tx -> m ()
checkNewTx :: Tx -> m ()
checkNewTx tx :: Tx
tx = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
unique_inputs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxIn]
txIn Tx
tx)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Transaction spends same output twice: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
DuplicatePrevOutput
[Maybe Unspent]
us <- Tx -> m [Maybe Unspent]
forall (m :: * -> *). StoreReadBase m => Tx -> m [Maybe Unspent]
getUnspentOutputs Tx
tx
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Maybe Unspent -> Bool) -> [Maybe Unspent] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe Unspent -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Unspent]
us) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Orphan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
Orphan
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Tx -> Bool
isCoinbase Tx
tx) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Coinbase cannot be imported into mempool: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
UnexpectedCoinbase
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([OutPoint] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [OutPoint]
prevOuts Tx
tx) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Maybe Unspent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe Unspent]
us) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Orphan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
Orphan
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UnixTime
outputs UnixTime -> UnixTime -> Bool
forall a. Ord a => a -> a -> Bool
> [Maybe Unspent] -> UnixTime
unspents [Maybe Unspent]
us) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Insufficient funds for tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
InsufficientFunds
where
unspents :: [Maybe Unspent] -> UnixTime
unspents = [UnixTime] -> UnixTime
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([UnixTime] -> UnixTime)
-> ([Maybe Unspent] -> [UnixTime]) -> [Maybe Unspent] -> UnixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unspent -> UnixTime) -> [Unspent] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map Unspent -> UnixTime
unspentAmount ([Unspent] -> [UnixTime])
-> ([Maybe Unspent] -> [Unspent]) -> [Maybe Unspent] -> [UnixTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Unspent] -> [Unspent]
forall a. [Maybe a] -> [a]
catMaybes
outputs :: UnixTime
outputs = [UnixTime] -> UnixTime
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TxOut -> UnixTime) -> [TxOut] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map TxOut -> UnixTime
outValue (Tx -> [TxOut]
txOut Tx
tx))
unique_inputs :: Int
unique_inputs = [OutPoint] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OutPoint] -> [OutPoint]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' ((TxIn -> OutPoint) -> [TxIn] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> OutPoint
prevOutput (Tx -> [TxIn]
txIn Tx
tx)))
getUnspentOutputs :: StoreReadBase m => Tx -> m [Maybe Unspent]
getUnspentOutputs :: Tx -> m [Maybe Unspent]
getUnspentOutputs tx :: Tx
tx = (OutPoint -> m (Maybe Unspent)) -> [OutPoint] -> m [Maybe Unspent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent (Tx -> [OutPoint]
prevOuts Tx
tx)
prepareTxData :: Bool -> BlockRef -> Word64 -> Tx -> [Unspent] -> TxData
prepareTxData :: Bool -> BlockRef -> UnixTime -> Tx -> [Unspent] -> TxData
prepareTxData rbf :: Bool
rbf br :: BlockRef
br tt :: UnixTime
tt tx :: Tx
tx us :: [Unspent]
us =
$WTxData :: BlockRef -> Tx -> IntMap Prev -> Bool -> Bool -> UnixTime -> TxData
TxData { txDataBlock :: BlockRef
txDataBlock = BlockRef
br
, txData :: Tx
txData = Tx
tx
, txDataPrevs :: IntMap Prev
txDataPrevs = IntMap Prev
ps
, txDataDeleted :: Bool
txDataDeleted = Bool
False
, txDataRBF :: Bool
txDataRBF = Bool
rbf
, txDataTime :: UnixTime
txDataTime = UnixTime
tt
}
where
mkprv :: Unspent -> Prev
mkprv u :: Unspent
u = ByteString -> UnixTime -> Prev
Prev (ShortByteString -> ByteString
B.Short.fromShort (Unspent -> ShortByteString
unspentScript Unspent
u)) (Unspent -> UnixTime
unspentAmount Unspent
u)
ps :: IntMap Prev
ps = [(Int, Prev)] -> IntMap Prev
forall a. [(Int, a)] -> IntMap a
I.fromList ([(Int, Prev)] -> IntMap Prev) -> [(Int, Prev)] -> IntMap Prev
forall a b. (a -> b) -> a -> b
$ [Int] -> [Prev] -> [(Int, Prev)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 ..] ([Prev] -> [(Int, Prev)]) -> [Prev] -> [(Int, Prev)]
forall a b. (a -> b) -> a -> b
$ (Unspent -> Prev) -> [Unspent] -> [Prev]
forall a b. (a -> b) -> [a] -> [b]
map Unspent -> Prev
mkprv [Unspent]
us
importTx
:: MonadImport m
=> BlockRef
-> Word64
-> Bool
-> Tx
-> m ()
importTx :: BlockRef -> UnixTime -> Bool -> Tx -> m ()
importTx br :: BlockRef
br tt :: UnixTime
tt rbf :: Bool
rbf tx :: Tx
tx = do
[Maybe Unspent]
mus <- Tx -> m [Maybe Unspent]
forall (m :: * -> *). StoreReadBase m => Tx -> m [Maybe Unspent]
getUnspentOutputs Tx
tx
[Unspent]
us <- [Maybe Unspent] -> (Maybe Unspent -> m Unspent) -> m [Unspent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Maybe Unspent]
mus ((Maybe Unspent -> m Unspent) -> m [Unspent])
-> (Maybe Unspent -> m Unspent) -> m [Unspent]
forall a b. (a -> b) -> a -> b
$ \case
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Attempted to import a tx missing UTXO: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m Unspent
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
Orphan
Just u :: Unspent
u -> Unspent -> m Unspent
forall (m :: * -> *) a. Monad m => a -> m a
return Unspent
u
let td :: TxData
td = Bool -> BlockRef -> UnixTime -> Tx -> [Unspent] -> TxData
prepareTxData Bool
rbf BlockRef
br UnixTime
tt Tx
tx [Unspent]
us
TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
commitAddTx TxData
td
unConfirmTx :: MonadImport m => TxData -> m ()
unConfirmTx :: TxData -> m ()
unConfirmTx t :: TxData
t = TxData -> Maybe BlockRef -> m ()
forall (m :: * -> *).
MonadImport m =>
TxData -> Maybe BlockRef -> m ()
confTx TxData
t Maybe BlockRef
forall a. Maybe a
Nothing
confirmTx :: MonadImport m => TxData -> BlockRef -> m ()
confirmTx :: TxData -> BlockRef -> m ()
confirmTx t :: TxData
t br :: BlockRef
br = TxData -> Maybe BlockRef -> m ()
forall (m :: * -> *).
MonadImport m =>
TxData -> Maybe BlockRef -> m ()
confTx TxData
t (BlockRef -> Maybe BlockRef
forall a. a -> Maybe a
Just BlockRef
br)
replaceAddressTx :: MonadImport m => TxData -> BlockRef -> m ()
replaceAddressTx :: TxData -> BlockRef -> m ()
replaceAddressTx t :: TxData
t new :: BlockRef
new = [Address] -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (TxData -> [Address]
txDataAddresses TxData
t) ((Address -> m ()) -> m ()) -> (Address -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a :: Address
a -> do
Address -> TxRef -> m ()
forall (m :: * -> *). StoreWrite m => Address -> TxRef -> m ()
deleteAddrTx
Address
a
$WTxRef :: BlockRef -> TxHash -> TxRef
TxRef { txRefBlock :: BlockRef
txRefBlock = TxData -> BlockRef
txDataBlock TxData
t
, txRefHash :: TxHash
txRefHash = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
t) }
Address -> TxRef -> m ()
forall (m :: * -> *). StoreWrite m => Address -> TxRef -> m ()
insertAddrTx
Address
a
$WTxRef :: BlockRef -> TxHash -> TxRef
TxRef { txRefBlock :: BlockRef
txRefBlock = BlockRef
new
, txRefHash :: TxHash
txRefHash = Tx -> TxHash
txHash (TxData -> Tx
txData TxData
t) }
adjustAddressOutput :: MonadImport m
=> OutPoint -> TxOut -> BlockRef -> BlockRef -> m ()
adjustAddressOutput :: OutPoint -> TxOut -> BlockRef -> BlockRef -> m ()
adjustAddressOutput op :: OutPoint
op o :: TxOut
o old :: BlockRef
old new :: BlockRef
new = do
let pk :: ByteString
pk = TxOut -> ByteString
scriptOutput TxOut
o
OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op m (Maybe Unspent) -> (Maybe Unspent -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just u :: Unspent
u -> do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Unspent -> BlockRef
unspentBlock Unspent
u BlockRef -> BlockRef -> Bool
forall a. Eq a => a -> a -> Bool
== BlockRef
old) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Existing unspent block bad for output: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OutPoint -> String
forall a. Show a => a -> String
show OutPoint
op
ByteString -> m ()
forall (m :: * -> *).
(StoreWrite m, MonadError ImportException m, MonadLoggerIO m,
StoreReadBase m) =>
ByteString -> m ()
replace_unspent ByteString
pk
where
replace_unspent :: ByteString -> m ()
replace_unspent pk :: ByteString
pk = do
let ma :: Maybe Address
ma = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS ByteString
pk)
OutPoint -> m ()
forall (m :: * -> *). StoreWrite m => OutPoint -> m ()
deleteUnspent OutPoint
op
Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Unspent -> m ()
insertUnspent
$WUnspent :: BlockRef
-> OutPoint
-> UnixTime
-> ShortByteString
-> Maybe Address
-> Unspent
Unspent
{ unspentBlock :: BlockRef
unspentBlock = BlockRef
new
, unspentPoint :: OutPoint
unspentPoint = OutPoint
op
, unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
, unspentScript :: ShortByteString
unspentScript = ByteString -> ShortByteString
B.Short.toShort ByteString
pk
, unspentAddress :: Maybe Address
unspentAddress = Maybe Address
ma
}
Maybe Address -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Address
ma ((Address -> m ()) -> m ()) -> (Address -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Address -> m ()
forall (m :: * -> *).
(StoreWrite m, MonadError ImportException m, MonadLoggerIO m,
StoreReadBase m) =>
ByteString -> Address -> m ()
replace_addr_unspent ByteString
pk
replace_addr_unspent :: ByteString -> Address -> m ()
replace_addr_unspent pk :: ByteString
pk a :: Address
a = do
Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
deleteAddrUnspent
Address
a
$WUnspent :: BlockRef
-> OutPoint
-> UnixTime
-> ShortByteString
-> Maybe Address
-> Unspent
Unspent
{ unspentBlock :: BlockRef
unspentBlock = BlockRef
old
, unspentPoint :: OutPoint
unspentPoint = OutPoint
op
, unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
, unspentScript :: ShortByteString
unspentScript = ByteString -> ShortByteString
B.Short.toShort ByteString
pk
, unspentAddress :: Maybe Address
unspentAddress = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
a
}
Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
insertAddrUnspent
Address
a
$WUnspent :: BlockRef
-> OutPoint
-> UnixTime
-> ShortByteString
-> Maybe Address
-> Unspent
Unspent
{ unspentBlock :: BlockRef
unspentBlock = BlockRef
new
, unspentPoint :: OutPoint
unspentPoint = OutPoint
op
, unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
, unspentScript :: ShortByteString
unspentScript = ByteString -> ShortByteString
B.Short.toShort ByteString
pk
, unspentAddress :: Maybe Address
unspentAddress = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
a
}
Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Address -> UnixTime -> m ()
decreaseBalance (BlockRef -> Bool
confirmed BlockRef
old) Address
a (TxOut -> UnixTime
outValue TxOut
o)
Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Address -> UnixTime -> m ()
increaseBalance (BlockRef -> Bool
confirmed BlockRef
new) Address
a (TxOut -> UnixTime
outValue TxOut
o)
confTx :: MonadImport m => TxData -> Maybe BlockRef -> m ()
confTx :: TxData -> Maybe BlockRef -> m ()
confTx t :: TxData
t mbr :: Maybe BlockRef
mbr = do
TxData -> BlockRef -> m ()
forall (m :: * -> *). MonadImport m => TxData -> BlockRef -> m ()
replaceAddressTx TxData
t BlockRef
new
[(Word32, TxOut)] -> ((Word32, TxOut) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Word32] -> [TxOut] -> [(Word32, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0 ..] (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
t))) (((Word32, TxOut) -> m ()) -> m ())
-> ((Word32, TxOut) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(n :: Word32
n, o :: TxOut
o) -> do
let op :: OutPoint
op = TxHash -> Word32 -> OutPoint
OutPoint (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
t)) Word32
n
OutPoint -> TxOut -> BlockRef -> BlockRef -> m ()
forall (m :: * -> *).
MonadImport m =>
OutPoint -> TxOut -> BlockRef -> BlockRef -> m ()
adjustAddressOutput OutPoint
op TxOut
o BlockRef
old BlockRef
new
Bool
rbf <- BlockRef -> Tx -> m Bool
forall (m :: * -> *). StoreReadBase m => BlockRef -> Tx -> m Bool
isRBF BlockRef
new (TxData -> Tx
txData TxData
t)
let td :: TxData
td = TxData
t { txDataBlock :: BlockRef
txDataBlock = BlockRef
new, txDataRBF :: Bool
txDataRBF = Bool
rbf }
TxData -> m ()
forall (m :: * -> *). StoreWrite m => TxData -> m ()
insertTx TxData
td
TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
updateMempool TxData
td
where
new :: BlockRef
new = BlockRef -> Maybe BlockRef -> BlockRef
forall a. a -> Maybe a -> a
fromMaybe (UnixTime -> BlockRef
MemRef (TxData -> UnixTime
txDataTime TxData
t)) Maybe BlockRef
mbr
old :: BlockRef
old = TxData -> BlockRef
txDataBlock TxData
t
freeOutputs
:: MonadImport m
=> Bool
-> Bool
-> Tx
-> m ()
freeOutputs :: Bool -> Bool -> Tx -> m ()
freeOutputs memonly :: Bool
memonly rbfcheck :: Bool
rbfcheck tx :: Tx
tx =
[OutPoint] -> (OutPoint -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tx -> [OutPoint]
prevOuts Tx
tx) ((OutPoint -> m ()) -> m ()) -> (OutPoint -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \op :: OutPoint
op ->
OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op m (Maybe Unspent) -> (Maybe Unspent -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \u :: Maybe Unspent
u -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Unspent -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Unspent
u) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
OutPoint -> m (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender OutPoint
op m (Maybe Spender) -> (Maybe Spender -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \p :: Maybe Spender
p -> Maybe Spender -> (Spender -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Spender
p ((Spender -> m ()) -> m ()) -> (Spender -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \s :: Spender
s ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Spender -> TxHash
spenderHash Spender
s TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== Tx -> TxHash
txHash Tx
tx) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> TxHash -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m ()
deleteTx Bool
memonly Bool
rbfcheck (Spender -> TxHash
spenderHash Spender
s)
deleteConfirmedTx :: MonadImport m => TxHash -> m ()
deleteConfirmedTx :: TxHash -> m ()
deleteConfirmedTx = Bool -> Bool -> TxHash -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m ()
deleteTx Bool
False Bool
False
deleteUnconfirmedTx :: MonadImport m => Bool -> TxHash -> m ()
deleteUnconfirmedTx :: Bool -> TxHash -> m ()
deleteUnconfirmedTx rbfcheck :: Bool
rbfcheck th :: TxHash
th =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th m (Maybe TxData) -> (Maybe TxData -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just _ -> Bool -> Bool -> TxHash -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m ()
deleteTx Bool
True Bool
rbfcheck TxHash
th
Nothing -> $(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Not found or already deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
deleteTx :: MonadImport m
=> Bool
-> Bool
-> TxHash
-> m ()
deleteTx :: Bool -> Bool -> TxHash -> m ()
deleteTx memonly :: Bool
memonly rbfcheck :: Bool
rbfcheck th :: TxHash
th =
Bool -> Bool -> TxHash -> m [Tx]
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [Tx]
getChain Bool
memonly Bool
rbfcheck TxHash
th m [Tx] -> ([Tx] -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Tx -> m ()) -> [Tx] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TxHash -> m ()
forall (m :: * -> *). MonadImport m => TxHash -> m ()
deleteSingleTx (TxHash -> m ()) -> (Tx -> TxHash) -> Tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> TxHash
txHash)
getChain :: MonadImport m
=> Bool
-> Bool
-> TxHash
-> m [Tx]
getChain :: Bool -> Bool -> TxHash -> m [Tx]
getChain memonly :: Bool
memonly rbfcheck :: Bool
rbfcheck th :: TxHash
th =
([Tx] -> [Tx]) -> m [Tx] -> m [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Tx] -> [Tx]
sort_clean (m [Tx] -> m [Tx]) -> m [Tx] -> m [Tx]
forall a b. (a -> b) -> a -> b
$
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th m (Maybe TxData) -> (Maybe TxData -> m [Tx]) -> m [Tx]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Transaction not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m [Tx]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
Just td :: TxData
td
| Bool
memonly Bool -> Bool -> Bool
&& BlockRef -> Bool
confirmed (TxData -> BlockRef
txDataBlock TxData
td) -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Transaction already confirmed: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m [Tx]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxConfirmed
| Bool
rbfcheck ->
BlockRef -> Tx -> m Bool
forall (m :: * -> *). StoreReadBase m => BlockRef -> Tx -> m Bool
isRBF (TxData -> BlockRef
txDataBlock TxData
td) (TxData -> Tx
txData TxData
td) m Bool -> (Bool -> m [Tx]) -> m [Tx]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
True -> TxData -> m [Tx]
forall (m :: * -> *).
(StoreReadBase m, MonadError ImportException m, MonadLoggerIO m,
StoreWrite m) =>
TxData -> m [Tx]
go TxData
td
False -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Double-spending transaction: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m [Tx]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
DoubleSpend
| Bool
otherwise -> TxData -> m [Tx]
forall (m :: * -> *).
(StoreReadBase m, MonadError ImportException m, MonadLoggerIO m,
StoreWrite m) =>
TxData -> m [Tx]
go TxData
td
where
sort_clean :: [Tx] -> [Tx]
sort_clean = [Tx] -> [Tx]
forall a. [a] -> [a]
reverse ([Tx] -> [Tx]) -> ([Tx] -> [Tx]) -> [Tx] -> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32, Tx) -> Tx) -> [(Word32, Tx)] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map (Word32, Tx) -> Tx
forall a b. (a, b) -> b
snd ([(Word32, Tx)] -> [Tx])
-> ([Tx] -> [(Word32, Tx)]) -> [Tx] -> [Tx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tx] -> [(Word32, Tx)]
sortTxs ([Tx] -> [(Word32, Tx)])
-> ([Tx] -> [Tx]) -> [Tx] -> [(Word32, Tx)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tx] -> [Tx]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub'
go :: TxData -> m [Tx]
go td :: TxData
td = do
let tx :: Tx
tx = TxData -> Tx
txData TxData
td
[TxHash]
ss <- [TxHash] -> [TxHash]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' ([TxHash] -> [TxHash])
-> (IntMap Spender -> [TxHash]) -> IntMap Spender -> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Spender -> TxHash) -> [Spender] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map Spender -> TxHash
spenderHash ([Spender] -> [TxHash])
-> (IntMap Spender -> [Spender]) -> IntMap Spender -> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Spender -> [Spender]
forall a. IntMap a -> [a]
I.elems (IntMap Spender -> [TxHash]) -> m (IntMap Spender) -> m [TxHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (IntMap Spender)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (IntMap Spender)
getSpenders TxHash
th
[Tx]
xs <- [[Tx]] -> [Tx]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Tx]] -> [Tx]) -> m [[Tx]] -> m [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> m [Tx]) -> [TxHash] -> m [[Tx]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> TxHash -> m [Tx]
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [Tx]
getChain Bool
memonly Bool
rbfcheck) [TxHash]
ss
[Tx] -> m [Tx]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tx] -> m [Tx]) -> [Tx] -> m [Tx]
forall a b. (a -> b) -> a -> b
$ Tx
tx Tx -> [Tx] -> [Tx]
forall a. a -> [a] -> [a]
: [Tx]
xs
deleteSingleTx :: MonadImport m => TxHash -> m ()
deleteSingleTx :: TxHash -> m ()
deleteSingleTx th :: TxHash
th =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th m (Maybe TxData) -> (Maybe TxData -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Already deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
Just td :: TxData
td -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Deleting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
TxHash -> m (IntMap Spender)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (IntMap Spender)
getSpenders TxHash
th m (IntMap Spender) -> (IntMap Spender -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
m :: IntMap Spender
m | IntMap Spender -> Bool
forall a. IntMap a -> Bool
I.null IntMap Spender
m -> TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
commitDelTx TxData
td
| Bool
otherwise -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logErrorS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Tried to delete spent tx: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxSpent
commitDelTx :: MonadImport m => TxData -> m ()
commitDelTx :: TxData -> m ()
commitDelTx = Bool -> TxData -> m ()
forall (m :: * -> *). MonadImport m => Bool -> TxData -> m ()
commitModTx Bool
False
commitAddTx :: MonadImport m => TxData -> m ()
commitAddTx :: TxData -> m ()
commitAddTx = Bool -> TxData -> m ()
forall (m :: * -> *). MonadImport m => Bool -> TxData -> m ()
commitModTx Bool
True
commitModTx :: MonadImport m => Bool -> TxData -> m ()
commitModTx :: Bool -> TxData -> m ()
commitModTx add :: Bool
add tx_data :: TxData
tx_data = do
(Address -> m ()) -> [Address] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Address -> m ()
forall (m :: * -> *).
(StoreWrite m, MonadError ImportException m, MonadLoggerIO m,
StoreReadBase m) =>
Address -> m ()
mod_addr_tx (TxData -> [Address]
txDataAddresses TxData
td)
m ()
mod_outputs
m ()
mod_unspent
TxData -> m ()
forall (m :: * -> *). StoreWrite m => TxData -> m ()
insertTx TxData
td
TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
updateMempool TxData
td
where
tx :: Tx
tx = TxData -> Tx
txData TxData
td
br :: BlockRef
br = TxData -> BlockRef
txDataBlock TxData
td
td :: TxData
td = TxData
tx_data { txDataDeleted :: Bool
txDataDeleted = Bool -> Bool
not Bool
add }
tx_ref :: TxRef
tx_ref = BlockRef -> TxHash -> TxRef
TxRef BlockRef
br (Tx -> TxHash
txHash Tx
tx)
mod_addr_tx :: Address -> m ()
mod_addr_tx a :: Address
a
| Bool
add = do
Address -> TxRef -> m ()
forall (m :: * -> *). StoreWrite m => Address -> TxRef -> m ()
insertAddrTx Address
a TxRef
tx_ref
Bool -> Address -> m ()
forall (m :: * -> *). MonadImport m => Bool -> Address -> m ()
modAddressCount Bool
add Address
a
| Bool
otherwise = do
Address -> TxRef -> m ()
forall (m :: * -> *). StoreWrite m => Address -> TxRef -> m ()
deleteAddrTx Address
a TxRef
tx_ref
Bool -> Address -> m ()
forall (m :: * -> *). MonadImport m => Bool -> Address -> m ()
modAddressCount Bool
add Address
a
mod_unspent :: m ()
mod_unspent
| Bool
add = Tx -> m ()
forall (m :: * -> *). MonadImport m => Tx -> m ()
spendOutputs Tx
tx
| Bool
otherwise = Tx -> m ()
forall (m :: * -> *). MonadImport m => Tx -> m ()
unspendOutputs Tx
tx
mod_outputs :: m ()
mod_outputs
| Bool
add = BlockRef -> Tx -> m ()
forall (m :: * -> *). MonadImport m => BlockRef -> Tx -> m ()
addOutputs BlockRef
br Tx
tx
| Bool
otherwise = BlockRef -> Tx -> m ()
forall (m :: * -> *). MonadImport m => BlockRef -> Tx -> m ()
delOutputs BlockRef
br Tx
tx
updateMempool :: MonadImport m => TxData -> m ()
updateMempool :: TxData -> m ()
updateMempool td :: TxData
td@TxData{txDataDeleted :: TxData -> Bool
txDataDeleted = Bool
True} =
TxHash -> m ()
forall (m :: * -> *). StoreWrite m => TxHash -> m ()
deleteFromMempool (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
td))
updateMempool td :: TxData
td@TxData{txDataDeleted :: TxData -> Bool
txDataDeleted = Bool
False, txDataBlock :: TxData -> BlockRef
txDataBlock = MemRef t :: UnixTime
t} =
TxHash -> UnixTime -> m ()
forall (m :: * -> *). StoreWrite m => TxHash -> UnixTime -> m ()
addToMempool (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
td)) UnixTime
t
updateMempool td :: TxData
td@TxData{txDataBlock :: TxData -> BlockRef
txDataBlock = BlockRef{}} =
TxHash -> m ()
forall (m :: * -> *). StoreWrite m => TxHash -> m ()
deleteFromMempool (Tx -> TxHash
txHash (TxData -> Tx
txData TxData
td))
spendOutputs :: MonadImport m => Tx -> m ()
spendOutputs :: Tx -> m ()
spendOutputs tx :: Tx
tx =
(Word32 -> OutPoint -> m ()) -> [Word32] -> [OutPoint] -> m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (TxHash -> Word32 -> OutPoint -> m ()
forall (m :: * -> *).
MonadImport m =>
TxHash -> Word32 -> OutPoint -> m ()
spendOutput (Tx -> TxHash
txHash Tx
tx)) [0 ..] (Tx -> [OutPoint]
prevOuts Tx
tx)
addOutputs :: MonadImport m => BlockRef -> Tx -> m ()
addOutputs :: BlockRef -> Tx -> m ()
addOutputs br :: BlockRef
br tx :: Tx
tx =
(Word32 -> TxOut -> m ()) -> [Word32] -> [TxOut] -> m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (BlockRef -> OutPoint -> TxOut -> m ()
forall (m :: * -> *).
MonadImport m =>
BlockRef -> OutPoint -> TxOut -> m ()
addOutput BlockRef
br (OutPoint -> TxOut -> m ())
-> (Word32 -> OutPoint) -> Word32 -> TxOut -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxHash -> Word32 -> OutPoint
OutPoint (Tx -> TxHash
txHash Tx
tx)) [0 ..] (Tx -> [TxOut]
txOut Tx
tx)
isRBF :: StoreReadBase m
=> BlockRef
-> Tx
-> m Bool
isRBF :: BlockRef -> Tx -> m Bool
isRBF br :: BlockRef
br tx :: Tx
tx
| BlockRef -> Bool
confirmed BlockRef
br = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise =
m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork m Network -> (Network -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \net :: Network
net ->
if Network -> Bool
getReplaceByFee Network
net
then m Bool
go
else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
where
go :: m Bool
go | (TxIn -> Bool) -> [TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xffffffff Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- 1) (Word32 -> Bool) -> (TxIn -> Word32) -> TxIn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Word32
txInSequence) (Tx -> [TxIn]
txIn Tx
tx) = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = m Bool
carry_on
carry_on :: m Bool
carry_on =
let hs :: [TxHash]
hs = [TxHash] -> [TxHash]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' ([TxHash] -> [TxHash]) -> [TxHash] -> [TxHash]
forall a b. (a -> b) -> a -> b
$ (TxIn -> TxHash) -> [TxIn] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map (OutPoint -> TxHash
outPointHash (OutPoint -> TxHash) -> (TxIn -> OutPoint) -> TxIn -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
prevOutput) (Tx -> [TxIn]
txIn Tx
tx)
ck :: [TxHash] -> m Bool
ck [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
ck (h :: TxHash
h : hs' :: [TxHash]
hs') =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
h m (Maybe TxData) -> (Maybe TxData -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just t :: TxData
t | BlockRef -> Bool
confirmed (TxData -> BlockRef
txDataBlock TxData
t) -> [TxHash] -> m Bool
ck [TxHash]
hs'
| TxData -> Bool
txDataRBF TxData
t -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise -> [TxHash] -> m Bool
ck [TxHash]
hs'
in [TxHash] -> m Bool
forall (m :: * -> *). StoreReadBase m => [TxHash] -> m Bool
ck [TxHash]
hs
addOutput :: MonadImport m => BlockRef -> OutPoint -> TxOut -> m ()
addOutput :: BlockRef -> OutPoint -> TxOut -> m ()
addOutput = Bool -> BlockRef -> OutPoint -> TxOut -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> BlockRef -> OutPoint -> TxOut -> m ()
modOutput Bool
True
delOutput :: MonadImport m => BlockRef -> OutPoint -> TxOut -> m ()
delOutput :: BlockRef -> OutPoint -> TxOut -> m ()
delOutput = Bool -> BlockRef -> OutPoint -> TxOut -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> BlockRef -> OutPoint -> TxOut -> m ()
modOutput Bool
False
modOutput :: MonadImport m => Bool -> BlockRef -> OutPoint -> TxOut -> m ()
modOutput :: Bool -> BlockRef -> OutPoint -> TxOut -> m ()
modOutput add :: Bool
add br :: BlockRef
br op :: OutPoint
op o :: TxOut
o = do
m ()
mod_unspent
Maybe Address -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Address
ma ((Address -> m ()) -> m ()) -> (Address -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a :: Address
a -> do
Address -> Unspent -> m ()
mod_addr_unspent Address
a Unspent
u
Bool -> Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> Address -> UnixTime -> m ()
modBalance (BlockRef -> Bool
confirmed BlockRef
br) Bool
add Address
a (TxOut -> UnixTime
outValue TxOut
o)
Address -> (UnixTime -> UnixTime) -> m ()
forall (m :: * -> *).
MonadImport m =>
Address -> (UnixTime -> UnixTime) -> m ()
modifyReceived Address
a UnixTime -> UnixTime
v
where
v :: UnixTime -> UnixTime
v | Bool
add = (UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
+ TxOut -> UnixTime
outValue TxOut
o)
| Bool
otherwise = UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
subtract (TxOut -> UnixTime
outValue TxOut
o)
ma :: Maybe Address
ma = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS (TxOut -> ByteString
scriptOutput TxOut
o))
u :: Unspent
u = $WUnspent :: BlockRef
-> OutPoint
-> UnixTime
-> ShortByteString
-> Maybe Address
-> Unspent
Unspent { unspentScript :: ShortByteString
unspentScript = ByteString -> ShortByteString
B.Short.toShort (TxOut -> ByteString
scriptOutput TxOut
o)
, unspentBlock :: BlockRef
unspentBlock = BlockRef
br
, unspentPoint :: OutPoint
unspentPoint = OutPoint
op
, unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
, unspentAddress :: Maybe Address
unspentAddress = Maybe Address
ma
}
mod_unspent :: m ()
mod_unspent | Bool
add = Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Unspent -> m ()
insertUnspent Unspent
u
| Bool
otherwise = OutPoint -> m ()
forall (m :: * -> *). StoreWrite m => OutPoint -> m ()
deleteUnspent OutPoint
op
mod_addr_unspent :: Address -> Unspent -> m ()
mod_addr_unspent | Bool
add = Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
insertAddrUnspent
| Bool
otherwise = Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
deleteAddrUnspent
delOutputs :: MonadImport m => BlockRef -> Tx -> m ()
delOutputs :: BlockRef -> Tx -> m ()
delOutputs br :: BlockRef
br tx :: Tx
tx =
[(Word32, TxOut)] -> ((Word32, TxOut) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Word32] -> [TxOut] -> [(Word32, TxOut)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] (Tx -> [TxOut]
txOut Tx
tx)) (((Word32, TxOut) -> m ()) -> m ())
-> ((Word32, TxOut) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(i :: Word32
i, o :: TxOut
o) -> do
let op :: OutPoint
op = TxHash -> Word32 -> OutPoint
OutPoint (Tx -> TxHash
txHash Tx
tx) Word32
i
BlockRef -> OutPoint -> TxOut -> m ()
forall (m :: * -> *).
MonadImport m =>
BlockRef -> OutPoint -> TxOut -> m ()
delOutput BlockRef
br OutPoint
op TxOut
o
getImportTxData :: MonadImport m => TxHash -> m TxData
getImportTxData :: TxHash -> m TxData
getImportTxData th :: TxHash
th =
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData TxHash
th m (Maybe TxData) -> (Maybe TxData -> m TxData) -> m TxData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> do
$(Text
LogLevel
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
b :: Text
a :: Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logDebugS) "BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Tx not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m TxData
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
Just d :: TxData
d -> TxData -> m TxData
forall (m :: * -> *) a. Monad m => a -> m a
return TxData
d
getTxOut :: Word32 -> Tx -> Maybe TxOut
getTxOut :: Word32 -> Tx -> Maybe TxOut
getTxOut i :: Word32
i tx :: Tx
tx = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [TxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxOut]
txOut Tx
tx))
TxOut -> Maybe TxOut
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOut -> Maybe TxOut) -> TxOut -> Maybe TxOut
forall a b. (a -> b) -> a -> b
$ Tx -> [TxOut]
txOut Tx
tx [TxOut] -> Int -> TxOut
forall a. [a] -> Int -> a
!! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i
spendOutput :: MonadImport m => TxHash -> Word32 -> OutPoint -> m ()
spendOutput :: TxHash -> Word32 -> OutPoint -> m ()
spendOutput th :: TxHash
th ix :: Word32
ix op :: OutPoint
op = do
Unspent
u <- OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op m (Maybe Unspent) -> (Maybe Unspent -> m Unspent) -> m Unspent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just u :: Unspent
u -> Unspent -> m Unspent
forall (m :: * -> *) a. Monad m => a -> m a
return Unspent
u
Nothing -> String -> m Unspent
forall a. HasCallStack => String -> a
error (String -> m Unspent) -> String -> m Unspent
forall a b. (a -> b) -> a -> b
$ "Could not find UTXO to spend: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OutPoint -> String
forall a. Show a => a -> String
show OutPoint
op
OutPoint -> m ()
forall (m :: * -> *). StoreWrite m => OutPoint -> m ()
deleteUnspent OutPoint
op
OutPoint -> Spender -> m ()
forall (m :: * -> *). StoreWrite m => OutPoint -> Spender -> m ()
insertSpender OutPoint
op (TxHash -> Word32 -> Spender
Spender TxHash
th Word32
ix)
let pk :: ByteString
pk = ShortByteString -> ByteString
B.Short.fromShort (Unspent -> ShortByteString
unspentScript Unspent
u)
Either String Address -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ByteString -> Either String Address
scriptToAddressBS ByteString
pk) ((Address -> m ()) -> m ()) -> (Address -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a :: Address
a -> do
Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Address -> UnixTime -> m ()
decreaseBalance
(BlockRef -> Bool
confirmed (Unspent -> BlockRef
unspentBlock Unspent
u))
Address
a
(Unspent -> UnixTime
unspentAmount Unspent
u)
Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
deleteAddrUnspent Address
a Unspent
u
unspendOutputs :: MonadImport m => Tx -> m ()
unspendOutputs :: Tx -> m ()
unspendOutputs = (OutPoint -> m ()) -> [OutPoint] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ OutPoint -> m ()
forall (m :: * -> *). MonadImport m => OutPoint -> m ()
unspendOutput ([OutPoint] -> m ()) -> (Tx -> [OutPoint]) -> Tx -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [OutPoint]
prevOuts
unspendOutput :: MonadImport m => OutPoint -> m ()
unspendOutput :: OutPoint -> m ()
unspendOutput op :: OutPoint
op = do
TxData
t <- TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData (OutPoint -> TxHash
outPointHash OutPoint
op) m (Maybe TxData) -> (Maybe TxData -> m TxData) -> m TxData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> String -> m TxData
forall a. HasCallStack => String -> a
error (String -> m TxData) -> String -> m TxData
forall a b. (a -> b) -> a -> b
$ "Could not find tx data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TxHash -> String
forall a. Show a => a -> String
show (OutPoint -> TxHash
outPointHash OutPoint
op)
Just t :: TxData
t -> TxData -> m TxData
forall (m :: * -> *) a. Monad m => a -> m a
return TxData
t
let o :: TxOut
o = TxOut -> Maybe TxOut -> TxOut
forall a. a -> Maybe a -> a
fromMaybe
(String -> TxOut
forall a. HasCallStack => String -> a
error ("Could not find output: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> OutPoint -> String
forall a. Show a => a -> String
show OutPoint
op))
(Word32 -> Tx -> Maybe TxOut
getTxOut (OutPoint -> Word32
outPointIndex OutPoint
op) (TxData -> Tx
txData TxData
t))
m :: Maybe Address
m = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (ByteString -> Either String Address
scriptToAddressBS (TxOut -> ByteString
scriptOutput TxOut
o))
u :: Unspent
u = $WUnspent :: BlockRef
-> OutPoint
-> UnixTime
-> ShortByteString
-> Maybe Address
-> Unspent
Unspent { unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
, unspentBlock :: BlockRef
unspentBlock = TxData -> BlockRef
txDataBlock TxData
t
, unspentScript :: ShortByteString
unspentScript = ByteString -> ShortByteString
B.Short.toShort (TxOut -> ByteString
scriptOutput TxOut
o)
, unspentPoint :: OutPoint
unspentPoint = OutPoint
op
, unspentAddress :: Maybe Address
unspentAddress = Maybe Address
m
}
OutPoint -> m ()
forall (m :: * -> *). StoreWrite m => OutPoint -> m ()
deleteSpender OutPoint
op
Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Unspent -> m ()
insertUnspent Unspent
u
Maybe Address -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Address
m ((Address -> m ()) -> m ()) -> (Address -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a :: Address
a -> do
Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
insertAddrUnspent Address
a Unspent
u
Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Address -> UnixTime -> m ()
increaseBalance (BlockRef -> Bool
confirmed (Unspent -> BlockRef
unspentBlock Unspent
u)) Address
a (TxOut -> UnixTime
outValue TxOut
o)
modifyReceived :: MonadImport m => Address -> (Word64 -> Word64) -> m ()
modifyReceived :: Address -> (UnixTime -> UnixTime) -> m ()
modifyReceived a :: Address
a f :: UnixTime -> UnixTime
f = do
Balance
b <- Address -> m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
a
Balance -> m ()
forall (m :: * -> *). StoreWrite m => Balance -> m ()
setBalance Balance
b { balanceTotalReceived :: UnixTime
balanceTotalReceived = UnixTime -> UnixTime
f (Balance -> UnixTime
balanceTotalReceived Balance
b) }
decreaseBalance :: MonadImport m => Bool -> Address -> Word64 -> m ()
decreaseBalance :: Bool -> Address -> UnixTime -> m ()
decreaseBalance conf :: Bool
conf = Bool -> Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> Address -> UnixTime -> m ()
modBalance Bool
conf Bool
False
increaseBalance :: MonadImport m => Bool -> Address -> Word64 -> m ()
increaseBalance :: Bool -> Address -> UnixTime -> m ()
increaseBalance conf :: Bool
conf = Bool -> Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> Address -> UnixTime -> m ()
modBalance Bool
conf Bool
True
modBalance :: MonadImport m
=> Bool
-> Bool
-> Address
-> Word64
-> m ()
modBalance :: Bool -> Bool -> Address -> UnixTime -> m ()
modBalance conf :: Bool
conf add :: Bool
add a :: Address
a val :: UnixTime
val = do
Balance
b <- Address -> m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
a
Balance -> m ()
forall (m :: * -> *). StoreWrite m => Balance -> m ()
setBalance (Balance -> m ()) -> Balance -> m ()
forall a b. (a -> b) -> a -> b
$ (Balance -> Balance
g (Balance -> Balance) -> (Balance -> Balance) -> Balance -> Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Balance -> Balance
f) Balance
b
where
g :: Balance -> Balance
g b :: Balance
b = Balance
b { balanceUnspentCount :: UnixTime
balanceUnspentCount = UnixTime -> UnixTime -> UnixTime
m 1 (Balance -> UnixTime
balanceUnspentCount Balance
b) }
f :: Balance -> Balance
f b :: Balance
b | Bool
conf = Balance
b { balanceAmount :: UnixTime
balanceAmount = UnixTime -> UnixTime -> UnixTime
m UnixTime
val (Balance -> UnixTime
balanceAmount Balance
b) }
| Bool
otherwise = Balance
b { balanceZero :: UnixTime
balanceZero = UnixTime -> UnixTime -> UnixTime
m UnixTime
val (Balance -> UnixTime
balanceZero Balance
b) }
m :: UnixTime -> UnixTime -> UnixTime
m | Bool
add = UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
(+)
| Bool
otherwise = UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
subtract
modAddressCount :: MonadImport m => Bool -> Address -> m ()
modAddressCount :: Bool -> Address -> m ()
modAddressCount add :: Bool
add a :: Address
a = do
Balance
b <- Address -> m Balance
forall (m :: * -> *). StoreReadBase m => Address -> m Balance
getDefaultBalance Address
a
Balance -> m ()
forall (m :: * -> *). StoreWrite m => Balance -> m ()
setBalance Balance
b {balanceTxCount :: UnixTime
balanceTxCount = UnixTime -> UnixTime
f (Balance -> UnixTime
balanceTxCount Balance
b)}
where
f :: UnixTime -> UnixTime
f | Bool
add = (UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
+ 1)
| Bool
otherwise = UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
subtract 1
txOutAddrs :: [TxOut] -> [Address]
txOutAddrs :: [TxOut] -> [Address]
txOutAddrs = [Address] -> [Address]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' ([Address] -> [Address])
-> ([TxOut] -> [Address]) -> [TxOut] -> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String Address] -> [Address]
forall a b. [Either a b] -> [b]
rights ([Either String Address] -> [Address])
-> ([TxOut] -> [Either String Address]) -> [TxOut] -> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut -> Either String Address)
-> [TxOut] -> [Either String Address]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Either String Address
scriptToAddressBS (ByteString -> Either String Address)
-> (TxOut -> ByteString) -> TxOut -> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> ByteString
scriptOutput)
txInAddrs :: [Prev] -> [Address]
txInAddrs :: [Prev] -> [Address]
txInAddrs = [Address] -> [Address]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' ([Address] -> [Address])
-> ([Prev] -> [Address]) -> [Prev] -> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String Address] -> [Address]
forall a b. [Either a b] -> [b]
rights ([Either String Address] -> [Address])
-> ([Prev] -> [Either String Address]) -> [Prev] -> [Address]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prev -> Either String Address)
-> [Prev] -> [Either String Address]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Either String Address
scriptToAddressBS (ByteString -> Either String Address)
-> (Prev -> ByteString) -> Prev -> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prev -> ByteString
prevScript)
txDataAddresses :: TxData -> [Address]
txDataAddresses :: TxData -> [Address]
txDataAddresses t :: TxData
t =
[Address] -> [Address]
forall a. (Eq a, Hashable a) => [a] -> [a]
nub' ([Address] -> [Address]) -> [Address] -> [Address]
forall a b. (a -> b) -> a -> b
$ [Prev] -> [Address]
txInAddrs [Prev]
prevs [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
<> [TxOut] -> [Address]
txOutAddrs [TxOut]
outs
where
prevs :: [Prev]
prevs = IntMap Prev -> [Prev]
forall a. IntMap a -> [a]
I.elems (TxData -> IntMap Prev
txDataPrevs TxData
t)
outs :: [TxOut]
outs = Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
t)
isCoinbase :: Tx -> Bool
isCoinbase :: Tx -> Bool
isCoinbase = (TxIn -> Bool) -> [TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== OutPoint
nullOutPoint) (OutPoint -> Bool) -> (TxIn -> OutPoint) -> TxIn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> OutPoint
prevOutput) ([TxIn] -> Bool) -> (Tx -> [TxIn]) -> Tx -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxIn]
txIn
prevOuts :: Tx -> [OutPoint]
prevOuts :: Tx -> [OutPoint]
prevOuts tx :: Tx
tx = (OutPoint -> Bool) -> [OutPoint] -> [OutPoint]
forall a. (a -> Bool) -> [a] -> [a]
filter (OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
/= OutPoint
nullOutPoint) ((TxIn -> OutPoint) -> [TxIn] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> OutPoint
prevOutput (Tx -> [TxIn]
txIn Tx
tx))
testPresent :: StoreReadBase m => Tx -> m Bool
testPresent :: Tx -> m Bool
testPresent tx :: Tx
tx = Maybe TxData -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TxData -> Bool) -> m (Maybe TxData) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData (Tx -> TxHash
txHash Tx
tx)
streamThings :: Monad m
=> (Limits -> m [a])
-> (a -> TxHash)
-> Limits
-> ConduitT () a m ()
streamThings :: (Limits -> m [a]) -> (a -> TxHash) -> Limits -> ConduitT () a m ()
streamThings f :: Limits -> m [a]
f g :: a -> TxHash
g l :: Limits
l =
m [a] -> ConduitT () a m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Limits -> m [a]
f Limits
l{limit :: Word32
limit = 50}) ConduitT () a m [a]
-> ([a] -> ConduitT () a m ()) -> ConduitT () a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> () -> ConduitT () a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ls :: [a]
ls -> do
(a -> ConduitT () a m ()) -> [a] -> ConduitT () a m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> ConduitT () a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [a]
ls
a -> ConduitT () a m ()
forall i. a -> ConduitT i a m ()
go ([a] -> a
forall a. [a] -> a
last [a]
ls)
where
go :: a -> ConduitT i a m ()
go x :: a
x =
m [a] -> ConduitT i a m [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Limits -> m [a]
f (Word32 -> Word32 -> Maybe Start -> Limits
Limits 50 0 (Start -> Maybe Start
forall a. a -> Maybe a
Just (TxHash -> Start
AtTx (a -> TxHash
g a
x))))) ConduitT i a m [a]
-> ([a] -> ConduitT i a m ()) -> ConduitT i a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> () -> ConduitT i a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ls :: [a]
ls -> do
case (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
== a -> TxHash
g a
x) (TxHash -> Bool) -> (a -> TxHash) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TxHash
g) [a]
ls of
[] -> () -> ConduitT i a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ls' :: [a]
ls' -> do
(a -> ConduitT i a m ()) -> [a] -> ConduitT i a m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [a]
ls'
a -> ConduitT i a m ()
go ([a] -> a
forall a. [a] -> a
last [a]
ls')
joinStreams :: Monad m
=> (a -> a -> Ordering)
-> [ConduitT () a m ()]
-> ConduitT () a m ()
joinStreams :: (a -> a -> Ordering) -> [ConduitT () a m ()] -> ConduitT () a m ()
joinStreams c :: a -> a -> Ordering
c xs :: [ConduitT () a m ()]
xs = do
let ss :: [SealedConduitT () a m ()]
ss = (ConduitT () a m () -> SealedConduitT () a m ())
-> [ConduitT () a m ()] -> [SealedConduitT () a m ()]
forall a b. (a -> b) -> [a] -> [b]
map ConduitT () a m () -> SealedConduitT () a m ()
forall i o (m :: * -> *) r.
ConduitT i o m r -> SealedConduitT i o m r
sealConduitT [ConduitT () a m ()]
xs
[(SealedConduitT () a m (), a)]
ys <- ((SealedConduitT () a m (), Maybe a)
-> Maybe (SealedConduitT () a m (), a))
-> [(SealedConduitT () a m (), Maybe a)]
-> [(SealedConduitT () a m (), a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SealedConduitT () a m (), Maybe a)
-> Maybe (SealedConduitT () a m (), a)
forall (f :: * -> *) a b. Functor f => (a, f b) -> f (a, b)
j ([(SealedConduitT () a m (), Maybe a)]
-> [(SealedConduitT () a m (), a)])
-> ConduitT () a m [(SealedConduitT () a m (), Maybe a)]
-> ConduitT () a m [(SealedConduitT () a m (), a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
m [(SealedConduitT () a m (), Maybe a)]
-> ConduitT () a m [(SealedConduitT () a m (), Maybe a)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((SealedConduitT () a m () -> m (SealedConduitT () a m (), Maybe a))
-> [SealedConduitT () a m ()]
-> m [(SealedConduitT () a m (), Maybe a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SealedConduitT () a m ()
-> Sink a m (Maybe a) -> m (SealedConduitT () a m (), Maybe a)
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> Sink a m b -> m (SealedConduitT () a m (), b)
$$++ Sink a m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await) [SealedConduitT () a m ()]
ss)
Maybe a -> [(SealedConduitT () a m (), a)] -> ConduitT () a m ()
forall (m :: * -> *) i.
Monad m =>
Maybe a -> [(SealedConduitT () a m (), a)] -> ConduitT i a m ()
go Maybe a
forall a. Maybe a
Nothing [(SealedConduitT () a m (), a)]
ys
where
j :: (a, f b) -> f (a, b)
j (x :: a
x, y :: f b
y) = (,) a
x (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
y
go :: Maybe a -> [(SealedConduitT () a m (), a)] -> ConduitT i a m ()
go m :: Maybe a
m ys :: [(SealedConduitT () a m (), a)]
ys =
case ((SealedConduitT () a m (), a)
-> (SealedConduitT () a m (), a) -> Ordering)
-> [(SealedConduitT () a m (), a)]
-> [(SealedConduitT () a m (), a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a -> a -> Ordering
c (a -> a -> Ordering)
-> ((SealedConduitT () a m (), a) -> a)
-> (SealedConduitT () a m (), a)
-> (SealedConduitT () a m (), a)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (SealedConduitT () a m (), a) -> a
forall a b. (a, b) -> b
snd) [(SealedConduitT () a m (), a)]
ys of
[] -> () -> ConduitT i a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(i :: SealedConduitT () a m ()
i,x :: a
x):ys' :: [(SealedConduitT () a m (), a)]
ys' -> do
case Maybe a
m of
Nothing -> a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
Just x' :: a
x'
| a -> a -> Ordering
c a
x a
x' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ -> () -> ConduitT i a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield a
x
(SealedConduitT () a m (), Maybe a)
-> Maybe (SealedConduitT () a m (), a)
forall (f :: * -> *) a b. Functor f => (a, f b) -> f (a, b)
j ((SealedConduitT () a m (), Maybe a)
-> Maybe (SealedConduitT () a m (), a))
-> ConduitT i a m (SealedConduitT () a m (), Maybe a)
-> ConduitT i a m (Maybe (SealedConduitT () a m (), a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (SealedConduitT () a m (), Maybe a)
-> ConduitT i a m (SealedConduitT () a m (), Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SealedConduitT () a m ()
i SealedConduitT () a m ()
-> Sink a m (Maybe a) -> m (SealedConduitT () a m (), Maybe a)
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> Sink a m b -> m (SealedConduitT () a m (), b)
$$++ Sink a m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await) ConduitT i a m (Maybe (SealedConduitT () a m (), a))
-> (Maybe (SealedConduitT () a m (), a) -> ConduitT i a m ())
-> ConduitT i a m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Nothing -> Maybe a -> [(SealedConduitT () a m (), a)] -> ConduitT i a m ()
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [(SealedConduitT () a m (), a)]
ys'
Just y :: (SealedConduitT () a m (), a)
y -> Maybe a -> [(SealedConduitT () a m (), a)] -> ConduitT i a m ()
go (a -> Maybe a
forall a. a -> Maybe a
Just a
x) ((SealedConduitT () a m (), a)
y(SealedConduitT () a m (), a)
-> [(SealedConduitT () a m (), a)]
-> [(SealedConduitT () a m (), a)]
forall a. a -> [a] -> [a]
:[(SealedConduitT () a m (), a)]
ys')