Port to req

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 Conduit ((.|), runConduitRes, Void, ConduitM, ResourceT)
-import qualified Data.ByteString.Lazy as L
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Data.UUID.V4 as UUID
+import qualified Network.HTTP.Client as HTTP
-import Network.Http.Client as Client
+import Network.HTTP.Req ((=:))
-import Network.Wreq (FormParam ((:=)))
+import qualified Network.HTTP.Req as Req
-import qualified Network.Wreq as Wreq
+import Network.HTTP.Req.Conduit as Conduit
-import qualified Network.Wreq.Session as Session
+import qualified Text.URI as URI
-import System.IO.Streams (InputStream, OutputStream)
-import qualified System.IO.Streams as Streams
-
--- import qualified Network.Wai.EventSource as Event
 
 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 -> Text
-channelUrl Ship {url, uid} = url <> "/~/channel/" <> Text.unpack uid
+channelUrl Ship {url, uid} = url <> "/~/channel/" <> uid
-
-type Url = String
 
 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 :: Ship -> IO Session
-connect sess ship =
+connect ship =
-  Session.post sess (url ship <> "/~/login") ["password" := (code 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
+  Req.useURI <$> (URI.mkURI $ channelUrl ship) >>= \case
-    sess
+    Nothing -> error "could not parse ship url"
-    (channelUrl ship)
+    Just uri ->
-    $ Aeson.toJSON $
+      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
+  Req.useURI <$> (URI.mkURI $ channelUrl ship) >>= \case
-    sess
+    Nothing -> error "could not parse ship url"
-    (channelUrl ship)
+    Just uri ->
-    $ Aeson.toJSON $
+      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.
+  -- | A handler function to receive the response from the server, e.g.
-  -- 'System.IO.Streams.stdout`.
+  -- 'Data.Conduit.Binary.sinkFile "my-file.out"'.
-  OutputStream ByteString ->
+  ConduitM ByteString Void (ResourceT IO) a ->
-  IO ()
+  IO a
-subscribe ship path outfn = Client.get addr handle
+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 ()
+    con (url, opts) =
-    handle _ i = Streams.connect i outfn
+      Req.reqBr
-    addr = Char8.pack $ (url ship) ++ "/" ++ Text.unpack path
+        Req.POST
+        url
+        Req.NoReqBody
+        $ opts <> Req.cookieJar sess

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
+      aeson base bytestring conduit conduit-extra http-client lens
-      io-streams
+      modern-uri req req-conduit text uuid wai wai-extra
     ]))
   ];
 }

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
+    connect ship >> return True
-      r <- connect sess ship
-      return $ r ^? Wreq.responseBody
 
   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
+    ack sess ship 1 >> return True
-      r <- ack sess ship 1
-      return $ r ^? Wreq.responseBody
 
-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"
     }
 

urbit-airlock.cabal

@@ -21,14 +21,17 @@ library
     base >= 4.7 && < 5,
     aeson,
     bytestring,
-    http-streams,
+    conduit,
-    io-streams,
+    conduit-extra,
+    http-client,
     lens,
+    modern-uri,
+    req,
+    req-conduit,
     text,
     uuid,
     wai,
-    wai-extra,
+    wai-extra
-    wreq
 
 -- executable urlock
 --   hs-source-dirs:      .

urbit-airlock.nix

@@ -1,17 +1,15 @@
-{ mkDerivation, aeson, base, bytestring, lens, stdenv, text, wai
+{ mkDerivation, aeson, base, bytestring, conduit, conduit-extra
-, wai-extra, wreq, uuid, http-streams, io-streams
+, 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;
 }