Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit 1b7ad20

Browse files
authored
Merge pull request #3775 from input-output-hk/i+j/develop/CO-410/implement-networkmagic
[CO-410] Implement `NetworkMagic` logic
2 parents 13545a7 + e146169 commit 1b7ad20

27 files changed

+301
-221
lines changed

src/Cardano/Wallet/API/V1/LegacyHandlers.hs

+8-3
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,9 @@ module Cardano.Wallet.API.V1.LegacyHandlers where
1010
import Universum
1111

1212
import Ntp.Client (NtpStatus)
13-
import Pos.Chain.Genesis as Genesis (Config)
13+
import Pos.Chain.Genesis as Genesis (Config (..))
1414
import Pos.Chain.Txp (TxpConfiguration)
15+
import Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic)
1516
import Pos.Infra.Diffusion.Types (Diffusion (sendTx))
1617

1718
import qualified Cardano.Wallet.API.V1 as V1
@@ -47,17 +48,21 @@ handlers :: ( HasConfigurations
4748
-> TVar NtpStatus
4849
-> Server V1.API
4950
handlers naturalTransformation genesisConfig txpConfig diffusion ntpStatus =
50-
hoist' (Proxy @Addresses.API) Addresses.handlers
51+
hoist' (Proxy @Addresses.API) (Addresses.handlers nm)
5152
:<|> hoist' (Proxy @Wallets.API) (Wallets.handlers genesisConfig)
52-
:<|> hoist' (Proxy @Accounts.API) Accounts.handlers
53+
:<|> hoist' (Proxy @Accounts.API) (Accounts.handlers nm)
5354
:<|> hoist' (Proxy @Transactions.API) (Transactions.handlers genesisConfig txpConfig sendTx')
5455
:<|> hoist' (Proxy @Settings.API) Settings.handlers
5556
:<|> hoist' (Proxy @Info.API) (Info.handlers diffusion ntpStatus)
5657
where
58+
nm :: NetworkMagic
59+
nm = makeNetworkMagic $ configProtocolMagic genesisConfig
60+
--
5761
hoist'
5862
:: forall (api :: *). HasServer api '[]
5963
=> Proxy api
6064
-> ServerT api MonadV1
6165
-> Server api
6266
hoist' p = hoistServer p naturalTransformation
67+
--
6368
sendTx' = sendTx diffusion

src/Cardano/Wallet/API/V1/LegacyHandlers/Accounts.hs

+45-27
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ import Universum
77

88
import Servant
99

10+
import Pos.Core.NetworkMagic (NetworkMagic)
1011
import qualified Pos.Wallet.Web.Account as V0
1112
import qualified Pos.Wallet.Web.ClientTypes.Types as V0
1213
import qualified Pos.Wallet.Web.Methods.Logic as V0
@@ -19,34 +20,42 @@ import Cardano.Wallet.API.V1.Migration
1920
import Cardano.Wallet.API.V1.Types
2021
import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
2122

22-
handlers :: ServerT Accounts.API MonadV1
23-
handlers =
23+
handlers :: NetworkMagic -> ServerT Accounts.API MonadV1
24+
handlers nm =
2425
deleteAccount
25-
:<|> getAccount
26-
:<|> listAccounts
27-
:<|> newAccount
28-
:<|> updateAccount
29-
:<|> getAccountAddresses
30-
:<|> getAccountBalance
26+
:<|> getAccount nm
27+
:<|> listAccounts nm
28+
:<|> newAccount nm
29+
:<|> updateAccount nm
30+
:<|> getAccountAddresses nm
31+
:<|> getAccountBalance nm
3132

3233
deleteAccount
3334
:: (V0.MonadWalletLogic ctx m)
34-
=> WalletId -> AccountIndex -> m NoContent
35+
=> WalletId
36+
-> AccountIndex
37+
-> m NoContent
3538
deleteAccount wId accIdx =
3639
migrate (wId, accIdx) >>= V0.deleteAccount
3740

