From e12ff5f6c5caaee78abbe568db9043190d7b3a80 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 21 Oct 2020 17:30:00 -0400 Subject: [PATCH] Port to req --- Urbit/Airlock.hs | 114 +++++++++++++++++++++++++++++--------------- shell.nix | 4 +- test.hs | 27 ++++------- urbit-airlock.cabal | 11 +++-- urbit-airlock.nix | 12 ++--- 5 files changed, 98 insertions(+), 70 deletions(-) diff --git a/Urbit/Airlock.hs b/Urbit/Airlock.hs index 326a279..fe0fafa 100644 --- a/Urbit/Airlock.hs +++ b/Urbit/Airlock.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -16,19 +18,14 @@ import Control.Lens () import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.ByteString.Lazy as L +import Conduit ((.|), runConduitRes, Void, ConduitM, ResourceT) import Data.Text (Text) import qualified Data.Text as Text -import Data.UUID.V4 as UUID -import Network.Http.Client as Client -import Network.Wreq (FormParam ((:=))) -import qualified Network.Wreq as Wreq -import qualified Network.Wreq.Session as Session -import System.IO.Streams (InputStream, OutputStream) -import qualified System.IO.Streams as Streams - --- import qualified Network.Wai.EventSource as Event +import qualified Network.HTTP.Client as HTTP +import Network.HTTP.Req ((=:)) +import qualified Network.HTTP.Req as Req +import Network.HTTP.Req.Conduit as Conduit +import qualified Text.URI as URI data Ship = Ship { -- | A random string for your channel. @@ -39,16 +36,14 @@ data Ship = Ship lastEventId :: Int, -- | Network access point, with port if necessary. Like -- 'https://sampel-palnet.arvo.network', or 'http://localhost:8080'. - url :: Url, + url :: Text, -- | Login code, `+code` in the dojo. Don't share this publically. code :: Text } deriving (Show) -channelUrl :: Ship -> String -channelUrl Ship {url, uid} = url <> "/~/channel/" <> Text.unpack uid - -type Url = String +channelUrl :: Ship -> Text +channelUrl Ship {url, uid} = url <> "/~/channel/" <> uid type App = Text @@ -63,15 +58,26 @@ type ShipName = Text nextEventId :: Ship -> Int nextEventId Ship {lastEventId} = lastEventId + 1 +type Session = HTTP.CookieJar + -- | Connect and login to the ship. -connect :: Session.Session -> Ship -> IO (Wreq.Response L.ByteString) -connect sess ship = - Session.post sess (url ship <> "/~/login") ["password" := (code ship)] +connect :: Ship -> IO Session +connect ship = + Req.useURI <$> (URI.mkURI $ url ship <> "/~/login") >>= \case + Nothing -> error "could not parse ship url" + Just uri -> + Req.runReq Req.defaultHttpConfig $ + Req.responseCookieJar <$> either con con uri + where + body = "password" =: (code ship) + con (url, opts) = + Req.req Req.POST url (Req.ReqBodyUrlEnc body) Req.ignoreResponse $ + opts -- | Poke a ship. poke :: Aeson.ToJSON a => - Session.Session -> + Session -> Ship -> -- | To what ship will you send the poke? ShipName -> @@ -80,12 +86,22 @@ poke :: -- | What mark should be applied to the data you are sending? Mark -> a -> - IO (Wreq.Response L.ByteString) + IO Req.IgnoreResponse poke sess ship shipName app mark json = - Session.post - sess - (channelUrl ship) - $ Aeson.toJSON $ + Req.useURI <$> (URI.mkURI $ channelUrl ship) >>= \case + Nothing -> error "could not parse ship url" + Just uri -> + Req.runReq Req.defaultHttpConfig $ + either con con uri + where + con (url, opts) = + Req.req + Req.POST + url + (Req.ReqBodyJson body) + Req.ignoreResponse + $ opts <> Req.cookieJar sess + body = [ Aeson.object [ "id" .= nextEventId ship, "action" .= Text.pack "poke", @@ -97,28 +113,48 @@ poke sess ship shipName app mark json = ] -- | Acknowledge receipt of a message. (This clears it from the ship's queue.) -ack :: Session.Session -> Ship -> Int -> IO (Wreq.Response L.ByteString) +ack :: Session -> Ship -> Int -> IO Req.IgnoreResponse ack sess ship eventId = - Session.post - sess - (channelUrl ship) - $ Aeson.toJSON $ + Req.useURI <$> (URI.mkURI $ channelUrl ship) >>= \case + Nothing -> error "could not parse ship url" + Just uri -> + Req.runReq Req.defaultHttpConfig $ + either con con uri + where + con (url, opts) = + Req.req + Req.POST + url + (Req.ReqBodyJson body) + Req.ignoreResponse + $ opts <> Req.cookieJar sess + body = [ Aeson.object [ "action" .= Text.pack "ack", "event-id" .= eventId ] ] --- | +-- | Subscribe to ship events on some path. subscribe :: + Session -> Ship -> Path -> - -- | A handler function to receiv the response from the server, e.g. - -- 'System.IO.Streams.stdout`. - OutputStream ByteString -> - IO () -subscribe ship path outfn = Client.get addr handle + -- | A handler function to receive the response from the server, e.g. + -- 'Data.Conduit.Binary.sinkFile "my-file.out"'. + ConduitM ByteString Void (ResourceT IO) a -> + IO a +subscribe sess ship path fn = + Req.useURI <$> (URI.mkURI $ url ship <> "/" <> path) >>= \case + Nothing -> error "could not parse ship url" + Just uri -> Req.runReq Req.defaultHttpConfig $ do + either con con uri $ \r -> + runConduitRes $ + responseBodySource r .| fn where - handle :: Response -> InputStream ByteString -> IO () - handle _ i = Streams.connect i outfn - addr = Char8.pack $ (url ship) ++ "/" ++ Text.unpack path + con (url, opts) = + Req.reqBr + Req.POST + url + Req.NoReqBody + $ opts <> Req.cookieJar sess diff --git a/shell.nix b/shell.nix index e244acd..05ec319 100644 --- a/shell.nix +++ b/shell.nix @@ -5,8 +5,8 @@ nixpkgs.mkShell { buildInputs = [ nixpkgs.ormolu.bin (nixpkgs.pkgs.haskell.packages.${compiler}.ghcWithPackages (hp: with hp; [ - aeson base bytestring http-streams lens text uuid wai wai-extra wreq - io-streams + aeson base bytestring conduit conduit-extra http-client lens + modern-uri req req-conduit text uuid wai wai-extra ])) ]; } diff --git a/test.hs b/test.hs index 07d9872..0fbf811 100644 --- a/test.hs +++ b/test.hs @@ -5,36 +5,29 @@ module Main where import Control.Exception (SomeException (..), try) -import Control.Lens ((^?)) import Data.Aeson (KeyValue ((.=))) import qualified Data.Aeson as Aeson -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 Network.Wreq as Wreq -import qualified Network.Wreq.Session as Session import qualified System.Environment as Env import qualified System.Exit as Exit import Urbit.Airlock main :: IO () main = do - port <- Env.getEnv "PORT" + port <- Text.pack <$> Env.getEnv "PORT" let ship = fakezod port - sess <- Session.newSession - + sess <- connect ship testing "ship connection" $ - isJust <$> do - r <- connect sess ship - return $ r ^? Wreq.responseBody + connect ship >> return True testing "poke ship" $ - isJust <$> do + do uuid <- UUID.nextRandom - r <- + _ <- poke sess ship "zod" "chat-hook" "json" $ Aeson.object [ "message" @@ -50,20 +43,18 @@ main = do ] ] ] - return $ r ^? Wreq.responseBody + return $ True testing "ack" $ - isJust <$> do - r <- ack sess ship 1 - return $ r ^? Wreq.responseBody + ack sess ship 1 >> return True -fakezod :: String -> Ship +fakezod :: Text -> Ship fakezod port = Ship { uid = "0123456789abcdef", name = "zod", lastEventId = 1, - url = "http://localhost:" ++ port, + url = "http://localhost:" <> port, code = "lidlut-tabwed-pillex-ridrup" } diff --git a/urbit-airlock.cabal b/urbit-airlock.cabal index 6e00525..810fec5 100644 --- a/urbit-airlock.cabal +++ b/urbit-airlock.cabal @@ -21,14 +21,17 @@ library base >= 4.7 && < 5, aeson, bytestring, - http-streams, - io-streams, + conduit, + conduit-extra, + http-client, lens, + modern-uri, + req, + req-conduit, text, uuid, wai, - wai-extra, - wreq + wai-extra -- executable urlock -- hs-source-dirs: . diff --git a/urbit-airlock.nix b/urbit-airlock.nix index 276ba50..b1383c8 100644 --- a/urbit-airlock.nix +++ b/urbit-airlock.nix @@ -1,17 +1,15 @@ -{ mkDerivation, aeson, base, bytestring, lens, stdenv, text, wai -, wai-extra, wreq, uuid, http-streams, io-streams +{ mkDerivation, aeson, base, bytestring, conduit, conduit-extra +, http-client, lens, modern-uri, req, req-conduit, stdenv, text +, uuid, wai, wai-extra }: mkDerivation { pname = "urbit-airlock"; version = "0.1.0.0"; src = ./.; - isLibrary = true; - isExecutable = true; libraryHaskellDepends = [ - aeson base bytestring http-streams lens text uuid wai wai-extra wreq + aeson base bytestring conduit conduit-extra http-client lens + modern-uri req req-conduit text uuid wai wai-extra ]; - executableHaskellDepends = [ base ]; - testHaskellDepends = [ base ]; homepage = "https://github.com/bsima/urbit-airlock"; license = stdenv.lib.licenses.bsd3; }