king: port the '-e' option to specify ethereum node endpoint.

pkg/hs/urbit-king/lib/Urbit/King/CLI.hs

@@ -89,6 +89,7 @@ data New = New
     , nArvoDir    :: Maybe FilePath
     , nBootType   :: BootType
     , nLite       :: Bool
+    , nEthNode    :: String
     , nSerfExe    :: Maybe Text
     }
   deriving (Show)
@@ -125,7 +126,8 @@ data Bug
         , bFinalEvt :: Word64
         }
     | CheckDawn
-        { bKeyfilePath :: FilePath
+        { bEthNode     :: String
+        , bKeyfilePath :: FilePath
         }
     | CheckComet
   deriving (Show)
@@ -248,6 +250,14 @@ serfExe =  optional
     <> help "Path to serf binary to run ships in"
     <> hidden
 
+ethNode :: Parser String
+ethNode = strOption
+     $ short 'e'
+    <> long "eth-node"
+    <> value "http://eth-mainnet.urbit.org:8545"
+    <> help "Ethereum gateway URL"
+    <> hidden
+
 new :: Parser New
 new = do
     nPierPath <- optional pierPath
@@ -268,6 +278,8 @@ new = do
                    <> value Nothing
                    <> help "Replace initial clay filesys with contents of PATH"
 
+    nEthNode <- ethNode
+
     nSerfExe <- serfExe
 
     pure New{..}
@@ -522,7 +534,7 @@ browseEvs :: Parser Bug
 browseEvs = EventBrowser <$> pierPath
 
 checkDawn :: Parser Bug
-checkDawn = CheckDawn <$> keyfilePath
+checkDawn = CheckDawn <$> ethNode <*> keyfilePath
 
 bugCmd :: Parser (Cmd, Log)
 bugCmd = (flip (,) <$> log <*>) $ fmap CmdBug

pkg/hs/urbit-king/lib/Urbit/King/Main.hs

@@ -537,7 +537,7 @@ newShip CLI.New{..} opts = do
 
     bootFromSeed :: Pill -> Seed -> RIO HostEnv ()
     bootFromSeed pill seed = do
-      ethReturn <- dawnVent seed
+      ethReturn <- dawnVent nEthNode seed
 
       case ethReturn of
         Left x -> error $ unpack x
@@ -627,8 +627,8 @@ startBrowser pierPath = runRAcquire $ do
     log <- Log.existing (pierPath <> "/.urb/log")
     rio $ EventBrowser.run log
 
-checkDawn :: HasLogFunc e => FilePath -> RIO e ()
-checkDawn keyfilePath = do
+checkDawn :: HasLogFunc e => String -> FilePath -> RIO e ()
+checkDawn provider keyfilePath = do
   -- The keyfile is a jammed Seed then rendered in UW format
   text <- readFileUtf8 keyfilePath
   asAtom <- case cordToUW (Cord $ T.strip text) of
@@ -642,7 +642,7 @@ checkDawn keyfilePath = do
 
   print $ show seed
 
-  e <- dawnVent seed
+  e <- dawnVent provider seed
   print $ show e
 
 
@@ -673,7 +673,7 @@ main = do
     CLI.CmdBug (CLI.ValidateEvents pax f   l) -> checkEvs pax f l
     CLI.CmdBug (CLI.ValidateFX     pax f   l) -> checkFx pax f l
     CLI.CmdBug (CLI.ReplayEvents pax l      ) -> replayPartEvs pax l
-    CLI.CmdBug (CLI.CheckDawn pax           ) -> checkDawn pax
+    CLI.CmdBug (CLI.CheckDawn provider pax  ) -> checkDawn provider pax
     CLI.CmdBug CLI.CheckComet                 -> checkComet
     CLI.CmdCon pier                           -> connTerm pier
 

pkg/hs/urbit-king/lib/Urbit/Vere/Dawn.hs

@@ -40,10 +40,6 @@ import qualified Urbit.Ob              as Ob
 import qualified Network.HTTP.Client.TLS as TLS
 import qualified Network.HTTP.Types      as HT
 
--- During boot, use the infura provider
-provider :: String
-provider = "http://eth-mainnet.urbit.org:8545"
-
 -- The address of the azimuth contract as a string.
 azimuthAddr :: Text
 azimuthAddr = "0x223c067f8cf28ae173ee5cafea60ca44c335fecb"
@@ -154,7 +150,7 @@ dawnPostRequests endpoint responseBuilder requests = do
 
   -- Send to the server
   responses <- dawnSendHTTP endpoint requestPayload >>= \case
-    Left err -> error $ "error fetching " <> provider <> ": HTTP " <> (show err)
+    Left err -> error $ "error fetching " <> endpoint <> ": HTTP " <> (show err)
     Right x -> pure x
 
   -- Get a list of the result texts in the order of the submitted requests
@@ -335,7 +331,7 @@ parseTurfResponse a raw = turf
 
 retrievePoint :: String -> TextBlockNum -> Ship -> RIO e EthPoint
 retrievePoint endpoint block ship =
-  dawnPostRequests provider parseEthPoint
+  dawnPostRequests endpoint parseEthPoint
     [PointRequest block (fromIntegral ship)] >>= \case
       [x] -> pure x
       _   -> error "JSON server returned multiple return values."
@@ -407,10 +403,11 @@ getSponsorshipChain endpoint block = loop
             pure $ chain <> [(ship, ethPoint)]
 
 -- Produces either an error or a validated boot event structure.
-dawnVent :: HasLogFunc e => Seed -> RIO e (Either Text Dawn)
-dawnVent dSeed@(Seed ship life ring oaf) =
+dawnVent :: HasLogFunc e => String -> Seed -> RIO e (Either Text Dawn)
+dawnVent provider dSeed@(Seed ship life ring oaf) =
   -- The type checker can't figure this out on its own.
   (onLeft tshow :: Either SomeException Dawn -> Either Text Dawn) <$> try do
+    putStrLn ("boot: requesting ethereum information from " <> pack provider)
     blockResponses
       <- dawnPostRequests provider parseBlockRequest [BlockRequest]