{-# 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
| OrphanLoop
| SpenderNotFound
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"
show ImportException
OrphanLoop = String
"Orphan loop"
show ImportException
SpenderNotFound = String
"Spender not found"
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 (HashSet TxHash) -> m ()) -> m (HashSet TxHash) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (HashSet TxHash) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (HashSet TxHash) -> m ()) -> m (HashSet TxHash) -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(LogSource -> LogSource -> m ()
logDebugS) LogSource
"BlockStore" LogSource
"Importing Genesis block"
Block -> BlockNode -> m (HashSet TxHash)
forall (m :: * -> *).
MonadImport m =>
Block -> BlockNode -> m (HashSet TxHash)
importBlock (Network -> Block
genesisBlock Network
net) (Network -> BlockNode
genesisNode Network
net)
newMempoolTx :: MonadImport m => Tx -> UnixTime -> m (Maybe (HashSet TxHash))
newMempoolTx :: Tx -> UnixTime -> m (Maybe (HashSet TxHash))
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 (Maybe (HashSet TxHash)))
-> m (Maybe (HashSet TxHash))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just TxData
_ ->
Maybe (HashSet TxHash) -> m (Maybe (HashSet TxHash))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (HashSet TxHash)
forall a. Maybe a
Nothing
Maybe TxData
Nothing -> do
HashSet TxHash
txids <- Bool -> Bool -> Tx -> m (HashSet TxHash)
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> Tx -> m (HashSet TxHash)
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
Maybe (HashSet TxHash) -> m (Maybe (HashSet TxHash))
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet TxHash -> Maybe (HashSet TxHash)
forall a. a -> Maybe a
Just HashSet TxHash
txids)
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 [TxHash]
forall (m :: * -> *). MonadImport m => TxHash -> m [TxHash]
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 (HashSet TxHash)
importOrConfirm :: BlockNode -> [Tx] -> m (HashSet TxHash)
importOrConfirm BlockNode
bn [Tx]
txns = do
HashSet TxHash
ths <- (HashSet TxHash -> HashSet TxHash -> HashSet TxHash)
-> HashSet TxHash -> [HashSet TxHash] -> HashSet TxHash
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HashSet TxHash -> HashSet TxHash -> HashSet TxHash
forall a. Semigroup a => a -> a -> a
(<>) HashSet TxHash
forall a. HashSet a
HashSet.empty ([HashSet TxHash] -> HashSet TxHash)
-> m [HashSet TxHash] -> m (HashSet TxHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word32, Tx) -> m (HashSet TxHash))
-> [(Word32, Tx)] -> m [HashSet TxHash]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> Tx -> m (HashSet TxHash)
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> Tx -> m (HashSet TxHash)
freeOutputs Bool
True Bool
False (Tx -> m (HashSet TxHash))
-> ((Word32, Tx) -> Tx) -> (Word32, Tx) -> m (HashSet TxHash)
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
HashSet TxHash -> m (HashSet TxHash)
forall (m :: * -> *) a. Monad m => a -> m a
return HashSet TxHash
ths
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 (HashSet TxHash)
importBlock :: Block -> BlockNode -> m (HashSet TxHash)
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))
HashSet TxHash
ths <- BlockNode -> [Tx] -> m (HashSet TxHash)
forall (m :: * -> *).
MonadImport m =>
BlockNode -> [Tx] -> m (HashSet TxHash)
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))
HashSet TxHash -> m (HashSet TxHash)
forall (m :: * -> *) a. Monad m => a -> m a
return HashSet TxHash
ths
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
-> Bool
-> 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
-> Bool
-> Tx
-> m (HashSet TxHash)
freeOutputs :: Bool -> Bool -> Tx -> m (HashSet TxHash)
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]
del <- ([[TxHash]] -> [TxHash]) -> m [[TxHash]] -> m [TxHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[TxHash]] -> [TxHash]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[TxHash]] -> m [TxHash]) -> m [[TxHash]] -> m [TxHash]
forall a b. (a -> b) -> a -> b
$ (TxHash -> m [TxHash]) -> [TxHash] -> m [[TxHash]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool -> Bool -> TxHash -> m [TxHash]
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [TxHash]
deleteTx Bool
memonly Bool
rbfcheck) ([TxHash] -> m [[TxHash]]) -> [TxHash] -> m [[TxHash]]
forall a b. (a -> b) -> a -> b
$ HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
HashSet.toList HashSet TxHash
txids
HashSet TxHash -> m (HashSet TxHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashSet TxHash -> m (HashSet TxHash))
-> HashSet TxHash -> m (HashSet TxHash)
forall a b. (a -> b) -> a -> b
$ [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList [TxHash]
del
deleteConfirmedTx :: MonadImport m => TxHash -> m [TxHash]
deleteConfirmedTx :: TxHash -> m [TxHash]
deleteConfirmedTx = Bool -> Bool -> TxHash -> m [TxHash]
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [TxHash]
deleteTx Bool
False Bool
False
deleteUnconfirmedTx :: MonadImport m => Bool -> TxHash -> m [TxHash]
deleteUnconfirmedTx :: Bool -> TxHash -> m [TxHash]
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 [TxHash]) -> m [TxHash]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just TxData
_ -> Bool -> Bool -> TxHash -> m [TxHash]
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [TxHash]
deleteTx Bool
True Bool
rbfcheck TxHash
th
Maybe TxData
Nothing -> do
$(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
[TxHash] -> m [TxHash]
forall (m :: * -> *) a. Monad m => a -> m a
return []
deleteTx :: MonadImport m
=> Bool
-> Bool
-> TxHash
-> m [TxHash]
deleteTx :: Bool -> Bool -> TxHash -> m [TxHash]
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 [TxHash]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
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
-> Bool
-> 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
-> Bool
-> 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)