104 lines
3.3 KiB
Haskell
104 lines
3.3 KiB
Haskell
module Test.HTTPurple.ServerSpec where
|
|
|
|
import Prelude
|
|
|
|
import Control.Monad.Except (throwError)
|
|
import Data.Generic.Rep (class Generic)
|
|
import Data.Newtype (wrap)
|
|
import Effect.Aff (Aff, delay)
|
|
import Effect.Aff.Class (liftAff)
|
|
import Effect.Class (liftEffect)
|
|
import Effect.Exception (error)
|
|
import Foreign.Object (empty)
|
|
import HTTPurple.Request (Request)
|
|
import HTTPurple.Response (Response, ok)
|
|
import HTTPurple.Server (serve)
|
|
import Routing.Duplex (RouteDuplex')
|
|
import Routing.Duplex as RD
|
|
import Routing.Duplex.Generic as G
|
|
import Routing.Duplex.Generic as RG
|
|
import Test.HTTPurple.TestHelpers (Test, get, get', getStatus, (?=))
|
|
import Test.Spec (describe, it)
|
|
import Test.Spec.Assertions (expectError)
|
|
|
|
data Route = Test
|
|
|
|
derive instance Generic Route _
|
|
|
|
route :: RouteDuplex' Route
|
|
route = RD.root $ G.sum
|
|
{ "Test": RD.path "test" RG.noArgs
|
|
}
|
|
|
|
mockRouter :: Request Route -> Aff Response
|
|
mockRouter { route: Test } = ok $ RD.print route Test
|
|
|
|
serveSpec :: Test
|
|
serveSpec =
|
|
describe "serve" do
|
|
it "boots a server on the given port" do
|
|
close <- liftEffect $ serve { hostname: "localhost", port: 10000 } { route, router: mockRouter }
|
|
out <- get 10000 empty "/test"
|
|
liftEffect $ close $ pure unit
|
|
out ?= "/test"
|
|
it "responds with a 500 upon unhandled exceptions" do
|
|
let router _ = throwError $ error "fail!"
|
|
close <- liftEffect $ serve { hostname: "localhost", port: 10000 } { route, router }
|
|
liftAff $ delay $ wrap 200.0
|
|
status <- getStatus 10000 empty "/test"
|
|
liftEffect $ close $ pure unit
|
|
status ?= 500
|
|
|
|
serve'Spec :: Test
|
|
serve'Spec =
|
|
describe "serve'" do
|
|
it "boots a server with the given options" do
|
|
close <-
|
|
liftEffect
|
|
$ serve { hostname: "localhost", port: 10000 } { route, router: mockRouter }
|
|
liftAff $ delay $ wrap 200.0
|
|
out <- get 10000 empty "/test"
|
|
liftEffect $ close $ pure unit
|
|
out ?= "/test"
|
|
|
|
serveSecureSpec :: Test
|
|
serveSecureSpec =
|
|
describe "serveSecure" do
|
|
describe "with valid key and cert files" do
|
|
it "boots a server on the given port" do
|
|
close <-
|
|
liftEffect
|
|
$ serve { hostname: "localhost", port: 10000, certFile: "./test/Mocks/Certificate.cer", keyFile: "./test/Mocks/Key.key" } { route, router: mockRouter }
|
|
liftAff $ delay $ wrap 200.0
|
|
out <- get' 10000 empty "/test"
|
|
liftEffect $ close $ pure unit
|
|
out ?= "/test"
|
|
describe "with invalid key and cert files" do
|
|
it "throws" do
|
|
expectError $ liftEffect
|
|
$ serve { hostname: "localhost", port: 10000, certFile: "", keyFile: "" } { route, router: mockRouter }
|
|
liftAff $ delay $ wrap 200.0
|
|
|
|
serveSecure'Spec :: Test
|
|
serveSecure'Spec =
|
|
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: 10000, certFile: "./test/Mocks/Certificate.cer", keyFile: "./test/Mocks/Key.key" }
|
|
close <-
|
|
liftEffect
|
|
$ serve options { route, router: mockRouter }
|
|
liftAff $ delay $ wrap 200.0
|
|
out <- get' 10000 empty "/test"
|
|
liftEffect $ close $ pure unit
|
|
out ?= "/test"
|
|
|
|
serverSpec :: Test
|
|
serverSpec =
|
|
describe "Server" do
|
|
serveSpec
|
|
serve'Spec
|
|
serveSecureSpec
|
|
serveSecure'Spec
|