Clean up imports (#185)
* Clean up import declarations to only use qualified when necessary * Remove unused imports
This commit is contained in:
Connor Prussin
GitHub
parent
f58aa94484
commit
8295d8755e
13
Readme.md
13
Readme.md
@ -36,16 +36,15 @@ spago install httpure
|
||||
```purescript
|
||||
module Main where
|
||||
|
||||
import Prelude (($))
|
||||
import Prelude
|
||||
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure (ServerM, serve, ok)
|
||||
|
||||
main :: HTTPure.ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router $ Console.log "Server now up on port 8080"
|
||||
main :: ServerM
|
||||
main = serve 8080 router $ log "Server now up on port 8080"
|
||||
where
|
||||
router _ = HTTPure.ok "hello world!"
|
||||
router _ = ok "hello world!"
|
||||
```
|
||||
|
||||
## Documentation
|
||||
|
||||
@ -24,7 +24,7 @@ You can create an HTTPure server without SSL using `HTTPure.serve`:
|
||||
|
||||
```purescript
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve 8080 router $ Console.log "Server up"
|
||||
main = HTTPure.serve 8080 router $ log "Server up"
|
||||
```
|
||||
|
||||
Most of the [examples](./Examples), besides [the SSL Example](./Examples/SSL),
|
||||
@ -35,7 +35,7 @@ You can also create a server using a custom
|
||||
|
||||
```purescript
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve' customOptions router $ Console.log "Server up"
|
||||
main = HTTPure.serve' customOptions router $ log "Server up"
|
||||
```
|
||||
|
||||
## SSL
|
||||
@ -48,7 +48,7 @@ path to a cert file and a path to a key file after the port number:
|
||||
main :: HTTPure.ServerM
|
||||
main =
|
||||
HTTPure.serveSecure 8080 "./Certificate.cer" "./Key.key" router $
|
||||
Console.log "Server up"
|
||||
log "Server up"
|
||||
```
|
||||
|
||||
You can look at [the SSL Example](./Examples/SSL/Main.purs), which uses this
|
||||
@ -62,12 +62,13 @@ You can also create a server using a
|
||||
main :: HTTPure.ServerM
|
||||
main =
|
||||
HTTPure.serveSecure' customSSLOptions customOptions router $
|
||||
Console.log "Server up"
|
||||
log "Server up"
|
||||
```
|
||||
|
||||
## Shutdown hook
|
||||
|
||||
To gracefully shut down a server you can add a shutdown hook. For this you will need to add the following dependencies:
|
||||
|
||||
```
|
||||
posix-types
|
||||
node-process
|
||||
@ -78,17 +79,17 @@ Then take the closing handler returned by `serve` and create a `SIGINT` and `SIG
|
||||
```purescript
|
||||
import Prelude
|
||||
|
||||
import Data.Posix.Signal (Signal(..))
|
||||
import Data.Posix.Signal (Signal(SIGINT, SIGTERM))
|
||||
import Effect (Effect)
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure (serve, ok)
|
||||
import Node.Process (onSignal)
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
closingHandler <- HTTPure.serve 8080 (const $ HTTPure.ok "hello world!") do
|
||||
Console.log $ "Server now up on port 8080"
|
||||
closingHandler <- serve 8080 (const $ ok "hello world!") do
|
||||
log $ "Server now up on port 8080"
|
||||
|
||||
onSignal SIGINT $ closingHandler $ Console.log "Received SIGINT, stopping service now."
|
||||
onSignal SIGTERM $ closingHandler $ Console.log "Received SIGTERM, stopping service now."
|
||||
onSignal SIGINT $ closingHandler $ log "Received SIGINT, stopping service now."
|
||||
onSignal SIGTERM $ closingHandler $ log "Received SIGTERM, stopping service now."
|
||||
```
|
||||
|
||||
@ -1,26 +1,26 @@
|
||||
module Examples.AsyncResponse.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Node.Encoding as Encoding
|
||||
import Node.FS.Aff as FSAff
|
||||
import Effect.Console (log)
|
||||
import HTTPure (ServerM, Request, ResponseM, serve, ok)
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.FS.Aff (readTextFile)
|
||||
|
||||
-- | The path to the file containing the response to send
|
||||
filePath :: String
|
||||
filePath = "./docs/Examples/AsyncResponse/Hello"
|
||||
|
||||
-- | Say 'hello world!' when run
|
||||
sayHello :: HTTPure.Request -> HTTPure.ResponseM
|
||||
sayHello = const $ FSAff.readTextFile Encoding.UTF8 filePath >>= HTTPure.ok
|
||||
sayHello :: Request -> ResponseM
|
||||
sayHello = const $ readTextFile UTF8 filePath >>= ok
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 sayHello do
|
||||
Console.log $ " ┌────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:8080 # => hello world! │"
|
||||
Console.log $ " └────────────────────────────────────────────┘"
|
||||
serve 8080 sayHello do
|
||||
log " ┌────────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl localhost:8080 # => hello world! │"
|
||||
log " └────────────────────────────────────────────┘"
|
||||
|
||||
@ -1,24 +1,24 @@
|
||||
module Examples.BinaryRequest.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import Effect.Console (log)
|
||||
import Node.Buffer (Buffer)
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure (Request, ResponseM, ServerM, toBuffer, serve, ok)
|
||||
|
||||
foreign import sha256sum :: Buffer -> String
|
||||
|
||||
-- | Respond with file's sha256sum
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { body } = HTTPure.toBuffer body >>= sha256sum >>> HTTPure.ok
|
||||
router :: Request -> ResponseM
|
||||
router { body } = toBuffer body >>= sha256sum >>> ok
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌─────────────────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -XPOST --data-binary @circle.png localhost:8080 │"
|
||||
Console.log $ " │ # => d5e776724dd5... │"
|
||||
Console.log $ " └─────────────────────────────────────────────────────────┘"
|
||||
serve 8080 router do
|
||||
log " ┌─────────────────────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -XPOST --data-binary @circle.png localhost:8080 │"
|
||||
log " │ # => d5e776724dd5... │"
|
||||
log " └─────────────────────────────────────────────────────────┘"
|
||||
|
||||
@ -1,28 +1,28 @@
|
||||
module Examples.BinaryResponse.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import Node.FS.Aff as FS
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import Node.FS.Aff (readFile)
|
||||
import HTTPure (ServerM, Request, ResponseM, Headers, serve, ok', header)
|
||||
|
||||
-- | The path to the file containing the response to send
|
||||
filePath :: String
|
||||
filePath = "./docs/Examples/BinaryResponse/circle.png"
|
||||
|
||||
responseHeaders :: HTTPure.Headers
|
||||
responseHeaders = HTTPure.header "Content-Type" "image/png"
|
||||
responseHeaders :: Headers
|
||||
responseHeaders = header "Content-Type" "image/png"
|
||||
|
||||
-- | Respond with image data when run
|
||||
image :: HTTPure.Request -> HTTPure.ResponseM
|
||||
image = const $ FS.readFile filePath >>= HTTPure.ok' responseHeaders
|
||||
image :: Request -> ResponseM
|
||||
image = const $ readFile filePath >>= ok' responseHeaders
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 image do
|
||||
Console.log $ " ┌──────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -o circle.png localhost:8080 │"
|
||||
Console.log $ " └──────────────────────────────────────┘"
|
||||
serve 8080 image do
|
||||
log " ┌──────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -o circle.png localhost:8080 │"
|
||||
log " └──────────────────────────────────────┘"
|
||||
|
||||
@ -1,36 +1,35 @@
|
||||
module Examples.Chunked.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Aff as Aff
|
||||
import Effect.Class as EffectClass
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Node.ChildProcess as ChildProcess
|
||||
import Node.Stream as Stream
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (log)
|
||||
import HTTPure (ServerM, Request, ResponseM, serve, ok)
|
||||
import Node.ChildProcess (stdout, spawn, defaultSpawnOptions)
|
||||
import Node.Stream (Readable)
|
||||
|
||||
-- | Run a script and return it's stdout stream
|
||||
runScript :: String -> Aff.Aff (Stream.Readable ())
|
||||
runScript :: String -> Aff (Readable ())
|
||||
runScript script =
|
||||
EffectClass.liftEffect $ ChildProcess.stdout
|
||||
<$> ChildProcess.spawn "sh" [ "-c", script ] ChildProcess.defaultSpawnOptions
|
||||
liftEffect $ stdout <$> spawn "sh" [ "-c", script ] defaultSpawnOptions
|
||||
|
||||
-- | Say 'hello world!' in chunks when run
|
||||
sayHello :: HTTPure.Request -> HTTPure.ResponseM
|
||||
sayHello = const $ runScript "echo 'hello '; sleep 1; echo 'world!'" >>= HTTPure.ok
|
||||
sayHello :: Request -> ResponseM
|
||||
sayHello = const $ runScript "echo 'hello '; sleep 1; echo 'world!'" >>= ok
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 sayHello do
|
||||
Console.log $ " ┌──────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -Nv localhost:8080 │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => < Transfer-Encoding: chunked │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => hello │"
|
||||
Console.log $ " │ (1 second pause) │"
|
||||
Console.log $ " │ # => world! │"
|
||||
Console.log $ " └──────────────────────────────────────┘"
|
||||
serve 8080 sayHello do
|
||||
log " ┌──────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -Nv localhost:8080 │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => < Transfer-Encoding: chunked │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => hello │"
|
||||
log " │ (1 second pause) │"
|
||||
log " │ # => world! │"
|
||||
log " └──────────────────────────────────────┘"
|
||||
|
||||
@ -4,34 +4,34 @@ import Prelude
|
||||
import Control.Monad.Reader (class MonadAsk, ReaderT, asks, runReaderT)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Aff.Class (class MonadAff)
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure (Request, Response, ResponseM, ServerM, serve, ok)
|
||||
|
||||
-- | A type to hold the environment for our ReaderT
|
||||
type Env = { name :: String }
|
||||
|
||||
-- | A middleware that introduces a ReaderT
|
||||
readerMiddleware ::
|
||||
(HTTPure.Request -> ReaderT Env Aff HTTPure.Response) ->
|
||||
HTTPure.Request ->
|
||||
HTTPure.ResponseM
|
||||
(Request -> ReaderT Env Aff Response) ->
|
||||
Request ->
|
||||
ResponseM
|
||||
readerMiddleware router request = do
|
||||
runReaderT (router request) { name: "joe" }
|
||||
|
||||
-- | Say 'hello, joe' when run
|
||||
sayHello :: forall m. MonadAff m => MonadAsk Env m => HTTPure.Request -> m HTTPure.Response
|
||||
sayHello :: forall m. MonadAff m => MonadAsk Env m => Request -> m Response
|
||||
sayHello _ = do
|
||||
name <- asks _.name
|
||||
HTTPure.ok $ "hello, " <> name
|
||||
ok $ "hello, " <> name
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 (readerMiddleware sayHello) do
|
||||
Console.log $ " ┌───────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -v localhost:8080 │"
|
||||
Console.log $ " │ # => hello, joe │"
|
||||
Console.log $ " └───────────────────────────────────────┘"
|
||||
serve 8080 (readerMiddleware sayHello) do
|
||||
log " ┌───────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -v localhost:8080 │"
|
||||
log " │ # => hello, joe │"
|
||||
log " └───────────────────────────────────────┘"
|
||||
|
||||
@ -1,29 +1,28 @@
|
||||
module Examples.Headers.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure ((!@))
|
||||
import Effect.Console (log)
|
||||
import HTTPure (ServerM, Headers, Request, ResponseM, (!@), header, serve, ok')
|
||||
|
||||
-- | The headers that will be included in every response.
|
||||
responseHeaders :: HTTPure.Headers
|
||||
responseHeaders = HTTPure.header "X-Example" "hello world!"
|
||||
responseHeaders :: Headers
|
||||
responseHeaders = header "X-Example" "hello world!"
|
||||
|
||||
-- | Route to the correct handler
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { headers } = HTTPure.ok' responseHeaders $ headers !@ "X-Input"
|
||||
router :: Request -> ResponseM
|
||||
router { headers } = ok' responseHeaders $ headers !@ "X-Input"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌──────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -H 'X-Input: test' -v localhost:8080 │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => ...< X-Example: hello world! │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => test │"
|
||||
Console.log $ " └──────────────────────────────────────────────┘"
|
||||
serve 8080 router do
|
||||
log " ┌──────────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -H 'X-Input: test' -v localhost:8080 │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => ...< X-Example: hello world! │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => test │"
|
||||
log " └──────────────────────────────────────────────┘"
|
||||
|
||||
@ -1,16 +1,16 @@
|
||||
module Examples.HelloWorld.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure (ServerM, serve, ok)
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 (const $ HTTPure.ok "hello world!") do
|
||||
Console.log $ " ┌────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:8080 # => hello world! │"
|
||||
Console.log $ " └────────────────────────────────────────────┘"
|
||||
serve 8080 (const $ ok "hello world!") do
|
||||
log " ┌────────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl localhost:8080 # => hello world! │"
|
||||
log " └────────────────────────────────────────────┘"
|
||||
|
||||
@ -1,66 +1,68 @@
|
||||
module Examples.Middleware.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Class as EffectClass
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (log)
|
||||
import HTTPure (Request, ResponseM, ServerM, serve, fullPath, header, ok, ok')
|
||||
|
||||
-- | A middleware that logs at the beginning and end of each request
|
||||
loggingMiddleware ::
|
||||
(HTTPure.Request -> HTTPure.ResponseM) ->
|
||||
HTTPure.Request ->
|
||||
HTTPure.ResponseM
|
||||
(Request -> ResponseM) ->
|
||||
Request ->
|
||||
ResponseM
|
||||
loggingMiddleware router request = do
|
||||
EffectClass.liftEffect $ Console.log $ "Request starting for " <> path
|
||||
liftEffect $ log $ "Request starting for " <> path
|
||||
response <- router request
|
||||
EffectClass.liftEffect $ Console.log $ "Request ending for " <> path
|
||||
liftEffect $ log $ "Request ending for " <> path
|
||||
pure response
|
||||
where
|
||||
path = HTTPure.fullPath request
|
||||
path = fullPath request
|
||||
|
||||
-- | A middleware that adds the X-Middleware header to the response, if it
|
||||
-- | wasn't already in the response
|
||||
headerMiddleware ::
|
||||
(HTTPure.Request -> HTTPure.ResponseM) ->
|
||||
HTTPure.Request ->
|
||||
HTTPure.ResponseM
|
||||
(Request -> ResponseM) ->
|
||||
Request ->
|
||||
ResponseM
|
||||
headerMiddleware router request = do
|
||||
response@{ headers } <- router request
|
||||
pure $ response { headers = header <> headers }
|
||||
pure $ response { headers = header' <> headers }
|
||||
where
|
||||
header = HTTPure.header "X-Middleware" "middleware"
|
||||
header' = header "X-Middleware" "middleware"
|
||||
|
||||
-- | A middleware that sends the body "Middleware!" instead of running the
|
||||
-- | router when requesting /middleware
|
||||
pathMiddleware ::
|
||||
(HTTPure.Request -> HTTPure.ResponseM) ->
|
||||
HTTPure.Request ->
|
||||
HTTPure.ResponseM
|
||||
pathMiddleware _ { path: [ "middleware" ] } = HTTPure.ok "Middleware!"
|
||||
(Request -> ResponseM) ->
|
||||
Request ->
|
||||
ResponseM
|
||||
pathMiddleware _ { path: [ "middleware" ] } = ok "Middleware!"
|
||||
pathMiddleware router request = router request
|
||||
|
||||
-- | Say 'hello' when run, and add a default value to the X-Middleware header
|
||||
sayHello :: HTTPure.Request -> HTTPure.ResponseM
|
||||
sayHello _ = HTTPure.ok' (HTTPure.header "X-Middleware" "router") "hello"
|
||||
sayHello :: Request -> ResponseM
|
||||
sayHello _ = ok' (header "X-Middleware" "router") "hello"
|
||||
|
||||
-- | The stack of middlewares to use for the server
|
||||
middlewareStack :: (Request -> ResponseM) -> Request -> ResponseM
|
||||
middlewareStack = loggingMiddleware <<< headerMiddleware <<< pathMiddleware
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 (middlewares sayHello) do
|
||||
Console.log $ " ┌───────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -v localhost:8080 │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => ...< X-Middleware: router │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => hello │"
|
||||
Console.log $ " │ > curl -v localhost:8080/middleware │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => ...< X-Middleware: middleware │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => Middleware! │"
|
||||
Console.log $ " └───────────────────────────────────────┘"
|
||||
where
|
||||
middlewares = loggingMiddleware <<< headerMiddleware <<< pathMiddleware
|
||||
serve 8080 (middlewareStack sayHello) do
|
||||
log " ┌───────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -v localhost:8080 │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => ...< X-Middleware: router │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => hello │"
|
||||
log " │ > curl -v localhost:8080/middleware │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => ...< X-Middleware: middleware │"
|
||||
log " │ # => ... │"
|
||||
log " │ # => Middleware! │"
|
||||
log " └───────────────────────────────────────┘"
|
||||
|
||||
@ -1,25 +1,25 @@
|
||||
module Examples.MultiRoute.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure (Request, ResponseM, ServerM, serve, ok, notFound)
|
||||
|
||||
-- | Specify the routes
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { path: [ "hello" ] } = HTTPure.ok "hello"
|
||||
router { path: [ "goodbye" ] } = HTTPure.ok "goodbye"
|
||||
router _ = HTTPure.notFound
|
||||
router :: Request -> ResponseM
|
||||
router { path: [ "hello" ] } = ok "hello"
|
||||
router { path: [ "goodbye" ] } = ok "goodbye"
|
||||
router _ = notFound
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:8080/hello │"
|
||||
Console.log $ " │ # => hello │"
|
||||
Console.log $ " │ > curl localhost:8080/goodbye │"
|
||||
Console.log $ " │ # => goodbye │"
|
||||
Console.log $ " └────────────────────────────────┘"
|
||||
serve 8080 router do
|
||||
log " ┌────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl localhost:8080/hello │"
|
||||
log " │ # => hello │"
|
||||
log " │ > curl localhost:8080/goodbye │"
|
||||
log " │ # => goodbye │"
|
||||
log " └────────────────────────────────┘"
|
||||
|
||||
@ -1,26 +1,25 @@
|
||||
module Examples.PathSegments.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure ((!@))
|
||||
import Effect.Console (log)
|
||||
import HTTPure (Request, ResponseM, ServerM, (!@), serve, ok)
|
||||
|
||||
-- | Specify the routes
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router :: Request -> ResponseM
|
||||
router { path }
|
||||
| path !@ 0 == "segment" = HTTPure.ok $ path !@ 1
|
||||
| otherwise = HTTPure.ok $ show path
|
||||
| path !@ 0 == "segment" = ok $ path !@ 1
|
||||
| otherwise = ok $ show path
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌───────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:8080/segment/<anything> │"
|
||||
Console.log $ " │ # => <anything> │"
|
||||
Console.log $ " │ > curl localhost:8080/<anything>/<else>/... │"
|
||||
Console.log $ " │ # => [ <anything>, <else>, ... ] │"
|
||||
Console.log $ " └───────────────────────────────────────────────┘"
|
||||
serve 8080 router do
|
||||
log " ┌───────────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl localhost:8080/segment/<anything> │"
|
||||
log " │ # => <anything> │"
|
||||
log " │ > curl localhost:8080/<anything>/<else>/... │"
|
||||
log " │ # => [ <anything>, <else>, ... ] │"
|
||||
log " └───────────────────────────────────────────────┘"
|
||||
|
||||
@ -1,22 +1,31 @@
|
||||
module Examples.Post.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure
|
||||
( Request
|
||||
, ResponseM
|
||||
, ServerM
|
||||
, Method(Post)
|
||||
, serve
|
||||
, ok
|
||||
, notFound
|
||||
, toString
|
||||
)
|
||||
|
||||
-- | Route to the correct handler
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { body, method: HTTPure.Post } = HTTPure.toString body >>= HTTPure.ok
|
||||
router _ = HTTPure.notFound
|
||||
router :: Request -> ResponseM
|
||||
router { body, method: Post } = toString body >>= ok
|
||||
router _ = notFound
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌───────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -XPOST --data test localhost:8080 │"
|
||||
Console.log $ " │ # => test │"
|
||||
Console.log $ " └───────────────────────────────────────────┘"
|
||||
serve 8080 router do
|
||||
log " ┌───────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl -XPOST --data test localhost:8080 │"
|
||||
log " │ # => test │"
|
||||
log " └───────────────────────────────────────────┘"
|
||||
|
||||
@ -1,29 +1,28 @@
|
||||
module Examples.QueryParameters.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure ((!@), (!?))
|
||||
import Effect.Console (log)
|
||||
import HTTPure (Request, ResponseM, ServerM, (!@), (!?), serve, ok)
|
||||
|
||||
-- | Specify the routes
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router :: Request -> ResponseM
|
||||
router { query }
|
||||
| query !? "foo" = HTTPure.ok "foo"
|
||||
| query !@ "bar" == "test" = HTTPure.ok "bar"
|
||||
| otherwise = HTTPure.ok $ query !@ "baz"
|
||||
| query !? "foo" = ok "foo"
|
||||
| query !@ "bar" == "test" = ok "bar"
|
||||
| otherwise = ok $ query !@ "baz"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌───────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:8080?foo │"
|
||||
Console.log $ " │ # => foo │"
|
||||
Console.log $ " │ > curl localhost:8080?bar=test │"
|
||||
Console.log $ " │ # => bar │"
|
||||
Console.log $ " │ > curl localhost:8080?baz=<anything> │"
|
||||
Console.log $ " │ # => <anything> │"
|
||||
Console.log $ " └───────────────────────────────────────┘"
|
||||
serve 8080 router do
|
||||
log " ┌───────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl localhost:8080?foo │"
|
||||
log " │ # => foo │"
|
||||
log " │ > curl localhost:8080?bar=test │"
|
||||
log " │ # => bar │"
|
||||
log " │ > curl localhost:8080?baz=<anything> │"
|
||||
log " │ # => <anything> │"
|
||||
log " └───────────────────────────────────────┘"
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
module Examples.SSL.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import Effect.Console (log)
|
||||
import HTTPure (Request, ResponseM, ServerM, serveSecure, ok)
|
||||
|
||||
-- | The path to the certificate file
|
||||
cert :: String
|
||||
@ -13,17 +13,17 @@ key :: String
|
||||
key = "./docs/Examples/SSL/Key.key"
|
||||
|
||||
-- | Say 'hello world!' when run
|
||||
sayHello :: HTTPure.Request -> HTTPure.ResponseM
|
||||
sayHello _ = HTTPure.ok "hello world!"
|
||||
sayHello :: Request -> ResponseM
|
||||
sayHello _ = ok "hello world!"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main :: ServerM
|
||||
main =
|
||||
HTTPure.serveSecure 8080 cert key sayHello do
|
||||
Console.log $ " ┌───────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl --insecure https://localhost:8080 │"
|
||||
Console.log $ " │ # => hello world! │"
|
||||
Console.log $ " └───────────────────────────────────────────┘"
|
||||
serveSecure 8080 cert key sayHello do
|
||||
log " ┌───────────────────────────────────────────┐"
|
||||
log " │ Server now up on port 8080 │"
|
||||
log " │ │"
|
||||
log " │ To test, run: │"
|
||||
log " │ > curl --insecure https://localhost:8080 │"
|
||||
log " │ # => hello world! │"
|
||||
log " └───────────────────────────────────────────┘"
|
||||
|
||||
@ -8,37 +8,39 @@ module HTTPure.Body
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Data.Either as Either
|
||||
import Effect as Effect
|
||||
import Data.Either (Either(Right))
|
||||
import Effect (Effect)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Aff as Aff
|
||||
import Effect.Ref as Ref
|
||||
import HTTPure.Headers as Headers
|
||||
import Node.Buffer as Buffer
|
||||
import Node.Encoding as Encoding
|
||||
import Node.HTTP as HTTP
|
||||
import Node.Stream as Stream
|
||||
import Type.Equality as TypeEquals
|
||||
import Effect.Aff (Aff, makeAff, nonCanceler)
|
||||
import Effect.Ref (read) as Ref
|
||||
import Effect.Ref (new, modify)
|
||||
import HTTPure.Headers (Headers, header)
|
||||
import Node.Buffer (toString) as Buffer
|
||||
import Node.Buffer (Buffer, concat, fromString, size)
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.HTTP (Request, Response, requestAsStream, responseAsStream)
|
||||
import Node.Stream (write) as Stream
|
||||
import Node.Stream (Stream, Readable, onData, onEnd, writeString, pipe, end)
|
||||
import Type.Equality (class TypeEquals, to)
|
||||
|
||||
-- | Read the body `Readable` stream out of the incoming request
|
||||
read :: HTTP.Request -> Stream.Readable ()
|
||||
read = HTTP.requestAsStream
|
||||
read :: Request -> Readable ()
|
||||
read = requestAsStream
|
||||
|
||||
-- | Slurp the entire `Readable` stream into a `String`
|
||||
toString :: Stream.Readable () -> Aff.Aff String
|
||||
toString = toBuffer >=> Buffer.toString Encoding.UTF8 >>> liftEffect
|
||||
toString :: Readable () -> Aff String
|
||||
toString = toBuffer >=> Buffer.toString UTF8 >>> liftEffect
|
||||
|
||||
-- | Slurp the entire `Readable` stream into a `Buffer`
|
||||
toBuffer :: Stream.Readable () -> Aff.Aff Buffer.Buffer
|
||||
toBuffer :: Readable () -> Aff Buffer
|
||||
toBuffer stream =
|
||||
Aff.makeAff \done -> do
|
||||
bufs <- Ref.new []
|
||||
Stream.onData stream \buf ->
|
||||
void $ Ref.modify (_ <> [ buf ]) bufs
|
||||
Stream.onEnd stream do
|
||||
body <- Ref.read bufs >>= Buffer.concat
|
||||
done $ Either.Right body
|
||||
pure Aff.nonCanceler
|
||||
makeAff \done -> do
|
||||
bufs <- new []
|
||||
onData stream \buf -> void $ modify (_ <> [ buf ]) bufs
|
||||
onEnd stream do
|
||||
body <- Ref.read bufs >>= concat
|
||||
done $ Right body
|
||||
pure nonCanceler
|
||||
|
||||
-- | Types that implement the `Body` class can be used as a body to an HTTPure
|
||||
-- | response, and can be used with all the response helpers.
|
||||
@ -47,10 +49,10 @@ class Body b where
|
||||
-- | things like `Content-Type`, `Content-Length`, and `Transfer-Encoding`.
|
||||
-- | Note that any headers passed in a response helper such as `ok'` will take
|
||||
-- | precedence over these.
|
||||
defaultHeaders :: b -> Effect.Effect Headers.Headers
|
||||
defaultHeaders :: b -> Effect Headers
|
||||
-- | Given a body value and a Node HTTP `Response` value, write the body value
|
||||
-- | to the Node response.
|
||||
write :: b -> HTTP.Response -> Aff.Aff Unit
|
||||
write :: b -> Response -> Aff Unit
|
||||
|
||||
-- | The instance for `String` will convert the string to a buffer first in
|
||||
-- | order to determine it's additional headers. This is to ensure that the
|
||||
@ -59,44 +61,32 @@ class Body b where
|
||||
-- | response stream and closing the response stream.
|
||||
instance bodyString :: Body String where
|
||||
defaultHeaders body = do
|
||||
buf :: Buffer.Buffer <- Buffer.fromString body Encoding.UTF8
|
||||
buf :: Buffer <- fromString body UTF8
|
||||
defaultHeaders buf
|
||||
write body response =
|
||||
Aff.makeAff \done -> do
|
||||
let
|
||||
stream = HTTP.responseAsStream response
|
||||
void $ Stream.writeString stream Encoding.UTF8 body
|
||||
$ Stream.end stream
|
||||
$ done
|
||||
$ Either.Right unit
|
||||
pure Aff.nonCanceler
|
||||
write body response = makeAff \done -> do
|
||||
let stream = responseAsStream response
|
||||
void $ writeString stream UTF8 body $ end stream $ done $ Right unit
|
||||
pure nonCanceler
|
||||
|
||||
-- | The instance for `Buffer` is trivial--we add a `Content-Length` header
|
||||
-- | using `Buffer.size`, and to send the response, we just write the buffer to
|
||||
-- | the stream and end the stream.
|
||||
instance bodyBuffer :: Body Buffer.Buffer where
|
||||
defaultHeaders buf = Headers.header "Content-Length" <$> show <$> Buffer.size buf
|
||||
write body response =
|
||||
Aff.makeAff \done -> do
|
||||
let
|
||||
stream = HTTP.responseAsStream response
|
||||
void $ Stream.write stream body
|
||||
$ Stream.end stream
|
||||
$ done
|
||||
$ Either.Right unit
|
||||
pure Aff.nonCanceler
|
||||
instance bodyBuffer :: Body Buffer where
|
||||
defaultHeaders buf = header "Content-Length" <$> show <$> size buf
|
||||
write body response = makeAff \done -> do
|
||||
let stream = responseAsStream response
|
||||
void $ Stream.write stream body $ end stream $ done $ Right unit
|
||||
pure nonCanceler
|
||||
|
||||
-- | This instance can be used to send chunked data. Here, we add a
|
||||
-- | `Transfer-Encoding` header to indicate chunked data. To write the data, we
|
||||
-- | simply pipe the newtype-wrapped `Stream` to the response.
|
||||
instance bodyChunked ::
|
||||
TypeEquals.TypeEquals (Stream.Stream r) (Stream.Readable ()) =>
|
||||
Body (Stream.Stream r) where
|
||||
defaultHeaders _ = pure $ Headers.header "Transfer-Encoding" "chunked"
|
||||
write body response =
|
||||
Aff.makeAff \done -> do
|
||||
let
|
||||
stream = TypeEquals.to body
|
||||
void $ Stream.pipe stream $ HTTP.responseAsStream response
|
||||
Stream.onEnd stream $ done $ Either.Right unit
|
||||
pure Aff.nonCanceler
|
||||
TypeEquals (Stream r) (Readable ()) =>
|
||||
Body (Stream r) where
|
||||
defaultHeaders _ = pure $ header "Transfer-Encoding" "chunked"
|
||||
write body response = makeAff \done -> do
|
||||
let stream = to body
|
||||
void $ pipe stream $ responseAsStream response
|
||||
onEnd stream $ done $ Right unit
|
||||
pure nonCanceler
|
||||
|
||||
@ -8,37 +8,36 @@ module HTTPure.Headers
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Effect as Effect
|
||||
import Foreign.Object as Object
|
||||
import Data.Foldable as Foldable
|
||||
import Data.FoldableWithIndex as FoldableWithIndex
|
||||
import Data.Map as Map
|
||||
import Data.Newtype as Newtype
|
||||
import Data.String.CaseInsensitive as CaseInsensitive
|
||||
import Data.TraversableWithIndex as TraversableWithIndex
|
||||
import Data.Tuple as Tuple
|
||||
import Node.HTTP as HTTP
|
||||
import HTTPure.Lookup as Lookup
|
||||
import HTTPure.Lookup ((!!))
|
||||
import Effect (Effect)
|
||||
import Foreign.Object (fold)
|
||||
import Data.Foldable (foldl)
|
||||
import Data.FoldableWithIndex (foldMapWithIndex)
|
||||
import Data.Map (empty) as Map
|
||||
import Data.Map (Map, singleton, union, insert)
|
||||
import Data.Newtype (class Newtype, unwrap)
|
||||
import Data.String.CaseInsensitive (CaseInsensitiveString(CaseInsensitiveString))
|
||||
import Data.TraversableWithIndex (traverseWithIndex)
|
||||
import Data.Tuple (Tuple(Tuple))
|
||||
import Node.HTTP (Request, Response, requestHeaders, setHeader)
|
||||
import HTTPure.Lookup (class Lookup, (!!))
|
||||
|
||||
-- | The `Headers` type is just sugar for a `Object` of `Strings`
|
||||
-- | that represents the set of headers in an HTTP request or response.
|
||||
newtype Headers
|
||||
= Headers (Map.Map CaseInsensitive.CaseInsensitiveString String)
|
||||
newtype Headers = Headers (Map CaseInsensitiveString String)
|
||||
|
||||
derive instance newtypeHeaders :: Newtype.Newtype Headers _
|
||||
derive instance newtypeHeaders :: Newtype Headers _
|
||||
|
||||
-- | Given a string, return a `Maybe` containing the value of the matching
|
||||
-- | header, if there is any.
|
||||
instance lookup :: Lookup.Lookup Headers String String where
|
||||
instance lookup :: Lookup Headers String String where
|
||||
lookup (Headers headers') key = headers' !! key
|
||||
|
||||
-- | Allow a `Headers` to be represented as a string. This string is formatted
|
||||
-- | in HTTP headers format.
|
||||
instance show :: Show Headers where
|
||||
show (Headers headers') = FoldableWithIndex.foldMapWithIndex showField headers' <> "\n"
|
||||
show (Headers headers') = foldMapWithIndex showField headers' <> "\n"
|
||||
where
|
||||
showField key value = Newtype.unwrap key <> ": " <> value <> "\n"
|
||||
showField key value = unwrap key <> ": " <> value <> "\n"
|
||||
|
||||
-- | Compare two `Headers` objects by comparing the underlying `Objects`.
|
||||
instance eq :: Eq Headers where
|
||||
@ -46,33 +45,31 @@ instance eq :: Eq Headers where
|
||||
|
||||
-- | Allow one `Headers` objects to be appended to another.
|
||||
instance semigroup :: Semigroup Headers where
|
||||
append (Headers a) (Headers b) = Headers $ Map.union b a
|
||||
append (Headers a) (Headers b) = Headers $ union b a
|
||||
|
||||
-- | Get the headers out of a HTTP `Request` object.
|
||||
read :: HTTP.Request -> Headers
|
||||
read = HTTP.requestHeaders >>> Object.fold insertField Map.empty >>> Headers
|
||||
read :: Request -> Headers
|
||||
read = requestHeaders >>> fold insertField Map.empty >>> Headers
|
||||
where
|
||||
insertField x key value = Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
|
||||
insertField x key value = insert (CaseInsensitiveString key) value x
|
||||
|
||||
-- | Given an HTTP `Response` and a `Headers` object, return an effect that will
|
||||
-- | write the `Headers` to the `Response`.
|
||||
write :: HTTP.Response -> Headers -> Effect.Effect Unit
|
||||
write response (Headers headers') =
|
||||
void
|
||||
$ TraversableWithIndex.traverseWithIndex writeField headers'
|
||||
write :: Response -> Headers -> Effect Unit
|
||||
write response (Headers headers') = void $ traverseWithIndex writeField headers'
|
||||
where
|
||||
writeField key value = HTTP.setHeader response (Newtype.unwrap key) value
|
||||
writeField key value = setHeader response (unwrap key) value
|
||||
|
||||
-- | Return a `Headers` containing nothing.
|
||||
empty :: Headers
|
||||
empty = Headers Map.empty
|
||||
|
||||
-- | Convert an `Array` of `Tuples` of 2 `Strings` to a `Headers` object.
|
||||
headers :: Array (Tuple.Tuple String String) -> Headers
|
||||
headers = Foldable.foldl insertField Map.empty >>> Headers
|
||||
headers :: Array (Tuple String String) -> Headers
|
||||
headers = foldl insertField Map.empty >>> Headers
|
||||
where
|
||||
insertField x (Tuple.Tuple key value) = Map.insert (CaseInsensitive.CaseInsensitiveString key) value x
|
||||
insertField x (Tuple key value) = insert (CaseInsensitiveString key) value x
|
||||
|
||||
-- | Create a singleton header from a key-value pair.
|
||||
header :: String -> String -> Headers
|
||||
header key = Map.singleton (CaseInsensitive.CaseInsensitiveString key) >>> Headers
|
||||
header key = singleton (CaseInsensitiveString key) >>> Headers
|
||||
|
||||
@ -9,12 +9,13 @@ module HTTPure.Lookup
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Data.Array as Array
|
||||
import Data.Map as Map
|
||||
import Data.Maybe as Maybe
|
||||
import Data.Monoid as Monoid
|
||||
import Data.String.CaseInsensitive as CaseInsensitive
|
||||
import Foreign.Object as Object
|
||||
import Data.Array (index)
|
||||
import Data.Map (Map)
|
||||
import Data.Map (lookup) as Map
|
||||
import Data.Maybe (Maybe, fromMaybe, isJust)
|
||||
import Data.String.CaseInsensitive (CaseInsensitiveString(CaseInsensitiveString))
|
||||
import Foreign.Object (Object)
|
||||
import Foreign.Object (lookup) as Object
|
||||
|
||||
-- | 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
|
||||
@ -23,7 +24,7 @@ import Foreign.Object as Object
|
||||
class Lookup c k r | c -> r where
|
||||
-- | Given some type and a key on that type, extract some value that
|
||||
-- | corresponds to that key.
|
||||
lookup :: c -> k -> Maybe.Maybe r
|
||||
lookup :: c -> k -> Maybe r
|
||||
|
||||
-- | `!!` is inspired by `!!` in `Data.Array`, but note that it differs from
|
||||
-- | `!!` in `Data.Array` in that you can use `!!` for any other instance of
|
||||
@ -33,26 +34,26 @@ infixl 8 lookup as !!
|
||||
-- | The instance of `Lookup` for an `Array` is just `!!` as defined in
|
||||
-- | `Data.Array`.
|
||||
instance lookupArray :: Lookup (Array t) Int t where
|
||||
lookup = Array.index
|
||||
lookup = index
|
||||
|
||||
-- | The instance of `Lookup` for a `Object` just uses `Object.lookup` (but
|
||||
-- | flipped, because `Object.lookup` expects the key first, which would end up
|
||||
-- | with a really weird API for `!!`).
|
||||
instance lookupObject :: Lookup (Object.Object t) String t where
|
||||
instance lookupObject :: Lookup (Object t) String t where
|
||||
lookup = flip Object.lookup
|
||||
|
||||
-- | The instance of `Lookup` for a `Map CaseInsensitiveString` converts the
|
||||
-- | `String` to a `CaseInsensitiveString` for lookup.
|
||||
instance lookupMapCaseInsensitiveString ::
|
||||
Lookup (Map.Map CaseInsensitive.CaseInsensitiveString t) String t where
|
||||
lookup set key = Map.lookup (CaseInsensitive.CaseInsensitiveString key) set
|
||||
Lookup (Map CaseInsensitiveString t) String t where
|
||||
lookup set key = Map.lookup (CaseInsensitiveString key) set
|
||||
|
||||
-- | This simple helper works on any `Lookup` instance where the return type is
|
||||
-- | a `Monoid`, and is the same as `lookup` except that it returns a `t`
|
||||
-- | instead of a `Maybe t`. If `lookup` would return `Nothing`, then `at`
|
||||
-- | returns `mempty`.
|
||||
at :: forall c k r. Monoid.Monoid r => Lookup c k r => c -> k -> r
|
||||
at set = Maybe.fromMaybe Monoid.mempty <<< lookup set
|
||||
at :: forall c k r. Monoid r => Lookup c k r => c -> k -> r
|
||||
at set = fromMaybe mempty <<< lookup set
|
||||
|
||||
-- | Expose `at` as the infix operator `!@`
|
||||
infixl 8 at as !@
|
||||
@ -61,7 +62,7 @@ infixl 8 at as !@
|
||||
-- | has a single type variable, and returns a `Boolean` indicating if the given
|
||||
-- | key matches any value in the given container.
|
||||
has :: forall c k r. Lookup (c r) k r => c r -> k -> Boolean
|
||||
has set key = Maybe.isJust ((lookup set key) :: Maybe.Maybe r)
|
||||
has set key = isJust ((lookup set key) :: Maybe r)
|
||||
|
||||
-- | Expose `has` as the infix operator `!?`
|
||||
infixl 8 has as !?
|
||||
|
||||
@ -4,7 +4,7 @@ module HTTPure.Method
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Node.HTTP as HTTP
|
||||
import Node.HTTP (Request, requestMethod)
|
||||
|
||||
-- | These are the HTTP methods that HTTPure understands.
|
||||
data Method
|
||||
@ -34,8 +34,8 @@ instance showMethod :: Show Method where
|
||||
show Patch = "Patch"
|
||||
|
||||
-- | Take an HTTP `Request` and extract the `Method` for that request.
|
||||
read :: HTTP.Request -> Method
|
||||
read request = case HTTP.requestMethod request of
|
||||
read :: Request -> Method
|
||||
read = requestMethod >>> case _ of
|
||||
"POST" -> Post
|
||||
"PUT" -> Put
|
||||
"DELETE" -> Delete
|
||||
|
||||
@ -4,11 +4,11 @@ module HTTPure.Path
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Data.Array as Array
|
||||
import Data.Maybe as Maybe
|
||||
import Data.String as String
|
||||
import Node.HTTP as HTTP
|
||||
import HTTPure.Utils as Utils
|
||||
import Data.Array (filter, head)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String (Pattern(Pattern), split)
|
||||
import Node.HTTP (Request, requestURL)
|
||||
import HTTPure.Utils (urlDecode)
|
||||
|
||||
-- | 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.
|
||||
@ -16,15 +16,12 @@ import HTTPure.Utils as Utils
|
||||
-- | defined by `lookupArray` in [Lookup.purs](./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
|
||||
type Path = Array String
|
||||
|
||||
-- | Given an HTTP `Request` object, extract the `Path`.
|
||||
read :: HTTP.Request -> Path
|
||||
read = HTTP.requestURL >>> split "?" >>> first >>> split "/" >>> nonempty >>> map Utils.urlDecode
|
||||
read :: Request -> Path
|
||||
read = requestURL >>> split' "?" >>> first >>> split' "/" >>> nonempty >>> map urlDecode
|
||||
where
|
||||
nonempty = Array.filter ((/=) "")
|
||||
|
||||
split = String.Pattern >>> String.split
|
||||
|
||||
first = Array.head >>> Maybe.fromMaybe ""
|
||||
nonempty = filter ((/=) "")
|
||||
split' = Pattern >>> split
|
||||
first = head >>> fromMaybe ""
|
||||
|
||||
@ -4,14 +4,14 @@ module HTTPure.Query
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Data.Array as Array
|
||||
import Data.Bifunctor as Bifunctor
|
||||
import Data.Maybe as Maybe
|
||||
import Data.String as String
|
||||
import Data.Tuple as Tuple
|
||||
import Foreign.Object as Object
|
||||
import Node.HTTP as HTTP
|
||||
import HTTPure.Utils as Utils
|
||||
import Data.Array (filter, head, tail)
|
||||
import Data.Bifunctor (bimap)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String (Pattern(Pattern), split, joinWith)
|
||||
import Data.Tuple (Tuple(Tuple))
|
||||
import Foreign.Object (Object, fromFoldable)
|
||||
import Node.HTTP (Request, requestURL)
|
||||
import HTTPure.Utils (replacePlus, urlDecode)
|
||||
|
||||
-- | The `Query` type is a `Object` of `Strings`, with one entry per query
|
||||
-- | parameter in the request. For any query parameters that don't have values
|
||||
@ -21,27 +21,19 @@ import HTTPure.Utils as Utils
|
||||
-- | [Lookup.purs](./Lookup.purs) because `lookupObject` is defined for any
|
||||
-- | `Object` of `Monoids`. So you can do something like `query !! "foo"` to get
|
||||
-- | the value of the query parameter "foo".
|
||||
type Query
|
||||
= Object.Object String
|
||||
type Query = Object String
|
||||
|
||||
-- | The `Map` of query segments in the given HTTP `Request`.
|
||||
read :: HTTP.Request -> Query
|
||||
read = HTTP.requestURL >>> split "?" >>> last >>> split "&" >>> nonempty >>> toObject
|
||||
read :: Request -> Query
|
||||
read = requestURL >>> split' "?" >>> last >>> split' "&" >>> nonempty >>> toObject
|
||||
where
|
||||
toObject = map toTuple >>> Object.fromFoldable
|
||||
|
||||
nonempty = Array.filter ((/=) "")
|
||||
|
||||
split = String.Pattern >>> String.split
|
||||
|
||||
first = Array.head >>> Maybe.fromMaybe ""
|
||||
|
||||
last = Array.tail >>> Maybe.fromMaybe [] >>> String.joinWith ""
|
||||
|
||||
decode = Utils.replacePlus >>> Utils.urlDecode
|
||||
|
||||
decodeKeyValue = Bifunctor.bimap decode decode
|
||||
|
||||
toTuple item = decodeKeyValue $ Tuple.Tuple (first itemParts) (last itemParts)
|
||||
toObject = map toTuple >>> fromFoldable
|
||||
nonempty = filter ((/=) "")
|
||||
split' = Pattern >>> split
|
||||
first = head >>> fromMaybe ""
|
||||
last = tail >>> fromMaybe [] >>> joinWith ""
|
||||
decode = replacePlus >>> urlDecode
|
||||
decodeKeyValue = bimap decode decode
|
||||
toTuple item = decodeKeyValue $ Tuple (first itemParts) (last itemParts)
|
||||
where
|
||||
itemParts = split "=" item
|
||||
itemParts = split' "=" item
|
||||
|
||||
@ -5,28 +5,34 @@ module HTTPure.Request
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Effect.Aff as Aff
|
||||
import Data.String as String
|
||||
import Foreign.Object as Object
|
||||
import Node.HTTP as HTTP
|
||||
import Node.Stream as Stream
|
||||
import HTTPure.Body as Body
|
||||
import HTTPure.Headers as Headers
|
||||
import HTTPure.Method as Method
|
||||
import HTTPure.Path as Path
|
||||
import HTTPure.Query as Query
|
||||
import Effect.Aff (Aff)
|
||||
import Data.String (joinWith)
|
||||
import Foreign.Object (isEmpty, toArrayWithKey)
|
||||
import Node.HTTP (requestURL)
|
||||
import Node.HTTP (Request) as HTTP
|
||||
import Node.Stream (Readable)
|
||||
import HTTPure.Body (read) as Body
|
||||
import HTTPure.Headers (Headers)
|
||||
import HTTPure.Headers (read) as Headers
|
||||
import HTTPure.Method (Method)
|
||||
import HTTPure.Method (read) as Method
|
||||
import HTTPure.Path (Path)
|
||||
import HTTPure.Path (read) as Path
|
||||
import HTTPure.Query (Query)
|
||||
import HTTPure.Query (read) as Query
|
||||
import HTTPure.Utils (encodeURIComponent)
|
||||
import HTTPure.Version as Version
|
||||
import HTTPure.Version (Version)
|
||||
import HTTPure.Version (read) as Version
|
||||
|
||||
-- | The `Request` type is a `Record` type that includes fields for accessing
|
||||
-- | the different parts of the HTTP request.
|
||||
type Request =
|
||||
{ method :: Method.Method
|
||||
, path :: Path.Path
|
||||
, query :: Query.Query
|
||||
, headers :: Headers.Headers
|
||||
, body :: Stream.Readable ()
|
||||
, httpVersion :: Version.Version
|
||||
{ method :: Method
|
||||
, path :: Path
|
||||
, query :: Query
|
||||
, headers :: Headers
|
||||
, body :: Readable ()
|
||||
, httpVersion :: Version
|
||||
, url :: String
|
||||
}
|
||||
|
||||
@ -36,19 +42,15 @@ type Request =
|
||||
fullPath :: Request -> String
|
||||
fullPath request = "/" <> path <> questionMark <> queryParams
|
||||
where
|
||||
path = String.joinWith "/" request.path
|
||||
|
||||
questionMark = if Object.isEmpty request.query then "" else "?"
|
||||
|
||||
queryParams = String.joinWith "&" queryParamsArr
|
||||
|
||||
queryParamsArr = Object.toArrayWithKey stringifyQueryParam request.query
|
||||
|
||||
path = joinWith "/" request.path
|
||||
questionMark = if isEmpty request.query then "" else "?"
|
||||
queryParams = joinWith "&" queryParamsArr
|
||||
queryParamsArr = toArrayWithKey stringifyQueryParam request.query
|
||||
stringifyQueryParam key value = encodeURIComponent key <> "=" <> encodeURIComponent value
|
||||
|
||||
-- | Given an HTTP `Request` object, this method will convert it to an HTTPure
|
||||
-- | `Request` object.
|
||||
fromHTTPRequest :: HTTP.Request -> Aff.Aff Request
|
||||
fromHTTPRequest :: HTTP.Request -> Aff Request
|
||||
fromHTTPRequest request = pure
|
||||
{ method: Method.read request
|
||||
, path: Path.read request
|
||||
@ -56,5 +58,5 @@ fromHTTPRequest request = pure
|
||||
, headers: Headers.read request
|
||||
, body: Body.read request
|
||||
, httpVersion: Version.read request
|
||||
, url: HTTP.requestURL request
|
||||
, url: requestURL request
|
||||
}
|
||||
|
||||
@ -134,25 +134,88 @@ module HTTPure.Response
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Effect.Aff as Aff
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Aff.Class (class MonadAff, liftAff)
|
||||
import Effect.Class (class MonadEffect)
|
||||
import Effect.Class as EffectClass
|
||||
import Node.HTTP as HTTP
|
||||
import HTTPure.Body as Body
|
||||
import HTTPure.Headers as Headers
|
||||
import HTTPure.Status as Status
|
||||
import Effect.Class (class MonadEffect, liftEffect)
|
||||
import Node.HTTP (Response) as HTTP
|
||||
import HTTPure.Body (class Body, defaultHeaders, write)
|
||||
import HTTPure.Headers (Headers, empty)
|
||||
import HTTPure.Headers (write) as Headers
|
||||
import HTTPure.Status (Status)
|
||||
import HTTPure.Status
|
||||
( write
|
||||
, continue
|
||||
, switchingProtocols
|
||||
, processing
|
||||
, ok
|
||||
, created
|
||||
, accepted
|
||||
, nonAuthoritativeInformation
|
||||
, noContent
|
||||
, resetContent
|
||||
, partialContent
|
||||
, multiStatus
|
||||
, alreadyReported
|
||||
, iMUsed
|
||||
, multipleChoices
|
||||
, movedPermanently
|
||||
, found
|
||||
, seeOther
|
||||
, notModified
|
||||
, useProxy
|
||||
, temporaryRedirect
|
||||
, permanentRedirect
|
||||
, 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
|
||||
, internalServerError
|
||||
, notImplemented
|
||||
, badGateway
|
||||
, serviceUnavailable
|
||||
, gatewayTimeout
|
||||
, hTTPVersionNotSupported
|
||||
, variantAlsoNegotiates
|
||||
, insufficientStorage
|
||||
, loopDetected
|
||||
, notExtended
|
||||
, networkAuthenticationRequired
|
||||
) as Status
|
||||
|
||||
-- | 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 = Aff.Aff Response
|
||||
type ResponseM = Aff Response
|
||||
|
||||
-- | A `Response` is a status code, headers, and a body.
|
||||
type Response =
|
||||
{ status :: Status.Status
|
||||
, headers :: Headers.Headers
|
||||
, writeBody :: HTTP.Response -> Aff.Aff Unit
|
||||
{ status :: Status
|
||||
, headers :: Headers
|
||||
, writeBody :: HTTP.Response -> Aff Unit
|
||||
}
|
||||
|
||||
-- | Given an HTTP `Response` and a HTTPure `Response`, this method will return
|
||||
@ -160,39 +223,38 @@ type Response =
|
||||
-- | and closing the HTTP `Response`.
|
||||
send :: forall m. MonadEffect m => MonadAff m => HTTP.Response -> Response -> m Unit
|
||||
send httpresponse { status, headers, writeBody } = do
|
||||
EffectClass.liftEffect $ Status.write httpresponse status
|
||||
EffectClass.liftEffect $ Headers.write httpresponse headers
|
||||
liftEffect $ Status.write httpresponse status
|
||||
liftEffect $ Headers.write httpresponse headers
|
||||
liftAff $ writeBody httpresponse
|
||||
|
||||
-- | For custom response statuses or providing a body for response codes that
|
||||
-- | don't typically send one.
|
||||
response :: forall m b. MonadAff m => Body.Body b => Status.Status -> b -> m Response
|
||||
response status = response' status Headers.empty
|
||||
response :: forall m b. MonadAff m => Body b => Status -> b -> m Response
|
||||
response status = response' status empty
|
||||
|
||||
-- | The same as `response` but with headers.
|
||||
response' ::
|
||||
forall m b.
|
||||
MonadAff m =>
|
||||
Body.Body b =>
|
||||
Status.Status ->
|
||||
Headers.Headers ->
|
||||
Body b =>
|
||||
Status ->
|
||||
Headers ->
|
||||
b ->
|
||||
m Response
|
||||
response' status headers body =
|
||||
EffectClass.liftEffect do
|
||||
defaultHeaders <- Body.defaultHeaders body
|
||||
pure
|
||||
{ status
|
||||
, headers: defaultHeaders <> headers
|
||||
, writeBody: Body.write body
|
||||
}
|
||||
response' status headers body = liftEffect do
|
||||
defaultHeaders' <- defaultHeaders body
|
||||
pure
|
||||
{ status
|
||||
, headers: defaultHeaders' <> headers
|
||||
, writeBody: write body
|
||||
}
|
||||
|
||||
-- | The same as `response` but without a body.
|
||||
emptyResponse :: forall m. MonadAff m => Status.Status -> m Response
|
||||
emptyResponse status = emptyResponse' status Headers.empty
|
||||
emptyResponse :: forall m. MonadAff m => Status -> m Response
|
||||
emptyResponse status = emptyResponse' status empty
|
||||
|
||||
-- | The same as `emptyResponse` but with headers.
|
||||
emptyResponse' :: forall m. MonadAff m => Status.Status -> Headers.Headers -> m Response
|
||||
emptyResponse' :: forall m. MonadAff m => Status -> Headers -> m Response
|
||||
emptyResponse' status headers = response' status headers ""
|
||||
|
||||
---------
|
||||
@ -200,504 +262,504 @@ emptyResponse' status headers = response' status headers ""
|
||||
---------
|
||||
-- | 100
|
||||
continue :: forall m. MonadAff m => m Response
|
||||
continue = continue' Headers.empty
|
||||
continue = continue' empty
|
||||
|
||||
-- | 100 with headers
|
||||
continue' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
continue' :: forall m. MonadAff m => Headers -> m Response
|
||||
continue' = emptyResponse' Status.continue
|
||||
|
||||
-- | 101
|
||||
switchingProtocols :: forall m. MonadAff m => m Response
|
||||
switchingProtocols = switchingProtocols' Headers.empty
|
||||
switchingProtocols = switchingProtocols' empty
|
||||
|
||||
-- | 101 with headers
|
||||
switchingProtocols' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
switchingProtocols' :: forall m. MonadAff m => Headers -> m Response
|
||||
switchingProtocols' = emptyResponse' Status.switchingProtocols
|
||||
|
||||
-- | 102
|
||||
processing :: forall m. MonadAff m => m Response
|
||||
processing = processing' Headers.empty
|
||||
processing = processing' empty
|
||||
|
||||
-- | 102 with headers
|
||||
processing' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
processing' :: forall m. MonadAff m => Headers -> m Response
|
||||
processing' = emptyResponse' Status.processing
|
||||
|
||||
---------
|
||||
-- 2xx --
|
||||
---------
|
||||
-- | 200
|
||||
ok :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
ok = ok' Headers.empty
|
||||
ok :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
ok = ok' empty
|
||||
|
||||
-- | 200 with headers
|
||||
ok' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
ok' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
ok' = response' Status.ok
|
||||
|
||||
-- | 201
|
||||
created :: forall m. MonadAff m => m Response
|
||||
created = created' Headers.empty
|
||||
created = created' empty
|
||||
|
||||
-- | 201 with headers
|
||||
created' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
created' :: forall m. MonadAff m => Headers -> m Response
|
||||
created' = emptyResponse' Status.created
|
||||
|
||||
-- | 202
|
||||
accepted :: forall m. MonadAff m => m Response
|
||||
accepted = accepted' Headers.empty
|
||||
accepted = accepted' empty
|
||||
|
||||
-- | 202 with headers
|
||||
accepted' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
accepted' :: forall m. MonadAff m => Headers -> m Response
|
||||
accepted' = emptyResponse' Status.accepted
|
||||
|
||||
-- | 203
|
||||
nonAuthoritativeInformation :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
nonAuthoritativeInformation = nonAuthoritativeInformation' Headers.empty
|
||||
nonAuthoritativeInformation :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
nonAuthoritativeInformation = nonAuthoritativeInformation' empty
|
||||
|
||||
-- | 203 with headers
|
||||
nonAuthoritativeInformation' ::
|
||||
forall m b.
|
||||
MonadAff m =>
|
||||
Body.Body b =>
|
||||
Headers.Headers ->
|
||||
Body b =>
|
||||
Headers ->
|
||||
b ->
|
||||
m Response
|
||||
nonAuthoritativeInformation' = response' Status.nonAuthoritativeInformation
|
||||
|
||||
-- | 204
|
||||
noContent :: forall m. MonadAff m => m Response
|
||||
noContent = noContent' Headers.empty
|
||||
noContent = noContent' empty
|
||||
|
||||
-- | 204 with headers
|
||||
noContent' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
noContent' :: forall m. MonadAff m => Headers -> m Response
|
||||
noContent' = emptyResponse' Status.noContent
|
||||
|
||||
-- | 205
|
||||
resetContent :: forall m. MonadAff m => m Response
|
||||
resetContent = resetContent' Headers.empty
|
||||
resetContent = resetContent' empty
|
||||
|
||||
-- | 205 with headers
|
||||
resetContent' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
resetContent' :: forall m. MonadAff m => Headers -> m Response
|
||||
resetContent' = emptyResponse' Status.resetContent
|
||||
|
||||
-- | 206
|
||||
partialContent :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
partialContent = partialContent' Headers.empty
|
||||
partialContent :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
partialContent = partialContent' empty
|
||||
|
||||
-- | 206 with headers
|
||||
partialContent' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
partialContent' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
partialContent' = response' Status.partialContent
|
||||
|
||||
-- | 207
|
||||
multiStatus :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
multiStatus = multiStatus' Headers.empty
|
||||
multiStatus :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
multiStatus = multiStatus' empty
|
||||
|
||||
-- | 207 with headers
|
||||
multiStatus' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
multiStatus' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
multiStatus' = response' Status.multiStatus
|
||||
|
||||
-- | 208
|
||||
alreadyReported :: forall m. MonadAff m => m Response
|
||||
alreadyReported = alreadyReported' Headers.empty
|
||||
alreadyReported = alreadyReported' empty
|
||||
|
||||
-- | 208 with headers
|
||||
alreadyReported' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
alreadyReported' :: forall m. MonadAff m => Headers -> m Response
|
||||
alreadyReported' = emptyResponse' Status.alreadyReported
|
||||
|
||||
-- | 226
|
||||
iMUsed :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
iMUsed = iMUsed' Headers.empty
|
||||
iMUsed :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
iMUsed = iMUsed' empty
|
||||
|
||||
-- | 226 with headers
|
||||
iMUsed' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
iMUsed' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
iMUsed' = response' Status.iMUsed
|
||||
|
||||
---------
|
||||
-- 3xx --
|
||||
---------
|
||||
-- | 300
|
||||
multipleChoices :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
multipleChoices = multipleChoices' Headers.empty
|
||||
multipleChoices :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
multipleChoices = multipleChoices' empty
|
||||
|
||||
-- | 300 with headers
|
||||
multipleChoices' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
multipleChoices' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
multipleChoices' = response' Status.multipleChoices
|
||||
|
||||
-- | 301
|
||||
movedPermanently :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
movedPermanently = movedPermanently' Headers.empty
|
||||
movedPermanently :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
movedPermanently = movedPermanently' empty
|
||||
|
||||
-- | 301 with headers
|
||||
movedPermanently' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
movedPermanently' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
movedPermanently' = response' Status.movedPermanently
|
||||
|
||||
-- | 302
|
||||
found :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
found = found' Headers.empty
|
||||
found :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
found = found' empty
|
||||
|
||||
-- | 302 with headers
|
||||
found' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
found' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
found' = response' Status.found
|
||||
|
||||
-- | 303
|
||||
seeOther :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
seeOther = seeOther' Headers.empty
|
||||
seeOther :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
seeOther = seeOther' empty
|
||||
|
||||
-- | 303 with headers
|
||||
seeOther' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
seeOther' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
seeOther' = response' Status.seeOther
|
||||
|
||||
-- | 304
|
||||
notModified :: forall m. MonadAff m => m Response
|
||||
notModified = notModified' Headers.empty
|
||||
notModified = notModified' empty
|
||||
|
||||
-- | 304 with headers
|
||||
notModified' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
notModified' :: forall m. MonadAff m => Headers -> m Response
|
||||
notModified' = emptyResponse' Status.notModified
|
||||
|
||||
-- | 305
|
||||
useProxy :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
useProxy = useProxy' Headers.empty
|
||||
useProxy :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
useProxy = useProxy' empty
|
||||
|
||||
-- | 305 with headers
|
||||
useProxy' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
useProxy' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
useProxy' = response' Status.useProxy
|
||||
|
||||
-- | 307
|
||||
temporaryRedirect :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
temporaryRedirect = temporaryRedirect' Headers.empty
|
||||
temporaryRedirect :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
temporaryRedirect = temporaryRedirect' empty
|
||||
|
||||
-- | 307 with headers
|
||||
temporaryRedirect' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
temporaryRedirect' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
temporaryRedirect' = response' Status.temporaryRedirect
|
||||
|
||||
-- | 308
|
||||
permanentRedirect :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
permanentRedirect = permanentRedirect' Headers.empty
|
||||
permanentRedirect :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
permanentRedirect = permanentRedirect' empty
|
||||
|
||||
-- | 308 with headers
|
||||
permanentRedirect' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
permanentRedirect' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
permanentRedirect' = response' Status.permanentRedirect
|
||||
|
||||
---------
|
||||
-- 4xx --
|
||||
---------
|
||||
-- | 400
|
||||
badRequest :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
badRequest = badRequest' Headers.empty
|
||||
badRequest :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
badRequest = badRequest' empty
|
||||
|
||||
-- | 400 with headers
|
||||
badRequest' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
badRequest' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
badRequest' = response' Status.badRequest
|
||||
|
||||
-- | 401
|
||||
unauthorized :: forall m. MonadAff m => m Response
|
||||
unauthorized = unauthorized' Headers.empty
|
||||
unauthorized = unauthorized' empty
|
||||
|
||||
-- | 401 with headers
|
||||
unauthorized' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
unauthorized' :: forall m. MonadAff m => Headers -> m Response
|
||||
unauthorized' = emptyResponse' Status.unauthorized
|
||||
|
||||
-- | 402
|
||||
paymentRequired :: forall m. MonadAff m => m Response
|
||||
paymentRequired = paymentRequired' Headers.empty
|
||||
paymentRequired = paymentRequired' empty
|
||||
|
||||
-- | 402 with headers
|
||||
paymentRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
paymentRequired' :: forall m. MonadAff m => Headers -> m Response
|
||||
paymentRequired' = emptyResponse' Status.paymentRequired
|
||||
|
||||
-- | 403
|
||||
forbidden :: forall m. MonadAff m => m Response
|
||||
forbidden = forbidden' Headers.empty
|
||||
forbidden = forbidden' empty
|
||||
|
||||
-- | 403 with headers
|
||||
forbidden' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
forbidden' :: forall m. MonadAff m => Headers -> m Response
|
||||
forbidden' = emptyResponse' Status.forbidden
|
||||
|
||||
-- | 404
|
||||
notFound :: forall m. MonadAff m => m Response
|
||||
notFound = notFound' Headers.empty
|
||||
notFound = notFound' empty
|
||||
|
||||
-- | 404 with headers
|
||||
notFound' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
notFound' :: forall m. MonadAff m => Headers -> m Response
|
||||
notFound' = emptyResponse' Status.notFound
|
||||
|
||||
-- | 405
|
||||
methodNotAllowed :: forall m. MonadAff m => m Response
|
||||
methodNotAllowed = methodNotAllowed' Headers.empty
|
||||
methodNotAllowed = methodNotAllowed' empty
|
||||
|
||||
-- | 405 with headers
|
||||
methodNotAllowed' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
methodNotAllowed' :: forall m. MonadAff m => Headers -> m Response
|
||||
methodNotAllowed' = emptyResponse' Status.methodNotAllowed
|
||||
|
||||
-- | 406
|
||||
notAcceptable :: forall m. MonadAff m => m Response
|
||||
notAcceptable = notAcceptable' Headers.empty
|
||||
notAcceptable = notAcceptable' empty
|
||||
|
||||
-- | 406 with headers
|
||||
notAcceptable' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
notAcceptable' :: forall m. MonadAff m => Headers -> m Response
|
||||
notAcceptable' = emptyResponse' Status.notAcceptable
|
||||
|
||||
-- | 407
|
||||
proxyAuthenticationRequired :: forall m. MonadAff m => m Response
|
||||
proxyAuthenticationRequired = proxyAuthenticationRequired' Headers.empty
|
||||
proxyAuthenticationRequired = proxyAuthenticationRequired' empty
|
||||
|
||||
-- | 407 with headers
|
||||
proxyAuthenticationRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
proxyAuthenticationRequired' :: forall m. MonadAff m => Headers -> m Response
|
||||
proxyAuthenticationRequired' = emptyResponse' Status.proxyAuthenticationRequired
|
||||
|
||||
-- | 408
|
||||
requestTimeout :: forall m. MonadAff m => m Response
|
||||
requestTimeout = requestTimeout' Headers.empty
|
||||
requestTimeout = requestTimeout' empty
|
||||
|
||||
-- | 408 with headers
|
||||
requestTimeout' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
requestTimeout' :: forall m. MonadAff m => Headers -> m Response
|
||||
requestTimeout' = emptyResponse' Status.requestTimeout
|
||||
|
||||
-- | 409
|
||||
conflict :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
conflict = conflict' Headers.empty
|
||||
conflict :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
conflict = conflict' empty
|
||||
|
||||
-- | 409 with headers
|
||||
conflict' :: forall m b. MonadAff m => Body.Body b => Headers.Headers -> b -> m Response
|
||||
conflict' :: forall m b. MonadAff m => Body b => Headers -> b -> m Response
|
||||
conflict' = response' Status.conflict
|
||||
|
||||
-- | 410
|
||||
gone :: forall m. MonadAff m => m Response
|
||||
gone = gone' Headers.empty
|
||||
gone = gone' empty
|
||||
|
||||
-- | 410 with headers
|
||||
gone' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
gone' :: forall m. MonadAff m => Headers -> m Response
|
||||
gone' = emptyResponse' Status.gone
|
||||
|
||||
-- | 411
|
||||
lengthRequired :: forall m. MonadAff m => m Response
|
||||
lengthRequired = lengthRequired' Headers.empty
|
||||
lengthRequired = lengthRequired' empty
|
||||
|
||||
-- | 411 with headers
|
||||
lengthRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
lengthRequired' :: forall m. MonadAff m => Headers -> m Response
|
||||
lengthRequired' = emptyResponse' Status.lengthRequired
|
||||
|
||||
-- | 412
|
||||
preconditionFailed :: forall m. MonadAff m => m Response
|
||||
preconditionFailed = preconditionFailed' Headers.empty
|
||||
preconditionFailed = preconditionFailed' empty
|
||||
|
||||
-- | 412 with headers
|
||||
preconditionFailed' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
preconditionFailed' :: forall m. MonadAff m => Headers -> m Response
|
||||
preconditionFailed' = emptyResponse' Status.preconditionFailed
|
||||
|
||||
-- | 413
|
||||
payloadTooLarge :: forall m. MonadAff m => m Response
|
||||
payloadTooLarge = payloadTooLarge' Headers.empty
|
||||
payloadTooLarge = payloadTooLarge' empty
|
||||
|
||||
-- | 413 with headers
|
||||
payloadTooLarge' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
payloadTooLarge' :: forall m. MonadAff m => Headers -> m Response
|
||||
payloadTooLarge' = emptyResponse' Status.payloadTooLarge
|
||||
|
||||
-- | 414
|
||||
uRITooLong :: forall m. MonadAff m => m Response
|
||||
uRITooLong = uRITooLong' Headers.empty
|
||||
uRITooLong = uRITooLong' empty
|
||||
|
||||
-- | 414 with headers
|
||||
uRITooLong' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
uRITooLong' :: forall m. MonadAff m => Headers -> m Response
|
||||
uRITooLong' = emptyResponse' Status.uRITooLong
|
||||
|
||||
-- | 415
|
||||
unsupportedMediaType :: forall m. MonadAff m => m Response
|
||||
unsupportedMediaType = unsupportedMediaType' Headers.empty
|
||||
unsupportedMediaType = unsupportedMediaType' empty
|
||||
|
||||
-- | 415 with headers
|
||||
unsupportedMediaType' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
unsupportedMediaType' :: forall m. MonadAff m => Headers -> m Response
|
||||
unsupportedMediaType' = emptyResponse' Status.unsupportedMediaType
|
||||
|
||||
-- | 416
|
||||
rangeNotSatisfiable :: forall m. MonadAff m => m Response
|
||||
rangeNotSatisfiable = rangeNotSatisfiable' Headers.empty
|
||||
rangeNotSatisfiable = rangeNotSatisfiable' empty
|
||||
|
||||
-- | 416 with headers
|
||||
rangeNotSatisfiable' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
rangeNotSatisfiable' :: forall m. MonadAff m => Headers -> m Response
|
||||
rangeNotSatisfiable' = emptyResponse' Status.rangeNotSatisfiable
|
||||
|
||||
-- | 417
|
||||
expectationFailed :: forall m. MonadAff m => m Response
|
||||
expectationFailed = expectationFailed' Headers.empty
|
||||
expectationFailed = expectationFailed' empty
|
||||
|
||||
-- | 417 with headers
|
||||
expectationFailed' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
expectationFailed' :: forall m. MonadAff m => Headers -> m Response
|
||||
expectationFailed' = emptyResponse' Status.expectationFailed
|
||||
|
||||
-- | 418
|
||||
imATeapot :: forall m. MonadAff m => m Response
|
||||
imATeapot = imATeapot' Headers.empty
|
||||
imATeapot = imATeapot' empty
|
||||
|
||||
-- | 418 with headers
|
||||
imATeapot' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
imATeapot' :: forall m. MonadAff m => Headers -> m Response
|
||||
imATeapot' = emptyResponse' Status.imATeapot
|
||||
|
||||
-- | 421
|
||||
misdirectedRequest :: forall m. MonadAff m => m Response
|
||||
misdirectedRequest = misdirectedRequest' Headers.empty
|
||||
misdirectedRequest = misdirectedRequest' empty
|
||||
|
||||
-- | 421 with headers
|
||||
misdirectedRequest' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
misdirectedRequest' :: forall m. MonadAff m => Headers -> m Response
|
||||
misdirectedRequest' = emptyResponse' Status.misdirectedRequest
|
||||
|
||||
-- | 422
|
||||
unprocessableEntity :: forall m. MonadAff m => m Response
|
||||
unprocessableEntity = unprocessableEntity' Headers.empty
|
||||
unprocessableEntity = unprocessableEntity' empty
|
||||
|
||||
-- | 422 with headers
|
||||
unprocessableEntity' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
unprocessableEntity' :: forall m. MonadAff m => Headers -> m Response
|
||||
unprocessableEntity' = emptyResponse' Status.unprocessableEntity
|
||||
|
||||
-- | 423
|
||||
locked :: forall m. MonadAff m => m Response
|
||||
locked = locked' Headers.empty
|
||||
locked = locked' empty
|
||||
|
||||
-- | 423 with headers
|
||||
locked' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
locked' :: forall m. MonadAff m => Headers -> m Response
|
||||
locked' = emptyResponse' Status.locked
|
||||
|
||||
-- | 424
|
||||
failedDependency :: forall m. MonadAff m => m Response
|
||||
failedDependency = failedDependency' Headers.empty
|
||||
failedDependency = failedDependency' empty
|
||||
|
||||
-- | 424 with headers
|
||||
failedDependency' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
failedDependency' :: forall m. MonadAff m => Headers -> m Response
|
||||
failedDependency' = emptyResponse' Status.failedDependency
|
||||
|
||||
-- | 426
|
||||
upgradeRequired :: forall m. MonadAff m => m Response
|
||||
upgradeRequired = upgradeRequired' Headers.empty
|
||||
upgradeRequired = upgradeRequired' empty
|
||||
|
||||
-- | 426 with headers
|
||||
upgradeRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
upgradeRequired' :: forall m. MonadAff m => Headers -> m Response
|
||||
upgradeRequired' = emptyResponse' Status.upgradeRequired
|
||||
|
||||
-- | 428
|
||||
preconditionRequired :: forall m. MonadAff m => m Response
|
||||
preconditionRequired = preconditionRequired' Headers.empty
|
||||
preconditionRequired = preconditionRequired' empty
|
||||
|
||||
-- | 428 with headers
|
||||
preconditionRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
preconditionRequired' :: forall m. MonadAff m => Headers -> m Response
|
||||
preconditionRequired' = emptyResponse' Status.preconditionRequired
|
||||
|
||||
-- | 429
|
||||
tooManyRequests :: forall m. MonadAff m => m Response
|
||||
tooManyRequests = tooManyRequests' Headers.empty
|
||||
tooManyRequests = tooManyRequests' empty
|
||||
|
||||
-- | 429 with headers
|
||||
tooManyRequests' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
tooManyRequests' :: forall m. MonadAff m => Headers -> m Response
|
||||
tooManyRequests' = emptyResponse' Status.tooManyRequests
|
||||
|
||||
-- | 431
|
||||
requestHeaderFieldsTooLarge :: forall m. MonadAff m => m Response
|
||||
requestHeaderFieldsTooLarge = requestHeaderFieldsTooLarge' Headers.empty
|
||||
requestHeaderFieldsTooLarge = requestHeaderFieldsTooLarge' empty
|
||||
|
||||
-- | 431 with headers
|
||||
requestHeaderFieldsTooLarge' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
requestHeaderFieldsTooLarge' :: forall m. MonadAff m => Headers -> m Response
|
||||
requestHeaderFieldsTooLarge' = emptyResponse' Status.requestHeaderFieldsTooLarge
|
||||
|
||||
-- | 451
|
||||
unavailableForLegalReasons :: forall m. MonadAff m => m Response
|
||||
unavailableForLegalReasons = unavailableForLegalReasons' Headers.empty
|
||||
unavailableForLegalReasons = unavailableForLegalReasons' empty
|
||||
|
||||
-- | 451 with headers
|
||||
unavailableForLegalReasons' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
unavailableForLegalReasons' :: forall m. MonadAff m => Headers -> m Response
|
||||
unavailableForLegalReasons' = emptyResponse' Status.unavailableForLegalReasons
|
||||
|
||||
---------
|
||||
-- 5xx --
|
||||
---------
|
||||
-- | 500
|
||||
internalServerError :: forall m b. MonadAff m => Body.Body b => b -> m Response
|
||||
internalServerError = internalServerError' Headers.empty
|
||||
internalServerError :: forall m b. MonadAff m => Body b => b -> m Response
|
||||
internalServerError = internalServerError' empty
|
||||
|
||||
-- | 500 with headers
|
||||
internalServerError' ::
|
||||
forall m b.
|
||||
MonadAff m =>
|
||||
Body.Body b =>
|
||||
Headers.Headers ->
|
||||
Body b =>
|
||||
Headers ->
|
||||
b ->
|
||||
m Response
|
||||
internalServerError' = response' Status.internalServerError
|
||||
|
||||
-- | 501
|
||||
notImplemented :: forall m. MonadAff m => m Response
|
||||
notImplemented = notImplemented' Headers.empty
|
||||
notImplemented = notImplemented' empty
|
||||
|
||||
-- | 501 with headers
|
||||
notImplemented' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
notImplemented' :: forall m. MonadAff m => Headers -> m Response
|
||||
notImplemented' = emptyResponse' Status.notImplemented
|
||||
|
||||
-- | 502
|
||||
badGateway :: forall m. MonadAff m => m Response
|
||||
badGateway = badGateway' Headers.empty
|
||||
badGateway = badGateway' empty
|
||||
|
||||
-- | 502 with headers
|
||||
badGateway' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
badGateway' :: forall m. MonadAff m => Headers -> m Response
|
||||
badGateway' = emptyResponse' Status.badGateway
|
||||
|
||||
-- | 503
|
||||
serviceUnavailable :: forall m. MonadAff m => m Response
|
||||
serviceUnavailable = serviceUnavailable' Headers.empty
|
||||
serviceUnavailable = serviceUnavailable' empty
|
||||
|
||||
-- | 503 with headers
|
||||
serviceUnavailable' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
serviceUnavailable' :: forall m. MonadAff m => Headers -> m Response
|
||||
serviceUnavailable' = emptyResponse' Status.serviceUnavailable
|
||||
|
||||
-- | 504
|
||||
gatewayTimeout :: forall m. MonadAff m => m Response
|
||||
gatewayTimeout = gatewayTimeout' Headers.empty
|
||||
gatewayTimeout = gatewayTimeout' empty
|
||||
|
||||
-- | 504 with headers
|
||||
gatewayTimeout' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
gatewayTimeout' :: forall m. MonadAff m => Headers -> m Response
|
||||
gatewayTimeout' = emptyResponse' Status.gatewayTimeout
|
||||
|
||||
-- | 505
|
||||
hTTPVersionNotSupported :: forall m. MonadAff m => m Response
|
||||
hTTPVersionNotSupported = hTTPVersionNotSupported' Headers.empty
|
||||
hTTPVersionNotSupported = hTTPVersionNotSupported' empty
|
||||
|
||||
-- | 505 with headers
|
||||
hTTPVersionNotSupported' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
hTTPVersionNotSupported' :: forall m. MonadAff m => Headers -> m Response
|
||||
hTTPVersionNotSupported' = emptyResponse' Status.hTTPVersionNotSupported
|
||||
|
||||
-- | 506
|
||||
variantAlsoNegotiates :: forall m. MonadAff m => m Response
|
||||
variantAlsoNegotiates = variantAlsoNegotiates' Headers.empty
|
||||
variantAlsoNegotiates = variantAlsoNegotiates' empty
|
||||
|
||||
-- | 506 with headers
|
||||
variantAlsoNegotiates' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
variantAlsoNegotiates' :: forall m. MonadAff m => Headers -> m Response
|
||||
variantAlsoNegotiates' = emptyResponse' Status.variantAlsoNegotiates
|
||||
|
||||
-- | 507
|
||||
insufficientStorage :: forall m. MonadAff m => m Response
|
||||
insufficientStorage = insufficientStorage' Headers.empty
|
||||
insufficientStorage = insufficientStorage' empty
|
||||
|
||||
-- | 507 with headers
|
||||
insufficientStorage' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
insufficientStorage' :: forall m. MonadAff m => Headers -> m Response
|
||||
insufficientStorage' = emptyResponse' Status.insufficientStorage
|
||||
|
||||
-- | 508
|
||||
loopDetected :: forall m. MonadAff m => m Response
|
||||
loopDetected = loopDetected' Headers.empty
|
||||
loopDetected = loopDetected' empty
|
||||
|
||||
-- | 508 with headers
|
||||
loopDetected' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
loopDetected' :: forall m. MonadAff m => Headers -> m Response
|
||||
loopDetected' = emptyResponse' Status.loopDetected
|
||||
|
||||
-- | 510
|
||||
notExtended :: forall m. MonadAff m => m Response
|
||||
notExtended = notExtended' Headers.empty
|
||||
notExtended = notExtended' empty
|
||||
|
||||
-- | 510 with headers
|
||||
notExtended' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
notExtended' :: forall m. MonadAff m => Headers -> m Response
|
||||
notExtended' = emptyResponse' Status.notExtended
|
||||
|
||||
-- | 511
|
||||
networkAuthenticationRequired :: forall m. MonadAff m => m Response
|
||||
networkAuthenticationRequired = networkAuthenticationRequired' Headers.empty
|
||||
networkAuthenticationRequired = networkAuthenticationRequired' empty
|
||||
|
||||
-- | 511 with headers
|
||||
networkAuthenticationRequired' :: forall m. MonadAff m => Headers.Headers -> m Response
|
||||
networkAuthenticationRequired' :: forall m. MonadAff m => Headers -> m Response
|
||||
networkAuthenticationRequired' = emptyResponse' Status.networkAuthenticationRequired
|
||||
|
||||
@ -7,84 +7,78 @@ module HTTPure.Server
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Effect as Effect
|
||||
import Effect.Aff as Aff
|
||||
import Effect.Class as EffectClass
|
||||
import Effect.Console as Console
|
||||
import Data.Maybe as Maybe
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (catchError, runAff, message)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (error)
|
||||
import Data.Maybe (Maybe(Nothing))
|
||||
import Data.Options ((:=), Options)
|
||||
import Node.Encoding as Encoding
|
||||
import Node.FS.Sync as FSSync
|
||||
import Node.HTTP as HTTP
|
||||
import Node.HTTP.Secure as HTTPS
|
||||
import HTTPure.Request as Request
|
||||
import HTTPure.Response as Response
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.FS.Sync (readTextFile)
|
||||
import Node.HTTP (Request, Response, createServer) as HTTP
|
||||
import Node.HTTP (ListenOptions, listen, close)
|
||||
import Node.HTTP.Secure (createServer) as HTTPS
|
||||
import Node.HTTP.Secure (SSLOptions, key, keyString, cert, certString)
|
||||
import HTTPure.Request (Request, fromHTTPRequest)
|
||||
import HTTPure.Response (ResponseM, internalServerError, send)
|
||||
|
||||
-- | The `ServerM` is just an `Effect` containing a callback to close the
|
||||
-- | server. This type is the return type of the HTTPure serve and related
|
||||
-- | methods.
|
||||
type ServerM
|
||||
= Effect.Effect (Effect.Effect Unit -> Effect.Effect Unit)
|
||||
type ServerM = Effect (Effect Unit -> Effect Unit)
|
||||
|
||||
-- | Given a router, handle unhandled exceptions it raises by
|
||||
-- | responding with 500 Internal Server Error.
|
||||
onError500 ::
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
Request.Request ->
|
||||
Response.ResponseM
|
||||
onError500 :: (Request -> ResponseM) -> Request -> ResponseM
|
||||
onError500 router request =
|
||||
Aff.catchError (router request) \err -> do
|
||||
EffectClass.liftEffect $ Console.error $ Aff.message err
|
||||
Response.internalServerError "Internal server error"
|
||||
catchError (router request) \err -> do
|
||||
liftEffect $ error $ message err
|
||||
internalServerError "Internal server error"
|
||||
|
||||
-- | This function takes a method which takes a `Request` and returns a
|
||||
-- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the
|
||||
-- | request, extracts the `Response` from the `ResponseM`, and sends the
|
||||
-- | `Response` to the HTTP `Response`.
|
||||
handleRequest ::
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
(Request -> ResponseM) ->
|
||||
HTTP.Request ->
|
||||
HTTP.Response ->
|
||||
Effect.Effect Unit
|
||||
Effect Unit
|
||||
handleRequest router request httpresponse =
|
||||
void $ Aff.runAff (\_ -> pure unit) $ Request.fromHTTPRequest request
|
||||
void $ runAff (\_ -> pure unit) $ fromHTTPRequest request
|
||||
>>= onError500 router
|
||||
>>= Response.send httpresponse
|
||||
>>= send httpresponse
|
||||
|
||||
-- | Given a `ListenOptions` object, a function mapping `Request` to
|
||||
-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
|
||||
-- | runs a HTTPure server without SSL.
|
||||
serve' ::
|
||||
HTTP.ListenOptions ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
Effect.Effect Unit ->
|
||||
ServerM
|
||||
serve' :: ListenOptions -> (Request -> ResponseM) -> Effect Unit -> ServerM
|
||||
serve' options router onStarted = do
|
||||
server <- HTTP.createServer (handleRequest router)
|
||||
HTTP.listen server options onStarted
|
||||
pure $ HTTP.close server
|
||||
listen server options onStarted
|
||||
pure $ close server
|
||||
|
||||
-- | Given a `Options HTTPS.SSLOptions` object and a `HTTP.ListenOptions`
|
||||
-- | object, a function mapping `Request` to `ResponseM`, and a `ServerM`
|
||||
-- | containing effects to run on boot, creates and runs a HTTPure server with
|
||||
-- | SSL.
|
||||
serveSecure' ::
|
||||
Options HTTPS.SSLOptions ->
|
||||
HTTP.ListenOptions ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
Effect.Effect Unit ->
|
||||
Options SSLOptions ->
|
||||
ListenOptions ->
|
||||
(Request -> ResponseM) ->
|
||||
Effect Unit ->
|
||||
ServerM
|
||||
serveSecure' sslOptions options router onStarted = do
|
||||
server <- HTTPS.createServer sslOptions (handleRequest router)
|
||||
HTTP.listen server options onStarted
|
||||
pure $ HTTP.close server
|
||||
listen server options onStarted
|
||||
pure $ close server
|
||||
|
||||
-- | Given a port number, return a `HTTP.ListenOptions` `Record`.
|
||||
listenOptions :: Int -> HTTP.ListenOptions
|
||||
listenOptions :: Int -> ListenOptions
|
||||
listenOptions port =
|
||||
{ hostname: "0.0.0.0"
|
||||
, port: port
|
||||
, backlog: Maybe.Nothing
|
||||
, port
|
||||
, backlog: Nothing
|
||||
}
|
||||
|
||||
-- | Create and start a server. This is the main entry point for HTTPure. Takes
|
||||
@ -92,11 +86,7 @@ listenOptions port =
|
||||
-- | `ResponseM`, and a `ServerM` containing effects to run after the server has
|
||||
-- | booted (usually logging). Returns an `ServerM` containing the server's
|
||||
-- | effects.
|
||||
serve ::
|
||||
Int ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
Effect.Effect Unit ->
|
||||
ServerM
|
||||
serve :: Int -> (Request -> ResponseM) -> Effect Unit -> ServerM
|
||||
serve = serve' <<< listenOptions
|
||||
|
||||
-- | Create and start an SSL server. This method is the same as `serve`, but
|
||||
@ -110,14 +100,11 @@ serveSecure ::
|
||||
Int ->
|
||||
String ->
|
||||
String ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
Effect.Effect Unit ->
|
||||
(Request -> ResponseM) ->
|
||||
Effect Unit ->
|
||||
ServerM
|
||||
serveSecure port cert key router onStarted = do
|
||||
cert' <- FSSync.readTextFile Encoding.UTF8 cert
|
||||
key' <- FSSync.readTextFile Encoding.UTF8 key
|
||||
serveSecure' (sslOpts key' cert') (listenOptions port) router onStarted
|
||||
where
|
||||
sslOpts key' cert' =
|
||||
HTTPS.key := HTTPS.keyString key'
|
||||
<> HTTPS.cert := HTTPS.certString cert'
|
||||
serveSecure port certFile keyFile router onStarted = do
|
||||
cert' <- readTextFile UTF8 certFile
|
||||
key' <- readTextFile UTF8 keyFile
|
||||
let sslOpts = key := keyString key' <> cert := certString cert'
|
||||
serveSecure' sslOpts (listenOptions port) router onStarted
|
||||
|
||||
@ -69,16 +69,15 @@ module HTTPure.Status
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Effect as Effect
|
||||
import Node.HTTP as HTTP
|
||||
import Effect (Effect)
|
||||
import Node.HTTP (Response, setStatusCode)
|
||||
|
||||
-- | The `Status` type enumerates all valid HTTP response status codes.
|
||||
type Status
|
||||
= Int
|
||||
type Status = Int
|
||||
|
||||
-- | Write a status to a given HTTP `Response`.
|
||||
write :: HTTP.Response -> Status -> Effect.Effect Unit
|
||||
write = HTTP.setStatusCode
|
||||
write :: Response -> Status -> Effect Unit
|
||||
write = setStatusCode
|
||||
|
||||
---------
|
||||
-- 1xx --
|
||||
|
||||
@ -5,15 +5,15 @@ module HTTPure.Utils
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Data.Maybe as Maybe
|
||||
import Data.String as String
|
||||
import JSURI as JSURI
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String (Pattern(Pattern), Replacement(Replacement), replaceAll)
|
||||
import JSURI (encodeURIComponent, decodeURIComponent) as JSURI
|
||||
|
||||
encodeURIComponent :: String -> String
|
||||
encodeURIComponent s = Maybe.fromMaybe s $ JSURI.encodeURIComponent s
|
||||
encodeURIComponent s = fromMaybe s $ JSURI.encodeURIComponent s
|
||||
|
||||
replacePlus :: String -> String
|
||||
replacePlus = String.replaceAll (String.Pattern "+") (String.Replacement "%20")
|
||||
replacePlus = replaceAll (Pattern "+") (Replacement "%20")
|
||||
|
||||
urlDecode :: String -> String
|
||||
urlDecode s = Maybe.fromMaybe s $ JSURI.decodeURIComponent s
|
||||
urlDecode s = fromMaybe s $ JSURI.decodeURIComponent s
|
||||
|
||||
@ -4,7 +4,7 @@ module HTTPure.Version
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Node.HTTP as HTTP
|
||||
import Node.HTTP (Request, httpVersion)
|
||||
|
||||
-- | These are the HTTP versions that HTTPure understands. There are five
|
||||
-- | commonly known versions which are explicitly named.
|
||||
@ -30,8 +30,8 @@ instance showVersion :: Show Version where
|
||||
show (Other version) = "HTTP/" <> version
|
||||
|
||||
-- | Take an HTTP `Request` and extract the `Version` for that request.
|
||||
read :: HTTP.Request -> Version
|
||||
read request = case HTTP.httpVersion request of
|
||||
read :: Request -> Version
|
||||
read = httpVersion >>> case _ of
|
||||
"0.9" -> HTTP0_9
|
||||
"1.0" -> HTTP1_0
|
||||
"1.1" -> HTTP1_1
|
||||
|
||||
@ -2,92 +2,90 @@ module Test.HTTPure.BodySpec where
|
||||
|
||||
import Prelude
|
||||
import Data.Maybe (Maybe(Nothing), fromMaybe)
|
||||
import Effect.Class as EffectClass
|
||||
import Node.Buffer as Buffer
|
||||
import Node.Encoding as Encoding
|
||||
import Node.Stream as Stream
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Body as Body
|
||||
import HTTPure.Headers as Headers
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=), stringToStream)
|
||||
import Effect.Class (liftEffect)
|
||||
import Node.Buffer (toString) as Buffer
|
||||
import Node.Buffer (Buffer, fromString)
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.Stream (readString)
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Body (read, toString, toBuffer, defaultHeaders, write)
|
||||
import HTTPure.Headers (header)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockRequest, mockResponse, getResponseBody, stringToStream)
|
||||
|
||||
readSpec :: TestHelpers.Test
|
||||
readSpec :: Test
|
||||
readSpec =
|
||||
Spec.describe "read" do
|
||||
Spec.it "is the body of the Request" do
|
||||
body <- Body.read <$> TestHelpers.mockRequest "" "GET" "" "test" []
|
||||
string <- EffectClass.liftEffect $ fromMaybe "" <$> Stream.readString body Nothing Encoding.UTF8
|
||||
describe "read" do
|
||||
it "is the body of the Request" do
|
||||
body <- read <$> mockRequest "" "GET" "" "test" []
|
||||
string <- liftEffect $ fromMaybe "" <$> readString body Nothing UTF8
|
||||
string ?= "test"
|
||||
|
||||
toStringSpec :: TestHelpers.Test
|
||||
toStringSpec :: Test
|
||||
toStringSpec =
|
||||
Spec.describe "toString" do
|
||||
Spec.it "slurps Streams into Strings" do
|
||||
string <- Body.toString $ stringToStream "foobar"
|
||||
describe "toString" do
|
||||
it "slurps Streams into Strings" do
|
||||
string <- toString $ stringToStream "foobar"
|
||||
string ?= "foobar"
|
||||
|
||||
toBufferSpec :: TestHelpers.Test
|
||||
toBufferSpec :: Test
|
||||
toBufferSpec =
|
||||
Spec.describe "toBuffer" do
|
||||
Spec.it "slurps Streams into Buffers" do
|
||||
buf <- Body.toBuffer $ stringToStream "foobar"
|
||||
string <- EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 buf
|
||||
describe "toBuffer" do
|
||||
it "slurps Streams into Buffers" do
|
||||
buf <- toBuffer $ stringToStream "foobar"
|
||||
string <- liftEffect $ Buffer.toString UTF8 buf
|
||||
string ?= "foobar"
|
||||
|
||||
defaultHeadersSpec :: TestHelpers.Test
|
||||
defaultHeadersSpec :: Test
|
||||
defaultHeadersSpec =
|
||||
Spec.describe "defaultHeaders" do
|
||||
Spec.describe "String" do
|
||||
Spec.describe "with an ASCII string" do
|
||||
Spec.it "has the correct Content-Length header" do
|
||||
headers <- EffectClass.liftEffect $ Body.defaultHeaders "ascii"
|
||||
headers ?= Headers.header "Content-Length" "5"
|
||||
Spec.describe "with a UTF-8 string" do
|
||||
Spec.it "has the correct Content-Length header" do
|
||||
headers <- EffectClass.liftEffect $ Body.defaultHeaders "\x2603"
|
||||
headers ?= Headers.header "Content-Length" "3"
|
||||
Spec.describe "Buffer" do
|
||||
Spec.it "has the correct Content-Length header" do
|
||||
buf :: Buffer.Buffer <- EffectClass.liftEffect $ Buffer.fromString "foobar" Encoding.UTF8
|
||||
headers <- EffectClass.liftEffect $ Body.defaultHeaders buf
|
||||
headers ?= Headers.header "Content-Length" "6"
|
||||
Spec.describe "Readable" do
|
||||
Spec.it "specifies the Transfer-Encoding header" do
|
||||
let
|
||||
body = TestHelpers.stringToStream "test"
|
||||
headers <- EffectClass.liftEffect $ Body.defaultHeaders body
|
||||
headers ?= Headers.header "Transfer-Encoding" "chunked"
|
||||
describe "defaultHeaders" do
|
||||
describe "String" do
|
||||
describe "with an ASCII string" do
|
||||
it "has the correct Content-Length header" do
|
||||
headers <- liftEffect $ defaultHeaders "ascii"
|
||||
headers ?= header "Content-Length" "5"
|
||||
describe "with a UTF-8 string" do
|
||||
it "has the correct Content-Length header" do
|
||||
headers <- liftEffect $ defaultHeaders "\x2603"
|
||||
headers ?= header "Content-Length" "3"
|
||||
describe "Buffer" do
|
||||
it "has the correct Content-Length header" do
|
||||
buf :: Buffer <- liftEffect $ fromString "foobar" UTF8
|
||||
headers <- liftEffect $ defaultHeaders buf
|
||||
headers ?= header "Content-Length" "6"
|
||||
describe "Readable" do
|
||||
it "specifies the Transfer-Encoding header" do
|
||||
headers <- liftEffect $ defaultHeaders $ stringToStream "test"
|
||||
headers ?= header "Transfer-Encoding" "chunked"
|
||||
|
||||
writeSpec :: TestHelpers.Test
|
||||
writeSpec :: Test
|
||||
writeSpec =
|
||||
Spec.describe "write" do
|
||||
Spec.describe "String" do
|
||||
Spec.it "writes the String to the Response body" do
|
||||
describe "write" do
|
||||
describe "String" do
|
||||
it "writes the String to the Response body" do
|
||||
body <- do
|
||||
resp <- EffectClass.liftEffect TestHelpers.mockResponse
|
||||
Body.write "test" resp
|
||||
pure $ TestHelpers.getResponseBody resp
|
||||
resp <- liftEffect mockResponse
|
||||
write "test" resp
|
||||
pure $ getResponseBody resp
|
||||
body ?= "test"
|
||||
Spec.describe "Buffer" do
|
||||
Spec.it "writes the Buffer to the Response body" do
|
||||
describe "Buffer" do
|
||||
it "writes the Buffer to the Response body" do
|
||||
body <- do
|
||||
resp <- EffectClass.liftEffect TestHelpers.mockResponse
|
||||
buf :: Buffer.Buffer <- EffectClass.liftEffect $ Buffer.fromString "test" Encoding.UTF8
|
||||
Body.write buf resp
|
||||
pure $ TestHelpers.getResponseBody resp
|
||||
resp <- liftEffect mockResponse
|
||||
buf :: Buffer <- liftEffect $ fromString "test" UTF8
|
||||
write buf resp
|
||||
pure $ getResponseBody resp
|
||||
body ?= "test"
|
||||
Spec.describe "Readable" do
|
||||
Spec.it "pipes the input stream to the Response body" do
|
||||
describe "Readable" do
|
||||
it "pipes the input stream to the Response body" do
|
||||
body <- do
|
||||
resp <- EffectClass.liftEffect TestHelpers.mockResponse
|
||||
Body.write (TestHelpers.stringToStream "test") resp
|
||||
pure $ TestHelpers.getResponseBody resp
|
||||
resp <- liftEffect mockResponse
|
||||
write (stringToStream "test") resp
|
||||
pure $ getResponseBody resp
|
||||
body ?= "test"
|
||||
|
||||
bodySpec :: TestHelpers.Test
|
||||
bodySpec :: Test
|
||||
bodySpec =
|
||||
Spec.describe "Body" do
|
||||
describe "Body" do
|
||||
defaultHeadersSpec
|
||||
readSpec
|
||||
toStringSpec
|
||||
|
||||
@ -1,139 +1,131 @@
|
||||
module Test.HTTPure.HeadersSpec where
|
||||
|
||||
import Prelude
|
||||
import Effect.Class as EffectClass
|
||||
import Data.Maybe as Maybe
|
||||
import Data.Tuple as Tuple
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Headers as Headers
|
||||
import Effect.Class (liftEffect)
|
||||
import Data.Maybe (Maybe(Nothing, Just))
|
||||
import Data.Tuple (Tuple(Tuple))
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Headers (header, headers, empty, read, write)
|
||||
import HTTPure.Lookup ((!!))
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
|
||||
lookupSpec :: TestHelpers.Test
|
||||
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 Just the string" do
|
||||
Headers.header "x-test" "test" !! "x-test" ?= Maybe.Just "test"
|
||||
Spec.describe "when searching with uppercase" do
|
||||
Spec.it "is Just the string" do
|
||||
Headers.header "x-test" "test" !! "X-Test" ?= Maybe.Just "test"
|
||||
Spec.describe "when the string is uppercase" do
|
||||
Spec.describe "when searching with lowercase" do
|
||||
Spec.it "is Just the string" do
|
||||
Headers.header "X-Test" "test" !! "x-test" ?= Maybe.Just "test"
|
||||
Spec.describe "when searching with uppercase" do
|
||||
Spec.it "is Just the string" do
|
||||
Headers.header "X-Test" "test" !! "X-Test" ?= Maybe.Just "test"
|
||||
Spec.describe "when the string is not in the header set" do
|
||||
Spec.it "is Nothing" do
|
||||
((Headers.empty !! "X-Test") :: Maybe.Maybe String) ?= Maybe.Nothing
|
||||
describe "lookup" do
|
||||
describe "when the string is in the header set" do
|
||||
describe "when searching with lowercase" do
|
||||
it "is Just the string" do
|
||||
header "x-test" "test" !! "x-test" ?= Just "test"
|
||||
describe "when searching with uppercase" do
|
||||
it "is Just the string" do
|
||||
header "x-test" "test" !! "X-Test" ?= Just "test"
|
||||
describe "when the string is uppercase" do
|
||||
describe "when searching with lowercase" do
|
||||
it "is Just the string" do
|
||||
header "X-Test" "test" !! "x-test" ?= Just "test"
|
||||
describe "when searching with uppercase" do
|
||||
it "is Just the string" do
|
||||
header "X-Test" "test" !! "X-Test" ?= Just "test"
|
||||
describe "when the string is not in the header set" do
|
||||
it "is Nothing" do
|
||||
((empty !! "X-Test") :: Maybe String) ?= Nothing
|
||||
|
||||
showSpec :: TestHelpers.Test
|
||||
showSpec =
|
||||
Spec.describe "show" do
|
||||
Spec.it "is a string representing the headers in HTTP format" do
|
||||
let
|
||||
mock = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
|
||||
describe "show" do
|
||||
it "is a string representing the headers in HTTP format" do
|
||||
let mock = header "Test1" "1" <> header "Test2" "2"
|
||||
show mock ?= "Test1: 1\nTest2: 2\n\n"
|
||||
|
||||
eqSpec :: TestHelpers.Test
|
||||
eqSpec =
|
||||
Spec.describe "eq" do
|
||||
Spec.describe "when the two Headers contain the same keys and values" do
|
||||
Spec.it "is true" do
|
||||
Headers.header "Test1" "test1" == Headers.header "Test1" "test1" ?= true
|
||||
Spec.describe "when the two Headers contain different keys and values" do
|
||||
Spec.it "is false" do
|
||||
Headers.header "Test1" "test1" == Headers.header "Test2" "test2" ?= false
|
||||
Spec.describe "when the two Headers contain only different values" do
|
||||
Spec.it "is false" do
|
||||
Headers.header "Test1" "test1" == Headers.header "Test1" "test2" ?= false
|
||||
Spec.describe "when the one Headers contains additional keys and values" do
|
||||
Spec.it "is false" do
|
||||
let
|
||||
mock = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
|
||||
Headers.header "Test1" "1" == mock ?= false
|
||||
describe "eq" do
|
||||
describe "when the two Headers contain the same keys and values" do
|
||||
it "is true" do
|
||||
header "Test1" "test1" == header "Test1" "test1" ?= true
|
||||
describe "when the two Headers contain different keys and values" do
|
||||
it "is false" do
|
||||
header "Test1" "test1" == header "Test2" "test2" ?= false
|
||||
describe "when the two Headers contain only different values" do
|
||||
it "is false" do
|
||||
header "Test1" "test1" == header "Test1" "test2" ?= false
|
||||
describe "when the one Headers contains additional keys and values" do
|
||||
it "is false" do
|
||||
let mock = header "Test1" "1" <> header "Test2" "2"
|
||||
header "Test1" "1" == mock ?= false
|
||||
|
||||
appendSpec :: TestHelpers.Test
|
||||
appendSpec =
|
||||
Spec.describe "append" do
|
||||
Spec.describe "when there are multiple keys" do
|
||||
Spec.it "appends the headers correctly" do
|
||||
let
|
||||
mock1 = Headers.header "Test1" "1" <> Headers.header "Test2" "2"
|
||||
let
|
||||
mock2 = Headers.header "Test3" "3" <> Headers.header "Test4" "4"
|
||||
describe "append" do
|
||||
describe "when there are multiple keys" do
|
||||
it "appends the headers correctly" do
|
||||
let
|
||||
mock1 = header "Test1" "1" <> header "Test2" "2"
|
||||
mock2 = header "Test3" "3" <> header "Test4" "4"
|
||||
mock3 =
|
||||
Headers.headers
|
||||
[ Tuple.Tuple "Test1" "1"
|
||||
, Tuple.Tuple "Test2" "2"
|
||||
, Tuple.Tuple "Test3" "3"
|
||||
, Tuple.Tuple "Test4" "4"
|
||||
headers
|
||||
[ Tuple "Test1" "1"
|
||||
, Tuple "Test2" "2"
|
||||
, Tuple "Test3" "3"
|
||||
, Tuple "Test4" "4"
|
||||
]
|
||||
mock1 <> mock2 ?= mock3
|
||||
Spec.describe "when there is a duplicated key" do
|
||||
Spec.it "uses the last appended value" do
|
||||
let
|
||||
mock = Headers.header "Test" "foo" <> Headers.header "Test" "bar"
|
||||
mock ?= Headers.header "Test" "bar"
|
||||
describe "when there is a duplicated key" do
|
||||
it "uses the last appended value" do
|
||||
let mock = header "Test" "foo" <> header "Test" "bar"
|
||||
mock ?= header "Test" "bar"
|
||||
|
||||
readSpec :: TestHelpers.Test
|
||||
readSpec =
|
||||
Spec.describe "read" do
|
||||
Spec.describe "with no headers" do
|
||||
Spec.it "is an empty Map" do
|
||||
describe "read" do
|
||||
describe "with no headers" do
|
||||
it "is an empty Map" do
|
||||
request <- TestHelpers.mockRequest "" "" "" "" []
|
||||
Headers.read request ?= Headers.empty
|
||||
Spec.describe "with headers" do
|
||||
Spec.it "is a Map with the contents of the headers" do
|
||||
let
|
||||
testHeader = [ Tuple.Tuple "X-Test" "test" ]
|
||||
read request ?= empty
|
||||
describe "with headers" do
|
||||
it "is a Map with the contents of the headers" do
|
||||
let testHeader = [ Tuple "X-Test" "test" ]
|
||||
request <- TestHelpers.mockRequest "" "" "" "" testHeader
|
||||
Headers.read request ?= Headers.headers testHeader
|
||||
read request ?= headers testHeader
|
||||
|
||||
writeSpec :: TestHelpers.Test
|
||||
writeSpec =
|
||||
Spec.describe "write" do
|
||||
Spec.it "writes the headers to the response" do
|
||||
header <- EffectClass.liftEffect do
|
||||
describe "write" do
|
||||
it "writes the headers to the response" do
|
||||
header <- liftEffect do
|
||||
mock <- TestHelpers.mockResponse
|
||||
Headers.write mock $ Headers.header "X-Test" "test"
|
||||
write mock $ header "X-Test" "test"
|
||||
pure $ TestHelpers.getResponseHeader "X-Test" mock
|
||||
header ?= "test"
|
||||
|
||||
emptySpec :: TestHelpers.Test
|
||||
emptySpec =
|
||||
Spec.describe "empty" do
|
||||
Spec.it "is an empty Map in an empty Headers" do
|
||||
show Headers.empty ?= "\n"
|
||||
describe "empty" do
|
||||
it "is an empty Map in an empty Headers" do
|
||||
show empty ?= "\n"
|
||||
|
||||
headerSpec :: TestHelpers.Test
|
||||
headerSpec =
|
||||
Spec.describe "header" do
|
||||
Spec.it "creates a singleton Headers" do
|
||||
show (Headers.header "X-Test" "test") ?= "X-Test: test\n\n"
|
||||
describe "header" do
|
||||
it "creates a singleton Headers" do
|
||||
show (header "X-Test" "test") ?= "X-Test: test\n\n"
|
||||
|
||||
headersFunctionSpec :: TestHelpers.Test
|
||||
headersFunctionSpec =
|
||||
Spec.describe "headers" do
|
||||
Spec.it "is equivalent to using Headers.header with <>" do
|
||||
describe "headers" do
|
||||
it "is equivalent to using header with <>" do
|
||||
let
|
||||
expected = header "X-Test-1" "1" <> header "X-Test-2" "2"
|
||||
test = headers
|
||||
[ Tuple "X-Test-1" "1"
|
||||
, Tuple "X-Test-2" "2"
|
||||
]
|
||||
test ?= expected
|
||||
where
|
||||
test =
|
||||
Headers.headers
|
||||
[ Tuple.Tuple "X-Test-1" "1"
|
||||
, Tuple.Tuple "X-Test-2" "2"
|
||||
]
|
||||
|
||||
expected = Headers.header "X-Test-1" "1" <> Headers.header "X-Test-2" "2"
|
||||
|
||||
headersSpec :: TestHelpers.Test
|
||||
headersSpec =
|
||||
Spec.describe "Headers" do
|
||||
describe "Headers" do
|
||||
lookupSpec
|
||||
showSpec
|
||||
eqSpec
|
||||
|
||||
@ -1,13 +1,21 @@
|
||||
module Test.HTTPure.IntegrationSpec where
|
||||
|
||||
import Prelude
|
||||
import Effect.Class as EffectClass
|
||||
import Foreign.Object as Object
|
||||
import Node.Buffer as Buffer
|
||||
import Node.FS.Aff as FS
|
||||
import Test.Spec as Spec
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Effect.Class (liftEffect)
|
||||
import Foreign.Object (singleton, empty)
|
||||
import Node.Buffer (toArray)
|
||||
import Node.FS.Aff (readFile)
|
||||
import Test.Spec (describe, it)
|
||||
import Test.HTTPure.TestHelpers
|
||||
( Test
|
||||
, (?=)
|
||||
, get
|
||||
, get'
|
||||
, getBinary
|
||||
, getHeader
|
||||
, post
|
||||
, postBinary
|
||||
)
|
||||
import Examples.AsyncResponse.Main as AsyncResponse
|
||||
import Examples.BinaryRequest.Main as BinaryRequest
|
||||
import Examples.BinaryResponse.Main as BinaryResponse
|
||||
@ -22,137 +30,137 @@ import Examples.Post.Main as Post
|
||||
import Examples.QueryParameters.Main as QueryParameters
|
||||
import Examples.SSL.Main as SSL
|
||||
|
||||
asyncResponseSpec :: TestHelpers.Test
|
||||
asyncResponseSpec :: Test
|
||||
asyncResponseSpec =
|
||||
Spec.it "runs the async response example" do
|
||||
close <- EffectClass.liftEffect AsyncResponse.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the async response example" do
|
||||
close <- liftEffect AsyncResponse.main
|
||||
response <- get 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
|
||||
binaryRequestSpec :: TestHelpers.Test
|
||||
binaryRequestSpec :: Test
|
||||
binaryRequestSpec =
|
||||
Spec.it "runs the binary request example" do
|
||||
close <- EffectClass.liftEffect BinaryRequest.main
|
||||
binaryBuf <- FS.readFile BinaryResponse.filePath
|
||||
response <- TestHelpers.postBinary 8080 Object.empty "/" binaryBuf
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the binary request example" do
|
||||
close <- liftEffect BinaryRequest.main
|
||||
binaryBuf <- readFile BinaryResponse.filePath
|
||||
response <- postBinary 8080 empty "/" binaryBuf
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "d5e776724dd545d8b54123b46362a553d10257cee688ef1be62166c984b34405"
|
||||
|
||||
binaryResponseSpec :: TestHelpers.Test
|
||||
binaryResponseSpec :: Test
|
||||
binaryResponseSpec =
|
||||
Spec.it "runs the binary response example" do
|
||||
close <- EffectClass.liftEffect BinaryResponse.main
|
||||
responseBuf <- TestHelpers.getBinary 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
binaryBuf <- FS.readFile BinaryResponse.filePath
|
||||
expected <- EffectClass.liftEffect $ Buffer.toArray binaryBuf
|
||||
response <- EffectClass.liftEffect $ Buffer.toArray responseBuf
|
||||
it "runs the binary response example" do
|
||||
close <- liftEffect BinaryResponse.main
|
||||
responseBuf <- getBinary 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
binaryBuf <- readFile BinaryResponse.filePath
|
||||
expected <- liftEffect $ toArray binaryBuf
|
||||
response <- liftEffect $ toArray responseBuf
|
||||
response ?= expected
|
||||
|
||||
chunkedSpec :: TestHelpers.Test
|
||||
chunkedSpec :: Test
|
||||
chunkedSpec =
|
||||
Spec.it "runs the chunked example" do
|
||||
close <- EffectClass.liftEffect Chunked.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the chunked example" do
|
||||
close <- liftEffect Chunked.main
|
||||
response <- get 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
-- TODO this isn't a great way to validate this, we need a way of inspecting
|
||||
-- each individual chunk instead of just looking at the entire response
|
||||
response ?= "hello \nworld!\n"
|
||||
|
||||
customStackSpec :: TestHelpers.Test
|
||||
customStackSpec :: Test
|
||||
customStackSpec =
|
||||
Spec.it "runs the custom stack example" do
|
||||
close <- EffectClass.liftEffect CustomStack.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the custom stack example" do
|
||||
close <- liftEffect CustomStack.main
|
||||
response <- get 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "hello, joe"
|
||||
|
||||
headersSpec :: TestHelpers.Test
|
||||
headersSpec :: Test
|
||||
headersSpec =
|
||||
Spec.it "runs the headers example" do
|
||||
close <- EffectClass.liftEffect Headers.main
|
||||
header <- TestHelpers.getHeader 8080 Object.empty "/" "X-Example"
|
||||
response <- TestHelpers.get 8080 (Object.singleton "X-Input" "test") "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the headers example" do
|
||||
close <- liftEffect Headers.main
|
||||
header <- getHeader 8080 empty "/" "X-Example"
|
||||
response <- get 8080 (singleton "X-Input" "test") "/"
|
||||
liftEffect $ close $ pure unit
|
||||
header ?= "hello world!"
|
||||
response ?= "test"
|
||||
|
||||
helloWorldSpec :: TestHelpers.Test
|
||||
helloWorldSpec :: Test
|
||||
helloWorldSpec =
|
||||
Spec.it "runs the hello world example" do
|
||||
close <- EffectClass.liftEffect HelloWorld.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the hello world example" do
|
||||
close <- liftEffect HelloWorld.main
|
||||
response <- get 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
|
||||
middlewareSpec :: TestHelpers.Test
|
||||
middlewareSpec :: Test
|
||||
middlewareSpec =
|
||||
Spec.it "runs the middleware example" do
|
||||
close <- EffectClass.liftEffect Middleware.main
|
||||
header <- TestHelpers.getHeader 8080 Object.empty "/" "X-Middleware"
|
||||
body <- TestHelpers.get 8080 Object.empty "/"
|
||||
header' <- TestHelpers.getHeader 8080 Object.empty "/middleware" "X-Middleware"
|
||||
body' <- TestHelpers.get 8080 Object.empty "/middleware"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the middleware example" do
|
||||
close <- liftEffect Middleware.main
|
||||
header <- getHeader 8080 empty "/" "X-Middleware"
|
||||
body <- get 8080 empty "/"
|
||||
header' <- getHeader 8080 empty "/middleware" "X-Middleware"
|
||||
body' <- get 8080 empty "/middleware"
|
||||
liftEffect $ close $ pure unit
|
||||
header ?= "router"
|
||||
body ?= "hello"
|
||||
header' ?= "middleware"
|
||||
body' ?= "Middleware!"
|
||||
|
||||
multiRouteSpec :: TestHelpers.Test
|
||||
multiRouteSpec :: Test
|
||||
multiRouteSpec =
|
||||
Spec.it "runs the multi route example" do
|
||||
close <- EffectClass.liftEffect MultiRoute.main
|
||||
hello <- TestHelpers.get 8080 Object.empty "/hello"
|
||||
goodbye <- TestHelpers.get 8080 Object.empty "/goodbye"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the multi route example" do
|
||||
close <- liftEffect MultiRoute.main
|
||||
hello <- get 8080 empty "/hello"
|
||||
goodbye <- get 8080 empty "/goodbye"
|
||||
liftEffect $ close $ pure unit
|
||||
hello ?= "hello"
|
||||
goodbye ?= "goodbye"
|
||||
|
||||
pathSegmentsSpec :: TestHelpers.Test
|
||||
pathSegmentsSpec :: Test
|
||||
pathSegmentsSpec =
|
||||
Spec.it "runs the path segments example" do
|
||||
close <- EffectClass.liftEffect PathSegments.main
|
||||
foo <- TestHelpers.get 8080 Object.empty "/segment/foo"
|
||||
somebars <- TestHelpers.get 8080 Object.empty "/some/bars"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the path segments example" do
|
||||
close <- liftEffect PathSegments.main
|
||||
foo <- get 8080 empty "/segment/foo"
|
||||
somebars <- get 8080 empty "/some/bars"
|
||||
liftEffect $ close $ pure unit
|
||||
foo ?= "foo"
|
||||
somebars ?= "[\"some\",\"bars\"]"
|
||||
|
||||
postSpec :: TestHelpers.Test
|
||||
postSpec :: Test
|
||||
postSpec =
|
||||
Spec.it "runs the post example" do
|
||||
close <- EffectClass.liftEffect Post.main
|
||||
response <- TestHelpers.post 8080 Object.empty "/" "test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the post example" do
|
||||
close <- liftEffect Post.main
|
||||
response <- post 8080 empty "/" "test"
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "test"
|
||||
|
||||
queryParametersSpec :: TestHelpers.Test
|
||||
queryParametersSpec :: Test
|
||||
queryParametersSpec =
|
||||
Spec.it "runs the query parameters example" do
|
||||
close <- EffectClass.liftEffect QueryParameters.main
|
||||
foo <- TestHelpers.get 8080 Object.empty "/?foo"
|
||||
bar <- TestHelpers.get 8080 Object.empty "/?bar=test"
|
||||
notbar <- TestHelpers.get 8080 Object.empty "/?bar=nottest"
|
||||
baz <- TestHelpers.get 8080 Object.empty "/?baz=test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the query parameters example" do
|
||||
close <- liftEffect QueryParameters.main
|
||||
foo <- get 8080 empty "/?foo"
|
||||
bar <- get 8080 empty "/?bar=test"
|
||||
notbar <- get 8080 empty "/?bar=nottest"
|
||||
baz <- get 8080 empty "/?baz=test"
|
||||
liftEffect $ close $ pure unit
|
||||
foo ?= "foo"
|
||||
bar ?= "bar"
|
||||
notbar ?= ""
|
||||
baz ?= "test"
|
||||
|
||||
sslSpec :: TestHelpers.Test
|
||||
sslSpec :: Test
|
||||
sslSpec =
|
||||
Spec.it "runs the ssl example" do
|
||||
close <- EffectClass.liftEffect SSL.main
|
||||
response <- TestHelpers.get' 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "runs the ssl example" do
|
||||
close <- liftEffect SSL.main
|
||||
response <- get' 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
|
||||
integrationSpec :: TestHelpers.Test
|
||||
integrationSpec :: Test
|
||||
integrationSpec =
|
||||
Spec.describe "Integration" do
|
||||
describe "Integration" do
|
||||
asyncResponseSpec
|
||||
binaryRequestSpec
|
||||
binaryResponseSpec
|
||||
|
||||
@ -1,56 +1,55 @@
|
||||
module Test.HTTPure.LookupSpec where
|
||||
|
||||
import Prelude
|
||||
import Data.Maybe as Maybe
|
||||
import Foreign.Object as Object
|
||||
import Test.Spec as Spec
|
||||
import Data.Maybe (Maybe(Nothing, Just))
|
||||
import Foreign.Object (singleton)
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Lookup ((!!), (!@), (!?))
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Test.HTTPure.TestHelpers (Test, (?=))
|
||||
|
||||
atSpec :: TestHelpers.Test
|
||||
atSpec :: Test
|
||||
atSpec =
|
||||
Spec.describe "at" do
|
||||
Spec.describe "when the lookup returns a Just" do
|
||||
Spec.it "is the value inside the Just" do
|
||||
describe "at" do
|
||||
describe "when the lookup returns a Just" do
|
||||
it "is the value inside the Just" do
|
||||
[ "one", "two", "three" ] !@ 1 ?= "two"
|
||||
Spec.describe "when the lookup returns a Nothing" do
|
||||
Spec.it "is mempty" do
|
||||
describe "when the lookup returns a Nothing" do
|
||||
it "is mempty" do
|
||||
[ "one", "two", "three" ] !@ 4 ?= ""
|
||||
|
||||
hasSpec :: TestHelpers.Test
|
||||
hasSpec :: Test
|
||||
hasSpec =
|
||||
Spec.describe "has" do
|
||||
Spec.describe "when the lookup returns a Just" do
|
||||
Spec.it "is true" do
|
||||
describe "has" do
|
||||
describe "when the lookup returns a Just" do
|
||||
it "is true" do
|
||||
[ "one", "two", "three" ] !? 1 ?= true
|
||||
Spec.describe "when the lookup returns a Nothing" do
|
||||
Spec.it "is false" do
|
||||
describe "when the lookup returns a Nothing" do
|
||||
it "is false" do
|
||||
[ "one", "two", "three" ] !? 4 ?= false
|
||||
|
||||
lookupFunctionSpec :: TestHelpers.Test
|
||||
lookupFunctionSpec :: Test
|
||||
lookupFunctionSpec =
|
||||
Spec.describe "lookup" do
|
||||
Spec.describe "Array" do
|
||||
Spec.describe "when the index is in bounds" do
|
||||
Spec.it "is Just the value at the index" do
|
||||
[ "one", "two", "three" ] !! 1 ?= Maybe.Just "two"
|
||||
Spec.describe "when the index is out of bounds" do
|
||||
Spec.it "is Nothing" do
|
||||
(([ "one", "two", "three" ] !! 4) :: Maybe.Maybe String) ?= Maybe.Nothing
|
||||
Spec.describe "Map" do
|
||||
Spec.describe "when the key is in the Map" do
|
||||
Spec.it "is Just the value at the given key" do
|
||||
mockMap !! "foo" ?= Maybe.Just "bar"
|
||||
Spec.describe "when the key is not in the Map" do
|
||||
Spec.it "is Nothing" do
|
||||
((mockMap !! "baz") :: Maybe.Maybe String) ?= Maybe.Nothing
|
||||
where
|
||||
mockMap = Object.singleton "foo" "bar"
|
||||
describe "lookup" do
|
||||
describe "Array" do
|
||||
describe "when the index is in bounds" do
|
||||
it "is Just the value at the index" do
|
||||
[ "one", "two", "three" ] !! 1 ?= Just "two"
|
||||
describe "when the index is out of bounds" do
|
||||
it "is Nothing" do
|
||||
(([ "one", "two", "three" ] !! 4) :: Maybe String) ?= Nothing
|
||||
describe "Map" do
|
||||
describe "when the key is in the Map" do
|
||||
it "is Just the value at the given key" do
|
||||
let mockMap = singleton "foo" "bar"
|
||||
mockMap !! "foo" ?= Just "bar"
|
||||
describe "when the key is not in the Map" do
|
||||
it "is Nothing" do
|
||||
let mockMap = singleton "foo" "bar"
|
||||
((mockMap !! "baz") :: Maybe String) ?= Nothing
|
||||
|
||||
lookupSpec :: TestHelpers.Test
|
||||
lookupSpec :: Test
|
||||
lookupSpec =
|
||||
Spec.describe "Lookup" do
|
||||
describe "Lookup" do
|
||||
atSpec
|
||||
hasSpec
|
||||
lookupFunctionSpec
|
||||
|
||||
@ -1,52 +1,54 @@
|
||||
module Test.HTTPure.MethodSpec where
|
||||
|
||||
import Prelude
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Method as Method
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Method
|
||||
( Method(Get, Post, Put, Delete, Head, Connect, Options, Trace, Patch)
|
||||
, read
|
||||
)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockRequest)
|
||||
|
||||
showSpec :: TestHelpers.Test
|
||||
showSpec :: 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"
|
||||
describe "show" do
|
||||
describe "with a Get" do
|
||||
it "is 'Get'" do
|
||||
show Get ?= "Get"
|
||||
describe "with a Post" do
|
||||
it "is 'Post'" do
|
||||
show Post ?= "Post"
|
||||
describe "with a Put" do
|
||||
it "is 'Put'" do
|
||||
show Put ?= "Put"
|
||||
describe "with a Delete" do
|
||||
it "is 'Delete'" do
|
||||
show Delete ?= "Delete"
|
||||
describe "with a Head" do
|
||||
it "is 'Head'" do
|
||||
show Head ?= "Head"
|
||||
describe "with a Connect" do
|
||||
it "is 'Connect'" do
|
||||
show Connect ?= "Connect"
|
||||
describe "with a Options" do
|
||||
it "is 'Options'" do
|
||||
show Options ?= "Options"
|
||||
describe "with a Trace" do
|
||||
it "is 'Trace'" do
|
||||
show Trace ?= "Trace"
|
||||
describe "with a Patch" do
|
||||
it "is 'Patch'" do
|
||||
show Patch ?= "Patch"
|
||||
|
||||
readSpec :: TestHelpers.Test
|
||||
readSpec :: Test
|
||||
readSpec =
|
||||
Spec.describe "read" do
|
||||
Spec.describe "with a 'GET' Request" do
|
||||
Spec.it "is Get" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "" "" []
|
||||
Method.read request ?= Method.Get
|
||||
describe "read" do
|
||||
describe "with a 'GET' Request" do
|
||||
it "is Get" do
|
||||
request <- mockRequest "" "GET" "" "" []
|
||||
read request ?= Get
|
||||
|
||||
methodSpec :: TestHelpers.Test
|
||||
methodSpec :: Test
|
||||
methodSpec =
|
||||
Spec.describe "Method" do
|
||||
describe "Method" do
|
||||
showSpec
|
||||
readSpec
|
||||
|
||||
@ -1,39 +1,38 @@
|
||||
module Test.HTTPure.PathSpec where
|
||||
|
||||
import Prelude
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Path as Path
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Path (read)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockRequest)
|
||||
|
||||
readSpec :: TestHelpers.Test
|
||||
readSpec :: Test
|
||||
readSpec =
|
||||
Spec.describe "read" do
|
||||
Spec.describe "with a query string" do
|
||||
Spec.it "is just the path" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "test/path?blabla" "" []
|
||||
Path.read request ?= [ "test", "path" ]
|
||||
Spec.describe "with no query string" do
|
||||
Spec.it "is the path" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "test/path" "" []
|
||||
Path.read request ?= [ "test", "path" ]
|
||||
Spec.describe "with no segments" do
|
||||
Spec.it "is an empty array" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "" "" []
|
||||
Path.read request ?= []
|
||||
Spec.describe "with empty segments" do
|
||||
Spec.it "strips the empty segments" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "//test//path///?query" "" []
|
||||
Path.read request ?= [ "test", "path" ]
|
||||
Spec.describe "with percent encoded segments" do
|
||||
Spec.it "decodes percent encoding" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "/test%20path/%2Fthis" "" []
|
||||
Path.read request ?= [ "test path", "/this" ]
|
||||
Spec.it "does not decode a plus sign" do
|
||||
request <- TestHelpers.mockRequest "" "GET" "/test+path/this" "" []
|
||||
Path.read request ?= [ "test+path", "this" ]
|
||||
describe "read" do
|
||||
describe "with a query string" do
|
||||
it "is just the path" do
|
||||
request <- mockRequest "" "GET" "test/path?blabla" "" []
|
||||
read request ?= [ "test", "path" ]
|
||||
describe "with no query string" do
|
||||
it "is the path" do
|
||||
request <- mockRequest "" "GET" "test/path" "" []
|
||||
read request ?= [ "test", "path" ]
|
||||
describe "with no segments" do
|
||||
it "is an empty array" do
|
||||
request <- mockRequest "" "GET" "" "" []
|
||||
read request ?= []
|
||||
describe "with empty segments" do
|
||||
it "strips the empty segments" do
|
||||
request <- mockRequest "" "GET" "//test//path///?query" "" []
|
||||
read request ?= [ "test", "path" ]
|
||||
describe "with percent encoded segments" do
|
||||
it "decodes percent encoding" do
|
||||
request <- mockRequest "" "GET" "/test%20path/%2Fthis" "" []
|
||||
read request ?= [ "test path", "/this" ]
|
||||
it "does not decode a plus sign" do
|
||||
request <- mockRequest "" "GET" "/test+path/this" "" []
|
||||
read request ?= [ "test+path", "this" ]
|
||||
|
||||
pathSpec :: TestHelpers.Test
|
||||
pathSpec :: Test
|
||||
pathSpec =
|
||||
Spec.describe "Path" do
|
||||
describe "Path" do
|
||||
readSpec
|
||||
|
||||
@ -1,64 +1,63 @@
|
||||
module Test.HTTPure.QuerySpec where
|
||||
|
||||
import Prelude
|
||||
import Data.Tuple as Tuple
|
||||
import Foreign.Object as Object
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Query as Query
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Data.Tuple (Tuple(Tuple))
|
||||
import Foreign.Object (empty, singleton, fromFoldable)
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Query (read)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockRequest)
|
||||
|
||||
readSpec :: TestHelpers.Test
|
||||
readSpec :: Test
|
||||
readSpec =
|
||||
Spec.describe "read" do
|
||||
Spec.describe "with no query string" do
|
||||
Spec.it "is an empty Map" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test" "" []
|
||||
Query.read req ?= Object.empty
|
||||
Spec.describe "with an empty query string" do
|
||||
Spec.it "is an empty Map" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?" "" []
|
||||
Query.read req ?= Object.empty
|
||||
Spec.describe "with a query parameter in the query string" do
|
||||
Spec.it "is a correct Map" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?a=b" "" []
|
||||
Query.read req ?= Object.singleton "a" "b"
|
||||
Spec.describe "with empty fields in the query string" do
|
||||
Spec.it "ignores the empty fields" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?&&a=b&&" "" []
|
||||
Query.read req ?= Object.singleton "a" "b"
|
||||
Spec.describe "with duplicated params" do
|
||||
Spec.it "takes the last param value" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?a=b&a=c" "" []
|
||||
Query.read req ?= Object.singleton "a" "c"
|
||||
Spec.describe "with empty params" do
|
||||
Spec.it "uses '' as the value" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?a" "" []
|
||||
Query.read req ?= Object.singleton "a" ""
|
||||
Spec.describe "with complex params" do
|
||||
Spec.it "is the correct Map" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" []
|
||||
Query.read req ?= expectedComplexResult
|
||||
Spec.describe "with urlencoded params" do
|
||||
Spec.it "decodes valid keys and values" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?foo%20bar=%3Fx%3Dtest" "" []
|
||||
Query.read req ?= Object.singleton "foo bar" "?x=test"
|
||||
Spec.it "passes invalid keys and values through" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?%%=%C3" "" []
|
||||
Query.read req ?= Object.singleton "%%" "%C3"
|
||||
Spec.it "converts + to a space" do
|
||||
req <- TestHelpers.mockRequest "" "" "/test?foo=bar+baz" "" []
|
||||
Query.read req ?= Object.singleton "foo" "bar baz"
|
||||
where
|
||||
expectedComplexResult =
|
||||
Object.fromFoldable
|
||||
[ Tuple.Tuple "a" ""
|
||||
, Tuple.Tuple "b" "d"
|
||||
, Tuple.Tuple "e" "f"
|
||||
, Tuple.Tuple "g" ""
|
||||
]
|
||||
describe "read" do
|
||||
describe "with no query string" do
|
||||
it "is an empty Map" do
|
||||
req <- mockRequest "" "" "/test" "" []
|
||||
read req ?= empty
|
||||
describe "with an empty query string" do
|
||||
it "is an empty Map" do
|
||||
req <- mockRequest "" "" "/test?" "" []
|
||||
read req ?= empty
|
||||
describe "with a query parameter in the query string" do
|
||||
it "is a correct Map" do
|
||||
req <- mockRequest "" "" "/test?a=b" "" []
|
||||
read req ?= singleton "a" "b"
|
||||
describe "with empty fields in the query string" do
|
||||
it "ignores the empty fields" do
|
||||
req <- mockRequest "" "" "/test?&&a=b&&" "" []
|
||||
read req ?= singleton "a" "b"
|
||||
describe "with duplicated params" do
|
||||
it "takes the last param value" do
|
||||
req <- mockRequest "" "" "/test?a=b&a=c" "" []
|
||||
read req ?= singleton "a" "c"
|
||||
describe "with empty params" do
|
||||
it "uses '' as the value" do
|
||||
req <- mockRequest "" "" "/test?a" "" []
|
||||
read req ?= singleton "a" ""
|
||||
describe "with complex params" do
|
||||
it "is the correct Map" do
|
||||
req <- mockRequest "" "" "/test?&&a&b=c&b=d&&&e=f&g=&" "" []
|
||||
let
|
||||
expectedComplexResult =
|
||||
fromFoldable
|
||||
[ Tuple "a" ""
|
||||
, Tuple "b" "d"
|
||||
, Tuple "e" "f"
|
||||
, Tuple "g" ""
|
||||
]
|
||||
read req ?= expectedComplexResult
|
||||
describe "with urlencoded params" do
|
||||
it "decodes valid keys and values" do
|
||||
req <- mockRequest "" "" "/test?foo%20bar=%3Fx%3Dtest" "" []
|
||||
read req ?= singleton "foo bar" "?x=test"
|
||||
it "passes invalid keys and values through" do
|
||||
req <- mockRequest "" "" "/test?%%=%C3" "" []
|
||||
read req ?= singleton "%%" "%C3"
|
||||
it "converts + to a space" do
|
||||
req <- mockRequest "" "" "/test?foo=bar+baz" "" []
|
||||
read req ?= singleton "foo" "bar baz"
|
||||
|
||||
querySpec :: TestHelpers.Test
|
||||
querySpec :: Test
|
||||
querySpec =
|
||||
Spec.describe "Query" do
|
||||
describe "Query" do
|
||||
readSpec
|
||||
|
||||
@ -1,83 +1,82 @@
|
||||
module Test.HTTPure.RequestSpec where
|
||||
|
||||
import Prelude
|
||||
import Data.Tuple as Tuple
|
||||
import Foreign.Object as Object
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Body as Body
|
||||
import HTTPure.Headers as Headers
|
||||
import HTTPure.Method as Method
|
||||
import HTTPure.Request as Request
|
||||
import HTTPure.Version as Version
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Data.Tuple (Tuple(Tuple))
|
||||
import Foreign.Object (singleton)
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Body (toString)
|
||||
import HTTPure.Headers (headers)
|
||||
import HTTPure.Method (Method(Post))
|
||||
import HTTPure.Request (fromHTTPRequest, fullPath)
|
||||
import HTTPure.Version (Version(HTTP1_1))
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockRequest)
|
||||
|
||||
fromHTTPRequestSpec :: TestHelpers.Test
|
||||
fromHTTPRequestSpec :: Test
|
||||
fromHTTPRequestSpec =
|
||||
Spec.describe "fromHTTPRequest" do
|
||||
Spec.it "contains the correct method" do
|
||||
mock <- mockRequest
|
||||
mock.method ?= Method.Post
|
||||
Spec.it "contains the correct path" do
|
||||
mock <- mockRequest
|
||||
describe "fromHTTPRequest" do
|
||||
it "contains the correct method" do
|
||||
mock <- mockRequest'
|
||||
mock.method ?= Post
|
||||
it "contains the correct path" do
|
||||
mock <- mockRequest'
|
||||
mock.path ?= [ "test" ]
|
||||
Spec.it "contains the correct query" do
|
||||
mock <- mockRequest
|
||||
mock.query ?= Object.singleton "a" "b"
|
||||
Spec.it "contains the correct headers" do
|
||||
mock <- mockRequest
|
||||
mock.headers ?= Headers.headers mockHeaders
|
||||
Spec.it "contains the correct body" do
|
||||
mockBody <- mockRequest >>= _.body >>> Body.toString
|
||||
it "contains the correct query" do
|
||||
mock <- mockRequest'
|
||||
mock.query ?= singleton "a" "b"
|
||||
it "contains the correct headers" do
|
||||
mock <- mockRequest'
|
||||
mock.headers ?= headers mockHeaders
|
||||
it "contains the correct body" do
|
||||
mockBody <- mockRequest' >>= _.body >>> toString
|
||||
mockBody ?= "body"
|
||||
Spec.it "contains the correct httpVersion" do
|
||||
mock <- mockRequest
|
||||
mock.httpVersion ?= Version.HTTP1_1
|
||||
it "contains the correct httpVersion" do
|
||||
mock <- mockRequest'
|
||||
mock.httpVersion ?= HTTP1_1
|
||||
where
|
||||
mockHeaders = [ Tuple.Tuple "Test" "test" ]
|
||||
mockHeaders = [ Tuple "Test" "test" ]
|
||||
|
||||
mockHTTPRequest = TestHelpers.mockRequest "1.1" "POST" "/test?a=b" "body" mockHeaders
|
||||
mockHTTPRequest = mockRequest "1.1" "POST" "/test?a=b" "body" mockHeaders
|
||||
|
||||
mockRequest = mockHTTPRequest >>= Request.fromHTTPRequest
|
||||
mockRequest' = mockHTTPRequest >>= fromHTTPRequest
|
||||
|
||||
fullPathSpec :: TestHelpers.Test
|
||||
fullPathSpec :: Test
|
||||
fullPathSpec =
|
||||
Spec.describe "fullPath" do
|
||||
Spec.describe "without query parameters" do
|
||||
Spec.it "is correct" do
|
||||
mock <- mockRequest "/foo/bar"
|
||||
Request.fullPath mock ?= "/foo/bar"
|
||||
Spec.describe "with empty path segments" do
|
||||
Spec.it "strips the empty segments" do
|
||||
mock <- mockRequest "//foo////bar/"
|
||||
Request.fullPath mock ?= "/foo/bar"
|
||||
Spec.describe "with only query parameters" do
|
||||
Spec.it "is correct" do
|
||||
mock <- mockRequest "?a=b&c=d"
|
||||
Request.fullPath mock ?= "/?a=b&c=d"
|
||||
Spec.describe "with only empty query parameters" do
|
||||
Spec.it "is has the default value of '' for the empty parameters" do
|
||||
mock <- mockRequest "?a"
|
||||
Request.fullPath mock ?= "/?a="
|
||||
Spec.describe "with query parameters that have special characters" do
|
||||
Spec.it "percent encodes query params" do
|
||||
mock <- mockRequest "?a=%3Fx%3Dtest"
|
||||
Request.fullPath mock ?= "/?a=%3Fx%3Dtest"
|
||||
Spec.describe "with empty query parameters" do
|
||||
Spec.it "strips out the empty arameters" do
|
||||
mock <- mockRequest "?a=b&&&"
|
||||
Request.fullPath mock ?= "/?a=b"
|
||||
Spec.describe "with a mix of segments and query parameters" do
|
||||
Spec.it "is correct" do
|
||||
mock <- mockRequest "/foo///bar/?&a=b&&c"
|
||||
Request.fullPath mock ?= "/foo/bar?a=b&c="
|
||||
describe "fullPath" do
|
||||
describe "without query parameters" do
|
||||
it "is correct" do
|
||||
mock <- mockRequest' "/foo/bar"
|
||||
fullPath mock ?= "/foo/bar"
|
||||
describe "with empty path segments" do
|
||||
it "strips the empty segments" do
|
||||
mock <- mockRequest' "//foo////bar/"
|
||||
fullPath mock ?= "/foo/bar"
|
||||
describe "with only query parameters" do
|
||||
it "is correct" do
|
||||
mock <- mockRequest' "?a=b&c=d"
|
||||
fullPath mock ?= "/?a=b&c=d"
|
||||
describe "with only empty query parameters" do
|
||||
it "is has the default value of '' for the empty parameters" do
|
||||
mock <- mockRequest' "?a"
|
||||
fullPath mock ?= "/?a="
|
||||
describe "with query parameters that have special characters" do
|
||||
it "percent encodes query params" do
|
||||
mock <- mockRequest' "?a=%3Fx%3Dtest"
|
||||
fullPath mock ?= "/?a=%3Fx%3Dtest"
|
||||
describe "with empty query parameters" do
|
||||
it "strips out the empty arameters" do
|
||||
mock <- mockRequest' "?a=b&&&"
|
||||
fullPath mock ?= "/?a=b"
|
||||
describe "with a mix of segments and query parameters" do
|
||||
it "is correct" do
|
||||
mock <- mockRequest' "/foo///bar/?&a=b&&c"
|
||||
fullPath mock ?= "/foo/bar?a=b&c="
|
||||
where
|
||||
mockHTTPRequest path = TestHelpers.mockRequest "" "POST" path "body" []
|
||||
mockHTTPRequest path = mockRequest "" "POST" path "body" []
|
||||
|
||||
mockRequest path = mockHTTPRequest path >>= Request.fromHTTPRequest
|
||||
mockRequest' path = mockHTTPRequest path >>= fromHTTPRequest
|
||||
|
||||
requestSpec :: TestHelpers.Test
|
||||
requestSpec :: Test
|
||||
requestSpec =
|
||||
Spec.describe "Request" do
|
||||
describe "Request" do
|
||||
fromHTTPRequestSpec
|
||||
fullPathSpec
|
||||
|
||||
@ -1,141 +1,138 @@
|
||||
module Test.HTTPure.ResponseSpec where
|
||||
|
||||
import Prelude
|
||||
import Data.Either as Either
|
||||
import Effect.Aff as Aff
|
||||
import Effect.Class as EffectClass
|
||||
import Node.Encoding as Encoding
|
||||
import Node.HTTP as HTTP
|
||||
import Node.Stream as Stream
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Body as Body
|
||||
import HTTPure.Headers as Headers
|
||||
import HTTPure.Response as Response
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Data.Either (Either(Right))
|
||||
import Effect.Aff (makeAff, nonCanceler)
|
||||
import Effect.Class (liftEffect)
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.HTTP (responseAsStream)
|
||||
import Node.Stream (writeString, end)
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Body (defaultHeaders)
|
||||
import HTTPure.Headers (header)
|
||||
import HTTPure.Response (send, response, response', emptyResponse, emptyResponse')
|
||||
import Test.HTTPure.TestHelpers
|
||||
( Test
|
||||
, (?=)
|
||||
, mockResponse
|
||||
, getResponseHeader
|
||||
, getResponseStatus
|
||||
, getResponseBody
|
||||
)
|
||||
|
||||
sendSpec :: TestHelpers.Test
|
||||
sendSpec :: Test
|
||||
sendSpec =
|
||||
Spec.describe "send" do
|
||||
Spec.it "writes the headers" do
|
||||
describe "send" do
|
||||
let
|
||||
mockResponse' =
|
||||
{ status: 123
|
||||
, headers: header "Test" "test"
|
||||
, writeBody:
|
||||
\response -> makeAff \done -> do
|
||||
stream <- pure $ responseAsStream response
|
||||
void $ writeString stream UTF8 "test" $ end stream $ done $ Right unit
|
||||
pure nonCanceler
|
||||
}
|
||||
it "writes the headers" do
|
||||
header <- do
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
Response.send httpResponse $ mockResponse unit
|
||||
pure $ TestHelpers.getResponseHeader "Test" httpResponse
|
||||
httpResponse <- liftEffect mockResponse
|
||||
send httpResponse mockResponse'
|
||||
pure $ getResponseHeader "Test" httpResponse
|
||||
header ?= "test"
|
||||
Spec.it "writes the status" do
|
||||
it "writes the status" do
|
||||
status <- do
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
Response.send httpResponse $ mockResponse unit
|
||||
pure $ TestHelpers.getResponseStatus httpResponse
|
||||
httpResponse <- liftEffect mockResponse
|
||||
send httpResponse mockResponse'
|
||||
pure $ getResponseStatus httpResponse
|
||||
status ?= 123
|
||||
Spec.it "writes the body" do
|
||||
it "writes the body" do
|
||||
body <- do
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
Response.send httpResponse $ mockResponse unit
|
||||
pure $ TestHelpers.getResponseBody httpResponse
|
||||
httpResponse <- liftEffect mockResponse
|
||||
send httpResponse mockResponse'
|
||||
pure $ getResponseBody httpResponse
|
||||
body ?= "test"
|
||||
where
|
||||
mockHeaders = Headers.header "Test" "test"
|
||||
|
||||
mockResponse _ =
|
||||
{ status: 123
|
||||
, headers: mockHeaders
|
||||
, writeBody:
|
||||
\response ->
|
||||
Aff.makeAff \done -> do
|
||||
stream <- pure $ HTTP.responseAsStream response
|
||||
void
|
||||
$ Stream.writeString stream Encoding.UTF8 "test"
|
||||
$ Stream.end stream
|
||||
$ done
|
||||
$ Either.Right unit
|
||||
pure Aff.nonCanceler
|
||||
}
|
||||
|
||||
responseFunctionSpec :: TestHelpers.Test
|
||||
responseFunctionSpec :: Test
|
||||
responseFunctionSpec =
|
||||
Spec.describe "response" do
|
||||
Spec.it "has the right status" do
|
||||
resp <- Response.response 123 "test"
|
||||
describe "response" do
|
||||
it "has the right status" do
|
||||
resp <- response 123 "test"
|
||||
resp.status ?= 123
|
||||
Spec.it "has only default headers" do
|
||||
resp <- Response.response 123 "test"
|
||||
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders "test"
|
||||
resp.headers ?= defaultHeaders
|
||||
Spec.it "has the right writeBody function" do
|
||||
it "has only default headers" do
|
||||
resp <- response 123 "test"
|
||||
defaultHeaders' <- liftEffect $ defaultHeaders "test"
|
||||
resp.headers ?= defaultHeaders'
|
||||
it "has the right writeBody function" do
|
||||
body <- do
|
||||
resp <- Response.response 123 "test"
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
resp <- response 123 "test"
|
||||
httpResponse <- liftEffect $ mockResponse
|
||||
resp.writeBody httpResponse
|
||||
pure $ TestHelpers.getResponseBody httpResponse
|
||||
pure $ getResponseBody httpResponse
|
||||
body ?= "test"
|
||||
|
||||
response'Spec :: TestHelpers.Test
|
||||
response'Spec :: Test
|
||||
response'Spec =
|
||||
Spec.describe "response'" do
|
||||
Spec.it "has the right status" do
|
||||
resp <- mockResponse
|
||||
describe "response'" do
|
||||
let
|
||||
mockHeaders = header "Test" "test"
|
||||
mockResponse' = response' 123 mockHeaders "test"
|
||||
it "has the right status" do
|
||||
resp <- mockResponse'
|
||||
resp.status ?= 123
|
||||
Spec.it "has the right headers" do
|
||||
resp <- mockResponse
|
||||
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders "test"
|
||||
resp.headers ?= defaultHeaders <> mockHeaders
|
||||
Spec.it "has the right writeBody function" do
|
||||
it "has the right headers" do
|
||||
resp <- mockResponse'
|
||||
defaultHeaders' <- liftEffect $ defaultHeaders "test"
|
||||
resp.headers ?= defaultHeaders' <> mockHeaders
|
||||
it "has the right writeBody function" do
|
||||
body <- do
|
||||
resp <- mockResponse
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
resp <- mockResponse'
|
||||
httpResponse <- liftEffect mockResponse
|
||||
resp.writeBody httpResponse
|
||||
pure $ TestHelpers.getResponseBody httpResponse
|
||||
pure $ getResponseBody httpResponse
|
||||
body ?= "test"
|
||||
where
|
||||
mockHeaders = Headers.header "Test" "test"
|
||||
|
||||
mockResponse = Response.response' 123 mockHeaders "test"
|
||||
|
||||
emptyResponseSpec :: TestHelpers.Test
|
||||
emptyResponseSpec :: Test
|
||||
emptyResponseSpec =
|
||||
Spec.describe "emptyResponse" do
|
||||
Spec.it "has the right status" do
|
||||
resp <- Response.emptyResponse 123
|
||||
describe "emptyResponse" do
|
||||
it "has the right status" do
|
||||
resp <- emptyResponse 123
|
||||
resp.status ?= 123
|
||||
Spec.it "has only default headers" do
|
||||
resp <- Response.emptyResponse 123
|
||||
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders ""
|
||||
resp.headers ?= defaultHeaders
|
||||
Spec.it "has the right writeBody function" do
|
||||
it "has only default headers" do
|
||||
resp <- emptyResponse 123
|
||||
defaultHeaders' <- liftEffect $ defaultHeaders ""
|
||||
resp.headers ?= defaultHeaders'
|
||||
it "has the right writeBody function" do
|
||||
body <- do
|
||||
resp <- Response.emptyResponse 123
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
resp <- emptyResponse 123
|
||||
httpResponse <- liftEffect $ mockResponse
|
||||
resp.writeBody httpResponse
|
||||
pure $ TestHelpers.getResponseBody httpResponse
|
||||
pure $ getResponseBody httpResponse
|
||||
body ?= ""
|
||||
|
||||
emptyResponse'Spec :: TestHelpers.Test
|
||||
emptyResponse'Spec :: Test
|
||||
emptyResponse'Spec =
|
||||
Spec.describe "emptyResponse'" do
|
||||
Spec.it "has the right status" do
|
||||
resp <- mockResponse
|
||||
describe "emptyResponse'" do
|
||||
let
|
||||
mockHeaders = header "Test" "test"
|
||||
mockResponse' = emptyResponse' 123 mockHeaders
|
||||
it "has the right status" do
|
||||
resp <- mockResponse'
|
||||
resp.status ?= 123
|
||||
Spec.it "has the right headers" do
|
||||
resp <- mockResponse
|
||||
defaultHeaders <- EffectClass.liftEffect $ Body.defaultHeaders ""
|
||||
resp.headers ?= mockHeaders <> defaultHeaders
|
||||
Spec.it "has the right writeBody function" do
|
||||
it "has the right headers" do
|
||||
resp <- mockResponse'
|
||||
defaultHeaders' <- liftEffect $ defaultHeaders ""
|
||||
resp.headers ?= mockHeaders <> defaultHeaders'
|
||||
it "has the right writeBody function" do
|
||||
body <- do
|
||||
resp <- mockResponse
|
||||
httpResponse <- EffectClass.liftEffect $ TestHelpers.mockResponse
|
||||
resp <- mockResponse'
|
||||
httpResponse <- liftEffect mockResponse
|
||||
resp.writeBody httpResponse
|
||||
pure $ TestHelpers.getResponseBody httpResponse
|
||||
pure $ getResponseBody httpResponse
|
||||
body ?= ""
|
||||
where
|
||||
mockHeaders = Headers.header "Test" "test"
|
||||
|
||||
mockResponse = Response.emptyResponse' 123 mockHeaders
|
||||
|
||||
responseSpec :: TestHelpers.Test
|
||||
responseSpec :: Test
|
||||
responseSpec =
|
||||
Spec.describe "Response" do
|
||||
describe "Response" do
|
||||
sendSpec
|
||||
responseFunctionSpec
|
||||
response'Spec
|
||||
|
||||
@ -1,106 +1,95 @@
|
||||
module Test.HTTPure.ServerSpec where
|
||||
|
||||
import Prelude
|
||||
import Effect.Class as EffectClass
|
||||
import Effect.Exception as Exception
|
||||
import Control.Monad.Except as Except
|
||||
import Data.Maybe as Maybe
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Exception (error)
|
||||
import Control.Monad.Except (throwError)
|
||||
import Data.Maybe (Maybe(Nothing))
|
||||
import Data.Options ((:=))
|
||||
import Data.String as String
|
||||
import Foreign.Object as Object
|
||||
import Node.Encoding as Encoding
|
||||
import Node.HTTP.Secure as HTTPS
|
||||
import Node.FS.Sync as FSSync
|
||||
import Test.Spec as Spec
|
||||
import Test.Spec.Assertions as Assertions
|
||||
import HTTPure.Request as Request
|
||||
import HTTPure.Response as Response
|
||||
import HTTPure.Server as Server
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Data.String (joinWith)
|
||||
import Foreign.Object (empty)
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.HTTP.Secure (key, keyString, cert, certString)
|
||||
import Node.FS.Sync (readTextFile)
|
||||
import Test.Spec (describe, it)
|
||||
import Test.Spec.Assertions (expectError)
|
||||
import HTTPure.Request (Request)
|
||||
import HTTPure.Response (ResponseM, ok)
|
||||
import HTTPure.Server (serve, serve', serveSecure, serveSecure')
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), get, get', getStatus)
|
||||
|
||||
mockRouter :: Request.Request -> Response.ResponseM
|
||||
mockRouter { path } = Response.ok $ "/" <> String.joinWith "/" path
|
||||
mockRouter :: Request -> ResponseM
|
||||
mockRouter { path } = ok $ "/" <> joinWith "/" path
|
||||
|
||||
errorRouter :: Request.Request -> Response.ResponseM
|
||||
errorRouter _ = Except.throwError $ Exception.error "fail!"
|
||||
|
||||
serveSpec :: TestHelpers.Test
|
||||
serveSpec :: Test
|
||||
serveSpec =
|
||||
Spec.describe "serve" do
|
||||
Spec.it "boots a server on the given port" do
|
||||
close <- EffectClass.liftEffect $ Server.serve 8080 mockRouter $ pure unit
|
||||
out <- TestHelpers.get 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
describe "serve" do
|
||||
it "boots a server on the given port" do
|
||||
close <- liftEffect $ serve 8080 mockRouter $ pure unit
|
||||
out <- get 8080 empty "/test"
|
||||
liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
Spec.it "responds with a 500 upon unhandled exceptions" do
|
||||
close <- EffectClass.liftEffect $ Server.serve 8080 errorRouter $ pure unit
|
||||
status <- TestHelpers.getStatus 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
it "responds with a 500 upon unhandled exceptions" do
|
||||
let router _ = throwError $ error "fail!"
|
||||
close <- liftEffect $ serve 8080 router $ pure unit
|
||||
status <- getStatus 8080 empty "/"
|
||||
liftEffect $ close $ pure unit
|
||||
status ?= 500
|
||||
|
||||
serve'Spec :: TestHelpers.Test
|
||||
serve'Spec :: Test
|
||||
serve'Spec =
|
||||
Spec.describe "serve'" do
|
||||
Spec.it "boots a server with the given options" do
|
||||
describe "serve'" do
|
||||
it "boots a server with the given options" do
|
||||
let options = { hostname: "localhost", port: 8080, backlog: Nothing }
|
||||
close <-
|
||||
EffectClass.liftEffect
|
||||
$ Server.serve' options mockRouter
|
||||
liftEffect
|
||||
$ serve' options mockRouter
|
||||
$ pure unit
|
||||
out <- TestHelpers.get 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out <- get 8080 empty "/test"
|
||||
liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
where
|
||||
options = { hostname: "localhost", port: 8080, backlog: Maybe.Nothing }
|
||||
|
||||
serveSecureSpec :: TestHelpers.Test
|
||||
serveSecureSpec :: Test
|
||||
serveSecureSpec =
|
||||
Spec.describe "serveSecure" do
|
||||
Spec.describe "with valid key and cert files" do
|
||||
Spec.it "boots a server on the given port" do
|
||||
describe "serveSecure" do
|
||||
describe "with valid key and cert files" do
|
||||
it "boots a server on the given port" do
|
||||
close <-
|
||||
EffectClass.liftEffect
|
||||
$ Server.serveSecure 8080 cert key mockRouter
|
||||
liftEffect
|
||||
$ serveSecure 8080 "./test/Mocks/Certificate.cer" "./test/Mocks/Key.key" mockRouter
|
||||
$ pure unit
|
||||
out <- TestHelpers.get' 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out <- get' 8080 empty "/test"
|
||||
liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
Spec.describe "with invalid key and cert files" do
|
||||
Spec.it "throws" do
|
||||
Assertions.expectError $ EffectClass.liftEffect
|
||||
$ Server.serveSecure 8080 "" "" mockRouter
|
||||
describe "with invalid key and cert files" do
|
||||
it "throws" do
|
||||
expectError $ liftEffect
|
||||
$ serveSecure 8080 "" "" mockRouter
|
||||
$ pure unit
|
||||
where
|
||||
cert = "./test/Mocks/Certificate.cer"
|
||||
|
||||
key = "./test/Mocks/Key.key"
|
||||
|
||||
serveSecure'Spec :: TestHelpers.Test
|
||||
serveSecure'Spec :: Test
|
||||
serveSecure'Spec =
|
||||
Spec.describe "serveSecure'" do
|
||||
Spec.describe "with valid key and cert files" do
|
||||
Spec.it "boots a server on the given port" do
|
||||
sslOpts <- EffectClass.liftEffect $ sslOptions
|
||||
describe "serveSecure'" do
|
||||
describe "with valid key and cert files" do
|
||||
it "boots a server on the given port" do
|
||||
let
|
||||
options = { hostname: "localhost", port: 8080, backlog: Nothing }
|
||||
sslOptions = do
|
||||
cert' <- readTextFile UTF8 "./test/Mocks/Certificate.cer"
|
||||
key' <- readTextFile UTF8 "./test/Mocks/Key.key"
|
||||
pure $ key := keyString key' <> cert := certString cert'
|
||||
sslOpts <- liftEffect $ sslOptions
|
||||
close <-
|
||||
EffectClass.liftEffect
|
||||
$ Server.serveSecure' sslOpts (options 8080) mockRouter
|
||||
liftEffect
|
||||
$ serveSecure' sslOpts options mockRouter
|
||||
$ pure unit
|
||||
out <- TestHelpers.get' 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out <- get' 8080 empty "/test"
|
||||
liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
where
|
||||
options port = { hostname: "localhost", port, backlog: Maybe.Nothing }
|
||||
|
||||
sslOptions = do
|
||||
cert <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Certificate.cer"
|
||||
key <- FSSync.readTextFile Encoding.UTF8 "./test/Mocks/Key.key"
|
||||
pure $
|
||||
HTTPS.key := HTTPS.keyString key
|
||||
<> HTTPS.cert := HTTPS.certString cert
|
||||
|
||||
serverSpec :: TestHelpers.Test
|
||||
serverSpec :: Test
|
||||
serverSpec =
|
||||
Spec.describe "Server" do
|
||||
describe "Server" do
|
||||
serveSpec
|
||||
serve'Spec
|
||||
serveSecureSpec
|
||||
|
||||
@ -1,24 +1,23 @@
|
||||
module Test.HTTPure.StatusSpec where
|
||||
|
||||
import Prelude
|
||||
import Effect.Class as EffectClass
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Status as Status
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Effect.Class (liftEffect)
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Status (write)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockResponse, getResponseStatus)
|
||||
|
||||
writeSpec :: TestHelpers.Test
|
||||
writeSpec :: Test
|
||||
writeSpec =
|
||||
Spec.describe "write" do
|
||||
Spec.it "writes the given status code" do
|
||||
describe "write" do
|
||||
it "writes the given status code" do
|
||||
status <-
|
||||
EffectClass.liftEffect do
|
||||
mock <- TestHelpers.mockResponse
|
||||
Status.write mock 123
|
||||
pure $ TestHelpers.getResponseStatus mock
|
||||
liftEffect do
|
||||
mock <- mockResponse
|
||||
write mock 123
|
||||
pure $ getResponseStatus mock
|
||||
status ?= 123
|
||||
|
||||
statusSpec :: TestHelpers.Test
|
||||
statusSpec :: Test
|
||||
statusSpec =
|
||||
Spec.describe "Status" do
|
||||
describe "Status" do
|
||||
writeSpec
|
||||
|
||||
@ -1,36 +1,51 @@
|
||||
module Test.HTTPure.TestHelpers where
|
||||
|
||||
import Prelude
|
||||
import Effect as Effect
|
||||
import Effect.Aff as Aff
|
||||
import Effect.Class as EffectClass
|
||||
import Effect.Ref as Ref
|
||||
import Data.Array as Array
|
||||
import Data.Either as Either
|
||||
import Data.List as List
|
||||
import Data.Maybe as Maybe
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, makeAff, nonCanceler)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Ref (new, modify_, read)
|
||||
import Data.Array (fromFoldable) as Array
|
||||
import Data.Either (Either(Right))
|
||||
import Data.List (List(Nil, Cons), reverse)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Options ((:=))
|
||||
import Data.String as StringUtil
|
||||
import Data.Tuple as Tuple
|
||||
import Foreign.Object as Object
|
||||
import Node.Buffer as Buffer
|
||||
import Node.Encoding as Encoding
|
||||
import Node.HTTP as HTTP
|
||||
import Node.HTTP.Client as HTTPClient
|
||||
import Node.Stream as Stream
|
||||
import Test.Spec as Spec
|
||||
import Test.Spec.Assertions as Assertions
|
||||
import Unsafe.Coerce as Coerce
|
||||
import Data.String (toLower)
|
||||
import Data.Tuple (Tuple)
|
||||
import Foreign.Object (fromFoldable) as Object
|
||||
import Foreign.Object (Object, lookup)
|
||||
import Node.Buffer (toString) as Buffer
|
||||
import Node.Buffer (Buffer, create, fromString, concat)
|
||||
import Node.Encoding (Encoding(UTF8))
|
||||
import Node.HTTP (Response) as HTTP
|
||||
import Node.HTTP (Request)
|
||||
import Node.HTTP.Client (Response, request) as HTTPClient
|
||||
import Node.HTTP.Client
|
||||
( RequestHeaders(RequestHeaders)
|
||||
, requestAsStream
|
||||
, protocol
|
||||
, method
|
||||
, hostname
|
||||
, port
|
||||
, path
|
||||
, headers
|
||||
, rejectUnauthorized
|
||||
, statusCode
|
||||
, responseHeaders
|
||||
, responseAsStream
|
||||
)
|
||||
import Node.Stream (Readable, write, end, onData, onEnd)
|
||||
import Test.Spec (Spec)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
import Unsafe.Coerce (unsafeCoerce)
|
||||
|
||||
infix 1 Assertions.shouldEqual as ?=
|
||||
infix 1 shouldEqual as ?=
|
||||
|
||||
-- | The type for integration tests.
|
||||
type Test
|
||||
= Spec.Spec Unit
|
||||
type Test = Spec Unit
|
||||
|
||||
-- | The type for the entire test suite.
|
||||
type TestSuite
|
||||
= Effect.Effect Unit
|
||||
type TestSuite = Effect Unit
|
||||
|
||||
-- | Given a URL, a failure handler, and a success handler, create an HTTP
|
||||
-- | client request.
|
||||
@ -38,40 +53,40 @@ request ::
|
||||
Boolean ->
|
||||
Int ->
|
||||
String ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Buffer.Buffer ->
|
||||
Aff.Aff HTTPClient.Response
|
||||
request secure port method headers path body =
|
||||
Aff.makeAff \done -> do
|
||||
req <- HTTPClient.request options $ Either.Right >>> done
|
||||
Buffer ->
|
||||
Aff HTTPClient.Response
|
||||
request secure port' method' headers' path' body =
|
||||
makeAff \done -> do
|
||||
req <- HTTPClient.request options $ Right >>> done
|
||||
let
|
||||
stream = HTTPClient.requestAsStream req
|
||||
stream = requestAsStream req
|
||||
void
|
||||
$ Stream.write stream body
|
||||
$ Stream.end stream
|
||||
$ write stream body
|
||||
$ end stream
|
||||
$ pure unit
|
||||
pure Aff.nonCanceler
|
||||
pure nonCanceler
|
||||
where
|
||||
options =
|
||||
HTTPClient.protocol := (if secure then "https:" else "http:")
|
||||
<> HTTPClient.method := method
|
||||
<> HTTPClient.hostname := "localhost"
|
||||
<> HTTPClient.port := port
|
||||
<> HTTPClient.path := path
|
||||
<> HTTPClient.headers := HTTPClient.RequestHeaders headers
|
||||
<> HTTPClient.rejectUnauthorized := false
|
||||
protocol := (if secure then "https:" else "http:")
|
||||
<> method := method'
|
||||
<> hostname := "localhost"
|
||||
<> port := port'
|
||||
<> path := path'
|
||||
<> headers := RequestHeaders headers'
|
||||
<> rejectUnauthorized := false
|
||||
|
||||
-- | Same as `request` but without.
|
||||
request' ::
|
||||
Boolean ->
|
||||
Int ->
|
||||
String ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Aff.Aff HTTPClient.Response
|
||||
Aff HTTPClient.Response
|
||||
request' secure port method headers path =
|
||||
EffectClass.liftEffect (Buffer.create 0)
|
||||
liftEffect (create 0)
|
||||
>>= request secure port method headers path
|
||||
|
||||
-- | Same as `request` but with a `String` body.
|
||||
@ -79,107 +94,107 @@ requestString ::
|
||||
Boolean ->
|
||||
Int ->
|
||||
String ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
String ->
|
||||
Aff.Aff HTTPClient.Response
|
||||
Aff HTTPClient.Response
|
||||
requestString secure port method headers path body = do
|
||||
EffectClass.liftEffect (Buffer.fromString body Encoding.UTF8)
|
||||
liftEffect (fromString body UTF8)
|
||||
>>= request secure port method headers path
|
||||
|
||||
-- | Convert a request to an Aff containing the `Buffer with the response body.
|
||||
toBuffer :: HTTPClient.Response -> Aff.Aff Buffer.Buffer
|
||||
toBuffer :: HTTPClient.Response -> Aff Buffer
|
||||
toBuffer response =
|
||||
Aff.makeAff \done -> do
|
||||
makeAff \done -> do
|
||||
let
|
||||
stream = HTTPClient.responseAsStream response
|
||||
chunks <- Ref.new List.Nil
|
||||
Stream.onData stream $ \new -> Ref.modify_ (List.Cons new) chunks
|
||||
Stream.onEnd stream $ Ref.read chunks
|
||||
>>= List.reverse
|
||||
stream = responseAsStream response
|
||||
chunks <- new Nil
|
||||
onData stream $ \new -> modify_ (Cons new) chunks
|
||||
onEnd stream $ read chunks
|
||||
>>= reverse
|
||||
>>> Array.fromFoldable
|
||||
>>> Buffer.concat
|
||||
>>= Either.Right
|
||||
>>> concat
|
||||
>>= Right
|
||||
>>> done
|
||||
pure Aff.nonCanceler
|
||||
pure nonCanceler
|
||||
|
||||
-- | Convert a request to an Aff containing the string with the response body.
|
||||
toString :: HTTPClient.Response -> Aff.Aff String
|
||||
toString :: HTTPClient.Response -> Aff String
|
||||
toString resp = do
|
||||
buf <- toBuffer resp
|
||||
EffectClass.liftEffect $ Buffer.toString Encoding.UTF8 buf
|
||||
liftEffect $ Buffer.toString UTF8 buf
|
||||
|
||||
-- | Run an HTTP GET with the given url and return an Aff that contains the
|
||||
-- | string with the response body.
|
||||
get ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Aff.Aff String
|
||||
Aff String
|
||||
get port headers path = request' false port "GET" headers path >>= toString
|
||||
|
||||
-- | Like `get` but return a response body in a `Buffer`
|
||||
getBinary ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Aff.Aff Buffer.Buffer
|
||||
Aff Buffer
|
||||
getBinary port headers path = request' false port "GET" headers path >>= toBuffer
|
||||
|
||||
-- | Run an HTTPS GET with the given url and return an Aff that contains the
|
||||
-- | string with the response body.
|
||||
get' ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Aff.Aff String
|
||||
Aff String
|
||||
get' port headers path = request' true port "GET" headers path >>= toString
|
||||
|
||||
-- | Run an HTTP POST with the given url and body and return an Aff that
|
||||
-- | contains the string with the response body.
|
||||
post ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
String ->
|
||||
Aff.Aff String
|
||||
Aff String
|
||||
post port headers path = requestString false port "POST" headers path >=> toString
|
||||
|
||||
-- | Run an HTTP POST with the given url and binary buffer body and return an
|
||||
-- | Aff that contains the string with the response body.
|
||||
postBinary ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Buffer.Buffer ->
|
||||
Aff.Aff String
|
||||
Buffer ->
|
||||
Aff String
|
||||
postBinary port headers path = request false port "POST" headers path >=> toString
|
||||
|
||||
-- | Convert a request to an Aff containing the string with the given header
|
||||
-- | value.
|
||||
extractHeader :: String -> HTTPClient.Response -> String
|
||||
extractHeader header = unmaybe <<< lookup <<< HTTPClient.responseHeaders
|
||||
extractHeader header = unmaybe <<< lookup' <<< responseHeaders
|
||||
where
|
||||
unmaybe = Maybe.fromMaybe ""
|
||||
unmaybe = fromMaybe ""
|
||||
|
||||
lookup = Object.lookup $ StringUtil.toLower header
|
||||
lookup' = lookup $ toLower header
|
||||
|
||||
-- | Run an HTTP GET with the given url and return an Aff that contains the
|
||||
-- | string with the header value for the given header.
|
||||
getHeader ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
String ->
|
||||
Aff.Aff String
|
||||
Aff String
|
||||
getHeader port headers path header = extractHeader header <$> request' false port "GET" headers path
|
||||
|
||||
getStatus ::
|
||||
Int ->
|
||||
Object.Object String ->
|
||||
Object String ->
|
||||
String ->
|
||||
Aff.Aff Int
|
||||
getStatus port headers path = HTTPClient.statusCode <$> request' false port "GET" headers path
|
||||
Aff Int
|
||||
getStatus port headers path = statusCode <$> request' false port "GET" headers path
|
||||
|
||||
-- | Mock an HTTP Request object
|
||||
foreign import mockRequestImpl ::
|
||||
@ -187,8 +202,8 @@ foreign import mockRequestImpl ::
|
||||
String ->
|
||||
String ->
|
||||
String ->
|
||||
Object.Object String ->
|
||||
Effect.Effect HTTP.Request
|
||||
Object String ->
|
||||
Effect Request
|
||||
|
||||
-- | Mock an HTTP Request object
|
||||
mockRequest ::
|
||||
@ -196,29 +211,29 @@ mockRequest ::
|
||||
String ->
|
||||
String ->
|
||||
String ->
|
||||
Array (Tuple.Tuple String String) ->
|
||||
Aff.Aff HTTP.Request
|
||||
mockRequest httpVersion method url body = EffectClass.liftEffect <<< mockRequestImpl httpVersion method url body <<< Object.fromFoldable
|
||||
Array (Tuple String String) ->
|
||||
Aff Request
|
||||
mockRequest httpVersion method url body = liftEffect <<< mockRequestImpl httpVersion method url body <<< Object.fromFoldable
|
||||
|
||||
-- | Mock an HTTP Response object
|
||||
foreign import mockResponse :: Effect.Effect HTTP.Response
|
||||
foreign import mockResponse :: Effect HTTP.Response
|
||||
|
||||
-- | Get the current body from an HTTP Response object (note this will only work
|
||||
-- | with an object returned from mockResponse).
|
||||
getResponseBody :: HTTP.Response -> String
|
||||
getResponseBody = _.body <<< Coerce.unsafeCoerce
|
||||
getResponseBody = _.body <<< unsafeCoerce
|
||||
|
||||
-- | Get the currently set status from an HTTP Response object.
|
||||
getResponseStatus :: HTTP.Response -> Int
|
||||
getResponseStatus = _.statusCode <<< Coerce.unsafeCoerce
|
||||
getResponseStatus = _.statusCode <<< unsafeCoerce
|
||||
|
||||
-- | Get all current headers on the HTTP Response object.
|
||||
getResponseHeaders :: HTTP.Response -> Object.Object String
|
||||
getResponseHeaders = Coerce.unsafeCoerce <<< _.headers <<< Coerce.unsafeCoerce
|
||||
getResponseHeaders :: HTTP.Response -> Object String
|
||||
getResponseHeaders = unsafeCoerce <<< _.headers <<< unsafeCoerce
|
||||
|
||||
-- | Get the current value for the header on the HTTP Response object.
|
||||
getResponseHeader :: String -> HTTP.Response -> String
|
||||
getResponseHeader header = Maybe.fromMaybe "" <<< Object.lookup header <<< getResponseHeaders
|
||||
getResponseHeader header = fromMaybe "" <<< lookup header <<< getResponseHeaders
|
||||
|
||||
-- | Create a stream out of a string.
|
||||
foreign import stringToStream :: String -> Stream.Readable ()
|
||||
foreign import stringToStream :: String -> Readable ()
|
||||
|
||||
@ -1,13 +1,16 @@
|
||||
module Test.HTTPure.UtilsSpec where
|
||||
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Utils as Utils
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Utils (replacePlus)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=))
|
||||
|
||||
utilsSpec :: TestHelpers.Test
|
||||
replacePlusSpec :: Test
|
||||
replacePlusSpec =
|
||||
describe "replacePlus" do
|
||||
it "should replace all pluses" do
|
||||
replacePlus "foo+bar+baz" ?= "foo%20bar%20baz"
|
||||
|
||||
utilsSpec :: Test
|
||||
utilsSpec =
|
||||
Spec.describe "replacePlus" do
|
||||
Spec.it "should replace all pluses" do
|
||||
Utils.replacePlus "HTTPPure+is+A+purescript+HTTP+server+framework"
|
||||
?= "HTTPPure%20is%20A%20purescript%20HTTP%20server%20framework"
|
||||
describe "Utils" do
|
||||
replacePlusSpec
|
||||
|
||||
@ -1,63 +1,65 @@
|
||||
module Test.HTTPure.VersionSpec where
|
||||
|
||||
import Prelude
|
||||
import Test.Spec as Spec
|
||||
import HTTPure.Version as Version
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Test.HTTPure.TestHelpers ((?=))
|
||||
import Test.Spec (describe, it)
|
||||
import HTTPure.Version
|
||||
( Version(HTTP0_9, HTTP1_0, HTTP1_1, HTTP2_0, HTTP3_0, Other)
|
||||
, read
|
||||
)
|
||||
import Test.HTTPure.TestHelpers (Test, (?=), mockRequest)
|
||||
|
||||
showSpec :: TestHelpers.Test
|
||||
showSpec :: Test
|
||||
showSpec =
|
||||
Spec.describe "show" do
|
||||
Spec.describe "with an HTTP0_9" do
|
||||
Spec.it "is 'HTTP0_9'" do
|
||||
show Version.HTTP0_9 ?= "HTTP/0.9"
|
||||
Spec.describe "with an HTTP1_0" do
|
||||
Spec.it "is 'HTTP1_0'" do
|
||||
show Version.HTTP1_0 ?= "HTTP/1.0"
|
||||
Spec.describe "with an HTTP1_1" do
|
||||
Spec.it "is 'HTTP1_1'" do
|
||||
show Version.HTTP1_1 ?= "HTTP/1.1"
|
||||
Spec.describe "with an HTTP2_0" do
|
||||
Spec.it "is 'HTTP2_0'" do
|
||||
show Version.HTTP2_0 ?= "HTTP/2.0"
|
||||
Spec.describe "with an HTTP3_0" do
|
||||
Spec.it "is 'HTTP3_0'" do
|
||||
show Version.HTTP3_0 ?= "HTTP/3.0"
|
||||
Spec.describe "with an Other" do
|
||||
Spec.it "is 'Other'" do
|
||||
show (Version.Other "version") ?= "HTTP/version"
|
||||
describe "show" do
|
||||
describe "with an HTTP0_9" do
|
||||
it "is 'HTTP0_9'" do
|
||||
show HTTP0_9 ?= "HTTP/0.9"
|
||||
describe "with an HTTP1_0" do
|
||||
it "is 'HTTP1_0'" do
|
||||
show HTTP1_0 ?= "HTTP/1.0"
|
||||
describe "with an HTTP1_1" do
|
||||
it "is 'HTTP1_1'" do
|
||||
show HTTP1_1 ?= "HTTP/1.1"
|
||||
describe "with an HTTP2_0" do
|
||||
it "is 'HTTP2_0'" do
|
||||
show HTTP2_0 ?= "HTTP/2.0"
|
||||
describe "with an HTTP3_0" do
|
||||
it "is 'HTTP3_0'" do
|
||||
show HTTP3_0 ?= "HTTP/3.0"
|
||||
describe "with an Other" do
|
||||
it "is 'Other'" do
|
||||
show (Other "version") ?= "HTTP/version"
|
||||
|
||||
readSpec :: TestHelpers.Test
|
||||
readSpec :: Test
|
||||
readSpec =
|
||||
Spec.describe "read" do
|
||||
Spec.describe "with an 'HTTP0_9' Request" do
|
||||
Spec.it "is HTTP0_9" do
|
||||
request <- TestHelpers.mockRequest "0.9" "" "" "" []
|
||||
Version.read request ?= Version.HTTP0_9
|
||||
Spec.describe "with an 'HTTP1_0' Request" do
|
||||
Spec.it "is HTTP1_0" do
|
||||
request <- TestHelpers.mockRequest "1.0" "" "" "" []
|
||||
Version.read request ?= Version.HTTP1_0
|
||||
Spec.describe "with an 'HTTP1_1' Request" do
|
||||
Spec.it "is HTTP1_1" do
|
||||
request <- TestHelpers.mockRequest "1.1" "" "" "" []
|
||||
Version.read request ?= Version.HTTP1_1
|
||||
Spec.describe "with an 'HTTP2_0' Request" do
|
||||
Spec.it "is HTTP2_0" do
|
||||
request <- TestHelpers.mockRequest "2.0" "" "" "" []
|
||||
Version.read request ?= Version.HTTP2_0
|
||||
Spec.describe "with an 'HTTP3_0' Request" do
|
||||
Spec.it "is HTTP3_0" do
|
||||
request <- TestHelpers.mockRequest "3.0" "" "" "" []
|
||||
Version.read request ?= Version.HTTP3_0
|
||||
Spec.describe "with an 'Other' Request" do
|
||||
Spec.it "is Other" do
|
||||
request <- TestHelpers.mockRequest "version" "" "" "" []
|
||||
Version.read request ?= Version.Other "version"
|
||||
describe "read" do
|
||||
describe "with an 'HTTP0_9' Request" do
|
||||
it "is HTTP0_9" do
|
||||
request <- mockRequest "0.9" "" "" "" []
|
||||
read request ?= HTTP0_9
|
||||
describe "with an 'HTTP1_0' Request" do
|
||||
it "is HTTP1_0" do
|
||||
request <- mockRequest "1.0" "" "" "" []
|
||||
read request ?= HTTP1_0
|
||||
describe "with an 'HTTP1_1' Request" do
|
||||
it "is HTTP1_1" do
|
||||
request <- mockRequest "1.1" "" "" "" []
|
||||
read request ?= HTTP1_1
|
||||
describe "with an 'HTTP2_0' Request" do
|
||||
it "is HTTP2_0" do
|
||||
request <- mockRequest "2.0" "" "" "" []
|
||||
read request ?= HTTP2_0
|
||||
describe "with an 'HTTP3_0' Request" do
|
||||
it "is HTTP3_0" do
|
||||
request <- mockRequest "3.0" "" "" "" []
|
||||
read request ?= HTTP3_0
|
||||
describe "with an 'Other' Request" do
|
||||
it "is Other" do
|
||||
request <- mockRequest "version" "" "" "" []
|
||||
read request ?= Other "version"
|
||||
|
||||
versionSpec :: TestHelpers.Test
|
||||
versionSpec :: Test
|
||||
versionSpec =
|
||||
Spec.describe "Version" do
|
||||
describe "Version" do
|
||||
showSpec
|
||||
readSpec
|
||||
|
||||
@ -1,37 +1,37 @@
|
||||
module Test.Main where
|
||||
|
||||
import Prelude
|
||||
import Effect.Aff as Aff
|
||||
import Test.Spec as Spec
|
||||
import Test.Spec.Reporter as Reporter
|
||||
import Test.Spec.Runner as Runner
|
||||
import Test.HTTPure.BodySpec as BodySpec
|
||||
import Test.HTTPure.HeadersSpec as HeadersSpec
|
||||
import Test.HTTPure.LookupSpec as LookupSpec
|
||||
import Test.HTTPure.MethodSpec as MethodSpec
|
||||
import Test.HTTPure.PathSpec as PathSpec
|
||||
import Test.HTTPure.QuerySpec as QuerySpec
|
||||
import Test.HTTPure.RequestSpec as RequestSpec
|
||||
import Test.HTTPure.ResponseSpec as ResponseSpec
|
||||
import Test.HTTPure.ServerSpec as ServerSpec
|
||||
import Test.HTTPure.StatusSpec as StatusSpec
|
||||
import Test.HTTPure.UtilsSpec as UtilsSpec
|
||||
import Test.HTTPure.VersionSpec as VersionSpec
|
||||
import Test.HTTPure.IntegrationSpec as IntegrationSpec
|
||||
import Test.HTTPure.TestHelpers as TestHelpers
|
||||
import Effect.Aff (launchAff_)
|
||||
import Test.Spec (describe)
|
||||
import Test.Spec.Reporter (specReporter)
|
||||
import Test.Spec.Runner (runSpec)
|
||||
import Test.HTTPure.BodySpec (bodySpec)
|
||||
import Test.HTTPure.HeadersSpec (headersSpec)
|
||||
import Test.HTTPure.LookupSpec (lookupSpec)
|
||||
import Test.HTTPure.MethodSpec (methodSpec)
|
||||
import Test.HTTPure.PathSpec (pathSpec)
|
||||
import Test.HTTPure.QuerySpec (querySpec)
|
||||
import Test.HTTPure.RequestSpec (requestSpec)
|
||||
import Test.HTTPure.ResponseSpec (responseSpec)
|
||||
import Test.HTTPure.ServerSpec (serverSpec)
|
||||
import Test.HTTPure.StatusSpec (statusSpec)
|
||||
import Test.HTTPure.UtilsSpec (utilsSpec)
|
||||
import Test.HTTPure.VersionSpec (versionSpec)
|
||||
import Test.HTTPure.IntegrationSpec (integrationSpec)
|
||||
import Test.HTTPure.TestHelpers (TestSuite)
|
||||
|
||||
main :: TestHelpers.TestSuite
|
||||
main = Aff.launchAff_ $ Runner.runSpec [ Reporter.specReporter ] $ Spec.describe "HTTPure" do
|
||||
BodySpec.bodySpec
|
||||
HeadersSpec.headersSpec
|
||||
LookupSpec.lookupSpec
|
||||
MethodSpec.methodSpec
|
||||
PathSpec.pathSpec
|
||||
QuerySpec.querySpec
|
||||
RequestSpec.requestSpec
|
||||
ResponseSpec.responseSpec
|
||||
ServerSpec.serverSpec
|
||||
StatusSpec.statusSpec
|
||||
UtilsSpec.utilsSpec
|
||||
VersionSpec.versionSpec
|
||||
IntegrationSpec.integrationSpec
|
||||
main :: TestSuite
|
||||
main = launchAff_ $ runSpec [ specReporter ] $ describe "HTTPure" do
|
||||
bodySpec
|
||||
headersSpec
|
||||
lookupSpec
|
||||
methodSpec
|
||||
pathSpec
|
||||
querySpec
|
||||
requestSpec
|
||||
responseSpec
|
||||
serverSpec
|
||||
statusSpec
|
||||
utilsSpec
|
||||
versionSpec
|
||||
integrationSpec
|
||||
|
||||
Loading…
Reference in New Issue
Block a user