3841
getAccount
3942
:: (MonadThrow m, V0.MonadWalletLogicRead ctx m)
40-
=> WalletId -> AccountIndex -> m (WalletResponse Account)
41-
getAccount wId accIdx =
42-
single <$> (migrate (wId, accIdx) >>= V0.getAccount >>= migrate)
43+
=> NetworkMagic
44+
-> WalletId
45+
-> AccountIndex
46+
-> m (WalletResponse Account)
47+
getAccount nm wId accIdx =
48+
single <$> (migrate (wId, accIdx) >>= V0.getAccount nm >>= migrate)
4349

4450
listAccounts
4551
:: (MonadThrow m, V0.MonadWalletLogicRead ctx m)
46-
=> WalletId -> RequestParams -> m (WalletResponse [Account])
47-
listAccounts wId params = do
52+
=> NetworkMagic
53+
-> WalletId
54+
-> RequestParams
55+
-> m (WalletResponse [Account])
56+
listAccounts nm wId params = do
4857
wid' <- migrate wId
49-
oldAccounts <- V0.getAccounts (Just wid')
58+
oldAccounts <- V0.getAccounts nm (Just wid')
5059
newAccounts <- migrate @[V0.CAccount] @[Account] oldAccounts
5160
respondWith params
5261
(NoFilters :: FilterOperations '[] Account)
@@ -55,41 +64,50 @@ listAccounts wId params = do
5564

5665
newAccount
5766
:: (V0.MonadWalletLogic ctx m)
58-
=> WalletId -> NewAccount -> m (WalletResponse Account)
59-
newAccount wId nAccount@NewAccount{..} = do
67+
=> NetworkMagic
68+
-> WalletId
69+
-> NewAccount
70+
-> m (WalletResponse Account)
71+
newAccount nm wId nAccount@NewAccount{..} = do
6072
let (V1 spendingPw) = fromMaybe (V1 mempty) naccSpendingPassword
6173
accInit <- migrate (wId, nAccount)
62-
cAccount <- V0.newAccount V0.RandomSeed spendingPw accInit
74+
cAccount <- V0.newAccount nm V0.RandomSeed spendingPw accInit
6375
single <$> (migrate cAccount)
6476

6577
updateAccount
6678
:: (V0.MonadWalletLogic ctx m)
67-
=> WalletId -> AccountIndex -> AccountUpdate -> m (WalletResponse Account)
68-
updateAccount wId accIdx accUpdate = do
79+
=> NetworkMagic
80+
-> WalletId
81+
-> AccountIndex
82+
-> AccountUpdate
83+
-> m (WalletResponse Account)
84+
updateAccount nm wId accIdx accUpdate = do
6985
newAccId <- migrate (wId, accIdx)
7086
accMeta <- migrate accUpdate
71-
cAccount <- V0.updateAccount newAccId accMeta
87+
cAccount <- V0.updateAccount nm newAccId accMeta
7288
single <$> (migrate cAccount)
7389

7490
getAccountAddresses
7591
:: (V0.MonadWalletLogic ctx m)
76-
=> WalletId
92+
=> NetworkMagic
93+
-> WalletId
7794
-> AccountIndex
7895
-> RequestParams
7996
-> FilterOperations '[V1 Address] WalletAddress
8097
-> m (WalletResponse AccountAddresses)
81-
getAccountAddresses wId accIdx pagination filters = do
82-
resp <- respondWith pagination filters NoSorts (getAddresses <$> getAccount wId accIdx)
98+
getAccountAddresses nm wId accIdx pagination filters = do
99+
resp <- respondWith pagination filters NoSorts (getAddresses <$> getAccount nm wId accIdx)
83100
return resp { wrData = AccountAddresses . wrData $ resp }
84101
where
85102
getAddresses =
86103
IxSet.fromList . accAddresses . wrData
87104

88105
getAccountBalance
89106
:: (V0.MonadWalletLogic ctx m)
90-
=> WalletId
107+
=> NetworkMagic
108+
-> WalletId
91109
-> AccountIndex
92110
-> m (WalletResponse AccountBalance)
93-
getAccountBalance wId accIdx = do
94-
resp <- getAccount wId accIdx
111+
getAccountBalance nm wId accIdx = do
112+
resp <- getAccount nm wId accIdx
95113
return resp { wrData = AccountBalance . accAmount . wrData $ resp }

src/Cardano/Wallet/API/V1/LegacyHandlers/Addresses.hs

+17-13
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import Servant
1212

1313

1414
import Pos.Core (decodeTextAddress)
15+
import Pos.Core.NetworkMagic (NetworkMagic)
1516
import Pos.Crypto (emptyPassphrase)
1617
import qualified Pos.DB.Txp as V0 (withTxpLocalData)
1718
import qualified Pos.Wallet.Web.Account as V0
@@ -40,10 +41,11 @@ import qualified Cardano.Wallet.Kernel.DB.Util.IxSet as IxSet
4041

4142
handlers
4243
:: V0.MonadWalletLogic ctx m
43-
=> ServerT Addresses.API m
44-
handlers = listAddresses
45-
:<|> newAddress
46-
:<|> getAddress
44+
=> NetworkMagic
45+
-> ServerT Addresses.API m
46+
handlers nm = listAddresses nm
47+
:<|> newAddress nm
48+
:<|> getAddress nm
4749

4850
-- | This is quite slow. What happens when we have 50k addresses?
4951
-- TODO(ks): One idea I have is to persist the length of the
@@ -56,9 +58,10 @@ handlers = listAddresses
5658
-- but I have an idea or two how that can be fixed.
5759
listAddresses
5860
:: forall ctx m. (MonadThrow m, V0.MonadWalletLogic ctx m)
59-
=> RequestParams
61+
=> NetworkMagic
62+
-> RequestParams
6063
-> m (WalletResponse [WalletAddress])
61-
listAddresses params = do
64+
listAddresses nm params = do
6265

6366
wdb <- askWalletDB
6467
ws <- getWalletSnapshot wdb
@@ -75,26 +78,27 @@ listAddresses params = do
7578
runStreamAddresses ws =
7679
runConduit $ CL.sourceList (getWalletAddresses ws)
7780
.| CL.map Just
78-
.| CL.concatMapM V0.getAccounts
81+
.| CL.concatMapM (V0.getAccounts nm)
7982
.| CL.concatMap caAddresses
8083
.| CL.mapM migrate
8184
.| CL.fold (\x a -> IxSet.updateIx (addrId a) a x) IxSet.empty
8285

8386
newAddress
8487
:: (MonadThrow m, V0.MonadWalletLogic ctx m)
85-
=> NewAddress -> m (WalletResponse WalletAddress)
86-
newAddress NewAddress {..} = do
88+
=> NetworkMagic -> NewAddress -> m (WalletResponse WalletAddress)
89+
newAddress nm NewAddress {..} = do
8790
let (V1 password) = fromMaybe (V1 emptyPassphrase) newaddrSpendingPassword
8891
accountId <- migrate (newaddrWalletId, newaddrAccountIndex)
89-
fmap single $ V0.newAddress V0.RandomSeed password accountId
92+
fmap single $ V0.newAddress nm V0.RandomSeed password accountId
9093
>>= migrate
9194

9295
-- | Verifies that an address is base58 decodable.
9396
getAddress
9497
:: (MonadThrow m , V0.MonadWalletLogic ctx m)
95-
=> Text
98+
=> NetworkMagic
99+
-> Text
96100
-> m (WalletResponse WalletAddress)
97-
getAddress addrText = do
101+
getAddress nm addrText = do
98102
addr <- either
99103
(throwM . InvalidAddressFormat)
100104
pure
@@ -126,6 +130,6 @@ getAddress addrText = do
126130
Just (_walletMeta, V0.AddressInfo{..}) -> do
127131
let accId = adiWAddressMeta ^. V0.wamAccount
128132
mps <- V0.withTxpLocalData V0.getMempoolSnapshot
129-
accMod <- V0.txMempoolToModifier ws mps . keyToWalletDecrCredentials =<< V0.findKey accId
133+
accMod <- V0.txMempoolToModifier ws mps . keyToWalletDecrCredentials nm =<< V0.findKey nm accId
130134
let caddr = V0.getWAddress ws accMod adiWAddressMeta
131135
single <$> migrate caddr

src/Cardano/Wallet/API/V1/LegacyHandlers/Wallets.hs

+30-23
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ import Pos.Chain.Genesis as Genesis (Config (..),
2626
import Pos.Chain.Update ()
2727
import qualified Pos.Core as Core
2828

29+
import Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic)
2930
import Pos.Util (HasLens (..))
3031
import qualified Pos.Wallet.WalletMode as V0
3132
import Pos.Wallet.Web.Methods.Logic (MonadWalletLogic,
@@ -36,13 +37,15 @@ import Servant
3637

3738
-- | All the @Servant@ handlers for wallet-specific operations.
3839
handlers :: Genesis.Config -> ServerT Wallets.API MonadV1
39-
handlers genesisConfig = newWallet genesisConfig
40-
:<|> listWallets
41-
:<|> updatePassword
42-
:<|> deleteWallet
43-
:<|> getWallet
44-
:<|> updateWallet
45-
:<|> getUtxoStatistics
40+
handlers genesisConfig =
41+
let nm = makeNetworkMagic $ configProtocolMagic genesisConfig
42+
in newWallet genesisConfig
43+
:<|> listWallets nm
44+
:<|> updatePassword nm
45+
:<|> deleteWallet nm
46+
:<|> getWallet nm
47+
:<|> updateWallet nm
48+
:<|> getUtxoStatistics
4649

4750
-- | Pure function which returns whether or not the underlying node is
4851
-- \"synced enough\" to allow wallet creation/restoration. The notion of
@@ -83,7 +86,8 @@ newWallet genesisConfig NewWallet{..} = do
8386
unless (isNodeSufficientlySynced (configBlkSecurityParam genesisConfig) spV0)
8487
$ throwM (NodeIsStillSyncing syncPercentage)
8588

86-
let newWalletHandler CreateWallet = V0.newWalletNoThrow
89+
let nm = makeNetworkMagic $ configProtocolMagic genesisConfig
90+
newWalletHandler CreateWallet = V0.newWalletNoThrow nm
8791
newWalletHandler RestoreWallet = V0.restoreWalletFromSeedNoThrow genesisConfig
8892
(V1 spendingPassword) = fromMaybe (V1 mempty) newwalSpendingPassword
8993
(BackupPhrase backupPhrase) = newwalBackupPhrase
@@ -106,46 +110,48 @@ listWallets :: ( MonadThrow m
106110
, V0.MonadWalletLogicRead ctx m
107111
, V0.MonadBlockchainInfo m
108112
)
109-
=> RequestParams
113+
=> NetworkMagic
114+
-> RequestParams
110115
-> FilterOperations '[WalletId, Core.Coin] Wallet
111116
-> SortOperations Wallet
112117
-> m (WalletResponse [Wallet])
113-
listWallets params fops sops = do
118+
listWallets nm params fops sops = do
114119
ws <- V0.askWalletSnapshot
115120
currentDepth <- V0.networkChainDifficulty
116121
respondWith params fops sops (IxSet.fromList <$> do
117-
(V0.getWalletsWithInfo ws >>= (migrate @_ @[V1.Wallet] . map (\(w, i) -> (w,i,currentDepth)))))
122+
(V0.getWalletsWithInfo nm ws >>= (migrate @_ @[V1.Wallet] . map (\(w, i) -> (w,i,currentDepth)))))
118123

119124
updatePassword
120125
:: ( MonadWalletLogic ctx m
121126
, V0.MonadBlockchainInfo m
122127
)
123-
=> WalletId -> PasswordUpdate -> m (WalletResponse Wallet)
124-
updatePassword wid PasswordUpdate{..} = do
128+
=> NetworkMagic -> WalletId -> PasswordUpdate -> m (WalletResponse Wallet)
129+
updatePassword nm wid PasswordUpdate{..} = do
125130
wid' <- migrate wid
126131
let (V1 old) = pwdOld
127132
(V1 new) = pwdNew
128-
_ <- V0.changeWalletPassphrase wid' old new
133+
_ <- V0.changeWalletPassphrase nm wid' old new
129134
single <$> do
130135
ss <- V0.askWalletSnapshot
131-
wallet <- V0.getWallet wid'
136+
wallet <- V0.getWallet nm wid'
132137
addWalletInfo ss wallet
133138

134139
-- | Deletes an exisiting wallet.
135140
deleteWallet
136141
:: (MonadWalletLogic ctx m)
137-
=> WalletId
142+
=> NetworkMagic
143+
-> WalletId
138144
-> m NoContent
139-
deleteWallet = V0.deleteWallet <=< migrate
145+
deleteWallet nm = V0.deleteWallet nm <=< migrate
140146

141147
getWallet :: ( MonadThrow m
142148
, MonadWalletLogicRead ctx m
143149
, V0.MonadBlockchainInfo m
144-
) => WalletId -> m (WalletResponse Wallet)
145-
getWallet wid = do
150+
) => NetworkMagic -> WalletId -> m (WalletResponse Wallet)
151+
getWallet nm wid = do
146152
ss <- V0.askWalletSnapshot
147153
wid' <- migrate wid
148-
wallet <- V0.getWallet wid'
154+
wallet <- V0.getWallet nm wid'
149155
single <$> addWalletInfo ss wallet
150156

151157
addWalletInfo
@@ -168,15 +174,16 @@ updateWallet
168174
:: (V0.MonadWalletLogic ctx m
169175
, V0.MonadBlockchainInfo m
170176
)
171-
=> WalletId
177+
=> NetworkMagic
178+
-> WalletId
172179
-> WalletUpdate
173180
-> m (WalletResponse Wallet)
174-
updateWallet wid WalletUpdate{..} = do
181+
updateWallet nm wid WalletUpdate{..} = do
175182
ws <- V0.askWalletSnapshot
176183
wid' <- migrate wid
177184
assurance <- migrate uwalAssuranceLevel
178185
walletMeta <- maybe (throwM WalletNotFound) pure $ V0.getWalletMeta wid' ws
179-
updated <- V0.updateWallet wid' walletMeta
186+
updated <- V0.updateWallet nm wid' walletMeta
180187
{ V0.cwName = uwalName
181188
, V0.cwAssurance = assurance
182189
}

src/Cardano/Wallet/API/V1/Swagger.hs

+1-4
Original file line numberDiff line numberDiff line change
@@ -393,7 +393,7 @@ $errors
393393
{ Core.addrRoot =
394394
Crypto.unsafeAbstractHash ("asdfasdf" :: String)
395395
, Core.addrAttributes =
396-
Core.mkAttributes $ Core.AddrAttributes Nothing Core.BootstrapEraDistr fixedNM
396+
Core.mkAttributes $ Core.AddrAttributes Nothing Core.BootstrapEraDistr NetworkMainOrStage
397397
, Core.addrType =
398398
Core.ATPubKey
399399
}
@@ -1105,6 +1105,3 @@ api (compileInfo, curSoftwareVersion) walletAPI mkDescription = toSwagger wallet
11051105
& paths %~ (DELETE, "/api/internal/reset-wallet-state") `setDescription` resetWalletStateDescription
11061106
& paths %~ (POST, "/api/v1/transactions/fees") `setDescription` estimateFeesDescription
11071107
& paths %~ (GET, "/api/v1/addresses/{address}") `setDescription` getAddressDescription
1108-
1109-
fixedNM :: NetworkMagic
1110-
fixedNM = NetworkMainOrStage

0 commit comments

Comments
 (0)