diff --git a/Urbit/Airlock.hs b/Urbit/Airlock.hs index 9a45c8d..b8dc617 100644 --- a/Urbit/Airlock.hs +++ b/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 :: Ship -> IO (Wreq.Response ByteString) +-- | Connect and login to the ship. Returns the 'urbauth' cookie. +connect :: Ship -> IO (Maybe ByteString) connect ship = do -- post to /~/login with json {"password": } 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 diff --git a/test.hs b/test.hs index 4d4fa25..a5830a8 100644 --- a/test.hs +++ b/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 = - Ship - { session = Nothing, - lastEventId = 0, - url = "http://localhost:8081", - code = "lidlut-tabwed-pillex-ridrup", - sseClient = False - } + let ship = fakezod + testing "ship connection" $ isJust <$> connect ship + cookie <- fromJust <$> connect ship - testing "ship connection" $ connect ship - - testing "poke ship" $ - poke ship "zod" "chat-hook" "json" $ + testing "poke ship" $ isJust <$> + (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 {-