2020-10-04 16:27:38 +03:00
|
|
|
{-# LANGUAGE LambdaCase #-}
|
2020-09-17 04:05:14 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2020-10-04 16:27:38 +03:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2020-09-17 04:05:14 +03:00
|
|
|
|
2020-09-17 03:49:49 +03:00
|
|
|
module Main where
|
|
|
|
|
2020-10-04 16:27:38 +03:00
|
|
|
import Control.Exception (SomeException (..), try)
|
2020-10-06 04:19:08 +03:00
|
|
|
import Control.Lens ((^?))
|
2020-10-04 16:27:38 +03:00
|
|
|
import Data.Aeson (KeyValue ((.=)))
|
|
|
|
import qualified Data.Aeson as Aeson
|
2020-10-09 23:23:08 +03:00
|
|
|
import qualified Data.Char as Char
|
2020-10-06 04:19:08 +03:00
|
|
|
import Data.Maybe (isJust)
|
2020-10-04 16:27:38 +03:00
|
|
|
import Data.Text (Text)
|
|
|
|
import qualified Data.Text as Text
|
|
|
|
import qualified Data.Text.IO as Text.IO
|
2020-10-06 04:19:08 +03:00
|
|
|
import qualified Network.Wreq as Wreq
|
2020-10-09 23:23:08 +03:00
|
|
|
import qualified Numeric
|
|
|
|
import qualified System.Random as Random
|
2020-09-17 04:05:14 +03:00
|
|
|
import Urbit.Airlock
|
2020-09-17 03:49:49 +03:00
|
|
|
|
2020-10-04 16:27:38 +03:00
|
|
|
main :: IO ()
|
2020-09-17 03:49:49 +03:00
|
|
|
main = do
|
2020-10-05 23:17:59 +03:00
|
|
|
let ship = fakezod
|
2020-10-04 16:27:38 +03:00
|
|
|
|
2020-10-06 04:21:48 +03:00
|
|
|
testing "ship connection" $
|
|
|
|
isJust <$> do
|
|
|
|
r <- connect ship
|
|
|
|
return $ r ^? Wreq.responseBody
|
2020-10-05 23:17:59 +03:00
|
|
|
|
2020-10-06 04:21:48 +03:00
|
|
|
testing "poke ship" $
|
|
|
|
isJust <$> do
|
2020-10-09 23:23:08 +03:00
|
|
|
n <- Random.randomRIO (0, 100)
|
2020-10-06 04:21:48 +03:00
|
|
|
r <-
|
|
|
|
poke ship "zod" "chat-hook" "json" $
|
|
|
|
Aeson.object
|
|
|
|
[ "message"
|
|
|
|
.= Aeson.object
|
|
|
|
[ "path" .= Text.pack "/~/~zod/mc",
|
|
|
|
"envelope"
|
|
|
|
.= Aeson.object
|
2020-10-09 23:23:08 +03:00
|
|
|
[ "uid" .= (Text.pack $ base32 n),
|
2020-10-06 04:21:48 +03:00
|
|
|
"number" .= lastEventId ship,
|
|
|
|
"author" .= Text.pack "~zod",
|
2020-10-09 23:23:08 +03:00
|
|
|
"when" .= Text.pack "1602118786225.497", -- int(time.time() * 1000)
|
2020-10-06 04:21:48 +03:00
|
|
|
"letter" .= Aeson.object ["text" .= Text.pack "hello world!"]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
]
|
|
|
|
return $ r ^? Wreq.responseBody
|
|
|
|
|
|
|
|
testing "ack" $
|
|
|
|
isJust <$> do
|
|
|
|
r <- ack ship 1
|
|
|
|
return $ r ^? Wreq.responseBody
|
2020-10-05 23:17:59 +03:00
|
|
|
|
|
|
|
fakezod :: Ship
|
|
|
|
fakezod =
|
|
|
|
Ship
|
|
|
|
{ session = Nothing,
|
2020-10-05 23:52:58 +03:00
|
|
|
name = "zod",
|
2020-10-05 23:17:59 +03:00
|
|
|
lastEventId = 0,
|
|
|
|
url = "http://localhost:8081",
|
|
|
|
code = "lidlut-tabwed-pillex-ridrup",
|
|
|
|
sseClient = False
|
|
|
|
}
|
2020-10-04 16:27:38 +03:00
|
|
|
|
|
|
|
-- | Poor man's testing framework
|
2020-10-05 23:17:59 +03:00
|
|
|
testing :: Text -> IO Bool -> IO ()
|
2020-10-04 16:27:38 +03:00
|
|
|
testing description f =
|
|
|
|
(putStrLn $ replicate 80 '-') >> try f >>= \case
|
|
|
|
Left (err :: SomeException) -> do
|
|
|
|
Text.IO.putStrLn $ "FAIL: " <> description
|
|
|
|
putStrLn $ show err
|
2020-10-05 23:17:59 +03:00
|
|
|
Right False -> do
|
|
|
|
Text.IO.putStrLn $ "FAIL: " <> description
|
|
|
|
putStrLn $ "expected True, got False"
|
|
|
|
Right True ->
|
2020-10-04 16:27:38 +03:00
|
|
|
Text.IO.putStrLn $ "PASS: " <> description
|
|
|
|
|
2020-10-09 23:23:08 +03:00
|
|
|
base32 :: Integer -> String
|
|
|
|
base32 n = Numeric.showIntAtBase 32 Char.intToDigit n ""
|
|
|
|
|
2020-10-04 16:27:38 +03:00
|
|
|
{-
|
|
|
|
s = baseconvert.base(random.getrandbits(128), 10, 32, string=True).lower()
|
|
|
|
uid = '0v' + '.'.join(s[i:i+5] for i in range(0, len(s), 5))[::-1]
|
|
|
|
|
|
|
|
"path": "/~/~zod/mc",
|
|
|
|
"envelope": {"uid": uid,
|
|
|
|
"number": 1,
|
|
|
|
"author": "~zod",
|
|
|
|
"when": ,
|
|
|
|
"letter": {"text": "hello world!"}}
|
|
|
|
|
|
|
|
-}
|