Further filling out of Dawn.

pkg/king/lib/Arvo/Event.hs

@@ -45,7 +45,7 @@ type Public = (Life, NounMap Life Pass)
 data Dnses = Dnses { dPri::Cord, dSec::Cord, dTer::Cord }
   deriving (Eq, Ord, Show)
 
-type EthAddr = Bytes -- 20 bytes
+type EthAddr = Atom --Bytes -- 20 bytes
 type ContNum = Word
 
 data EthPoint = EthPoint
@@ -73,13 +73,12 @@ data Snap = Snap (NounMap Ship Public)
   deriving (Eq, Ord, Show)
 
 data Dawn = MkDawn
-    { dSeed :: Seed
-    , dShip :: Ship
-    , dCzar :: NounMap Ship (Rift, Life, Pass)
-    , dTurf :: [Turf]
-    , dBloq :: Bloq
-    , dNode :: (Maybe PUrl)
-    , dSnap :: (Maybe Snap)
+    { dSeed    :: Seed
+    , dSponsor :: EthPoint
+    , dCzar    :: NounMap Ship (Rift, Life, Pass)
+    , dTurf    :: [Turf]
+    , dBloq    :: Bloq
+    , dNode    :: (Maybe PUrl)
     }
   deriving (Eq, Ord, Show)
 

pkg/king/lib/Vere/Dawn.hs

@@ -4,18 +4,22 @@ module Vere.Dawn where
 import Arvo.Common
 import Arvo.Event      hiding (Address)
 import Azimuth.Azimuth
-import UrbitPrelude    hiding (Call, to)
+import UrbitPrelude    hiding (Call, rights, to)
 
+import Data.Solidity.Abi.Codec       (encode)
+import Network.Ethereum.Account
 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.ByteArray       as BA
 import qualified Data.Map.Strict      as M
 import qualified Network.Ethereum.Ens as Ens
+import qualified Urbit.Ob             as Ob
 
 {-TODOs:
 
@@ -34,74 +38,158 @@ provider = HttpProvider
 
 --azimuthContract = "0x223c067F8CF28ae173EE5CafEa60cA44C335fecB"
 
+-- Conversion Utilities --------------------------------------------------------
+
+bsToAtom :: ByteString -> Atom
+bsToAtom x = x ^. from atomBytes
+
+-- Takes the web3's bytes representation and changes the endianness.
+bytes32ToBS :: BytesN 32 -> ByteString
+bytes32ToBS = reverse . BA.pack . BA.unpack
+
 bytes32ToAtom :: BytesN 32 -> Atom
-bytes32ToAtom bytes =
-  (reverse (BA.pack $ BA.unpack bytes)) ^. from atomBytes
+bytes32ToAtom = bsToAtom . bytes32ToBS
+
+-- web3 doesn't export unAddress.
+addressToBS :: Address -> ByteString
+addressToBS = reverse . encode
+
+addressToAtom = bsToAtom . addressToBS
+
+-- A Pass is the encryptionKey and authenticationKey concatenated together.
+passFromEth :: BytesN 32 -> BytesN 32 -> UIntN 32 -> Pass
+passFromEth enc aut sut | sut /= 1 = 0
+passFromEth enc aut sut            =
+  ((bytes32ToBS enc) <> (bytes32ToBS aut)) ^. from atomBytes
+
+clanFromShip :: Ship -> Ob.Class
+clanFromShip = Ob.clan . Ob.patp . fromIntegral
+
+-- Data Validation -------------------------------------------------------------
+
+-- Validates the keys, life, discontinuity, etc. If everything is ok, return
+-- the sponsoring ship for Seed.
+validateAndGetSponsor :: Seed -> EthPoint -> Either Text Ship
+validateAndGetSponsor (Seed ship life ring mo) EthPoint{..} = do
+  let clan = clanFromShip ship
+
+  case clan of
+    Ob.Comet  -> Left "todo: comet"
+    -- When the ship is a moon, the only requirement is that the parent is
+    -- launched.
+    Ob.Moon   -> do
+      Left "todo: moon's parent must be launched"
+
+    _         -> case epNet of
+      Nothing -> Left "ship not keyed"
+      Just (life, pass, contNum, _, _) -> do
+        -- when ( /= pass) $ Left "key mismatch"
+        pure $ Ship 5
 
 
-retrievePoint :: Quantity -> Address -> Int -> Web3 (Atom)
-retrievePoint bloq azimuth p =
+
+-- Azimuth Functions -----------------------------------------------------------
+
+-- Perform a request to azimuth at a certain block number
+withAzimuth :: Quantity
+            -> Address
+            -> DefaultAccount Web3 a
+            -> Web3 a
+withAzimuth bloq azimuth action =
     withAccount () $
       withParam (to .~ azimuth) $
-        withParam (block .~ (BlockWithNumber bloq)) $ do
-          (pubKey, _, _, _, _, _, _, _, keyRev, continuity) <-
-            points (fromIntegral p)
-          pure $ bytes32ToAtom pubKey
+        withParam (block .~ (BlockWithNumber bloq))
+          action
 
+-- In the Hoon implementation, the EthPoint structure has space for the deed
+-- information, but it immediately punts on this by bunting the deed structure
+-- instead of making the correct calls. We just do the right thing.
+--
+retrievePoint :: Quantity -> Address -> Int -> Web3 (EthPoint)
+retrievePoint bloq azimuth p =
+  withAzimuth bloq azimuth $ do
+    (owner, managementProxy, spawnProxy, votingProxy, transferProxy)
+      <- rights (fromIntegral p)
 
+    (encryptionKey,
+     authenticationKey,
+     hasSponsor,
+     active,
+     escapeRequested,
+     sponsor,
+     escapeTo,
+     cryptoSuite,
+     keyRevision, continuityNum) <- points (fromIntegral p)
+
+    let escapeState = if escapeRequested
+                      then Just $ Ship $ fromIntegral escapeTo
+                      else Nothing
+
+    let epOwn = (addressToAtom owner,
+                 addressToAtom managementProxy,
+                 addressToAtom votingProxy,
+                 addressToAtom transferProxy)
+
+    let epNet = if (not active)
+        then Nothing
+        else Just (
+          (fromIntegral keyRevision),
+          (passFromEth encryptionKey authenticationKey cryptoSuite),
+          (fromIntegral continuityNum),
+          (hasSponsor, Ship (fromIntegral sponsor)),
+          escapeState
+          )
+
+    let epKid = case (clanFromShip $ Ship $ fromIntegral p) of
+           Ob.Galaxy -> Just (addressToAtom spawnProxy, None)
+           Ob.Star   -> Just (addressToAtom spawnProxy, None)
+           _         -> Nothing
+
+    pure EthPoint{..}
+
+-- Retrieves information about all the galaxies from Ethereum.
 retrieveGalaxyTable :: Quantity -> Address -> Web3 (Map Ship (Rift, Life, Pass))
 retrieveGalaxyTable bloq azimuth =
-    withAccount () $
-      withParam (to .~ azimuth) $
-        withParam (block .~ (BlockWithNumber bloq)) $
-          M.fromList <$> mapM getRow [0..5]
+    withAzimuth bloq azimuth $ M.fromList <$> mapM getRow [0..5]
   where
     getRow idx = do
+      -- TODO: should we be building a `passFromEth` here instead of converting
+      -- pubKey?
       (pubKey, _, _, _, _, _, _, _, keyRev, continuity) <- points idx
       pure (fromIntegral idx, (fromIntegral continuity,
                                fromIntegral keyRev,
                                bytes32ToAtom pubKey))
 
-
--- Reads the Turf domains off the blockchain at block height `bloq`.
+-- Reads the three Ames domains from Ethereum.
 readAmesDomains :: Quantity -> Address -> Web3 ([Turf])
 readAmesDomains bloq azimuth =
-    withAccount () $
-      withParam (to .~ azimuth) $
-        withParam (block .~ (BlockWithNumber bloq)) $
-          mapM getTurf [0..2]
+    withAzimuth bloq azimuth $ 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]
+  [%dawn seed sponsor galaxies domains block eth-url]
 -}
 
 -- 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?
