mirror of
https://github.com/bsima/haskell-urbit-api.git
synced 2024-08-17 22:10:55 +03:00
implement session support
This commit is contained in:
parent
ffa7e5d644
commit
3229641462
@ -11,11 +11,13 @@ module Urbit.Airlock
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens ()
|
||||
import Data.Aeson ((.=))
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Encoding as Encoding
|
||||
import Network.Wreq (FormParam ((:=)))
|
||||
import qualified Network.Wreq as Wreq
|
||||
@ -24,7 +26,9 @@ import qualified Network.Wreq.Session as Session
|
||||
-- import qualified Network.Wai.EventSource as Event
|
||||
|
||||
data Ship = Ship
|
||||
{ session :: Maybe Session.Session,
|
||||
{ -- | A random string for your channel.
|
||||
uid :: Text,
|
||||
-- | The `@p` of your ship.
|
||||
name :: ShipName,
|
||||
-- | Track the latest event we saw (needed for poking).
|
||||
lastEventId :: Int,
|
||||
@ -38,7 +42,7 @@ data Ship = Ship
|
||||
deriving (Show)
|
||||
|
||||
channelUrl :: Ship -> String
|
||||
channelUrl Ship {url} = url <> "/channel.js"
|
||||
channelUrl Ship {url} = url <> "/~/channel/1234567890abcdef"
|
||||
|
||||
type Url = String
|
||||
|
||||
@ -58,13 +62,14 @@ nextEventId :: Ship -> Int
|
||||
nextEventId Ship {lastEventId} = lastEventId + 1
|
||||
|
||||
-- | Connect and login to the ship.
|
||||
connect :: Ship -> IO (Wreq.Response L.ByteString)
|
||||
connect ship =
|
||||
Wreq.post (url ship <> "/~/login") ["password" := (code ship)]
|
||||
connect :: Session.Session -> Ship -> IO (Wreq.Response L.ByteString)
|
||||
connect sess ship =
|
||||
Session.post sess (url ship <> "/~/login") ["password" := (code ship)]
|
||||
|
||||
-- | Poke a ship.
|
||||
poke ::
|
||||
Aeson.ToJSON a =>
|
||||
Session.Session ->
|
||||
Ship ->
|
||||
-- | To what ship will you send the poke?
|
||||
ShipName ->
|
||||
@ -74,25 +79,31 @@ poke ::
|
||||
Mark ->
|
||||
a ->
|
||||
IO (Wreq.Response L.ByteString)
|
||||
poke ship shipName app mark json =
|
||||
Wreq.post
|
||||
poke sess ship shipName app mark json =
|
||||
Session.post
|
||||
sess
|
||||
(channelUrl ship)
|
||||
[ "id" := nextEventId ship,
|
||||
"action" := ("poke" :: Text),
|
||||
"ship" := shipName,
|
||||
"app" := app,
|
||||
"mark" := mark,
|
||||
"json" := Aeson.encode json
|
||||
]
|
||||
$ Aeson.toJSON $
|
||||
Aeson.object
|
||||
[ "id" .= nextEventId ship,
|
||||
"action" .= Text.pack "poke",
|
||||
"ship" .= shipName,
|
||||
"app" .= app,
|
||||
"mark" .= mark,
|
||||
"json" .= json
|
||||
]
|
||||
|
||||
-- | Acknowledge receipt of a message. (This clears it from the ship's queue.)
|
||||
ack :: Ship -> Int -> IO (Wreq.Response L.ByteString)
|
||||
ack ship eventId =
|
||||
Wreq.post
|
||||
ack :: Session.Session -> Ship -> Int -> IO (Wreq.Response L.ByteString)
|
||||
ack sess ship eventId =
|
||||
Session.post
|
||||
sess
|
||||
(channelUrl ship)
|
||||
[ "action" := ("ack" :: Text),
|
||||
"event-id" := eventId
|
||||
]
|
||||
$ Aeson.toJSON $
|
||||
Aeson.object
|
||||
[ "action" .= Text.pack "ack",
|
||||
"event-id" .= eventId
|
||||
]
|
||||
|
||||
-- TODO
|
||||
-- ssePipe :: Ship -> IO _
|
||||
|
@ -5,7 +5,7 @@ nixpkgs.mkShell {
|
||||
buildInputs = [
|
||||
nixpkgs.ormolu.bin
|
||||
(nixpkgs.pkgs.haskell.packages.${compiler}.ghcWithPackages (hp: with hp; [
|
||||
aeson base bytestring lens text wai wai-extra wreq
|
||||
aeson base bytestring lens text uuid wai wai-extra wreq
|
||||
]))
|
||||
];
|
||||
}
|
||||
|
35
test.hs
35
test.hs
@ -13,7 +13,11 @@ import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as Text.IO
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import qualified Data.Word as Word
|
||||
import qualified Network.Wreq as Wreq
|
||||
import qualified Network.Wreq.Session as Session
|
||||
import qualified Numeric
|
||||
import qualified System.Random as Random
|
||||
import Urbit.Airlock
|
||||
@ -21,24 +25,25 @@ import Urbit.Airlock
|
||||
main :: IO ()
|
||||
main = do
|
||||
let ship = fakezod
|
||||
sess <- Session.newSession
|
||||
|
||||
testing "ship connection" $
|
||||
isJust <$> do
|
||||
r <- connect ship
|
||||
r <- connect sess ship
|
||||
return $ r ^? Wreq.responseBody
|
||||
|
||||
testing "poke ship" $
|
||||
isJust <$> do
|
||||
n <- Random.randomRIO (0, 100)
|
||||
uid <- UUID.nextRandom
|
||||
r <-
|
||||
poke ship "zod" "chat-hook" "json" $
|
||||
poke sess ship "zod" "chat-hook" "json" $
|
||||
Aeson.object
|
||||
[ "message"
|
||||
.= Aeson.object
|
||||
[ "path" .= Text.pack "/~/~zod/mc",
|
||||
"envelope"
|
||||
.= Aeson.object
|
||||
[ "uid" .= (Text.pack $ base32 n),
|
||||
[ "uid" .= UUID.toText uid,
|
||||
"number" .= lastEventId ship,
|
||||
"author" .= Text.pack "~zod",
|
||||
"when" .= Text.pack "1602118786225.497", -- int(time.time() * 1000)
|
||||
@ -50,13 +55,14 @@ main = do
|
||||
|
||||
testing "ack" $
|
||||
isJust <$> do
|
||||
r <- ack ship 1
|
||||
r <- ack sess ship 1
|
||||
return $ r ^? Wreq.responseBody
|
||||
|
||||
|
||||
fakezod :: Ship
|
||||
fakezod =
|
||||
Ship
|
||||
{ session = Nothing,
|
||||
{ uid = "0123456789abcdef",
|
||||
name = "zod",
|
||||
lastEventId = 0,
|
||||
url = "http://localhost:8081",
|
||||
@ -64,6 +70,7 @@ fakezod =
|
||||
sseClient = False
|
||||
}
|
||||
|
||||
|
||||
-- | Poor man's testing framework
|
||||
testing :: Text -> IO Bool -> IO ()
|
||||
testing description f =
|
||||
@ -76,19 +83,3 @@ testing description f =
|
||||
putStrLn $ "expected True, got False"
|
||||
Right True ->
|
||||
Text.IO.putStrLn $ "PASS: " <> description
|
||||
|
||||
base32 :: Integer -> String
|
||||
base32 n = Numeric.showIntAtBase 32 Char.intToDigit n ""
|
||||
|
||||
{-
|
||||
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!"}}
|
||||
|
||||
-}
|
||||
|
@ -23,6 +23,7 @@ library
|
||||
bytestring,
|
||||
lens,
|
||||
text,
|
||||
uuid,
|
||||
wai,
|
||||
wai-extra,
|
||||
wreq
|
||||
|
@ -8,7 +8,7 @@ mkDerivation {
|
||||
isLibrary = true;
|
||||
isExecutable = true;
|
||||
libraryHaskellDepends = [
|
||||
aeson base bytestring lens text wai wai-extra wreq
|
||||
aeson base bytestring lens text uuid wai wai-extra wreq
|
||||
];
|
||||
executableHaskellDepends = [ base ];
|
||||
testHaskellDepends = [ base ];
|
||||
|
Loading…
Reference in New Issue
Block a user