Merge pull request #3561 from input-output-hk/intricate+mhuesch/CO-354/implement-networkmagic

[release/1.3.1] [CO-354] Implement `NetworkMagic` logic

Author: erikd

auxx/src/Command/BlockGen.hs

@@ -14,6 +14,7 @@ import           System.Wlog (logInfo)
 import           Pos.AllSecrets (mkAllSecretsSimple)
 import           Pos.Client.KeyStorage (getSecretKeysPlain)
 import           Pos.Core (gdBootStakeholders, genesisData)
+import           Pos.Core.NetworkMagic (makeNetworkMagic)
 import           Pos.Crypto (ProtocolMagic, encToSecret)
 import           Pos.Generator.Block (BlockGenParams (..), genBlocks, tgpTxCountRange)
 import           Pos.Infra.StateLock (Priority (..), withStateLock)
@@ -30,7 +31,8 @@ generateBlocks pm GenBlocksParams{..} = withStateLock HighPriority ApplyBlock $
     seed <- liftIO $ maybe randomIO pure bgoSeed
     logInfo $ "Generating with seed " <> show seed
 
-    allSecrets <- mkAllSecretsSimple . map encToSecret <$> getSecretKeysPlain
+    let nm = makeNetworkMagic pm
+    allSecrets <- mkAllSecretsSimple nm . map encToSecret <$> getSecretKeysPlain
 
     let bgenParams =
             BlockGenParams

auxx/src/Command/Proc.hs

@@ -17,12 +17,11 @@ import qualified Text.JSON.Canonical as CanonicalJSON
 
 import           Pos.Client.KeyStorage (addSecretKey, getSecretKeysPlain)
 import           Pos.Client.Txp.Balances (getBalance)
-import           Pos.Core (AddrStakeDistribution (..), Address, HeavyDlgIndex (..),
-                           SoftwareVersion (..), StakeholderId, addressHash, mkMultiKeyDistr,
-                           unsafeGetCoin)
+import           Pos.Core (AddrStakeDistribution (..), HeavyDlgIndex (..), SoftwareVersion (..),
+                           StakeholderId, addressHash, mkMultiKeyDistr, unsafeGetCoin)
 import           Pos.Core.Common (AddrAttributes (..), AddrSpendingData (..), makeAddress)
 import           Pos.Core.Configuration (genesisSecretKeys)
