fixed tests again

Urbit/Airlock.hs

@@ -12,7 +12,8 @@ where
 
 import Control.Lens
 import qualified Data.Aeson as Aeson
-import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as L
+import Data.ByteString (ByteString)
 import Data.Text (Text)
 import Network.Wreq (FormParam ((:=)))
 import qualified Network.Wreq as Wreq
@@ -53,13 +54,13 @@ type ShipName = Text
 nextEventId :: Ship -> Int
 nextEventId Ship {lastEventId} = lastEventId + 1
 
--- | Connect and login to the ship.
+-- | Connect and login to the ship. Returns the 'urbauth' cookie.
-connect :: Ship -> IO (Wreq.Response ByteString)
+connect :: Ship -> IO (Maybe ByteString)
 connect ship = do
   -- post to <ship>/~/login with json {"password": <code>}
   let params = Wreq.defaults & Wreq.param "password" .~ [(code ship)]
   r <- Wreq.getWith params (url ship <> "/~/login")
-  return r
+  return $ r ^? Wreq.responseHeader "Set-Cookie"
 
 -- | Poke a ship.
 poke ::
@@ -72,7 +73,7 @@ poke ::
   -- | What mark should be applied to the data you are sending?
   Mark ->
   a ->
-  IO (Wreq.Response ByteString)
+  IO (Maybe L.ByteString)
 poke ship shipName app mark json = do
   r <-
     Wreq.put
@@ -84,10 +85,10 @@ poke ship shipName app mark json = do
         "mark" := mark,
         "json" := Aeson.encode json
       ]
-  return r
+  return $ r ^? Wreq.responseBody
 
 -- | 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 L.ByteString)
 ack ship eventId = do
   r <-
     Wreq.post

test.hs

@@ -7,6 +7,7 @@ module Main where
 import Control.Exception (SomeException (..), try)
 import Data.Aeson (KeyValue ((.=)))
 import qualified Data.Aeson as Aeson
+import Data.Maybe (isJust, fromJust)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
@@ -14,19 +15,12 @@ import Urbit.Airlock
 
 main :: IO ()
 main = do
-  let ship =
+  let ship = fakezod
-        Ship
+  testing "ship connection" $ isJust <$> connect ship
-          { session = Nothing,
+  cookie <- fromJust <$> connect ship
-            lastEventId = 0,
-            url = "http://localhost:8081",
-            code = "lidlut-tabwed-pillex-ridrup",
-            sseClient = False
-          }
 
-  testing "ship connection" $ connect ship
+  testing "poke ship" $ isJust <$>
-
+    (poke ship "zod" "chat-hook" "json" $
-  testing "poke ship" $
-    poke ship "zod" "chat-hook" "json" $
       Aeson.object
         [ "message"
             .= Aeson.object
@@ -40,16 +34,30 @@ main = do
                       "letter" .= Aeson.object ["text" .= Text.pack "hello world!"]
                     ]
               ]
-        ]
+        ])
+
+
+fakezod :: Ship
+fakezod =
+  Ship
+    { session = Nothing,
+      lastEventId = 0,
+      url = "http://localhost:8081",
+      code = "lidlut-tabwed-pillex-ridrup",
+      sseClient = False
+    }
 
 -- | Poor man's testing framework
-testing :: Show a => Text -> IO a -> IO ()
+testing :: Text -> IO Bool -> IO ()
 testing description f =
   (putStrLn $ replicate 80 '-') >> try f >>= \case
     Left (err :: SomeException) -> do
       Text.IO.putStrLn $ "FAIL: " <> description
       putStrLn $ show err
-    Right _ ->
+    Right False -> do
+      Text.IO.putStrLn $ "FAIL: " <> description
+      putStrLn $ "expected True, got False"
+    Right True ->
       Text.IO.putStrLn $ "PASS: " <> description
 
 {-