{-# 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
    ) where

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           Data.Either             (rights)
import           Data.HashSet            (HashSet)
import qualified Data.HashSet            as HashSet
import qualified Data.IntMap.Strict      as I
import           Data.List               (nub)
import           Data.Maybe              (catMaybes, fromMaybe, isJust,
                                          isNothing)
import           Data.Serialize          (encode)
import           Data.String.Conversions (cs)
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
    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 ImportException
PrevBlockNotBest    = String
"Previous block not best"
    show ImportException
Orphan              = String
"Orphan"
    show ImportException
UnexpectedCoinbase  = String
"Unexpected coinbase"
    show ImportException
BestBlockNotFound   = String
"Best block not found"
    show ImportException
BlockNotBest        = String
"Block not best"
    show ImportException
TxNotFound          = String
"Transaction not found"
    show ImportException
DoubleSpend         = String
"Double spend"
    show ImportException
TxConfirmed         = String
"Transaction confirmed"
    show ImportException
InsufficientFunds   = String
"Insufficient funds"
    show ImportException
DuplicatePrevOutput = String
"Duplicate previous output"
    show ImportException
TxSpent             = String
"Transaction is spent"

initBest :: MonadImport m => m ()
initBest :: m ()
initBest = do
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" LogSource
"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
        $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" LogSource
"Importing Genesis block"
        Block -> BlockNode -> m ()
forall (m :: * -> *). MonadImport m => Block -> BlockNode -> m ()
importBlock (Network -> Block
genesisBlock Network
net) (Network -> BlockNode
genesisNode Network
net)

newMempoolTx :: MonadImport m => Tx -> UnixTime -> m Bool
newMempoolTx :: Tx -> UnixTime -> m Bool
newMempoolTx Tx
tx 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 TxData
_ ->
            Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Maybe TxData
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
        Maybe BlockHash
Nothing -> do
            $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" LogSource
"Best block unknown"
            ImportException -> m BlockHash
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
        Just 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
        Maybe BlockData
Nothing -> do
            $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" LogSource
"Best block not found"
            ImportException -> m BlockData
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
        Just 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 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
>>= \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
            $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                LogSource
"Cannot revert non-head block: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
            ImportException -> m BlockData
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BlockNotBest
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Obtained block data for " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
    [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)
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Obtained import tx data for block " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
    BlockHash -> m ()
forall (m :: * -> *). StoreWrite m => BlockHash -> m ()
setBest (BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bd))
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Set parent as best block " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<>
        BlockHash -> LogSource
blockHashToHex (BlockHeader -> BlockHash
prevBlock (BlockData -> BlockHeader
blockDataHeader BlockData
bd))
    BlockData -> m ()
forall (m :: * -> *). StoreWrite m => BlockData -> m ()
insertBlock BlockData
bd {blockDataMainChain :: Bool
blockDataMainChain = Bool
False}
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Updated as not in main chain: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex BlockHash
bh
    [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
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Unconfirmed " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
tds)) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" transactions"
    TxHash -> m ()
forall (m :: * -> *). MonadImport m => TxHash -> m ()
deleteConfirmedTx (Tx -> TxHash
txHash (TxData -> Tx
txData ([TxData] -> TxData
forall a. [a] -> a
head [TxData]
tds)))
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Deleted coinbase: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex (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 Block
b 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
        Maybe BlockHash
Nothing
            | BlockNode -> Bool
isGenesis BlockNode
n -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise -> do
                $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                    LogSource
"Cannot import non-genesis block: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
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 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
                $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                    LogSource
"Block does not build on head: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
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 BlockNode
bn [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 Word32
i = BlockRef :: 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 Word32
i 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
            Bool
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
            Bool
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 Word32
i 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 TxData
t -> do
                $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                    LogSource
"Confirming tx: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
            Maybe TxData
Nothing -> do
                $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                    LogSource
"Cannot find tx to confirm: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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 Word32
i Tx
tx = do
        $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Importing tx: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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 Block
b BlockNode
n = do
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Checking new block: "
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n))
    Block -> BlockNode -> m ()
forall (m :: * -> *). MonadImport m => Block -> BlockNode -> m ()
checkNewBlock Block
b BlockNode
n
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" LogSource
"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)
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Inserting block entries for: "
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
blockHashToHex (BlockHeader -> BlockHash
headerHash (BlockNode -> BlockHeader
nodeHeader BlockNode
n))
    BlockData -> m ()
forall (m :: * -> *). StoreWrite m => BlockData -> m ()
insertBlock
        BlockData :: Word32
