thunderstrike/purescript-httpurple
thunderstrike/purescript-httpurple
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Improve and simplify APIs (#68)

Browse Source
This commit is contained in:
Connor Prussin 2017-09-25 23:08:07 -07:00 committed by GitHub
parent 92ed802a93
commit 278e110d59
34 changed files with 1527 additions and 565 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
History.md
View File

@ -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

3
Makefile
View File

@ -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)

2
Readme.md
View File

@ -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

4
bower.json
View File

@ -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",

14
docs/Examples/Headers/Main.purs
View File

@ -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)

3
docs/Examples/HelloWorld/Main.purs
View File

@ -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)

7
docs/Examples/MultiRoute/Main.purs
View File

@ -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)

34
docs/Examples/PathSegments/Main.purs Normal file
View File

@ -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/<anything> │"
Console.log $ " │ # => <anything> │"
Console.log $ " │ > curl localhost:" <> portS <> "/<anything>/<else>/... │"
Console.log $ " │ # => [ <anything>, <else>, ... ] │"
Console.log $ " └───────────────────────────────────────────────┘"

11
docs/Examples/PathSegments/Readme.md Normal file
View File

@ -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
```

5
docs/Examples/Post/Main.purs
View File

@ -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)

3
docs/Examples/SSL/Main.purs
View File

@ -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)

85
src/HTTPure.purs
View File

@ -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')

2
src/HTTPure/Body.purs
View File

@ -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 ""

48
src/HTTPure/Headers.purs
View File

@ -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

26
src/HTTPure/Lookup.purs Normal file
View File

@ -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

51
src/HTTPure/Method.purs Normal file
View File

@ -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

26
src/HTTPure/Path.purs
View File

@ -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 ""

14
src/HTTPure/Query.purs Normal file
View File

@ -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

58
src/HTTPure/Request.purs
View File

@ -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
}

827
src/HTTPure/Response.purs
View File

@ -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

331
src/HTTPure/Status.purs
View File

@ -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

6
test/HTTPure/BodySpec.purs
View File

@ -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"

60
test/HTTPure/HeadersSpec.purs
View File

@ -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

11
test/HTTPure/IntegrationSpec.purs
View File

@ -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

23
test/HTTPure/LookupSpec.purs Normal file
View File

@ -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

52
test/HTTPure/MethodSpec.purs Normal file
View File

@ -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

24
test/HTTPure/PathSpec.purs
View File

@ -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

21
test/HTTPure/QuerySpec.purs Normal file
View File

@ -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

249
test/HTTPure/RequestSpec.purs
View File

@ -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

59
test/HTTPure/ResponseSpec.purs
View File

@ -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

4
test/HTTPure/ServerSpec.purs
View File

@ -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

2
test/HTTPure/SpecHelpers.js
View File

@ -1,6 +1,6 @@
"use strict";
exports.mockRequest = function(method) {
exports.mockRequestImpl = function(method) {
return function(url) {
return function(body) {
return function(headers) {

14
test/HTTPure/SpecHelpers.purs
View File

@ -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

6
test/HTTPureSpec.purs
View File

@ -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