mirror of
https://github.com/urbit/shrub.git
synced 2024-11-28 13:54:20 +03:00
king dawn: replace web3 usage with hand rolled jsonrpc messages.
This replaces the autogenerated bindings to the Azimuth contracts which use Network.Web3 with hand rolled json messages. Booting a ship involved 256 individual galaxy point lookups using web3, while Vere batched all of that into one JSONRPC message. With this patch, we also batch everything at each phase into one JSONRPC batch.
This commit is contained in:
Elliot Glaysher
parent
1e8158b683
commit
4a7e1b2009
@ -1,3 +1,5 @@
|
||||
{-# OPTIONS_GHC -Wno-deprecations #-}
|
||||
|
||||
{-|
|
||||
Use etherium to access PKI information.
|
||||
-}
|
||||
@ -6,51 +8,45 @@ module Urbit.Vere.Dawn where
|
||||
|
||||
import Urbit.Arvo.Common
|
||||
import Urbit.Arvo.Event hiding (Address)
|
||||
import Urbit.Prelude hiding (Call, rights, to)
|
||||
import Urbit.Prelude hiding (Call, rights, to, (.=))
|
||||
|
||||
import Data.Bits (xor)
|
||||
import Data.List (nub)
|
||||
import Data.Text (splitOn)
|
||||
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 Network.HTTP.Client.TLS
|
||||
|
||||
import Data.Solidity.Prim.Address (fromHexString)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import Numeric (showHex)
|
||||
|
||||
import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import qualified Crypto.Hash.SHA512 as SHA512
|
||||
import qualified Crypto.Sign.Ed25519 as Ed
|
||||
import qualified Data.Binary as B
|
||||
import qualified Data.ByteArray as BA
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
-- import qualified Network.Ethereum.Ens as Ens
|
||||
import qualified Network.HTTP.Client as C
|
||||
import qualified Urbit.Azimuth as AZ
|
||||
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 = HttpProvider "http://eth-mainnet.urbit.org:8545"
|
||||
provider = "http://eth-mainnet.urbit.org:8545"
|
||||
|
||||
-- The address of the azimuth contract as a string.
|
||||
azimuthAddr = "0x223c067f8cf28ae173ee5cafea60ca44c335fecb" :: Text
|
||||
|
||||
-- Conversion Utilities --------------------------------------------------------
|
||||
|
||||
-- Takes the web3's bytes representation and changes the endianness.
|
||||
bytes32ToBS :: BytesN 32 -> ByteString
|
||||
bytes32ToBS = reverse . BA.pack . BA.unpack
|
||||
|
||||
toBloq :: Quantity -> Bloq
|
||||
toBloq = fromIntegral . unQuantity
|
||||
|
||||
passFromEth :: BytesN 32 -> BytesN 32 -> UIntN 32 -> Pass
|
||||
passFromEth enc aut sut | sut /= 1 =
|
||||
passFromBS :: ByteString -> ByteString -> ByteString -> Pass
|
||||
passFromBS enc aut sut | bytesAtom sut /= 1 =
|
||||
Pass (Ed.PublicKey mempty) (Ed.PublicKey mempty)
|
||||
passFromEth enc aut sut =
|
||||
passFromBS enc aut sut =
|
||||
Pass (decode aut) (decode enc)
|
||||
where
|
||||
decode = Ed.PublicKey . bytes32ToBS
|
||||
decode = Ed.PublicKey
|
||||
|
||||
bsToBool :: ByteString -> Bool
|
||||
bsToBool bs = bytesAtom bs == 1
|
||||
|
||||
clanFromShip :: Ship -> Ob.Class
|
||||
clanFromShip = Ob.clan . Ob.patp . fromIntegral
|
||||
@ -61,6 +57,11 @@ shipSein = Ship . fromIntegral . Ob.fromPatp . Ob.sein . Ob.patp . fromIntegral
|
||||
renderShip :: Ship -> Text
|
||||
renderShip = Ob.renderPatp . Ob.patp . fromIntegral
|
||||
|
||||
|
||||
hexStrToAtom :: Text -> Atom
|
||||
hexStrToAtom =
|
||||
bytesAtom . reverse . toBytes . hexString . removePrefix . encodeUtf8
|
||||
|
||||
-- Data Validation -------------------------------------------------------------
|
||||
|
||||
-- Derive public key structure from the key derivation seed structure
|
||||
@ -74,85 +75,262 @@ ringToPass Ring{..} = Pass{..}
|
||||
Nothing -> error "Invalid seed passed to createKeypairFromSeed"
|
||||
Just x -> x
|
||||
|
||||
-- JSONRPC Functions -----------------------------------------------------------
|
||||
|
||||
-- The big problem here is that we can't really use the generated web3 wrappers
|
||||
-- around the azimuth contracts, especially for the galaxy table request. They
|
||||
-- make multiple rpc invocations per galaxy request (which aren't even
|
||||
-- batched!), while Vere built a single batched rpc call to fetch the entire
|
||||
-- galaxy table.
|
||||
--
|
||||
-- The included Network.JsonRpc.TinyClient that Network.Web3 embeds can't do
|
||||
-- batches, so calling that directly is out.
|
||||
--
|
||||
-- Network.JSONRPC appears to not like something about the JSON that Infura
|
||||
-- returns; it's just hanging? Also no documentation.
|
||||
--
|
||||
-- So, like with Vere, we roll our own.
|
||||
|
||||
dawnSendHTTP endpoint requestData = liftIO do
|
||||
manager <- C.newManager TLS.tlsManagerSettings
|
||||
|
||||
initialRequest <- C.parseRequest endpoint
|
||||
let request = initialRequest
|
||||
{ C.method = "POST"
|
||||
, C.requestBody = C.RequestBodyLBS $ requestData
|
||||
, C.requestHeaders = [("Accept", "applciation/json"),
|
||||
("Content-Type", "application/json"),
|
||||
("Charsets", "utf-8")]
|
||||
}
|
||||
|
||||
response <- C.httpLbs request manager
|
||||
|
||||
-- Return body if 200.
|
||||
let code = HT.statusCode $ C.responseStatus response
|
||||
case code of
|
||||
200 -> pure $ Right $ C.responseBody response
|
||||
x -> pure $ Left x
|
||||
|
||||
class RequestMethod m where
|
||||
getRequestMethod :: m -> Text
|
||||
|
||||
data RawResponse = RawResponse
|
||||
{ rrId :: Int
|
||||
, rrResult :: Text
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
instance FromJSON RawResponse where
|
||||
parseJSON = withObject "Response" $ \v -> do
|
||||
rrId <- v .: "id"
|
||||
rrResult <- v .: "result"
|
||||
pure RawResponse{..}
|
||||
|
||||
|
||||
-- Given a list of methods and parameters, return a list of decoded responses.
|
||||
dawnPostRequests :: forall req e resp
|
||||
. (ToJSON req, RequestMethod req)
|
||||
=> String
|
||||
-> (req -> Text -> resp)
|
||||
-> [req]
|
||||
-> RIO e [resp]
|
||||
dawnPostRequests endpoint responseBuilder requests = do
|
||||
-- Encode our input requests
|
||||
let requestPayload =
|
||||
encode $ Array $ fromList $ map toFullRequest $ zip [0..] requests
|
||||
|
||||
-- Send to the server
|
||||
responses <- dawnSendHTTP endpoint requestPayload >>= \case
|
||||
Left err -> error $ "error fetching " ++ provider ++ ": HTTP " ++ (show err)
|
||||
Right x -> pure x
|
||||
|
||||
-- Get a list of the result texts in the order of the submitted requests
|
||||
rawSorted <- case decode responses of
|
||||
Nothing -> error $ "couldn't decode json"
|
||||
Just x -> pure $ map rrResult $ sortOn rrId x
|
||||
|
||||
-- Build the final result structure by calling the passed in builder with the
|
||||
-- request (some outputs need data from the request sturcture, eitherwise,
|
||||
-- we'd lean on FromJSON).
|
||||
let results = map (uncurry responseBuilder) (zip requests rawSorted)
|
||||
pure results
|
||||
|
||||
where
|
||||
toFullRequest :: (Int, req) -> Value
|
||||
toFullRequest (id, req) = object [ "jsonrpc" .= ("2.0" :: Text)
|
||||
, "method" .= getRequestMethod req
|
||||
, "params" .= req
|
||||
, "id" .= id
|
||||
]
|
||||
|
||||
-- Azimuth JSON Requests -------------------------------------------------------
|
||||
|
||||
-- Simple packing a block number to the text format.
|
||||
blockNumToStr :: Int -> Text
|
||||
blockNumToStr bn = pack $ "0x" <> (showHex bn "")
|
||||
|
||||
-- Not a full implementation of the Ethereum ABI, but just the ability to call
|
||||
-- a method by encoded id (like 0x63fa9a87 for `points(uint32)`), and a single
|
||||
-- UIntN 32 parameter.
|
||||
encodeCall :: Text -> Int -> Text
|
||||
encodeCall method idx = method <> leadingZeroes <> renderedNumber
|
||||
where
|
||||
renderedNumber = pack $ showHex idx ""
|
||||
leadingZeroes = replicate (64 - length renderedNumber) '0'
|
||||
|
||||
data BlockRequest = BlockRequest
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance RequestMethod BlockRequest where
|
||||
getRequestMethod BlockRequest = "eth_blockNumber"
|
||||
|
||||
instance ToJSON BlockRequest where
|
||||
toJSON BlockRequest = Array $ fromList []
|
||||
|
||||
-- No need to parse, it's already in the format we'll pass as an argument to
|
||||
-- eth calls which take a block number.
|
||||
parseBlockRequest :: BlockRequest -> Text -> TextBlockNum
|
||||
parseBlockRequest br txt = txt
|
||||
|
||||
type TextBlockNum = Text
|
||||
|
||||
data PointRequest = PointRequest
|
||||
{ grqHexBlockNum :: TextBlockNum
|
||||
, grqPointId :: Int
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance RequestMethod PointRequest where
|
||||
getRequestMethod PointRequest{..} = "eth_call"
|
||||
|
||||
instance ToJSON PointRequest where
|
||||
toJSON PointRequest{..} =
|
||||
Array $ fromList [object [ "to" .= azimuthAddr
|
||||
, "data" .= encodeCall "0x63fa9a87" grqPointId],
|
||||
String grqHexBlockNum
|
||||
]
|
||||
|
||||
parseAndChunkResultToBS :: Text -> [ByteString]
|
||||
parseAndChunkResultToBS result =
|
||||
map reverse $
|
||||
chunkBytestring 32 $
|
||||
toBytes $
|
||||
hexString $
|
||||
removePrefix $
|
||||
encodeUtf8 result
|
||||
|
||||
-- The incoming result is a text bytestring. We need to take that text, and
|
||||
-- spit out the parsed data.
|
||||
--
|
||||
-- We're sort of lucky here. After removing the front "0x", we can just chop
|
||||
-- the incoming text string into 10 different 64 character chunks and then
|
||||
-- parse them as numbers.
|
||||
parseEthPoint :: PointRequest -> Text -> EthPoint
|
||||
parseEthPoint PointRequest{..} result = EthPoint{..}
|
||||
where
|
||||
[rawEncryptionKey,
|
||||
rawAuthenticationKey,
|
||||
rawHasSponsor,
|
||||
rawActive,
|
||||
rawEscapeRequested,
|
||||
rawSponsor,
|
||||
rawEscapeTo,
|
||||
rawCryptoSuite,
|
||||
rawKeyRevision,
|
||||
rawContinuityNum] = parseAndChunkResultToBS result
|
||||
|
||||
escapeState = if bsToBool rawEscapeRequested
|
||||
then Just $ Ship $ fromIntegral $ bytesAtom rawEscapeTo
|
||||
else Nothing
|
||||
|
||||
-- Vere doesn't set ownership information, neither did the old Dawn.hs
|
||||
-- implementation.
|
||||
epOwn = (0, 0, 0, 0)
|
||||
|
||||
epNet = if not $ bsToBool rawActive
|
||||
then Nothing
|
||||
else Just
|
||||
( fromIntegral $ bytesAtom rawKeyRevision
|
||||
, passFromBS rawEncryptionKey rawAuthenticationKey rawCryptoSuite
|
||||
, fromIntegral $ bytesAtom rawContinuityNum
|
||||
, (bsToBool rawHasSponsor,
|
||||
Ship (fromIntegral $ bytesAtom rawSponsor))
|
||||
, escapeState
|
||||
)
|
||||
|
||||
-- I don't know what this is supposed to be, other than the old Dawn.hs and
|
||||
-- dawn.c do the same thing.
|
||||
epKid = case clanFromShip (Ship $ fromIntegral grqPointId) of
|
||||
Ob.Galaxy -> Just (0, setToHoonSet mempty)
|
||||
Ob.Star -> Just (0, setToHoonSet mempty)
|
||||
_ -> Nothing
|
||||
|
||||
-- Preprocess data from a point request into the form used in the galaxy table.
|
||||
parseGalaxyTableEntry :: PointRequest -> Text -> (Ship, (Rift, Life, Pass))
|
||||
parseGalaxyTableEntry PointRequest{..} result = (ship, (rift, life, pass))
|
||||
where
|
||||
[rawEncryptionKey,
|
||||
rawAuthenticationKey,
|
||||
_, _, _, _, _,
|
||||
rawCryptoSuite,
|
||||
rawKeyRevision,
|
||||
rawContinuityNum] = parseAndChunkResultToBS result
|
||||
|
||||
ship = Ship $ fromIntegral grqPointId
|
||||
rift = fromIntegral $ bytesAtom rawContinuityNum
|
||||
life = fromIntegral $ bytesAtom rawKeyRevision
|
||||
pass = passFromBS rawEncryptionKey rawAuthenticationKey rawCryptoSuite
|
||||
|
||||
removePrefix :: ByteString -> ByteString
|
||||
removePrefix withOhEx
|
||||
| prefix == "0x" = suffix
|
||||
| otherwise = error "not prefixed with 0x"
|
||||
where
|
||||
(prefix, suffix) = splitAt 2 withOhEx
|
||||
|
||||
chunkBytestring :: Int -> ByteString -> [ByteString]
|
||||
chunkBytestring size bs
|
||||
| null rest = [cur]
|
||||
| otherwise = (cur : chunkBytestring size rest)
|
||||
where
|
||||
(cur, rest) = splitAt size bs
|
||||
|
||||
data TurfRequest = TurfRequest
|
||||
{ trqHexBlockNum :: TextBlockNum
|
||||
, trqTurfId :: Int
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance RequestMethod TurfRequest where
|
||||
getRequestMethod TurfRequest{..} = "eth_call"
|
||||
|
||||
instance ToJSON TurfRequest where
|
||||
toJSON TurfRequest{..} =
|
||||
Array $ fromList [object [ "to" .= azimuthAddr
|
||||
, "data" .= encodeCall "0xeccc8ff1" trqTurfId],
|
||||
String trqHexBlockNum
|
||||
]
|
||||
|
||||
-- This is another hack instead of a full Ethereum ABI resposne.
|
||||
parseTurfResponse :: TurfRequest -> Text -> Turf
|
||||
parseTurfResponse a raw = turf
|
||||
where
|
||||
without0x = removePrefix $ encodeUtf8 raw
|
||||
(_, blRest) = splitAt 64 without0x
|
||||
(utfLenStr, utfStr) = splitAt 64 blRest
|
||||
utfLen = fromIntegral $ bytesAtom $ reverse $ toBytes $ hexString utfLenStr
|
||||
dnsStr = decodeUtf8 $ (BS.take utfLen) $ toBytes $ hexString utfStr
|
||||
turf = Turf $ fmap Cord $ reverse $ splitOn "." dnsStr
|
||||
|
||||
-- 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)
|
||||
action
|
||||
retrievePoint :: String -> TextBlockNum -> Ship -> RIO e EthPoint
|
||||
retrievePoint endpoint block ship =
|
||||
dawnPostRequests provider parseEthPoint
|
||||
[(PointRequest block (fromIntegral ship))] >>= \case
|
||||
[x] -> pure x
|
||||
_ -> error "JSON server returned multiple return values."
|
||||
|
||||
-- Retrieves the EthPoint information for an individual point.
|
||||
retrievePoint :: Quantity -> Address -> Ship -> Web3 EthPoint
|
||||
retrievePoint bloq azimuth ship =
|
||||
withAzimuth bloq azimuth $ do
|
||||
(encryptionKey,
|
||||
authenticationKey,
|
||||
hasSponsor,
|
||||
active,
|
||||
escapeRequested,
|
||||
sponsor,
|
||||
escapeTo,
|
||||
cryptoSuite,
|
||||
keyRevision,
|
||||
continuityNum) <- AZ.points (fromIntegral ship)
|
||||
|
||||
let escapeState = if escapeRequested
|
||||
then Just $ Ship $ fromIntegral escapeTo
|
||||
else Nothing
|
||||
|
||||
-- The hoon version also sets this to all 0s and then does nothing with it.
|
||||
let epOwn = (0, 0, 0, 0)
|
||||
|
||||
let epNet = if not active
|
||||
then Nothing
|
||||
else Just
|
||||
( fromIntegral keyRevision
|
||||
, passFromEth encryptionKey authenticationKey cryptoSuite
|
||||
, fromIntegral continuityNum
|
||||
, (hasSponsor, Ship (fromIntegral sponsor))
|
||||
, escapeState
|
||||
)
|
||||
|
||||
-- TODO: wtf?
|
||||
let epKid = case clanFromShip ship of
|
||||
Ob.Galaxy -> Just (0, setToHoonSet mempty)
|
||||
Ob.Star -> Just (0, setToHoonSet mempty)
|
||||
_ -> Nothing
|
||||
|
||||
pure EthPoint{..}
|
||||
|
||||
-- Retrieves information about all the galaxies from Ethereum.
|
||||
retrieveGalaxyTable :: Quantity -> Address -> Web3 (Map Ship (Rift, Life, Pass))
|
||||
retrieveGalaxyTable bloq azimuth =
|
||||
withAzimuth bloq azimuth $ mapFromList <$> mapM getRow [0..255]
|
||||
where
|
||||
getRow idx = do
|
||||
(encryptionKey, authenticationKey, _, _, _, _, _, cryptoSuite,
|
||||
keyRev, continuity) <- AZ.points idx
|
||||
pure ( fromIntegral idx
|
||||
, ( fromIntegral continuity
|
||||
, fromIntegral keyRev
|
||||
, passFromEth encryptionKey authenticationKey cryptoSuite
|
||||
)
|
||||
)
|
||||
|
||||
-- Reads the three Ames domains from Ethereum, removing duplicates
|
||||
readAmesDomains :: Quantity -> Address -> Web3 [Turf]
|
||||
readAmesDomains bloq azimuth =
|
||||
withAzimuth bloq azimuth $ nub <$> mapM getTurf [0..2]
|
||||
where
|
||||
getTurf idx =
|
||||
Turf . fmap Cord . reverse . splitOn "." <$> AZ.dnsDomains idx
|
||||
|
||||
|
||||
validateShipAndGetImmediateSponsor :: Quantity -> Address -> Seed -> Web3 Ship
|
||||
validateShipAndGetImmediateSponsor block azimuth (Seed ship life ring oaf) =
|
||||
validateShipAndGetSponsor :: String -> TextBlockNum -> Seed -> RIO e Ship
|
||||
validateShipAndGetSponsor endpoint block (Seed ship life ring oaf) =
|
||||
case clanFromShip ship of
|
||||
Ob.Comet -> validateComet
|
||||
Ob.Moon -> validateMoon
|
||||
@ -177,7 +355,7 @@ validateShipAndGetImmediateSponsor block azimuth (Seed ship life ring oaf) =
|
||||
validateRest = do
|
||||
putStrLn ("boot: retrieving " ++ renderShip ship ++ "'s public keys")
|
||||
|
||||
whoP <- retrievePoint block azimuth ship
|
||||
whoP <- retrievePoint endpoint block ship
|
||||
case epNet whoP of
|
||||
Nothing -> fail "ship not keyed"
|
||||
Just (netLife, pass, contNum, (hasSponsor, who), _) -> do
|
||||
@ -194,12 +372,12 @@ validateShipAndGetImmediateSponsor block azimuth (Seed ship life ring oaf) =
|
||||
|
||||
-- Walk through the sponsorship chain retrieving the actual sponsorship chain
|
||||
-- as it exists on Ethereum.
|
||||
getSponsorshipChain :: Quantity -> Address -> Ship -> Web3 [(Ship,EthPoint)]
|
||||
getSponsorshipChain block azimuth = loop
|
||||
getSponsorshipChain :: String -> TextBlockNum -> Ship -> RIO e [(Ship,EthPoint)]
|
||||
getSponsorshipChain endpoint block = loop
|
||||
where
|
||||
loop ship = do
|
||||
putStrLn ("boot: retrieving keys for sponsor " ++ renderShip ship)
|
||||
ethPoint <- retrievePoint block azimuth ship
|
||||
ethPoint <- retrievePoint endpoint block ship
|
||||
|
||||
case (clanFromShip ship, epNet ethPoint) of
|
||||
(Ob.Comet, _) -> fail "Comets cannot be sponsors"
|
||||
@ -217,47 +395,44 @@ getSponsorshipChain block azimuth = loop
|
||||
chain <- loop sponsor
|
||||
pure $ chain ++ [(ship, ethPoint)]
|
||||
|
||||
|
||||
-- Produces either an error or a validated boot event structure.
|
||||
dawnVent :: Seed -> RIO e (Either Text Dawn)
|
||||
dawnVent :: HasLogFunc e => Seed -> RIO e (Either Text Dawn)
|
||||
dawnVent dSeed@(Seed ship life ring oaf) = do
|
||||
ret <- runWeb3' provider $ do
|
||||
block <- blockNumber
|
||||
putStrLn ("boot: ethereum block #" ++ tshow block)
|
||||
blockResponses
|
||||
<- dawnPostRequests provider parseBlockRequest [BlockRequest]
|
||||
|
||||
-- TODO: Eventually look up the contract from ENS. Right now, our infura
|
||||
-- node is filtering everything except for a very small set of contracts,
|
||||
-- so just hard code the address.
|
||||
--
|
||||
-- putStrLn "boot: retrieving azimuth contract"
|
||||
-- azimuth <- withAccount () $ Ens.resolve "azimuth.eth"
|
||||
let azimuthAddr = "0x223c067f8cf28ae173ee5cafea60ca44c335fecb"
|
||||
let azimuth = case fromHexString azimuthAddr of
|
||||
Left _ -> error "Impossible"
|
||||
Right x -> x
|
||||
hexStrBlock <- case blockResponses of
|
||||
[num] -> pure num
|
||||
x -> error "Unexpected multiple returns from block # request"
|
||||
|
||||
immediateSponsor <- validateShipAndGetImmediateSponsor block azimuth dSeed
|
||||
dSponsor <- getSponsorshipChain block azimuth immediateSponsor
|
||||
let dBloq = hexStrToAtom hexStrBlock
|
||||
putStrLn ("boot: ethereum block #" ++ tshow dBloq)
|
||||
|
||||
putStrLn "boot: retrieving galaxy table"
|
||||
dCzar <- mapToHoonMap <$> retrieveGalaxyTable block azimuth
|
||||
immediateSponsor <- validateShipAndGetSponsor provider hexStrBlock dSeed
|
||||
dSponsor <- getSponsorshipChain provider hexStrBlock immediateSponsor
|
||||
|
||||
putStrLn "boot: retrieving network domains"
|
||||
dTurf <- readAmesDomains block azimuth
|
||||
putStrLn "boot: retrieving galaxy table"
|
||||
dCzar <- (mapToHoonMap . mapFromList) <$>
|
||||
(dawnPostRequests provider parseGalaxyTableEntry $
|
||||
map (PointRequest hexStrBlock) [0..255])
|
||||
|
||||
let dBloq = toBloq block
|
||||
let dNode = Nothing
|
||||
pure $ MkDawn{..}
|
||||
putStrLn "boot: retrieving network domains"
|
||||
dTurf <- nub <$> (dawnPostRequests provider parseTurfResponse $
|
||||
map (TurfRequest hexStrBlock) [0..2])
|
||||
|
||||
case ret of
|
||||
Left x -> pure $ Left $ tshow x
|
||||
Right y -> pure $ Right y
|
||||
let dNode = Nothing
|
||||
|
||||
-- TODO: Figure out exception handling now. We don't want all the `error`
|
||||
-- statements in ehre to literally kill the program.
|
||||
pure $ Right $ MkDawn{..}
|
||||
|
||||
|
||||
-- Comet List ------------------------------------------------------------------
|
||||
|
||||
dawnCometList :: RIO e [Ship]
|
||||
dawnCometList = do
|
||||
-- Get the jamfile with the list of stars accepting comets right now.
|
||||
manager <- io $ C.newManager tlsManagerSettings
|
||||
manager <- io $ C.newManager TLS.tlsManagerSettings
|
||||
request <- io $ C.parseRequest "https://bootstrap.urbit.org/comet-stars.jam"
|
||||
response <- io $ C.httpLbs (C.setRequestCheckStatus request) manager
|
||||
let body = toStrict $ C.responseBody response
|
||||
|
||||
@ -51,6 +51,7 @@ dependencies:
|
||||
- hashable
|
||||
- hashtables
|
||||
- heap
|
||||
- hexstring
|
||||
- http-client
|
||||
- http-client-tls
|
||||
- http-types
|
||||
@ -101,7 +102,6 @@ dependencies:
|
||||
- unliftio-core
|
||||
- unordered-containers
|
||||
- urbit-atom
|
||||
- urbit-azimuth
|
||||
- urbit-eventlog-lmdb
|
||||
- urbit-hob
|
||||
- urbit-noun
|
||||
@ -114,7 +114,6 @@ dependencies:
|
||||
- wai-websockets
|
||||
- warp
|
||||
- warp-tls
|
||||
- web3
|
||||
- websockets
|
||||
|
||||
default-extensions:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user