diff --git a/Urbit/Airlock.hs b/Urbit/Airlock.hs index 08d5631..c5690a3 100644 --- a/Urbit/Airlock.hs +++ b/Urbit/Airlock.hs @@ -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 _ diff --git a/shell.nix b/shell.nix index 7e1f58b..f226fa4 100644 --- a/shell.nix +++ b/shell.nix @@ -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 ])) ]; } diff --git a/test.hs b/test.hs index fa51ec9..385f074 100644 --- a/test.hs +++ b/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!"}} - --} diff --git a/urbit-airlock.cabal b/urbit-airlock.cabal index f00697e..66cf9b8 100644 --- a/urbit-airlock.cabal +++ b/urbit-airlock.cabal @@ -23,6 +23,7 @@ library bytestring, lens, text, + uuid, wai, wai-extra, wreq diff --git a/urbit-airlock.nix b/urbit-airlock.nix index 2e4a05c..d354a50 100644 --- a/urbit-airlock.nix +++ b/urbit-airlock.nix @@ -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 ];