+  --
+  -- Everyone needs the Ethereum node instead of just the galaxies.
 
   hs <- runWeb3' provider $ do
     -- Block number (dBloq)
     dBloq <- blockNumber
-    print ("Eth block: " ++ (show dBloq))
+    print ("boot: eth block: " ++ (show dBloq))
 
     azimuth <- withAccount () $ Ens.resolve "azimuth.eth"
     print ("Azimuth: " ++ (show azimuth))
 
-    -- TODO: Do the entire point:...:dawn flow. This now should work in theory
-    --
-    -- (x ...) <- withAccount () $
-    --   withParam (to .~ azimuthContract) $
-    --     points 15
+    -- TODO: We're retrieving point information, but we don't have
+    p <- retrievePoint dBloq azimuth 0
+    print $ show p
 
     -- Retrieve the galaxy table [MUST FIX s/5/255/]
     -- galaxyTable <- retrieveGalaxyTable dBloq azimuth

pkg/king/lib/Vere/Serf.hs

@@ -421,7 +421,7 @@ bootFromSeq serf (BootSeq ident nocks ovums) = do
         muckOvum ov  eId mug wen = DoWork $ Work eId mug wen ov
 
     bootMsg = "Booting " ++ (fakeStr (isFake ident)) ++
-              (Ob.render (Ob.patp (fromIntegral (who ident))))
+              (Ob.renderPatp (Ob.patp (fromIntegral (who ident))))
     fakeStr True  = "fake "
     fakeStr False = ""
 

stack.yaml

@@ -8,7 +8,7 @@ extra-deps:
   - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38
   - base58-bytestring-0.1.0@sha256:a1da72ee89d5450bac1c792d9fcbe95ed7154ab7246f2172b57bd4fd9b5eab79
   - lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00
-  - urbit-hob-0.1.0@sha256:ad893bb71ffcf9500820213c12cfa2544e8757ab143ebb45f9c7cc48c7536e11
+  - urbit-hob-0.3.0
 
 nix:
   packages: