{-# 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 ->
  -- | unix time
  Word64 ->
  -- | RBF
  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 =>
  -- | only delete transaction if unconfirmed
  Bool ->
  -- | only delete RBF
  Bool ->
  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 =>
  -- | only delete transaction if unconfirmed
  Bool ->
  -- | only delete RBF
  Bool ->
  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) =>
  -- | only delete transaction if unconfirmed
  Bool ->
  -- | only delete RBF
  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 (Maybe 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 (Maybe Tx)) -> m (Maybe Tx)
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
"Transaction not found: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> TxHash -> LogSource
txHashToHex TxHash
th
          Maybe Tx -> m (Maybe Tx)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Tx
forall a. Maybe a
Nothing
        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 (Maybe 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 (Maybe Tx)) -> m (Maybe Tx)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Bool
True -> Maybe Tx -> m (Maybe Tx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Tx -> m (Maybe Tx)) -> Maybe Tx -> m (Maybe Tx)
forall a b. (a -> b) -> a -> b
$ Tx -> Maybe Tx
forall a. a -> Maybe a
Just (Tx -> Maybe Tx) -> Tx -> Maybe 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 (Maybe Tx)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
DoubleSpend
          | Bool
otherwise -> Maybe Tx -> m (Maybe Tx)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Tx -> m (Maybe Tx)) -> Maybe Tx -> m (Maybe Tx)
forall a b. (a -> b) -> a -> b
$ Tx -> Maybe Tx
forall a. a -> Maybe a
Just (Tx -> Maybe Tx) -> Tx -> Maybe 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)
-> ([Maybe Tx] -> [Tx]) -> [Maybe Tx] -> HashSet Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Tx] -> [Tx]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Tx] -> HashSet Tx) -> m [Maybe Tx] -> m (HashSet Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> m (Maybe Tx)) -> [TxHash] -> m [Maybe Tx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TxHash -> m (Maybe Tx)
forall (m :: * -> *).
(StoreReadBase m, MonadLogger m, MonadError ImportException m) =>
TxHash -> m (Maybe 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 =>
  -- | confirmed
  Bool ->
  -- | add
  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)