From d7b83f209b90332dae78d5f1376f58f383c3b871 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Wed, 17 May 2017 10:07:55 +0200 Subject: [PATCH 1/4] Support Buffer request body --- src/Hyper/Node/Server.purs | 31 +++++++++++++++++++------------ src/Hyper/Request.purs | 4 ++-- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/src/Hyper/Node/Server.purs b/src/Hyper/Node/Server.purs index ce239af..d4ec409 100644 --- a/src/Hyper/Node/Server.purs +++ b/src/Hyper/Node/Server.purs @@ -14,6 +14,7 @@ import Prelude import Data.HTTP.Method as Method import Data.Int as Int import Data.StrMap as StrMap +import Node.Buffer as Buffer import Node.HTTP as HTTP import Node.Stream as Stream import Control.IxMonad (ipure, (:*>), (:>>=)) @@ -32,10 +33,10 @@ import Hyper.Conn (Conn) import Hyper.Middleware (Middleware, evalMiddleware, lift') import Hyper.Middleware.Class (getConn, modifyConn) import Hyper.Port (Port(..)) -import Hyper.Request (class ReadableBody, class Request, RequestData) +import Hyper.Request (class ReadableBody, class Request, RequestData, readBody) import Hyper.Response (class ResponseWritable, class Response, ResponseEnded, StatusLineOpen) import Hyper.Status (Status(..)) -import Node.Buffer (Buffer) +import Node.Buffer (BUFFER, Buffer) import Node.Encoding (Encoding(..)) import Node.HTTP (HTTP) import Node.Stream (Writable) @@ -82,30 +83,36 @@ instance bufferNodeResponse :: (MonadAff e m) toResponse buf = ipure (write buf) -readBody +readBodyAsBuffer :: forall e. HttpRequest - -> Aff (http :: HTTP, avar :: AVAR | e) String -readBody (HttpRequest request _) = do + -> Aff (http :: HTTP, avar :: AVAR, buffer :: BUFFER | e) Buffer +readBodyAsBuffer (HttpRequest request _) = do let stream = HTTP.requestAsStream request completeBody <- makeVar - chunks <- makeVar' "" + chunks <- makeVar' [] e <- liftEff (catchException (pure <<< Just) (fillBody stream chunks completeBody *> pure Nothing)) case e of Just err -> throwError err Nothing -> takeVar completeBody where fillBody stream chunks completeBody = do - Stream.onDataString stream UTF8 \chunk -> void do - launchAff (modifyVar (_ <> chunk) chunks) - Stream.onEnd stream $ void (launchAff (takeVar chunks >>= putVar completeBody)) + Stream.onData stream \chunk -> void do + launchAff (modifyVar (_ <> [chunk]) chunks) + Stream.onEnd stream $ void (launchAff (takeVar chunks >>= concat' >>= putVar completeBody)) + concat' = liftEff <<< Buffer.concat -instance requestBodyReaderReqestBody :: (Monad m, MonadAff (http :: HTTP, avar :: AVAR | e) m) - => ReadableBody HttpRequest m String where +instance readableBodyHttpRequestString :: (Monad m, MonadAff (http :: HTTP, avar :: AVAR, buffer :: BUFFER | e) m) + => ReadableBody HttpRequest m String where + readBody = + readBody :>>= (liftEff <<< Buffer.toString UTF8) + +instance readableBodyHttpRequestBuffer :: (Monad m, MonadAff (http :: HTTP, avar :: AVAR, buffer :: BUFFER | e) m) + => ReadableBody HttpRequest m Buffer where readBody = _.request <$> getConn :>>= case _ of - r -> lift' (liftAff (readBody r)) + r -> liftAff (readBodyAsBuffer r) -- TODO: Make a newtype data HttpResponse state = HttpResponse HTTP.Response diff --git a/src/Hyper/Request.purs b/src/Hyper/Request.purs index e26facd..8fbcdc4 100644 --- a/src/Hyper/Request.purs +++ b/src/Hyper/Request.purs @@ -33,8 +33,8 @@ class Request req m where class Request req m <= BaseRequest req m -- | A ReadableBody instance reads the request body for a specific body --- | reader type. -class ReadableBody req m b | req -> b where +-- | type. +class ReadableBody req m b where readBody :: forall res c . Middleware From 14251d8211461362887f44eda5d6172911c8ac65 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Wed, 17 May 2017 10:18:08 +0200 Subject: [PATCH 2/4] Fix examples for buffer effect --- docs/src/topic-guides/FormSerialization.purs | 3 ++- docs/src/topic-guides/ReadBody.purs | 3 ++- examples/FormParser.purs | 3 ++- src/Hyper/Node/Server.purs | 15 ++++++++------- 4 files changed, 14 insertions(+), 10 deletions(-) diff --git a/docs/src/topic-guides/FormSerialization.purs b/docs/src/topic-guides/FormSerialization.purs index 8392b9d..1390e63 100644 --- a/docs/src/topic-guides/FormSerialization.purs +++ b/docs/src/topic-guides/FormSerialization.purs @@ -21,6 +21,7 @@ import Hyper.Node.Server (defaultOptionsWithLogging, runServer) import Hyper.Request (class ReadableBody, class Request, getRequestData) import Hyper.Response (class Response, class ResponseWritable, ResponseEnded, StatusLineOpen, closeHeaders, respond, writeStatus) import Hyper.Status (statusBadRequest, statusMethodNotAllowed) +import Node.Buffer (BUFFER) import Node.HTTP (HTTP) -- start snippet datatypes @@ -88,7 +89,7 @@ onPost = <> show beers <> " beers coming up!\n") -- end snippet onPost -main :: forall e. Eff (http :: HTTP, console :: CONSOLE, exception :: EXCEPTION, avar :: AVAR | e) Unit +main :: forall e. Eff (http :: HTTP, console :: CONSOLE, exception :: EXCEPTION, avar :: AVAR, buffer :: BUFFER | e) Unit main = let router = diff --git a/docs/src/topic-guides/ReadBody.purs b/docs/src/topic-guides/ReadBody.purs index 17c568a..6d2e2e4 100644 --- a/docs/src/topic-guides/ReadBody.purs +++ b/docs/src/topic-guides/ReadBody.purs @@ -14,6 +14,7 @@ import Hyper.Node.Server (defaultOptionsWithLogging, runServer) import Hyper.Request (class ReadableBody, getRequestData, readBody) import Hyper.Response (class Response, class ResponseWritable, ResponseEnded, StatusLineOpen, closeHeaders, respond, writeStatus) import Hyper.Status (statusBadRequest, statusMethodNotAllowed) +import Node.Buffer (BUFFER) import Node.HTTP (HTTP) onPost @@ -41,7 +42,7 @@ onPost = :*> respond ("You said: " <> msg) -- end snippet onPost -main :: forall e. Eff (http :: HTTP, console :: CONSOLE, exception :: EXCEPTION, avar :: AVAR | e) Unit +main :: forall e. Eff (http :: HTTP, console :: CONSOLE, exception :: EXCEPTION, avar :: AVAR, buffer :: BUFFER | e) Unit main = let router = diff --git a/examples/FormParser.purs b/examples/FormParser.purs index 442df70..087ff85 100644 --- a/examples/FormParser.purs +++ b/examples/FormParser.purs @@ -18,12 +18,13 @@ import Hyper.Node.Server (defaultOptionsWithLogging, runServer) import Hyper.Request (getRequestData) import Hyper.Response (closeHeaders, contentType, respond, writeStatus) import Hyper.Status (statusBadRequest, statusMethodNotAllowed, statusOK) +import Node.Buffer (BUFFER) import Node.HTTP (HTTP) import Text.Smolder.HTML (button, form, input, label, p) import Text.Smolder.Markup (text, (!)) import Text.Smolder.Renderer.String (render) -main :: forall e. Eff (http :: HTTP, console :: CONSOLE, exception :: EXCEPTION, avar :: AVAR | e) Unit +main :: forall e. Eff (http :: HTTP, console :: CONSOLE, exception :: EXCEPTION, avar :: AVAR, buffer :: BUFFER | e) Unit main = let -- A view function that renders the name form. diff --git a/src/Hyper/Node/Server.purs b/src/Hyper/Node/Server.purs index d4ec409..192c455 100644 --- a/src/Hyper/Node/Server.purs +++ b/src/Hyper/Node/Server.purs @@ -26,6 +26,7 @@ import Control.Monad.Eff.Class (class MonadEff, liftEff) import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.Eff.Exception (Error, catchException, error) import Control.Monad.Error.Class (throwError) +import Data.Either (Either(..), either) import Data.Maybe (Maybe(..)) import Data.Newtype (unwrap) import Data.Tuple (Tuple(..)) @@ -91,15 +92,15 @@ readBodyAsBuffer (HttpRequest request _) = do let stream = HTTP.requestAsStream request completeBody <- makeVar chunks <- makeVar' [] - e <- liftEff (catchException (pure <<< Just) (fillBody stream chunks completeBody *> pure Nothing)) - case e of - Just err -> throwError err - Nothing -> takeVar completeBody + res <- liftEff $ + catchException (pure <<< Left) (Right <$> fillBody stream chunks completeBody) + either throwError (const (takeVar completeBody)) res where fillBody stream chunks completeBody = do - Stream.onData stream \chunk -> void do - launchAff (modifyVar (_ <> [chunk]) chunks) - Stream.onEnd stream $ void (launchAff (takeVar chunks >>= concat' >>= putVar completeBody)) + Stream.onData stream \chunk -> + void (launchAff (modifyVar (_ <> [chunk]) chunks)) + Stream.onEnd stream $ + void (launchAff (takeVar chunks >>= concat' >>= putVar completeBody)) concat' = liftEff <<< Buffer.concat instance readableBodyHttpRequestString :: (Monad m, MonadAff (http :: HTTP, avar :: AVAR, buffer :: BUFFER | e) m) From 0078936cfa6b665219c9a16cf648dadfde3c0ca5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Wed, 17 May 2017 10:45:52 +0200 Subject: [PATCH 3/4] Fix CSS in Sphinx after breaking change --- docs/src/conf.py | 1 - docs/src/theme/layout.html | 4 ++-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/docs/src/conf.py b/docs/src/conf.py index d890a17..8114ea9 100644 --- a/docs/src/conf.py +++ b/docs/src/conf.py @@ -27,7 +27,6 @@ # needs_sphinx = '1.0' import os -import sys import subprocess from datetime import date diff --git a/docs/src/theme/layout.html b/docs/src/theme/layout.html index 6dd8f98..3dbfb12 100644 --- a/docs/src/theme/layout.html +++ b/docs/src/theme/layout.html @@ -1,7 +1,5 @@ {% extends "sphinxdoc/layout.html" %} -{% set css_files = css_files + ['_static/bootstrap/css/bootstrap.min.css', '_static/overrides.css'] %} - {%- from "relbar.html" import relbar_top with context %} {% block htmltitle %} @@ -36,6 +34,8 @@ + + {% endblock %} From 673ef297c3bc9f4b2688664f28d5cb74df998f86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Oskar=20Wickstr=C3=B6m?= Date: Wed, 17 May 2017 11:22:25 +0200 Subject: [PATCH 4/4] Add latexmk package --- .travis.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.travis.yml b/.travis.yml index ef095a5..1409088 100644 --- a/.travis.yml +++ b/.travis.yml @@ -13,6 +13,7 @@ addons: - texlive-latex-recommended - latex-xcolor - lmodern + - latexmk node_js: - '5.5'