From 278e110d59409e1ed2793413459899ea8c8d92da Mon Sep 17 00:00:00 2001 From: Connor Prussin Date: Mon, 25 Sep 2017 23:08:07 -0700 Subject: [PATCH] Improve and simplify APIs (#68) --- History.md | 7 + Makefile | 3 +- Readme.md | 2 +- bower.json | 4 +- docs/Examples/Headers/Main.purs | 14 +- docs/Examples/HelloWorld/Main.purs | 3 +- docs/Examples/MultiRoute/Main.purs | 7 +- docs/Examples/PathSegments/Main.purs | 34 ++ docs/Examples/PathSegments/Readme.md | 11 + docs/Examples/Post/Main.purs | 5 +- docs/Examples/SSL/Main.purs | 3 +- src/HTTPure.purs | 85 ++- src/HTTPure/Body.purs | 2 +- src/HTTPure/Headers.purs | 48 +- src/HTTPure/Lookup.purs | 26 + src/HTTPure/Method.purs | 51 ++ src/HTTPure/Path.purs | 26 +- src/HTTPure/Query.purs | 14 + src/HTTPure/Request.purs | 58 +- src/HTTPure/Response.purs | 827 +++++++++++++++++++-------- src/HTTPure/Status.purs | 331 +++++++++++ test/HTTPure/BodySpec.purs | 6 +- test/HTTPure/HeadersSpec.purs | 60 +- test/HTTPure/IntegrationSpec.purs | 11 + test/HTTPure/LookupSpec.purs | 23 + test/HTTPure/MethodSpec.purs | 52 ++ test/HTTPure/PathSpec.purs | 24 +- test/HTTPure/QuerySpec.purs | 21 + test/HTTPure/RequestSpec.purs | 249 +------- test/HTTPure/ResponseSpec.purs | 59 +- test/HTTPure/ServerSpec.purs | 4 +- test/HTTPure/SpecHelpers.js | 2 +- test/HTTPure/SpecHelpers.purs | 14 +- test/HTTPureSpec.purs | 6 + 34 files changed, 1527 insertions(+), 565 deletions(-) create mode 100644 docs/Examples/PathSegments/Main.purs create mode 100644 docs/Examples/PathSegments/Readme.md create mode 100644 src/HTTPure/Lookup.purs create mode 100644 src/HTTPure/Method.purs create mode 100644 src/HTTPure/Query.purs create mode 100644 test/HTTPure/LookupSpec.purs create mode 100644 test/HTTPure/MethodSpec.purs create mode 100644 test/HTTPure/QuerySpec.purs diff --git a/History.md b/History.md index a9309c0..bc2ad45 100644 --- a/History.md +++ b/History.md @@ -1,3 +1,10 @@ +unreleased +========== +- Major refactor for simpler APIs +- Lookup typeclass and `!!` operator +- Support for inspecting and routing on path segments +- Support for inspecting and routing on query parameters + 0.3.0 / 2017-08-01 ================== - Support HTTPS servers diff --git a/Makefile b/Makefile index 447840f..0ccc741 100644 --- a/Makefile +++ b/Makefile @@ -74,7 +74,8 @@ example: ls -1 $(EXAMPLESPATH) | cat -n read -rp " > " out; \ out=$$(echo $$out | sed 's/[^0-9]*//g'); \ - $(MAKE) example EXAMPLE=$$([ $$out ] && ls -1 $(EXAMPLESPATH) | sed "$${out}q;d") + $(MAKE) example \ + EXAMPLE=$$([ $$out ] && ls -1 $(EXAMPLESPATH) | sed "$${out}q;d") else example: $(BUILD) $(EXAMPLE_INDEX) $(NODE) $(EXAMPLE_INDEX) diff --git a/Readme.md b/Readme.md index 5064ffc..2a63efe 100644 --- a/Readme.md +++ b/Readme.md @@ -37,7 +37,7 @@ main :: HTTPure.ServerM (console :: Console.CONSOLE) main = HTTPure.serve 8080 router $ Console.log "Server now up on port 8080" where - router _ = pure $ HTTPure.OK StrMap.empty "hello world!" + router _ = HTTPure.ok "hello world!" ``` ## Documentation diff --git a/bower.json b/bower.json index 30da656..550ee40 100644 --- a/bower.json +++ b/bower.json @@ -20,7 +20,9 @@ "purescript-prelude": "^3.0.0", "purescript-aff": "^3.1.0", "purescript-node-fs": "^4.0.0", - "purescript-node-http": "^4.1.0" + "purescript-node-http": "^4.1.0", + "purescript-strings": "^3.3.0", + "purescript-foldable-traversable": "^3.6.0" }, "devDependencies": { "purescript-psci-support": "^3.0.0", diff --git a/docs/Examples/Headers/Main.purs b/docs/Examples/Headers/Main.purs index eff38ae..73cb6b5 100644 --- a/docs/Examples/Headers/Main.purs +++ b/docs/Examples/Headers/Main.purs @@ -3,8 +3,9 @@ module Headers where import Prelude import Control.Monad.Eff.Console as Console -import Data.StrMap as StrMap +import Data.Tuple as Tuple import HTTPure as HTTPure +import HTTPure ((!!)) -- | Serve the example server on this port port :: Int @@ -14,16 +15,13 @@ port = 8082 portS :: String portS = show port --- | Read X-Input back to the body and set the X-Example header -sayHello :: HTTPure.Headers -> HTTPure.Response -sayHello = HTTPure.OK responseHeaders <<< flip HTTPure.lookup "X-Input" - where - responseHeaders = StrMap.singleton "X-Example" "hello world!" +-- | The headers that will be included in every response. +responseHeaders :: HTTPure.Headers +responseHeaders = HTTPure.headers [Tuple.Tuple "X-Example" "hello world!"] -- | Route to the correct handler router :: forall e. HTTPure.Request -> HTTPure.ResponseM e -router (HTTPure.Get headers _) = pure $ sayHello headers -router _ = pure $ HTTPure.NotFound StrMap.empty +router { headers } = HTTPure.ok' responseHeaders $ headers !! "X-Input" -- | Boot up the server main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) diff --git a/docs/Examples/HelloWorld/Main.purs b/docs/Examples/HelloWorld/Main.purs index 1af84ee..d7a44cc 100644 --- a/docs/Examples/HelloWorld/Main.purs +++ b/docs/Examples/HelloWorld/Main.purs @@ -3,7 +3,6 @@ module HelloWorld where import Prelude import Control.Monad.Eff.Console as Console -import Data.StrMap as StrMap import HTTPure as HTTPure -- | Serve the example server on this port @@ -16,7 +15,7 @@ portS = show port -- | Say 'hello world!' when run sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e -sayHello _ = pure $ HTTPure.OK StrMap.empty "hello world!" +sayHello _ = HTTPure.ok "hello world!" -- | Boot up the server main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) diff --git a/docs/Examples/MultiRoute/Main.purs b/docs/Examples/MultiRoute/Main.purs index 4cd8ebb..12e5711 100644 --- a/docs/Examples/MultiRoute/Main.purs +++ b/docs/Examples/MultiRoute/Main.purs @@ -3,7 +3,6 @@ module MultiRoute where import Prelude import Control.Monad.Eff.Console as Console -import Data.StrMap as StrMap import HTTPure as HTTPure -- | Serve the example server on this port @@ -16,9 +15,9 @@ portS = show port -- | Specify the routes router :: forall e. HTTPure.Request -> HTTPure.ResponseM e -router (HTTPure.Get _ "/hello") = pure $ HTTPure.OK StrMap.empty "hello" -router (HTTPure.Get _ "/goodbye") = pure $ HTTPure.OK StrMap.empty "goodbye" -router _ = pure $ HTTPure.NotFound StrMap.empty +router { path: [ "hello" ] } = HTTPure.ok "hello" +router { path: [ "goodbye" ] } = HTTPure.ok "goodbye" +router _ = HTTPure.notFound -- | Boot up the server main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) diff --git a/docs/Examples/PathSegments/Main.purs b/docs/Examples/PathSegments/Main.purs new file mode 100644 index 0000000..78570d4 --- /dev/null +++ b/docs/Examples/PathSegments/Main.purs @@ -0,0 +1,34 @@ +module PathSegments where + +import Prelude + +import Control.Monad.Eff.Console as Console +import HTTPure as HTTPure +import HTTPure ((!!)) + +-- | Serve the example server on this port +port :: Int +port = 8086 + +-- | Shortcut for `show port` +portS :: String +portS = show port + +-- | Specify the routes +router :: forall e. HTTPure.Request -> HTTPure.ResponseM e +router { path } + | path !! 0 == "segment" = HTTPure.ok $ path !! 1 + | otherwise = HTTPure.ok $ show path + +-- | Boot up the server +main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) +main = HTTPure.serve port router do + Console.log $ " ┌───────────────────────────────────────────────┐" + Console.log $ " │ Server now up on port " <> portS <> " │" + Console.log $ " │ │" + Console.log $ " │ To test, run: │" + Console.log $ " │ > curl localhost:" <> portS <> "/segment/ │" + Console.log $ " │ # => │" + Console.log $ " │ > curl localhost:" <> portS <> "///... │" + Console.log $ " │ # => [ , , ... ] │" + Console.log $ " └───────────────────────────────────────────────┘" diff --git a/docs/Examples/PathSegments/Readme.md b/docs/Examples/PathSegments/Readme.md new file mode 100644 index 0000000..f51a170 --- /dev/null +++ b/docs/Examples/PathSegments/Readme.md @@ -0,0 +1,11 @@ +# Path Segments Example + +This is a basic example that demonstrates working with URL segments. It includes +code that fetches the whole set of URL segments as an array of strings, and code +that routes based on the value of specific segments. + +To run the example server, run: + +```bash +make example EXAMPLE=PathSegments +``` diff --git a/docs/Examples/Post/Main.purs b/docs/Examples/Post/Main.purs index 5f36691..629eef2 100644 --- a/docs/Examples/Post/Main.purs +++ b/docs/Examples/Post/Main.purs @@ -3,7 +3,6 @@ module Post where import Prelude import Control.Monad.Eff.Console as Console -import Data.StrMap as StrMap import HTTPure as HTTPure -- | Serve the example server on this port @@ -16,8 +15,8 @@ portS = show port -- | Route to the correct handler router :: forall e. HTTPure.Request -> HTTPure.ResponseM e -router (HTTPure.Post _ _ body) = pure $ HTTPure.OK StrMap.empty body -router _ = pure $ HTTPure.NotFound StrMap.empty +router { body, method: HTTPure.Post } = HTTPure.ok body +router _ = HTTPure.notFound -- | Boot up the server main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e) diff --git a/docs/Examples/SSL/Main.purs b/docs/Examples/SSL/Main.purs index e584421..5718c1c 100644 --- a/docs/Examples/SSL/Main.purs +++ b/docs/Examples/SSL/Main.purs @@ -3,7 +3,6 @@ module SSL where import Prelude import Control.Monad.Eff.Console as Console -import Data.StrMap as StrMap import HTTPure as HTTPure -- | Serve the example server on this port @@ -24,7 +23,7 @@ key = "./docs/Examples/SSL/Key.key" -- | Say 'hello world!' when run sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e -sayHello _ = pure $ HTTPure.OK StrMap.empty "hello world!" +sayHello _ = HTTPure.ok "hello world!" -- | Boot up the server main :: forall e. HTTPure.SecureServerM (console :: Console.CONSOLE | e) diff --git a/src/HTTPure.purs b/src/HTTPure.purs index 4a4651b..ada8162 100644 --- a/src/HTTPure.purs +++ b/src/HTTPure.purs @@ -1,11 +1,90 @@ module HTTPure ( module HTTPure.Headers + , module HTTPure.Lookup + , module HTTPure.Method + , module HTTPure.Path , module HTTPure.Request , module HTTPure.Response , module HTTPure.Server ) where -import HTTPure.Headers (Headers, lookup) -import HTTPure.Request (Request(..)) -import HTTPure.Response (ResponseM, Response(..)) +import HTTPure.Headers (Headers, headers) +import HTTPure.Lookup (lookup, (!!)) +import HTTPure.Method (Method(..)) +import HTTPure.Path (Path) +import HTTPure.Request (Request) +import HTTPure.Response + ( ResponseM + , response, response' + + -- 1xx + , continue, continue' + , switchingProtocols, switchingProtocols' + , processing, processing' + + -- 2xx + , ok, ok' + , created, created' + , accepted, accepted' + , nonAuthoritativeInformation, nonAuthoritativeInformation' + , noContent, noContent' + , resetContent, resetContent' + , partialContent, partialContent' + , multiStatus, multiStatus' + , alreadyReported, alreadyReported' + , iMUsed, iMUsed' + + -- 3xx + , multipleChoices, multipleChoices' + , movedPermanently, movedPermanently' + , found, found' + , seeOther, seeOther' + , notModified, notModified' + , useProxy, useProxy' + , temporaryRedirect, temporaryRedirect' + , permanentRedirect, permanentRedirect' + + -- 4xx + , badRequest, badRequest' + , unauthorized, unauthorized' + , paymentRequired, paymentRequired' + , forbidden, forbidden' + , notFound, notFound' + , methodNotAllowed, methodNotAllowed' + , notAcceptable, notAcceptable' + , proxyAuthenticationRequired, proxyAuthenticationRequired' + , requestTimeout, requestTimeout' + , conflict, conflict' + , gone, gone' + , lengthRequired, lengthRequired' + , preconditionFailed, preconditionFailed' + , payloadTooLarge, payloadTooLarge' + , uRITooLong, uRITooLong' + , unsupportedMediaType, unsupportedMediaType' + , rangeNotSatisfiable, rangeNotSatisfiable' + , expectationFailed, expectationFailed' + , imATeapot, imATeapot' + , misdirectedRequest, misdirectedRequest' + , unprocessableEntity, unprocessableEntity' + , locked, locked' + , failedDependency, failedDependency' + , upgradeRequired, upgradeRequired' + , preconditionRequired, preconditionRequired' + , tooManyRequests, tooManyRequests' + , requestHeaderFieldsTooLarge, requestHeaderFieldsTooLarge' + , unavailableForLegalReasons, unavailableForLegalReasons' + + -- 5xx + , internalServerError, internalServerError' + , notImplemented, notImplemented' + , badGateway, badGateway' + , serviceUnavailable, serviceUnavailable' + , gatewayTimeout, gatewayTimeout' + , hTTPVersionNotSupported, hTTPVersionNotSupported' + , variantAlsoNegotiates, variantAlsoNegotiates' + , insufficientStorage, insufficientStorage' + , loopDetected, loopDetected' + , notExtended, notExtended' + , networkAuthenticationRequired, networkAuthenticationRequired' + ) import HTTPure.Server (SecureServerM, ServerM, serve, serve') diff --git a/src/HTTPure/Body.purs b/src/HTTPure/Body.purs index 5cb1feb..1cf1334 100644 --- a/src/HTTPure/Body.purs +++ b/src/HTTPure/Body.purs @@ -20,7 +20,7 @@ import HTTPure.HTTPureM as HTTPureM type Body = String -- | Extract the contents of the body of the HTTP Request. -read :: forall e. HTTP.Request -> Aff.Aff (HTTPureM.HTTPureEffects e) String +read :: forall e. HTTP.Request -> Aff.Aff (HTTPureM.HTTPureEffects e) Body read request = Aff.makeAff \_ success -> do let stream = HTTP.requestAsStream request buf <- ST.newSTRef "" diff --git a/src/HTTPure/Headers.purs b/src/HTTPure/Headers.purs index a123f9a..b001f10 100644 --- a/src/HTTPure/Headers.purs +++ b/src/HTTPure/Headers.purs @@ -1,6 +1,7 @@ module HTTPure.Headers ( Headers - , lookup + , headers + , read , write ) where @@ -10,25 +11,46 @@ import Control.Monad.Eff as Eff import Data.Maybe as Maybe import Data.String as StringUtil import Data.StrMap as StrMap -import Data.Traversable as Traversable +import Data.TraversableWithIndex as TraversableWithIndex +import Data.Tuple as Tuple import Node.HTTP as HTTP +import HTTPure.Lookup as Lookup + -- | The Headers type is just sugar for a StrMap of Strings that represents the -- | set of headers sent or received in an HTTP request or response. -type Headers = StrMap.StrMap String +newtype Headers = Headers (StrMap.StrMap String) --- | Return the value of the given header. -lookup :: Headers -> String -> String -lookup headers = - Maybe.fromMaybe "" <<< flip StrMap.lookup headers <<< StringUtil.toLower +-- | Given a string, return the matching headers. This search is +-- | case-insensitive. +instance lookupHeaders :: Lookup.Lookup Headers String String where + lookup (Headers headers') = + Maybe.fromMaybe "" <<< flip StrMap.lookup headers' <<< StringUtil.toLower --- | Write a set of headers to the given HTTP Response. +-- | Allow a headers set to be represented as a string. +instance showHeaders :: Show Headers where + show (Headers headers') = + StrMap.foldMap showField headers' <> "\n" + where + showField key value = key <> ": " <> value <> "\n" + +-- | Compare two Headers objects by comparing the underlying StrMaps. +instance eqHeaders :: Eq Headers where + eq (Headers a) (Headers b) = eq a b + +-- | Get the headers out of a HTTP Request object. +read :: HTTP.Request -> Headers +read = HTTP.requestHeaders >>> Headers + +-- | Given an HTTP Response and a Headers object, return an effect that will +-- | write the Headers to the Response. write :: forall e. HTTP.Response -> Headers -> Eff.Eff (http :: HTTP.HTTP | e) Unit -write response headers = - void $ Traversable.traverse writeHeader $ StrMap.keys headers - where - getHeader header = Maybe.fromMaybe "" $ StrMap.lookup header headers - writeHeader header = HTTP.setHeader response header $ getHeader header +write response (Headers headers') = void $ + TraversableWithIndex.traverseWithIndex (HTTP.setHeader response) headers' + +-- | Convert an Array of Tuples of 2 Strings to a Headers object. +headers :: Array (Tuple.Tuple String String) -> Headers +headers = StrMap.fromFoldable >>> Headers diff --git a/src/HTTPure/Lookup.purs b/src/HTTPure/Lookup.purs new file mode 100644 index 0000000..b52fa38 --- /dev/null +++ b/src/HTTPure/Lookup.purs @@ -0,0 +1,26 @@ +module HTTPure.Lookup + ( class Lookup + , lookup, (!!) + ) where + +import Prelude + +import Data.Array as Array +import Data.Maybe as Maybe +import Data.Monoid as Monoid + +-- | Types that implement the Lookup class can be looked up by some key to +-- | retrieve some value. For instance, you could have an implementation for +-- | String (Maybe String) Int where `lookup string index` returns `Just` the +-- | character in `string` at `index`, or `Nothing` if `index` is out of bounds. +class Lookup a v k where + lookup :: a -> k -> v + +-- | !! can be used as an infix operator instead of using the `lookup` function. +infixl 8 lookup as !! + +-- | A default instance of Lookup for an Array of some type of Monoid. Note that +-- | this is different from `!!` defined in `Data.Array` in that it does not +-- | return a Maybe. If the index is out of bounds, the return value is mempty. +instance lookupArray :: Monoid.Monoid m => Lookup (Array m) m Int where + lookup arr = Maybe.fromMaybe Monoid.mempty <<< Array.index arr diff --git a/src/HTTPure/Method.purs b/src/HTTPure/Method.purs new file mode 100644 index 0000000..aab0bdc --- /dev/null +++ b/src/HTTPure/Method.purs @@ -0,0 +1,51 @@ +module HTTPure.Method + ( Method(..) + , read + ) where + +import Data.Eq as Eq +import Data.Generic as Generic +import Node.HTTP as HTTP +import Data.Show as Show + +-- | These are the HTTP methods that HTTPure understands. +data Method + = Get + | Post + | Put + | Delete + | Head + | Connect + | Options + | Trace + | Patch + +-- | If two Methods are the same constructor, they are equal. +derive instance generic :: Generic.Generic Method +instance eq :: Eq.Eq Method where + eq = Generic.gEq + +-- | Convert a constructor to a string. +instance show :: Show.Show Method where + show Get = "Get" + show Post = "Post" + show Put = "Put" + show Delete = "Delete" + show Head = "Head" + show Connect = "Connect" + show Options = "Options" + show Trace = "Trace" + show Patch = "Patch" + +-- | Take an HTTP Request and return the Method for that request. +read :: HTTP.Request -> Method +read request = case HTTP.requestMethod request of + "POST" -> Post + "PUT" -> Put + "DELETE" -> Delete + "HEAD" -> Head + "CONNECT" -> Connect + "OPTIONS" -> Options + "TRACE" -> Trace + "PATCH" -> Patch + _ -> Get diff --git a/src/HTTPure/Path.purs b/src/HTTPure/Path.purs index 948f61b..b0da258 100644 --- a/src/HTTPure/Path.purs +++ b/src/HTTPure/Path.purs @@ -1,7 +1,27 @@ module HTTPure.Path ( Path + , read ) where --- | The Path type is just sugar for a String that will be sent in a request and --- | indicates the path of the resource being requested. -type Path = String +import Prelude + +import Data.Array as Array +import Data.Maybe as Maybe +import Data.String as String +import Node.HTTP as HTTP + +-- | The Path type is just sugar for an Array of String segments that are sent +-- | in a request and indicates the path of the resource being requested. Note +-- | that this type has an implementation of Lookup for `Int` keys defined by +-- | `lookpArray` in `Lookup.purs` because `lookupArray` is defined for any +-- | `Array` of `Monoids`. So you can do something like `path !! 2` to get the +-- | path segment at index 2. +type Path = Array String + +-- | Given an HTTP Request object, extract the Path. +read :: HTTP.Request -> Path +read = HTTP.requestURL >>> split "?" >>> first >>> split "/" >>> nonempty + where + nonempty = Array.filter ((/=) "") + split = String.Pattern >>> String.split + first = Array.head >>> Maybe.fromMaybe "" diff --git a/src/HTTPure/Query.purs b/src/HTTPure/Query.purs new file mode 100644 index 0000000..407a033 --- /dev/null +++ b/src/HTTPure/Query.purs @@ -0,0 +1,14 @@ +module HTTPure.Query + ( Query + , read + ) where + +import Data.StrMap as StrMap +import Node.HTTP as HTTP + +type Query = StrMap.StrMap String + +-- | The StrMap of query segments in the given HTTP Request. +-- | TODO fill in this stub +read :: HTTP.Request -> Query +read _ = StrMap.empty diff --git a/src/HTTPure/Request.purs b/src/HTTPure/Request.purs index 3104b7c..636a03e 100644 --- a/src/HTTPure/Request.purs +++ b/src/HTTPure/Request.purs @@ -1,42 +1,29 @@ module HTTPure.Request - ( Request(..) + ( Request , fromHTTPRequest ) where import Prelude import Control.Monad.Aff as Aff -import Data.Show as Show import Node.HTTP as HTTP import HTTPure.Body as Body import HTTPure.Headers as Headers import HTTPure.HTTPureM as HTTPureM +import HTTPure.Method as Method import HTTPure.Path as Path +import HTTPure.Query as Query --- | A Request is a method along with headers, a path, and sometimes a body. -data Request - = Get Headers.Headers Path.Path - | Post Headers.Headers Path.Path Body.Body - | Put Headers.Headers Path.Path Body.Body - | Delete Headers.Headers Path.Path - | Head Headers.Headers Path.Path - | Connect Headers.Headers Path.Path Body.Body - | Options Headers.Headers Path.Path - | Trace Headers.Headers Path.Path - | Patch Headers.Headers Path.Path Body.Body - --- | When using show on a Request, print the method and the path. -instance show :: Show.Show Request where - show (Get _ path) = "GET: " <> path - show (Post _ path _) = "POST: " <> path - show (Put _ path _) = "PUT: " <> path - show (Delete _ path) = "DELETE: " <> path - show (Head _ path) = "HEAD: " <> path - show (Connect _ path _) = "CONNECT: " <> path - show (Options _ path) = "OPTIONS: " <> path - show (Trace _ path) = "TRACE: " <> path - show (Patch _ path _) = "PATCH: " <> path +-- | A Route is a function that takes a Method, a Path, a Query, a Header, and a +-- | Body, and returns a Response monad. +type Request = + { method :: Method.Method + , path :: Path.Path + , query :: Query.Query + , headers :: Headers.Headers + , body :: Body.Body + } -- | Given an HTTP Request object, this method will convert it to an HTTPure -- | Request object. @@ -45,17 +32,10 @@ fromHTTPRequest :: forall e. Aff.Aff (HTTPureM.HTTPureEffects e) Request fromHTTPRequest request = do body <- Body.read request - pure $ case method of - "POST" -> Post headers path body - "PUT" -> Put headers path body - "DELETE" -> Delete headers path - "HEAD" -> Head headers path - "CONNECT" -> Connect headers path body - "OPTIONS" -> Options headers path - "TRACE" -> Trace headers path - "PATCH" -> Patch headers path body - _ -> Get headers path - where - method = HTTP.requestMethod request - headers = HTTP.requestHeaders request - path = HTTP.requestURL request + pure $ + { method: Method.read request + , path: Path.read request + , query: Query.read request + , headers: Headers.read request + , body: body + } diff --git a/src/HTTPure/Response.purs b/src/HTTPure/Response.purs index 1138545..2f754a9 100644 --- a/src/HTTPure/Response.purs +++ b/src/HTTPure/Response.purs @@ -1,7 +1,78 @@ module HTTPure.Response - ( ResponseM - , Response(..) + ( Response(..) + , ResponseM , send + , response, response' + + -- 1xx + , continue, continue' + , switchingProtocols, switchingProtocols' + , processing, processing' + + -- 2xx + , ok, ok' + , created, created' + , accepted, accepted' + , nonAuthoritativeInformation, nonAuthoritativeInformation' + , noContent, noContent' + , resetContent, resetContent' + , partialContent, partialContent' + , multiStatus, multiStatus' + , alreadyReported, alreadyReported' + , iMUsed, iMUsed' + + -- 3xx + , multipleChoices, multipleChoices' + , movedPermanently, movedPermanently' + , found, found' + , seeOther, seeOther' + , notModified, notModified' + , useProxy, useProxy' + , temporaryRedirect, temporaryRedirect' + , permanentRedirect, permanentRedirect' + + -- 4xx + , badRequest, badRequest' + , unauthorized, unauthorized' + , paymentRequired, paymentRequired' + , forbidden, forbidden' + , notFound, notFound' + , methodNotAllowed, methodNotAllowed' + , notAcceptable, notAcceptable' + , proxyAuthenticationRequired, proxyAuthenticationRequired' + , requestTimeout, requestTimeout' + , conflict, conflict' + , gone, gone' + , lengthRequired, lengthRequired' + , preconditionFailed, preconditionFailed' + , payloadTooLarge, payloadTooLarge' + , uRITooLong, uRITooLong' + , unsupportedMediaType, unsupportedMediaType' + , rangeNotSatisfiable, rangeNotSatisfiable' + , expectationFailed, expectationFailed' + , imATeapot, imATeapot' + , misdirectedRequest, misdirectedRequest' + , unprocessableEntity, unprocessableEntity' + , locked, locked' + , failedDependency, failedDependency' + , upgradeRequired, upgradeRequired' + , preconditionRequired, preconditionRequired' + , tooManyRequests, tooManyRequests' + , requestHeaderFieldsTooLarge, requestHeaderFieldsTooLarge' + , unavailableForLegalReasons, unavailableForLegalReasons' + + -- 5xx + , internalServerError, internalServerError' + , notImplemented, notImplemented' + , badGateway, badGateway' + , serviceUnavailable, serviceUnavailable' + , gatewayTimeout, gatewayTimeout' + , hTTPVersionNotSupported, hTTPVersionNotSupported' + , variantAlsoNegotiates, variantAlsoNegotiates' + , insufficientStorage, insufficientStorage' + , loopDetected, loopDetected' + , notExtended, notExtended' + , networkAuthenticationRequired, networkAuthenticationRequired' ) where import Prelude @@ -13,241 +84,537 @@ import HTTPure.Headers as Headers import HTTPure.HTTPureM as HTTPureM import HTTPure.Status as Status --- | A response is a status and headers, and for some statuses, a body. You can --- | use the data constructor `Response` to send non-standard status codes. -data Response - - -- Non-standard status codes - = Response Int Headers.Headers Body.Body - - -- 1xx - | Continue Headers.Headers - | SwitchingProtocols Headers.Headers - | Processing Headers.Headers - - -- 2xx - | OK Headers.Headers Body.Body - | Created Headers.Headers - | Accepted Headers.Headers - | NonAuthoritativeInformation Headers.Headers Body.Body - | NoContent Headers.Headers - | ResetContent Headers.Headers - | PartialContent Headers.Headers Body.Body - | MultiStatus Headers.Headers Body.Body - | AlreadyReported Headers.Headers - | IMUsed Headers.Headers Body.Body - - -- 3xx - | MultipleChoices Headers.Headers Body.Body - | MovedPermanently Headers.Headers Body.Body - | Found Headers.Headers Body.Body - | SeeOther Headers.Headers Body.Body - | NotModified Headers.Headers - | UseProxy Headers.Headers Body.Body - | TemporaryRedirect Headers.Headers Body.Body - | PermanentRedirect Headers.Headers Body.Body - - -- 4xx - | BadRequest Headers.Headers Body.Body - | Unauthorized Headers.Headers - | PaymentRequired Headers.Headers - | Forbidden Headers.Headers - | NotFound Headers.Headers - | MethodNotAllowed Headers.Headers - | NotAcceptable Headers.Headers - | ProxyAuthenticationRequired Headers.Headers - | RequestTimeout Headers.Headers - | Conflict Headers.Headers Body.Body - | Gone Headers.Headers - | LengthRequired Headers.Headers - | PreconditionFailed Headers.Headers - | PayloadTooLarge Headers.Headers - | URITooLong Headers.Headers - | UnsupportedMediaType Headers.Headers - | RangeNotSatisfiable Headers.Headers - | ExpectationFailed Headers.Headers - | ImATeapot Headers.Headers - | MisdirectedRequest Headers.Headers - | UnprocessableEntity Headers.Headers - | Locked Headers.Headers - | FailedDependency Headers.Headers - | UpgradeRequired Headers.Headers - | PreconditionRequired Headers.Headers - | TooManyRequests Headers.Headers - | RequestHeaderFieldsTooLarge Headers.Headers - | UnavailableForLegalReasons Headers.Headers - - -- 5xx - | InternalServerError Headers.Headers Body.Body - | NotImplemented Headers.Headers - | BadGateway Headers.Headers - | ServiceUnavailable Headers.Headers - | GatewayTimeout Headers.Headers - | HTTPVersionNotSupported Headers.Headers - | VariantAlsoNegotiates Headers.Headers - | InsufficientStorage Headers.Headers - | LoopDetected Headers.Headers - | NotExtended Headers.Headers - | NetworkAuthenticationRequired Headers.Headers - -- | The ResponseM type simply conveniently wraps up an HTTPure monad that -- | returns a response. This type is the return type of all router/route -- | methods. type ResponseM e = HTTPureM.HTTPureM e Response --- | Get the Status for a Response -status :: Response -> Status.Status -status (Response s _ _) = s -status (Continue _) = 100 -status (SwitchingProtocols _) = 101 -status (Processing _) = 102 -status (OK _ _) = 200 -status (Created _) = 201 -status (Accepted _) = 202 -status (NonAuthoritativeInformation _ _) = 203 -status (NoContent _) = 204 -status (ResetContent _) = 205 -status (PartialContent _ _) = 206 -status (MultiStatus _ _) = 207 -status (AlreadyReported _) = 208 -status (IMUsed _ _) = 226 -status (MultipleChoices _ _) = 300 -status (MovedPermanently _ _) = 301 -status (Found _ _) = 302 -status (SeeOther _ _) = 303 -status (NotModified _) = 304 -status (UseProxy _ _) = 305 -status (TemporaryRedirect _ _) = 307 -status (PermanentRedirect _ _) = 308 -status (BadRequest _ _) = 400 -status (Unauthorized _) = 401 -status (PaymentRequired _) = 402 -status (Forbidden _) = 403 -status (NotFound _) = 404 -status (MethodNotAllowed _) = 405 -status (NotAcceptable _) = 406 -status (ProxyAuthenticationRequired _) = 407 -status (RequestTimeout _) = 408 -status (Conflict _ _) = 409 -status (Gone _) = 410 -status (LengthRequired _) = 411 -status (PreconditionFailed _) = 412 -status (PayloadTooLarge _) = 413 -status (URITooLong _) = 414 -status (UnsupportedMediaType _) = 415 -status (RangeNotSatisfiable _) = 416 -status (ExpectationFailed _) = 417 -status (ImATeapot _) = 418 -status (MisdirectedRequest _) = 421 -status (UnprocessableEntity _) = 422 -status (Locked _) = 423 -status (FailedDependency _) = 424 -status (UpgradeRequired _) = 426 -status (PreconditionRequired _) = 428 -status (TooManyRequests _) = 429 -status (RequestHeaderFieldsTooLarge _) = 431 -status (UnavailableForLegalReasons _) = 451 -status (InternalServerError _ _) = 500 -status (NotImplemented _) = 501 -status (BadGateway _) = 502 -status (ServiceUnavailable _) = 503 -status (GatewayTimeout _) = 504 -status (HTTPVersionNotSupported _) = 505 -status (VariantAlsoNegotiates _) = 506 -status (InsufficientStorage _) = 507 -status (LoopDetected _) = 508 -status (NotExtended _) = 510 -status (NetworkAuthenticationRequired _) = 511 - --- | Extract the Headers from a Response -headers :: Response -> Headers.Headers -headers (Response _ h _) = h -headers (Continue h) = h -headers (SwitchingProtocols h) = h -headers (Processing h) = h -headers (OK h _) = h -headers (Created h) = h -headers (Accepted h) = h -headers (NonAuthoritativeInformation h _) = h -headers (NoContent h) = h -headers (ResetContent h) = h -headers (PartialContent h _) = h -headers (MultiStatus h _) = h -headers (AlreadyReported h) = h -headers (IMUsed h _) = h -headers (MultipleChoices h _) = h -headers (MovedPermanently h _) = h -headers (Found h _) = h -headers (SeeOther h _) = h -headers (NotModified h) = h -headers (UseProxy h _) = h -headers (TemporaryRedirect h _) = h -headers (PermanentRedirect h _) = h -headers (BadRequest h _) = h -headers (Unauthorized h) = h -headers (PaymentRequired h) = h -headers (Forbidden h) = h -headers (NotFound h) = h -headers (MethodNotAllowed h) = h -headers (NotAcceptable h) = h -headers (ProxyAuthenticationRequired h) = h -headers (RequestTimeout h) = h -headers (Conflict h _) = h -headers (Gone h) = h -headers (LengthRequired h) = h -headers (PreconditionFailed h) = h -headers (PayloadTooLarge h) = h -headers (URITooLong h) = h -headers (UnsupportedMediaType h) = h -headers (RangeNotSatisfiable h) = h -headers (ExpectationFailed h) = h -headers (ImATeapot h) = h -headers (MisdirectedRequest h) = h -headers (UnprocessableEntity h) = h -headers (Locked h) = h -headers (FailedDependency h) = h -headers (UpgradeRequired h) = h -headers (PreconditionRequired h) = h -headers (TooManyRequests h) = h -headers (RequestHeaderFieldsTooLarge h) = h -headers (UnavailableForLegalReasons h) = h -headers (InternalServerError h _) = h -headers (NotImplemented h) = h -headers (BadGateway h) = h -headers (ServiceUnavailable h) = h -headers (GatewayTimeout h) = h -headers (HTTPVersionNotSupported h) = h -headers (VariantAlsoNegotiates h) = h -headers (InsufficientStorage h) = h -headers (LoopDetected h) = h -headers (NotExtended h) = h -headers (NetworkAuthenticationRequired h) = h - --- | Extract the Body from a Response -body :: Response -> Body.Body -body (Response _ _ b) = b -body (OK _ b) = b -body (NonAuthoritativeInformation _ b) = b -body (PartialContent _ b) = b -body (MultiStatus _ b) = b -body (IMUsed _ b) = b -body (MultipleChoices _ b) = b -body (MovedPermanently _ b) = b -body (Found _ b) = b -body (SeeOther _ b) = b -body (UseProxy _ b) = b -body (TemporaryRedirect _ b) = b -body (PermanentRedirect _ b) = b -body (BadRequest _ b) = b -body (Conflict _ b) = b -body (InternalServerError _ b) = b -body _ = "" +-- | A response is a status code, headers, and a body. +data Response = Response Status.Status Headers.Headers Body.Body -- | Given an HTTP response and a HTTPure response, this method will return a -- | monad encapsulating writing the HTTPure response to the HTTP response and -- | closing the HTTP response. send :: forall e. HTTP.Response -> Response -> HTTPureM.HTTPureM e Unit -send httpresponse response = do - Status.write httpresponse $ status response - Headers.write httpresponse $ headers response - Body.write httpresponse $ body response +send httpresponse (Response status headers body) = do + Status.write httpresponse $ status + Headers.write httpresponse $ headers + Body.write httpresponse $ body + +-- | For custom response statuses or providing a body for response codes that +-- | don't typically send one. +response :: forall e. + Status.Status -> + Headers.Headers -> + Body.Body -> + ResponseM e +response status headers body = pure $ Response status headers body + +-- | The same as `response` but without a body. +response' :: forall e. Status.Status -> Headers.Headers -> ResponseM e +response' status headers = response status headers $ "" + +--------- +-- 1xx -- +--------- + +-- | 100 +continue :: forall e. ResponseM e +continue = continue' $ Headers.headers [] + +-- | 100 with headers +continue' :: forall e. Headers.Headers -> ResponseM e +continue' = response' Status.continue + +-- | 101 +switchingProtocols :: forall e. ResponseM e +switchingProtocols = switchingProtocols' $ Headers.headers [] + +-- | 101 with headers +switchingProtocols' :: forall e. Headers.Headers -> ResponseM e +switchingProtocols' = response' Status.switchingProtocols + +-- | 102 +processing :: forall e. ResponseM e +processing = processing' $ Headers.headers [] + +-- | 102 with headers +processing' :: forall e. Headers.Headers -> ResponseM e +processing' = response' Status.processing + +--------- +-- 2xx -- +--------- + +-- | 200 +ok :: forall e. Body.Body -> ResponseM e +ok = ok' $ Headers.headers [] + +-- | 200 with headers +ok' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +ok' = response Status.ok + +-- | 201 +created :: forall e. ResponseM e +created = created' $ Headers.headers [] + +-- | 201 with headers +created' :: forall e. Headers.Headers -> ResponseM e +created' = response' Status.created + +-- | 202 +accepted :: forall e. ResponseM e +accepted = accepted' $ Headers.headers [] + +-- | 202 with headers +accepted' :: forall e. Headers.Headers -> ResponseM e +accepted' = response' Status.accepted + +-- | 203 +nonAuthoritativeInformation :: forall e. Body.Body -> ResponseM e +nonAuthoritativeInformation = nonAuthoritativeInformation' $ Headers.headers [] + +-- | 203 with headers +nonAuthoritativeInformation' :: forall e. + Headers.Headers -> + Body.Body -> + ResponseM e +nonAuthoritativeInformation' = response Status.nonAuthoritativeInformation + +-- | 204 +noContent :: forall e. ResponseM e +noContent = noContent' $ Headers.headers [] + +-- | 204 with headers +noContent' :: forall e. Headers.Headers -> ResponseM e +noContent' = response' Status.noContent + +-- | 205 +resetContent :: forall e. ResponseM e +resetContent = resetContent' $ Headers.headers [] + +-- | 205 with headers +resetContent' :: forall e. Headers.Headers -> ResponseM e +resetContent' = response' Status.resetContent + +-- | 206 +partialContent :: forall e. Body.Body -> ResponseM e +partialContent = partialContent' $ Headers.headers [] + +-- | 206 with headers +partialContent' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +partialContent' = response Status.partialContent + +-- | 207 +multiStatus :: forall e. Body.Body -> ResponseM e +multiStatus = multiStatus' $ Headers.headers [] + +-- | 207 with headers +multiStatus' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +multiStatus' = response Status.multiStatus + +-- | 208 +alreadyReported :: forall e. ResponseM e +alreadyReported = alreadyReported' $ Headers.headers [] + +-- | 208 with headers +alreadyReported' :: forall e. Headers.Headers -> ResponseM e +alreadyReported' = response' Status.alreadyReported + +-- | 226 +iMUsed :: forall e. Body.Body -> ResponseM e +iMUsed = iMUsed' $ Headers.headers [] + +-- | 226 with headers +iMUsed' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +iMUsed' = response Status.iMUsed + +--------- +-- 3xx -- +--------- + +-- | 300 +multipleChoices :: forall e. Body.Body -> ResponseM e +multipleChoices = multipleChoices' $ Headers.headers [] + +-- | 300 with headers +multipleChoices' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +multipleChoices' = response Status.multipleChoices + +-- | 301 +movedPermanently :: forall e. Body.Body -> ResponseM e +movedPermanently = movedPermanently' $ Headers.headers [] + +-- | 301 with headers +movedPermanently' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +movedPermanently' = response Status.movedPermanently + +-- | 302 +found :: forall e. Body.Body -> ResponseM e +found = found' $ Headers.headers [] + +-- | 302 with headers +found' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +found' = response Status.found + +-- | 303 +seeOther :: forall e. Body.Body -> ResponseM e +seeOther = seeOther' $ Headers.headers [] + +-- | 303 with headers +seeOther' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +seeOther' = response Status.seeOther + +-- | 304 +notModified :: forall e. ResponseM e +notModified = notModified' $ Headers.headers [] + +-- | 304 with headers +notModified' :: forall e. Headers.Headers -> ResponseM e +notModified' = response' Status.notModified + +-- | 305 +useProxy :: forall e. Body.Body -> ResponseM e +useProxy = useProxy' $ Headers.headers [] + +-- | 305 with headers +useProxy' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +useProxy' = response Status.useProxy + +-- | 307 +temporaryRedirect :: forall e. Body.Body -> ResponseM e +temporaryRedirect = temporaryRedirect' $ Headers.headers [] + +-- | 307 with headers +temporaryRedirect' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +temporaryRedirect' = response Status.temporaryRedirect + +-- | 308 +permanentRedirect :: forall e. Body.Body -> ResponseM e +permanentRedirect = permanentRedirect' $ Headers.headers [] + +-- | 308 with headers +permanentRedirect' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +permanentRedirect' = response Status.permanentRedirect + + +--------- +-- 4xx -- +--------- + +-- | 400 +badRequest :: forall e. Body.Body -> ResponseM e +badRequest = badRequest' $ Headers.headers [] + +-- | 400 with headers +badRequest' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +badRequest' = response Status.badRequest + +-- | 401 +unauthorized :: forall e. ResponseM e +unauthorized = unauthorized' $ Headers.headers [] + +-- | 401 with headers +unauthorized' :: forall e. Headers.Headers -> ResponseM e +unauthorized' = response' Status.unauthorized + +-- | 402 +paymentRequired :: forall e. ResponseM e +paymentRequired = paymentRequired' $ Headers.headers [] + +-- | 402 with headers +paymentRequired' :: forall e. Headers.Headers -> ResponseM e +paymentRequired' = response' Status.paymentRequired + +-- | 403 +forbidden :: forall e. ResponseM e +forbidden = forbidden' $ Headers.headers [] + +-- | 403 with headers +forbidden' :: forall e. Headers.Headers -> ResponseM e +forbidden' = response' Status.forbidden + +-- | 404 +notFound :: forall e. ResponseM e +notFound = notFound' $ Headers.headers [] + +-- | 404 with headers +notFound' :: forall e. Headers.Headers -> ResponseM e +notFound' = response' Status.notFound + +-- | 405 +methodNotAllowed :: forall e. ResponseM e +methodNotAllowed = methodNotAllowed' $ Headers.headers [] + +-- | 405 with headers +methodNotAllowed' :: forall e. Headers.Headers -> ResponseM e +methodNotAllowed' = response' Status.methodNotAllowed + +-- | 406 +notAcceptable :: forall e. ResponseM e +notAcceptable = notAcceptable' $ Headers.headers [] + +-- | 406 with headers +notAcceptable' :: forall e. Headers.Headers -> ResponseM e +notAcceptable' = response' Status.notAcceptable + +-- | 407 +proxyAuthenticationRequired :: forall e. ResponseM e +proxyAuthenticationRequired = proxyAuthenticationRequired' $ Headers.headers [] + +-- | 407 with headers +proxyAuthenticationRequired' :: forall e. Headers.Headers -> ResponseM e +proxyAuthenticationRequired' = response' Status.proxyAuthenticationRequired + +-- | 408 +requestTimeout :: forall e. ResponseM e +requestTimeout = requestTimeout' $ Headers.headers [] + +-- | 408 with headers +requestTimeout' :: forall e. Headers.Headers -> ResponseM e +requestTimeout' = response' Status.requestTimeout + +-- | 409 +conflict :: forall e. Body.Body -> ResponseM e +conflict = conflict' $ Headers.headers [] + +-- | 409 with headers +conflict' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +conflict' = response Status.conflict + +-- | 410 +gone :: forall e. ResponseM e +gone = gone' $ Headers.headers [] + +-- | 410 with headers +gone' :: forall e. Headers.Headers -> ResponseM e +gone' = response' Status.gone + +-- | 411 +lengthRequired :: forall e. ResponseM e +lengthRequired = lengthRequired' $ Headers.headers [] + +-- | 411 with headers +lengthRequired' :: forall e. Headers.Headers -> ResponseM e +lengthRequired' = response' Status.lengthRequired + +-- | 412 +preconditionFailed :: forall e. ResponseM e +preconditionFailed = preconditionFailed' $ Headers.headers [] + +-- | 412 with headers +preconditionFailed' :: forall e. Headers.Headers -> ResponseM e +preconditionFailed' = response' Status.preconditionFailed + +-- | 413 +payloadTooLarge :: forall e. ResponseM e +payloadTooLarge = payloadTooLarge' $ Headers.headers [] + +-- | 413 with headers +payloadTooLarge' :: forall e. Headers.Headers -> ResponseM e +payloadTooLarge' = response' Status.payloadTooLarge + +-- | 414 +uRITooLong :: forall e. ResponseM e +uRITooLong = uRITooLong' $ Headers.headers [] + +-- | 414 with headers +uRITooLong' :: forall e. Headers.Headers -> ResponseM e +uRITooLong' = response' Status.uRITooLong + +-- | 415 +unsupportedMediaType :: forall e. ResponseM e +unsupportedMediaType = unsupportedMediaType' $ Headers.headers [] + +-- | 415 with headers +unsupportedMediaType' :: forall e. Headers.Headers -> ResponseM e +unsupportedMediaType' = response' Status.unsupportedMediaType + +-- | 416 +rangeNotSatisfiable :: forall e. ResponseM e +rangeNotSatisfiable = rangeNotSatisfiable' $ Headers.headers [] + +-- | 416 with headers +rangeNotSatisfiable' :: forall e. Headers.Headers -> ResponseM e +rangeNotSatisfiable' = response' Status.rangeNotSatisfiable + +-- | 417 +expectationFailed :: forall e. ResponseM e +expectationFailed = expectationFailed' $ Headers.headers [] + +-- | 417 with headers +expectationFailed' :: forall e. Headers.Headers -> ResponseM e +expectationFailed' = response' Status.expectationFailed + +-- | 418 +imATeapot :: forall e. ResponseM e +imATeapot = imATeapot' $ Headers.headers [] + +-- | 418 with headers +imATeapot' :: forall e. Headers.Headers -> ResponseM e +imATeapot' = response' Status.imATeapot + +-- | 421 +misdirectedRequest :: forall e. ResponseM e +misdirectedRequest = misdirectedRequest' $ Headers.headers [] + +-- | 421 with headers +misdirectedRequest' :: forall e. Headers.Headers -> ResponseM e +misdirectedRequest' = response' Status.misdirectedRequest + +-- | 422 +unprocessableEntity :: forall e. ResponseM e +unprocessableEntity = unprocessableEntity' $ Headers.headers [] + +-- | 422 with headers +unprocessableEntity' :: forall e. Headers.Headers -> ResponseM e +unprocessableEntity' = response' Status.unprocessableEntity + +-- | 423 +locked :: forall e. ResponseM e +locked = locked' $ Headers.headers [] + +-- | 423 with headers +locked' :: forall e. Headers.Headers -> ResponseM e +locked' = response' Status.locked + +-- | 424 +failedDependency :: forall e. ResponseM e +failedDependency = failedDependency' $ Headers.headers [] + +-- | 424 with headers +failedDependency' :: forall e. Headers.Headers -> ResponseM e +failedDependency' = response' Status.failedDependency + +-- | 426 +upgradeRequired :: forall e. ResponseM e +upgradeRequired = upgradeRequired' $ Headers.headers [] + +-- | 426 with headers +upgradeRequired' :: forall e. Headers.Headers -> ResponseM e +upgradeRequired' = response' Status.upgradeRequired + +-- | 428 +preconditionRequired :: forall e. ResponseM e +preconditionRequired = preconditionRequired' $ Headers.headers [] + +-- | 428 with headers +preconditionRequired' :: forall e. Headers.Headers -> ResponseM e +preconditionRequired' = response' Status.preconditionRequired + +-- | 429 +tooManyRequests :: forall e. ResponseM e +tooManyRequests = tooManyRequests' $ Headers.headers [] + +-- | 429 with headers +tooManyRequests' :: forall e. Headers.Headers -> ResponseM e +tooManyRequests' = response' Status.tooManyRequests + +-- | 431 +requestHeaderFieldsTooLarge :: forall e. ResponseM e +requestHeaderFieldsTooLarge = requestHeaderFieldsTooLarge' $ Headers.headers [] + +-- | 431 with headers +requestHeaderFieldsTooLarge' :: forall e. Headers.Headers -> ResponseM e +requestHeaderFieldsTooLarge' = response' Status.requestHeaderFieldsTooLarge + +-- | 451 +unavailableForLegalReasons :: forall e. ResponseM e +unavailableForLegalReasons = unavailableForLegalReasons' $ Headers.headers [] + +-- | 451 with headers +unavailableForLegalReasons' :: forall e. Headers.Headers -> ResponseM e +unavailableForLegalReasons' = response' Status.unavailableForLegalReasons + +--------- +-- 5xx -- +--------- + +-- | 500 +internalServerError :: forall e. Body.Body -> ResponseM e +internalServerError = internalServerError' $ Headers.headers [] + +-- | 500 with headers +internalServerError' :: forall e. Headers.Headers -> Body.Body -> ResponseM e +internalServerError' = response Status.internalServerError + +-- | 501 +notImplemented :: forall e. ResponseM e +notImplemented = notImplemented' $ Headers.headers [] + +-- | 501 with headers +notImplemented' :: forall e. Headers.Headers -> ResponseM e +notImplemented' = response' Status.notImplemented + +-- | 502 +badGateway :: forall e. ResponseM e +badGateway = badGateway' $ Headers.headers [] + +-- | 502 with headers +badGateway' :: forall e. Headers.Headers -> ResponseM e +badGateway' = response' Status.badGateway + +-- | 503 +serviceUnavailable :: forall e. ResponseM e +serviceUnavailable = serviceUnavailable' $ Headers.headers [] + +-- | 503 with headers +serviceUnavailable' :: forall e. Headers.Headers -> ResponseM e +serviceUnavailable' = response' Status.serviceUnavailable + +-- | 504 +gatewayTimeout :: forall e. ResponseM e +gatewayTimeout = gatewayTimeout' $ Headers.headers [] + +-- | 504 with headers +gatewayTimeout' :: forall e. Headers.Headers -> ResponseM e +gatewayTimeout' = response' Status.gatewayTimeout + +-- | 505 +hTTPVersionNotSupported :: forall e. ResponseM e +hTTPVersionNotSupported = hTTPVersionNotSupported' $ Headers.headers [] + +-- | 505 with headers +hTTPVersionNotSupported' :: forall e. Headers.Headers -> ResponseM e +hTTPVersionNotSupported' = response' Status.hTTPVersionNotSupported + +-- | 506 +variantAlsoNegotiates :: forall e. ResponseM e +variantAlsoNegotiates = variantAlsoNegotiates' $ Headers.headers [] + +-- | 506 with headers +variantAlsoNegotiates' :: forall e. Headers.Headers -> ResponseM e +variantAlsoNegotiates' = response' Status.variantAlsoNegotiates + +-- | 507 +insufficientStorage :: forall e. ResponseM e +insufficientStorage = insufficientStorage' $ Headers.headers [] + +-- | 507 with headers +insufficientStorage' :: forall e. Headers.Headers -> ResponseM e +insufficientStorage' = response' Status.insufficientStorage + +-- | 508 +loopDetected :: forall e. ResponseM e +loopDetected = loopDetected' $ Headers.headers [] + +-- | 508 with headers +loopDetected' :: forall e. Headers.Headers -> ResponseM e +loopDetected' = response' Status.loopDetected + +-- | 510 +notExtended :: forall e. ResponseM e +notExtended = notExtended' $ Headers.headers [] + +-- | 510 with headers +notExtended' :: forall e. Headers.Headers -> ResponseM e +notExtended' = response' Status.notExtended + +-- | 511 +networkAuthenticationRequired :: forall e. ResponseM e +networkAuthenticationRequired = + networkAuthenticationRequired' $ Headers.headers [] + +-- | 511 with headers +networkAuthenticationRequired' :: forall e. Headers.Headers -> ResponseM e +networkAuthenticationRequired' = response' Status.networkAuthenticationRequired diff --git a/src/HTTPure/Status.purs b/src/HTTPure/Status.purs index defb7bf..6f260a0 100644 --- a/src/HTTPure/Status.purs +++ b/src/HTTPure/Status.purs @@ -1,6 +1,76 @@ module HTTPure.Status ( Status , write + + -- 1xx + , continue + , switchingProtocols + , processing + + -- 2xx + , ok + , created + , accepted + , nonAuthoritativeInformation + , noContent + , resetContent + , partialContent + , multiStatus + , alreadyReported + , iMUsed + + -- 3xx + , multipleChoices + , movedPermanently + , found + , seeOther + , notModified + , useProxy + , temporaryRedirect + , permanentRedirect + + -- 4xx + , badRequest + , unauthorized + , paymentRequired + , forbidden + , notFound + , methodNotAllowed + , notAcceptable + , proxyAuthenticationRequired + , requestTimeout + , conflict + , gone + , lengthRequired + , preconditionFailed + , payloadTooLarge + , uRITooLong + , unsupportedMediaType + , rangeNotSatisfiable + , expectationFailed + , imATeapot + , misdirectedRequest + , unprocessableEntity + , locked + , failedDependency + , upgradeRequired + , preconditionRequired + , tooManyRequests + , requestHeaderFieldsTooLarge + , unavailableForLegalReasons + + -- 5xx + , internalServerError + , notImplemented + , badGateway + , serviceUnavailable + , gatewayTimeout + , hTTPVersionNotSupported + , variantAlsoNegotiates + , insufficientStorage + , loopDetected + , notExtended + , networkAuthenticationRequired ) where import Prelude @@ -17,3 +87,264 @@ write :: forall e. Status -> Eff.Eff (http :: HTTP.HTTP | e) Unit write = HTTP.setStatusCode + +--------- +-- 1xx -- +--------- + +-- | 100 +continue :: Status +continue = 100 + +-- | 101 +switchingProtocols :: Status +switchingProtocols = 101 + +-- | 102 +processing :: Status +processing = 102 + +--------- +-- 2xx -- +--------- + +-- | 200 +ok :: Status +ok = 200 + +-- | 201 +created :: Status +created = 201 + +-- | 202 +accepted :: Status +accepted = 202 + +-- | 203 +nonAuthoritativeInformation :: Status +nonAuthoritativeInformation = 203 + +-- | 204 +noContent :: Status +noContent = 204 + +-- | 205 +resetContent :: Status +resetContent = 205 + +-- | 206 +partialContent :: Status +partialContent = 206 + +-- | 207 +multiStatus :: Status +multiStatus = 207 + +-- | 208 +alreadyReported :: Status +alreadyReported = 208 + +-- | 226 +iMUsed :: Status +iMUsed = 226 + +--------- +-- 3xx -- +--------- + +-- | 300 +multipleChoices :: Status +multipleChoices = 300 + +-- | 301 +movedPermanently :: Status +movedPermanently = 301 + +-- | 302 +found :: Status +found = 302 + +-- | 303 +seeOther :: Status +seeOther = 303 + +-- | 304 +notModified :: Status +notModified = 304 + +-- | 305 +useProxy :: Status +useProxy = 305 + +-- | 307 +temporaryRedirect :: Status +temporaryRedirect = 307 + +-- | 308 +permanentRedirect :: Status +permanentRedirect = 308 + + +--------- +-- 4xx -- +--------- + +-- | 400 +badRequest :: Status +badRequest = 400 + +-- | 401 +unauthorized :: Status +unauthorized = 401 + +-- | 402 +paymentRequired :: Status +paymentRequired = 402 + +-- | 403 +forbidden :: Status +forbidden = 403 + +-- | 404 +notFound :: Status +notFound = 404 + +-- | 405 +methodNotAllowed :: Status +methodNotAllowed = 405 + +-- | 406 +notAcceptable :: Status +notAcceptable = 406 + +-- | 407 +proxyAuthenticationRequired :: Status +proxyAuthenticationRequired = 407 + +-- | 408 +requestTimeout :: Status +requestTimeout = 408 + +-- | 409 +conflict :: Status +conflict = 409 + +-- | 410 +gone :: Status +gone = 410 + +-- | 411 +lengthRequired :: Status +lengthRequired = 411 + +-- | 412 +preconditionFailed :: Status +preconditionFailed = 412 + +-- | 413 +payloadTooLarge :: Status +payloadTooLarge = 413 + +-- | 414 +uRITooLong :: Status +uRITooLong = 414 + +-- | 415 +unsupportedMediaType :: Status +unsupportedMediaType = 415 + +-- | 416 +rangeNotSatisfiable :: Status +rangeNotSatisfiable = 416 + +-- | 417 +expectationFailed :: Status +expectationFailed = 417 + +-- | 418 +imATeapot :: Status +imATeapot = 418 + +-- | 421 +misdirectedRequest :: Status +misdirectedRequest = 421 + +-- | 422 +unprocessableEntity :: Status +unprocessableEntity = 422 + +-- | 423 +locked :: Status +locked = 423 + +-- | 424 +failedDependency :: Status +failedDependency = 424 + +-- | 426 +upgradeRequired :: Status +upgradeRequired = 426 + +-- | 428 +preconditionRequired :: Status +preconditionRequired = 428 + +-- | 429 +tooManyRequests :: Status +tooManyRequests = 429 + +-- | 431 +requestHeaderFieldsTooLarge :: Status +requestHeaderFieldsTooLarge = 431 + +-- | 451 +unavailableForLegalReasons :: Status +unavailableForLegalReasons = 451 + +--------- +-- 5xx -- +--------- + +-- | 500 +internalServerError :: Status +internalServerError = 500 + +-- | 501 +notImplemented :: Status +notImplemented = 501 + +-- | 502 +badGateway :: Status +badGateway = 502 + +-- | 503 +serviceUnavailable :: Status +serviceUnavailable = 503 + +-- | 504 +gatewayTimeout :: Status +gatewayTimeout = 504 + +-- | 505 +hTTPVersionNotSupported :: Status +hTTPVersionNotSupported = 505 + +-- | 506 +variantAlsoNegotiates :: Status +variantAlsoNegotiates = 506 + +-- | 507 +insufficientStorage :: Status +insufficientStorage = 507 + +-- | 508 +loopDetected :: Status +loopDetected = 508 + +-- | 510 +notExtended :: Status +notExtended = 510 + +-- | 511 +networkAuthenticationRequired :: Status +networkAuthenticationRequired = 511 diff --git a/test/HTTPure/BodySpec.purs b/test/HTTPure/BodySpec.purs index 70b9799..cda6fa8 100644 --- a/test/HTTPure/BodySpec.purs +++ b/test/HTTPure/BodySpec.purs @@ -3,7 +3,6 @@ module HTTPure.BodySpec where import Prelude import Control.Monad.Eff.Class as EffClass -import Data.StrMap as StrMap import Test.Spec as Spec import HTTPure.Body as Body @@ -13,9 +12,8 @@ import HTTPure.SpecHelpers ((?=)) readSpec :: SpecHelpers.Test readSpec = Spec.describe "read" do - Spec.it "returns the body of the Request" do - let req = SpecHelpers.mockRequest "GET" "" "test" StrMap.empty - request <- EffClass.liftEff req + Spec.it "is the body of the Request" do + request <- SpecHelpers.mockRequest "GET" "" "test" [] body <- Body.read request body ?= "test" diff --git a/test/HTTPure/HeadersSpec.purs b/test/HTTPure/HeadersSpec.purs index 98b7c5e..cf566e2 100644 --- a/test/HTTPure/HeadersSpec.purs +++ b/test/HTTPure/HeadersSpec.purs @@ -3,10 +3,11 @@ module HTTPure.HeadersSpec where import Prelude import Control.Monad.Eff.Class as EffClass -import Data.StrMap as StrMap +import Data.Tuple as Tuple import Test.Spec as Spec import HTTPure.Headers as Headers +import HTTPure.Lookup ((!!)) import HTTPure.SpecHelpers as SpecHelpers import HTTPure.SpecHelpers ((?=)) @@ -16,26 +17,73 @@ lookupSpec = Spec.describe "lookup" do Spec.describe "when the string is in the header set" do Spec.describe "when searching with lowercase" do Spec.it "is the string" do - Headers.lookup mockHeaders "x-test" ?= "test" + mockHeaders !! "x-test" ?= "test" Spec.describe "when searching with uppercase" do Spec.it "is the string" do - Headers.lookup mockHeaders "X-Test" ?= "test" + mockHeaders !! "X-Test" ?= "test" Spec.describe "when the string is not in the header set" do Spec.it "is an empty string" do - Headers.lookup StrMap.empty "X-Test" ?= "" + (Headers.headers []) !! "X-Test" ?= "" where - mockHeaders = StrMap.singleton "x-test" "test" + mockHeaders = Headers.headers [Tuple.Tuple "x-test" "test"] + +showSpec :: SpecHelpers.Test +showSpec = Spec.describe "show" do + Spec.it "is a string representing the headers in HTTP format" do + show mockHeaders ?= "Test1: test1\nTest2: test2\n\n" + where + mockHeaders = + Headers.headers + [ Tuple.Tuple "Test1" "test1" + , Tuple.Tuple "Test2" "test2" + ] + +eqSpec :: SpecHelpers.Test +eqSpec = Spec.describe "eq" do + Spec.describe "when the two Headers contain the same keys and values" do + Spec.it "is true" do + eq mockHeaders1 mockHeaders2 ?= true + Spec.describe "when the two Headers contain different keys and values" do + Spec.it "is false" do + eq mockHeaders1 mockHeaders3 ?= false + Spec.describe "when the one Headers contains additional keys and values" do + Spec.it "is false" do + eq mockHeaders1 mockHeaders4 ?= false + where + mockHeaders1 = Headers.headers [ Tuple.Tuple "Test1" "test1" ] + mockHeaders2 = Headers.headers [ Tuple.Tuple "Test1" "test1" ] + mockHeaders3 = Headers.headers [ Tuple.Tuple "Test2" "test2" ] + mockHeaders4 = + Headers.headers + [ Tuple.Tuple "Test1" "test1" + , Tuple.Tuple "Test2" "test2" + ] + +readSpec :: SpecHelpers.Test +readSpec = Spec.describe "read" do + Spec.describe "with no headers" do + Spec.it "is an empty StrMap" do + request <- SpecHelpers.mockRequest "" "" "" [] + Headers.read request ?= Headers.headers [] + Spec.describe "with headers" do + Spec.it "is an StrMap with the contents of the headers" do + let testHeader = [Tuple.Tuple "X-Test" "test"] + request <- SpecHelpers.mockRequest "" "" "" testHeader + Headers.read request ?= Headers.headers testHeader writeSpec :: SpecHelpers.Test writeSpec = Spec.describe "write" do Spec.it "writes the headers to the response" do header <- EffClass.liftEff do mock <- SpecHelpers.mockResponse - Headers.write mock $ StrMap.singleton "X-Test" "test" + Headers.write mock $ Headers.headers [Tuple.Tuple "X-Test" "test"] pure $ SpecHelpers.getResponseHeader "X-Test" mock header ?= "test" headersSpec :: SpecHelpers.Test headersSpec = Spec.describe "Headers" do lookupSpec + showSpec + eqSpec + readSpec writeSpec diff --git a/test/HTTPure/IntegrationSpec.purs b/test/HTTPure/IntegrationSpec.purs index 3d55337..8adb709 100644 --- a/test/HTTPure/IntegrationSpec.purs +++ b/test/HTTPure/IntegrationSpec.purs @@ -12,6 +12,7 @@ import HTTPure.SpecHelpers ((?=)) import Headers as Headers import HelloWorld as HelloWorld import MultiRoute as MultiRoute +import PathSegments as PathSegments import Post as Post import SSL as SSL @@ -40,6 +41,15 @@ multiRouteSpec = Spec.it "runs the multi route example" do goodbye ?= "goodbye" where port = MultiRoute.port +pathSegmentsSpec :: SpecHelpers.Test +pathSegmentsSpec = Spec.it "runs the path segments example" do + EffClass.liftEff PathSegments.main + foo <- SpecHelpers.get port StrMap.empty "/segment/foo" + foo ?= "foo" + somebars <- SpecHelpers.get port StrMap.empty "/some/bars" + somebars?= "[\"some\",\"bars\"]" + where port = PathSegments.port + postSpec :: SpecHelpers.Test postSpec = Spec.it "runs the post example" do EffClass.liftEff Post.main @@ -59,5 +69,6 @@ integrationSpec = Spec.describe "Integration" do headersSpec helloWorldSpec multiRouteSpec + pathSegmentsSpec postSpec sslSpec diff --git a/test/HTTPure/LookupSpec.purs b/test/HTTPure/LookupSpec.purs new file mode 100644 index 0000000..1dfa2fc --- /dev/null +++ b/test/HTTPure/LookupSpec.purs @@ -0,0 +1,23 @@ +module HTTPure.LookupSpec where + +import Prelude + +import Test.Spec as Spec + +import HTTPure.Lookup ((!!)) + +import HTTPure.SpecHelpers as SpecHelpers +import HTTPure.SpecHelpers ((?=)) + +lookupArraySpec :: SpecHelpers.Test +lookupArraySpec = Spec.describe "lookupArray" do + Spec.describe "when the index is in bounds" do + Spec.it "is the segment at the index" do + [ "one", "two", "three" ] !! 1 ?= "two" + Spec.describe "when the index is out of bounds" do + Spec.it "is an empty monoid" do + [ "one", "two", "three" ] !! 4 ?= "" + +lookupSpec :: SpecHelpers.Test +lookupSpec = Spec.describe "Lookup" do + lookupArraySpec diff --git a/test/HTTPure/MethodSpec.purs b/test/HTTPure/MethodSpec.purs new file mode 100644 index 0000000..b1e948e --- /dev/null +++ b/test/HTTPure/MethodSpec.purs @@ -0,0 +1,52 @@ +module HTTPure.MethodSpec where + +import Prelude + +import Test.Spec as Spec + +import HTTPure.Method as Method + +import HTTPure.SpecHelpers as SpecHelpers +import HTTPure.SpecHelpers ((?=)) + +showSpec :: SpecHelpers.Test +showSpec = Spec.describe "show" do + Spec.describe "with a Get" do + Spec.it "is 'Get'" do + show Method.Get ?= "Get" + Spec.describe "with a Post" do + Spec.it "is 'Post'" do + show Method.Post ?= "Post" + Spec.describe "with a Put" do + Spec.it "is 'Put'" do + show Method.Put ?= "Put" + Spec.describe "with a Delete" do + Spec.it "is 'Delete'" do + show Method.Delete ?= "Delete" + Spec.describe "with a Head" do + Spec.it "is 'Head'" do + show Method.Head ?= "Head" + Spec.describe "with a Connect" do + Spec.it "is 'Connect'" do + show Method.Connect ?= "Connect" + Spec.describe "with a Options" do + Spec.it "is 'Options'" do + show Method.Options ?= "Options" + Spec.describe "with a Trace" do + Spec.it "is 'Trace'" do + show Method.Trace ?= "Trace" + Spec.describe "with a Patch" do + Spec.it "is 'Patch'" do + show Method.Patch ?= "Patch" + +readSpec :: SpecHelpers.Test +readSpec = Spec.describe "read" do + Spec.describe "with a 'GET' Request" do + Spec.it "is Get" do + request <- SpecHelpers.mockRequest "GET" "" "" [] + Method.read request ?= Method.Get + +methodSpec :: SpecHelpers.Test +methodSpec = Spec.describe "Method" do + showSpec + readSpec diff --git a/test/HTTPure/PathSpec.purs b/test/HTTPure/PathSpec.purs index 0797551..7689998 100644 --- a/test/HTTPure/PathSpec.purs +++ b/test/HTTPure/PathSpec.purs @@ -4,8 +4,30 @@ import Prelude import Test.Spec as Spec +import HTTPure.Path as Path + import HTTPure.SpecHelpers as SpecHelpers +import HTTPure.SpecHelpers ((?=)) + +readSpec :: SpecHelpers.Test +readSpec = Spec.describe "read" do + Spec.describe "with a query string" do + Spec.it "is just the path" do + request <- SpecHelpers.mockRequest "GET" "test/path?blabla" "" [] + Path.read request ?= [ "test", "path" ] + Spec.describe "with no query string" do + Spec.it "is the path" do + request <- SpecHelpers.mockRequest "GET" "test/path" "" [] + Path.read request ?= [ "test", "path" ] + Spec.describe "with no segments" do + Spec.it "is an empty array" do + request <- SpecHelpers.mockRequest "GET" "" "" [] + Path.read request ?= [] + Spec.describe "with empty segments" do + Spec.it "strips the empty segments" do + request <- SpecHelpers.mockRequest "GET" "//test//path///?query" "" [] + Path.read request ?= [ "test", "path" ] pathSpec :: SpecHelpers.Test pathSpec = Spec.describe "Path" do - pure unit + readSpec diff --git a/test/HTTPure/QuerySpec.purs b/test/HTTPure/QuerySpec.purs new file mode 100644 index 0000000..00741bb --- /dev/null +++ b/test/HTTPure/QuerySpec.purs @@ -0,0 +1,21 @@ +module HTTPure.QuerySpec where + +import Prelude + +import Data.StrMap as StrMap +import Test.Spec as Spec + +import HTTPure.Query as Query + +import HTTPure.SpecHelpers as SpecHelpers +import HTTPure.SpecHelpers ((?=)) + +readSpec :: SpecHelpers.Test +readSpec = Spec.describe "read" do + Spec.it "is always an empty StrMap (until the stub is fully implemented)" do + req <- SpecHelpers.mockRequest "" "" "" [] + Query.read req ?= StrMap.empty + +querySpec :: SpecHelpers.Test +querySpec = Spec.describe "Query" do + readSpec diff --git a/test/HTTPure/RequestSpec.purs b/test/HTTPure/RequestSpec.purs index 29eec9b..4521179 100644 --- a/test/HTTPure/RequestSpec.purs +++ b/test/HTTPure/RequestSpec.purs @@ -2,247 +2,40 @@ module HTTPure.RequestSpec where import Prelude -import Control.Monad.Eff.Class as EffClass +import Data.Tuple as Tuple import Data.StrMap as StrMap import Test.Spec as Spec -import Test.Spec.Assertions as Assertions import HTTPure.Headers as Headers +import HTTPure.Method as Method import HTTPure.Request as Request import HTTPure.SpecHelpers as SpecHelpers import HTTPure.SpecHelpers ((?=)) -showSpec :: SpecHelpers.Test -showSpec = Spec.describe "show" do - Spec.describe "with a POST" do - Spec.it "is the method and the path" do - show (Request.Post StrMap.empty "test" "") ?= "POST: test" - Spec.describe "with a PUT" do - Spec.it "is the method and the path" do - show (Request.Put StrMap.empty "test" "") ?= "PUT: test" - Spec.describe "with a DELETE" do - Spec.it "is the method and the path" do - show (Request.Delete StrMap.empty "test") ?= "DELETE: test" - Spec.describe "with a HEAD" do - Spec.it "is the method and the path" do - show (Request.Head StrMap.empty "test") ?= "HEAD: test" - Spec.describe "with a CONNECT" do - Spec.it "is the method and the path" do - show (Request.Connect StrMap.empty "test" "") ?= "CONNECT: test" - Spec.describe "with a OPTIONS" do - Spec.it "is the method and the path" do - show (Request.Options StrMap.empty "test") ?= "OPTIONS: test" - Spec.describe "with a TRACE" do - Spec.it "is the method and the path" do - show (Request.Trace StrMap.empty "test") ?= "TRACE: test" - Spec.describe "with a PATH" do - Spec.it "is the method and the path" do - show (Request.Patch StrMap.empty "test" "") ?= "PATCH: test" - Spec.describe "with a GET" do - Spec.it "is the method and the path" do - show (Request.Get StrMap.empty "test") ?= "GET: test" - fromHTTPRequestSpec :: SpecHelpers.Test fromHTTPRequestSpec = Spec.describe "fromHTTPRequest" do - - Spec.describe "with a POST" do - Spec.it "is a Post" do - response <- mock "POST" "" "" StrMap.empty - case response of - (Request.Post _ _ _) -> pure unit - a -> Assertions.fail $ "expected a Post, got " <> show a - Spec.it "has the correct headers" do - response <- mock "POST" "" "" mockHeader - case response of - (Request.Post headers _ _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Post, got " <> show a - Spec.it "has the correct path" do - response <- mock "POST" "test" "" StrMap.empty - case response of - (Request.Post _ "test" _) -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - Spec.it "has the correct body" do - response <- mock "POST" "" "test" StrMap.empty - case response of - (Request.Post _ _ "test") -> pure unit - (Request.Post _ _ body) -> - Assertions.fail $ "expected the body 'test', got " <> body - a -> Assertions.fail $ "expected a post, got " <> show a - - Spec.describe "with a PUT" do - Spec.it "is a Put" do - response <- mock "PUT" "" "" StrMap.empty - case response of - (Request.Put _ _ _) -> pure unit - a -> Assertions.fail $ "expected a Put, got " <> show a - Spec.it "has the correct headers" do - response <- mock "PUT" "" "" mockHeader - case response of - (Request.Put headers _ _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Put, got " <> show a - Spec.it "has the correct path" do - response <- mock "PUT" "test" "" StrMap.empty - case response of - (Request.Put _ "test" _) -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - Spec.it "has the correct body" do - response <- mock "PUT" "" "test" StrMap.empty - case response of - (Request.Put _ _ "test") -> pure unit - (Request.Put _ _ body) -> - Assertions.fail $ "expected the body 'test', got " <> body - a -> Assertions.fail $ "expected a put, got " <> show a - - Spec.describe "with a DELETE" do - Spec.it "is a Delete" do - response <- mock "DELETE" "" "" StrMap.empty - case response of - (Request.Delete _ _) -> pure unit - a -> Assertions.fail $ "expected a Delete, got " <> show a - Spec.it "has the correct headers" do - response <- mock "DELETE" "" "" mockHeader - case response of - (Request.Delete headers _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Delete, got " <> show a - Spec.it "has the correct path" do - response <- mock "DELETE" "test" "" StrMap.empty - case response of - (Request.Delete _ "test") -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - - Spec.describe "with a HEAD" do - Spec.it "is a Head" do - response <- mock "HEAD" "" "" StrMap.empty - case response of - (Request.Head _ _) -> pure unit - a -> Assertions.fail $ "expected a Head, got " <> show a - Spec.it "has the correct headers" do - response <- mock "HEAD" "" "" mockHeader - case response of - (Request.Head headers _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Head, got " <> show a - Spec.it "has the correct path" do - response <- mock "HEAD" "test" "" StrMap.empty - case response of - (Request.Head _ "test") -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - - Spec.describe "with a CONNECT" do - Spec.it "is a Connect" do - response <- mock "CONNECT" "" "" StrMap.empty - case response of - (Request.Connect _ _ _) -> pure unit - a -> Assertions.fail $ "expected a Connect, got " <> show a - Spec.it "has the correct headers" do - response <- mock "CONNECT" "" "" mockHeader - case response of - (Request.Connect headers _ _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Connect, got " <> show a - Spec.it "has the correct path" do - response <- mock "CONNECT" "test" "" StrMap.empty - case response of - (Request.Connect _ "test" _) -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - Spec.it "has the correct body" do - response <- mock "CONNECT" "" "test" StrMap.empty - case response of - (Request.Connect _ _ "test") -> pure unit - (Request.Connect _ _ body) -> - Assertions.fail $ "expected the body 'test', got " <> body - a -> Assertions.fail $ "expected a connect, got " <> show a - - Spec.describe "with a OPTIONS" do - Spec.it "is a Options" do - response <- mock "OPTIONS" "" "" StrMap.empty - case response of - (Request.Options _ _) -> pure unit - a -> Assertions.fail $ "expected a Options, got " <> show a - Spec.it "has the correct headers" do - response <- mock "OPTIONS" "" "" mockHeader - case response of - (Request.Options headers _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Options, got " <> show a - Spec.it "has the correct path" do - response <- mock "OPTIONS" "test" "" StrMap.empty - case response of - (Request.Options _ "test") -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - - Spec.describe "with a TRACE" do - Spec.it "is a Trace" do - response <- mock "TRACE" "" "" StrMap.empty - case response of - (Request.Trace _ _) -> pure unit - a -> Assertions.fail $ "expected a Trace, got " <> show a - Spec.it "has the correct headers" do - response <- mock "TRACE" "" "" mockHeader - case response of - (Request.Trace headers _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Trace, got " <> show a - Spec.it "has the correct path" do - response <- mock "TRACE" "test" "" StrMap.empty - case response of - (Request.Trace _ "test") -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - - Spec.describe "with a PATCH" do - Spec.it "is a Patch" do - response <- mock "PATCH" "" "" StrMap.empty - case response of - (Request.Patch _ _ _) -> pure unit - a -> Assertions.fail $ "expected a Patch, got " <> show a - Spec.it "has the correct headers" do - response <- mock "PATCH" "" "" mockHeader - case response of - (Request.Patch headers _ _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Patch, got " <> show a - Spec.it "has the correct path" do - response <- mock "PATCH" "test" "" StrMap.empty - case response of - (Request.Patch _ "test" _) -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - Spec.it "has the correct body" do - response <- mock "PATCH" "" "test" StrMap.empty - case response of - (Request.Patch _ _ "test") -> pure unit - (Request.Patch _ _ body) -> - Assertions.fail $ "expected the body 'test', got " <> body - a -> Assertions.fail $ "expected a patch, got " <> show a - - Spec.describe "with a GET" do - Spec.it "is a Get" do - response <- mock "GET" "" "" StrMap.empty - case response of - (Request.Get _ _) -> pure unit - a -> Assertions.fail $ "expected a Get, got " <> show a - Spec.it "has the correct headers" do - response <- mock "GET" "" "" mockHeader - case response of - (Request.Get headers _) -> - Headers.lookup headers "X-Test" ?= "test" - a -> Assertions.fail $ "expected a Get, got " <> show a - Spec.it "has the correct path" do - response <- mock "GET" "test" "" StrMap.empty - case response of - (Request.Get _ "test") -> pure unit - a -> Assertions.fail $ "expected the path 'test', got " <> show a - + Spec.it "contains the correct method" do + mock <- mockRequest + mock.method ?= Method.Post + Spec.it "contains the correct path" do + mock <- mockRequest + mock.path ?= [ "test" ] + Spec.it "contains the correct query" do + mock <- mockRequest + mock.query ?= StrMap.empty + Spec.it "contains the correct headers" do + mock <- mockRequest + mock.headers ?= Headers.headers mockHeaders + Spec.it "contains the correct body" do + mock <- mockRequest + mock.body ?= "body" where - mock method path body headers = do - let req = SpecHelpers.mockRequest method path body headers - EffClass.liftEff req >>= Request.fromHTTPRequest - mockHeader = StrMap.singleton "x-test" "test" + mockHeaders = [ Tuple.Tuple "Test" "test" ] + mockHTTPRequest = + SpecHelpers.mockRequest "POST" "/test?a=b" "body" mockHeaders + mockRequest = mockHTTPRequest >>= Request.fromHTTPRequest requestSpec :: SpecHelpers.Test requestSpec = Spec.describe "Request" do - showSpec fromHTTPRequestSpec diff --git a/test/HTTPure/ResponseSpec.purs b/test/HTTPure/ResponseSpec.purs index 60a69fa..475ec4b 100644 --- a/test/HTTPure/ResponseSpec.purs +++ b/test/HTTPure/ResponseSpec.purs @@ -3,9 +3,11 @@ module HTTPure.ResponseSpec where import Prelude import Control.Monad.Eff.Class as EffClass -import Data.StrMap as StrMap +import Data.Tuple as Tuple + import Test.Spec as Spec +import HTTPure.Headers as Headers import HTTPure.Response as Response import HTTPure.SpecHelpers as SpecHelpers @@ -15,23 +17,58 @@ sendSpec :: SpecHelpers.Test sendSpec = Spec.describe "send" do Spec.it "writes the headers" do header <- EffClass.liftEff do - resp <- SpecHelpers.mockResponse - Response.send resp $ Response.OK (StrMap.singleton "X-Test" "test") "" - pure $ SpecHelpers.getResponseHeader "X-Test" resp + httpResponse <- SpecHelpers.mockResponse + Response.send httpResponse mockResponse + pure $ SpecHelpers.getResponseHeader "Test" httpResponse header ?= "test" Spec.it "writes the status" do status <- EffClass.liftEff do - resp <- SpecHelpers.mockResponse - Response.send resp $ Response.Response 465 StrMap.empty "" - pure $ SpecHelpers.getResponseStatus resp - status ?= 465 + httpResponse <- SpecHelpers.mockResponse + Response.send httpResponse mockResponse + pure $ SpecHelpers.getResponseStatus httpResponse + status ?= 123 Spec.it "writes the body" do body <- EffClass.liftEff do - resp <- SpecHelpers.mockResponse - Response.send resp $ Response.OK StrMap.empty "test" - pure $ SpecHelpers.getResponseBody resp + httpResponse <- SpecHelpers.mockResponse + Response.send httpResponse mockResponse + pure $ SpecHelpers.getResponseBody httpResponse body ?= "test" + where + mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ] + mockResponse = Response.Response 123 mockHeaders "test" + +responseFunctionSpec :: SpecHelpers.Test +responseFunctionSpec = Spec.describe "response" do + Spec.it "has the right status" do + resp <- mockResponse + case resp of (Response.Response status _ _) -> status ?= 123 + Spec.it "has the right headers" do + resp <- mockResponse + case resp of (Response.Response _ headers _) -> headers ?= mockHeaders + Spec.it "has the right body" do + resp <- mockResponse + case resp of (Response.Response _ _ body) -> body ?= "test" + where + mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ] + mockResponse = EffClass.liftEff $ Response.response 123 mockHeaders "test" + +response'Spec :: SpecHelpers.Test +response'Spec = Spec.describe "response'" do + Spec.it "has the right status" do + resp <- mockResponse + case resp of (Response.Response status _ _) -> status ?= 123 + Spec.it "has the right headers" do + resp <- mockResponse + case resp of (Response.Response _ headers _) -> headers ?= mockHeaders + Spec.it "has an empty body" do + resp <- mockResponse + case resp of (Response.Response _ _ body) -> body ?= "" + where + mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ] + mockResponse = EffClass.liftEff $ Response.response' 123 mockHeaders responseSpec :: SpecHelpers.Test responseSpec = Spec.describe "Response" do sendSpec + responseFunctionSpec + response'Spec diff --git a/test/HTTPure/ServerSpec.purs b/test/HTTPure/ServerSpec.purs index cbf6b98..e9c53ed 100644 --- a/test/HTTPure/ServerSpec.purs +++ b/test/HTTPure/ServerSpec.purs @@ -3,6 +3,7 @@ module HTTPure.ServerSpec where import Prelude import Control.Monad.Eff.Class as EffClass +import Data.String as String import Data.StrMap as StrMap import Test.Spec as Spec import Test.Spec.Assertions.Aff as AffAssertions @@ -15,8 +16,7 @@ import HTTPure.SpecHelpers as SpecHelpers import HTTPure.SpecHelpers ((?=)) mockRouter :: forall e. Request.Request -> Response.ResponseM e -mockRouter (Request.Get _ path) = pure $ Response.OK StrMap.empty path -mockRouter _ = pure $ Response.OK StrMap.empty "" +mockRouter { path } = Response.ok $ "/" <> String.joinWith "/" path serveSpec :: SpecHelpers.Test serveSpec = Spec.describe "serve" do diff --git a/test/HTTPure/SpecHelpers.js b/test/HTTPure/SpecHelpers.js index 810fdcc..7c9f2f3 100644 --- a/test/HTTPure/SpecHelpers.js +++ b/test/HTTPure/SpecHelpers.js @@ -1,6 +1,6 @@ "use strict"; -exports.mockRequest = function(method) { +exports.mockRequestImpl = function(method) { return function(url) { return function(body) { return function(headers) { diff --git a/test/HTTPure/SpecHelpers.purs b/test/HTTPure/SpecHelpers.purs index 8fd8b08..00c6c86 100644 --- a/test/HTTPure/SpecHelpers.purs +++ b/test/HTTPure/SpecHelpers.purs @@ -4,12 +4,14 @@ import Prelude import Control.Monad.Aff as Aff import Control.Monad.Eff as Eff +import Control.Monad.Eff.Class as EffClass import Control.Monad.Eff.Exception as Exception import Control.Monad.ST as ST import Data.Maybe as Maybe import Data.Options ((:=)) import Data.String as StringUtil import Data.StrMap as StrMap +import Data.Tuple as Tuple import Node.Encoding as Encoding import Node.FS as FS import Node.HTTP as HTTP @@ -137,7 +139,7 @@ getHeader port headers path header = foreign import data MOCK_REQUEST :: Eff.Effect -- | Mock an HTTP Request object -foreign import mockRequest :: +foreign import mockRequestImpl :: forall e. String -> String -> @@ -145,6 +147,16 @@ foreign import mockRequest :: StrMap.StrMap String -> Eff.Eff (mockRequest :: MOCK_REQUEST | e) HTTP.Request +-- | Mock an HTTP Request object +mockRequest :: forall e. + String -> + String -> + String -> + Array (Tuple.Tuple String String) -> + Aff.Aff (mockRequest :: MOCK_REQUEST | e) HTTP.Request +mockRequest method url body = + EffClass.liftEff <<< mockRequestImpl method url body <<< StrMap.fromFoldable + -- | An effect encapsulating creating a mock response object foreign import data MOCK_RESPONSE :: Eff.Effect diff --git a/test/HTTPureSpec.purs b/test/HTTPureSpec.purs index 2304ba0..1f888b7 100644 --- a/test/HTTPureSpec.purs +++ b/test/HTTPureSpec.purs @@ -9,7 +9,10 @@ import Test.Spec.Runner as Runner import HTTPure.BodySpec as BodySpec import HTTPure.HeadersSpec as HeadersSpec import HTTPure.HTTPureMSpec as HTTPureMSpec +import HTTPure.LookupSpec as LookupSpec +import HTTPure.MethodSpec as MethodSpec import HTTPure.PathSpec as PathSpec +import HTTPure.QuerySpec as QuerySpec import HTTPure.RequestSpec as RequestSpec import HTTPure.ResponseSpec as ResponseSpec import HTTPure.ServerSpec as ServerSpec @@ -23,7 +26,10 @@ main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do BodySpec.bodySpec HeadersSpec.headersSpec HTTPureMSpec.httpureMSpec + LookupSpec.lookupSpec + MethodSpec.methodSpec PathSpec.pathSpec + QuerySpec.querySpec RequestSpec.requestSpec ResponseSpec.responseSpec ServerSpec.serverSpec