{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
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 qualified Data.HashMap.Strict as M
import qualified Data.HashSet as H
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 (..),
Ctx,
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
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
$c== :: ImportException -> ImportException -> Bool
== :: ImportException -> ImportException -> Bool
$c/= :: ImportException -> ImportException -> Bool
/= :: 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
$ccompare :: ImportException -> ImportException -> Ordering
compare :: ImportException -> ImportException -> Ordering
$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
>= :: ImportException -> ImportException -> Bool
$cmax :: ImportException -> ImportException -> ImportException
max :: ImportException -> ImportException -> ImportException
$cmin :: ImportException -> ImportException -> ImportException
min :: ImportException -> ImportException -> 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
$ctoException :: ImportException -> SomeException
toException :: ImportException -> SomeException
$cfromException :: SomeException -> Maybe ImportException
fromException :: SomeException -> Maybe ImportException
$cdisplayException :: ImportException -> String
displayException :: ImportException -> String
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 :: forall (m :: * -> *). MonadImport m => m ()
initBest = do
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
$(logDebugS) Text
"BlockStore" Text
"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 (BlockData, [TxData]) -> m ())
-> m (BlockData, [TxData])
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (BlockData, [TxData]) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (BlockData, [TxData]) -> m ())
-> m (BlockData, [TxData]) -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(logDebugS) Text
"BlockStore" Text
"Importing Genesis block"
Block -> BlockNode -> m (BlockData, [TxData])
forall (m :: * -> *).
MonadImport m =>
Block -> BlockNode -> m (BlockData, [TxData])
importBlock (Network -> Ctx -> Block
genesisBlock Network
net Ctx
ctx) (Network -> BlockNode
genesisNode Network
net)
newMempoolTx :: (MonadImport m) => Tx -> UnixTime -> m Bool
newMempoolTx :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just TxData
_ ->
Bool -> m Bool
forall a. a -> m a
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
TxData
_ <- BlockRef -> UnixTime -> Bool -> Tx -> m TxData
forall (m :: * -> *).
MonadImport m =>
BlockRef -> UnixTime -> Bool -> Tx -> m TxData
importTx (UnixTime -> BlockRef
MemRef UnixTime
w) UnixTime
w Bool
rbf Tx
tx
Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
bestBlockData :: (MonadImport m) => m BlockData
bestBlockData :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe BlockHash
Nothing -> do
$(logErrorS) Text
"BlockStore" Text
"Best block unknown"
ImportException -> m BlockHash
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
Just BlockHash
h -> BlockHash -> m BlockHash
forall a. a -> m a
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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe BlockData
Nothing -> do
$(logErrorS) Text
"BlockStore" Text
"Best block not found"
ImportException -> m BlockData
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
Just BlockData
b -> BlockData -> m BlockData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
revertBlock :: (MonadImport m) => BlockHash -> m ()
revertBlock :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \BlockData
b ->
if BlockHeader -> BlockHash
headerHash BlockData
b.header BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
bh
then BlockData -> m BlockData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockData
b
else do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Cannot revert non-head block: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bh
ImportException -> m BlockData
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BlockNotBest
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Obtained block data for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxHash -> m TxData
forall (m :: * -> *). MonadImport m => TxHash -> m TxData
getImportTxData BlockData
bd.txs
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Obtained import tx data for block " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bh
BlockHash -> m ()
forall (m :: * -> *). StoreWrite m => BlockHash -> m ()
setBest BlockData
bd.header.prev
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Set parent as best block "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockData
bd.header.prev
BlockData -> m ()
forall (m :: * -> *). StoreWrite m => BlockData -> m ()
insertBlock BlockData
bd {main = False}
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Updated as not in main chain: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex BlockHash
bh
[TxData] -> (TxData -> m TxData) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([TxData] -> [TxData]
forall a. HasCallStack => [a] -> [a]
tail [TxData]
tds) TxData -> m TxData
forall (m :: * -> *). MonadImport m => TxData -> m TxData
unConfirmTx
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Unconfirmed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([TxData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxData]
tds)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" transactions"
TxHash -> m ()
forall (m :: * -> *). MonadImport m => TxHash -> m ()
deleteConfirmedTx (Tx -> TxHash
txHash ([TxData] -> TxData
forall a. HasCallStack => [a] -> a
head [TxData]
tds).tx)
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Deleted coinbase: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash ([TxData] -> TxData
forall a. HasCallStack => [a] -> a
head [TxData]
tds).tx)
checkNewBlock :: (MonadImport m) => Block -> BlockNode -> m ()
checkNewBlock :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe BlockHash
Nothing
| BlockNode -> Bool
isGenesis BlockNode
n -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Cannot import non-genesis block: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash Block
b.header)
ImportException -> m ()
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
BestBlockNotFound
Just BlockHash
h
| Block
b.header.prev BlockHash -> BlockHash -> Bool
forall a. Eq a => a -> a -> Bool
== BlockHash
h -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Block does not build on head: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash Block
b.header)
ImportException -> m ()
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
PrevBlockNotBest
importOrConfirm :: (MonadImport m) => BlockNode -> [Tx] -> m [TxData]
importOrConfirm :: forall (m :: * -> *).
MonadImport m =>
BlockNode -> [Tx] -> m [TxData]
importOrConfirm BlockNode
bn [Tx]
txns = do
$(logDebugS) Text
"BlockStore" Text
"Freeing outputs..."
((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)
$(logDebugS) Text
"BlockStore" Text
"Outputs freed"
((Word32, Tx) -> m TxData) -> [(Word32, Tx)] -> m [TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Word32 -> Tx -> m TxData) -> (Word32, Tx) -> m TxData
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word32 -> Tx -> m TxData
forall {m :: * -> *}.
(StoreReadBase m, MonadError ImportException m, MonadLoggerIO m,
StoreWrite m) =>
Word32 -> Tx -> m TxData
action) [(Word32, Tx)]
txs
where
txs :: [(Word32, Tx)]
txs = [Tx] -> [(Word32, Tx)]
sortTxs [Tx]
txns
br :: Word32 -> BlockRef
br Word32
i = BlockRef {height :: Word32
height = BlockNode
bn.height, position :: Word32
position = Word32
i}
bn_time :: UnixTime
bn_time = Word32 -> UnixTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> UnixTime) -> Word32 -> UnixTime
forall a b. (a -> b) -> a -> b
$ BlockNode
bn.header.timestamp
action :: Word32 -> Tx -> m TxData
action Word32
i Tx
tx =
Tx -> m Bool
forall (m :: * -> *). StoreReadBase m => Tx -> m Bool
testPresent Tx
tx m Bool -> (Bool -> m TxData) -> m TxData
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> Word32 -> Tx -> m TxData
forall {m :: * -> *}.
(MonadError ImportException m, MonadLoggerIO m, StoreReadBase m,
StoreWrite m) =>
Word32 -> Tx -> m TxData
import_it Word32
i Tx
tx
Bool
True -> Word32 -> Tx -> m TxData
forall {m :: * -> *}.
(StoreReadBase m, MonadError ImportException m, MonadLoggerIO m,
StoreWrite m) =>
Word32 -> Tx -> m TxData
confirm_it Word32
i Tx
tx
confirm_it :: Word32 -> Tx -> m TxData
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 TxData) -> m TxData
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just TxData
t -> do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Confirming tx: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
TxData -> BlockRef -> m TxData
forall (m :: * -> *).
MonadImport m =>
TxData -> BlockRef -> m TxData
confirmTx TxData
t (Word32 -> BlockRef
br Word32
i)
Maybe TxData
Nothing -> do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Cannot find tx to confirm: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m TxData
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
import_it :: Word32 -> Tx -> m TxData
import_it Word32
i Tx
tx = do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Importing tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
BlockRef -> UnixTime -> Bool -> Tx -> m TxData
forall (m :: * -> *).
MonadImport m =>
BlockRef -> UnixTime -> Bool -> Tx -> m TxData
importTx (Word32 -> BlockRef
br Word32
i) UnixTime
bn_time Bool
False Tx
tx
importBlock :: (MonadImport m) => Block -> BlockNode -> m (BlockData, [TxData])
importBlock :: forall (m :: * -> *).
MonadImport m =>
Block -> BlockNode -> m (BlockData, [TxData])
importBlock Block
b BlockNode
n = do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Checking new block: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash BlockNode
n.header)
Block -> BlockNode -> m ()
forall (m :: * -> *). MonadImport m => Block -> BlockNode -> m ()
checkNewBlock Block
b BlockNode
n
$(logDebugS) Text
"BlockStore" Text
"Passed check"
Network
net <- m Network
forall (m :: * -> *). StoreReadBase m => m Network
getNetwork
let subsidy :: UnixTime
subsidy = Network -> Word32 -> UnixTime
computeSubsidy Network
net BlockNode
n.height
[BlockHash]
bs <- Word32 -> m [BlockHash]
forall (m :: * -> *). StoreReadBase m => Word32 -> m [BlockHash]
getBlocksAtHeight BlockNode
n.height
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Inserting block entries for: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash BlockNode
n.header)
[BlockHash] -> Word32 -> m ()
forall (m :: * -> *). StoreWrite m => [BlockHash] -> Word32 -> m ()
setBlocksAtHeight
([BlockHash] -> [BlockHash]
forall a. Eq a => [a] -> [a]
nub (BlockHeader -> BlockHash
headerHash BlockNode
n.header BlockHash -> [BlockHash] -> [BlockHash]
forall a. a -> [a] -> [a]
: [BlockHash]
bs))
BlockNode
n.height
BlockHash -> m ()
forall (m :: * -> *). StoreWrite m => BlockHash -> m ()
setBest (BlockHeader -> BlockHash
headerHash BlockNode
n.header)
[TxData]
tds <- BlockNode -> [Tx] -> m [TxData]
forall (m :: * -> *).
MonadImport m =>
BlockNode -> [Tx] -> m [TxData]
importOrConfirm BlockNode
n Block
b.txs
let bd :: BlockData
bd =
BlockData
{ height :: Word32
height = BlockNode
n.height,
main :: Bool
main = Bool
True,
work :: Integer
work = BlockNode
n.work,
header :: BlockHeader
header = BlockNode
n.header,
size :: Word32
size = 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)),
txs :: [TxHash]
txs = (Tx -> TxHash) -> [Tx] -> [TxHash]
forall a b. (a -> b) -> [a] -> [b]
map Tx -> TxHash
txHash Block
b.txs,
weight :: Word32
weight = if Network
net.segWit then Word32
w else Word32
0,
subsidy :: UnixTime
subsidy = UnixTime
subsidy,
fee :: UnixTime
fee = [UnixTime] -> UnixTime
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([UnixTime] -> UnixTime) -> [UnixTime] -> UnixTime
forall a b. (a -> b) -> a -> b
$ (TxData -> UnixTime) -> [TxData] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map TxData -> UnixTime
txDataFee [TxData]
tds,
outputs :: UnixTime
outputs = UnixTime
ts_out_val
}
BlockData -> m ()
forall (m :: * -> *). StoreWrite m => BlockData -> m ()
insertBlock BlockData
bd
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Finished importing block: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlockHash -> Text
blockHashToHex (BlockHeader -> BlockHash
headerHash BlockNode
n.header)
(BlockData, [TxData]) -> m (BlockData, [TxData])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockData
bd, [TxData]
tds)
where
ts_out_val :: UnixTime
ts_out_val =
[UnixTime] -> UnixTime
forall a. Num a => [a] -> a
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 a. Num a => [a] -> a
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 (.value) ([TxOut] -> [UnixTime]) -> (Tx -> [TxOut]) -> Tx -> [UnixTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.outputs)) ([Tx] -> [UnixTime]) -> [Tx] -> [UnixTime]
forall a b. (a -> b) -> a -> b
$ [Tx] -> [Tx]
forall a. HasCallStack => [a] -> [a]
tail ([Tx] -> [Tx]) -> [Tx] -> [Tx]
forall a b. (a -> b) -> a -> b
$ Block
b.txs
w :: Word32
w =
let f :: Tx -> Tx
f Tx
t = (Tx
t :: Tx) {witness = []}
b' :: Block
b' = (Block
b :: Block) {txs = map f b.txs}
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 :: forall (m :: * -> *). MonadImport m => 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
tx.inputs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Transaction spends same output twice: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall a. ImportException -> m a
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
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Orphan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall a. ImportException -> m a
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
isCoinbaseTx Tx
tx) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Coinbase cannot be imported into mempool: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall a. ImportException -> m a
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 a. [a] -> 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 a. [a] -> 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
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Orphan: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall a. ImportException -> m a
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
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Insufficient funds for tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m ()
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
InsufficientFunds
where
unspents :: [Maybe Unspent] -> UnixTime
unspents = [UnixTime] -> UnixTime
forall a. Num a => [a] -> a
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 (.value) ([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 a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((TxOut -> UnixTime) -> [TxOut] -> [UnixTime]
forall a b. (a -> b) -> [a] -> [b]
map (.value) Tx
tx.outputs)
unique_inputs :: Int
unique_inputs = [OutPoint] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OutPoint] -> [OutPoint]
forall a. Hashable a => [a] -> [a]
nub' ((TxIn -> OutPoint) -> [TxIn] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map (.outpoint) Tx
tx.inputs))
getUnspentOutputs :: (StoreReadBase m) => Tx -> m [Maybe Unspent]
getUnspentOutputs :: forall (m :: * -> *). StoreReadBase m => 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
{ block :: BlockRef
block = BlockRef
br,
tx :: Tx
tx = Tx
tx,
prevs :: IntMap Prev
prevs = IntMap Prev
ps,
deleted :: Bool
deleted = Bool
False,
rbf :: Bool
rbf = Bool
rbf,
timestamp :: UnixTime
timestamp = UnixTime
tt,
spenders :: IntMap Spender
spenders = IntMap Spender
forall a. IntMap a
I.empty
}
where
mkprv :: Unspent -> Prev
mkprv Unspent {Maybe Address
UnixTime
ByteString
OutPoint
BlockRef
block :: BlockRef
outpoint :: OutPoint
value :: UnixTime
script :: ByteString
address :: Maybe Address
address :: Unspent -> Maybe Address
script :: Unspent -> ByteString
value :: Unspent -> UnixTime
outpoint :: Unspent -> OutPoint
block :: Unspent -> BlockRef
..} = ByteString -> UnixTime -> Prev
Prev ByteString
script UnixTime
value
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 TxData
importTx :: forall (m :: * -> *).
MonadImport m =>
BlockRef -> UnixTime -> Bool -> Tx -> m TxData
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
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Attempted to import a tx missing UTXO: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx)
ImportException -> m Unspent
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
Orphan
Just Unspent
u -> Unspent -> m Unspent
forall a. a -> m a
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
TxData -> m TxData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxData
td
unConfirmTx :: (MonadImport m) => TxData -> m TxData
unConfirmTx :: forall (m :: * -> *). MonadImport m => TxData -> m TxData
unConfirmTx TxData
t = TxData -> Maybe BlockRef -> m TxData
forall (m :: * -> *).
MonadImport m =>
TxData -> Maybe BlockRef -> m TxData
confTx TxData
t Maybe BlockRef
forall a. Maybe a
Nothing
confirmTx :: (MonadImport m) => TxData -> BlockRef -> m TxData
confirmTx :: forall (m :: * -> *).
MonadImport m =>
TxData -> BlockRef -> m TxData
confirmTx TxData
t BlockRef
br = TxData -> Maybe BlockRef -> m TxData
forall (m :: * -> *).
MonadImport m =>
TxData -> Maybe BlockRef -> m TxData
confTx TxData
t (BlockRef -> Maybe BlockRef
forall a. a -> Maybe a
Just BlockRef
br)
replaceAddressTx :: (MonadImport m) => TxData -> BlockRef -> m ()
replaceAddressTx :: forall (m :: * -> *). MonadImport m => TxData -> BlockRef -> m ()
replaceAddressTx TxData
t BlockRef
new = do
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
[Address] -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Ctx -> TxData -> [Address]
txDataAddresses Ctx
ctx 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
{ block :: BlockRef
block = TxData
t.block,
txid :: TxHash
txid = Tx -> TxHash
txHash TxData
t.tx
}
Address -> TxRef -> m ()
forall (m :: * -> *). StoreWrite m => Address -> TxRef -> m ()
insertAddrTx
Address
a
TxRef
{ block :: BlockRef
block = BlockRef
new,
txid :: TxHash
txid = Tx -> TxHash
txHash TxData
t.tx
}
adjustAddressOutput ::
(MonadImport m) =>
OutPoint ->
TxOut ->
BlockRef ->
BlockRef ->
m ()
adjustAddressOutput :: forall (m :: * -> *).
MonadImport m =>
OutPoint -> TxOut -> BlockRef -> BlockRef -> m ()
adjustAddressOutput OutPoint
op TxOut
o BlockRef
old BlockRef
new = do
let pk :: ByteString
pk = TxOut
o.script
OutPoint -> m (Maybe Unspent)
forall (m :: * -> *).
StoreReadBase m =>
OutPoint -> m (Maybe Unspent)
getUnspent OutPoint
op m (Maybe Unspent) -> (Maybe Unspent -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Unspent
Nothing -> () -> m ()
forall a. a -> m a
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
u.block 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 :: * -> *}.
(StoreReadBase m, StoreWrite m, MonadError ImportException m,
MonadLoggerIO m) =>
ByteString -> m ()
replace_unspent ByteString
pk
where
replace_unspent :: ByteString -> m ()
replace_unspent ByteString
pk = do
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
let ma :: Maybe Address
ma = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx ByteString
pk)
OutPoint -> m ()
forall (m :: * -> *). StoreWrite m => OutPoint -> m ()
deleteUnspent OutPoint
op
Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Unspent -> m ()
insertUnspent
Unspent
{ block :: BlockRef
block = BlockRef
new,
outpoint :: OutPoint
outpoint = OutPoint
op,
value :: UnixTime
value = TxOut
o.value,
script :: ByteString
script = ByteString
pk,
address :: Maybe Address
address = 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
{ block :: BlockRef
block = BlockRef
old,
outpoint :: OutPoint
outpoint = OutPoint
op,
value :: UnixTime
value = TxOut
o.value,
script :: ByteString
script = ByteString
pk,
address :: Maybe Address
address = 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
{ block :: BlockRef
block = BlockRef
new,
outpoint :: OutPoint
outpoint = OutPoint
op,
value :: UnixTime
value = TxOut
o.value,
script :: ByteString
script = ByteString
pk,
address :: Maybe Address
address = 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
o.value
Bool -> Address -> UnixTime -> m ()
forall (m :: * -> *).
MonadImport m =>
Bool -> Address -> UnixTime -> m ()
increaseBalance (BlockRef -> Bool
confirmed BlockRef
new) Address
a TxOut
o.value
confTx :: (MonadImport m) => TxData -> Maybe BlockRef -> m TxData
confTx :: forall (m :: * -> *).
MonadImport m =>
TxData -> Maybe BlockRef -> m TxData
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 ..] TxData
t.tx.outputs) (((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
t.tx) 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
t.tx
let td :: TxData
td = (TxData
t :: TxData) {block = new, rbf = rbf}
TxData -> m ()
forall (m :: * -> *). StoreWrite m => TxData -> m ()
insertTx TxData
td
TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
updateMempool TxData
td
TxData -> m TxData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxData
td
where
new :: BlockRef
new = BlockRef -> Maybe BlockRef -> BlockRef
forall a. a -> Maybe a -> a
fromMaybe (UnixTime -> BlockRef
MemRef TxData
t.timestamp) Maybe BlockRef
mbr
old :: BlockRef
old = TxData
t.block
freeOutputs ::
(MonadImport m) =>
Bool ->
Bool ->
Tx ->
m ()
freeOutputs :: forall (m :: * -> *). MonadImport m => Bool -> Bool -> Tx -> m ()
freeOutputs Bool
memonly Bool
rbfcheck Tx
tx = do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Freeing outputs for tx " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex (Tx -> TxHash
txHash Tx
tx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"..."
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
H.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 (.txid) [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]
H.toList HashSet TxHash
txids
deleteConfirmedTx :: (MonadImport m) => TxHash -> m ()
deleteConfirmedTx :: forall (m :: * -> *). MonadImport m => 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 :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
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 ->
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Not found or already deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
deleteTx ::
(MonadImport m) =>
Bool ->
Bool ->
TxHash ->
m ()
deleteTx :: forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m ()
deleteTx Bool
memonly Bool
rbfcheck TxHash
th = do
[Tx]
chain <- Bool -> Bool -> TxHash -> m [Tx]
forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [Tx]
getChain Bool
memonly Bool
rbfcheck TxHash
th
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Deleting "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show ([Tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
chain))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" txs from chain leading to "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxHash -> m TxHash
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxHash
h) [Tx]
chain
getChain ::
(MonadImport m) =>
Bool ->
Bool ->
TxHash ->
m [Tx]
getChain :: forall (m :: * -> *).
MonadImport m =>
Bool -> Bool -> TxHash -> m [Tx]
getChain Bool
memonly Bool
rbfcheck TxHash
th' = do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Getting chain for tx " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
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
<$> HashMap TxHash Tx -> HashSet TxHash -> m [Tx]
forall {m :: * -> *}.
(StoreReadBase m, MonadLogger m, MonadError ImportException m) =>
HashMap TxHash Tx -> HashSet TxHash -> m [Tx]
go HashMap TxHash Tx
forall k v. HashMap k v
M.empty (TxHash -> HashSet TxHash
forall a. Hashable a => a -> HashSet a
H.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 TxData)
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 TxData)) -> m (Maybe TxData)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe TxData
Nothing -> do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Transaction not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
Maybe TxData -> m (Maybe TxData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TxData
forall a. Maybe a
Nothing
Just TxData
td
| Bool
memonly Bool -> Bool -> Bool
&& BlockRef -> Bool
confirmed TxData
td.block -> do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Transaction already confirmed: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m (Maybe TxData)
forall a. ImportException -> m a
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
td.block TxData
td.tx m Bool -> (Bool -> m (Maybe TxData)) -> m (Maybe TxData)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Maybe TxData -> m (Maybe TxData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TxData -> m (Maybe TxData))
-> Maybe TxData -> m (Maybe TxData)
forall a b. (a -> b) -> a -> b
$ TxData -> Maybe TxData
forall a. a -> Maybe a
Just TxData
td
Bool
False -> do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Double-spending transaction: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m (Maybe TxData)
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
DoubleSpend
| Bool
otherwise -> Maybe TxData -> m (Maybe TxData)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TxData -> m (Maybe TxData))
-> Maybe TxData -> m (Maybe TxData)
forall a b. (a -> b) -> a -> b
$ TxData -> Maybe TxData
forall a. a -> Maybe a
Just TxData
td
go :: HashMap TxHash Tx -> HashSet TxHash -> m [Tx]
go HashMap TxHash Tx
txm HashSet TxHash
pdg = do
let ths :: [TxHash]
ths = (TxHash -> Bool) -> [TxHash] -> [TxHash]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TxHash -> Bool) -> TxHash -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxHash -> HashMap TxHash Tx -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`M.member` HashMap TxHash Tx
txm)) (HashSet TxHash -> [TxHash]
forall a. HashSet a -> [a]
H.toList HashSet TxHash
pdg)
[TxData]
tds <- [Maybe TxData] -> [TxData]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TxData] -> [TxData]) -> m [Maybe TxData] -> m [TxData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxHash -> m (Maybe TxData)) -> [TxHash] -> m [Maybe TxData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxHash -> m (Maybe TxData)
forall {m :: * -> *}.
(StoreReadBase m, MonadLogger m, MonadError ImportException m) =>
TxHash -> m (Maybe TxData)
get_tx [TxHash]
ths
let txmn :: HashMap TxHash Tx
txmn = [(TxHash, Tx)] -> HashMap TxHash Tx
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(TxHash, Tx)] -> HashMap TxHash Tx)
-> [(TxHash, Tx)] -> HashMap TxHash Tx
forall a b. (a -> b) -> a -> b
$ (TxData -> (TxHash, Tx)) -> [TxData] -> [(TxHash, Tx)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TxData
d -> (Tx -> TxHash
txHash TxData
d.tx, TxData
d.tx)) [TxData]
tds
spds :: [TxHash]
spds = (TxData -> [TxHash]) -> [TxData] -> [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 (.txid) ([Spender] -> [TxHash])
-> (TxData -> [Spender]) -> TxData -> [TxHash]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap Spender -> [Spender]
forall a. IntMap a -> [a]
I.elems (IntMap Spender -> [Spender])
-> (TxData -> IntMap Spender) -> TxData -> [Spender]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.spenders)) [TxData]
tds
pdg' :: HashSet TxHash
pdg' = [TxHash] -> HashSet TxHash
forall a. (Eq a, Hashable a) => [a] -> HashSet a
H.fromList [TxHash]
spds
txm' :: HashMap TxHash Tx
txm' = HashMap TxHash Tx
txmn HashMap TxHash Tx -> HashMap TxHash Tx -> HashMap TxHash Tx
forall a. Semigroup a => a -> a -> a
<> HashMap TxHash Tx
txm
if HashSet TxHash -> Bool
forall a. HashSet a -> Bool
H.null HashSet TxHash
pdg'
then do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Chain for tx "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th'
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" contains "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (Int -> String
forall a. Show a => a -> String
show (HashMap TxHash Tx -> Int
forall k v. HashMap k v -> Int
M.size HashMap TxHash Tx
txm'))
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" txs"
[Tx] -> m [Tx]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tx] -> m [Tx]) -> [Tx] -> m [Tx]
forall a b. (a -> b) -> a -> b
$ HashMap TxHash Tx -> [Tx]
forall k v. HashMap k v -> [v]
M.elems HashMap TxHash Tx
txm'
else HashMap TxHash Tx -> HashSet TxHash -> m [Tx]
go HashMap TxHash Tx
txm' HashSet TxHash
pdg'
deleteSingleTx :: (MonadImport m) => TxHash -> m ()
deleteSingleTx :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe TxData
Nothing -> do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Already deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m ()
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
Just TxData
td ->
if IntMap Spender -> Bool
forall a. IntMap a -> Bool
I.null TxData
td.spenders
then do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Deleting tx: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
TxData -> m ()
forall (m :: * -> *). MonadImport m => TxData -> m ()
commitDelTx TxData
td
else do
$(logErrorS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Tried to delete spent tx: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m ()
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxSpent
commitDelTx :: (MonadImport m) => TxData -> m ()
commitDelTx :: forall (m :: * -> *). MonadImport m => TxData -> m ()
commitDelTx = Bool -> TxData -> m ()
forall (m :: * -> *). MonadImport m => Bool -> TxData -> m ()
commitModTx Bool
False
commitAddTx :: (MonadImport m) => TxData -> m ()
commitAddTx :: forall (m :: * -> *). MonadImport m => TxData -> m ()
commitAddTx = Bool -> TxData -> m ()
forall (m :: * -> *). MonadImport m => Bool -> TxData -> m ()
commitModTx Bool
True
commitModTx :: (MonadImport m) => Bool -> TxData -> m ()
commitModTx :: forall (m :: * -> *). MonadImport m => Bool -> TxData -> m ()
commitModTx Bool
add TxData
tx_data = do
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
(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 (Ctx -> TxData -> [Address]
txDataAddresses Ctx
ctx 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
td.tx
br :: BlockRef
br = TxData
td.block
td :: TxData
td = (TxData
tx_data :: TxData) {deleted = not 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 :: forall (m :: * -> *). MonadImport m => TxData -> m ()
updateMempool td :: TxData
td@TxData {deleted :: TxData -> Bool
deleted = Bool
True} =
TxHash -> m ()
forall (m :: * -> *). StoreWrite m => TxHash -> m ()
deleteFromMempool (Tx -> TxHash
txHash TxData
td.tx)
updateMempool td :: TxData
td@TxData {block :: TxData -> BlockRef
block = MemRef UnixTime
t} =
TxHash -> UnixTime -> m ()
forall (m :: * -> *). StoreWrite m => TxHash -> UnixTime -> m ()
addToMempool (Tx -> TxHash
txHash TxData
td.tx) UnixTime
t
updateMempool td :: TxData
td@TxData {block :: TxData -> BlockRef
block = BlockRef {}} =
TxHash -> m ()
forall (m :: * -> *). StoreWrite m => TxHash -> m ()
deleteFromMempool (Tx -> TxHash
txHash TxData
td.tx)
spendOutputs :: (MonadImport m) => Tx -> m ()
spendOutputs :: forall (m :: * -> *). MonadImport m => 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 :: forall (m :: * -> *). MonadImport m => 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
tx.outputs
isRBF ::
(StoreReadBase m) =>
BlockRef ->
Tx ->
m Bool
isRBF :: forall (m :: * -> *). StoreReadBase m => BlockRef -> Tx -> m Bool
isRBF BlockRef
br Tx
tx
| BlockRef -> Bool
confirmed BlockRef
br = Bool -> m Bool
forall a. a -> m a
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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Network
net ->
if Network
net.replaceByFee
then m Bool
go
else Bool -> m Bool
forall a. a -> m a
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
. (.sequence)) Tx
tx.inputs = Bool -> m Bool
forall a. a -> m a
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. 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.hash) Tx
tx.inputs
ck :: [TxHash] -> m Bool
ck [] = Bool -> m Bool
forall a. a -> m a
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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe TxData
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just TxData
t
| BlockRef -> Bool
confirmed TxData
t.block -> [TxHash] -> m Bool
ck [TxHash]
hs'
| TxData
t.rbf -> Bool -> m Bool
forall a. a -> m a
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 :: forall (m :: * -> *).
MonadImport m =>
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 :: forall (m :: * -> *).
MonadImport m =>
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 :: forall (m :: * -> *).
MonadImport m =>
Bool -> BlockRef -> OutPoint -> TxOut -> m ()
modOutput Bool
add BlockRef
br OutPoint
op TxOut
o = do
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
Ctx -> m ()
forall {m :: * -> *}. StoreWrite m => Ctx -> m ()
mod_unspent Ctx
ctx
Maybe Address -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Ctx -> Maybe Address
ma Ctx
ctx) ((Address -> m ()) -> m ()) -> (Address -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Address
a -> do
Address -> Unspent -> m ()
mod_addr_unspent Address
a (Ctx -> Unspent
u Ctx
ctx)
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
o.value
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
o.value)
| Bool
otherwise = UnixTime -> UnixTime -> UnixTime
forall a. Num a => a -> a -> a
subtract TxOut
o.value
ma :: Ctx -> Maybe Address
ma Ctx
ctx = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx TxOut
o.script)
u :: Ctx -> Unspent
u Ctx
ctx =
Unspent
{ script :: ByteString
script = TxOut
o.script,
block :: BlockRef
block = BlockRef
br,
outpoint :: OutPoint
outpoint = OutPoint
op,
value :: UnixTime
value = TxOut
o.value,
address :: Maybe Address
address = Ctx -> Maybe Address
ma Ctx
ctx
}
mod_unspent :: Ctx -> m ()
mod_unspent Ctx
ctx
| Bool
add = Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Unspent -> m ()
insertUnspent (Ctx -> Unspent
u Ctx
ctx)
| 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 :: forall (m :: * -> *). MonadImport m => 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
tx.outputs) (((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 :: forall (m :: * -> *). MonadImport m => 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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe TxData
Nothing -> do
$(logDebugS) Text
"BlockStore" (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Tx not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxHash -> Text
txHashToHex TxHash
th
ImportException -> m TxData
forall a. ImportException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ImportException
TxNotFound
Just TxData
d -> TxData -> m TxData
forall a. a -> m a
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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
tx.outputs)
TxOut -> Maybe TxOut
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOut -> Maybe TxOut) -> TxOut -> Maybe TxOut
forall a b. (a -> b) -> a -> b
$ Tx
tx.outputs [TxOut] -> Int -> TxOut
forall a. HasCallStack => [a] -> Int -> a
!! Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i
insertSpender :: (MonadImport m) => OutPoint -> Spender -> m ()
insertSpender :: forall (m :: * -> *). MonadImport m => OutPoint -> Spender -> m ()
insertSpender OutPoint
op Spender
s = do
TxData
td <- TxHash -> m TxData
forall (m :: * -> *). MonadImport m => TxHash -> m TxData
getImportTxData OutPoint
op.hash
let p :: IntMap Spender
p = TxData
td.spenders
p' :: IntMap Spender
p' = Int -> Spender -> IntMap Spender -> IntMap Spender
forall a. Int -> a -> IntMap a -> IntMap a
I.insert (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral OutPoint
op.index) Spender
s IntMap Spender
p
td' :: TxData
td' = (TxData
td :: TxData) {spenders = p'}
TxData -> m ()
forall (m :: * -> *). StoreWrite m => TxData -> m ()
insertTx TxData
td'
deleteSpender :: (MonadImport m) => OutPoint -> m ()
deleteSpender :: forall (m :: * -> *). MonadImport m => OutPoint -> m ()
deleteSpender OutPoint
op = do
TxData
td <- TxHash -> m TxData
forall (m :: * -> *). MonadImport m => TxHash -> m TxData
getImportTxData OutPoint
op.hash
let p :: IntMap Spender
p = TxData
td.spenders
p' :: IntMap Spender
p' = Int -> IntMap Spender -> IntMap Spender
forall a. Int -> IntMap a -> IntMap a
I.delete (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral OutPoint
op.index) IntMap Spender
p
td' :: TxData
td' = (TxData
td :: TxData) {spenders = p'}
TxData -> m ()
forall (m :: * -> *). StoreWrite m => TxData -> m ()
insertTx TxData
td'
spendOutput :: (MonadImport m) => TxHash -> Word32 -> OutPoint -> m ()
spendOutput :: forall (m :: * -> *).
MonadImport m =>
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 a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Unspent
u -> Unspent -> m Unspent
forall a. a -> m a
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 :: * -> *). MonadImport m => OutPoint -> Spender -> m ()
insertSpender OutPoint
op (TxHash -> Word32 -> Spender
Spender TxHash
th Word32
ix)
let pk :: ByteString
pk = Unspent
u.script
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
Either String Address -> (Address -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx 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
u.block) Address
a Unspent
u.value
Address -> Unspent -> m ()
forall (m :: * -> *). StoreWrite m => Address -> Unspent -> m ()
deleteAddrUnspent Address
a Unspent
u
unspendOutputs :: (MonadImport m) => Tx -> m ()
unspendOutputs :: forall (m :: * -> *). MonadImport m => 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 :: forall (m :: * -> *). MonadImport m => OutPoint -> m ()
unspendOutput OutPoint
op = do
Ctx
ctx <- m Ctx
forall (m :: * -> *). StoreReadBase m => m Ctx
getCtx
TxData
t <-
TxHash -> m (Maybe TxData)
forall (m :: * -> *). StoreReadBase m => TxHash -> m (Maybe TxData)
getActiveTxData OutPoint
op.hash m (Maybe TxData) -> (Maybe TxData -> m TxData) -> m TxData
forall a b. m a -> (a -> m b) -> m b
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
op.hash
Just TxData
t -> TxData -> m TxData
forall a. a -> m a
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
op.index TxData
t.tx)
m :: Maybe Address
m = Either String Address -> Maybe Address
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx TxOut
o.script)
u :: Unspent
u =
Unspent
{ value :: UnixTime
value = TxOut
o.value,
block :: BlockRef
block = TxData
t.block,
script :: ByteString
script = TxOut
o.script,
outpoint :: OutPoint
outpoint = OutPoint
op,
address :: Maybe Address
address = Maybe Address
m
}
OutPoint -> m ()
forall (m :: * -> *). MonadImport 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
u.block) Address
a TxOut
o.value
modifyReceived :: (MonadImport m) => Address -> (Word64 -> Word64) -> m ()
modifyReceived :: forall (m :: * -> *).
MonadImport m =>
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 {received = f b.received}
decreaseBalance :: (MonadImport m) => Bool -> Address -> Word64 -> m ()
decreaseBalance :: forall (m :: * -> *).
MonadImport m =>
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 :: forall (m :: * -> *).
MonadImport m =>
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 :: forall (m :: * -> *).
MonadImport m =>
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 :: Balance) {utxo = m 1 b.utxo}
f :: Balance -> Balance
f Balance
b
| Bool
conf = (Balance
b :: Balance) {confirmed = m val b.confirmed}
| Bool
otherwise = (Balance
b :: Balance) {unconfirmed = m val b.unconfirmed}
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 :: forall (m :: * -> *). MonadImport m => 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 {txs = f b.txs}
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 :: Ctx -> [TxOut] -> [Address]
txOutAddrs :: Ctx -> [TxOut] -> [Address]
txOutAddrs Ctx
ctx = [Address] -> [Address]
forall 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 (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx (ByteString -> Either String Address)
-> (TxOut -> ByteString) -> TxOut -> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script))
txInAddrs :: Ctx -> [Prev] -> [Address]
txInAddrs :: Ctx -> [Prev] -> [Address]
txInAddrs Ctx
ctx = [Address] -> [Address]
forall 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 (Ctx -> ByteString -> Either String Address
scriptToAddressBS Ctx
ctx (ByteString -> Either String Address)
-> (Prev -> ByteString) -> Prev -> Either String Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.script))
txDataAddresses :: Ctx -> TxData -> [Address]
txDataAddresses :: Ctx -> TxData -> [Address]
txDataAddresses Ctx
ctx TxData
t =
[Address] -> [Address]
forall a. Hashable a => [a] -> [a]
nub' ([Address] -> [Address]) -> [Address] -> [Address]
forall a b. (a -> b) -> a -> b
$ Ctx -> [Prev] -> [Address]
txInAddrs Ctx
ctx [Prev]
prevs [Address] -> [Address] -> [Address]
forall a. Semigroup a => a -> a -> a
<> Ctx -> [TxOut] -> [Address]
txOutAddrs Ctx
ctx [TxOut]
outs
where
prevs :: [Prev]
prevs = IntMap Prev -> [Prev]
forall a. IntMap a -> [a]
I.elems TxData
t.prevs
outs :: [TxOut]
outs = TxData
t.tx.outputs
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 (.outpoint) Tx
tx.inputs)
testPresent :: (StoreReadBase m) => Tx -> m Bool
testPresent :: forall (m :: * -> *). StoreReadBase m => 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)