Can retrieve the ames domains from Ethereum using web3.

Partial support for retrieving the galaxy table, but I'm having
problems converting the public key type.

pkg/king/app/CLI.hs

@@ -27,11 +27,11 @@ data Opts = Opts
   deriving (Show)
 
 data New = New
-    { nPillPath  :: FilePath
-    , nShipAddr  :: Text
-    , nPierPath  :: Maybe FilePath -- Derived from ship name if not specified.
-    , nArvoDir   :: Maybe FilePath
-    , nBootFake  :: Bool
+    { nPillPath :: FilePath
+    , nShipAddr :: Text
+    , nPierPath :: Maybe FilePath -- Derived from ship name if not specified.
+    , nArvoDir  :: Maybe FilePath
+    , nBootFake :: Bool
     }
   deriving (Show)
 
@@ -62,6 +62,7 @@ data Bug
         , bFirstEvt :: Word64
         , bFinalEvt :: Word64
         }
+    | CheckDawn
   deriving (Show)
 
 data Cmd
@@ -247,6 +248,9 @@ checkFx = ValidateFX <$> pierPath <*> firstEv <*> lastEv
 browseEvs :: Parser Bug
 browseEvs = EventBrowser <$> pierPath
 
+checkDawn :: Parser Bug
+checkDawn = pure CheckDawn
+
 bugCmd :: Parser Cmd
 bugCmd = fmap CmdBug
         $ subparser
@@ -270,6 +274,10 @@ bugCmd = fmap CmdBug
             ( info (checkFx <**> helper)
             $ progDesc "Parse all data in event log"
             )
+       <> command "dawn"
+            ( info (checkDawn <**> helper)
+            $ progDesc "Test run dawn"
+            )
 
 conCmd :: Parser Cmd
 conCmd = do

pkg/king/app/Main.hs

@@ -104,6 +104,7 @@ import System.Environment   (getProgName)
 import System.Posix.Signals (Handler(Catch), installHandler, sigTERM)
 import Text.Show.Pretty     (pPrint)
 import Urbit.Time           (Wen)
+import Vere.Dawn
 import Vere.LockFile        (lockFile)
 
 import qualified CLI                         as CLI
@@ -326,6 +327,13 @@ startBrowser pierPath = runRAcquire $ do
     log <- Log.existing (pierPath <> "/.urb/log")
     rio $ EventBrowser.run log
 
+checkDawn :: HasLogFunc e => RIO e ()
+checkDawn = do
+  e <- dawnVent (Seed (Ship 0) 1 (fromIntegral 1) Nothing)
+  case e of
+    Left x  -> putStrLn "Left"
+    Right y -> putStrLn "Right"
+
 main :: IO ()
 main = do
     mainTid <- myThreadId
@@ -342,6 +350,7 @@ main = do
         CLI.CmdBug (CLI.ValidatePill pax pil seq) -> testPill pax pil seq
         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.CheckDawn                  -> checkDawn
         CLI.CmdCon port                           -> connTerm port
 
 

pkg/king/lib/Arvo/Event.hs

@@ -15,6 +15,7 @@ import qualified Network.HTTP.Types.Method as H
 -- Misc Types ------------------------------------------------------------------
 
 type Pass = Atom -- Public Key
+type Rift = Atom -- Continuity number
 type Life = Word -- Number of Azimoth key revs.
 type Bloq = Atom -- TODO
 type Ring = Atom -- Private Key
