fixed tests again

This commit is contained in:
Ben Sima 2020-10-05 16:17:59 -04:00
parent bae7e7e2f6
commit 0e14fa866e
2 changed files with 31 additions and 22 deletions

View File

@ -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 <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

38
test.hs
View File

@ -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
{-