From 01f45d64bc1a5c0ae4aa8bb8d287fab2adcaaef3 Mon Sep 17 00:00:00 2001
From: Jordan Millar <jordan.millar@iohk.io>
Date: Fri, 22 Nov 2019 13:54:41 -0400
Subject: [PATCH] Implement `RealNodeTopology` While running a real protocol,
 the node determines the peers it will connect to from a JSON configuration
 file.

---
 cardano-config/src/Cardano/Config/Topology.hs |  8 +++++
 cardano-node/src/Cardano/Node/Run.hs          | 35 ++++++++++++++++---
 configuration/topology-proxy-follower.json    | 21 +++++------
 scripts/mainnet-proxy-follower.sh             |  3 +-
 4 files changed, 47 insertions(+), 20 deletions(-)

diff --git a/cardano-config/src/Cardano/Config/Topology.hs b/cardano-config/src/Cardano/Config/Topology.hs
index a7d66adefae..114099b883f 100644
--- a/cardano-config/src/Cardano/Config/Topology.hs
+++ b/cardano-config/src/Cardano/Config/Topology.hs
@@ -12,6 +12,7 @@ module Cardano.Config.Topology
   , NodeAddress(..)
   , NodeHostAddress(..)
   , NodeSetup(..)
+  , RealNodeTopology(..)
   , RemoteAddress(..)
   , createNodeAddress
   , nodeAddressInfo
@@ -134,6 +135,13 @@ data NodeSetup = NodeSetup
   , producers :: ![RemoteAddress]
   } deriving Show
 
+data RealNodeTopology = RealNodeTopology { rProducers :: ![RemoteAddress] }
+
+instance FromJSON RealNodeTopology where
+  parseJSON = withObject "RealNodeTopology" $ \v ->
+    RealNodeTopology
+      <$> v .: "rProducers"
+
 instance FromJSON NodeId where
   parseJSON v = CoreId <$> parseJSON v
 
diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
index 2ba9a605b90..119bf378184 100644
--- a/cardano-node/src/Cardano/Node/Run.hs
+++ b/cardano-node/src/Cardano/Node/Run.hs
@@ -26,8 +26,12 @@ import           Prelude (error, id, unlines)
 #ifdef UNIX
 import qualified Control.Concurrent.Async as Async
 #endif
+import           Control.Exception (IOException)
+import qualified Control.Exception as Exception
 import           Control.Tracer
+import           Data.Aeson (eitherDecode)
 import qualified Data.ByteString.Char8 as BSC
+import qualified Data.ByteString.Lazy as LB
 import           Data.Either (partitionEithers)
 import           Data.Functor.Contravariant (contramap)
 import qualified Data.List as List
@@ -161,13 +165,21 @@ handleSimpleNode p trace nodeTracers npm = do
     RealProtocolMode (NodeRealCLI rMscFp rNodeAddr _ _) -> do
       let pInfo@ProtocolInfo{ pInfoConfig = cfg } = protocolInfo p
 
-      hn <- getHostName
+      -- Topology
+      eitherTopology <- readRealNodeTopology . unTopology $ topFile rMscFp
+      topology <- case eitherTopology of
+                    --TODO: Convert handleSimpleNode to return `ExceptT`
+                    Left err -> panic $ "Cardano.Node.Run.readRealNodeTopology: "
+                                      <> err
+                    Right top -> pure top
+
       -- Tracing
       let tracer = contramap pack $ toLogObject trace
       traceWith tracer $ unlines
-        [ "**************************************"
-        , "Node IP: " <> naHostAddress rNodeAddr
-        , "My producers are " --TODO: Should depend on the jq version of top file
+        [ ""
+        , "**************************************"
+        , "Host node address: " <> show rNodeAddr
+        , "My producers are " <> (show $ rProducers topology)
         , "**************************************"
         ]
 
@@ -184,7 +196,7 @@ handleSimpleNode p trace nodeTracers npm = do
           dnsProducerAddrs :: [RemoteAddress]
           (ipProducerAddrs, dnsProducerAddrs) = partitionEithers
             [ maybe (Right ra) Left $ remoteAddressToNodeAddress ra
-            | ra <- [RemoteAddress "18.185.45.45" 3001 1] ]
+            | ra <- rProducers topology ]
           ipProducers :: [SockAddr]
           ipProducers = nodeAddressToSockAddr <$> ipProducerAddrs
 
@@ -336,3 +348,16 @@ handleSimpleNode p trace nodeTracers npm = do
               Just (CoreId  n) -> n
               Just (RelayId _) -> error "Non-core nodes currently not supported"
               Nothing -> 999
+
+-- | Read the `RealNodeTopology` configuration from the specified file.
+-- While running a real protocol, this gives your node its own address and
+-- other remote peers it will attempt to connect to.
+readRealNodeTopology :: FilePath -> IO (Either Text RealNodeTopology)
+readRealNodeTopology fp = do
+  ebs <- Exception.try $ BSC.readFile fp :: IO (Either IOException BSC.ByteString)
+  case ebs of
+    Left e -> pure $ handler e
+    Right bs -> pure . first toS . eitherDecode $ LB.fromStrict bs
+ where
+   handler :: IOException -> Either Text RealNodeTopology
+   handler e =  Left . pack $ show e
diff --git a/configuration/topology-proxy-follower.json b/configuration/topology-proxy-follower.json
index 5c81c41003c..cadb8d0e9f5 100644
--- a/configuration/topology-proxy-follower.json
+++ b/configuration/topology-proxy-follower.json
@@ -1,14 +1,9 @@
-[
-    { "nodeId": 0
-    , "nodeAddress":
-      { "addr": "127.0.0.1"
-      , "port": 7776
-      }
-    , "producers":
-      [ { "addr": "18.185.45.45"
-        , "port": 3001
-        , "valency": 1
-        }
-      ]
+{
+  "rProducers": [
+    {
+      "addr": "18.185.45.45",
+      "port": 3001,
+      "valency": 1
     }
-]
+  ]
+}
diff --git a/scripts/mainnet-proxy-follower.sh b/scripts/mainnet-proxy-follower.sh
index a583ecea033..21d12881a99 100755
--- a/scripts/mainnet-proxy-follower.sh
+++ b/scripts/mainnet-proxy-follower.sh
@@ -3,12 +3,11 @@
 set -e
 
 RUNNER=${RUNNER:-cabal new-run --}
-TOPOLOGY=${TOPOLOGY:-"configuration/topology-proxy-follower.json"}
 
 ARGS=(  run
         --database-path           "./db"
         --genesis-file            "configuration/mainnet-genesis.json"
-        --topology                "${TOPOLOGY}"
+         --topology                "configuration/topology-proxy-follower.json"
         --socket-path             "./socket/mainnet-proxy-socket"
         --config                  "./configuration/mainnet-proxy-follower.yaml"
         --port                    7776