WIP tests

Author: jamesdbrock

.gitignore

@@ -6,3 +6,4 @@
 /node_modules/
 /output/
 package-lock.json
+generated-docs/

spago.dhall

@@ -13,10 +13,11 @@ to generate this file without the comments in this block.
 { name = "node-http"
 , dependencies =
   [ "aff"
-  , "arrays"
   , "arraybuffer-types"
+  , "arrays"
   , "console"
   , "contravariant"
+  , "control"
   , "effect"
   , "either"
   , "exceptions"
@@ -34,6 +35,7 @@ to generate this file without the comments in this block.
   , "partial"
   , "prelude"
   , "st"
+  , "strings"
   , "transformers"
   , "tuples"
   , "unsafe-coerce"

src/Node/HTTP2.purs

@@ -1,4 +1,11 @@
--- | Low-level bindings to the *Node.js* [HTTP/2](https://nodejs.org/docs/latest/api/http2.html) API.
+-- | Bindings to the [*Node.js* HTTP/2](https://nodejs.org/docs/latest/api/http2.html) API.
+-- |
+-- | The __Node.HTTP2.Client__ and __Node.HTTP2.Server__ modules provide a
+-- | low-level `Effect` callback API.
+-- |
+-- | The __Node.HTTP2.Client.Aff__ and __Node.HTTP2.Server.Aff__ modules provide
+-- | a high-level `Aff` API so that
+-- | [“you don’t even have to think about callbacks.”](https://github.com/purescript-contrib/purescript-aff/tree/main/docs#escaping-callback-hell).
 module Node.HTTP2
   ( Headers
   , toHeaders

src/Node/HTTP2/Client.Aff.purs

@@ -1,9 +1,5 @@
 -- | Bindings to the *Node.js* HTTP/2 Client Core API.
 -- |
--- | This module provides an `Aff` API so that
--- | “you don’t even have to think about callbacks.”
--- | See [__Escaping Callback Hell__](https://github.com/purescript-contrib/purescript-aff/tree/main/docs#escaping-callback-hell).
--- |
 -- | ## Client-side example
 -- |
 -- | Equivalent to
@@ -14,23 +10,23 @@
 -- |
 -- | ca <- liftEffect $ Node.FS.Sync.readFile "localhost-cert.pem"
 -- |
--- | clientsession <- connect
+-- | client <- connect
 -- |   (toOptions {ca})
 -- |   (URL.parse "https://localhost:8443")
 -- |
--- | clientstream <- request clientsession
+-- | stream <- request client
 -- |   (toOptions {})
 -- |   (toHeaders {":path": "/"})
 -- |
--- | headers <- waitResponse clientstream
+-- | headers <- waitResponse stream
 -- | liftEffect $ for_ (headerKeys headers) \name ->
 -- |   Effect.Console.log $
 -- |     name <> ": " <> fromMaybe "" (headerString headers name)
 -- |
--- | dataString <- toStringUTF8 =<< (fst <$> readAll (toDuplex clientstream))
--- | liftEffect $ Effect.Console.log $ "\n" <> dataString
+-- | body <- toStringUTF8 =<< (fst <$> readAll (toDuplex stream))
+-- | liftEffect $ Effect.Console.log $ "\n" <> body
 -- |
--- | close clientsession
+-- | close client
 -- | ```
 module Node.HTTP2.Client.Aff
   ( connect

src/Node/HTTP2/Client.purs

@@ -8,30 +8,30 @@
 -- | ```
 -- | ca <- Node.FS.Sync.readFile "localhost-cert.pem"
 -- |
--- | clientsession <- connect
+-- | client <- connect
 -- |   (URL.parse "https://localhost:8443")
 -- |   (toOptions {ca})
 -- |   (\_ _ -> pure unit)
 -- |
--- | clientstream <- request clientsession
+-- | stream <- request client
 -- |   (toHeaders {":path": "/"})
 -- |   (toOptions {})
 -- |
--- | onceResponse clientstream
+-- | onceResponse stream
 -- |   \headers flags ->
 -- |     for_ (headerKeys headers) \name ->
 -- |       Effect.Console.log $
 -- |         name <> ": " <> fromMaybe "" (headerValueString headers name)
 -- |
--- | let req = toDuplex clientstream
+-- | let req = toDuplex stream
 -- |
 -- | dataRef <- liftST $ Control.Monad.ST.Ref.new ""
 -- | Node.Stream.onDataString req Node.Encoding.UTF8
 -- |   \chunk -> void $ liftST $ Control.Monad.ST.Ref.modify (_ <> chunk) dataRef
 -- | Node.Stream.onEnd req do
 -- |   dataString <- liftST $ Control.Monad.ST.Ref.read dataRef
 -- |   Effect.Console.log $ "\n" <> dataString
--- |   close clientsession
+-- |   close client
 -- | ```
 module Node.HTTP2.Client
   ( ClientHttp2Session

src/Node/HTTP2/Server.Aff.purs

@@ -11,16 +11,17 @@
 -- | key <- Node.FS.Sync.readFile "localhost-privkey.pem"
 -- | cert <- Node.FS.Sync.readFile "localhost-cert.pem"
 -- |
--- | void $ listenSecure (toOptions {key, cert}) (toOptions {port:8443 })
--- |   \server _headers stream -> do
+-- | void $ listenSecure (toOptions {key, cert}) (toOptions {port:8443})
+-- |   (\server err -> liftEffect $ Console.errorShow err)
+-- |   \server headers stream -> do
 -- |     respond stream
 -- |       (toOptions {})
 -- |       (toHeaders
 -- |         { "content-type": "text/html; charset=utf-8"
 -- |         , ":status": 200
 -- |         }
 -- |       )
--- |     write (toDuplex stream) =<< fromStringUTF8 ("<html>Hello World</html>")
+-- |     write (toDuplex stream) =<< fromStringUTF8 ("<h1>Hello World<hl>")
 -- |     end (toDuplex stream)
 -- |     closeSecure server
 -- | ```
@@ -153,9 +154,9 @@ closeSecure server = makeAff \complete -> do
 -- | Push a stream to the client, with the client request headers for a
 -- | request which the client did not send but to which the server will respond.
 -- |
--- | On the new pushed stream, call
--- | `respond`
--- | and
+-- | On the new pushed stream, it is mandatory to first call `respond`.
+-- |
+-- | Then call
 -- | [`Node.Stream.Aff.write`](https://pursuit.purescript.org/packages/purescript-node-streams-aff/docs/Node.Stream.Aff#v:write)
 -- | and
 -- | [`Node.Stream.Aff.end`](https://pursuit.purescript.org/packages/purescript-node-streams-aff/docs/Node.Stream.Aff#v:end).
@@ -164,8 +165,8 @@ closeSecure server = makeAff \complete -> do
 -- |
 -- | > Calling `http2stream.pushStream()` from within a pushed stream is not permitted and will throw an error.
 pushStream :: ServerHttp2Stream -> OptionsObject -> Headers -> Aff ServerHttp2Stream
-pushStream stream optionsobject headers = makeAff \complete -> do
-  Server.pushStream stream headers optionsobject \nerr pushedstream _ -> do
+pushStream stream optionsobject headersRequest = makeAff \complete -> do
+  Server.pushStream stream headersRequest optionsobject \nerr pushedstream _ -> do
     case toMaybe nerr of
       Just err -> complete (Left err)
       Nothing -> complete (Right pushedstream)

test/HTTP2.purs

@@ -17,8 +17,8 @@ import Node.Stream as Node.Stream
 import Node.URL as URL
 
 
-testHttp2ServerSecure :: Effect Unit
-testHttp2ServerSecure = do
+basic_serverSecure :: Effect Unit
+basic_serverSecure = do
 
   server <- HTTP2.Server.createSecureServer
     (toOptions {key: mockKey, cert: mockCert})
@@ -46,8 +46,8 @@ testHttp2ServerSecure = do
     (toOptions { port:8443 })
     (pure unit)
 
-testHttp2Client :: Effect Unit
-testHttp2Client = do
+basic_client :: Effect Unit
+basic_client = do
 
   clientsession <- HTTP2.Client.connect
     (URL.parse "https://localhost:8443")

test/HTTP2Aff.purs

@@ -2,19 +2,22 @@ module Test.HTTP2Aff where
 
 import Prelude
 
+import Control.Alternative ((<|>))
+import Data.Foldable (traverse_)
+import Data.Maybe (fromMaybe)
+import Data.String as String
 import Data.Tuple (fst)
-import Effect.Aff (Aff, throwError)
+import Effect.Aff (Aff, parallel, sequential, throwError)
 import Effect.Class (liftEffect)
 import Effect.Console as Console
-import Node.HTTP2 (fromStringUTF8, toHeaders, toOptions, toStringUTF8)
-import Node.HTTP2.Client.Aff (waitResponse)
+import Node.HTTP2 (Headers, fromStringUTF8, headerArray, headerKeys, headerString, toHeaders, toOptions, toStringUTF8)
 import Node.HTTP2.Client.Aff as Client.Aff
 import Node.HTTP2.Server.Aff as Server.Aff
 import Node.Stream.Aff (end, readAll, readSome, write)
 import Node.URL as URL
 
-testHttp2ServerSecureAff :: Aff Unit
-testHttp2ServerSecureAff = do
+push1_serverSecure :: Aff Unit
+push1_serverSecure = do
 
   -- 1. Start the server, wait for a connection.
   void $ Server.Aff.listenSecure
@@ -34,6 +37,7 @@ testHttp2ServerSecureAff = do
 
       -- 4. Push a new stream.
       stream2 <- Server.Aff.pushStream stream (toOptions {}) (toHeaders {})
+      Server.Aff.respond stream2 (toOptions {}) (toHeaders {})
       let s2 = Server.Aff.toDuplex stream2
       write s2 =<< fromStringUTF8 "HTTP/2 secure push body Aff"
       end s2
@@ -42,11 +46,11 @@ testHttp2ServerSecureAff = do
       end s
 
       -- 5. After one session, stop the server.
-      Server.Aff.closeServerSecure server
+      Server.Aff.closeSecure server
 
 
-testHttp2ClientAff :: Aff Unit
-testHttp2ClientAff = do
+push1_client :: Aff Unit
+push1_client = do
 
   -- 1. Begin the session, open a connection.
   session <- Client.Aff.connect
@@ -80,6 +84,87 @@ testHttp2ClientAff = do
 
 
 
+headers_serverSecure :: Aff Unit
+headers_serverSecure = do
+
+  -- 1. Start the server, wait for a connection.
+  void $ Server.Aff.listenSecure
+    (toOptions {key: mockKey, cert: mockCert})
+    (toOptions {port: 8444})
+    (\_server err -> throwError err)
+    \server headers stream -> do
+      liftEffect $ Console.log $ "SERVER " <> headersShow headers
+
+      -- 2. Receive a request.
+      let s = Server.Aff.toDuplex stream
+
+      -- 3. Send a response.
+      Server.Aff.respond stream (toOptions {}) $ toHeaders
+        { "normal": "server normal header"
+        }
+      -- Error [ERR_HTTP2_HEADERS_AFTER_RESPOND]: Cannot specify additional headers after response initiated
+      -- Server.Aff.sendHeadersAdditional stream $ toHeaders
+      --   { "additional": "server additional header"
+      --   }
+
+      -- 4. Push a new stream.
+      stream2 <- Server.Aff.pushStream stream (toOptions {}) (toHeaders {})
+      Server.Aff.respond stream2 (toOptions {})
+        ( toHeaders
+          { "pushnormal": "server normal pushed header"
+          }
+        )
+      let s2 = Server.Aff.toDuplex stream2
+      end s2
+
+      -- 5. Close the connection.
+      end s
+
+      -- 5. After one session, stop the server.
+      Server.Aff.closeSecure server
+
+
+
+headers_client :: Aff Unit
+headers_client = do
+
+  -- 1. Begin the session, open a connection.
+  session <- Client.Aff.connect
+    (toOptions {ca: mockCert})
+    (URL.parse "https://localhost:8444")
+
+  -- 2. Send a request.
+  stream <- Client.Aff.request session (toOptions {}) $ toHeaders
+      { "normal": "client normal header"
+      }
+  let s = Client.Aff.toDuplex stream
+  end s
+
+
+
+  sequential $ traverse_ parallel
+    [ do
+      -- 4. Receive a pushed stream.
+        {headersRequest, headersResponse} <- Client.Aff.waitPush session
+        liftEffect $ Console.log $ "CLIENT Request " <> headersShow headersRequest
+        liftEffect $ Console.log $ "CLIENT Response " <> headersShow headersResponse
+    , do
+      -- 3. Wait for the response.
+        headers <- Client.Aff.waitResponse stream
+        liftEffect $ Console.log $ "CLIENT " <> headersShow headers
+    ]
+
+
+  -- 6. Wait for the end of the session then close the connection.
+  -- Client.Aff.waitEnd stream
+  Client.Aff.close session
+
+
+
+
+
+
+
 
 -- https://letsencrypt.org/docs/certificates-for-localhost/#making-and-trusting-your-own-certificates
 --
@@ -88,6 +173,15 @@ testHttp2ClientAff = do
 --     openssl req -x509 -out localhost.crt -keyout localhost.key -newkey rsa:2048 -nodes -sha256 -days 3650 -subj '/CN=localhost' -extensions EXT -config <( printf "[dn]\nCN=localhost\n[req]\ndistinguished_name = dn\n[EXT]\nsubjectAltName=DNS:localhost\nkeyUsage=digitalSignature\nextendedKeyUsage=serverAuth")
 --
 
+headersShow :: Headers -> String
+headersShow headers = String.joinWith ", " $ headerKeys headers <#> \key ->
+  key <> ": " <>
+    ( fromMaybe "" $
+      (headerString headers key)
+      <|>
+      (String.joinWith " " <$> headerArray headers key)
+    )
+
 mockCert :: String
 mockCert =
   """-----BEGIN CERTIFICATE-----

test/Main.purs

@@ -17,6 +17,7 @@ import Node.HTTP.Secure as HTTPS
 import Node.Net.Socket as Socket
 import Node.Stream (Writable, end, pipe, writeString)
 import Partial.Unsafe (unsafeCrashWith)
+import Test.HTTP2 as HTTP2
 import Test.HTTP2Aff as HTTP2Aff
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -29,11 +30,13 @@ main = do
   -- testHttpsServer -- TODO this test prevents node event loop from exiting
   -- testHttps -- TODO this test prevents node event loop from exiting
   -- testCookies
-  -- HTTP2.testHttp2ServerSecure
-  -- HTTP2.testHttp2Client
   launchAff_ do
-    HTTP2Aff.testHttp2ServerSecureAff
-    HTTP2Aff.testHttp2ClientAff
+    HTTP2Aff.push1_serverSecure
+    HTTP2Aff.push1_client
+    HTTP2Aff.headers_serverSecure
+    HTTP2Aff.headers_client
+  -- HTTP2.basic_serverSecure
+  -- HTTP2.basic_client
 
 respond :: Request -> Response -> Effect Unit
 respond req res = do