Skip to content

Commit 9bb064d

Browse files
volhovmvolhovm
committed
[RSC-142][RSC-143] Fix/refactor importAddress
This commit refactor import functionality to make sure everything is imported except transactions -- public addresses that depend on imported one. Also adds a confirmation check before address deletion.
1 parent a94a0b1 commit 9bb064d

File tree

5 files changed

+254
-217
lines changed

5 files changed

+254
-217
lines changed

‎src/RSCoin/User/AcidState.hs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module RSCoin.User.AcidState
1818
, GetSecretKey (..)
1919
, FindUserAddress (..)
2020
, GetUserAddresses (..)
21+
, GetDependentAddresses (..)
2122
, GetOwnedAddresses (..)
2223
, GetOwnedDefaultAddresses (..)
2324
, GetOwnedAddrIds (..)
@@ -48,7 +49,6 @@ import qualified Data.Acid as A
4849
import Data.Acid.Memory as AM
4950
import Data.Map (Map)
5051
import Data.SafeCopy (base, deriveSafeCopy)
51-
import Data.Set (Set)
5252

5353
import qualified RSCoin.Core as C
5454
import RSCoin.Core.Crypto (keyGen)
@@ -88,6 +88,7 @@ closeState = A.closeAcidState
8888
isInitialized :: A.Query WalletStorage Bool
8989
getSecretKey :: C.Address -> A.Query WalletStorage (Maybe (Maybe C.SecretKey))
9090
findUserAddress :: C.Address -> A.Query WalletStorage (C.Address, Maybe C.SecretKey)
91+
getDependentAddresses :: C.Address -> A.Query WalletStorage [C.Address]
9192
getUserAddresses :: A.Query WalletStorage [(C.Address,C.SecretKey)]
9293
getOwnedAddresses :: C.Address -> A.Query WalletStorage [C.Address]
9394
getOwnedDefaultAddresses :: C.Address -> A.Query WalletStorage [C.Address]
@@ -103,6 +104,7 @@ getAllocationByIndex :: Int -> A.Query WalletStorage (MSAddress, AllocationInfo)
103104
getSecretKey = W.getSecretKey
104105
isInitialized = W.isInitialized
105106
findUserAddress = W.findUserAddress
107+
getDependentAddresses = W.getDependentAddresses
106108
getUserAddresses = W.getUserAddresses
107109
getOwnedAddresses = W.getOwnedAddresses
108110
getOwnedDefaultAddresses = W.getOwnedDefaultAddresses
@@ -117,8 +119,7 @@ getAllocationByIndex = W.getAllocationByIndex
117119

