fixup some docs and add name field

This commit is contained in:
Ben Sima 2020-09-23 08:10:40 -04:00
parent 357df39431
commit 0a19045256
2 changed files with 33 additions and 13 deletions

View File

@ -1,7 +1,13 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Urbit.Airlock where module Urbit.Airlock
( Ship(..),
App,
Mark,
connect,
poke,
) where
import Control.Lens import Control.Lens
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
@ -15,10 +21,16 @@ import qualified Network.Wreq.Session as Session
data Ship = Ship data Ship = Ship
{ session :: Maybe Session.Session, { session :: Maybe Session.Session,
-- | Track the latest event we saw (needed for poking).
lastEventId :: Int, lastEventId :: Int,
-- | Internet-facing access point, like 'http://sampel-palnet.arvo.network'
url :: Url, url :: Url,
-- | Login code, `+code` in the dojo. Don't share this publically.
code :: Text, code :: Text,
sseClient :: Bool -- | Not implemented yet...
sseClient :: Bool,
-- | The `@p` of the ship
name :: Text
} }
deriving (Show) deriving (Show)
@ -31,7 +43,6 @@ type Url = String
type App = Text type App = Text
type Path = Text type Path = Text
type Mark = Text type Mark = Text
type ShipName = Text
type Subscription = Text type Subscription = Text
@ -40,7 +51,7 @@ nextEventId :: Ship -> Int
nextEventId Ship { lastEventId } = lastEventId + 1 nextEventId Ship { lastEventId } = lastEventId + 1
-- | -- | Connect and login to the ship.
connect :: Ship -> IO (Wreq.Response ByteString) connect :: Ship -> IO (Wreq.Response ByteString)
connect ship = do connect ship = do
-- post to <ship>/~/login with json {"password": <code>} -- post to <ship>/~/login with json {"password": <code>}
@ -49,20 +60,28 @@ connect ship = do
return r return r
-- | -- | Poke a ship.
poke :: Ship -> ShipName -> App -> Mark -> Aeson.Value -> IO (Wreq.Response ByteString) poke ::
poke ship shipName app mark json = do Ship ->
-- | Which gall application are you trying to poke?
App ->
-- | What mark should be applied to the data you are sending?
Mark ->
Aeson.Value ->
IO (Wreq.Response ByteString)
poke ship app mark json = do
r <- Wreq.put (channelUrl ship) r <- Wreq.put (channelUrl ship)
["id" := nextEventId ship ["id" := nextEventId ship
, "action" := ("poke"::Text) , "action" := ("poke" :: Text)
, "ship" := shipName , "ship" := (name ship)
, "app" := app , "app" := app
, "mark" := mark , "mark" := mark
, "json" := Aeson.encode json] , "json" := Aeson.encode json
]
return r return r
-- | -- | Acknowledge receipt of a message. (This clears it from the ship's queue.)
ack :: Ship -> Int -> IO (Wreq.Response ByteString) ack :: Ship -> Int -> IO (Wreq.Response ByteString)
ack ship eventId = do ack ship eventId = do
r <- Wreq.post (channelUrl ship) r <- Wreq.post (channelUrl ship)
@ -77,7 +96,7 @@ ack ship eventId = do
-- | -- |
subscribe :: Ship -> ShipName -> App -> Path -> IO Subscription subscribe :: Ship -> App -> Path -> IO Subscription
subscribe = undefined subscribe = undefined

View File

@ -10,7 +10,8 @@ main = do
lastEventId = 0, lastEventId = 0,
url = "http://localhost:8081", url = "http://localhost:8081",
code = "lidlut-tabwed-pillex-ridrup", code = "lidlut-tabwed-pillex-ridrup",
sseClient = False sseClient = False,
name = "zod"
} }
connect ship connect ship
putStrLn "success" putStrLn "success"