-import           Pos.Core.NetworkMagic (NetworkMagic (..))
+import           Pos.Core.NetworkMagic (makeNetworkMagic)
 import           Pos.Core.Txp (TxOut (..))
 import           Pos.Crypto (ProtocolMagic, PublicKey, emptyPassphrase, encToPublic, fullPublicKeyF,
                              hashHexF, noPassEncrypt, safeCreatePsk, unsafeCheatingHashCoerce,
@@ -94,6 +93,8 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
 
     let name = "addr" in
     needsAuxxMode name >>= \Dict ->
+    needsProtocolMagic name >>= \pm ->
+    let nm = makeNetworkMagic pm in
     return CommandProc
     { cpName = name
     , cpArgumentPrepare = map
@@ -104,9 +105,9 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
     , cpExec = \(pk', mDistr) -> do
         pk <- toLeft pk'
         addr <- case mDistr of
-            Nothing -> makePubKeyAddressAuxx fixedNM pk
+            Nothing -> makePubKeyAddressAuxx nm pk
             Just distr -> return $
-                makeAddress (PubKeyASD pk) (AddrAttributes Nothing distr fixedNM)
+                makeAddress (PubKeyASD pk) (AddrAttributes Nothing distr nm)
         return $ ValueAddress addr
     , cpHelp = "address for the specified public key. a stake distribution \
              \ can be specified manually (by default it uses the current epoch \
@@ -115,6 +116,7 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
 
     let name = "addr-hd" in
     needsAuxxMode name >>= \Dict ->
+    needsProtocolMagic name >>= \pm ->
     return CommandProc
     { cpName = name
     , cpArgumentPrepare = identity
@@ -124,7 +126,8 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
         sk <- evaluateWHNF (sks !! i) -- WHNF is sufficient to force possible errors
                                       -- from using (!!). I'd use NF but there's no
                                       -- NFData instance for secret keys.
-        addrHD <- deriveHDAddressAuxx fixedNM sk
+        let nm = makeNetworkMagic pm
+        addrHD <- deriveHDAddressAuxx nm sk
         return $ ValueAddress addrHD
     , cpHelp = "address of the HD wallet for the specified public key"
     },
@@ -182,12 +185,16 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
 
     let name = "balance" in
     needsAuxxMode name >>= \Dict ->
+    needsProtocolMagic name >>= \pm ->
+    let nm = makeNetworkMagic pm in
     return CommandProc
     { cpName = name
     , cpArgumentPrepare = identity
     , cpArgumentConsumer = getArg (tyAddress `tyEither` tyPublicKey `tyEither` tyInt) "addr"
     , cpExec = \addr' -> do
-        addr <- toLeft addr'
+        addr <- case addr' of
+            Left a    -> pure a
+            Right pki -> makePubKeyAddressAuxx nm =<< toLeft pki
         balance <- getBalance addr
         return $ ValueNumber (fromIntegral . unsafeGetCoin $ balance)
     , cpHelp = "check the amount of coins on the specified address"
@@ -466,6 +473,8 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
 
     let name = "listaddr" in
     needsAuxxMode name >>= \Dict ->
+    needsProtocolMagic name >>= \pm ->
+    let nm = makeNetworkMagic pm in
     return CommandProc
     { cpName = name
     , cpArgumentPrepare = identity
@@ -475,8 +484,8 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
         printAction "Available addresses:"
         for_ (zip [0 :: Int ..] sks) $ \(i, sk) -> do
             let pk = encToPublic sk
-            addr <- makePubKeyAddressAuxx fixedNM pk
-            addrHD <- deriveHDAddressAuxx fixedNM sk
+            addr <- makePubKeyAddressAuxx nm pk
+            addrHD <- deriveHDAddressAuxx nm sk
             printAction $
                 sformat ("    #"%int%":   addr:      "%build%"\n"%
                          "          pk:        "%fullPublicKeyF%"\n"%
@@ -485,7 +494,7 @@ createCommandProcs mpm hasAuxxMode printAction mDiffusion = rights . fix $ \comm
                     i addr pk (addressHash pk) addrHD
         walletMB <- (^. usWallet) <$> (view userSecret >>= atomically . readTVar)
         whenJust walletMB $ \wallet -> do
-            addrHD <- deriveHDAddressAuxx fixedNM (_wusRootKey wallet)
+            addrHD <- deriveHDAddressAuxx nm (_wusRootKey wallet)
             printAction $
                 sformat ("    Wallet address:\n"%
                          "          HD addr:   "%build)
@@ -536,16 +545,9 @@ instance MonadAuxxMode m => ToLeft m PublicKey Int where
 instance MonadAuxxMode m => ToLeft m StakeholderId PublicKey where
     toLeft = return . either identity addressHash
 
-instance MonadAuxxMode m => ToLeft m Address PublicKey where
-    toLeft = either return (makePubKeyAddressAuxx fixedNM)
-
 getPublicKeyFromIndex :: MonadAuxxMode m => Int -> m PublicKey
 getPublicKeyFromIndex i = do
     sks <- getSecretKeysPlain
     let sk = sks !! i
         pk = encToPublic sk
     evaluateNF pk
-
-
-fixedNM :: NetworkMagic
-fixedNM = NMNothing

auxx/src/Command/Tx.hs

@@ -40,7 +40,7 @@ import           Pos.Client.Txp.Util (createTx)
 import           Pos.Core (BlockVersionData (bvdSlotDuration), IsBootstrapEraAddr (..),
                            Timestamp (..), deriveFirstHDAddress, makePubKeyAddress, mkCoin)
 import           Pos.Core.Configuration (genesisBlockVersionData, genesisSecretKeys)
-import           Pos.Core.NetworkMagic (NetworkMagic (..))
+import           Pos.Core.NetworkMagic (makeNetworkMagic)
 import           Pos.Core.Txp (TxAux (..), TxIn (TxInUtxo), TxOut (..), TxOutAux (..), txaF)
 import           Pos.Crypto (EncryptedSecretKey, ProtocolMagic, emptyPassphrase, encToPublic,
                              fakeSigner, hash, safeToPublic, toPublic, withSafeSigners)
@@ -104,18 +104,19 @@ sendToAllGenesis pm diffusion (SendToAllGenesisParams genesisTxsPerThread txsPer
         logInfo $ sformat ("Found "%shown%" keys in the genesis block.") (length keysToSend)
         startAtTxt <- liftIO $ lookupEnv "AUXX_START_AT"
         let startAt = fromMaybe 0 . readMaybe . fromMaybe "" $ startAtTxt :: Int
+        let nm = makeNetworkMagic pm
         -- construct a transaction, and add it to the queue
         let addTx secretKey = do
                 let signer = fakeSigner secretKey
                     publicKey = toPublic secretKey
                 -- construct transaction output
-                outAddr <- makePubKeyAddressAuxx fixedNM publicKey
+                outAddr <- makePubKeyAddressAuxx nm publicKey
                 let txOut1 = TxOut {
                     txOutAddress = outAddr,
                     txOutValue = mkCoin 1
                     }
                     txOuts = TxOutAux txOut1 :| []
-                utxo <- getOwnUtxoForPk fixedNM $ safeToPublic signer
+                utxo <- getOwnUtxoForPk nm $ safeToPublic signer
                 etx <- createTx pm mempty utxo signer txOuts publicKey
                 case etx of
                     Left err -> logError (sformat ("Error: "%build%" while trying to contruct tx") err)
@@ -221,11 +222,12 @@ send
     -> m ()
 send pm diffusion idx outputs = do
     skey <- takeSecret
+    let nm = makeNetworkMagic pm
     let curPk = encToPublic skey
-    let plainAddresses = map (flip (makePubKeyAddress fixedNM) curPk . IsBootstrapEraAddr) [False, True]
+    let plainAddresses = map (flip (makePubKeyAddress nm) curPk . IsBootstrapEraAddr) [False, True]
     let (hdAddresses, hdSecrets) = unzip $ map
             (\ibea -> fromMaybe (error "send: pass mismatch") $
-                    deriveFirstHDAddress fixedNM (IsBootstrapEraAddr ibea) emptyPassphrase skey) [False, True]
+                    deriveFirstHDAddress nm (IsBootstrapEraAddr ibea) emptyPassphrase skey) [False, True]
     let allAddresses = hdAddresses ++ plainAddresses
     let allSecrets = hdSecrets ++ [skey, skey]
     etx <- withSafeSigners allSecrets (pure emptyPassphrase) $ \signers -> runExceptT @AuxxException $ do
@@ -273,6 +275,3 @@ sendTxsFromFile diffusion txsFile = do
                 (topsortTxAuxes txAuxes)
         let submitOne = submitTxRaw diffusion
         mapM_ submitOne sortedTxAuxes
-
-fixedNM :: NetworkMagic
-fixedNM = NMNothing

block/src/Pos/Block/Logic/Internal.hs

@@ -42,6 +42,7 @@ import           Pos.Core (ComponentBlock (..), IsGenesisHeader, epochIndexL, gb
                            mainBlockUpdatePayload)
 import           Pos.Core.Block (Block, GenesisBlock, MainBlock)
 import           Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..))
+import           Pos.Core.NetworkMagic (makeNetworkMagic)
 import           Pos.Crypto (ProtocolMagic)
 import           Pos.DB (MonadDB, MonadDBRead, MonadGState, SomeBatchOp (..))
 import qualified Pos.DB.GState.Common as GS (writeBatchGState)
@@ -186,7 +187,7 @@ applyBlocksDbUnsafeDo pm scb blunds pModifier = do
     let blocks = fmap fst blunds
     -- Note: it's important to do 'slogApplyBlocks' first, because it
     -- puts blocks in DB.
-    slogBatch <- slogApplyBlocks scb blunds
+    slogBatch <- slogApplyBlocks pm scb blunds
     TxpGlobalSettings {..} <- view (lensOf @TxpGlobalSettings)
     usBatch <- SomeBatchOp <$> usApplyBlocks pm (map toUpdateBlock blocks) pModifier
     delegateBatch <- SomeBatchOp <$> dlgApplyBlocks (map toDlgBlund blunds)
@@ -213,7 +214,8 @@ rollbackBlocksUnsafe
     -> NewestFirst NE Blund
     -> m ()
 rollbackBlocksUnsafe pm bsc scb toRollback = do
-    slogRoll <- slogRollbackBlocks bsc scb toRollback
+    let nm = makeNetworkMagic pm
+    slogRoll <- slogRollbackBlocks nm bsc scb toRollback
     dlgRoll <- SomeBatchOp <$> dlgRollbackBlocks (map toDlgBlund toRollback)
     usRoll <- SomeBatchOp <$> usRollbackBlocks
                   (toRollback & each._2 %~ undoUS

block/src/Pos/Block/Slog/Logic.hs

@@ -42,7 +42,7 @@ import           Pos.Core (BlockVersion (..), FlatSlotId, blkSecurityParam, diff
 import           Pos.Core.Block (Block, genBlockLeaders, mainBlockSlot)
 import           Pos.Core.Chrono (NE, NewestFirst (getNewestFirst), OldestFirst (..), toOldestFirst,
                                   _OldestFirst)
-import           Pos.Core.NetworkMagic (NetworkMagic (..))
+import           Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic)
 import           Pos.Crypto (ProtocolMagic)
 import           Pos.DB (SomeBatchOp (..))
 import           Pos.DB.Block (putBlunds)
@@ -214,10 +214,11 @@ newtype ShouldCallBListener = ShouldCallBListener Bool
 --     6. Setting @inMainChain@ flags
 slogApplyBlocks
     :: MonadSlogApply ctx m
-    => ShouldCallBListener
+    => ProtocolMagic
+    -> ShouldCallBListener
     -> OldestFirst NE Blund
     -> m SomeBatchOp
-slogApplyBlocks (ShouldCallBListener callBListener) blunds = do
+slogApplyBlocks pm (ShouldCallBListener callBListener) blunds = do
     -- Note: it's important to put blunds first. The invariant is that
     -- the sequence of blocks corresponding to the tip must exist in
     -- BlockDB. If program is interrupted after we put blunds and
@@ -227,7 +228,8 @@ slogApplyBlocks (ShouldCallBListener callBListener) blunds = do
     -- If the program is interrupted at this point (after putting blunds
     -- in BlockDB), we will have garbage blunds in BlockDB, but it's not a
     -- problem.
-    bListenerBatch <- if callBListener then onApplyBlocks fixedNM blunds
+    let nm = makeNetworkMagic pm
+    bListenerBatch <- if callBListener then onApplyBlocks nm blunds
                       else pure mempty
 
     let newestBlock = NE.last $ getOldestFirst blunds
@@ -282,11 +284,12 @@ newtype BypassSecurityCheck = BypassSecurityCheck Bool
 --     5. Removing @inMainChain@ flags
 slogRollbackBlocks ::
        MonadSlogApply ctx m
-    => BypassSecurityCheck -- ^ is rollback for more than k blocks allowed?
+    => NetworkMagic
+    -> BypassSecurityCheck -- ^ is rollback for more than k blocks allowed?
     -> ShouldCallBListener
     -> NewestFirst NE Blund
     -> m SomeBatchOp
-slogRollbackBlocks (BypassSecurityCheck bypassSecurity) (ShouldCallBListener callBListener) blunds = do
+slogRollbackBlocks nm (BypassSecurityCheck bypassSecurity) (ShouldCallBListener callBListener) blunds = do
     inAssertMode $ when (isGenesis0 (blocks ^. _Wrapped . _neLast)) $
         assertionFailed $
         colorize Red "FATAL: we are TRYING TO ROLLBACK 0-TH GENESIS block"
@@ -306,7 +309,7 @@ slogRollbackBlocks (BypassSecurityCheck bypassSecurity) (ShouldCallBListener cal
         reportFatalError "slogRollbackBlocks: the attempted rollback would \
                          \lead to a more than 'k' distance between tip and \
                          \last seen block, which is a security risk. Aborting."
-    bListenerBatch <- if callBListener then onRollbackBlocks fixedNM blunds
+    bListenerBatch <- if callBListener then onRollbackBlocks nm blunds
                       else pure mempty
     let putTip =
             SomeBatchOp $ GS.PutTip $
@@ -345,7 +348,3 @@ slogRollbackBlocks (BypassSecurityCheck bypassSecurity) (ShouldCallBListener cal
     blockExtraBatch lastSlots =
         GS.SetLastSlots (newLastSlots lastSlots) :
         mconcat [forwardLinksBatch, inMainBatch]
-
-
-fixedNM :: NetworkMagic
-fixedNM = NMNothing

client/src/Pos/Client/Txp/Network.hs

@@ -25,7 +25,7 @@ import           Pos.Client.Txp.Util (InputSelectionPolicy, PendingAddresses (..
 import           Pos.Communication.Message ()
 import           Pos.Communication.Types (InvOrDataTK)
 import           Pos.Core (Address, Coin, makeRedeemAddress, mkCoin, unsafeAddCoin)
-import           Pos.Core.NetworkMagic (NetworkMagic (..))
+import           Pos.Core.NetworkMagic (makeNetworkMagic)
 import           Pos.Core.Txp (TxAux (..), TxId, TxOut (..), TxOutAux (..), txaF)
 import           Pos.Crypto (ProtocolMagic, RedeemSecretKey, SafeSigner, hash, redeemToPublic)
 import           Pos.Infra.Communication.Protocol (OutSpecs)
@@ -68,7 +68,8 @@ prepareRedemptionTx
     -> Address
     -> m (TxAux, Address, Coin)
 prepareRedemptionTx pm rsk output = do
-    let redeemAddress = makeRedeemAddress fixedNM $ redeemToPublic rsk
+    let nm = makeNetworkMagic pm
+    let redeemAddress = makeRedeemAddress nm $ redeemToPublic rsk
     utxo <- getOwnUtxo redeemAddress
     let addCoin c = unsafeAddCoin c . txOutValue . toaOut
         redeemBalance = foldl' addCoin (mkCoin 0) utxo
@@ -90,7 +91,3 @@ submitTxRaw diffusion txAux@TxAux {..} = do
 
 sendTxOuts :: OutSpecs
 sendTxOuts = createOutSpecs (Proxy :: Proxy (InvOrDataTK TxId TxMsgContents))
-
-
-fixedNM :: NetworkMagic
-fixedNM = NMNothing

client/src/Pos/Client/Txp/Util.hs

@@ -66,7 +66,7 @@ import           Pos.Core (Address, Coin, StakeholderId, TxFeePolicy (..), TxSiz
                            isRedeemAddress, mkCoin, sumCoins, txSizeLinearMinValue,
                            unsafeIntegerToCoin, unsafeSubCoin)
 import           Pos.Core.Configuration (HasConfiguration)
-import           Pos.Core.NetworkMagic (NetworkMagic (..))
+import           Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic)
 import           Pos.Crypto (ProtocolMagic, RedeemSecretKey, SafeSigner,
                              SignTag (SignRedeemTx, SignTx), deterministicKeyGen, fakeSigner, hash,
                              redeemSign, redeemToPublic, safeSign, safeToPublic)
@@ -516,7 +516,7 @@ prepareInpsOuts
     -> TxCreator m (TxOwnedInputs TxOut, TxOutputs)
 prepareInpsOuts pm pendingTx utxo outputs addrData = do
     txRaw@TxRaw {..} <- prepareTxWithFee pm pendingTx utxo outputs
-    outputsWithRem <- mkOutputsWithRem fixedNM addrData txRaw
+    outputsWithRem <- mkOutputsWithRem (makeNetworkMagic pm) addrData txRaw
     pure (trInputs, outputsWithRem)
 
 createGenericTx
@@ -729,7 +729,7 @@ stabilizeTxFee pm pendingTx linearPolicy utxo outputs = do
     stabilizeTxFeeDo (_, 0) _ = pure Nothing
     stabilizeTxFeeDo (isSecondStage, attempt) expectedFee = do
         txRaw <- prepareTxRaw pendingTx utxo outputs expectedFee
-        fakeChangeAddr <- lift . lift $ getFakeChangeAddress fixedNM
+        fakeChangeAddr <- lift . lift $ getFakeChangeAddress (makeNetworkMagic pm)
         txMinFee <- txToLinearFee linearPolicy $
                     createFakeTxFromRawTx pm fakeChangeAddr txRaw
 
@@ -774,7 +774,3 @@ createFakeTxFromRawTx pm fakeAddr TxRaw{..} =
            (\_ -> Right $ fakeSigner fakeSK)
            trInputs
            txOutsWithRem
-
-
-fixedNM :: NetworkMagic
-fixedNM = NMNothing

client/test/Test/Pos/Client/Txp/Mode.hs

@@ -54,16 +54,16 @@ instance MonadGState TxpTestMode where
 
 instance MonadAddresses TxpTestMode where
     type AddrData TxpTestMode = ()
-    getNewAddress _ _ = pure fakeAddressForMonadAddresses
-    getFakeChangeAddress _ = pure fakeAddressForMonadAddresses
+    getNewAddress nm _ = pure (fakeAddressForMonadAddresses nm)
+    getFakeChangeAddress = pure . fakeAddressForMonadAddresses
 
-fakeAddressForMonadAddresses :: Address
-fakeAddressForMonadAddresses = address
+fakeAddressForMonadAddresses :: NetworkMagic -> Address
+fakeAddressForMonadAddresses nm = address
   where
     -- seed for address generation is a ByteString with 32 255's
     seedSize = 32
     seed = BS.replicate seedSize (255 :: Word8)
-    address = makePubKeyAddressBoot fixedNM $ fst $ deterministicKeyGen seed
+    address = makePubKeyAddressBoot nm $ fst $ deterministicKeyGen seed
 
 withBVData
   :: MonadReader BlockVersionData m
@@ -87,7 +87,3 @@ instance MonadAddresses TxpTestProperty where
 
 instance (HasTxpConfigurations, Testable a) => Testable (TxpTestProperty a) where
     property = monadic (ioProperty . flip runReaderT genesisBlockVersionData)
-
-
-fixedNM :: NetworkMagic
-fixedNM = NMNothing