-> Bool
-> Integer
-> BlockHeader
-> Word32
-> Word32
-> [TxHash]
-> UnixTime
-> UnixTime
-> UnixTime
-> BlockData
BlockData
            { blockDataHeight :: Word32
blockDataHeight = BlockNode -> Word32
nodeHeight BlockNode
n
            , blockDataMainChain :: Bool
blockDataMainChain = Bool
True
            , blockDataWork :: Integer
blockDataWork = BlockNode -> Integer
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 Word32
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)
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Finished importing transactions for: "
        LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> BlockHash -> LogSource
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 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
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x

checkNewTx :: MonadImport m => Tx -> m ()
checkNewTx :: Tx -> m ()
checkNewTx 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
        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Transaction spends same output twice: "
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Orphan: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Coinbase cannot be imported into mempool: "
            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Orphan: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
            LogSource
"Insufficient funds for tx: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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 = (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 Bool
rbf BlockRef
br UnixTime
tt Tx
tx [Unspent]
us =
    TxData :: 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 Unspent
u = ByteString -> UnixTime -> Prev
Prev (Unspent -> ByteString
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 [Int
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 -- ^ unix time
    -> Bool -- ^ RBF
    -> Tx
    -> m ()
importTx :: BlockRef -> UnixTime -> Bool -> Tx -> m ()
importTx BlockRef
br UnixTime
tt Bool
rbf 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
        Maybe Unspent
Nothing -> do
            $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                LogSource
"Attempted to import a tx missing UTXO: "
                LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex (Tx -> TxHash
txHash Tx
tx)
            ImportException -> m Unspent
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
Orphan
        Just 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 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 TxData
t 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 TxData
t 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
$ \Address
a -> do
    Address -> TxRef -> m ()
forall (m :: * -> *). StoreWrite m => Address -> TxRef -> m ()
deleteAddrTx
        Address
a
        TxRef :: 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
        TxRef :: 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 OutPoint
op TxOut
o BlockRef
old 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
        Maybe Unspent
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just 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
$ String
"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 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
            Unspent :: BlockRef
-> OutPoint -> UnixTime -> ByteString -> Maybe Address -> Unspent
Unspent
                { unspentBlock :: BlockRef
unspentBlock = BlockRef
new
                , unspentPoint :: OutPoint
unspentPoint = OutPoint
op
                , unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
                , unspentScript :: ByteString
unspentScript = 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 ByteString
pk Address
a = do
        Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
deleteAddrUnspent
            Address
a
            Unspent :: BlockRef
-> OutPoint -> UnixTime -> ByteString -> Maybe Address -> Unspent
Unspent
                { unspentBlock :: BlockRef
unspentBlock = BlockRef
old
                , unspentPoint :: OutPoint
unspentPoint = OutPoint
op
                , unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
                , unspentScript :: ByteString
unspentScript = 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
            Unspent :: BlockRef
-> OutPoint -> UnixTime -> ByteString -> Maybe Address -> Unspent
Unspent
                { unspentBlock :: BlockRef
unspentBlock = BlockRef
new
                , unspentPoint :: OutPoint
unspentPoint = OutPoint
op
                , unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
                , unspentScript :: ByteString
unspentScript = 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 TxData
t 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 [Word32
0 ..] (Tx -> [TxOut]
txOut (TxData -> Tx
txData TxData
t))) (((Word32, TxOut) -> m ()) -> m ())
-> ((Word32, TxOut) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Word32
n, 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 -- ^ only delete transaction if unconfirmed
    -> Bool -- ^ only delete RBF
    -> Tx
    -> m ()
freeOutputs :: Bool -> Bool -> Tx -> m ()
freeOutputs Bool
memonly Bool
rbfcheck Tx
tx = do
    let prevs :: [OutPoint]
prevs = Tx -> [OutPoint]
prevOuts Tx
tx
    [Maybe Unspent]
unspents <- (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 [OutPoint]
prevs
    let spents :: [OutPoint]
spents = [ OutPoint
p | (OutPoint
p, Maybe Unspent
Nothing) <- [OutPoint] -> [Maybe Unspent] -> [(OutPoint, Maybe Unspent)]
forall a b. [a] -> [b] -> [(a, b)]
zip [OutPoint]
prevs [Maybe Unspent]
unspents ]
    [Spender]
spndrs <- [Maybe Spender] -> [Spender]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Spender] -> [Spender]) -> m [Maybe Spender] -> m [Spender]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OutPoint -> m (Maybe Spender)) -> [OutPoint] -> m [Maybe Spender]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM OutPoint -> m (Maybe Spender)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Spender)
getSpender [OutPoint]
spents
    let txids :: HashSet TxHash
txids = [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash) -> [TxHash] -> HashSet TxHash
forall a b. (a -> b) -> a -> b
$ (TxHash -> Bool) -> [TxHash] -> [TxHash]
forall a. (a -> Bool) -> [a] -> [a]
filter (TxHash -> TxHash -> Bool
forall a. Eq a => a -> a -> Bool
/= Tx -> TxHash
txHash Tx
tx) ([TxHash] -> [TxHash]) -> [TxHash] -> [TxHash]
forall a b. (a -> b) -> a -> b
$ (Spender -> TxHash) -> [Spender] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map Spender -> TxHash
spenderHash [Spender]
spndrs
    (TxHash -> m ()) -> [TxHash] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Bool -> TxHash -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m ()
deleteTx Bool
memonly Bool
rbfcheck) ([TxHash] -> m ()) -> [TxHash] -> m ()
forall a b. (a -> b) -> a -> b
$ HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
txids

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 Bool
rbfcheck 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 TxData
_ -> Bool -> Bool -> TxHash -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m ()
deleteTx Bool
True Bool
rbfcheck TxHash
th
        Maybe TxData
Nothing ->
          $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
          LogSource
"Not found or already deleted: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th

deleteTx :: MonadImport m
         => Bool -- ^ only delete transaction if unconfirmed
         -> Bool -- ^ only delete RBF
         -> TxHash
         -> m ()
deleteTx :: Bool -> Bool -> TxHash -> m ()
deleteTx Bool
memonly Bool
rbfcheck TxHash
th = do
    [Tx]
chain <- Bool -> Bool -> TxHash -> m [Tx]
forall (m :: * -> *).
(MonadImport m, MonadLoggerIO m) =>
Bool -> Bool -> TxHash -> m [Tx]
getChain Bool
memonly Bool
rbfcheck TxHash
th
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Deleting " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> String -> LogSource
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
chain)) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<>
        LogSource
