diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 06ed895..c9b2d23 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -10,15 +10,16 @@ jobs: build: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - uses: purescript-contrib/setup-purescript@main with: purescript: "unstable" + purs-tidy: "latest" - - uses: actions/setup-node@v2 + - uses: actions/setup-node@v3 with: - node-version: "14" + node-version: "lts/*" - name: Install dependencies run: | @@ -33,3 +34,8 @@ jobs: run: | bower install npm run-script test --if-present + + - name: Check formatting + run: | + purs-tidy check src test + \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md index 16f234f..06e1e08 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ Notable changes to this project are documented in this file. The format is based Breaking changes: - Update node libraries to latest releases (#48 by @JordanMartinez) +- Reimplement `http`/`https` bindings (#49 by @JordanMartinez) New features: diff --git a/bower.json b/bower.json index 6853217..cbbfb4d 100644 --- a/bower.json +++ b/bower.json @@ -24,7 +24,8 @@ "purescript-node-buffer": "^9.0.0", "purescript-node-net": "^5.1.0", "purescript-node-streams": "^9.0.0", - "purescript-node-url": "^6.0.0", + "purescript-node-tls": "https://github.com/JordanMartinez/purescript-node-tls.git#^0.3.0", + "purescript-node-url": "^7.0.0", "purescript-nullable": "^6.0.0", "purescript-options": "^7.0.0", "purescript-prelude": "^6.0.0", diff --git a/src/Node/HTTP.js b/src/Node/HTTP.js index 85881a4..771392a 100644 --- a/src/Node/HTTP.js +++ b/src/Node/HTTP.js @@ -1,101 +1,20 @@ -import http from "http"; +import http from "node:http"; -export function createServer(handleRequest) { - return function () { - return http.createServer(function (req, res) { - handleRequest(req)(res)(); - }); - }; -} +export const createServer = () => http.createServer(); +export const createServerOptsImpl = (opts) => http.createServer(opts); -export function listenImpl(server) { - return function (port) { - return function (hostname) { - return function (backlog) { - return function (done) { - return function () { - if (backlog !== null) { - server.listen(port, hostname, backlog, done); - } else { - server.listen(port, hostname, done); - } - }; - }; - }; - }; - }; -} +export const maxHeaderSize = http.maxHeaderSize; -export function closeImpl(server) { - return function (done) { - return function () { - server.close(done); - }; - }; -} +export const requestStrImpl = (url) => http.request(url); +export const requestStrOptsImpl = (url, opts) => http.request(url, opts); +export const requestUrlImpl = (url) => http.request(url); +export const requestUrlOptsImpl = (url, opts) => http.request(url, opts); +export const requestOptsImpl = (opts) => http.request(opts); -export function listenSocket(server) { - return function (path) { - return function (done) { - return function () { - server.listen(path, done); - }; - }; - }; -} +export const getStrImpl = (url) => http.get(url); +export const getStrOptsImpl = (url, opts) => http.get(url, opts); +export const getUrlImpl = (url) => http.get(url); +export const getUrlOptsImpl = (url, opts) => http.get(url, opts); +export const getOptsImpl = (opts) => http.get(opts); -export function onConnect(server) { - return function (cb) { - return function () { - server.on("connect", function (req, socket, buffer) { - return cb(req)(socket)(buffer)(); - }); - }; - }; -} - -export function onUpgrade(server) { - return function (cb) { - return function () { - server.on("upgrade", function (req, socket, buffer) { - return cb(req)(socket)(buffer)(); - }); - }; - }; -} - -export function setHeader(res) { - return function (key) { - return function (value) { - return function () { - res.setHeader(key, value); - }; - }; - }; -} - -export function setHeaders(res) { - return function (key) { - return function (values) { - return function () { - res.setHeader(key, values); - }; - }; - }; -} - -export function setStatusCode(res) { - return function (code) { - return function () { - res.statusCode = code; - }; - }; -} - -export function setStatusMessage(res) { - return function (message) { - return function () { - res.statusMessage = message; - }; - }; -} +export const setMaxIdleHttpParsersImpl = (i) => http.setMaxIdleHTTPParsers(i); diff --git a/src/Node/HTTP.purs b/src/Node/HTTP.purs index d36d9c2..e500816 100644 --- a/src/Node/HTTP.purs +++ b/src/Node/HTTP.purs @@ -1,114 +1,198 @@ --- | This module defines low-level bindings to the Node HTTP module. - module Node.HTTP - ( Server - , Request - , Response - + ( CreateServerOptions , createServer - , listen - , close - , ListenOptions - , listenSocket - , onConnect - , onUpgrade - - , httpVersion - , requestHeaders - , requestMethod - , requestURL - , requestAsStream - - , setHeader - , setHeaders - , setStatusCode - , setStatusMessage - , responseAsStream + , createServer' + , maxHeaderSize + , request + , requestUrl + , RequestOptions + , request' + , requestURL' + , requestOpts + , get + , getUrl + , get' + , getUrl' + , getOpts + , setMaxIdleHttpParsers ) where import Prelude -import Data.Maybe (Maybe) -import Data.Nullable (Nullable, toNullable) +import Data.Time.Duration (Milliseconds) import Effect (Effect) +import Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn1, runEffectFn2) +import Foreign (Foreign) import Foreign.Object (Object) -import Node.Buffer (Buffer) -import Node.Net.Types (Socket, TCP) -import Node.Stream (Writable, Readable) -import Unsafe.Coerce (unsafeCoerce) - --- | The type of a HTTP server object -foreign import data Server :: Type - --- | A HTTP request object -foreign import data Request :: Type - --- | A HTTP response object -foreign import data Response :: Type - --- | Create a HTTP server, given a function to be executed when a request is received. -foreign import createServer :: (Request -> Response -> Effect Unit) -> Effect Server - -foreign import listenImpl :: Server -> Int -> String -> Nullable Int -> Effect Unit -> Effect Unit - -foreign import closeImpl :: Server -> Effect Unit -> Effect Unit - --- | Listen on a port in order to start accepting HTTP requests. The specified callback will be run when setup is complete. -listen :: Server -> ListenOptions -> Effect Unit -> Effect Unit -listen server opts done = listenImpl server opts.port opts.hostname (toNullable opts.backlog) done - --- | Close a listening HTTP server. The specified callback will be run the server closing is complete. -close :: Server -> Effect Unit -> Effect Unit -close server done = closeImpl server done - --- | Options to be supplied to `listen`. See the [Node API](https://nodejs.org/dist/latest-v6.x/docs/api/http.html#http_server_listen_handle_callback) for detailed information about these. -type ListenOptions = - { hostname :: String +import Node.HTTP.Types (ClientRequest, HttpServer) +import Node.Net.Types (ConnectTcpOptions) +import Node.Stream (Duplex) +import Node.URL (URL) +import Prim.Row as Row + +-- | - `connectionsCheckingInterval`: Sets the interval value in milliseconds to check for request and headers timeout in incomplete requests. Default: 30000. +-- | - `headersTimeout`: Sets the timeout value in milliseconds for receiving the complete HTTP headers from the client. See server.headersTimeout for more information. Default: 60000. +-- | - `highWaterMark` Optionally overrides all sockets' readableHighWaterMark and writableHighWaterMark. This affects highWaterMark property of both IncomingMessage and ServerResponse. Default: See stream.getDefaultHighWaterMark(). +-- | - `insecureHTTPParser` Use an insecure HTTP parser that accepts invalid HTTP headers when true. Using the insecure parser should be avoided. See --insecure-http-parser for more information. Default: false. +-- | - `keepAlive` If set to true, it enables keep-alive functionality on the socket immediately after a new incoming connection is received, similarly on what is done in [socket.setKeepAlive([enable][, initialDelay])][socket.setKeepAlive(enable, initialDelay)]. Default: false. +-- | - `keepAliveInitialDelay` If set to a positive number, it sets the initial delay before the first keepalive probe is sent on an idle socket. Default: 0. +-- | - `requestTimeout`: Sets the timeout value in milliseconds for receiving the entire request from the client. See server.requestTimeout for more information. Default: 300000. +-- | - `joinDuplicateHeaders` It joins the field line values of multiple headers in a request with , instead of discarding the duplicates. See message.headers for more information. Default: false. +-- | - `uniqueHeaders` A list of response headers that should be sent only once. If the header's value is an array, the items will be joined using ; . +type CreateServerOptions = + ( connectionsCheckingInterval :: Milliseconds + , headersTimeout :: Milliseconds + , highWaterMark :: Number + , insecureHTTPParser :: Boolean + , keepAlive :: Boolean + , keepAliveInitialDelay :: Milliseconds + , requestTimeout :: Milliseconds + , joinDuplicateHeaders :: Boolean + , uniqueHeaders :: Array String + ) + +foreign import createServer :: Effect (HttpServer) + +createServer' + :: forall r trash + . Row.Union r trash CreateServerOptions + => { | r } + -> Effect HttpServer +createServer' opts = runEffectFn1 createServerOptsImpl opts + +foreign import createServerOptsImpl :: forall r. EffectFn1 ({ | r }) (HttpServer) + +foreign import maxHeaderSize :: Int + +request :: String -> Effect ClientRequest +request url = runEffectFn1 requestStrImpl url + +foreign import requestStrImpl :: EffectFn1 (String) (ClientRequest) + +requestUrl :: URL -> Effect ClientRequest +requestUrl url = runEffectFn1 requestUrlImpl url + +foreign import requestUrlImpl :: EffectFn1 (URL) (ClientRequest) + +-- | - `auth` Basic authentication ('user:password') to compute an Authorization header. +-- | - `createConnection` A function that produces a socket/stream to use for the request when the agent option is not used. This can be used to avoid creating a custom Agent class just to override the default createConnection function. See agent.createConnection() for more details. Any Duplex stream is a valid return value. +-- | - `defaultPort` Default port for the protocol. Default: agent.defaultPort if an Agent is used, else undefined. +-- | - `family` IP address family to use when resolving host or hostname. Valid values are 4 or 6. When unspecified, both IP v4 and v6 will be used. +-- | - `headers` An object containing request headers. +-- | - `hints` Optional dns.lookup() hints. +-- | - `host` A domain name or IP address of the server to issue the request to. Default: 'localhost'. +-- | - `hostname` Alias for host. To support url.parse(), hostname will be used if both host and hostname are specified. +-- | - `insecureHTTPParser` Use an insecure HTTP parser that accepts invalid HTTP headers when true. Using the insecure parser should be avoided. See --insecure-http-parser for more information. Default: false +-- | - `localAddress` Local interface to bind for network connections. +-- | - `localPort` Local port to connect from. +-- | - `lookup` Custom lookup function. Default: dns.lookup(). +-- | - `maxHeaderSize` Optionally overrides the value of --max-http-header-size (the maximum length of response headers in bytes) for responses received from the server. Default: 16384 (16 KiB). +-- | - `method` A string specifying the HTTP request method. Default: 'GET'. +-- | - `path` Request path. Should include query string if any. E.G. '/index.html?page=12'. An exception is thrown when the request path contains illegal characters. Currently, only spaces are rejected but that may change in the future. Default: '/'. +-- | - `port` Port of remote server. Default: defaultPort if set, else 80. +-- | - `protocol` Protocol to use. Default: 'http:'. +-- | - `setHost` : Specifies whether or not to automatically add the Host header. Defaults to true. +-- | - `signal` : An AbortSignal that may be used to abort an ongoing request. +-- | - `socketPath` Unix domain socket. Cannot be used if one of host or port is specified, as those specify a TCP Socket. +-- | - `timeout` : A number specifying the socket timeout in milliseconds. This will set the timeout before the socket is connected. +-- | - `uniqueHeaders` A list of request headers that should be sent only once. If the header's value is an array, the items will be joined using ; . +-- | - `joinDuplicateHeaders` It joins the field line values of multiple headers in a request with , instead of discarding the duplicates. See message.headers for more information. Default: false. +type RequestOptions r = + ( auth :: String + , createConnection :: Effect Duplex + , defaultPort :: Int + , family :: Int + , headers :: Object Foreign + , hints :: Number + , host :: String + , hostname :: String + , insecureHTTPParser :: Boolean + , localAddress :: String + , localPort :: Int + , maxHeaderSize :: Number + , method :: String + , path :: String , port :: Int - , backlog :: Maybe Int - } - --- | Listen on a unix socket. The specified callback will be run when setup is complete. -foreign import listenSocket :: Server -> String -> Effect Unit -> Effect Unit - --- | Listen to `connect` events on the server -foreign import onConnect :: Server -> (Request -> Socket TCP -> Buffer -> Effect Unit) -> Effect Unit - --- | Listen to `upgrade` events on the server -foreign import onUpgrade :: Server -> (Request -> Socket TCP -> Buffer -> Effect Unit) -> Effect Unit - --- | Get the request HTTP version -httpVersion :: Request -> String -httpVersion = _.httpVersion <<< unsafeCoerce - --- | Get the request headers as a hash -requestHeaders :: Request -> Object String -requestHeaders = _.headers <<< unsafeCoerce - --- | Get the request method (GET, POST, etc.) -requestMethod :: Request -> String -requestMethod = _.method <<< unsafeCoerce - --- | Get the request URL -requestURL :: Request -> String -requestURL = _.url <<< unsafeCoerce - --- | Coerce the request object into a readable stream. -requestAsStream :: Request -> Readable () -requestAsStream = unsafeCoerce - --- | Set a header with a single value. -foreign import setHeader :: Response -> String -> String -> Effect Unit - --- | Set a header with multiple values. -foreign import setHeaders :: Response -> String -> Array String -> Effect Unit - --- | Set the status code. -foreign import setStatusCode :: Response -> Int -> Effect Unit - --- | Set the status message. -foreign import setStatusMessage :: Response -> String -> Effect Unit - --- | Coerce the response object into a writable stream. -responseAsStream :: Response -> Writable () -responseAsStream = unsafeCoerce + , protocol :: String + , setHost :: Boolean + , socketPath :: String + , timeout :: Milliseconds + , uniqueHeaders :: Array String + , joinDuplicateHeaders :: Boolean + | ConnectTcpOptions r + ) + +request' + :: forall r trash + . Row.Union r trash (RequestOptions ()) + => String + -> { | r } + -> Effect ClientRequest +request' url opts = runEffectFn2 requestStrOptsImpl url opts + +foreign import requestStrOptsImpl :: forall r. EffectFn2 (String) ({ | r }) (ClientRequest) + +requestURL' + :: forall r trash + . Row.Union r trash (RequestOptions ()) + => URL + -> { | r } + -> Effect ClientRequest +requestURL' url opts = runEffectFn2 requestUrlOptsImpl url opts + +foreign import requestUrlOptsImpl :: forall r. EffectFn2 (URL) ({ | r }) (ClientRequest) + +requestOpts + :: forall r trash + . Row.Union r trash (RequestOptions ()) + => { | r } + -> Effect ClientRequest +requestOpts opts = runEffectFn1 requestOptsImpl opts + +foreign import requestOptsImpl :: forall r. EffectFn1 ({ | r }) (ClientRequest) + +get :: String -> Effect ClientRequest +get url = runEffectFn1 getStrImpl url + +foreign import getStrImpl :: EffectFn1 (String) (ClientRequest) + +getUrl :: URL -> Effect ClientRequest +getUrl url = runEffectFn1 getUrlImpl url + +foreign import getUrlImpl :: EffectFn1 (URL) (ClientRequest) + +get' + :: forall r trash + . Row.Union r trash (RequestOptions ()) + => Row.Lacks "method" r + => String + -> { | r } + -> Effect ClientRequest +get' url opts = runEffectFn2 getStrOptsImpl url opts + +foreign import getStrOptsImpl :: forall r. EffectFn2 (String) ({ | r }) (ClientRequest) + +getUrl' + :: forall r trash + . Row.Union r trash (RequestOptions ()) + => Row.Lacks "method" r + => URL + -> { | r } + -> Effect ClientRequest +getUrl' url opts = runEffectFn2 getUrlOptsImpl url opts + +foreign import getUrlOptsImpl :: forall r. EffectFn2 (URL) ({ | r }) (ClientRequest) + +getOpts + :: forall r trash + . Row.Union r trash (RequestOptions ()) + => { | r } + -> Effect ClientRequest +getOpts opts = runEffectFn1 getOptsImpl opts + +foreign import getOptsImpl :: forall r. EffectFn1 ({ | r }) (ClientRequest) + +setMaxIdleHttpParsers :: Int -> Effect Unit +setMaxIdleHttpParsers i = runEffectFn1 setMaxIdleHttpParsersImpl i + +foreign import setMaxIdleHttpParsersImpl :: EffectFn1 (Int) (Unit) diff --git a/src/Node/HTTP/Client.js b/src/Node/HTTP/Client.js deleted file mode 100644 index 5aba645..0000000 --- a/src/Node/HTTP/Client.js +++ /dev/null @@ -1,23 +0,0 @@ -import http from "http"; -import https from "https"; - -export function requestImpl(opts) { - return function (k) { - return function () { - var lib = opts.protocol === "https:" ? https : http; - return lib.request(opts, function (res) { - k(res)(); - }); - }; - }; -} - -export function setTimeout(r) { - return function (ms) { - return function (k) { - return function () { - r.setTimeout(ms, k); - }; - }; - }; -} diff --git a/src/Node/HTTP/Client.purs b/src/Node/HTTP/Client.purs deleted file mode 100644 index 8b35f88..0000000 --- a/src/Node/HTTP/Client.purs +++ /dev/null @@ -1,153 +0,0 @@ --- | This module defines low-level bindings to the Node HTTP client. - -module Node.HTTP.Client - ( Request - , Response - , RequestHeaders(..) - , RequestOptions - , RequestFamily(..) - , protocol - , hostname - , port - , method - , path - , headers - , auth - , key - , cert - , rejectUnauthorized - , family - , request - , requestFromURI - , requestAsStream - , responseAsStream - , setTimeout - , httpVersion - , responseHeaders - , responseCookies - , statusCode - , statusMessage - ) where - -import Prelude - -import Data.Functor.Contravariant ((>$<)) -import Data.Maybe (Maybe) -import Data.Options (Option, Options, opt, options) -import Effect (Effect) -import Foreign (Foreign, unsafeToForeign) -import Foreign.Object (Object) -import Foreign.Object as Object -import Node.Stream (Readable, Writable) -import Node.URL as URL -import Unsafe.Coerce (unsafeCoerce) - --- | A HTTP request object -foreign import data Request :: Type - --- | A HTTP response object -foreign import data Response :: Type - --- | A HTTP request object -newtype RequestHeaders = RequestHeaders (Object String) - --- | The type of HTTP request options -data RequestOptions - --- | Values for the `family` request option -data RequestFamily = IPV4 | IPV6 - --- | The protocol to use -protocol :: Option RequestOptions String -protocol = opt "protocol" - --- | Domain name or IP -hostname :: Option RequestOptions String -hostname = opt "hostname" - --- | Port of remote server -port :: Option RequestOptions Int -port = opt "port" - --- | The HTTP request method: GET, POST, etc. -method :: Option RequestOptions String -method = opt "method" - --- | The request path, including query string if appropriate. -path :: Option RequestOptions String -path = opt "path" - -headers :: Option RequestOptions RequestHeaders -headers = opt "headers" - --- | Basic authentication -auth :: Option RequestOptions String -auth = opt "auth" - --- | Private Key -key :: Option RequestOptions String -key = opt "key" - --- | Public x509 certificate -cert :: Option RequestOptions String -cert = opt "cert" - --- | Is cert verified against CAs -rejectUnauthorized :: Option RequestOptions Boolean -rejectUnauthorized = opt "rejectUnauthorized" - --- | IP address family to use when resolving `hostname`. --- | Valid values are `IPV6` and `IPV4` -family :: Option RequestOptions RequestFamily -family = familyToOption >$< opt "family" - --- | Translates RequestFamily values to Int parameters for Request -familyToOption :: RequestFamily -> Int -familyToOption IPV4 = 4 -familyToOption IPV6 = 6 - --- | Make a HTTP request using the specified options and response callback. -foreign import requestImpl :: Foreign -> (Response -> Effect Unit) -> Effect Request - --- | Make a HTTP request using the specified options and response callback. -request :: Options RequestOptions -> (Response -> Effect Unit) -> Effect Request -request = requestImpl <<< options - --- | Make a HTTP request from a URI string and response callback. -requestFromURI :: String -> (Response -> Effect Unit) -> Effect Request -requestFromURI = requestImpl <<< unsafeToForeign <<< URL.parse - --- | Create a writable stream from a request object. -requestAsStream :: forall r. Request -> Writable r -requestAsStream = unsafeCoerce - --- | Create a readable stream from a response object. -responseAsStream :: forall w. Response -> Readable w -responseAsStream = unsafeCoerce - --- | Set the socket timeout for a `Request` -foreign import setTimeout :: Request -> Int -> Effect Unit -> Effect Unit - --- | Get the request HTTP version -httpVersion :: Response -> String -httpVersion = _.httpVersion <<< unsafeCoerce - -headers' :: forall a. Response -> Object a -headers' = _.headers <<< unsafeCoerce - --- | Get the response headers as a hash --- | Cookies are not included and could be retrieved with responseCookies -responseHeaders :: Response -> Object String -responseHeaders res = Object.delete "set-cookie" $ headers' res - --- | Get the response cookies as Just (Array String) or Nothing if no cookies -responseCookies :: Response -> Maybe (Array String) -responseCookies res = Object.lookup "set-cookie" $ headers' res - --- | Get the response status code -statusCode :: Response -> Int -statusCode = _.statusCode <<< unsafeCoerce - --- | Get the response status message -statusMessage :: Response -> String -statusMessage = _.statusMessage <<< unsafeCoerce diff --git a/src/Node/HTTP/ClientRequest.js b/src/Node/HTTP/ClientRequest.js new file mode 100644 index 0000000..e17e049 --- /dev/null +++ b/src/Node/HTTP/ClientRequest.js @@ -0,0 +1,8 @@ +export const path = (cr) => cr.path; +export const method = (cr) => cr.method; +export const host = (cr) => cr.host; +export const protocol = (cr) => cr.protocol; +export const reusedSocket = (cr) => cr.reusedSocket; +export const setNoDelayImpl = (d, cr) => cr.setNoDelay(d); +export const setSocketKeepAliveImpl = (b, ms, cr) => cr.setSocketKeepAlive(b, ms); +export const setTimeoutImpl = (ms, cr) => cr.setTimeout(ms); diff --git a/src/Node/HTTP/ClientRequest.purs b/src/Node/HTTP/ClientRequest.purs new file mode 100644 index 0000000..4831611 --- /dev/null +++ b/src/Node/HTTP/ClientRequest.purs @@ -0,0 +1,91 @@ +module Node.HTTP.ClientRequest + ( toOutgoingMessage + , connectH + , continueH + , finishH + , informationH + , responseH + , socketH + , timeoutH + , upgradeH + , path + , method + , host + , protocol + , reusedSocket + , setNoDelay + , setSocketKeepAlive + , setTimeout + ) where + +import Prelude + +import Data.Time.Duration (Milliseconds) +import Effect (Effect) +import Effect.Uncurried (EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn3, runEffectFn2, runEffectFn3) +import Foreign (Foreign) +import Foreign.Object (Object) +import Node.Buffer (Buffer) +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter.UtilTypes (EventHandle0, EventHandle3, EventHandle1) +import Node.HTTP.Types (ClientRequest, IMClientRequest, IncomingMessage, OutgoingMessage) +import Node.Stream (Duplex) +import Unsafe.Coerce (unsafeCoerce) + +toOutgoingMessage :: ClientRequest -> OutgoingMessage +toOutgoingMessage = unsafeCoerce + +connectH :: EventHandle3 ClientRequest (IncomingMessage IMClientRequest) Duplex Buffer +connectH = EventHandle "connect" \cb -> mkEffectFn3 \a b c -> cb a b c + +continueH :: EventHandle0 ClientRequest +continueH = EventHandle "continue" identity + +finishH :: EventHandle0 ClientRequest +finishH = EventHandle "finish" identity + +informationH + :: EventHandle1 ClientRequest + { httpVersion :: String + , httpVersionMajor :: Int + , httpVersionMinor :: Int + , statusCode :: Int + , statusMessage :: String + , headers :: Object Foreign + , rawHeaders :: Array String + } +informationH = EventHandle "information" mkEffectFn1 + +responseH :: EventHandle1 ClientRequest (IncomingMessage IMClientRequest) +responseH = EventHandle "response" mkEffectFn1 + +socketH :: EventHandle1 ClientRequest Duplex +socketH = EventHandle "socket" mkEffectFn1 + +timeoutH :: EventHandle0 ClientRequest +timeoutH = EventHandle "timeout" identity + +upgradeH :: EventHandle3 ClientRequest (IncomingMessage IMClientRequest) Duplex Buffer +upgradeH = EventHandle "upgrade" \cb -> mkEffectFn3 \a b c -> cb a b c + +foreign import path :: ClientRequest -> String +foreign import method :: ClientRequest -> String +foreign import host :: ClientRequest -> String +foreign import protocol :: ClientRequest -> String +foreign import reusedSocket :: ClientRequest -> Boolean + +setNoDelay :: Boolean -> ClientRequest -> Effect Unit +setNoDelay d cr = runEffectFn2 setNoDelayImpl d cr + +foreign import setNoDelayImpl :: EffectFn2 (Boolean) (ClientRequest) (Unit) + +setSocketKeepAlive :: Boolean -> Milliseconds -> ClientRequest -> Effect Unit +setSocketKeepAlive d ms cr = runEffectFn3 setSocketKeepAliveImpl d ms cr + +foreign import setSocketKeepAliveImpl :: EffectFn3 (Boolean) (Milliseconds) (ClientRequest) (Unit) + +setTimeout :: Milliseconds -> ClientRequest -> Effect Unit +setTimeout ms cr = runEffectFn2 setTimeoutImpl ms cr + +foreign import setTimeoutImpl :: EffectFn2 (Milliseconds) (ClientRequest) (Unit) + diff --git a/src/Node/HTTP/IncomingMessage.js b/src/Node/HTTP/IncomingMessage.js new file mode 100644 index 0000000..369abca --- /dev/null +++ b/src/Node/HTTP/IncomingMessage.js @@ -0,0 +1,13 @@ +export const completeImpl = (im) => im.complete; +export const headersImpl = (im) => im.headers; +export const headersDistinct = (im) => im.headersDistinct; +export const httpVersion = (im) => im.httpVersion; +export const method = (im) => im.method; +export const rawHeaders = (im) => im.rawHeaders; +export const rawTrailersImpl = (im) => im.rawTrailers; +export const socketImpl = (im) => im.socket; +export const statusCode = (im) => im.statusCode; +export const statusMessage = (im) => im.statusMessage; +export const trailersImpl = (im) => im.trailers; +export const trailersDistinctImpl = (im) => im.trailersDistinct; +export const url = (im) => im.url; diff --git a/src/Node/HTTP/IncomingMessage.purs b/src/Node/HTTP/IncomingMessage.purs new file mode 100644 index 0000000..9886cf3 --- /dev/null +++ b/src/Node/HTTP/IncomingMessage.purs @@ -0,0 +1,88 @@ +module Node.HTTP.IncomingMessage + ( toReadable + , closeH + , complete + , headers + , cookies + , headersDistinct + , httpVersion + , method + , rawHeaders + , rawTrailers + , socket + , statusCode + , statusMessage + , trailers + , trailersDistinct + , url + ) where + +import Prelude + +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Maybe (Maybe) +import Data.Nullable (Nullable, toMaybe) +import Effect (Effect) +import Effect.Uncurried (EffectFn1, runEffectFn1) +import Foreign (Foreign) +import Foreign.Object (Object) +import Foreign.Object as Object +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter.UtilTypes (EventHandle0) +import Node.HTTP.Types (IMClientRequest, IMServer, IncomingMessage) +import Node.Stream (Readable, Duplex) +import Unsafe.Coerce (unsafeCoerce) + +toReadable :: forall messageType. IncomingMessage messageType -> Readable () +toReadable = unsafeCoerce + +closeH :: forall messageType. EventHandle0 (IncomingMessage messageType) +closeH = EventHandle "close" identity + +complete :: forall messageType. IncomingMessage messageType -> Effect Boolean +complete im = runEffectFn1 completeImpl im + +foreign import completeImpl :: forall messageType. EffectFn1 (IncomingMessage messageType) (Boolean) + +headers :: forall messageType. IncomingMessage messageType -> Object String +headers = Object.delete "set-cookie" <<< headersImpl + +cookies :: forall messageType. IncomingMessage messageType -> Maybe (Array String) +cookies = Object.lookup "set-cookie" <<< headersImpl + +foreign import headersImpl :: forall messageType a. IncomingMessage messageType -> Object a + +foreign import headersDistinct :: forall messageType. IncomingMessage messageType -> Object (NonEmptyArray String) + +foreign import httpVersion :: forall messageType. IncomingMessage messageType -> String + +foreign import method :: IncomingMessage IMServer -> String + +foreign import rawHeaders :: forall messageType. IncomingMessage messageType -> Array String + +rawTrailers :: forall messageType. IncomingMessage messageType -> Maybe (Array String) +rawTrailers im = toMaybe $ rawTrailersImpl im + +foreign import rawTrailersImpl :: forall messageType. IncomingMessage messageType -> (Nullable (Array String)) + +socket :: forall messageType. IncomingMessage messageType -> Effect (Maybe Duplex) +socket im = map toMaybe $ runEffectFn1 socketImpl im + +foreign import socketImpl :: forall messageType. EffectFn1 (IncomingMessage messageType) (Nullable Duplex) + +foreign import statusCode :: IncomingMessage IMClientRequest -> Int + +foreign import statusMessage :: IncomingMessage IMClientRequest -> String + +trailers :: forall messageType. IncomingMessage messageType -> Effect (Maybe (Object Foreign)) +trailers im = map toMaybe $ runEffectFn1 trailersImpl im + +foreign import trailersImpl :: forall messageType. EffectFn1 (IncomingMessage messageType) (Nullable (Object Foreign)) + +trailersDistinct :: forall messageType. IncomingMessage messageType -> Effect (Maybe (Object (NonEmptyArray String))) +trailersDistinct im = map toMaybe $ runEffectFn1 trailersDistinctImpl im + +foreign import trailersDistinctImpl :: forall messageType. EffectFn1 (IncomingMessage messageType) (Nullable (Object (NonEmptyArray String))) + +foreign import url :: IncomingMessage IMServer -> String + diff --git a/src/Node/HTTP/OutgoingMessage.js b/src/Node/HTTP/OutgoingMessage.js new file mode 100644 index 0000000..4119406 --- /dev/null +++ b/src/Node/HTTP/OutgoingMessage.js @@ -0,0 +1,14 @@ +export const addTrailersImpl = (trailers, om) => om.addTrailers(trailers); +export const appendHeaderImpl = (name, value, om) => om.appendHeader(name, value); +export const appendHeadersImpl = (name, values, om) => om.appendHeaders(name, values); +export const flushHeadersImpl = (om) => om.flushHeaders(); +export const getHeaderImpl = (name, om) => om.getHeader(name); +export const getHeaderNamesImpl = (name, om) => om.getHeaderNames(name); +export const getHeadersImpl = (om) => om.getHeaders(); +export const hasHeaderImpl = (name, msg) => msg.hasHeader(name); +export const headersSentImpl = (om) => om.headersSent(); +export const removeHeaderImpl = (name, om) => om.removeHeader(name); +export const setHeaderImpl = (name, value, om) => om.setHeader(name, value); +export const setHeaderArrImpl = (name, value, om) => om.setHeader(name, value); +export const setTimeoutImpl = (msecs, om) => om.setTimeout(msecs); +export const socketImpl = (om) => om.socket; diff --git a/src/Node/HTTP/OutgoingMessage.purs b/src/Node/HTTP/OutgoingMessage.purs new file mode 100644 index 0000000..c477c1a --- /dev/null +++ b/src/Node/HTTP/OutgoingMessage.purs @@ -0,0 +1,117 @@ +module Node.HTTP.OutgoingMessage + ( toWriteable + , drainH + , finishH + , prefinishH + , addTrailers + , appendHeader + , appendHeaders + , flushHeaders + , getHeader + , getHeaderNames + , getHeaders + , hasHeader + , headersSent + , removeHeader + , setHeader + , setHeader' + , setTimeout + , socket + ) where + +import Prelude + +import Data.Maybe (Maybe) +import Data.Nullable (Nullable, toMaybe) +import Data.Time.Duration (Milliseconds) +import Effect (Effect) +import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, runEffectFn1, runEffectFn2, runEffectFn3) +import Foreign (Foreign) +import Foreign.Object (Object) +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter.UtilTypes (EventHandle0) +import Node.HTTP.Types (OutgoingMessage) +import Node.Stream (Writable) +import Unsafe.Coerce (unsafeCoerce) + +toWriteable :: OutgoingMessage -> Writable () +toWriteable = unsafeCoerce + +drainH :: EventHandle0 OutgoingMessage +drainH = EventHandle "drain" identity + +finishH :: EventHandle0 OutgoingMessage +finishH = EventHandle "finish" identity + +prefinishH :: EventHandle0 OutgoingMessage +prefinishH = EventHandle "prefinish" identity + +addTrailers :: Object String -> OutgoingMessage -> Effect Unit +addTrailers trailers msg = runEffectFn2 addTrailersImpl trailers msg + +foreign import addTrailersImpl :: EffectFn2 (Object String) (OutgoingMessage) (Unit) + +appendHeader :: String -> String -> OutgoingMessage -> Effect Unit +appendHeader name value msg = runEffectFn3 appendHeaderImpl name value msg + +foreign import appendHeaderImpl :: EffectFn3 (String) (String) (OutgoingMessage) (Unit) + +appendHeaders :: String -> Array String -> OutgoingMessage -> Effect Unit +appendHeaders name values msg = runEffectFn3 appendHeadersImpl name values msg + +foreign import appendHeadersImpl :: EffectFn3 (String) (Array String) (OutgoingMessage) (Unit) + +flushHeaders :: OutgoingMessage -> Effect Unit +flushHeaders msg = runEffectFn1 flushHeadersImpl msg + +foreign import flushHeadersImpl :: EffectFn1 (OutgoingMessage) (Unit) + +getHeader :: String -> OutgoingMessage -> Effect (Maybe String) +getHeader name msg = map toMaybe $ runEffectFn2 getHeaderImpl name msg + +foreign import getHeaderImpl :: EffectFn2 (String) (OutgoingMessage) (Nullable String) + +getHeaderNames :: String -> OutgoingMessage -> Effect (Array String) +getHeaderNames name msg = runEffectFn2 getHeaderNamesImpl name msg + +foreign import getHeaderNamesImpl :: EffectFn2 (String) (OutgoingMessage) ((Array String)) + +getHeaders :: OutgoingMessage -> Effect (Object Foreign) +getHeaders msg = runEffectFn1 getHeadersImpl msg + +foreign import getHeadersImpl :: EffectFn1 (OutgoingMessage) (Object Foreign) + +hasHeader :: String -> OutgoingMessage -> Effect Boolean +hasHeader name msg = runEffectFn2 hasHeaderImpl name msg + +foreign import hasHeaderImpl :: EffectFn2 (String) (OutgoingMessage) (Boolean) + +headersSent :: OutgoingMessage -> Effect Boolean +headersSent msg = runEffectFn1 headersSentImpl msg + +foreign import headersSentImpl :: EffectFn1 (OutgoingMessage) (Boolean) + +removeHeader :: String -> OutgoingMessage -> Effect Unit +removeHeader name msg = runEffectFn2 removeHeaderImpl name msg + +foreign import removeHeaderImpl :: EffectFn2 (String) (OutgoingMessage) (Unit) + +setHeader :: String -> String -> OutgoingMessage -> Effect Unit +setHeader name value msg = runEffectFn3 setHeaderImpl name value msg + +foreign import setHeaderImpl :: EffectFn3 (String) (String) (OutgoingMessage) (Unit) + +setHeader' :: String -> Array String -> OutgoingMessage -> Effect Unit +setHeader' name value msg = runEffectFn3 setHeaderArrImpl name value msg + +foreign import setHeaderArrImpl :: EffectFn3 (String) (Array String) (OutgoingMessage) (Unit) + +setTimeout :: Milliseconds -> OutgoingMessage -> Effect Unit +setTimeout msecs msg = runEffectFn2 setTimeoutImpl msecs msg + +foreign import setTimeoutImpl :: EffectFn2 (Milliseconds) (OutgoingMessage) (Unit) + +socket :: OutgoingMessage -> Effect (Maybe (Writable ())) +socket msg = map toMaybe $ runEffectFn1 socketImpl msg + +foreign import socketImpl :: EffectFn1 (OutgoingMessage) (Nullable (Writable ())) diff --git a/src/Node/HTTP/Secure.js b/src/Node/HTTP/Secure.js deleted file mode 100644 index 1814fd7..0000000 --- a/src/Node/HTTP/Secure.js +++ /dev/null @@ -1,11 +0,0 @@ -import https from "https"; - -export function createServerImpl(options) { - return function (handleRequest) { - return function () { - return https.createServer(options, function (req, res) { - handleRequest(req)(res)(); - }); - }; - }; -} diff --git a/src/Node/HTTP/Secure.purs b/src/Node/HTTP/Secure.purs deleted file mode 100644 index 28bde54..0000000 --- a/src/Node/HTTP/Secure.purs +++ /dev/null @@ -1,313 +0,0 @@ --- | This module defines low-level bindings to the Node HTTPS module. - -module Node.HTTP.Secure - ( createServer - - , SSLOptions - , handshakeTimeout - , requestCert - , rejectUnauthorized - - , NPNProtocols - , npnProtocolsString - , npnProtocolsBuffer - , npnProtocolsUint8Array - , npnProtocolsStringArray - , npnProtocolsBufferArray - , npnProtocolsUint8ArrayArray - , npnProtocols - - , ALPNProtocols - , alpnProtocolsString - , alpnProtocolsBuffer - , alpnProtocolsUint8Array - , alpnProtocolsStringArray - , alpnProtocolsBufferArray - , alpnProtocolsUint8ArrayArray - , alpnProtocols - - , sessionTimeout - , ticketKeys - - , PFX - , pfxString - , pfxBuffer - , pfx - - , Key - , keyString - , keyBuffer - , keyStringArray - , keyBufferArray - , key - - , passphrase - - , Cert - , certString - , certBuffer - , certStringArray - , certBufferArray - , cert - - , CA - , caString - , caBuffer - , caStringArray - , caBufferArray - , ca - - , CRL - , crlString - , crlBuffer - , crlStringArray - , crlBufferArray - , crl - - , ciphers - , honorCipherOrder - , ecdhCurve - - , DHParam - , dhparamString - , dhparamBuffer - , dhparam - - , secureProtocol - , secureOptions - , sessionIdContext - ) where - -import Prelude - -import Data.ArrayBuffer.Types (Uint8Array) -import Data.Options (Options, Option, options, opt) -import Effect (Effect) -import Foreign (Foreign) -import Node.Buffer (Buffer) -import Node.HTTP (Server, Request, Response) -import Unsafe.Coerce (unsafeCoerce) - --- | Create an HTTPS server, given the SSL options and a function to be executed --- | when a request is received. -foreign import createServerImpl - :: Foreign - -> (Request -> Response -> Effect Unit) - -> Effect Server - --- | Create an HTTPS server, given the SSL options and a function to be executed --- | when a request is received. -createServer - :: Options SSLOptions - -> (Request -> Response -> Effect Unit) - -> Effect Server -createServer = createServerImpl <<< options - --- | The type of HTTPS server options -data SSLOptions - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -handshakeTimeout :: Option SSLOptions Int -handshakeTimeout = opt "handshakeTimeout" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -requestCert :: Option SSLOptions Boolean -requestCert = opt "requestCert" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -rejectUnauthorized :: Option SSLOptions Boolean -rejectUnauthorized = opt "rejectUnauthorized" - --- | The npnProtocols option can be a String, a Buffer, a Uint8Array, or an --- | array of any of those types. -data NPNProtocols - -npnProtocolsString :: String -> NPNProtocols -npnProtocolsString = unsafeCoerce - -npnProtocolsBuffer :: Buffer -> NPNProtocols -npnProtocolsBuffer = unsafeCoerce - -npnProtocolsUint8Array :: Uint8Array -> NPNProtocols -npnProtocolsUint8Array = unsafeCoerce - -npnProtocolsStringArray :: Array String -> NPNProtocols -npnProtocolsStringArray = unsafeCoerce - -npnProtocolsBufferArray :: Array Buffer -> NPNProtocols -npnProtocolsBufferArray = unsafeCoerce - -npnProtocolsUint8ArrayArray :: Array Uint8Array -> NPNProtocols -npnProtocolsUint8ArrayArray = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -npnProtocols :: Option SSLOptions NPNProtocols -npnProtocols = opt "NPNProtocols" - --- | The alpnProtocols option can be a String, a Buffer, a Uint8Array, or an --- | array of any of those types. -data ALPNProtocols - -alpnProtocolsString :: String -> ALPNProtocols -alpnProtocolsString = unsafeCoerce - -alpnProtocolsBuffer :: Buffer -> ALPNProtocols -alpnProtocolsBuffer = unsafeCoerce - -alpnProtocolsUint8Array :: Uint8Array -> ALPNProtocols -alpnProtocolsUint8Array = unsafeCoerce - -alpnProtocolsStringArray :: Array String -> ALPNProtocols -alpnProtocolsStringArray = unsafeCoerce - -alpnProtocolsBufferArray :: Array Buffer -> ALPNProtocols -alpnProtocolsBufferArray = unsafeCoerce - -alpnProtocolsUint8ArrayArray :: Array Uint8Array -> ALPNProtocols -alpnProtocolsUint8ArrayArray = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -alpnProtocols :: Option SSLOptions ALPNProtocols -alpnProtocols = opt "ALPNProtocols" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -sessionTimeout :: Option SSLOptions Int -sessionTimeout = opt "sessionTimeout" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createserver_options_secureconnectionlistener) -ticketKeys :: Option SSLOptions Buffer -ticketKeys = opt "ticketKeys" - --- | The PFX option can take either a String or a Buffer -data PFX - -pfxString :: String -> PFX -pfxString = unsafeCoerce - -pfxBuffer :: Buffer -> PFX -pfxBuffer = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -pfx :: Option SSLOptions PFX -pfx = opt "pfx" - --- | The key option can be a String, a Buffer, an array of strings, or an array --- | of buffers. -data Key - -keyString :: String -> Key -keyString = unsafeCoerce - -keyBuffer :: Buffer -> Key -keyBuffer = unsafeCoerce - -keyStringArray :: Array String -> Key -keyStringArray = unsafeCoerce - -keyBufferArray :: Array Buffer -> Key -keyBufferArray = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -key :: Option SSLOptions Key -key = opt "key" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -passphrase :: Option SSLOptions String -passphrase = opt "passphrase" - --- | The cert option can be a String, a Buffer, an array of strings, or an array --- | of buffers. -data Cert - -certString :: String -> Cert -certString = unsafeCoerce - -certBuffer :: Buffer -> Cert -certBuffer = unsafeCoerce - -certStringArray :: Array String -> Cert -certStringArray = unsafeCoerce - -certBufferArray :: Array Buffer -> Cert -certBufferArray = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -cert :: Option SSLOptions Cert -cert = opt "cert" - --- | The CA option can be a String, a Buffer, an array of strings, or an array --- | of buffers. -data CA - -caString :: String -> CA -caString = unsafeCoerce - -caBuffer :: Buffer -> CA -caBuffer = unsafeCoerce - -caStringArray :: Array String -> CA -caStringArray = unsafeCoerce - -caBufferArray :: Array Buffer -> CA -caBufferArray = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -ca :: Option SSLOptions CA -ca = opt "ca" - --- | The CRL option can be a String, a Buffer, an array of strings, or an array --- | of buffers. -data CRL - -crlString :: String -> CRL -crlString = unsafeCoerce - -crlBuffer :: Buffer -> CRL -crlBuffer = unsafeCoerce - -crlStringArray :: Array String -> CRL -crlStringArray = unsafeCoerce - -crlBufferArray :: Array Buffer -> CRL -crlBufferArray = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -crl :: Option SSLOptions CRL -crl = opt "crl" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -ciphers :: Option SSLOptions String -ciphers = opt "ciphers" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -honorCipherOrder :: Option SSLOptions Boolean -honorCipherOrder = opt "honorCipherOrder" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -ecdhCurve :: Option SSLOptions String -ecdhCurve = opt "ecdhCurve" - --- | The DHParam option can take either a String or a Buffer -data DHParam - -dhparamString :: String -> DHParam -dhparamString = unsafeCoerce - -dhparamBuffer :: Buffer -> DHParam -dhparamBuffer = unsafeCoerce - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -dhparam :: Option SSLOptions DHParam -dhparam = opt "dhparam" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -secureProtocol :: Option SSLOptions String -secureProtocol = opt "secureProtocol" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -secureOptions :: Option SSLOptions Int -secureOptions = opt "secureOptions" - --- | See the [node docs](https://nodejs.org/api/tls.html#tls_tls_createsecurecontext_options) -sessionIdContext :: Option SSLOptions String -sessionIdContext = opt "sessionIdContext" diff --git a/src/Node/HTTP/Server.js b/src/Node/HTTP/Server.js new file mode 100644 index 0000000..2191bd5 --- /dev/null +++ b/src/Node/HTTP/Server.js @@ -0,0 +1,30 @@ +export const bytesParsed = (e) => e.bytesParsed; +export const rawPacket = (e) => e.rawPacket; + +export const closeAllConnectionsImpl = (hs) => hs.closeAllConnections(); +export const closeIdleConnectionsImpl = (hs) => hs.closeIdleConnections(); +export const headersTimeoutImpl = (hs) => hs.headersTimeout; +export const setHeadersTimeoutImpl = (tm, hs) => { + hs.headersTimeout = tm; +}; + +export const maxHeadersCountImpl = (hs) => hs.maxHeadersCount; +export const setMaxHeadersCountImpl = (c, hs) => { + hs.maxHeadersCount = c; +}; +export const requestTimeoutImpl = (hs) => hs.requestTimeout; +export const setRequestTimeoutImpl = (tm, hs) => { + hs.requestTimeout = tm; +}; +export const maxRequestsPerSocketImpl = (hs) => hs.maxRequestsPerSocket; +export const setMaxRequestsPerSocketImpl = (c, hs) => { + hs.maxRequestsPerSocket = c; +}; +export const timeoutImpl = (hs) => hs.timeout; +export const setTimeoutImpl = (c, hs) => { + hs.timeout = c; +}; +export const keepAliveTimeoutImpl = (hs) => hs.keepAliveTimeout; +export const setKeepAliveTimeoutImpl = (tm, hs) => { + hs.keepAliveTimeout = tm; +}; diff --git a/src/Node/HTTP/Server.purs b/src/Node/HTTP/Server.purs new file mode 100644 index 0000000..14f597c --- /dev/null +++ b/src/Node/HTTP/Server.purs @@ -0,0 +1,174 @@ +module Node.HTTP.Server + ( toTlsServer + , toNetServer + , checkContinueH + , checkExpectationH + , ClientErrorException + , toError + , bytesParsed + , rawPacket + , clientErrorH + , closeH + , connectH + , connectionH + , dropRequestH + , requestH + , upgradeH + , closeAllConnections + , closeIdleConnections + , headersTimeout + , setHeadersTimeout + , maxHeadersCount + , setMaxHeadersCount + , setUnlimitedHeadersCount + , requestTimeout + , setRequestTimeout + , maxRequestsPerSocket + , setMaxRequestsPerSocket + , setUnlimitedRequestsPerSocket + , timeout + , setTimeout + , clearTimeout + , keepAliveTimeout + , setKeepAliveTimeout + , clearKeepAliveTimeout + ) where + +import Prelude + +import Data.Time.Duration (Milliseconds(..)) +import Effect (Effect) +import Effect.Exception (Error) +import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, mkEffectFn2, mkEffectFn3, runEffectFn1, runEffectFn2) +import Foreign (Foreign) +import Node.Buffer (Buffer) +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter.UtilTypes (EventHandle0, EventHandle2, EventHandle3, EventHandle1) +import Node.HTTP.Types (Encrypted, HttpServer', IMServer, IncomingMessage, ServerResponse) +import Node.Net.Types (Server, TCP) +import Node.Stream (Duplex) +import Node.TLS.Types (TlsServer) +import Unsafe.Coerce (unsafeCoerce) + +toTlsServer :: HttpServer' Encrypted -> TlsServer +toTlsServer = unsafeCoerce + +toNetServer :: forall transmissionType. (HttpServer' transmissionType) -> Server TCP +toNetServer = unsafeCoerce + +checkContinueH :: forall transmissionType. EventHandle2 (HttpServer' transmissionType) (IncomingMessage IMServer) ServerResponse +checkContinueH = EventHandle "checkContinue" \cb -> mkEffectFn2 \a b -> cb a b + +checkExpectationH :: forall transmissionType. EventHandle2 (HttpServer' transmissionType) (IncomingMessage IMServer) ServerResponse +checkExpectationH = EventHandle "checkExpectation" \cb -> mkEffectFn2 \a b -> cb a b + +newtype ClientErrorException = ClientErrorException Error + +toError :: ClientErrorException -> Error +toError (ClientErrorException e) = e + +foreign import bytesParsed :: ClientErrorException -> Int +foreign import rawPacket :: ClientErrorException -> Foreign + +clientErrorH :: forall transmissionType. EventHandle2 (HttpServer' transmissionType) ClientErrorException Duplex +clientErrorH = EventHandle "clientError" \cb -> mkEffectFn2 \a b -> cb a b + +closeH :: forall transmissionType. EventHandle0 (HttpServer' transmissionType) +closeH = EventHandle "close" identity + +connectH :: forall transmissionType. EventHandle3 (HttpServer' transmissionType) (IncomingMessage IMServer) Duplex Buffer +connectH = EventHandle "connect" \cb -> mkEffectFn3 \a b c -> cb a b c + +connectionH :: forall transmissionType. EventHandle1 (HttpServer' transmissionType) Duplex +connectionH = EventHandle "connection" mkEffectFn1 + +dropRequestH :: forall transmissionType. EventHandle2 (HttpServer' transmissionType) (IncomingMessage IMServer) Duplex +dropRequestH = EventHandle "dropRequest" \cb -> mkEffectFn2 \a b -> cb a b + +requestH :: forall transmissionType. EventHandle2 (HttpServer' transmissionType) (IncomingMessage IMServer) ServerResponse +requestH = EventHandle "request" \cb -> mkEffectFn2 \a b -> cb a b + +upgradeH :: forall transmissionType. EventHandle3 (HttpServer' transmissionType) (IncomingMessage IMServer) Duplex Buffer +upgradeH = EventHandle "upgrade" \cb -> mkEffectFn3 \a b c -> cb a b c + +closeAllConnections :: forall transmissionType. (HttpServer' transmissionType) -> Effect Unit +closeAllConnections hs = runEffectFn1 closeAllConnectionsImpl hs + +foreign import closeAllConnectionsImpl :: forall transmissionType. EffectFn1 (HttpServer' transmissionType) (Unit) + +closeIdleConnections :: forall transmissionType. (HttpServer' transmissionType) -> Effect Unit +closeIdleConnections hs = runEffectFn1 closeIdleConnectionsImpl hs + +foreign import closeIdleConnectionsImpl :: forall transmissionType. EffectFn1 (HttpServer' transmissionType) (Unit) + +headersTimeout :: forall transmissionType. (HttpServer' transmissionType) -> Effect Int +headersTimeout hs = runEffectFn1 headersTimeoutImpl hs + +foreign import headersTimeoutImpl :: forall transmissionType. EffectFn1 ((HttpServer' transmissionType)) (Int) + +setHeadersTimeout :: forall transmissionType. Int -> (HttpServer' transmissionType) -> Effect Unit +setHeadersTimeout tm hs = runEffectFn2 setHeadersTimeoutImpl tm hs + +foreign import setHeadersTimeoutImpl :: forall transmissionType. EffectFn2 (Int) ((HttpServer' transmissionType)) (Unit) + +maxHeadersCount :: forall transmissionType. (HttpServer' transmissionType) -> Effect Int +maxHeadersCount hs = runEffectFn1 maxHeadersCountImpl hs + +foreign import maxHeadersCountImpl :: forall transmissionType. EffectFn1 ((HttpServer' transmissionType)) (Int) + +setMaxHeadersCount :: forall transmissionType. Int -> (HttpServer' transmissionType) -> Effect Unit +setMaxHeadersCount c hs = runEffectFn2 setMaxHeadersCountImpl c hs + +foreign import setMaxHeadersCountImpl :: forall transmissionType. EffectFn2 (Int) ((HttpServer' transmissionType)) (Unit) + +setUnlimitedHeadersCount :: forall transmissionType. (HttpServer' transmissionType) -> Effect Unit +setUnlimitedHeadersCount = setMaxHeadersCount 0 + +requestTimeout :: forall transmissionType. (HttpServer' transmissionType) -> Effect Milliseconds +requestTimeout hs = runEffectFn1 requestTimeoutImpl hs + +foreign import requestTimeoutImpl :: forall transmissionType. EffectFn1 ((HttpServer' transmissionType)) (Milliseconds) + +setRequestTimeout :: forall transmissionType. Milliseconds -> (HttpServer' transmissionType) -> Effect Unit +setRequestTimeout tm hs = runEffectFn2 setRequestTimeoutImpl tm hs + +foreign import setRequestTimeoutImpl :: forall transmissionType. EffectFn2 (Milliseconds) ((HttpServer' transmissionType)) (Unit) + +maxRequestsPerSocket :: forall transmissionType. (HttpServer' transmissionType) -> Effect Int +maxRequestsPerSocket hs = runEffectFn1 maxRequestsPerSocketImpl hs + +foreign import maxRequestsPerSocketImpl :: forall transmissionType. EffectFn1 ((HttpServer' transmissionType)) (Int) + +setMaxRequestsPerSocket :: forall transmissionType. Int -> (HttpServer' transmissionType) -> Effect Unit +setMaxRequestsPerSocket c hs = runEffectFn2 setMaxRequestsPerSocketImpl c hs + +foreign import setMaxRequestsPerSocketImpl :: forall transmissionType. EffectFn2 (Int) ((HttpServer' transmissionType)) (Unit) + +setUnlimitedRequestsPerSocket :: forall transmissionType. (HttpServer' transmissionType) -> Effect Unit +setUnlimitedRequestsPerSocket hs = setMaxRequestsPerSocket 0 hs + +timeout :: forall transmissionType. (HttpServer' transmissionType) -> Effect Milliseconds +timeout hs = runEffectFn1 timeoutImpl hs + +foreign import timeoutImpl :: forall transmissionType. EffectFn1 ((HttpServer' transmissionType)) (Milliseconds) + +setTimeout :: forall transmissionType. Milliseconds -> (HttpServer' transmissionType) -> Effect Unit +setTimeout ms hs = runEffectFn2 setTimeoutImpl ms hs + +foreign import setTimeoutImpl :: forall transmissionType. EffectFn2 (Milliseconds) ((HttpServer' transmissionType)) (Unit) + +clearTimeout :: forall transmissionType. (HttpServer' transmissionType) -> Effect Unit +clearTimeout hs = setTimeout (Milliseconds 0.0) hs + +keepAliveTimeout :: forall transmissionType. (HttpServer' transmissionType) -> Effect Milliseconds +keepAliveTimeout hs = runEffectFn1 keepAliveTimeoutImpl hs + +foreign import keepAliveTimeoutImpl :: forall transmissionType. EffectFn1 ((HttpServer' transmissionType)) (Milliseconds) + +setKeepAliveTimeout :: forall transmissionType. Milliseconds -> (HttpServer' transmissionType) -> Effect Unit +setKeepAliveTimeout ms hs = runEffectFn2 setKeepAliveTimeoutImpl ms hs + +foreign import setKeepAliveTimeoutImpl :: forall transmissionType. EffectFn2 (Milliseconds) ((HttpServer' transmissionType)) (Unit) + +clearKeepAliveTimeout :: forall transmissionType. (HttpServer' transmissionType) -> Effect Unit +clearKeepAliveTimeout hs = setKeepAliveTimeout (Milliseconds 0.0) hs diff --git a/src/Node/HTTP/ServerResponse.js b/src/Node/HTTP/ServerResponse.js new file mode 100644 index 0000000..331e688 --- /dev/null +++ b/src/Node/HTTP/ServerResponse.js @@ -0,0 +1,28 @@ +export const req = (sr) => sr.req; + +export const sendDateImpl = (sr) => sr.sendDate; +export const setSendDateImpl = (d, sr) => { + sr.sendDate = d; +}; +export const statusCodeImpl = (sr) => sr.statusCode; +export const setStatusCodeImpl = (code, sr) => { + sr.statusCode = code; +}; +export const statusMessageImpl = (sr) => sr.statusMessage; +export const setStatusMessageImpl = (msg, sr) => { + sr.statusMessage = msg; +}; +export const strictContentLengthImpl = (sr) => sr.strictContentLength; +export const setStrictContentLengthImpl = (b, sr) => { + sr.strictContentLength = b; +}; + +export const writeEarlyHintsImpl = (hints, sr) => sr.writeEarlyHints(hints); +export const writeEarlyHintsCbImpl = (hints, cb, sr) => sr.writeEarlyHintsCb(hints, cb); + +export const writeHeadImpl = (code, sr) => sr.writeHead(code); +export const writeHeadMsgImpl = (code, msg, sr) => sr.writeHeadMsg(code, msg); +export const writeHeadHeadersImpl = (code, hdrs, sr) => sr.writeHeadHeaders(code, hdrs); +export const writeHeadMsgHeadersImpl = (code, msg, hdrs, sr) => sr.writeHeadMsgHeaders(code, msg, hdrs); + +export const writeProcessingImpl = (sr) => sr.writeProcessing(); diff --git a/src/Node/HTTP/ServerResponse.purs b/src/Node/HTTP/ServerResponse.purs new file mode 100644 index 0000000..4a4570a --- /dev/null +++ b/src/Node/HTTP/ServerResponse.purs @@ -0,0 +1,116 @@ +module Node.HTTP.ServerResponse + ( toOutgoingMessage + , closeH + , finishH + , req + , sendDate + , setSendDate + , statusCode + , setStatusCode + , statusMessage + , setStatusMessage + , strictContentLength + , setStrictContentLength + , writeEarlyHints + , writeEarlyHints' + , writeHead + , writeHead' + , writeHeadHeaders + , writeHeadMsgHeaders + , writeProcessing + ) where + +import Prelude + +import Effect (Effect) +import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4) +import Node.EventEmitter (EventHandle(..)) +import Node.EventEmitter.UtilTypes (EventHandle0) +import Node.HTTP.Types (IMServer, IncomingMessage, OutgoingMessage, ServerResponse) +import Unsafe.Coerce (unsafeCoerce) + +toOutgoingMessage :: ServerResponse -> OutgoingMessage +toOutgoingMessage = unsafeCoerce + +closeH :: EventHandle0 ServerResponse +closeH = EventHandle "close" identity + +finishH :: EventHandle0 ServerResponse +finishH = EventHandle "finish" identity + +foreign import req :: ServerResponse -> IncomingMessage IMServer + +sendDate :: ServerResponse -> Effect Boolean +sendDate sr = runEffectFn1 sendDateImpl sr + +foreign import sendDateImpl :: EffectFn1 (ServerResponse) (Boolean) + +setSendDate :: Boolean -> ServerResponse -> Effect Unit +setSendDate b sr = runEffectFn2 setSendDateImpl b sr + +foreign import setSendDateImpl :: EffectFn2 (Boolean) (ServerResponse) (Unit) + +statusCode :: ServerResponse -> Effect Int +statusCode sr = runEffectFn1 statusCodeImpl sr + +foreign import statusCodeImpl :: EffectFn1 (ServerResponse) (Int) + +setStatusCode :: Int -> ServerResponse -> Effect Unit +setStatusCode code sr = runEffectFn2 setStatusCodeImpl code sr + +foreign import setStatusCodeImpl :: EffectFn2 (Int) (ServerResponse) (Unit) + +statusMessage :: ServerResponse -> Effect String +statusMessage sr = runEffectFn1 statusMessageImpl sr + +foreign import statusMessageImpl :: EffectFn1 (ServerResponse) (String) + +setStatusMessage :: String -> ServerResponse -> Effect Unit +setStatusMessage msg sr = runEffectFn2 setStatusMessageImpl msg sr + +foreign import setStatusMessageImpl :: EffectFn2 (String) (ServerResponse) (Unit) + +strictContentLength :: ServerResponse -> Effect Boolean +strictContentLength sr = runEffectFn1 strictContentLengthImpl sr + +foreign import strictContentLengthImpl :: EffectFn1 (ServerResponse) (Boolean) + +setStrictContentLength :: Boolean -> ServerResponse -> Effect Unit +setStrictContentLength b sr = runEffectFn2 setStrictContentLengthImpl b sr + +foreign import setStrictContentLengthImpl :: EffectFn2 (Boolean) (ServerResponse) (Unit) + +writeEarlyHints :: forall r. { | r } -> ServerResponse -> Effect Unit +writeEarlyHints hints sr = runEffectFn2 writeEarlyHintsImpl hints sr + +foreign import writeEarlyHintsImpl :: forall r. EffectFn2 ({ | r }) (ServerResponse) (Unit) + +writeEarlyHints' :: forall r. { | r } -> Effect Unit -> ServerResponse -> Effect Unit +writeEarlyHints' hints cb sr = runEffectFn3 writeEarlyHintsCbImpl hints cb sr + +foreign import writeEarlyHintsCbImpl :: forall r. EffectFn3 ({ | r }) (Effect Unit) (ServerResponse) (Unit) + +writeHead :: Int -> ServerResponse -> Effect Unit +writeHead statusCode' sr = runEffectFn2 writeHeadImpl statusCode' sr + +foreign import writeHeadImpl :: EffectFn2 (Int) (ServerResponse) (Unit) + +writeHead' :: Int -> String -> ServerResponse -> Effect Unit +writeHead' statusCode' statusMsg sr = runEffectFn3 writeHeadMsgImpl statusCode' statusMsg sr + +foreign import writeHeadMsgImpl :: EffectFn3 (Int) (String) (ServerResponse) (Unit) + +writeHeadHeaders :: forall r. Int -> { | r } -> ServerResponse -> Effect Unit +writeHeadHeaders statusCode' hdrs sr = runEffectFn3 writeHeadHeadersImpl statusCode' hdrs sr + +foreign import writeHeadHeadersImpl :: forall r. EffectFn3 (Int) ({ | r }) (ServerResponse) (Unit) + +writeHeadMsgHeaders :: forall r. Int -> String -> { | r } -> ServerResponse -> Effect Unit +writeHeadMsgHeaders statusCode' msg hdrs sr = runEffectFn4 writeHeadMsgHeadersImpl statusCode' msg hdrs sr + +foreign import writeHeadMsgHeadersImpl :: forall r. EffectFn4 (Int) (String) ({ | r }) (ServerResponse) (Unit) + +writeProcessing :: ServerResponse -> Effect Unit +writeProcessing sr = runEffectFn1 writeProcessingImpl sr + +foreign import writeProcessingImpl :: EffectFn1 (ServerResponse) (Unit) diff --git a/src/Node/HTTP/Types.purs b/src/Node/HTTP/Types.purs new file mode 100644 index 0000000..559d501 --- /dev/null +++ b/src/Node/HTTP/Types.purs @@ -0,0 +1,24 @@ +module Node.HTTP.Types where + +foreign import data OutgoingMessage :: Type + +data IncomingMessageType + +foreign import data IMClientRequest :: IncomingMessageType +foreign import data IMServer :: IncomingMessageType + +foreign import data IncomingMessage :: IncomingMessageType -> Type + +foreign import data ClientRequest :: Type + +foreign import data ServerResponse :: Type + +data TransmissionType + +foreign import data Encrypted :: TransmissionType +foreign import data PlainText :: TransmissionType + +foreign import data HttpServer' :: TransmissionType -> Type + +type HttpServer = HttpServer' PlainText +type HttpsServer = HttpServer' Encrypted diff --git a/src/Node/HTTPS.js b/src/Node/HTTPS.js new file mode 100644 index 0000000..b2cd7ba --- /dev/null +++ b/src/Node/HTTPS.js @@ -0,0 +1,16 @@ +import https from "node:https"; + +export const createSecureServer = () => https.createServer(); +export const createSecureServerOptsImpl = (opts) => https.createServer(opts); + +export const requestStrImpl = (url) => https.request(url); +export const requestStrOptsImpl = (url, opts) => https.request(url, opts); +export const requestUrlImpl = (url) => https.request(url); +export const requestUrlOptsImpl = (url, opts) => https.request(url, opts); +export const requestOptsImpl = (opts) => https.request(opts); + +export const getStrImpl = (url) => https.get(url); +export const getStrOptsImpl = (url, opts) => https.get(url, opts); +export const getUrlImpl = (url) => https.get(url); +export const getUrlOptsImpl = (url, opts) => https.get(url, opts); +export const getOptsImpl = (opts) => https.get(opts); diff --git a/src/Node/HTTPS.purs b/src/Node/HTTPS.purs new file mode 100644 index 0000000..cda714e --- /dev/null +++ b/src/Node/HTTPS.purs @@ -0,0 +1,200 @@ +module Node.HTTPS + ( CreateSecureServerOptions + , createSecureServer + , createSecureServer' + , request + , requestUrl + , SecureRequestOptions + , request' + , requestURL' + , requestOpts + , get + , getUrl + , get' + , getUrl' + , getOpts + ) where + +import Effect (Effect) +import Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn1, runEffectFn2) +import Node.Buffer (Buffer) +import Node.HTTP (CreateServerOptions, RequestOptions) +import Node.HTTP.Types (ClientRequest, HttpServer', Encrypted) +import Node.TLS.Types as TLS +import Node.URL (URL) +import Prim.Row as Row + +-- | Example usage. See `createSecureServer'` to pass in options: +-- | +-- | ``` +-- | server <- HTTPS.createSecureServer +-- | -- setup request handler +-- | server # on Server.requestH \request response -> do +-- | -- send back a response +-- | +-- | -- (optional) setup listener callback +-- | let ns = Server.toNetServer server +-- | ns # once_ NetServer.listeningH do +-- | +-- | -- start the server +-- | listenTcp ns { host: "localhost", port: 8000 } +-- | +-- | -- Sometime in the future, close the server +-- | Server.closeAllConnections +-- | NetServer.close ns +-- | ``` +foreign import createSecureServer :: Effect (HttpServer' Encrypted) + +type CreateSecureServerOptions = + TLS.TlsCreateServerOptions TLS.Server (TLS.CreateSecureContextOptions CreateServerOptions) + +-- | Example usage: +-- | +-- | ``` +-- | key' <- FSA.readFile "path/to/key/file" +-- | cert' <- FSA.readFile "path/to/cert/file" +-- | server <- HTTPS.createSecureServer' +-- | { key: [ mockKey' ] +-- | , cert: [ mockCert' ] +-- | } +-- | -- setup request handler +-- | server # on Server.requestH \request response -> do +-- | -- send back a response +-- | +-- | -- (optional) setup listener callback +-- | let ns = Server.toNetServer server +-- | ns # once_ NetServer.listeningH do +-- | +-- | -- start the server +-- | listenTcp ns { host: "localhost", port: 8000 } +-- | +-- | -- Sometime in the future, close the server +-- | Server.closeAllConnections +-- | NetServer.close ns +-- | ``` +createSecureServer' + :: forall r trash + . Row.Union r trash CreateSecureServerOptions + => { | r } + -> Effect (HttpServer' Encrypted) +createSecureServer' opts = runEffectFn1 createSecureServerOptsImpl opts + +foreign import createSecureServerOptsImpl :: forall r. EffectFn1 ({ | r }) (HttpServer' Encrypted) + +request :: String -> Effect ClientRequest +request url = runEffectFn1 requestStrImpl url + +foreign import requestStrImpl :: EffectFn1 (String) (ClientRequest) + +requestUrl :: URL -> Effect ClientRequest +requestUrl url = runEffectFn1 requestUrlImpl url + +foreign import requestUrlImpl :: EffectFn1 (URL) (ClientRequest) + +-- | - `ca` | | | Optionally override the trusted CA certificates. Default is to trust the well-known CAs curated by Mozilla. Mozilla's CAs are completely replaced when CAs are explicitly specified using this option. The value can be a string or Buffer, or an Array of strings and/or Buffers. Any string or Buffer can contain multiple PEM CAs concatenated together. The peer's certificate must be chainable to a CA trusted by the server for the connection to be authenticated. When using certificates that are not chainable to a well-known CA, the certificate's CA must be explicitly specified as a trusted or the connection will fail to authenticate. If the peer uses a certificate that doesn't match or chain to one of the default CAs, use the ca option to provide a CA certificate that the peer's certificate can match or chain to. For self-signed certificates, the certificate is its own CA, and must be provided. For PEM encoded certificates, supported types are "TRUSTED CERTIFICATE", "X509 CERTIFICATE", and "CERTIFICATE". See also tls.rootCertificates. +-- | - `cert` | | | Cert chains in PEM format. One cert chain should be provided per private key. Each cert chain should consist of the PEM formatted certificate for a provided private key, followed by the PEM formatted intermediate certificates (if any), in order, and not including the root CA (the root CA must be pre-known to the peer, see ca). When providing multiple cert chains, they do not have to be in the same order as their private keys in key. If the intermediate certificates are not provided, the peer will not be able to validate the certificate, and the handshake will fail. +-- | - `ciphers` Cipher suite specification, replacing the default. For more information, see Modifying the default TLS cipher suite. Permitted ciphers can be obtained via tls.getCiphers(). Cipher names must be uppercased in order for OpenSSL to accept them. +-- | - `clientCertEngine` Name of an OpenSSL engine which can provide the client certificate. +-- | - `crl` | | | PEM formatted CRLs (Certificate Revocation Lists). +-- | - `dhparam` | 'auto' or custom Diffie-Hellman parameters, required for non-ECDHE perfect forward secrecy. If omitted or invalid, the parameters are silently discarded and DHE ciphers will not be available. ECDHE-based perfect forward secrecy will still be available. +-- | - `ecdhCurve` A string describing a named curve or a colon separated list of curve NIDs or names, for example P-521:P-384:P-256, to use for ECDH key agreement. Set to auto to select the curve automatically. Use crypto.getCurves() to obtain a list of available curve names. On recent releases, openssl ecparam -list_curves will also display the name and description of each available elliptic curve. Default: tls.DEFAULT_ECDH_CURVE. +-- | - `honorCipherOrder` Attempt to use the server's cipher suite preferences instead of the client's. When true, causes SSL_OP_CIPHER_SERVER_PREFERENCE to be set in secureOptions, see OpenSSL Options for more information. +-- | - `key` | | | | Private keys in PEM format. PEM allows the option of private keys being encrypted. Encrypted keys will be decrypted with options.passphrase. Multiple keys using different algorithms can be provided either as an array of unencrypted key strings or buffers, or an array of objects in the form {pem: [, passphrase: ]}. The object form can only occur in an array. object.passphrase is optional. Encrypted keys will be decrypted with object.passphrase if provided, or options.passphrase if it is not. +-- | - `passphrase` Shared passphrase used for a single private key and/or a PFX. +-- | - `pfx` | | | | PFX or PKCS12 encoded private key and certificate chain. pfx is an alternative to providing key and cert individually. PFX is usually encrypted, if it is, passphrase will be used to decrypt it. Multiple PFX can be provided either as an array of unencrypted PFX buffers, or an array of objects in the form {buf: [, passphrase: ]}. The object form can only occur in an array. object.passphrase is optional. Encrypted PFX will be decrypted with object.passphrase if provided, or options.passphrase if it is not. +-- | - `rejectUnauthorized` If not false the server will reject any connection which is not authorized with the list of supplied CAs. This option only has an effect if requestCert is true. Default: true. +-- | - `secureOptions` Optionally affect the OpenSSL protocol behavior, which is not usually necessary. This should be used carefully if at all! Value is a numeric bitmask of the SSL_OP_* options from OpenSSL Options. +-- | - `secureProtocol` Legacy mechanism to select the TLS protocol version to use, it does not support independent control of the minimum and maximum version, and does not support limiting the protocol to TLSv1.3. Use minVersion and maxVersion instead. The possible values are listed as SSL_METHODS, use the function names as strings. For example, use 'TLSv1_1_method' to force TLS version 1.1, or 'TLS_method' to allow any TLS protocol version up to TLSv1.3. It is not recommended to use TLS versions less than 1.2, but it may be required for interoperability. Default: none, see minVersion. +-- | - `sessionIdContext` Opaque identifier used by servers to ensure session state is not shared between applications. Unused by clients. +-- | - `servername`: Server name for the SNI (Server Name Indication) TLS extension. It is the name of the host being connected to, and must be a host name, and not an IP address. It can be used by a multi-homed server to choose the correct certificate to present to the client, see the SNICallback option to tls.createServer(). +-- | - `highWaterMark`: Consistent with the readable stream highWaterMark parameter. Default: 16 * 1024. +type SecureRequestOptions = + ( ca :: Array Buffer + , cert :: Array Buffer + , ciphers :: String + , clientCertEngine :: String + , crl :: Array Buffer + , dhparam :: Buffer + , ecdhCurve :: String + , honorCipherOrder :: Boolean + , key :: Array Buffer + , passphrase :: String + , pfx :: Array Buffer + , rejectUnauthorized :: Boolean + , secureOptions :: Number + , secureProtocol :: String + , sessionIdContext :: String + , servername :: String + , highWaterMark :: Number + | RequestOptions () + ) + +request' + :: forall r trash + . Row.Union r trash SecureRequestOptions + => String + -> { | r } + -> Effect ClientRequest +request' url opts = runEffectFn2 requestStrOptsImpl url opts + +foreign import requestStrOptsImpl :: forall r. EffectFn2 (String) ({ | r }) (ClientRequest) + +requestURL' + :: forall r trash + . Row.Union r trash SecureRequestOptions + => URL + -> { | r } + -> Effect ClientRequest +requestURL' url opts = runEffectFn2 requestUrlOptsImpl url opts + +foreign import requestUrlOptsImpl :: forall r. EffectFn2 (URL) ({ | r }) (ClientRequest) + +requestOpts + :: forall r trash + . Row.Union r trash SecureRequestOptions + => { | r } + -> Effect ClientRequest +requestOpts opts = runEffectFn1 requestOptsImpl opts + +foreign import requestOptsImpl :: forall r. EffectFn1 ({ | r }) (ClientRequest) + +get :: String -> Effect ClientRequest +get url = runEffectFn1 getStrImpl url + +foreign import getStrImpl :: EffectFn1 (String) (ClientRequest) + +getUrl :: URL -> Effect ClientRequest +getUrl url = runEffectFn1 getUrlImpl url + +foreign import getUrlImpl :: EffectFn1 (URL) (ClientRequest) + +get' + :: forall r trash + . Row.Union r trash SecureRequestOptions + => Row.Lacks "method" r + => String + -> { | r } + -> Effect ClientRequest +get' url opts = runEffectFn2 getStrOptsImpl url opts + +foreign import getStrOptsImpl :: forall r. EffectFn2 (String) ({ | r }) (ClientRequest) + +getUrl' + :: forall r trash + . Row.Union r trash SecureRequestOptions + => Row.Lacks "method" r + => URL + -> { | r } + -> Effect ClientRequest +getUrl' url opts = runEffectFn2 getUrlOptsImpl url opts + +foreign import getUrlOptsImpl :: forall r. EffectFn2 (URL) ({ | r }) (ClientRequest) + +getOpts + :: forall r trash + . Row.Union r trash SecureRequestOptions + => { | r } + -> Effect ClientRequest +getOpts opts = runEffectFn1 getOptsImpl opts + +foreign import getOptsImpl :: forall r. EffectFn1 ({ | r }) (ClientRequest) diff --git a/test/Main.js b/test/Main.js index d962007..ca66666 100644 --- a/test/Main.js +++ b/test/Main.js @@ -1,7 +1,2 @@ -import http from "node:http"; -import https from "node:https"; -export const createServerOnly = () => http.createServer(); -export const createSecureServerOnlyImpl = (opts) => https.createServer(opts); -export const onRequestImpl = (server, cb) => server.on("request", cb); export const stdout = process.stdout; export const setTimeoutImpl = (int, cb) => setTimeout(cb, int); diff --git a/test/Main.purs b/test/Main.purs index 6e5441e..6c6f1e6 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,37 +3,31 @@ module Test.Main where import Prelude import Data.Foldable (foldMap) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Options (Options, options, (:=)) -import Data.Tuple (Tuple(..)) +import Data.Maybe (fromMaybe) import Effect (Effect) import Effect.Console (log, logShow) -import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn2, runEffectFn1, runEffectFn2) -import Foreign (Foreign) -import Foreign.Object (fromFoldable, lookup) +import Effect.Uncurried (EffectFn2) +import Foreign.Object (lookup) +import Node.Buffer (Buffer) +import Node.Buffer as Buffer import Node.Encoding (Encoding(..)) -import Node.HTTP (Request, Response, Server, close, listen, onUpgrade, requestAsStream, requestHeaders, requestMethod, requestURL, responseAsStream, setHeader, setStatusCode) -import Node.HTTP.Client as Client -import Node.HTTP.Secure (SSLOptions) -import Node.HTTP.Secure as HTTPS -import Node.Net.Socket as Socket -import Node.Stream (Writable, end, pipe, writeString) +import Node.EventEmitter (once_) +import Node.HTTP as HTTP +import Node.HTTP.ClientRequest as Client +import Node.HTTP.IncomingMessage as IM +import Node.HTTP.OutgoingMessage as OM +import Node.HTTP.Server (closeAllConnections) +import Node.HTTP.Server as Server +import Node.HTTP.ServerResponse as ServerResponse +import Node.HTTP.Types (HttpServer', IMServer, IncomingMessage, ServerResponse) +import Node.HTTPS as HTTPS +import Node.Net.Server (listenTcp) +import Node.Net.Server as NetServer +import Node.Stream (Duplex, Writable, end, pipe) import Node.Stream as Stream import Partial.Unsafe (unsafeCrashWith) import Unsafe.Coerce (unsafeCoerce) -foreign import createServerOnly :: Effect Server - -createSecureServerOnly :: Options SSLOptions -> Effect Server -createSecureServerOnly opts = runEffectFn1 createSecureServerOnlyImpl $ options opts - -foreign import createSecureServerOnlyImpl :: EffectFn1 (Foreign) (Server) - -onRequest :: Server -> (Request -> Response -> Effect Unit) -> Effect Unit -onRequest s cb = runEffectFn2 onRequestImpl s $ mkEffectFn2 cb - -foreign import onRequestImpl :: EffectFn2 (Server) (EffectFn2 Request Response Unit) (Unit) - foreign import setTimeoutImpl :: EffectFn2 Int (Effect Unit) Unit foreign import stdout :: forall r. Writable r @@ -46,14 +40,22 @@ main = do testHttps testCookies -respond :: Effect Unit -> Request -> Response -> Effect Unit +killServer :: forall transmissionType. HttpServer' transmissionType -> Effect Unit +killServer s = do + let ns = Server.toNetServer s + closeAllConnections s + NetServer.close ns + +respond :: Effect Unit -> IncomingMessage IMServer -> ServerResponse -> Effect Unit respond closeServer req res = do - setStatusCode res 200 + ServerResponse.setStatusCode 200 res let - inputStream = requestAsStream req - outputStream = responseAsStream res - log (requestMethod req <> " " <> requestURL req) - case requestMethod req of + inputStream = IM.toReadable req + om = ServerResponse.toOutgoingMessage res + outputStream = OM.toWriteable om + + log (IM.method req <> " " <> IM.url req) + case IM.method req of "GET" -> do let html = foldMap (_ <> "\n") @@ -62,20 +64,29 @@ respond closeServer req res = do , " " , "" ] - setHeader res "Content-Type" "text/html" - _ <- writeString outputStream UTF8 html - end outputStream - "POST" -> void $ pipe inputStream outputStream - _ -> unsafeCrashWith "Unexpected HTTP method" + + OM.setHeader "Content-Type" "text/html" om + void $ Stream.writeString outputStream UTF8 html + Stream.end outputStream + "POST" -> + pipe inputStream outputStream + _ -> + unsafeCrashWith "Unexpected HTTP method" closeServer testBasic :: Effect Unit testBasic = do - server <- createServerOnly - onRequest server $ respond (close server mempty) - listen server { hostname: "localhost", port: 8080, backlog: Nothing } $ void do + server <- HTTP.createServer + server # once_ Server.requestH (respond (killServer server)) + let netServer = Server.toNetServer server + netServer # once_ NetServer.listeningH do log "Listening on port 8080." - simpleReq "http://localhost:8080" + let uri = "http://localhost:8080" + log ("GET " <> uri <> ":") + req <- HTTP.get uri + req # once_ Client.responseH logResponse + end (OM.toWriteable $ Client.toOutgoingMessage req) + listenTcp netServer { host: "localhost", port: 8080 } mockCert :: String mockCert = @@ -133,118 +144,119 @@ TbGfXbnVfNmqgQh71+k02p6S testHttpsServer :: Effect Unit testHttpsServer = do - server <- createSecureServerOnly sslOpts - onRequest server $ respond (close server mempty) - listen server { hostname: "localhost", port: 8081, backlog: Nothing } $ void do + mockKey' <- Buffer.fromString mockKey UTF8 + mockCert' <- Buffer.fromString mockCert UTF8 + server <- HTTPS.createSecureServer' + { key: [ mockKey' ] + , cert: [ mockCert' ] + } + server # once_ Server.requestH (respond (killServer server)) + let netServer = Server.toNetServer server + netServer # once_ NetServer.listeningH do log "Listening on port 8081." - complexReq $ - Client.protocol := "https:" - <> Client.method := "GET" - <> Client.hostname := "localhost" - <> Client.port := 8081 - <> Client.path := "/" - <> - Client.rejectUnauthorized := false - where - sslOpts = - HTTPS.key := HTTPS.keyString mockKey <> - HTTPS.cert := HTTPS.certString mockCert + let + optsR = + { protocol: "https:" + , method: "GET" + , hostname: "localhost" + , port: 8081 + , path: "/" + , rejectUnauthorized: false + } + log $ optsR.method <> " " <> optsR.protocol <> "//" <> optsR.hostname <> ":" <> show optsR.port <> optsR.path <> ":" + req <- HTTPS.requestOpts optsR + req # once_ Client.responseH logResponse + end (OM.toWriteable $ Client.toOutgoingMessage req) + listenTcp netServer { host: "localhost", port: 8081 } testHttps :: Effect Unit -testHttps = - simpleReq "https://pursuit.purescript.org/packages/purescript-node-http/badge" +testHttps = do + let uri = "https://pursuit.purescript.org/packages/purescript-node-http/badge" + log ("GET " <> uri <> ":") + req <- HTTPS.get uri + req # once_ Client.responseH logResponse + end (OM.toWriteable $ Client.toOutgoingMessage req) testCookies :: Effect Unit -testCookies = - simpleReq - "https://httpbin.org/cookies/set?cookie1=firstcookie&cookie2=secondcookie" - -simpleReq :: String -> Effect Unit -simpleReq uri = do +testCookies = do + let uri = "https://httpbin.org/cookies/set?cookie1=firstcookie&cookie2=secondcookie" log ("GET " <> uri <> ":") - req <- Client.requestFromURI uri logResponse - end (Client.requestAsStream req) - -complexReq :: Options Client.RequestOptions -> Effect Unit -complexReq opts = do - log $ optsR.method <> " " <> optsR.protocol <> "//" <> optsR.hostname <> ":" <> optsR.port <> optsR.path <> ":" - req <- Client.request opts logResponse - end (Client.requestAsStream req) - where - optsR = unsafeCoerce $ options opts + req <- HTTPS.get uri + req # once_ Client.responseH logResponse + end (OM.toWriteable $ Client.toOutgoingMessage req) -logResponse :: Client.Response -> Effect Unit +logResponse :: forall imTy. IncomingMessage imTy -> Effect Unit logResponse response = void do log "Headers:" - logShow $ Client.responseHeaders response + logShow $ IM.headers response log "Cookies:" - logShow $ Client.responseCookies response + logShow $ IM.cookies response log "Response:" - let responseStream = Client.responseAsStream response - pipe responseStream stdout + pipe (IM.toReadable response) stdout testUpgrade :: Effect Unit testUpgrade = do - server <- createServerOnly - -- Set timeout to close server - runEffectFn2 setTimeoutImpl 10_000 (close server mempty) - onUpgrade server handleUpgrade - onRequest server $ respond (mempty) - listen server { hostname: "localhost", port: 3000, backlog: Nothing } - $ void do - log "Listening on port 3000." - sendRequests + server <- HTTP.createServer + server # once_ Server.upgradeH handleUpgrade + + server # once_ Server.requestH (respond (mempty)) + let netServer = Server.toNetServer server + netServer # once_ NetServer.listeningH do + log $ "Listening on port " <> show httpPort <> "." + sendRequests + listenTcp netServer { host: "localhost", port: httpPort } where + httpPort = 3000 + + handleUpgrade :: IncomingMessage IMServer -> Duplex -> Buffer -> Effect Unit handleUpgrade req socket _ = do - let upgradeHeader = fromMaybe "" $ lookup "upgrade" $ requestHeaders req - let sockStream = Socket.toDuplex socket + let upgradeHeader = fromMaybe "" $ lookup "upgrade" $ IM.headers req if upgradeHeader == "websocket" then - void $ Stream.writeString sockStream - UTF8 + void $ Stream.writeString socket UTF8 "HTTP/1.1 101 Switching Protocols\r\nContent-Length: 0\r\n\r\n" else - void $ Stream.writeString sockStream - UTF8 + void $ Stream.writeString socket UTF8 "HTTP/1.1 426 Upgrade Required\r\nContent-Length: 0\r\n\r\n" + sendRequests :: Effect Unit sendRequests = do -- This tests that the upgrade callback is not called when the request is not an HTTP upgrade - reqSimple <- Client.request (Client.port := 3000) \response -> do - if (Client.statusCode response /= 200) then + reqSimple <- HTTP.requestOpts { port: httpPort } + reqSimple # once_ Client.responseH \response -> do + if (IM.statusCode response /= 200) then unsafeCrashWith "Unexpected response to simple request on `testUpgrade`" else pure unit - end (Client.requestAsStream reqSimple) + end (OM.toWriteable $ Client.toOutgoingMessage reqSimple) + {- These two requests test that the upgrade callback is called and that it has access to the original request and can write to the underlying TCP socket -} - let - headers = Client.RequestHeaders $ fromFoldable - [ Tuple "Connection" "upgrade" - , Tuple "Upgrade" "something" - ] - reqUpgrade <- Client.request - (Client.port := 3000 <> Client.headers := headers) - \response -> do - if (Client.statusCode response /= 426) then - unsafeCrashWith "Unexpected response to upgrade request on `testUpgrade`" - else - pure unit - end (Client.requestAsStream reqUpgrade) + reqUpgrade <- HTTP.requestOpts + { port: httpPort + , headers: unsafeCoerce + { "Connection": "upgrade" + , "Upgrade": "something" + } + } + reqUpgrade # once_ Client.responseH \response -> do + if (IM.statusCode response /= 426) then + unsafeCrashWith "Unexpected response to upgrade request on `testUpgrade`" + else + pure unit + end (OM.toWriteable $ Client.toOutgoingMessage reqUpgrade) - let - wsHeaders = Client.RequestHeaders $ fromFoldable - [ Tuple "Connection" "upgrade" - , Tuple "Upgrade" "websocket" - ] - - reqWSUpgrade <- Client.request - (Client.port := 3000 <> Client.headers := wsHeaders) - \response -> do - if (Client.statusCode response /= 101) then - unsafeCrashWith "Unexpected response to websocket upgrade request on `testUpgrade`" - else - pure unit - end (Client.requestAsStream reqWSUpgrade) - pure unit + reqWSUpgrade <- HTTP.requestOpts + { port: httpPort + , headers: unsafeCoerce + { "Connection": "upgrade" + , "Upgrade": "websocket" + } + } + reqWSUpgrade # once_ Client.responseH \response -> do + if (IM.statusCode response /= 101) then + unsafeCrashWith "Unexpected response to websocket upgrade request on `testUpgrade`" + else + pure unit + end (OM.toWriteable $ Client.toOutgoingMessage reqWSUpgrade)