git.iko.soy/rowtype-yoga/purescript-yoga-http-api
on feat/custom-type-errors help sign in
feat: Add support for multiple authentication types (BasicAuth, ApiKey, DigestAuth)

- Create unified Auth module with all authentication types: - BearerToken (HTTP Bearer - already existed) - BasicAuth (HTTP Basic authentication) - ApiKeyHeader (API Key in header) - DigestAuth (HTTP Digest authentication) - Add DetectSecurityRL instances for all auth types to detect security requirements - Add RenderHeadersSchemaRL skip instances to exclude auth headers from regular parameters - Update buildSecuritySchemes to dynamically detect and include all used auth types - Add comprehensive tests for each authentication type - Update .gitignore to exclude .psci_modules - Export all auth types from main Route module All authentication types now correctly: - Appear only in OpenAPI security schemes (not as regular parameters) - Generate proper OpenAPI 3.0 security scheme definitions - Support metadata wrappers (Description, Example, Deprecated)

commit40ec00164c64dc42d4f680e72032e59ecb1ae179 authorMark <mark.eibes@gmail.com> dateSat 7 Feb 2026, 22:48 (8 months ago) parent7a05f46
7 files changed+423−63
.gitignore+1 src/Yoga/HTTP/API/Route.purs+2 src/Yoga/HTTP/API/Route/Auth.purs+114 src/Yoga/HTTP/API/Route/BearerToken.purs+2−34 src/Yoga/HTTP/API/Route/OpenAPI.purs+192−14 test/BearerAuthTest.Spec.purs+107−14 test/Test.Operators.purs+5−1
.gitignore+1
@@ -5,3 +5,4 @@ output-test
55node_modules
66.purs-repl
77.psc-ide-port
8+.psci_modules
src/Yoga/HTTP/API/Route.purs+2
@@ -5,6 +5,7 @@ module Yoga.HTTP.API.Route
55 , module Yoga.HTTP.API.Route.StatusCode
66 , module Yoga.HTTP.API.Route.HeaderError
77 , module Yoga.HTTP.API.Route.HeaderValue
8+ , module Yoga.HTTP.API.Route.Auth
89 , module Yoga.HTTP.API.Route.BearerToken
910 , module Yoga.HTTP.API.Route.Response
1011 , module Yoga.HTTP.API.Route.Handler
@@ -15,6 +16,7 @@ module Yoga.HTTP.API.Route
1516 ) where
1617
1718import Yoga.HTTP.API.Path (Path, Root, Lit, Capture, PathCons, Param, QueryParams, Required, type (/), type (:), type (:?), class PathPattern, pathPattern, class ParseParam, parseParam, class ParsePath, parsePath)
19+import Yoga.HTTP.API.Route.Auth (BearerToken(..), BasicAuth(..), ApiKeyHeader(..), DigestAuth(..))
1820import Yoga.HTTP.API.Route.BearerToken (BearerToken(..))
1921import Yoga.HTTP.API.Route.Encoding (JSON, FormData, NoBody)
2022import Yoga.HTTP.API.Route.Handler (HandlerFn, Request)
src/Yoga/HTTP/API/Route/Auth.pursnew file+114
@@ -0,0 +1,114 @@
1+module Yoga.HTTP.API.Route.Auth
2+ ( BearerToken(..)
3+ , BasicAuth(..)
4+ , ApiKeyHeader(..)
5+ , DigestAuth(..)
6+ ) where
7+
8+import Prelude
9+
10+import Data.Either (Either(..))
11+import Data.Newtype (class Newtype)
12+import Data.String as String
13+import Yoga.HTTP.API.Route.HeaderValue (class HeaderValue, class HeaderValueType)
14+
15+--------------------------------------------------------------------------------
16+-- BearerToken
17+--------------------------------------------------------------------------------
18+
19+-- | Bearer token newtype that validates the "Bearer " prefix
20+-- |
21+-- | Example:
22+-- | parseHeader "Bearer abc123" :: Either String BearerToken
23+-- | = Right (BearerToken "abc123")
24+-- | parseHeader "abc123" :: Either String BearerToken
25+-- | = Left "missing 'Bearer ' prefix"
26+newtype BearerToken = BearerToken String
27+
28+derive instance Eq BearerToken
29+derive newtype instance Show BearerToken
30+derive instance Newtype BearerToken _
31+
32+instance HeaderValue BearerToken where
33+ parseHeader s =
34+ if String.take 7 s == "Bearer " then Right $ BearerToken $ String.drop 7 s
35+ else Left "missing 'Bearer ' prefix"
36+
37+ printHeader (BearerToken token) = "Bearer " <> token
38+
39+instance HeaderValueType BearerToken where
40+ headerValueType _ = "string"
41+
42+--------------------------------------------------------------------------------
43+-- BasicAuth
44+--------------------------------------------------------------------------------
45+
46+-- | Basic authentication header value (Base64-encoded credentials)
47+-- |
48+-- | Example:
49+-- | parseHeader "Basic dXNlcjpwYXNz" :: Either String BasicAuth
50+-- | = Right (BasicAuth "dXNlcjpwYXNz")
51+-- |
52+-- | The raw Base64-encoded credentials are preserved for server-side verification
53+newtype BasicAuth = BasicAuth String
54+
55+derive instance Eq BasicAuth
56+derive newtype instance Show BasicAuth
57+derive instance Newtype BasicAuth _
58+
59+instance HeaderValue BasicAuth where
60+ parseHeader s =
61+ if String.take 6 s == "Basic " then Right $ BasicAuth $ String.drop 6 s
62+ else Left "missing 'Basic ' prefix"
63+
64+ printHeader (BasicAuth credentials) = "Basic " <> credentials
65+
66+instance HeaderValueType BasicAuth where
67+ headerValueType _ = "string"
68+
69+--------------------------------------------------------------------------------
70+-- ApiKeyHeader
71+--------------------------------------------------------------------------------
72+
73+-- | API Key passed in a custom header
74+-- |
75+-- | Example:
76+-- | parseHeader "abc123" :: Either String ApiKeyHeader
77+-- | = Right (ApiKeyHeader "abc123")
78+newtype ApiKeyHeader = ApiKeyHeader String
79+
80+derive instance Eq ApiKeyHeader
81+derive newtype instance Show ApiKeyHeader
82+derive instance Newtype ApiKeyHeader _
83+
84+instance HeaderValue ApiKeyHeader where
85+ parseHeader = Right <<< ApiKeyHeader
86+ printHeader (ApiKeyHeader key) = key
87+
88+instance HeaderValueType ApiKeyHeader where
89+ headerValueType _ = "string"
90+
91+--------------------------------------------------------------------------------
92+-- DigestAuth
93+--------------------------------------------------------------------------------
94+
95+-- | Digest authentication header value
96+-- |
97+-- | Example:
98+-- | parseHeader "Digest username=\"user\", realm=\"api\", ..." :: Either String DigestAuth
99+-- | = Right (DigestAuth "Digest username=\"user\", realm=\"api\", ...")
100+newtype DigestAuth = DigestAuth String
101+
102+derive instance Eq DigestAuth
103+derive newtype instance Show DigestAuth
104+derive instance Newtype DigestAuth _
105+
106+instance HeaderValue DigestAuth where
107+ parseHeader s =
108+ if String.take 7 s == "Digest " then Right $ DigestAuth s
109+ else Left "missing 'Digest ' prefix"
110+
111+ printHeader (DigestAuth value) = value
112+
113+instance HeaderValueType DigestAuth where
114+ headerValueType _ = "string"
src/Yoga/HTTP/API/Route/BearerToken.purs+2−34
@@ -1,37 +1,5 @@
11module Yoga.HTTP.API.Route.BearerToken
2− ( BearerToken(..)
2+ ( module Exports
33 ) where
44
5−import Prelude
6−
7−import Data.Either (Either(..))
8−import Data.Newtype (class Newtype)
9−import Data.String as String
10−import Yoga.HTTP.API.Route.HeaderValue (class HeaderValue, class HeaderValueType)
11−
12−--------------------------------------------------------------------------------
13−-- BearerToken
14−--------------------------------------------------------------------------------
15−
16−-- | Bearer token newtype that validates the "Bearer " prefix
17−-- |
18−-- | Example:
19−-- | parseHeader "Bearer abc123" :: Either String BearerToken
20−-- | = Right (BearerToken "abc123")
21−-- | parseHeader "abc123" :: Either String BearerToken
22−-- | = Left "missing 'Bearer ' prefix"
23−newtype BearerToken = BearerToken String
24−
25−derive instance Eq BearerToken
26−derive newtype instance Show BearerToken
27−derive instance Newtype BearerToken _
28−
29−instance HeaderValue BearerToken where
30− parseHeader s =
31− if String.take 7 s == "Bearer " then Right $ BearerToken $ String.drop 7 s
32− else Left "missing 'Bearer ' prefix"
33−
34− printHeader (BearerToken token) = "Bearer " <> token
35−
36−instance HeaderValueType BearerToken where
37− headerValueType _ = "string"
5+import Yoga.HTTP.API.Route.Auth (BearerToken(..)) as Exports
src/Yoga/HTTP/API/Route/OpenAPI.purs+192−14
@@ -66,8 +66,10 @@ module Yoga.HTTP.API.Route.OpenAPI
6666
6767import Prelude
6868
69+import Data.Array as Array
6970import Data.Foldable (foldl)
7071import Data.Maybe (Maybe(..), maybe)
72+import Data.String as String
7173import Data.String.Regex (replace)
7274import Data.String.Regex.Flags (global)
7375import Data.String.Regex.Unsafe (unsafeRegex)
@@ -80,7 +82,7 @@ import Prim.RowList (class RowToList, RowList, Cons, Nil)
8082import Prim.RowList as RL
8183import Type.Proxy (Proxy(..))
8284import Unsafe.Coerce (unsafeCoerce)
83−import Yoga.HTTP.API.Route.BearerToken (BearerToken)
85+import Yoga.HTTP.API.Route.Auth (BearerToken, BasicAuth, ApiKeyHeader, DigestAuth)
8486import Yoga.HTTP.API.Route.Encoding (JSON, FormData, NoBody)
8587import Yoga.HTTP.API.Route.HeaderValue (class HeaderValueType, headerValueType)
8688import Yoga.HTTP.API.Route.OpenAPIMetadata (Description, Example, Format, Minimum, Maximum, Pattern, MinLength, MaxLength, Title, Nullable, Default, Deprecated, Enum, Schema, class HasDescription, description, class HasExample, example, class HasFormat, format, class HasDeprecated, deprecated, class HasMinimum, minimum, class HasMaximum, maximum, class HasPattern, pattern, class HasMinLength, minLength, class HasMaxLength, maxLength, class HasTitle, title, class HasNullable, nullable, class HasDefault, default, class HasEnum, enum, class HasOperationMetadata, operationMetadata)
@@ -187,6 +189,54 @@ else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Example ex Bea
187189else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Deprecated BearerToken) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Deprecated BearerToken) tail) headers where
188190 renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
189191
192+-- Skip BasicAuth headers (they're handled as security schemes, not regular headers)
193+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name BasicAuth tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name BasicAuth tail) headers where
194+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
195+
196+-- Skip BasicAuth wrapped in Description
197+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Description desc BasicAuth) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Description desc BasicAuth) tail) headers where
198+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
199+
200+-- Skip BasicAuth wrapped in Example
201+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Example ex BasicAuth) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Example ex BasicAuth) tail) headers where
202+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
203+
204+-- Skip BasicAuth wrapped in Deprecated
205+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Deprecated BasicAuth) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Deprecated BasicAuth) tail) headers where
206+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
207+
208+-- Skip ApiKeyHeader headers (they're handled as security schemes, not regular headers)
209+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name ApiKeyHeader tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name ApiKeyHeader tail) headers where
210+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
211+
212+-- Skip ApiKeyHeader wrapped in Description
213+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Description desc ApiKeyHeader) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Description desc ApiKeyHeader) tail) headers where
214+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
215+
216+-- Skip ApiKeyHeader wrapped in Example
217+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Example ex ApiKeyHeader) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Example ex ApiKeyHeader) tail) headers where
218+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
219+
220+-- Skip ApiKeyHeader wrapped in Deprecated
221+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Deprecated ApiKeyHeader) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Deprecated ApiKeyHeader) tail) headers where
222+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
223+
224+-- Skip DigestAuth headers (they're handled as security schemes, not regular headers)
225+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name DigestAuth tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name DigestAuth tail) headers where
226+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
227+
228+-- Skip DigestAuth wrapped in Description
229+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Description desc DigestAuth) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Description desc DigestAuth) tail) headers where
230+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
231+
232+-- Skip DigestAuth wrapped in Example
233+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Example ex DigestAuth) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Example ex DigestAuth) tail) headers where
234+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
235+
236+-- Skip DigestAuth wrapped in Deprecated
237+else instance (RenderHeadersSchemaRL tail tailRow, Row.Cons name (Deprecated DigestAuth) tailRow headers, Row.Lacks name tailRow) => RenderHeadersSchemaRL (RL.Cons name (Deprecated DigestAuth) tail) headers where
238+ renderHeadersSchemaRL _ = renderHeadersSchemaRL (Proxy :: Proxy tail)
239+
190240-- Required header (non-Maybe type)
191241else instance
192242 ( IsSymbol name
@@ -290,6 +340,106 @@ else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Deprecate
290340 in
291341 [ bearerAuth ]
292342
343+-- Case: BasicAuth found
344+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name BasicAuth tail) where
345+ detectSecurityRL _ =
346+ let
347+ basicAuth = unsafeCoerce $ FObject.singleton "basicAuth" ([] :: Array String)
348+ in
349+ [ basicAuth ]
350+
351+-- Case: BasicAuth wrapped in Description
352+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Description desc BasicAuth) tail) where
353+ detectSecurityRL _ =
354+ let
355+ basicAuth = unsafeCoerce $ FObject.singleton "basicAuth" ([] :: Array String)
356+ in
357+ [ basicAuth ]
358+
359+-- Case: BasicAuth wrapped in Example
360+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Example ex BasicAuth) tail) where
361+ detectSecurityRL _ =
362+ let
363+ basicAuth = unsafeCoerce $ FObject.singleton "basicAuth" ([] :: Array String)
364+ in
365+ [ basicAuth ]
366+
367+-- Case: BasicAuth wrapped in Deprecated
368+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Deprecated BasicAuth) tail) where
369+ detectSecurityRL _ =
370+ let
371+ basicAuth = unsafeCoerce $ FObject.singleton "basicAuth" ([] :: Array String)
372+ in
373+ [ basicAuth ]
374+
375+-- Case: ApiKeyHeader found
376+else instance (DetectSecurityRL tail, IsSymbol name) => DetectSecurityRL (RL.Cons name ApiKeyHeader tail) where
377+ detectSecurityRL _ =
378+ let
379+ keyName = reflectSymbol (Proxy :: Proxy name)
380+ apiKeyAuth = unsafeCoerce $ FObject.singleton (keyName <> "ApiKey") ([] :: Array String)
381+ in
382+ [ apiKeyAuth ]
383+
384+-- Case: ApiKeyHeader wrapped in Description
385+else instance (DetectSecurityRL tail, IsSymbol name) => DetectSecurityRL (RL.Cons name (Description desc ApiKeyHeader) tail) where
386+ detectSecurityRL _ =
387+ let
388+ keyName = reflectSymbol (Proxy :: Proxy name)
389+ apiKeyAuth = unsafeCoerce $ FObject.singleton (keyName <> "ApiKey") ([] :: Array String)
390+ in
391+ [ apiKeyAuth ]
392+
393+-- Case: ApiKeyHeader wrapped in Example
394+else instance (DetectSecurityRL tail, IsSymbol name) => DetectSecurityRL (RL.Cons name (Example ex ApiKeyHeader) tail) where
395+ detectSecurityRL _ =
396+ let
397+ keyName = reflectSymbol (Proxy :: Proxy name)
398+ apiKeyAuth = unsafeCoerce $ FObject.singleton (keyName <> "ApiKey") ([] :: Array String)
399+ in
400+ [ apiKeyAuth ]
401+
402+-- Case: ApiKeyHeader wrapped in Deprecated
403+else instance (DetectSecurityRL tail, IsSymbol name) => DetectSecurityRL (RL.Cons name (Deprecated ApiKeyHeader) tail) where
404+ detectSecurityRL _ =
405+ let
406+ keyName = reflectSymbol (Proxy :: Proxy name)
407+ apiKeyAuth = unsafeCoerce $ FObject.singleton (keyName <> "ApiKey") ([] :: Array String)
408+ in
409+ [ apiKeyAuth ]
410+
411+-- Case: DigestAuth found
412+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name DigestAuth tail) where
413+ detectSecurityRL _ =
414+ let
415+ digestAuth = unsafeCoerce $ FObject.singleton "digestAuth" ([] :: Array String)
416+ in
417+ [ digestAuth ]
418+
419+-- Case: DigestAuth wrapped in Description
420+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Description desc DigestAuth) tail) where
421+ detectSecurityRL _ =
422+ let
423+ digestAuth = unsafeCoerce $ FObject.singleton "digestAuth" ([] :: Array String)
424+ in
425+ [ digestAuth ]
426+
427+-- Case: DigestAuth wrapped in Example
428+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Example ex DigestAuth) tail) where
429+ detectSecurityRL _ =
430+ let
431+ digestAuth = unsafeCoerce $ FObject.singleton "digestAuth" ([] :: Array String)
432+ in
433+ [ digestAuth ]
434+
435+-- Case: DigestAuth wrapped in Deprecated
436+else instance DetectSecurityRL tail => DetectSecurityRL (RL.Cons name (Deprecated DigestAuth) tail) where
437+ detectSecurityRL _ =
438+ let
439+ digestAuth = unsafeCoerce $ FObject.singleton "digestAuth" ([] :: Array String)
440+ in
441+ [ digestAuth ]
442+
293443-- Case: Non-security header, recurse
294444else instance (DetectSecurityRL tail, HeaderValueType ty) => DetectSecurityRL (RL.Cons name ty tail) where
295445 detectSecurityRL _ = detectSecurityRL (Proxy :: Proxy tail)
@@ -1237,32 +1387,60 @@ foreign import data OpenAPISpec :: Type
12371387instance WriteForeign OpenAPISpec where
12381388 writeImpl = unsafeCoerce
12391389
1240−-- | Detect if any operations use bearer token authentication
1390+-- | Detect which security schemes are used across all operations
12411391-- | and build the securitySchemes component
12421392buildSecuritySchemes :: Array OperationEntry -> FObject.Object Foreign
12431393buildSecuritySchemes ops =
12441394 let
1245− hasSecurity = ops # foldl checkOp false
1395+ securityKeys = ops # foldl collectSecurityKeys []
12461396 where
1247− checkOp acc entry =
1397+ collectSecurityKeys acc entry =
12481398 let
12491399 opObj = unsafeCoerce (unsafeParseJSON entry.operation) :: FObject.Object Foreign
12501400 securityField = FObject.lookup "security" opObj
12511401 in
1252− acc || case securityField of
1253− Nothing -> false
1254− Just _ -> true
1255− in
1256− if hasSecurity then
1257− FObject.singleton "bearerAuth"
1258− ( unsafeCoerce
1402+ case securityField of
1403+ Nothing -> acc
1404+ Just secArray ->
1405+ let
1406+ secList = unsafeCoerce secArray :: Array (FObject.Object Foreign)
1407+ keys = secList >>= FObject.keys
1408+ in
1409+ acc <> keys
1410+
1411+ uniqueKeys = Array.nub securityKeys
1412+ schemes = uniqueKeys <#> \key ->
1413+ let
1414+ scheme = case key of
1415+ "bearerAuth" -> Just $ Tuple key $ unsafeCoerce
12591416 { type: "http"
12601417 , scheme: "bearer"
12611418 , bearerFormat: "JWT"
12621419 }
1263− )
1264− else
1265− FObject.empty
1420+ "basicAuth" -> Just $ Tuple key $ unsafeCoerce
1421+ { type: "http"
1422+ , scheme: "basic"
1423+ }
1424+ "digestAuth" -> Just $ Tuple key $ unsafeCoerce
1425+ { type: "http"
1426+ , scheme: "digest"
1427+ }
1428+ _ ->
1429+ -- API Key (header names ending with "ApiKey")
1430+ if String.take (String.length key - 6) key /= "" && String.drop (String.length key - 6) key == "ApiKey" then
1431+ let
1432+ headerName = String.take (String.length key - 6) key
1433+ in
1434+ Just $ Tuple key $ unsafeCoerce
1435+ { type: "apiKey"
1436+ , in: "header"
1437+ , name: headerName
1438+ }
1439+ else Nothing
1440+ in
1441+ scheme
1442+ in
1443+ FObject.fromFoldable $ Array.catMaybes schemes
12661444
12671445-- | Type for OpenAPI server object
12681446type ServerObject =
test/BearerAuthTest.Spec.purs+107−14
@@ -5,42 +5,135 @@ import Prelude
55import Data.String as String
66import Effect (Effect)
77import Yoga.HTTP.API.Path (Path, Lit)
8−import Yoga.HTTP.API.Route (GET, Route, Request, BearerToken, buildOpenAPISpec)
8+import Yoga.HTTP.API.Route (GET, Route, Request, buildOpenAPISpec)
9+import Yoga.HTTP.API.Route.Auth (BearerToken, BasicAuth, ApiKeyHeader, DigestAuth)
910import Yoga.JSON (writeJSON)
1011import ViTest (ViTest, describe, test)
1112import ViTest.Expect (expectToBe)
1213
1314--------------------------------------------------------------------------------
14−-- Test API with BearerToken
15+-- Test APIs with different authentication types
1516--------------------------------------------------------------------------------
1617
17−type AuthAPI =
18+type BearerAuthAPI =
1819 { getProtected :: Route GET (Path (Lit "protected")) (Request { headers :: { authorization :: BearerToken } }) (ok :: { body :: { message :: String } })
1920 }
2021
22+type BasicAuthAPI =
23+ { getProtected :: Route GET (Path (Lit "protected")) (Request { headers :: { authorization :: BasicAuth } }) (ok :: { body :: { message :: String } })
24+ }
25+
26+type ApiKeyAPI =
27+ { getProtected :: Route GET (Path (Lit "protected")) (Request { headers :: { apiKey :: ApiKeyHeader } }) (ok :: { body :: { message :: String } })
28+ }
29+
30+type DigestAuthAPI =
31+ { getProtected :: Route GET (Path (Lit "protected")) (Request { headers :: { authorization :: DigestAuth } }) (ok :: { body :: { message :: String } })
32+ }
33+
34+type MultiAuthAPI =
35+ { bearerEndpoint :: Route GET (Path (Lit "bearer")) (Request { headers :: { authorization :: BearerToken } }) (ok :: { body :: { message :: String } })
36+ , basicEndpoint :: Route GET (Path (Lit "basic")) (Request { headers :: { authorization :: BasicAuth } }) (ok :: { body :: { message :: String } })
37+ , apiKeyEndpoint :: Route GET (Path (Lit "apikey")) (Request { headers :: { xApiKey :: ApiKeyHeader } }) (ok :: { body :: { message :: String } })
38+ }
39+
2140--------------------------------------------------------------------------------
2241-- Tests
2342--------------------------------------------------------------------------------
2443
25−testBearerTokenNotInHeaders :: Effect ViTest
26−testBearerTokenNotInHeaders = describe "BearerToken in OpenAPI" do
44+testBearerTokenAuth :: Effect ViTest
45+testBearerTokenAuth = describe "BearerToken Authentication" do
2746 _ <- test "BearerToken does not appear as a regular header parameter" do
28− let spec = buildOpenAPISpec @AuthAPI { title: "Auth API", version: "1.0.0" }
47+ let spec = buildOpenAPISpec @BearerAuthAPI { title: "Auth API", version: "1.0.0" }
2948 let json = writeJSON spec
30− -- Authorization should NOT appear in parameters array
3149 let hasAuthParam = String.contains (String.Pattern "\"name\":\"authorization\"") json
3250 expectToBe false hasAuthParam
3351
3452 _ <- test "BearerToken appears in security requirements" do
35− let spec = buildOpenAPISpec @AuthAPI { title: "Auth API", version: "1.0.0" }
53+ let spec = buildOpenAPISpec @BearerAuthAPI { title: "Auth API", version: "1.0.0" }
3654 let json = writeJSON spec
37− -- Should contain bearerAuth security reference
3855 let hasBearerAuth = String.contains (String.Pattern "bearerAuth") json
3956 expectToBe true hasBearerAuth
4057
41− test "OpenAPI spec contains securitySchemes component" do
42− let spec = buildOpenAPISpec @AuthAPI { title: "Auth API", version: "1.0.0" }
58+ test "BearerToken security scheme has correct structure" do
59+ let spec = buildOpenAPISpec @BearerAuthAPI { title: "Auth API", version: "1.0.0" }
60+ let json = writeJSON spec
61+ expectToBe true (String.contains (String.Pattern "\"type\":\"http\"") json)
62+ expectToBe true (String.contains (String.Pattern "\"scheme\":\"bearer\"") json)
63+
64+testBasicAuth :: Effect ViTest
65+testBasicAuth = describe "BasicAuth Authentication" do
66+ _ <- test "BasicAuth does not appear as a regular header parameter" do
67+ let spec = buildOpenAPISpec @BasicAuthAPI { title: "Auth API", version: "1.0.0" }
68+ let json = writeJSON spec
69+ let hasAuthParam = String.contains (String.Pattern "\"name\":\"authorization\"") json
70+ expectToBe false hasAuthParam
71+
72+ _ <- test "BasicAuth appears in security requirements" do
73+ let spec = buildOpenAPISpec @BasicAuthAPI { title: "Auth API", version: "1.0.0" }
74+ let json = writeJSON spec
75+ let hasBasicAuth = String.contains (String.Pattern "basicAuth") json
76+ expectToBe true hasBasicAuth
77+
78+ test "BasicAuth security scheme has correct structure" do
79+ let spec = buildOpenAPISpec @BasicAuthAPI { title: "Auth API", version: "1.0.0" }
80+ let json = writeJSON spec
81+ expectToBe true (String.contains (String.Pattern "\"type\":\"http\"") json)
82+ expectToBe true (String.contains (String.Pattern "\"scheme\":\"basic\"") json)
83+
84+testApiKeyAuth :: Effect ViTest
85+testApiKeyAuth = describe "ApiKey Authentication" do
86+ _ <- test "ApiKeyHeader does not appear as a regular header parameter" do
87+ let spec = buildOpenAPISpec @ApiKeyAPI { title: "Auth API", version: "1.0.0" }
88+ let json = writeJSON spec
89+ -- Check that parameters array is empty (no header parameters)
90+ let hasEmptyParams = String.contains (String.Pattern "\"parameters\":[]") json
91+ expectToBe true hasEmptyParams
92+
93+ _ <- test "ApiKey appears in security requirements" do
94+ let spec = buildOpenAPISpec @ApiKeyAPI { title: "Auth API", version: "1.0.0" }
95+ let json = writeJSON spec
96+ let hasApiKey = String.contains (String.Pattern "apiKeyApiKey") json
97+ expectToBe true hasApiKey
98+
99+ test "ApiKey security scheme has correct structure" do
100+ let spec = buildOpenAPISpec @ApiKeyAPI { title: "Auth API", version: "1.0.0" }
101+ let json = writeJSON spec
102+ expectToBe true (String.contains (String.Pattern "\"type\":\"apiKey\"") json)
103+ expectToBe true (String.contains (String.Pattern "\"in\":\"header\"") json)
104+
105+testDigestAuth :: Effect ViTest
106+testDigestAuth = describe "DigestAuth Authentication" do
107+ _ <- test "DigestAuth does not appear as a regular header parameter" do
108+ let spec = buildOpenAPISpec @DigestAuthAPI { title: "Auth API", version: "1.0.0" }
109+ let json = writeJSON spec
110+ let hasAuthParam = String.contains (String.Pattern "\"name\":\"authorization\"") json
111+ expectToBe false hasAuthParam
112+
113+ _ <- test "DigestAuth appears in security requirements" do
114+ let spec = buildOpenAPISpec @DigestAuthAPI { title: "Auth API", version: "1.0.0" }
115+ let json = writeJSON spec
116+ let hasDigestAuth = String.contains (String.Pattern "digestAuth") json
117+ expectToBe true hasDigestAuth
118+
119+ test "DigestAuth security scheme has correct structure" do
120+ let spec = buildOpenAPISpec @DigestAuthAPI { title: "Auth API", version: "1.0.0" }
121+ let json = writeJSON spec
122+ expectToBe true (String.contains (String.Pattern "\"type\":\"http\"") json)
123+ expectToBe true (String.contains (String.Pattern "\"scheme\":\"digest\"") json)
124+
125+testMultipleAuthTypes :: Effect ViTest
126+testMultipleAuthTypes = describe "Multiple Authentication Types" do
127+ _ <- test "All auth types appear in security schemes" do
128+ let spec = buildOpenAPISpec @MultiAuthAPI { title: "Auth API", version: "1.0.0" }
129+ let json = writeJSON spec
130+ expectToBe true (String.contains (String.Pattern "bearerAuth") json)
131+ expectToBe true (String.contains (String.Pattern "basicAuth") json)
132+ expectToBe true (String.contains (String.Pattern "xApiKeyApiKey") json)
133+
134+ test "None of the auth headers appear as regular parameters" do
135+ let spec = buildOpenAPISpec @MultiAuthAPI { title: "Auth API", version: "1.0.0" }
43136 let json = writeJSON spec
44− -- Should have bearerAuth defined in components.securitySchemes
45− let hasSecuritySchemes = String.contains (String.Pattern "securitySchemes") json
46− expectToBe true hasSecuritySchemes
137+ -- Check that all endpoints have empty parameters arrays
138+ let hasEmptyParams = String.contains (String.Pattern "\"parameters\":[]") json
139+ expectToBe true hasEmptyParams
test/Test.Operators.purs+5−1
@@ -39,7 +39,11 @@ spec = do
3939 _ <- APIRecordTest.testOperationIds
4040 _ <- APIRecordTest.testBuildOpenAPISpec
4141 _ <- APIRecordTest.testAPIHandlers
42− _ <- BearerAuthTest.testBearerTokenNotInHeaders
42+ _ <- BearerAuthTest.testBearerTokenAuth
43+ _ <- BearerAuthTest.testBasicAuth
44+ _ <- BearerAuthTest.testApiKeyAuth
45+ _ <- BearerAuthTest.testDigestAuth
46+ _ <- BearerAuthTest.testMultipleAuthTypes
4347 SchemaComponentTest.testSchemaComponents
4448
4549main :: ViTest