Make server cancelable and clean up examples and tests (#112)
This commit is contained in:
parent
1adbcecaaa
commit
ce4a10a3b5
@ -7,28 +7,20 @@ import HTTPure as HTTPure
|
||||
import Node.Encoding as Encoding
|
||||
import Node.FS.Aff as FSAff
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8088
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | 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 _ = FSAff.readTextFile Encoding.UTF8 filePath >>= HTTPure.ok
|
||||
sayHello = const $ FSAff.readTextFile Encoding.UTF8 filePath >>= HTTPure.ok
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port sayHello do
|
||||
main = HTTPure.serve 8080 sayHello do
|
||||
Console.log $ " ┌────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> " # => hello world! │"
|
||||
Console.log $ " │ > curl localhost:8080 # => hello world! │"
|
||||
Console.log $ " └────────────────────────────────────────────┘"
|
||||
|
@ -6,30 +6,23 @@ import Effect.Console as Console
|
||||
import Node.FS.Aff as FS
|
||||
import HTTPure as HTTPure
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8090
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | The path to the file containing the response to send
|
||||
filePath :: String
|
||||
filePath = "./docs/Examples/Binary/circle.png"
|
||||
|
||||
responseHeaders :: HTTPure.Headers
|
||||
responseHeaders = HTTPure.header "Content-Type" "image/png"
|
||||
|
||||
-- | Respond with image data when run
|
||||
image :: HTTPure.Request -> HTTPure.ResponseM
|
||||
image _ = FS.readFile filePath >>= HTTPure.ok' headers
|
||||
where
|
||||
headers = HTTPure.header "Content-Type" "image/png"
|
||||
image = const $ FS.readFile filePath >>= HTTPure.ok' responseHeaders
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port image do
|
||||
main = HTTPure.serve 8080 image do
|
||||
Console.log $ " ┌────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -o circle.png localhost:" <> portS <> " │"
|
||||
Console.log $ " │ > curl -o circle.png localhost:8080 │"
|
||||
Console.log $ " └────────────────────────────────────────────┘"
|
||||
|
@ -9,14 +9,6 @@ import HTTPure as HTTPure
|
||||
import Node.ChildProcess as ChildProcess
|
||||
import Node.Stream as Stream
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8091
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | Run a script and return it's stdout stream
|
||||
runScript :: String -> Aff.Aff (Stream.Readable ())
|
||||
runScript script = EffectClass.liftEffect $ ChildProcess.stdout <$>
|
||||
@ -24,17 +16,17 @@ runScript script = EffectClass.liftEffect $ ChildProcess.stdout <$>
|
||||
|
||||
-- | Say 'hello world!' in chunks when run
|
||||
sayHello :: HTTPure.Request -> HTTPure.ResponseM
|
||||
sayHello _ =
|
||||
runScript "echo -n 'hello '; sleep 1; echo -n 'world!'" >>= HTTPure.ok
|
||||
sayHello =
|
||||
const $ runScript "echo -n 'hello '; sleep 1; echo -n 'world!'" >>= HTTPure.ok
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port sayHello do
|
||||
main = HTTPure.serve 8080 sayHello do
|
||||
Console.log $ " ┌────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -Nv localhost:" <> portS <> " │"
|
||||
Console.log $ " │ > curl -Nv localhost:8080 │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => < Transfer-Encoding: chunked │"
|
||||
Console.log $ " │ # => ... │"
|
||||
|
@ -6,14 +6,6 @@ import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure ((!@))
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8082
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | The headers that will be included in every response.
|
||||
responseHeaders :: HTTPure.Headers
|
||||
responseHeaders = HTTPure.header "X-Example" "hello world!"
|
||||
@ -24,12 +16,12 @@ router { headers } = HTTPure.ok' responseHeaders $ headers !@ "X-Input"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port router do
|
||||
main = HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌──────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -H 'X-Input: test' -v localhost:" <> portS <> " │"
|
||||
Console.log $ " │ > curl -H 'X-Input: test' -v localhost:8080 │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => ...< X-Example: hello world! │"
|
||||
Console.log $ " │ # => ... │"
|
||||
|
@ -5,24 +5,12 @@ import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8080
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | Say 'hello world!' when run
|
||||
sayHello :: HTTPure.Request -> HTTPure.ResponseM
|
||||
sayHello _ = HTTPure.ok "hello world!"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port sayHello do
|
||||
main = HTTPure.serve 8080 (const $ HTTPure.ok "hello world!") do
|
||||
Console.log $ " ┌────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> " # => hello world! │"
|
||||
Console.log $ " │ > curl localhost:8080 # => hello world! │"
|
||||
Console.log $ " └────────────────────────────────────────────┘"
|
||||
|
@ -6,14 +6,6 @@ import Effect.Class as EffectClass
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8089
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | A middleware that logs at the beginning and end of each request
|
||||
loggingMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) ->
|
||||
HTTPure.Request ->
|
||||
@ -51,17 +43,17 @@ sayHello _ = HTTPure.ok' (HTTPure.header "X-Middleware" "router") "hello"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port (middlewares sayHello) do
|
||||
main = HTTPure.serve 8080 (middlewares sayHello) do
|
||||
Console.log $ " ┌───────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -v localhost:" <> portS <> " │"
|
||||
Console.log $ " │ > curl -v localhost:8080 │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => ...< X-Middleware: router │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => hello │"
|
||||
Console.log $ " │ > curl -v localhost:" <> portS <> "/middleware │"
|
||||
Console.log $ " │ > curl -v localhost:8080/middleware │"
|
||||
Console.log $ " │ # => ... │"
|
||||
Console.log $ " │ # => ...< X-Middleware: middleware │"
|
||||
Console.log $ " │ # => ... │"
|
||||
|
@ -5,14 +5,6 @@ import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8081
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | Specify the routes
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { path: [ "hello" ] } = HTTPure.ok "hello"
|
||||
@ -21,11 +13,11 @@ router _ = HTTPure.notFound
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port router do
|
||||
main = HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌───────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "/hello # => hello │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "/goodbye # => goodbye │"
|
||||
Console.log $ " │ > curl localhost:8080/hello # => hello │"
|
||||
Console.log $ " │ > curl localhost:8080/goodbye # => goodbye │"
|
||||
Console.log $ " └───────────────────────────────────────────────┘"
|
||||
|
@ -6,14 +6,6 @@ import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure ((!@))
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8086
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | Specify the routes
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { path }
|
||||
@ -22,13 +14,13 @@ router { path }
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port router do
|
||||
main = HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌───────────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "/segment/<anything> │"
|
||||
Console.log $ " │ > curl localhost:8080/segment/<anything> │"
|
||||
Console.log $ " │ # => <anything> │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "/<anything>/<else>/... │"
|
||||
Console.log $ " │ > curl localhost:8080/<anything>/<else>/... │"
|
||||
Console.log $ " │ # => [ <anything>, <else>, ... ] │"
|
||||
Console.log $ " └───────────────────────────────────────────────┘"
|
||||
|
@ -5,14 +5,6 @@ import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8084
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | Route to the correct handler
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { body, method: HTTPure.Post } = HTTPure.ok body
|
||||
@ -20,11 +12,11 @@ router _ = HTTPure.notFound
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port router do
|
||||
main = HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌───────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl -XPOST --data test localhost:" <> portS <> " │"
|
||||
Console.log $ " │ > curl -XPOST --data test localhost:8080 │"
|
||||
Console.log $ " │ # => test │"
|
||||
Console.log $ " └───────────────────────────────────────────┘"
|
||||
|
@ -6,14 +6,6 @@ import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
import HTTPure ((!@), (!?))
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8087
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | Specify the routes
|
||||
router :: HTTPure.Request -> HTTPure.ResponseM
|
||||
router { query }
|
||||
@ -23,15 +15,15 @@ router { query }
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serve port router do
|
||||
main = HTTPure.serve 8080 router do
|
||||
Console.log $ " ┌────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "?foo │"
|
||||
Console.log $ " │ > curl localhost:8080?foo │"
|
||||
Console.log $ " │ # => foo │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "?bar=test │"
|
||||
Console.log $ " │ > curl localhost:8080?bar=test │"
|
||||
Console.log $ " │ # => bar │"
|
||||
Console.log $ " │ > curl localhost:" <> portS <> "?baz=<anything> │"
|
||||
Console.log $ " │ > curl localhost:8080?baz=<anything> │"
|
||||
Console.log $ " │ # => <anything> │"
|
||||
Console.log $ " └────────────────────────────────────────┘"
|
||||
|
@ -5,14 +5,6 @@ import Prelude
|
||||
import Effect.Console as Console
|
||||
import HTTPure as HTTPure
|
||||
|
||||
-- | Serve the example server on this port
|
||||
port :: Int
|
||||
port = 8085
|
||||
|
||||
-- | Shortcut for `show port`
|
||||
portS :: String
|
||||
portS = show port
|
||||
|
||||
-- | The path to the certificate file
|
||||
cert :: String
|
||||
cert = "./docs/Examples/SSL/Certificate.cer"
|
||||
@ -27,11 +19,11 @@ sayHello _ = HTTPure.ok "hello world!"
|
||||
|
||||
-- | Boot up the server
|
||||
main :: HTTPure.ServerM
|
||||
main = HTTPure.serveSecure port cert key sayHello do
|
||||
main = HTTPure.serveSecure 8080 cert key sayHello do
|
||||
Console.log $ " ┌───────────────────────────────────────────┐"
|
||||
Console.log $ " │ Server now up on port " <> portS <> " │"
|
||||
Console.log $ " │ Server now up on port 8080 │"
|
||||
Console.log $ " │ │"
|
||||
Console.log $ " │ To test, run: │"
|
||||
Console.log $ " │ > curl --insecure https://localhost:" <> portS <> " │"
|
||||
Console.log $ " │ > curl --insecure https://localhost:8080 │"
|
||||
Console.log $ " │ # => hello world! │"
|
||||
Console.log $ " └───────────────────────────────────────────┘"
|
||||
|
@ -20,10 +20,10 @@ import Node.HTTP.Secure as HTTPS
|
||||
import HTTPure.Request as Request
|
||||
import HTTPure.Response as Response
|
||||
|
||||
-- | The `ServerM` type simply conveniently wraps up an HTTPure monad that
|
||||
-- | returns a `Unit`. This type is the return type of the HTTPure serve and
|
||||
-- | related methods.
|
||||
type ServerM = Effect.Effect Unit
|
||||
-- | 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)
|
||||
|
||||
-- | This function takes a method which takes a `Request` and returns a
|
||||
-- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the
|
||||
@ -32,7 +32,7 @@ type ServerM = Effect.Effect Unit
|
||||
handleRequest :: (Request.Request -> Response.ResponseM) ->
|
||||
HTTP.Request ->
|
||||
HTTP.Response ->
|
||||
ServerM
|
||||
Effect.Effect Unit
|
||||
handleRequest router request httpresponse =
|
||||
void $ Aff.runAff (\_ -> pure unit) $
|
||||
Request.fromHTTPRequest request >>= router >>= Response.send httpresponse
|
||||
@ -42,11 +42,12 @@ handleRequest router request httpresponse =
|
||||
-- | runs a HTTPure server without SSL.
|
||||
serve' :: HTTP.ListenOptions ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
ServerM ->
|
||||
Effect.Effect Unit ->
|
||||
ServerM
|
||||
serve' options router onStarted =
|
||||
HTTP.createServer (handleRequest router) >>= \server ->
|
||||
serve' options router onStarted = do
|
||||
server <- HTTP.createServer (handleRequest router)
|
||||
HTTP.listen server options onStarted
|
||||
pure $ HTTP.close server
|
||||
|
||||
-- | Given a `Options HTTPS.SSLOptions` object and a `HTTP.ListenOptions`
|
||||
-- | object, a function mapping `Request` to `ResponseM`, and a `ServerM`
|
||||
@ -55,11 +56,12 @@ serve' options router onStarted =
|
||||
serveSecure' :: Options HTTPS.SSLOptions ->
|
||||
HTTP.ListenOptions ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
ServerM ->
|
||||
Effect.Effect Unit ->
|
||||
ServerM
|
||||
serveSecure' sslOptions options router onStarted =
|
||||
HTTPS.createServer sslOptions (handleRequest router) >>= \server ->
|
||||
serveSecure' sslOptions options router onStarted = do
|
||||
server <- HTTPS.createServer sslOptions (handleRequest router)
|
||||
HTTP.listen server options onStarted
|
||||
pure $ HTTP.close server
|
||||
|
||||
-- | Given a port number, return a `HTTP.ListenOptions` `Record`.
|
||||
listenOptions :: Int -> HTTP.ListenOptions
|
||||
@ -76,7 +78,7 @@ listenOptions port =
|
||||
-- | effects.
|
||||
serve :: Int ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
ServerM ->
|
||||
Effect.Effect Unit ->
|
||||
ServerM
|
||||
serve = serve' <<< listenOptions
|
||||
|
||||
@ -91,7 +93,7 @@ serveSecure :: Int ->
|
||||
String ->
|
||||
String ->
|
||||
(Request.Request -> Response.ResponseM) ->
|
||||
ServerM ->
|
||||
Effect.Effect Unit ->
|
||||
ServerM
|
||||
serveSecure port cert key router onStarted = do
|
||||
cert' <- FSSync.readTextFile Encoding.UTF8 cert
|
||||
|
@ -25,103 +25,103 @@ import Examples.SSL.Main as SSL
|
||||
|
||||
asyncResponseSpec :: TestHelpers.Test
|
||||
asyncResponseSpec = Spec.it "runs the async response example" do
|
||||
EffectClass.liftEffect AsyncResponse.main
|
||||
response <- TestHelpers.get port Object.empty "/"
|
||||
close <- EffectClass.liftEffect AsyncResponse.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
where port = AsyncResponse.port
|
||||
|
||||
binarySpec :: TestHelpers.Test
|
||||
binarySpec = Spec.it "runs the binary example" do
|
||||
close <- EffectClass.liftEffect Binary.main
|
||||
responseBuf <- TestHelpers.getBinary 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
binaryBuf <- FS.readFile Binary.filePath
|
||||
expected <- EffectClass.liftEffect $ Buffer.toArray binaryBuf
|
||||
EffectClass.liftEffect Binary.main
|
||||
responseBuf <- TestHelpers.getBinary port Object.empty "/"
|
||||
response <- EffectClass.liftEffect $ Buffer.toArray responseBuf
|
||||
response ?= expected
|
||||
where port = Binary.port
|
||||
|
||||
chunkedSpec :: TestHelpers.Test
|
||||
chunkedSpec = Spec.it "runs the chunked example" do
|
||||
EffectClass.liftEffect Chunked.main
|
||||
response <- TestHelpers.get port Object.empty "/"
|
||||
close <- EffectClass.liftEffect Chunked.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.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 world!"
|
||||
where port = Chunked.port
|
||||
|
||||
headersSpec :: TestHelpers.Test
|
||||
headersSpec = Spec.it "runs the headers example" do
|
||||
EffectClass.liftEffect Headers.main
|
||||
header <- TestHelpers.getHeader port Object.empty "/" "X-Example"
|
||||
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
|
||||
header ?= "hello world!"
|
||||
response <- TestHelpers.get port (Object.singleton "X-Input" "test") "/"
|
||||
response ?= "test"
|
||||
where port = Headers.port
|
||||
|
||||
helloWorldSpec :: TestHelpers.Test
|
||||
helloWorldSpec = Spec.it "runs the hello world example" do
|
||||
EffectClass.liftEffect HelloWorld.main
|
||||
response <- TestHelpers.get port Object.empty "/"
|
||||
close <- EffectClass.liftEffect HelloWorld.main
|
||||
response <- TestHelpers.get 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
where port = HelloWorld.port
|
||||
|
||||
middlewareSpec :: TestHelpers.Test
|
||||
middlewareSpec = Spec.it "runs the middleware example" do
|
||||
EffectClass.liftEffect Middleware.main
|
||||
header <- TestHelpers.getHeader port Object.empty "/" "X-Middleware"
|
||||
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
|
||||
header ?= "router"
|
||||
body <- TestHelpers.get port Object.empty "/"
|
||||
body ?= "hello"
|
||||
header' <- TestHelpers.getHeader port Object.empty "/middleware" "X-Middleware"
|
||||
header' ?= "middleware"
|
||||
body' <- TestHelpers.get port Object.empty "/middleware"
|
||||
body' ?= "Middleware!"
|
||||
where port = Middleware.port
|
||||
|
||||
multiRouteSpec :: TestHelpers.Test
|
||||
multiRouteSpec = Spec.it "runs the multi route example" do
|
||||
EffectClass.liftEffect MultiRoute.main
|
||||
hello <- TestHelpers.get port Object.empty "/hello"
|
||||
close <- EffectClass.liftEffect MultiRoute.main
|
||||
hello <- TestHelpers.get 8080 Object.empty "/hello"
|
||||
goodbye <- TestHelpers.get 8080 Object.empty "/goodbye"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
hello ?= "hello"
|
||||
goodbye <- TestHelpers.get port Object.empty "/goodbye"
|
||||
goodbye ?= "goodbye"
|
||||
where port = MultiRoute.port
|
||||
|
||||
pathSegmentsSpec :: TestHelpers.Test
|
||||
pathSegmentsSpec = Spec.it "runs the path segments example" do
|
||||
EffectClass.liftEffect PathSegments.main
|
||||
foo <- TestHelpers.get port Object.empty "/segment/foo"
|
||||
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
|
||||
foo ?= "foo"
|
||||
somebars <- TestHelpers.get port Object.empty "/some/bars"
|
||||
somebars ?= "[\"some\",\"bars\"]"
|
||||
where port = PathSegments.port
|
||||
|
||||
postSpec :: TestHelpers.Test
|
||||
postSpec = Spec.it "runs the post example" do
|
||||
EffectClass.liftEffect Post.main
|
||||
response <- TestHelpers.post port Object.empty "/" "test"
|
||||
close <- EffectClass.liftEffect Post.main
|
||||
response <- TestHelpers.post 8080 Object.empty "/" "test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
response ?= "test"
|
||||
where port = Post.port
|
||||
|
||||
queryParametersSpec :: TestHelpers.Test
|
||||
queryParametersSpec = Spec.it "runs the query parameters example" do
|
||||
EffectClass.liftEffect QueryParameters.main
|
||||
foo <- TestHelpers.get port Object.empty "/?foo"
|
||||
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
|
||||
foo ?= "foo"
|
||||
bar <- TestHelpers.get port Object.empty "/?bar=test"
|
||||
bar ?= "bar"
|
||||
notbar <- TestHelpers.get port Object.empty "/?bar=nottest"
|
||||
notbar ?= ""
|
||||
baz <- TestHelpers.get port Object.empty "/?baz=test"
|
||||
baz ?= "test"
|
||||
where port = QueryParameters.port
|
||||
|
||||
sslSpec :: TestHelpers.Test
|
||||
sslSpec = Spec.it "runs the ssl example" do
|
||||
EffectClass.liftEffect SSL.main
|
||||
response <- TestHelpers.get' port Object.empty "/"
|
||||
close <- EffectClass.liftEffect SSL.main
|
||||
response <- TestHelpers.get' 8080 Object.empty "/"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
response ?= "hello world!"
|
||||
where port = SSL.port
|
||||
|
||||
integrationSpec :: TestHelpers.Test
|
||||
integrationSpec = Spec.describe "Integration" do
|
||||
|
@ -26,30 +26,35 @@ mockRouter { path } = Response.ok $ "/" <> String.joinWith "/" path
|
||||
serveSpec :: TestHelpers.Test
|
||||
serveSpec = Spec.describe "serve" do
|
||||
Spec.it "boots a server on the given port" do
|
||||
EffectClass.liftEffect $ Server.serve 7901 mockRouter $ pure unit
|
||||
out <- TestHelpers.get 7901 Object.empty "/test"
|
||||
close <- EffectClass.liftEffect $ Server.serve 8080 mockRouter $ pure unit
|
||||
out <- TestHelpers.get 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
|
||||
serve'Spec :: TestHelpers.Test
|
||||
serve'Spec = Spec.describe "serve'" do
|
||||
Spec.it "boots a server with the given options" do
|
||||
EffectClass.liftEffect $ Server.serve' options mockRouter $ pure unit
|
||||
out <- TestHelpers.get 7902 Object.empty "/test"
|
||||
close <- EffectClass.liftEffect $
|
||||
Server.serve' options mockRouter $ pure unit
|
||||
out <- TestHelpers.get 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
where
|
||||
options = { hostname: "localhost", port: 7902, backlog: Maybe.Nothing }
|
||||
options = { hostname: "localhost", port: 8080, backlog: Maybe.Nothing }
|
||||
|
||||
serveSecureSpec :: TestHelpers.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
|
||||
EffectClass.liftEffect $ Server.serveSecure 7903 cert key mockRouter $ pure unit
|
||||
out <- TestHelpers.get' 7903 Object.empty "/test"
|
||||
close <- EffectClass.liftEffect $
|
||||
Server.serveSecure 8080 cert key mockRouter $ pure unit
|
||||
out <- TestHelpers.get' 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
Spec.describe "with invalid key and cert files" do
|
||||
Spec.it "throws" do
|
||||
AffAssertions.expectError do
|
||||
EffectClass.liftEffect $ Server.serveSecure 7904 "" "" mockRouter $ pure unit
|
||||
AffAssertions.expectError $ EffectClass.liftEffect $
|
||||
Server.serveSecure 8080 "" "" mockRouter $ pure unit
|
||||
where
|
||||
cert = "./test/Mocks/Certificate.cer"
|
||||
key = "./test/Mocks/Key.key"
|
||||
@ -59,9 +64,10 @@ 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
|
||||
EffectClass.liftEffect $
|
||||
Server.serveSecure' sslOpts (options 7905) mockRouter $ pure unit
|
||||
out <- TestHelpers.get' 7905 Object.empty "/test"
|
||||
close <- EffectClass.liftEffect $
|
||||
Server.serveSecure' sslOpts (options 8080) mockRouter $ pure unit
|
||||
out <- TestHelpers.get' 8080 Object.empty "/test"
|
||||
EffectClass.liftEffect $ close $ pure unit
|
||||
out ?= "/test"
|
||||
where
|
||||
options port = { hostname: "localhost", port, backlog: Maybe.Nothing }
|
||||
|
Loading…
Reference in New Issue
Block a user