mirror of
https://github.com/bsima/haskell-urbit-api.git
synced 2024-10-27 02:30:46 +03:00
fixed tests again
This commit is contained in:
parent
bae7e7e2f6
commit
0e14fa866e
@ -12,7 +12,8 @@ where
|
|||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import qualified Data.Aeson as Aeson
|
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 Data.Text (Text)
|
||||||
import Network.Wreq (FormParam ((:=)))
|
import Network.Wreq (FormParam ((:=)))
|
||||||
import qualified Network.Wreq as Wreq
|
import qualified Network.Wreq as Wreq
|
||||||
@ -53,13 +54,13 @@ type ShipName = Text
|
|||||||
nextEventId :: Ship -> Int
|
nextEventId :: Ship -> Int
|
||||||
nextEventId Ship {lastEventId} = lastEventId + 1
|
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
|
connect ship = do
|
||||||
-- post to <ship>/~/login with json {"password": <code>}
|
-- post to <ship>/~/login with json {"password": <code>}
|
||||||
let params = Wreq.defaults & Wreq.param "password" .~ [(code ship)]
|
let params = Wreq.defaults & Wreq.param "password" .~ [(code ship)]
|
||||||
r <- Wreq.getWith params (url ship <> "/~/login")
|
r <- Wreq.getWith params (url ship <> "/~/login")
|
||||||
return r
|
return $ r ^? Wreq.responseHeader "Set-Cookie"
|
||||||
|
|
||||||
-- | Poke a ship.
|
-- | Poke a ship.
|
||||||
poke ::
|
poke ::
|
||||||
@ -72,7 +73,7 @@ poke ::
|
|||||||
-- | What mark should be applied to the data you are sending?
|
-- | What mark should be applied to the data you are sending?
|
||||||
Mark ->
|
Mark ->
|
||||||
a ->
|
a ->
|
||||||
IO (Wreq.Response ByteString)
|
IO (Maybe L.ByteString)
|
||||||
poke ship shipName app mark json = do
|
poke ship shipName app mark json = do
|
||||||
r <-
|
r <-
|
||||||
Wreq.put
|
Wreq.put
|
||||||
@ -84,10 +85,10 @@ poke ship shipName app mark json = do
|
|||||||
"mark" := mark,
|
"mark" := mark,
|
||||||
"json" := Aeson.encode json
|
"json" := Aeson.encode json
|
||||||
]
|
]
|
||||||
return r
|
return $ r ^? Wreq.responseBody
|
||||||
|
|
||||||
-- | Acknowledge receipt of a message. (This clears it from the ship's queue.)
|
-- | 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
|
ack ship eventId = do
|
||||||
r <-
|
r <-
|
||||||
Wreq.post
|
Wreq.post
|
||||||
|
38
test.hs
38
test.hs
@ -7,6 +7,7 @@ module Main where
|
|||||||
import Control.Exception (SomeException (..), try)
|
import Control.Exception (SomeException (..), try)
|
||||||
import Data.Aeson (KeyValue ((.=)))
|
import Data.Aeson (KeyValue ((.=)))
|
||||||
import qualified Data.Aeson as Aeson
|
import qualified Data.Aeson as Aeson
|
||||||
|
import Data.Maybe (isJust, fromJust)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import qualified Data.Text.IO as Text.IO
|
import qualified Data.Text.IO as Text.IO
|
||||||
@ -14,19 +15,12 @@ import Urbit.Airlock
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
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
|
Aeson.object
|
||||||
[ "message"
|
[ "message"
|
||||||
.= Aeson.object
|
.= Aeson.object
|
||||||
@ -40,16 +34,30 @@ main = do
|
|||||||
"letter" .= Aeson.object ["text" .= Text.pack "hello world!"]
|
"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
|
-- | Poor man's testing framework
|
||||||
testing :: Show a => Text -> IO a -> IO ()
|
testing :: Text -> IO Bool -> IO ()
|
||||||
testing description f =
|
testing description f =
|
||||||
(putStrLn $ replicate 80 '-') >> try f >>= \case
|
(putStrLn $ replicate 80 '-') >> try f >>= \case
|
||||||
Left (err :: SomeException) -> do
|
Left (err :: SomeException) -> do
|
||||||
Text.IO.putStrLn $ "FAIL: " <> description
|
Text.IO.putStrLn $ "FAIL: " <> description
|
||||||
putStrLn $ show err
|
putStrLn $ show err
|
||||||
Right _ ->
|
Right False -> do
|
||||||
|
Text.IO.putStrLn $ "FAIL: " <> description
|
||||||
|
putStrLn $ "expected True, got False"
|
||||||
|
Right True ->
|
||||||
Text.IO.putStrLn $ "PASS: " <> description
|
Text.IO.putStrLn $ "PASS: " <> description
|
||||||
|
|
||||||
{-
|
{-
|
||||||
|
Loading…
Reference in New Issue
Block a user