" txs from chain leading to " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th
    (Tx -> m TxHash) -> [Tx] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Tx
t -> let h :: TxHash
h = Tx -> TxHash
txHash Tx
t in TxHash -> m ()
forall (m :: * -> *). MonadImport m => TxHash -> m ()
deleteSingleTx TxHash
h m () -> m TxHash -> m TxHash
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxHash -> m TxHash
forall (m :: * -> *) a. Monad m => a -> m a
return TxHash
h) [Tx]
chain

getChain :: (MonadImport m, MonadLoggerIO m)
         => Bool -- ^ only delete transaction if unconfirmed
         -> Bool -- ^ only delete RBF
         -> TxHash
         -> m [Tx]
getChain :: Bool -> Bool -> TxHash -> m [Tx]
getChain Bool
memonly Bool
rbfcheck TxHash
th' = do
    $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
        LogSource
"Getting chain for tx " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th'
    [Tx] -> [Tx]
sort_clean ([Tx] -> [Tx]) -> m [Tx] -> m [Tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet Tx -> HashSet TxHash -> m [Tx]
forall (m :: * -> *).
(StoreReadBase m, MonadLogger m, MonadError ImportException m) =>
HashSet Tx -> HashSet TxHash -> m [Tx]
go HashSet Tx
forall a. HashSet a
HashSet.empty (TxHash -> HashSet TxHash
forall a. Hashable a => a -> HashSet a
HashSet.singleton TxHash
th')
  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
    get_tx :: TxHash -> m Tx
get_tx TxHash
th =
        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
            Maybe TxData
Nothing -> do
                $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                    LogSource
"Transaction not found: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th
                ImportException -> m Tx
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
            Just TxData
td
              | Bool
memonly Bool -> Bool -> Bool
&& BlockRef -> Bool
confirmed (TxData -> BlockRef
txDataBlock TxData
td) -> do
                $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                    LogSource
"Transaction already confirmed: "
                    LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
                    Bool
True -> 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
$ TxData -> Tx
txData TxData
td
                    Bool
False -> do
                        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                            LogSource
"Double-spending transaction: "
                            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th
                        ImportException -> m Tx
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
DoubleSpend
              | Bool
otherwise -> 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
$ TxData -> Tx
txData TxData
td
    go :: HashSet Tx -> HashSet TxHash -> m [Tx]
go HashSet Tx
txs HashSet TxHash
pdg = do
        HashSet Tx
txs1 <- [Tx] -> HashSet Tx
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([Tx] -> HashSet Tx) -> m [Tx] -> m (HashSet 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 TxHash -> m Tx
forall (m :: * -> *).
(StoreReadBase m, MonadLogger m, MonadError ImportException m) =>
TxHash -> m Tx
get_tx (HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
pdg)
        HashSet TxHash
pdg1 <- [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList ([TxHash] -> HashSet TxHash)
-> ([IntMap Spender] -> [TxHash])
-> [IntMap Spender]
-> HashSet TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Spender -> [TxHash]) -> [IntMap Spender] -> [TxHash]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((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] -> HashSet TxHash)
-> m [IntMap Spender] -> m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (TxHash -> m (IntMap Spender)) -> [TxHash] -> m [IntMap Spender]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> m (IntMap Spender)
forall (m :: * -> *).
StoreReadBase m =>
TxHash -> m (IntMap Spender)
getSpenders (HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
pdg)
        let txs' :: HashSet Tx
txs' = HashSet Tx
txs1 HashSet Tx -> HashSet Tx -> HashSet Tx
forall a. Semigroup a => a -> a -> a
<> HashSet Tx
txs
            pdg' :: HashSet TxHash
pdg' = HashSet TxHash
pdg1 HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HashSet.difference` (Tx -> TxHash) -> HashSet Tx -> HashSet TxHash
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HashSet.map Tx -> TxHash
txHash HashSet Tx
txs'
        if HashSet TxHash -> Bool
forall a. HashSet a -> Bool
HashSet.null HashSet TxHash
pdg'
            then [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
$ HashSet Tx -> [Tx]
forall a. HashSet a -> [a]
HashSet.toList HashSet Tx
txs'
            else HashSet Tx -> HashSet TxHash -> m [Tx]
go HashSet Tx
txs' HashSet TxHash
pdg'

deleteSingleTx :: MonadImport m => TxHash -> m ()
deleteSingleTx :: TxHash -> m ()
deleteSingleTx 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
        Maybe TxData
Nothing -> do
            $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                LogSource
"Already deleted: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th
            ImportException -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
        Just TxData
td -> do
            $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                LogSource
"Deleting tx: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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
                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
                        $(LogSource -> LogSource -> m ()
logErrorS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$
                            LogSource
"Tried to delete spent tx: "
                            LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
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 Bool
add 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 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{txDataBlock :: TxData -> BlockRef
txDataBlock = MemRef 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 =
    (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)) [Word32
0 ..] (Tx -> [OutPoint]
prevOuts Tx
tx)

addOutputs :: MonadImport m => BlockRef -> Tx -> m ()
addOutputs :: BlockRef -> Tx -> m ()
addOutputs BlockRef
br 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)) [Word32
0 ..] (Tx -> [TxOut]
txOut Tx
tx)

isRBF :: StoreReadBase m
      => BlockRef
      -> Tx
      -> m Bool
isRBF :: BlockRef -> Tx -> m Bool
isRBF BlockRef
br 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
>>= \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
< Word32
0xffffffff Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
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 (TxHash
h : [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
                    Maybe TxData
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                    Just 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 Bool
add BlockRef
br OutPoint
op 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
$ \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 = Unspent :: BlockRef
-> OutPoint -> UnixTime -> ByteString -> Maybe Address -> Unspent
Unspent { unspentScript :: ByteString
unspentScript = 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 BlockRef
br 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 [Word32
0..] (Tx -> [TxOut]
txOut Tx
tx)) (((Word32, TxOut) -> m ()) -> m ())
-> ((Word32, TxOut) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Word32
i, 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 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
        Maybe TxData
Nothing -> do
            $(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Tx not found: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th
            ImportException -> m TxData
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
        Just 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 Word32
i 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 TxHash
th Word32
ix 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 Unspent
u  -> Unspent -> m Unspent
forall (m :: * -> *) a. Monad m => a -> m a
return Unspent
u
        Maybe Unspent
Nothing -> String -> m Unspent
forall a. HasCallStack => String -> a
error (String -> m Unspent) -> String -> m Unspent
forall a b. (a -> b) -> a -> b
$ String
"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 = Unspent -> ByteString
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
$ \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 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
        Maybe TxData
Nothing -> String -> m TxData
forall a. HasCallStack => String -> a
error (String -> m TxData) -> String -> m TxData
forall a b. (a -> b) -> a -> b
$ String
"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 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 (String
"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 = Unspent :: BlockRef
-> OutPoint -> UnixTime -> ByteString -> Maybe Address -> Unspent
Unspent { unspentAmount :: UnixTime
unspentAmount = TxOut -> UnixTime
outValue TxOut
o
                    , unspentBlock :: BlockRef
unspentBlock = TxData -> BlockRef
txDataBlock TxData
t
                    , unspentScript :: ByteString
unspentScript = 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
$ \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 Address
a 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 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 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 -- ^ confirmed
           -> Bool -- ^ add
           -> Address
           -> Word64
           -> m ()
modBalance :: Bool -> Bool -> Address -> UnixTime -> m ()
modBalance Bool
conf Bool
add Address
a 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 Balance
b = Balance
b { balanceUnspentCount :: UnixTime
balanceUnspentCount = UnixTime -> UnixTime -> UnixTime
m UnixTime
1 (Balance -> UnixTime
balanceUnspentCount Balance
b) }
    f :: Balance -> Balance
f 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 Bool
add 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
+ UnixTime
1)
      | Bool
otherwise = UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
subtract UnixTime
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 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 = (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 = 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)