mirror of
https://github.com/bsima/haskell-urbit-api.git
synced 2024-08-17 14:00:31 +03:00
fixed tests again
This commit is contained in:
parent
bae7e7e2f6
commit
0e14fa866e
@ -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
38
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
|
||||
|
||||
{-
|
||||
|
Loading…
Reference in New Issue
Block a user