{-# LANGUAGE OverloadedStrings #-}
module ResourceTests where
-- import Network.HTTP.Types
-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Webcrank
-- runResourceTests = testGroup "runResource"
-- [ testCase "service is unavailable" testServiceUnavailable
-- , testCase "not implemented" testNotImplemented
-- , testCase "uri too long" testUriTooLong
-- , testCase "method not allowed" testMethodNotAllowed
-- , testCase "bad request" testBadRequest
-- , testCase "unauthorized" testUnauthorized
-- , testCase "forbidden" testForbidden
-- , testCase "unknown or unsupported Content-* headers" testInvalidContentHeaders
-- , testCase "unknown Content-Type" testUnknownContentType
-- , testCase "entity too large" testEntityTooLarge
-- , testCase "OPTIONS" testOptions
-- , testCase "no acceptable media type" testNoAcceptableMediaType
-- , testCase "no acceptable charset" testNoAcceptableCharset
-- ]
-- (<@=?>) = (=<<) . (@=?)
-- testServiceUnavailable = resp503 <@=?> runResource rs testRq where
-- rs = testResource { serviceAvailable = value False }
-- resp503 = testResp serviceUnavailable503
-- [(hContentType, "text/html")]
-- (testBody "503 Service UnavailableService Unavailable
The server is currently unable to handle the request due to a temporary overloading or maintenance of the server.
webcrank web server")
-- testNotImplemented = resp501 <@=?> runResource testResource rq where
-- rq = testRq { testRqMethod = "MOVE" }
-- resp501 = testResp notImplemented501
-- [(hContentType, "text/html")]
-- (testBody "501 Not ImplementedNot Implemented
The server does not support the MOVE method.
webcrank web server")
-- testUriTooLong = resp414 <@=?> runResource rs testRq where
-- rs = testResource { uriTooLong = value True }
-- resp414 = testResp requestURITooLong414
-- [(hContentType, "text/html")]
-- (testBody "414 Request-URI Too LongRequest-URI Too Long
Request-URI Too Long
webcrank web server")
-- testMethodNotAllowed = resp405 <@=?> runResource testResource rq where
-- rq = testRq { testRqMethod = "POST" }
-- resp405 = testResp methodNotAllowed405
-- [(hContentType, "text/html"), ("Allow", "GET, HEAD")]
-- (testBody "405 Method Not AllowedMethod Not Allowed
Method Not Allowed
webcrank web server")
-- testBadRequest = resp400 <@=?> runResource rs testRq where
-- rs = testResource { malformedRequest = value True }
-- resp400 = testResp badRequest400
-- [(hContentType, "text/html")]
-- (testBody "400 Bad RequestBad Request
Bad Request
webcrank web server")
-- testUnauthorized = resp401 <@=?> runResource rs testRq where
-- realm = "Basic realm=\"Webcrank\""
-- rs = testResource { isAuthorized = unauthorized realm }
-- resp401 = testResp unauthorized401
-- [(hContentType, "text/html"), ("WWW-Authenticate", realm)]
-- (testBody "401 UnauthorizedUnauthorized
Unauthorized
webcrank web server")
-- testForbidden = resp403 <@=?> runResource rs testRq where
-- rs = testResource { forbidden = value True }
-- resp403 = testResp forbidden403
-- [(hContentType, "text/html")]
-- (testBody "403 ForbiddenForbidden
Forbidden
webcrank web server")
-- testInvalidContentHeaders = resp501 <@=?> runResource rs testRq where
-- rs = testResource { validContentHeaders = value False }
-- resp501 = testResp notImplemented501
-- [(hContentType, "text/html")]
-- (testBody "501 Not ImplementedNot Implemented
The server does not support the GET method.
webcrank web server")
-- testUnknownContentType = resp415 <@=?> runResource rs testRq where
-- rs = testResource { knownContentType = value False }
-- resp415 = testResp unsupportedMediaType415
-- [(hContentType, "text/html")]
-- (testBody "415 Unsupported Media TypeUnsupported Media Type
Unsupported Media Type
webcrank web server")
-- testEntityTooLarge = resp413 <@=?> runResource rs testRq where
-- rs = testResource { validEntityLength = value False }
-- resp413 = testResp requestEntityTooLarge413
-- [(hContentType, "text/html")]
-- (testBody "413 Request Entity Too LargeRequest Entity Too Large
Request Entity Too Large
webcrank web server")
-- testOptions = resp200 <@=?> runResource rs rq where
-- hdrs = [("X-Test", "1, 2, 3")]
-- rs = testResource { allowedMethods = return [methodGet, methodOptions], options = return hdrs }
-- rq = testRq { testRqMethod = methodOptions }
-- resp200 = testResp ok200 hdrs Nothing
-- testNoAcceptableMediaType = resp406 <@=?> runResource testResource rq where
-- rq = testRq { testRqHeaders = [(hAccept, "text/plain")] }
-- resp406 = testResp notAcceptable406
-- [(hContentType, "text/html")]
-- (testBody "406 Not AcceptableNot Acceptable
No acceptable media type available
webcrank web server")
-- testNoAcceptableCharset = resp406 <@=?> runResource testResource rq where
-- rq = testRq { testRqHeaders = [("Accept-Charset", "utf-16")] }
-- resp406 = testResp notAcceptable406
-- [(hContentType, "text/html")]
-- (testBody "406 Not AcceptableNot Acceptable
No acceptable charset available
webcrank web server")