@@ -0,0 +1,305 @@
1+module Test.PublicSurfaceTest where
2+
3+import Prelude
4+
5+import Data.Array (length)
6+import Data.Either (Either(..))
7+import Data.Generic.Rep (class Generic)
8+import Data.Maybe (Maybe(..))
9+import Data.Undefined.NoProblem (opt)
10+import Data.String as String
11+import Data.Variant (Variant)
12+import Data.Variant as Variant
13+import Effect (Effect)
14+import Effect.Aff (Aff)
15+import Foreign.Object as FObject
16+import Type.Function (type (#))
17+import Type.Proxy (Proxy(..))
18+import ViTest (ViTest, describe, test)
19+import ViTest.Expect (expectToBe)
20+import Yoga.HTTP.API.Path (Capture, Lit, Path, Required, Root, parseParam, parsePath, pathPattern, type (/), type (:), type (:?))
21+import Yoga.HTTP.API.Route (ApiKeyCookie(..), ApiKeyHeader(..), BasicAuth(..), BearerToken(..), CustomContentType, DELETE, Deprecated, DigestAuth(..), Enum, Example, Format, FormData, GET, JSON, MaxLength, Maximum, MinLength, Minimum, MultipartFormData, NoBody, NoRequest, Nullable, PATCH, POST, PUT, PlainText, QUERY, Response(..), Route, Schema, Title, XML, apiHandlers, buildOpenAPISpec', default, deprecated, description, enum, example, format, headerValueType, maxLength, maximum, minLength, minimum, mkHandler, nullable, options, parseHeader, pattern, printHeader, runHandler, statusCodeFor, statusCodeToString, title)
22+import Yoga.HTTP.API.Route.Handler (Request, class EncodingBody)
23+import Yoga.HTTP.API.Route.HeaderError (HeaderError(..))
24+import Yoga.HTTP.API.Route.OpenAPI (detectCookieSecurity, detectSecurity, getContentType, renderCookieParamsSchema, renderHeadersSchema, renderJSONSchema, renderPathParamsSchema, renderQueryParamsSchema, renderRequestBodySchema, renderResponseHeadersSchema)
25+import Yoga.HTTP.API.Route.OpenAPIMetadata (Description, Default, Pattern, links, type (:#))
26+import Yoga.HTTP.API.Route.RenderMethod (renderMethod)
27+import Yoga.HTTP.API.Route.Response (ok, respondNoBody, respondNoContent, respondNotModified, respondNothing, respondStatus, respondStatusWith)
28+import Yoga.HTTP.API.Route.RouteHandler (Handler)
29+import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap)
30+import Yoga.JSON (writeJSON)
31+
32+data Access = Guest | Member | Admin
33+
34+derive instance Generic Access _
35+
36+expectEqual :: forall a. Eq a => Show a => a -> a -> Aff Unit
37+expectEqual expected actual = expectToBe (show expected) (show actual)
38+
39+code :: forall @label. StatusCodeMap label => String
40+code = statusCodeToString (statusCodeFor (Proxy :: Proxy label))
41+
42+decodeBody :: forall encoding body. EncodingBody encoding body => Proxy encoding -> body -> body
43+decodeBody _ = identity
44+
45+type HandlerRoute =
46+ Route GET
47+ (Path ("items" / "id" : Int) :? { limit :: Required Int, search :: String })
48+ { headers :: { requestId :: String }, body :: JSON { suffix :: String } }
49+ (ok :: { body :: String })
50+
51+handler :: Handler HandlerRoute
52+handler = mkHandler \{ path, query, headers, body } ->
53+ pure $ ok (headers.requestId <> ":" <> show path.id <> ":" <> show query.limit <> ":" <> show query.search <> ":" <> body.suffix)
54+
55+type WrappedHandlerRoute =
56+ Route POST "wrapped" (Request { body :: FormData String }) (ok :: { body :: String })
57+
58+wrappedHandler :: Handler WrappedHandlerRoute
59+wrappedHandler = mkHandler \{ body } -> pure $ ok body
60+
61+type NoRequestRoute =
62+ Route GET Root NoRequest (ok :: { body :: String })
63+
64+noRequestHandler :: Handler NoRequestRoute
65+noRequestHandler = mkHandler \_ -> pure $ ok "healthy"
66+
67+type ServerAPI =
68+ { health :: NoRequestRoute }
69+
70+testMethodsAndPaths :: Effect ViTest
71+testMethodsAndPaths = describe "public methods and paths" do
72+ _ <- test "renders every method token" do
73+ expectEqual
74+ [ "get", "post", "put", "delete", "patch", "query" ]
75+ [ renderMethod (Proxy :: Proxy GET)
76+ , renderMethod (Proxy :: Proxy POST)
77+ , renderMethod (Proxy :: Proxy PUT)
78+ , renderMethod (Proxy :: Proxy DELETE)
79+ , renderMethod (Proxy :: Proxy PATCH)
80+ , renderMethod (Proxy :: Proxy QUERY)
81+ ]
82+
83+ _ <- test "renders root, literal, capture, sugar, wrapped, and query paths" do
84+ expectEqual
85+ [ "/", "/", "/users", "/:id", "/users/:id/posts", "/users/:id", "/users/:id" ]
86+ [ pathPattern (Proxy :: Proxy Root)
87+ , pathPattern (Proxy :: Proxy "/")
88+ , pathPattern (Proxy :: Proxy (Lit "users"))
89+ , pathPattern (Proxy :: Proxy (Capture "id" Int))
90+ , pathPattern (Proxy :: Proxy (Path (Lit "users" / Capture "id" Int / Lit "posts")))
91+ , pathPattern (Proxy :: Proxy (Path ("users" / "id" : Int)))
92+ , pathPattern (Proxy :: Proxy (Path ("users" / "id" : Int) :? { q :: String }))
93+ ]
94+
95+ _ <- test "parses primitive parameters and rejects malformed values" do
96+ expectEqual (Right "") (parseParam "" :: Either String String)
97+ expectEqual (Right 42) (parseParam "42" :: Either String Int)
98+ expectEqual (Left "Expected an integer but got: 4.2") (parseParam "4.2" :: Either String Int)
99+ expectEqual (Right 4.2) (parseParam "4.2" :: Either String Number)
100+ expectEqual (Left "Expected a number but got: nope") (parseParam "nope" :: Either String Number)
101+
102+ test "parses exact paths into correctly named captures" do
103+ expectEqual (Just {}) (parsePath (Proxy :: Proxy (Path Root)) "/")
104+ expectEqual Nothing (parsePath (Proxy :: Proxy (Path Root)) "")
105+ expectEqual (Just {}) (parsePath (Proxy :: Proxy (Path (Lit "users"))) "/users")
106+ expectEqual Nothing (parsePath (Proxy :: Proxy (Path (Lit "users"))) "/posts")
107+ expectEqual (Just { id: 7 }) (parsePath (Proxy :: Proxy (Path (Capture "id" Int))) "/7")
108+ expectEqual Nothing (parsePath (Proxy :: Proxy (Path (Capture "id" Int))) "/bad")
109+ expectEqual (Just { id: 7 }) (parsePath (Proxy :: Proxy (Path (Lit "users" / Capture "id" Int))) "/users/7")
110+ expectEqual Nothing (parsePath (Proxy :: Proxy (Path (Lit "users" / Capture "id" Int))) "/users/7/extra")
111+
112+testHeadersAndAuth :: Effect ViTest
113+testHeadersAndAuth = describe "header values, errors, and authentication" do
114+ _ <- test "roundtrips strings, integers, and optional headers" do
115+ expectEqual (Right "alpha") (parseHeader "alpha" :: Either String String)
116+ expectEqual "alpha" (printHeader "alpha")
117+ expectEqual (Right 12) (parseHeader "12" :: Either String Int)
118+ expectEqual (Left "not a valid integer (got: twelve)") (parseHeader "twelve" :: Either String Int)
119+ expectEqual "12" (printHeader 12)
120+ expectEqual (Right (Just 12)) (parseHeader "12" :: Either String (Maybe Int))
121+ expectEqual (Right Nothing) (parseHeader "twelve" :: Either String (Maybe Int))
122+ expectEqual "" (printHeader (Nothing :: Maybe Int))
123+
124+ _ <- test "validates and roundtrips every authentication header type" do
125+ expectEqual (Right (BearerToken "token")) (parseHeader "Bearer token" :: Either String BearerToken)
126+ expectEqual (Left "missing 'Bearer ' prefix") (parseHeader "bearer token" :: Either String BearerToken)
127+ expectEqual "Bearer token" (printHeader (BearerToken "token"))
128+ expectEqual (Right (BasicAuth "dXNlcjpwYXNz")) (parseHeader "Basic dXNlcjpwYXNz" :: Either String BasicAuth)
129+ expectEqual (Left "missing 'Basic ' prefix") (parseHeader "dXNlcjpwYXNz" :: Either String BasicAuth)
130+ expectEqual "Basic dXNlcjpwYXNz" (printHeader (BasicAuth "dXNlcjpwYXNz"))
131+ expectEqual (Right (ApiKeyHeader "key")) (parseHeader "key" :: Either String ApiKeyHeader)
132+ expectEqual "key" (printHeader (ApiKeyHeader "key"))
133+ expectEqual (Right (ApiKeyCookie "session")) (parseHeader "session" :: Either String ApiKeyCookie)
134+ expectEqual "session" (printHeader (ApiKeyCookie "session"))
135+ expectEqual (Right (DigestAuth "Digest realm=api")) (parseHeader "Digest realm=api" :: Either String DigestAuth)
136+ expectEqual (Left "missing 'Digest ' prefix") (parseHeader "realm=api" :: Either String DigestAuth)
137+ expectEqual "Digest realm=api" (printHeader (DigestAuth "Digest realm=api"))
138+
139+ test "distinguishes missing headers from invalid values" do
140+ expectEqual "Missing required header: x-request-id" (show (MissingHeader "x-request-id"))
141+ expectEqual "Invalid header 'content-length': not an integer" (show (InvalidHeaderValue "content-length" "not an integer"))
142+ expectToBe true (MissingHeader "x" /= InvalidHeaderValue "x" "missing")
143+
144+testStatusesAndResponses :: Effect ViTest
145+testStatusesAndResponses = describe "status and response constructors" do
146+ _ <- test "maps every public status label" do
147+ expectEqual
148+ [ "100", "101", "102", "103"
149+ , "200", "201", "202", "203", "204", "205", "206", "207", "208", "226"
150+ , "300", "301", "302", "303", "304", "305", "307", "308"
151+ , "400", "401", "402", "403", "404", "405", "406", "407", "408", "409", "410", "411", "412", "413", "414", "415", "416", "417", "418", "421", "422", "423", "424", "425", "426", "428", "429", "431", "451"
152+ , "500", "501", "502", "503", "504", "505", "506", "507", "508", "510", "511"
153+ ]
154+ [ code @"continue", code @"switchingProtocols", code @"processing", code @"earlyHints"
155+ , code @"ok", code @"created", code @"accepted", code @"nonAuthoritativeInformation", code @"noContent", code @"resetContent", code @"partialContent", code @"multiStatus", code @"alreadyReported", code @"imUsed"
156+ , code @"multipleChoices", code @"movedPermanently", code @"found", code @"seeOther", code @"notModified", code @"useProxy", code @"temporaryRedirect", code @"permanentRedirect"
157+ , code @"badRequest", code @"unauthorized", code @"paymentRequired", code @"forbidden", code @"notFound", code @"methodNotAllowed", code @"notAcceptable", code @"proxyAuthenticationRequired", code @"requestTimeout", code @"conflict", code @"gone", code @"lengthRequired", code @"preconditionFailed", code @"payloadTooLarge", code @"uriTooLong", code @"unsupportedMediaType", code @"rangeNotSatisfiable", code @"expectationFailed", code @"imATeapot", code @"misdirectedRequest", code @"unprocessableEntity", code @"locked", code @"failedDependency", code @"tooEarly", code @"upgradeRequired", code @"preconditionRequired", code @"tooManyRequests", code @"requestHeaderFieldsTooLarge", code @"unavailableForLegalReasons"
158+ , code @"internalServerError", code @"notImplemented", code @"badGateway", code @"serviceUnavailable", code @"gatewayTimeout", code @"httpVersionNotSupported", code @"variantAlsoNegotiates", code @"insufficientStorage", code @"loopDetected", code @"notExtended", code @"networkAuthenticationRequired"
159+ ]
160+
161+ _ <- test "constructs numeric responses with status-derived labels" do
162+ let
163+ plain :: Variant (ok :: Response () String)
164+ plain = respondStatus @200 "body"
165+ withHeaders :: Variant (created :: Response (location :: String) String)
166+ withHeaders = respondStatusWith @201 { location: "/items/1" } "created"
167+ expectEqual "body" (Variant.match { ok: \(Response r) -> r.body } plain)
168+ expectEqual "/items/1:created" (Variant.match { created: \(Response r) -> r.headers.location <> ":" <> r.body } withHeaders)
169+
170+ test "constructs bodyless and empty standard responses" do
171+ let
172+ bodyless :: Variant (noContent :: Response (etag :: String) Unit)
173+ bodyless = respondNoBody (Proxy :: Proxy "noContent") { etag: "v1" }
174+ nothing :: Variant (accepted :: Response () Unit)
175+ nothing = respondNothing @"accepted"
176+ noContentResponse :: Variant (noContent :: Response () Unit)
177+ noContentResponse = respondNoContent
178+ notModifiedResponse :: Variant (notModified :: Response () Unit)
179+ notModifiedResponse = respondNotModified
180+ expectEqual "v1" (Variant.match { noContent: \(Response r) -> r.headers.etag } bodyless)
181+ expectEqual unit (Variant.match { accepted: \(Response r) -> r.body } nothing)
182+ expectEqual unit (Variant.match { noContent: \(Response r) -> r.body } noContentResponse)
183+ expectEqual unit (Variant.match { notModified: \(Response r) -> r.body } notModifiedResponse)
184+
185+testMetadataAndOpenAPI :: Effect ViTest
186+testMetadataAndOpenAPI = describe "metadata and OpenAPI primitives" do
187+ _ <- test "extracts every composable schema metadata value" do
188+ let p = Proxy :: Proxy (String # Description "identifier" # Example "abc" # Format "uuid" # Minimum 1 # Maximum 9 # Pattern "^[a-z]+$" # MinLength 2 # MaxLength 8 # Title "Identifier" # Nullable # Default "abc" # Deprecated)
189+ expectEqual (Just "identifier") (description p)
190+ expectEqual (Just "abc") (example p)
191+ expectEqual (Just "uuid") (format p)
192+ expectEqual (Just 1) (minimum p)
193+ expectEqual (Just 9) (maximum p)
194+ expectEqual (Just "^[a-z]+$") (pattern p)
195+ expectEqual (Just 2) (minLength p)
196+ expectEqual (Just 8) (maxLength p)
197+ expectEqual (Just "Identifier") (title p)
198+ expectEqual true (nullable p)
199+ expectEqual (Just "abc") (default p)
200+ expectEqual true (deprecated p)
201+
202+ _ <- test "extracts generic enums and chained links" do
203+ expectEqual (Just [ "Guest", "Member", "Admin" ]) (enum (Proxy :: Proxy (Enum Access)))
204+ let
205+ metadata = links (Proxy :: Proxy (((((String :# "getItem") "getItemById" (id :: "$response.body#/id")) :# "getOwner") "getOwnerById" (id :: "$response.body#/ownerId"))))
206+ expectEqual 2 (length metadata)
207+ expectEqual [ "getOwner", "getItem" ] (map _.name metadata)
208+ expectEqual [ "getOwnerById", "getItemById" ] (map _.operationId metadata)
209+ expectToBe true (String.contains (String.Pattern "$response.body#/ownerId") (writeJSON metadata))
210+
211+ _ <- test "maps every request content encoding" do
212+ expectEqual
213+ [ "", "application/json", "application/x-www-form-urlencoded", "multipart/form-data", "text/plain", "application/xml", "application/vnd.test+json", "application/json" ]
214+ [ getContentType (Proxy :: Proxy NoBody)
215+ , getContentType (Proxy :: Proxy (JSON String))
216+ , getContentType (Proxy :: Proxy (FormData String))
217+ , getContentType (Proxy :: Proxy (MultipartFormData String))
218+ , getContentType (Proxy :: Proxy PlainText)
219+ , getContentType (Proxy :: Proxy (XML String))
220+ , getContentType (Proxy :: Proxy (CustomContentType "application/vnd.test+json" String))
221+ , getContentType (Proxy :: Proxy (Schema "Text" String))
222+ ]
223+
224+ _ <- test "unwraps every request encoding to its handler body" do
225+ expectEqual "json" (decodeBody (Proxy :: Proxy (JSON String)) "json")
226+ expectEqual "form" (decodeBody (Proxy :: Proxy (FormData String)) "form")
227+ expectEqual "multipart" (decodeBody (Proxy :: Proxy (MultipartFormData String)) "multipart")
228+ expectEqual "text" (decodeBody (Proxy :: Proxy PlainText) "text")
229+ expectEqual "xml" (decodeBody (Proxy :: Proxy (XML String)) "xml")
230+ expectEqual "custom" (decodeBody (Proxy :: Proxy (CustomContentType "application/vnd.test+json" String)) "custom")
231+
232+ _ <- test "reports header schema types through metadata wrappers" do
233+ expectEqual [ "string", "integer", "integer", "string" ]
234+ [ headerValueType (Proxy :: Proxy String)
235+ , headerValueType (Proxy :: Proxy Int)
236+ , headerValueType (Proxy :: Proxy (Maybe Int))
237+ , headerValueType (Proxy :: Proxy (Description "token" BearerToken))
238+ ]
239+
240+ _ <- test "builds explicit server metadata with buildOpenAPISpec'" do
241+ let
242+ document = buildOpenAPISpec' @ServerAPI
243+ (options { title: "Server API", version: "1.0.0" })
244+ { servers: opt [ { url: "https://api.example.test", description: Just "production" } ] }
245+ json = writeJSON document
246+ expectToBe true (String.contains (String.Pattern "\"servers\"") json)
247+ expectToBe true (String.contains (String.Pattern "https://api.example.test") json)
248+
249+ test "renders public OpenAPI schema and security seams" do
250+ expectEqual
251+ [ 0, 1, 1, 1, 2, 1, 0, 1, 1, 1 ]
252+ [ length (renderHeadersSchema (Proxy :: Proxy ()))
253+ , length (renderHeadersSchema (Proxy :: Proxy (requestId :: String)))
254+ , length (renderCookieParamsSchema (Proxy :: Proxy (theme :: String)))
255+ , length (renderPathParamsSchema (Proxy :: Proxy (id :: Int)))
256+ , length (renderQueryParamsSchema (Proxy :: Proxy (limit :: Int, search :: Maybe String)))
257+ , FObject.size (renderResponseHeadersSchema (Proxy :: Proxy (etag :: String)))
258+ , length (detectSecurity (Proxy :: Proxy (requestId :: String)))
259+ , length (detectSecurity (Proxy :: Proxy (authorization :: BearerToken, apiKey :: ApiKeyHeader)))
260+ , length (detectCookieSecurity (Proxy :: Proxy (session :: ApiKeyCookie)))
261+ , length (detectCookieSecurity (Proxy :: Proxy (primary :: ApiKeyCookie, secondary :: ApiKeyCookie)))
262+ ]
263+ case renderRequestBodySchema (Proxy :: Proxy NoBody) of
264+ Nothing -> expectToBe true true
265+ Just _ -> expectToBe "no request body" "unexpected request body"
266+ case renderRequestBodySchema (Proxy :: Proxy (JSON { name :: String })) of
267+ Nothing -> expectToBe "request body" "missing"
268+ Just body -> expectEqual true body.required
269+ expectToBe true (String.contains (String.Pattern "nullable") (writeJSON (renderJSONSchema (Proxy :: Proxy (Maybe String)))))
270+
271+testHandlers :: Effect ViTest
272+testHandlers = describe "route and API handler combinators" do
273+ _ <- test "mkHandler/runHandler preserve typed path, query, header, and body inputs" do
274+ response <- runHandler handler
275+ { path: { id: 7 }
276+ , query: { limit: 5, search: Just "red" }
277+ , headers: { requestId: "req" }
278+ , body: { suffix: "done" }
279+ }
280+ expectEqual "req:7:5:(Just \"red\"):done" (Variant.match { ok: \(Response r) -> r.body } response)
281+
282+ _ <- test "apiHandlers preserves a complete named handler record" do
283+ let handlers = apiHandlers @{ getItem :: HandlerRoute } { getItem: handler }
284+ response <- runHandler handlers.getItem
285+ { path: { id: 1 }
286+ , query: { limit: 2, search: Nothing }
287+ , headers: { requestId: "r" }
288+ , body: { suffix: "x" }
289+ }
290+ expectEqual "r:1:2:Nothing:x" (Variant.match { ok: \(Response r) -> r.body } response)
291+
292+ test "Request and NoRequest wrappers compute executable handler inputs" do
293+ wrapped <- runHandler wrappedHandler { path: {}, query: {}, headers: {}, body: "form body" }
294+ healthy <- runHandler noRequestHandler { path: {}, query: {}, headers: {}, body: unit }
295+ expectEqual "form body" (Variant.match { ok: \(Response r) -> r.body } wrapped)
296+ expectEqual "healthy" (Variant.match { ok: \(Response r) -> r.body } healthy)
297+
298+spec :: Effect ViTest
299+spec = do
300+ _ <- testMethodsAndPaths
301+ _ <- testHeadersAndAuth
302+ _ <- testStatusesAndResponses
303+ _ <- testMetadataAndOpenAPI
304+ testHandlers
305+