implement session support

Urbit/Airlock.hs

@@ -11,11 +11,13 @@ module Urbit.Airlock
   )
 where
 
-import Control.Lens
+import Control.Lens ()
+import Data.Aeson ((.=))
 import qualified Data.Aeson as Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as L
 import Data.Text (Text)
+import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Encoding
 import Network.Wreq (FormParam ((:=)))
 import qualified Network.Wreq as Wreq
@@ -24,7 +26,9 @@ import qualified Network.Wreq.Session as Session
 -- import qualified Network.Wai.EventSource as Event
 
 data Ship = Ship
-  { session :: Maybe Session.Session,
+  { -- | A random string for your channel.
+    uid :: Text,
+    -- | The `@p` of your ship.
     name :: ShipName,
     -- | Track the latest event we saw (needed for poking).
     lastEventId :: Int,
@@ -38,7 +42,7 @@ data Ship = Ship
   deriving (Show)
 
 channelUrl :: Ship -> String
-channelUrl Ship {url} = url <> "/channel.js"
+channelUrl Ship {url} = url <> "/~/channel/1234567890abcdef"
 
 type Url = String
 
@@ -58,13 +62,14 @@ nextEventId :: Ship -> Int
 nextEventId Ship {lastEventId} = lastEventId + 1
 
 -- | Connect and login to the ship.
-connect :: Ship -> IO (Wreq.Response L.ByteString)
-connect ship =
-  Wreq.post (url ship <> "/~/login") ["password" := (code ship)]
+connect :: Session.Session -> Ship -> IO (Wreq.Response L.ByteString)
+connect sess ship =
+  Session.post sess (url ship <> "/~/login") ["password" := (code ship)]
 
 -- | Poke a ship.
 poke ::
   Aeson.ToJSON a =>
+  Session.Session ->
   Ship ->
   -- | To what ship will you send the poke?
   ShipName ->
@@ -74,25 +79,31 @@ poke ::
   Mark ->
   a ->
   IO (Wreq.Response L.ByteString)
-poke ship shipName app mark json =
-  Wreq.post
+poke sess ship shipName app mark json =
+  Session.post
+    sess
     (channelUrl ship)
-    [ "id" := nextEventId ship,
-      "action" := ("poke" :: Text),
-      "ship" := shipName,
-      "app" := app,
-      "mark" := mark,
-      "json" := Aeson.encode json
-    ]
+    $ Aeson.toJSON $
+      Aeson.object
+        [ "id" .= nextEventId ship,
+          "action" .= Text.pack "poke",
+          "ship" .= shipName,
+          "app" .= app,
+          "mark" .= mark,
+          "json" .= json
+        ]
 
 -- | Acknowledge receipt of a message. (This clears it from the ship's queue.)
-ack :: Ship -> Int -> IO (Wreq.Response L.ByteString)
-ack ship eventId =
-  Wreq.post
+ack :: Session.Session -> Ship -> Int -> IO (Wreq.Response L.ByteString)
+ack sess ship eventId =
+  Session.post
+    sess
     (channelUrl ship)
-    [ "action" := ("ack" :: Text),
-      "event-id" := eventId
-    ]
+    $ Aeson.toJSON $
+      Aeson.object
+        [ "action" .= Text.pack "ack",
+          "event-id" .= eventId
+        ]
 
 -- TODO
 -- ssePipe :: Ship -> IO _

shell.nix

@@ -5,7 +5,7 @@ nixpkgs.mkShell {
   buildInputs = [
     nixpkgs.ormolu.bin
     (nixpkgs.pkgs.haskell.packages.${compiler}.ghcWithPackages (hp: with hp; [
-      aeson base bytestring lens text wai wai-extra wreq
+      aeson base bytestring lens text uuid wai wai-extra wreq
     ]))
   ];
 }

test.hs

@@ -13,7 +13,11 @@ import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
+import qualified Data.UUID as UUID
+import qualified Data.UUID.V4 as UUID
+import qualified Data.Word as Word
 import qualified Network.Wreq as Wreq
+import qualified Network.Wreq.Session as Session
 import qualified Numeric
 import qualified System.Random as Random
 import Urbit.Airlock
@@ -21,24 +25,25 @@ import Urbit.Airlock
 main :: IO ()
 main = do
   let ship = fakezod
+  sess <- Session.newSession
 
   testing "ship connection" $
     isJust <$> do
-      r <- connect ship
+      r <- connect sess ship
       return $ r ^? Wreq.responseBody
 
   testing "poke ship" $
     isJust <$> do
-      n <- Random.randomRIO (0, 100)
+      uid <- UUID.nextRandom
       r <-
-        poke ship "zod" "chat-hook" "json" $
+        poke sess ship "zod" "chat-hook" "json" $
           Aeson.object
             [ "message"
                 .= Aeson.object
                   [ "path" .= Text.pack "/~/~zod/mc",
                     "envelope"
                       .= Aeson.object
-                        [ "uid" .= (Text.pack $ base32 n),
+                        [ "uid" .= UUID.toText uid,
                           "number" .= lastEventId ship,
                           "author" .= Text.pack "~zod",
                           "when" .= Text.pack "1602118786225.497", -- int(time.time() * 1000)
@@ -50,13 +55,14 @@ main = do
 
   testing "ack" $
     isJust <$> do
-      r <- ack ship 1
+      r <- ack sess ship 1
       return $ r ^? Wreq.responseBody
 
+
 fakezod :: Ship
 fakezod =
   Ship
-    { session = Nothing,
+    { uid = "0123456789abcdef",
       name = "zod",
       lastEventId = 0,
       url = "http://localhost:8081",
@@ -64,6 +70,7 @@ fakezod =
       sseClient = False
     }
 
+
 -- | Poor man's testing framework
 testing :: Text -> IO Bool -> IO ()
 testing description f =
@@ -76,19 +83,3 @@ testing description f =
       putStrLn $ "expected True, got False"
     Right True ->
       Text.IO.putStrLn $ "PASS: " <> description
-
-base32 :: Integer -> String
-base32 n = Numeric.showIntAtBase 32 Char.intToDigit n ""
-
-{-
-s = baseconvert.base(random.getrandbits(128), 10, 32, string=True).lower()
-uid = '0v' + '.'.join(s[i:i+5] for i in range(0, len(s), 5))[::-1]
-
-"path": "/~/~zod/mc",
-"envelope": {"uid": uid,
-             "number": 1,
-             "author": "~zod",
-             "when": ,
-             "letter": {"text": "hello world!"}}
-
--}

urbit-airlock.cabal

@@ -23,6 +23,7 @@ library
     bytestring,
     lens,
     text,
+    uuid,
     wai,
     wai-extra,
     wreq

urbit-airlock.nix

@@ -8,7 +8,7 @@ mkDerivation {
   isLibrary = true;
   isExecutable = true;
   libraryHaskellDepends = [
-    aeson base bytestring lens text wai wai-extra wreq
+    aeson base bytestring lens text uuid wai wai-extra wreq
   ];
   executableHaskellDepends = [ base ];
   testHaskellDepends = [ base ];