@@ -74,7 +75,7 @@ data Snap = Snap (NounMap Ship Public)
 data Dawn = MkDawn
     { dSeed :: Seed
     , dShip :: Ship
-    , dCzar :: NounMap Ship (Life, Pass)
+    , dCzar :: NounMap Ship (Rift, Life, Pass)
     , dTurf :: [Turf]
     , dBloq :: Bloq
     , dNode :: (Maybe PUrl)

pkg/king/lib/Azimuth/Azimuth.hs

@@ -0,0 +1,5 @@
+module Azimuth.Azimuth where
+
+import Network.Ethereum.Contract.TH
+
+[abiFrom|lib/Azimuth/azimuth.json|]

pkg/king/lib/Vere/Dawn.hs

@@ -0,0 +1,99 @@
+{-# OPTIONS_GHC -Wwarn #-}
+module Vere.Dawn where
+
+import Arvo.Common
+import Arvo.Event
+import Azimuth.Azimuth
+import UrbitPrelude    hiding (Call, to)
+
+import Network.Ethereum.Api.Eth
+import Network.Ethereum.Api.Provider
+import Network.Ethereum.Api.Types    hiding (blockNumber)
+import Network.Ethereum.Web3
+
+import Data.Text (splitOn)
+
+import qualified Data.Map.Strict as M
+
+{-TODOs:
+
+  - Dawn takes a NounMap instead of a Map. Need a conversion function.
+
+-}
+
+
+-- During boot, use the infura provider
+provider = HttpProvider
+  "https://mainnet.infura.io/v3/196a7f37c7d54211b4a07904ec73ad87"
+
+azimuthContract = "0x223c067F8CF28ae173EE5CafEa60cA44C335fecB"
+
+
+-- Reads the
+--
+-- TODO: I don't know how to change a BytesN 32 to an Atom.
+retrieveGalaxyTable :: Quantity -> Web3 (Map Ship (Rift, Life, Pass))
+retrieveGalaxyTable bloq =
+    withAccount () $
+      withParam (to .~ azimuthContract) $
+        withParam (block .~ (BlockWithNumber bloq)) $
+          M.fromList <$> mapM getRow [0..5]
+  where
+    getRow idx = do
+      (pubKey, _, _, _, _, _, _, _, keyRev, continuity) <- points idx
+      -- pubKey is a sort of ByteArray.
+      pure (fromIntegral idx, (fromIntegral continuity,
+                               fromIntegral keyRev,
+                               fromIntegral 0))
+                               -- pubKey ^. from atomBytes))
+
+-- Reads the Turf domains off the blockchain at block height `bloq`.
+readAmesDomains :: Quantity -> Web3 ([Turf])
+readAmesDomains bloq =
+    withAccount () $
+      withParam (to .~ azimuthContract) $
+        withParam (block .~ (BlockWithNumber bloq)) $
+          mapM getTurf [0..2]
+  where
+    getTurf idx = do
+      str <- dnsDomains idx
+      pure $ Turf $ fmap Cord $ reverse $ splitOn "." str
+
+
+
+
+{-
+  [%dawn seed sponsor galaxies domains block eth-url snap]
+-}
+
+-- Produces either an error or a validated boot event structure.
+dawnVent :: Seed -> RIO e (Either Text Dawn)
+dawnVent (Seed (Ship ship) life ring oaf) = do
+  -- TODO: The dawn code tries to switch which ethereum provider it uses based
+  -- on a ships' rank, but then doesn't do anything with it other than passing
+  -- it into the ship and just uses the hardcoded infura node?
+
+  hs <- runWeb3' provider $ do
+    -- Block number (dBloq)
+    dBloq <- blockNumber
+
+    -- TODO: Do the entire point:...:dawn flow. This now should work in theory
+    --
+    -- (x ...) <- withAccount () $
+    --   withParam (to .~ azimuthContract) $
+    --     points 15
+
+    -- Retrieve the galaxy table [MUST FIX s/5/255/ AND PUBKEY TO ATOM]
+    -- galaxyTable <- retrieveGalaxyTable dBloq
+    -- print $ show galaxyTable
+
+    -- Read Ames domains [DONE]
+    -- dTurf <- readAmesDomains dBloq
+    -- print $ show dTurf
+
+    pure (dBloq)
+
+  print $ show hs
+
+  pure (Left "bad")
+

pkg/king/lib/Vere/Pier.hs

@@ -214,6 +214,9 @@ pier pierPath mPort (serf, log, ss) = do
       Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn)
       Right tag       -> logError $ displayShow ("something simply exited", tag)
 
+    atomically $ (Term.spin muxed) (Just "shutdown")
+
+
 death :: Text -> Async () -> STM (Either (Text, SomeException) Text)
 death tag tid = do
   waitCatchSTM tid <&> \case

pkg/king/package.yaml

@@ -57,6 +57,7 @@ dependencies:
   - lmdb
   - lock-file
   - megaparsec
+  - memory
   - mtl
   - multimap
   - network
@@ -99,6 +100,7 @@ dependencies:
   - wai-conduit
   - warp
   - warp-tls
+  - web3
   - websockets
 
 default-extensions: