944ca7d · rowtype-yoga/purescript-yoga-fetch-om

git.iko.soy/rowtype-yoga/purescript-yoga-fetch-om

Fix headers, referrer, URL encoding, credentials, and JSON errors

Breaking changes: - DecodeResponse returns Either String instead of Maybe - BuildClientFn dispatches on RowList instead of IsEmpty/IsNonEmpty flags - credentials default changed from Include to SameOrigin Bug fixes: - DeriveClientFn now passes headers through to makeRequest - Referrer changed from ReferrerClient to ReferrerNone (Node.js compat) - Query params are now URL-encoded via encodeURIComponent - Custom Content-Type headers no longer duplicated with auto-generated ones Improvements: - JSON parse errors now include human-readable messages via yoga-json - Added ToHeaders class for empty/non-empty header dispatch - Added headers support to route definitions (e.g. authorization)

commit944ca7d30bc8d67c13506420e6fecd0ba6db271c authorMark <mark.eibes@gmail.com> dateMon 9 Feb 2026, 13:42 (8 months ago) parentf7217bd

14 files changed+168−63

compare with main

unifiedsplit

spago.lock+3 spago.yaml+2−1 src/Yoga/Fetch/Om.purs+23−6 src/Yoga/Fetch/Om/BuildUrl.js+3 src/Yoga/Fetch/Om/BuildUrl.purs+4−2 src/Yoga/Fetch/Om/ClientFn.purs+21−24 src/Yoga/Fetch/Om/MakeRequest.purs+15−7 src/Yoga/Fetch/Om/ParseResponse.purs+9−8 src/Yoga/Fetch/Om/Simple.purs+19−13 test/BuildUrl.Spec.purs+6−1 test/Complete.Example.purs+16 test/Example.purs+7 test/MakeRequest.Spec.purs+37 test/Test.Main.purs+3−1

spago.lock+3

@@ -14,6 +14,9 @@

1414 {

1515 "effect": ">=4.0.0 <5.0.0"

1616 },

17+ {

18+ "either": ">=6.1.0 <7.0.0"

19+ },

1720 {

1821 "exceptions": ">=6.1.0 <7.0.0"

1922 },

spago.yaml+2−1

@@ -3,7 +3,7 @@ workspace: {}

33package:

44 name: yoga-fetch-om

55 publish:

6− version: 0.2.0

6+ version: 0.3.0

77 license: MIT

88 location:

99 githubOwner: rowtype-yoga

@@ -18,6 +18,7 @@ package:

1818 - aff: ">=8.0.0 <9.0.0"

1919 - arrays: ">=7.3.0 <8.0.0"

2020 - effect: ">=4.0.0 <5.0.0"

21+ - either: ">=6.1.0 <7.0.0"

2122 - exceptions: ">=6.1.0 <7.0.0"

2223 - http-methods: ">=6.0.0 <7.0.0"

2324 - js-fetch: ">=0.2.1 <0.3.0"

src/Yoga/Fetch/Om.purs+23−6

@@ -8,6 +8,8 @@ module Yoga.Fetch.Om

88 , class DeriveClientFn

99 , deriveClientFn

1010 , class RecordRow

11+ , class ToHeaders

12+ , toHeaders

1113 , module Yoga.HTTP.API.Route

1214 , module Yoga.HTTP.API.Path

1315 , module Yoga.Fetch.Om.Simple

@@ -23,9 +25,12 @@ import Prim.RowList as RL

2325import Record as Record

2426import Type.Proxy (Proxy(..))

2527import Unsafe.Coerce (unsafeCoerce)

28+import JS.Fetch.Headers (Headers)

29+import JS.Fetch.Headers as Headers

30+import Type.Row.Homogeneous (class Homogeneous)

2631import Yoga.Fetch.Om.BuildUrl (class BuildUrl, buildUrl)

2732import Yoga.Fetch.Om.Simple (class DecodeResponse, decodeResponse, FetchError, FetchResponse, get, getWithHeaders, delete, deleteWithHeaders, delete_, post, postWithHeaders, post_, put, putWithHeaders, put_, patch, patchWithHeaders, patch_)

28−import Yoga.Fetch.Om.ClientFn (class BuildClientFn, class CheckBodyIsUnit, class CheckRowEmpty, buildClientFn)

33+import Yoga.Fetch.Om.ClientFn (class BuildClientFn, class CheckBodyIsUnit, buildClientFn)

2934import Yoga.Fetch.Om.ExtractParams (class ExtractRequestBody, class ExtractRequestHeaders)

3035import Yoga.Fetch.Om.MakeRequest (class MakeRequest, class SerializeBody, makeRequest, serializeBody)

3136import Yoga.Fetch.Om.ParseResponse (class ParseResponse, parseResponse)

@@ -42,6 +47,16 @@ class RecordRow t r | t -> r

4247

4348instance RecordRow (Record r) r

4449

50+class ToHeaders :: RowList Type -> Row Type -> Constraint

51+class ToHeaders headersRL headers where

52+ toHeaders :: Proxy headersRL -> Record headers -> Headers

53+

54+instance ToHeaders RL.Nil headers where

55+ toHeaders _ _ = Headers.empty

56+

57+else instance Homogeneous headers String => ToHeaders headersRL headers where

58+ toHeaders _ = Headers.fromRecord

59+

4560class DeriveClientFn :: forall k1. Type -> k1 -> Type -> Row Type -> Row Type -> Row Type -> Type -> Type -> Constraint

4661class

4762 DeriveClientFn method segments request response errorRow successRow result fn

@@ -64,18 +79,20 @@ instance

6479 , Row.Union pathParams queryParams pathQuery

6580 , Row.Nub pathQuery pathQuery

6681 , RowToList pathQuery pathQueryRL

67− , CheckRowEmpty headers headersFlag

82+ , RowToList headers headersRL

83+ , ToHeaders headersRL headers

6884 , CheckBodyIsUnit body bodyFlag

69− , BuildClientFn pathQueryRL headersFlag bodyFlag body pathQuery headers errorRow result fn

85+ , BuildClientFn pathQueryRL headersRL bodyFlag body pathQuery headers errorRow result fn

7086 ) =>

7187 DeriveClientFn method segments request response errorRow successRow result fn where

7288 deriveClientFn baseUrl _ =

73− buildClientFn (Proxy :: _ pathQueryRL) (Proxy :: _ headersFlag) (Proxy :: _ bodyFlag) impl

89+ buildClientFn (Proxy :: _ pathQueryRL) (Proxy :: _ headersRL) (Proxy :: _ bodyFlag) impl

7490 where

7591 impl :: Record pathQuery -> Record headers -> body -> Om {} errorRow result

76− impl pathQueryRec _headers bodyVal = do

92+ impl pathQueryRec headersRec bodyVal = do

7793 let url = buildUrl baseUrl (Proxy :: _ segments) pathParamsRec queryParamsRec

78− fetchResp <- makeRequest (Proxy :: _ method) url (serializeBody bodyVal) # fromAff

94+ let hdrs = toHeaders (Proxy :: _ headersRL) headersRec

95+ fetchResp <- makeRequest (Proxy :: _ method) url hdrs (serializeBody bodyVal) # fromAff

7996 variant <- parseResponse fetchResp :: Om {} errorRow (Variant successRow)

8097 variantOrValue (Proxy :: _ successRL) variant # pure

8198 where

src/Yoga/Fetch/Om/BuildUrl.jsnew file+3

@@ -0,0 +1,3 @@

1+export function encodeURIComponent_(s) {

2+ return encodeURIComponent(s);

3+}

src/Yoga/Fetch/Om/BuildUrl.purs+4−2

@@ -29,6 +29,8 @@ import Record as Record

2929import Type.Proxy (Proxy(..))

3030import Yoga.HTTP.API.Path (class PathPattern, pathPattern)

3131

32+foreign import encodeURIComponent_ :: String -> String

33+

3234class BuildUrl :: forall k. k -> Row Type -> Row Type -> Constraint

3335class BuildUrl segments pathParams queryParams | segments -> pathParams queryParams where

3436 buildUrl :: String -> Proxy segments -> Record pathParams -> Record queryParams -> String

@@ -119,7 +121,7 @@ instance

119121 where

120122 acc' = case Record.get (Proxy :: _ name) rec of

121123 Nothing -> acc

122− Just value -> Array.snoc acc (reflectSymbol (Proxy :: _ name) <> "=" <> serializeParam value)

124+ Just value -> Array.snoc acc (encodeURIComponent_ (reflectSymbol (Proxy :: _ name)) <> "=" <> encodeURIComponent_ (serializeParam value))

123125

124126else instance

125127 ( IsSymbol name

@@ -131,7 +133,7 @@ else instance

131133 appendQueryParamsRL _ rec acc =

132134 appendQueryParamsRL (Proxy :: _ tail) rec (Array.snoc acc pair)

133135 where

134− pair = reflectSymbol (Proxy :: _ name) <> "=" <> serializeParam (Record.get (Proxy :: _ name) rec)

136+ pair = encodeURIComponent_ (reflectSymbol (Proxy :: _ name)) <> "=" <> encodeURIComponent_ (serializeParam (Record.get (Proxy :: _ name) rec))

135137

136138class SerializeParam :: Type -> Constraint

137139class SerializeParam a where

src/Yoga/Fetch/Om/ClientFn.purs+21−24

@@ -2,15 +2,12 @@ module Yoga.Fetch.Om.ClientFn

22 ( class BuildClientFn

33 , buildClientFn

44 , class CheckBodyIsUnit

5− , class CheckRowEmpty

65 , IsUnit

76 , IsNotUnit

8− , IsEmpty

9− , IsNonEmpty

107 ) where

118

129import Data.Unit (Unit, unit)

13−import Prim.RowList (class RowToList, RowList)

10+import Prim.RowList (RowList)

1411import Prim.RowList as RL

1512import Type.Proxy (Proxy)

1613import Unsafe.Coerce (unsafeCoerce)

@@ -18,8 +15,6 @@ import Yoga.Om (Om)

1815

1916data IsUnit

2017data IsNotUnit

21−data IsEmpty

22−data IsNonEmpty

2318

2419class CheckBodyIsUnit :: Type -> Type -> Constraint

2520class CheckBodyIsUnit body flag | body -> flag

@@ -27,27 +22,22 @@ class CheckBodyIsUnit body flag | body -> flag

2722instance CheckBodyIsUnit Unit IsUnit

2823else instance CheckBodyIsUnit body IsNotUnit

2924

30−class CheckRowEmpty :: Row Type -> Type -> Constraint

31−class CheckRowEmpty row flag | row -> flag

32−

33−instance RowToList row RL.Nil => CheckRowEmpty row IsEmpty

34−else instance CheckRowEmpty row IsNonEmpty

35−

3625class BuildClientFn

37− :: RowList Type -> Type -> Type -> Type -> Row Type -> Row Type -> Row Type -> Type -> Type -> Constraint

26+ :: RowList Type -> RowList Type -> Type -> Type -> Row Type -> Row Type -> Row Type -> Type -> Type -> Constraint

3827class

39− BuildClientFn pathQueryRL headersFlag bodyFlag body pathQuery headers errorRow result fn

40− | pathQueryRL headersFlag bodyFlag body pathQuery headers errorRow result -> fn where

28+ BuildClientFn pathQueryRL headersRL bodyFlag body pathQuery headers errorRow result fn

29+ | pathQueryRL headersRL bodyFlag body pathQuery headers errorRow result -> fn where

4130 buildClientFn

4231 :: Proxy pathQueryRL

43− -> Proxy headersFlag

32+ -> Proxy headersRL

4433 -> Proxy bodyFlag

4534 -> (Record pathQuery -> Record headers -> body -> Om {} errorRow result)

4635 -> fn

4736

37+-- No path/query, no headers, no body

4838instance

4939 BuildClientFn RL.Nil

50− IsEmpty

40+ RL.Nil

5141 IsUnit

5242 Unit

5343 pq

@@ -57,9 +47,10 @@ instance

5747 (Om {} errorRow result) where

5848 buildClientFn _ _ _ f = f (unsafeCoerce {}) (unsafeCoerce {}) unit

5949

50+-- No path/query, no headers, with body

6051instance

6152 BuildClientFn RL.Nil

62− IsEmpty

53+ RL.Nil

6354 IsNotUnit

6455 body

6556 pq

@@ -69,9 +60,10 @@ instance

6960 (body -> Om {} errorRow result) where

7061 buildClientFn _ _ _ f = \b -> f (unsafeCoerce {}) (unsafeCoerce {}) b

7162

63+-- No path/query, with headers, no body

7264instance

7365 BuildClientFn RL.Nil

74− IsNonEmpty

66+ (RL.Cons n t tl)

7567 IsUnit

7668 Unit

7769 pq

@@ -81,9 +73,10 @@ instance

8173 (Record h -> Om {} errorRow result) where

8274 buildClientFn _ _ _ f = \hdrs -> f (unsafeCoerce {}) hdrs unit

8375

76+-- No path/query, with headers, with body

8477instance

8578 BuildClientFn RL.Nil

86− IsNonEmpty

79+ (RL.Cons n t tl)

8780 IsNotUnit

8881 body

8982 pq

@@ -93,9 +86,10 @@ instance

9386 (Record h -> body -> Om {} errorRow result) where

9487 buildClientFn _ _ _ f = \hdrs b -> f (unsafeCoerce {}) hdrs b

9588

89+-- With path/query, no headers, no body

9690instance

9791 BuildClientFn (RL.Cons n t tl)

98− IsEmpty

92+ RL.Nil

9993 IsUnit

10094 Unit

10195 pq

@@ -105,9 +99,10 @@ instance

10599 (Record pq -> Om {} errorRow result) where

106100 buildClientFn _ _ _ f = \pqr -> f pqr (unsafeCoerce {}) unit

107101

102+-- With path/query, no headers, with body

108103instance

109104 BuildClientFn (RL.Cons n t tl)

110− IsEmpty

105+ RL.Nil

111106 IsNotUnit

112107 body

113108 pq

@@ -117,9 +112,10 @@ instance

117112 (Record pq -> body -> Om {} errorRow result) where

118113 buildClientFn _ _ _ f = \pqr b -> f pqr (unsafeCoerce {}) b

119114

115+-- With path/query, with headers, no body

120116instance

121117 BuildClientFn (RL.Cons n t tl)

122− IsNonEmpty

118+ (RL.Cons hn ht htl)

123119 IsUnit

124120 Unit

125121 pq

@@ -129,9 +125,10 @@ instance

129125 (Record pq -> Record h -> Om {} errorRow result) where

130126 buildClientFn _ _ _ f = \pqr hdrs -> f pqr hdrs unit

131127

128+-- With path/query, with headers, with body

132129instance

133130 BuildClientFn (RL.Cons n t tl)

134− IsNonEmpty

131+ (RL.Cons hn ht htl)

135132 IsNotUnit

136133 body

137134 pq

src/Yoga/Fetch/Om/MakeRequest.purs+15−7

@@ -9,11 +9,14 @@ module Yoga.Fetch.Om.MakeRequest

99import Prelude

1010

1111import Data.HTTP.Method (Method(..))

12+import Data.Array as Array

1213import Data.Maybe (Maybe(..))

14+import Data.Tuple (fst)

1315import Data.Tuple.Nested ((/\))

1416import Effect.Aff (Aff)

1517import Effect.Class (liftEffect)

1618import JS.Fetch as Fetch

19+import JS.Fetch.Headers (Headers)

1720import JS.Fetch.Headers as Headers

1821import JS.Fetch.Request as Request

1922import JS.Fetch.RequestBody as Body

@@ -54,26 +57,31 @@ makeRequest

5457 . MakeRequest method

5558 => Proxy method

5659 -> String

60+ -> Headers

5761 -> Maybe String

5862 -> Aff FetchResponse.Response

59−makeRequest proxy url maybeBody = do

63+makeRequest proxy url customHeaders maybeBody = do

6064 request <- Request.new url options # liftEffect

6165 Promise.toAffE $ Fetch.fetch request

6266 where

6367 method = httpMethod proxy

64− headers = case maybeBody of

65− Nothing -> Headers.empty

66− Just _ -> Headers.fromFoldable [ "Content-Type" /\ "application/json" ]

68+ customArr = Headers.toArray customHeaders

69+ hasContentType = Array.any (\t -> fst t == "content-type") customArr

70+ contentTypeArr = case maybeBody of

71+ Nothing -> []

72+ Just _ | hasContentType -> []

73+ Just _ -> [ "Content-Type" /\ "application/json" ]

74+ allHeaders = Headers.fromFoldable (contentTypeArr <> customArr)

6775 body = case maybeBody of

6876 Nothing -> Body.empty

6977 Just b -> Body.fromString b

7078 options =

7179 { method

72− , headers

80+ , headers: allHeaders

7381 , body

74− , credentials: Credentials.Include

82+ , credentials: Credentials.SameOrigin

7583 , mode: Mode.Cors

76− , referrer: Referrer.ReferrerClient

84+ , referrer: Referrer.ReferrerNone

7785 , referrerPolicy: ReferrerPolicy.NoReferrer

7886 , integrity: Integrity ""

7987 , duplex: Duplex.Half

src/Yoga/Fetch/Om/ParseResponse.purs+9−8

@@ -10,7 +10,6 @@ module Yoga.Fetch.Om.ParseResponse

1010import Prelude

1111

1212import Control.Monad.Error.Class (throwError)

13−import Data.Maybe (Maybe(..))

1413import Data.Symbol (class IsSymbol)

1514import Data.Variant (Variant)

1615import Data.Variant as Variant

@@ -25,7 +24,9 @@ import Prim.RowList as RL

2524import Promise.Aff as Promise

2625import Type.Proxy (Proxy(..))

2726import Yoga.HTTP.API.Route.StatusCode (class StatusCodeMap, statusCodeFor, StatusCode(..))

28−import Yoga.JSON (class ReadForeign, readJSON_)

27+import Data.Either (Either(..))

28+import Yoga.JSON (class ReadForeign, readJSON)

29+import Yoga.JSON.Error (withStringErrors)

2930import Yoga.Om (Om, fromAff)

3031import Yoga.Om.Error (Exception)

3132

@@ -67,9 +68,9 @@ else instance

6768 ParseSuccessRL (RL.Cons label body tailRL) successRow where

6869 parseSuccessRL _ actualStatus jsonText = do

6970 let StatusCode expected = statusCodeFor (Proxy :: _ label)

70− if actualStatus == expected then case readJSON_ jsonText of

71− Nothing -> Aff.throwError (Exception.error "JSON parse error")

72− Just parsed -> pure (Variant.inj (Proxy :: _ label) parsed)

71+ if actualStatus == expected then case withStringErrors (readJSON jsonText) of

72+ Left errs -> Aff.throwError (Exception.error ("Failed to parse response (status " <> show actualStatus <> "):\n" <> errs))

73+ Right parsed -> pure (Variant.inj (Proxy :: _ label) parsed)

7374 else

7475 parseSuccessRL (Proxy :: _ tailRL) actualStatus jsonText

7576

@@ -98,8 +99,8 @@ else instance

9899 ParseErrorRL (RL.Cons label body tailRL) errorRow where

99100 parseErrorRL _ errorProxy actualStatus jsonText = do

100101 let StatusCode expected = statusCodeFor (Proxy :: _ label)

101− if actualStatus == expected then case readJSON_ jsonText of

102− Nothing -> throwError (Variant.inj (Proxy :: _ "exception") (Exception.error "JSON parse error"))

103− Just parsed -> throwError (Variant.inj (Proxy :: _ label) parsed)

102+ if actualStatus == expected then case withStringErrors (readJSON jsonText) of

103+ Left errs -> throwError (Variant.inj (Proxy :: _ "exception") (Exception.error ("Failed to parse error response (status " <> show actualStatus <> "):\n" <> errs)))

104+ Right parsed -> throwError (Variant.inj (Proxy :: _ label) parsed)

104105 else

105106 parseErrorRL (Proxy :: _ tailRL) errorProxy actualStatus jsonText

src/Yoga/Fetch/Om/Simple.purs+19−13

@@ -22,7 +22,10 @@ module Yoga.Fetch.Om.Simple

2222import Prelude

2323

2424import Data.HTTP.Method (Method(..))

25+import Data.Array as Array

26+import Data.Either (Either(..))

2527import Data.Maybe (Maybe(..))

28+import Data.Tuple (fst)

2629import Data.Tuple.Nested ((/\))

2730import Effect.Class (liftEffect)

2831import JS.Fetch as Fetch

@@ -41,7 +44,8 @@ import JS.Fetch.Response as Resp

4144import Promise.Aff as Promise

4245import Type.Row.Homogeneous (class Homogeneous)

4346-- PlainText removed, using local phantom type

44−import Yoga.JSON (class ReadForeign, class WriteForeign, readJSON_, writeJSON)

47+import Yoga.JSON (class ReadForeign, class WriteForeign, readJSON, writeJSON)

48+import Yoga.JSON.Error (withStringErrors)

4549import Yoga.Om (Om, fromAff, throw)

4650

4751type FetchError = { status :: Int, body :: String }

@@ -50,15 +54,15 @@ type FetchResponse a = { headers :: Headers, body :: a }

5054

5155class DecodeResponse :: forall k. k -> Type -> Constraint

5256class DecodeResponse a result | a -> result where

53− decodeResponse :: String -> Maybe result

57+ decodeResponse :: String -> Either String result

5458

5559data PlainTextResponse

5660

5761instance DecodeResponse PlainTextResponse String where

58− decodeResponse = Just

62+ decodeResponse = Right

5963

6064else instance ReadForeign a => DecodeResponse a a where

61− decodeResponse = readJSON_

65+ decodeResponse = withStringErrors <<< readJSON

6266

6367simpleFetch

6468 :: forall @a result headers ctx err

@@ -76,19 +80,21 @@ simpleFetch method headers url maybeBody = do

7680 let respHeaders = Resp.headers resp

7781 if status >= 200 && status < 300 then

7882 case decodeResponse @a respText of

79− Nothing -> throw { fetchError: { status, body: respText } }

80− Just body -> pure { headers: respHeaders, body }

83+ Left errs -> throw { fetchError: { status, body: "Failed to parse response:\n" <> errs <> "\nBody: " <> respText } }

84+ Right body -> pure { headers: respHeaders, body }

8185 else

8286 throw { fetchError: { status, body: respText } }

8387 where

8488 doFetch = do

8589 request <- Request.new url options # liftEffect

8690 Promise.toAffE $ Fetch.fetch request

87− contentTypeHeaders = case maybeBody of

88− Nothing -> Headers.empty

89− Just _ -> Headers.fromFoldable [ "Content-Type" /\ "application/json" ]

90− allHeaders = Headers.fromFoldable

91− (Headers.toArray contentTypeHeaders <> Headers.toArray (Headers.fromRecord headers))

91+ customArr = Headers.toArray (Headers.fromRecord headers)

92+ hasContentType = Array.any (\t -> fst t == "content-type") customArr

93+ contentTypeArr = case maybeBody of

94+ Nothing -> []

95+ Just _ | hasContentType -> []

96+ Just _ -> [ "Content-Type" /\ "application/json" ]

97+ allHeaders = Headers.fromFoldable (contentTypeArr <> customArr)

9298 reqBody = case maybeBody of

9399 Nothing -> Body.empty

94100 Just b -> Body.fromString b

@@ -96,9 +102,9 @@ simpleFetch method headers url maybeBody = do

96102 { method

97103 , headers: allHeaders

98104 , body: reqBody

99− , credentials: Credentials.Include

105+ , credentials: Credentials.SameOrigin

100106 , mode: Mode.Cors

101− , referrer: Referrer.ReferrerClient

107+ , referrer: Referrer.ReferrerNone

102108 , referrerPolicy: ReferrerPolicy.NoReferrer

103109 , integrity: Integrity ""

104110 , duplex: Duplex.Half

test/BuildUrl.Spec.purs+6−1

@@ -83,11 +83,16 @@ testAppendQueryParams = describe "appendQueryParams" $ do

8383 "/users"

8484 expectToEqual "/users?offset=20" result

8585

86− test "handles empty query params" do

86+ _ <- test "handles empty query params" do

8787 let

8888 result = appendQueryParams @() {} "/users"

8989 expectToEqual "/users" result

9090

91+ test "URL-encodes special characters in values" do

92+ let

93+ result = appendQueryParams @(search :: String) { search: "hello world&more=yes" } "/users"

94+ expectToEqual "/users?search=hello%20world%26more%3Dyes" result

95+

9196--------------------------------------------------------------------------------

9297-- BuildUrl Tests

9398--------------------------------------------------------------------------------

test/Complete.Example.purs+16

@@ -64,10 +64,18 @@ type UserAPI =

6464 ( noContent :: { body :: {} }

6565 , notFound :: { body :: ErrorMessage }

6666 )

67+ , createUserAuth ::

68+ Route POST

69+ (Path "users")

70+ { headers :: Record (authorization :: String), body :: JSON CreateUserRequest }

71+ ( created :: { body :: User }

72+ , badRequest :: { body :: ErrorMessage }

73+ )

6774 }

6875

6976api

7077 :: { createUser :: CreateUserRequest -> Om {} (badRequest :: ErrorMessage) User

78+ , createUserAuth :: { authorization :: String } -> CreateUserRequest -> Om {} (badRequest :: ErrorMessage) User

7179 , deleteUser :: { id :: Int } -> Om {} (notFound :: ErrorMessage) {}

7280 , getUser :: { id :: Int } -> Om {} (notFound :: ErrorMessage) User

7381 , listUsers :: { limit :: Maybe Int, offset :: Maybe Int } -> Om {} () (Array User)

@@ -115,3 +123,11 @@ exampleDeleteUser :: Om {} (notFound :: ErrorMessage) Unit

115123exampleDeleteUser = do

116124 _ <- api.deleteUser { id: 42 }

117125 log "User deleted successfully"

126+

127+exampleCreateUserAuth :: Om {} (badRequest :: ErrorMessage) Unit

128+exampleCreateUserAuth = do

129+ user <- api.createUserAuth { authorization: "Bearer abc123" }

130+ { name: "Alice"

131+ , email: "alice@example.com"

132+ }

133+ log $ "Created user with ID: " <> show user.id

test/Example.purs+7

@@ -36,4 +36,11 @@ type UserAPI =

3636 ( noContent :: { body :: {} }

3737 , notFound :: { body :: ErrorMessage }

3838 )

39+ , createUserAuth ::

40+ Route POST

41+ (Path "users")

42+ { headers :: Record (authorization :: String), body :: JSON CreateUserRequest }

43+ ( created :: { body :: User }

44+ , badRequest :: { body :: ErrorMessage }

45+ )

3946 }

test/MakeRequest.Spec.pursnew file+37

@@ -0,0 +1,37 @@

1+module MakeRequest.Spec where

3+import Prelude

5+import Data.Tuple.Nested ((/\))

6+import Effect (Effect)

7+import Effect.Aff (Aff)

8+import JS.Fetch.Headers as Headers

9+import Prim.RowList as RL

10+import Type.Proxy (Proxy(..))

11+import Yoga.Fetch.Om (toHeaders)

12+import ViTest (ViTest, describe, test)

13+import ViTest.Expect (expectToBe)

14+

15+expectToEqual :: forall a. Eq a => a -> a -> Aff Unit

16+expectToEqual expected actual = expectToBe true (expected == actual)

17+

18+testToHeaders :: Effect ViTest

19+testToHeaders = describe "toHeaders" $ do

20+ _ <- test "empty headers produces no entries" do

21+ let hdrs = toHeaders (Proxy :: _ RL.Nil) {}

22+ expectToEqual [] (Headers.toArray hdrs)

23+

24+ _ <- test "single header is included" do

25+ let hdrs = toHeaders (Proxy :: _ (RL.Cons "authorization" String RL.Nil)) { authorization: "Bearer abc123" }

26+ expectToEqual [ "authorization" /\ "Bearer abc123" ] (Headers.toArray hdrs)

27+

28+ test "multiple headers are included" do

29+ let

30+ hdrs = toHeaders

31+ (Proxy :: _ (RL.Cons "authorization" String (RL.Cons "x-custom" String RL.Nil)))

32+ { authorization: "Bearer abc123", "x-custom": "value" }

33+ arr = Headers.toArray hdrs

34+ expectToEqual true

35+ ( arr == [ "authorization" /\ "Bearer abc123", "x-custom" /\ "value" ]

36+ || arr == [ "x-custom" /\ "value", "authorization" /\ "Bearer abc123" ]

37+ )

test/Test.Main.purs+3−1

@@ -3,6 +3,7 @@ module Test.Main where

33import Prelude

55import BuildUrl.Spec as BuildUrl

6+import MakeRequest.Spec as MakeRequest

67import SplitParams.Spec as SplitParams

78import Variant.Spec as Variant

89import Effect (Effect)

@@ -14,7 +15,8 @@ spec = do

1415 _ <- BuildUrl.testAppendQueryParams

1516 _ <- BuildUrl.testBuildUrl

1617 _ <- SplitParams.testSplitParams

17− Variant.testOnly

18+ _ <- Variant.testOnly

19+ MakeRequest.testToHeaders

1820

1921main :: ViTest

2022main = viTest spec