118120
withBlockchainUpdate :: C.PeriodId -> C.HBlock -> A.Update WalletStorage ()
119121
addTemporaryTransaction :: C.PeriodId -> C.Transaction -> A.Update WalletStorage ()
120-
addAddress :: (C.Address,Maybe C.SecretKey) -> [C.Transaction] ->
121-
Set TxHistoryRecord -> A.Update WalletStorage ()
122+
addAddress :: C.Address -> Maybe C.SecretKey -> Map C.PeriodId C.HBlock -> A.Update WalletStorage ()
122123
deleteAddress :: C.Address -> A.Update WalletStorage ()
123124
updateAllocationStrategies :: Map MSAddress AllocationInfo -> A.Update WalletStorage ()
124125
initWallet :: [(C.SecretKey,C.PublicKey)] -> Maybe Int -> A.Update WalletStorage ()
@@ -135,6 +136,7 @@ $(makeAcidic
135136
[ 'isInitialized
136137
, 'getSecretKey
137138
, 'findUserAddress
139+
, 'getDependentAddresses
138140
, 'getUserAddresses
139141
, 'getOwnedAddresses
140142
, 'getOwnedDefaultAddresses

‎src/RSCoin/User/Operations.hs

Lines changed: 63 additions & 85 deletions
Original file line numberDiff line numberDiff line change
@@ -37,49 +37,42 @@ module RSCoin.User.Operations
3737
, retrieveAllocationsList
3838
) where
3939

40-
import Control.Arrow ((***))
41-
import Control.Exception (SomeException, assert,
42-
fromException)
43-
import Control.Lens ((^.))
44-
import Control.Monad (filterM, forM_, unless, void, when)
45-
import Control.Monad.Catch (MonadThrow, catch, throwM, try)
46-
import Control.Monad.Extra (whenJust)
47-
import Control.Monad.IO.Class (MonadIO, liftIO)
48-
import Control.Monad.State (StateT (..), execStateT, get,
49-
modify)
50-
import Control.Monad.Trans.Class (lift)
51-
import Data.Acid.Advanced (query', update')
52-
import Data.Bifunctor (first)
53-
import Data.Function (on)
54-
import qualified Data.IntMap.Strict as I
55-
import Data.List (delete, elemIndex, foldl1',
56-
genericIndex, genericLength,
57-
groupBy, nub, sortOn)
58-
import qualified Data.Map as M
59-
import Data.Maybe (fromJust, fromMaybe, isJust,
60-
isNothing)
61-
import Data.Monoid ((<>))
62-
import qualified Data.Set as S
63-
import qualified Data.Text as T
64-
import Data.Text.Buildable (Buildable)
65-
import qualified Data.Text.IO as TIO
66-
import Data.Tuple.Select (sel1, sel2, sel3)
67-
import Formatting (build, int, sformat, shown, (%))
68-
import Safe (atMay)
69-
70-
import Serokell.Util (listBuilderJSON,
71-
listBuilderJSONIndent, pairBuilder)
72-
73-
import qualified RSCoin.Core as C
74-
import RSCoin.Timed (MonadRpc (getNodeContext), WorkMode,
75-
for, sec, wait)
76-
import qualified RSCoin.User.AcidState as A
77-
import RSCoin.User.Cache (UserCache)
78-
import RSCoin.User.Error (UserError (..), UserLogicError,
79-
isWalletSyncError)
80-
import RSCoin.User.Logic (SignatureBundle, getExtraSignatures,
81-
joinBundles, validateTransaction)
82-
import qualified RSCoin.User.Wallet as W
40+
import Control.Arrow ((***))
41+
import Control.Exception (SomeException, assert, fromException)
42+
import Control.Lens ((^.))
43+
import Control.Monad (filterM, forM_, unless, void, when)
44+
import Control.Monad.Catch (MonadThrow, catch, throwM, try)
45+
import Control.Monad.Extra (whenJust)
46+
import Control.Monad.IO.Class (MonadIO, liftIO)
47+
import Data.Acid.Advanced (query', update')
48+
import Data.Function (on)
49+
import qualified Data.IntMap.Strict as I
50+
import Data.List (elemIndex, foldl1', genericIndex,
51+
genericLength, groupBy, nub, sortOn)
52+
import qualified Data.Map as M
53+
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
54+
import Data.Monoid ((<>))
55+
import qualified Data.Text as T
56+
import Data.Text.Buildable (Buildable)
57+
import qualified Data.Text.IO as TIO
58+
import Data.Tuple.Select (sel1, sel2, sel3)
59+
import Debug.Trace
60+
import Formatting (build, int, sformat, shown, (%))
61+
import Safe (atMay)
62+
63+
import Serokell.Util (listBuilderJSON, listBuilderJSONIndent,
64+
pairBuilder)
65+
66+
import qualified RSCoin.Core as C
67+
import RSCoin.Timed (MonadRpc (getNodeContext), WorkMode,
68+
for, sec, wait)
69+
import qualified RSCoin.User.AcidState as A
70+
import RSCoin.User.Cache (UserCache)
71+
import RSCoin.User.Error (UserError (..), UserLogicError,
72+
isWalletSyncError)
73+
import RSCoin.User.Logic (SignatureBundle, getExtraSignatures,
74+
joinBundles, validateTransaction)
75+
import qualified RSCoin.User.Wallet as W
8376

8477
walletInitialized :: MonadIO m => A.RSCoinUserState -> m Bool
8578
walletInitialized st = query' st A.IsInitialized
@@ -222,13 +215,11 @@ isInitialized st = query' st A.IsInitialized
222215
addUserAddress
223216
:: MonadIO m
224217
=> A.RSCoinUserState
225-
-> Maybe C.SecretKey
226218
-> C.PublicKey
227-
-> [C.Transaction]
228-
-> S.Set W.TxHistoryRecord
219+
-> Maybe C.SecretKey
229220
-> m ()
230-
addUserAddress st skMaybe pk txs hRecords =
231-
update' st $ A.AddAddress (C.Address pk, skMaybe) txs hRecords
221+
addUserAddress st pk skMaybe =
222+
update' st $ A.AddAddress (C.Address pk) skMaybe M.empty
232223

233224
-- | Same as addAddress, but queries blockchain automatically and
234225
-- queries transactions that affect this address
@@ -237,60 +228,47 @@ importAddress
237228
=> A.RSCoinUserState
238229
-> (Maybe C.SecretKey, C.PublicKey)
239230
-> Int
240-
-> Maybe Int
241231
-> m ()
242-
importAddress st (skMaybe,pk) fromH toH0 = do
232+
importAddress st (skMaybe,pk) fromH = do
243233
whenJust skMaybe $ \sk ->
244234
unless (C.checkKeyPair (sk,pk)) $
245235
commitError "The provided pair doesn't match thus can't be used"
246236
ourSk <- query' st $ A.GetSecretKey $ C.Address pk
247237
case ourSk of
248238
Nothing -> return () -- it's ok
249-
Just Nothing -> C.logInfo $ "The address doesn't have secret key, " <>
250-
"adding this one with re-query"
239+
Just Nothing | isJust skMaybe ->
240+
C.logInfo $ "The address doesn't have secret key, " <>
241+
"adding this sk with re-query"
242+
Just Nothing ->
243+
commitError "This address doesn't have sk, won't update without provided"
251244
Just (Just _) -> commitError "The address is already imported"
252245
when (fromH < 0) $ commitError $
253246
sformat ("Height 'from' " % int % " must be positive!") fromH
254-
whenJust toH0 $ \toH -> do
255-
when (toH < 0) $ commitError $
256-
sformat ("Height 'to' " % int % " must be positive!") toH
257-
when (toH < fromH) $ commitError $ sformat
258-
("Height 'from' " % int % "is greater than height 'to' " % int)
259-
fromH toH
260247
walletHeight <- query' st A.GetLastBlockId
261-
let toH = fromMaybe walletHeight toH0
262-
when (toH > walletHeight) $
263-
let formatPattern = "Desired interval [" % int % "," % int %
264-
"] must lie exactly within [0," % int % "]," %
248+
when (fromH > walletHeight) $
249+
let formatPattern =
250+
"fromH must be exactly within [0," % int % "]," %
265251
" where " % int %
266252
" is current wallet's top known blockchain height."
267-
in commitError $ sformat formatPattern fromH toH walletHeight walletHeight
253+
in commitError $ sformat formatPattern walletHeight walletHeight
254+
let period = [fromH..walletHeight]
255+
delta = max (walletHeight - fromH - 1) $
256+
max 100 $ (walletHeight - fromH) `div` 10
257+
periodsLast = splitEvery delta period
258+
traceM $ "Period is : " ++ show period
259+
traceM $ "Delta is : " ++ show delta
260+
traceM $ "periods is : " ++ show periodsLast
268261
C.logInfo $ sformat
269-
("Starting blockchain query process for blocks " % int % ".." % int) fromH toH
270-
(txs,txHistoryRecords) <-
271-
execStateT (gatherTransactionsDo [fromH..toH]) ([],S.empty)
262+
("Starting blockchain query process for blocks " % int % ".." % int) fromH walletHeight
263+
hblocks <- (period `zip`) . concat <$>
264+
mapM (\l -> C.getBlocksByHeight (head l) (last l)) periodsLast
272265
C.logInfo "Ended blockchain query process"
273-
update' st $ A.AddAddress (newAddress,skMaybe)
274-
(nub $ map fst txs) txHistoryRecords
266+
update' st $ A.AddAddress newAddress skMaybe $ M.fromList hblocks
275267
where
276268
newAddress = C.Address pk
277-
gatherTransactionsDo
278-
:: (WorkMode m) =>
279-
[Int] -> StateT ([(C.Transaction,C.AddrId)], S.Set W.TxHistoryRecord) m ()
280-
gatherTransactionsDo [] = return ()
281-
gatherTransactionsDo (periodId:otherPeriodIds) = do
282-
C.HBlock{..} <- lift $ C.getBlockByHeight periodId
283-
forM_ hbTransactions $ \tx ->
284-
W.handleToAdd [newAddress] tx $ \_ addrid -> do
285-
let histRecord =
286-
W.TxHistoryRecord tx periodId W.TxHConfirmed
287-
$ S.singleton newAddress
288-
modify (((tx,addrid) :) *** S.insert histRecord)
289-
forM_ hbTransactions $ \tx -> do
290-
currentTxs <- fst <$> get
291-
toRemove <- W.getToRemove [(newAddress, currentTxs)] tx
292-
forM_ toRemove $ \(_,pair') -> modify (first $ delete pair')
293-
gatherTransactionsDo otherPeriodIds
269+
splitEvery _ [] = []
270+
splitEvery n list = let (first,rest) = splitAt n list
271+
in first : (splitEvery n rest)
294272

295273
-- | Deletes an address. Accepts an index in [0..length addresses)
296274
deleteUserAddress :: (WorkMode m) => A.RSCoinUserState -> Int -> m ()

0 commit comments

Comments
 (0)