@@ -1,487 +1,6 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE FunctionalDependencies #-}
6−{-# LANGUAGE PolyKinds #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE TypeOperators #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−{-# OPTIONS_HADDOCK not-home #-}
12−
13−-- | Type safe generation of internal links.
14−--
15−-- Given an API with a few endpoints:
16−--
17−-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
18−-- >>> import Servant.API
19−-- >>> import Servant.Utils.Links
20−-- >>> import Data.Proxy
21−-- >>>
22−-- >>> type Hello = "hello" :> Get '[JSON] Int
23−-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
24−-- >>> type API = Hello :<|> Bye
25−-- >>> let api = Proxy :: Proxy API
26−--
27−-- It is possible to generate links that are guaranteed to be within 'API' with
28−-- 'safeLink'. The first argument to 'safeLink' is a type representing the API
29−-- you would like to restrict links to. The second argument is the destination
30−-- endpoint you would like the link to point to, this will need to end with a
31−-- verb like GET or POST. Further arguments may be required depending on the
32−-- type of the endpoint. If everything lines up you will get a 'Link' out the
33−-- other end.
34−--
35−-- You may omit 'QueryParam's and the like should you not want to provide them,
36−-- but types which form part of the URL path like 'Capture' must be included.
37−-- The reason you may want to omit 'QueryParam's is that safeLink is a bit
38−-- magical: if parameters are included that could take input it will return a
39−-- function that accepts that input and generates a link. This is best shown
40−-- with an example. Here, a link is generated with no parameters:
41−--
42−-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
43−-- >>> toUrlPiece (safeLink api hello :: Link)
44−-- "hello"
45−--
46−-- If the API has an endpoint with parameters then we can generate links with
47−-- or without those:
48−--
49−-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent)
50−-- >>> toUrlPiece $ safeLink api with (Just "Hubert")
51−-- "bye?name=Hubert"
52−--
53−-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
54−-- >>> toUrlPiece $ safeLink api without
55−-- "bye"
56−--
57−-- If you would like create a helper for generating links only within that API,
58−-- you can partially apply safeLink if you specify a correct type signature
59−-- like so:
60−--
61−-- >>> :set -XConstraintKinds
62−-- >>> :{
63−-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
64−-- >>> => Proxy endpoint -> MkLink endpoint Link
65−-- >>> apiLink = safeLink api
66−-- >>> :}
67−--
68−-- `safeLink'` allows to make specialise the output:
69−--
70−-- >>> safeLink' toUrlPiece api without
71−-- "bye"
72−--
73−-- >>> :{
74−-- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
75−-- >>> => Proxy endpoint -> MkLink endpoint Text
76−-- >>> apiTextLink = safeLink' toUrlPiece api
77−-- >>> :}
78−--
79−-- >>> apiTextLink without
80−-- "bye"
81−--
82−-- Attempting to construct a link to an endpoint that does not exist in api
83−-- will result in a type error like this:
84−--
85−-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] NoContent)
86−-- >>> safeLink api bad_link
87−-- ...
88−-- ...Could not deduce...
89−-- ...
90−--
91−-- This error is essentially saying that the type family couldn't find
92−-- bad_link under api after trying the open (but empty) type family
93−-- `IsElem'` as a last resort.
94−module Servant.Utils.Links (
95− module Servant.API.TypeLevel,
96−
97− -- * Building and using safe links
98− --
99− -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
100− safeLink
101− , safeLink'
102− , allLinks
103− , allLinks'
104− , URI(..)
105− -- * Adding custom types
106− , HasLink(..)
107− , Link
108− , linkURI
109− , linkURI'
110− , LinkArrayElementStyle (..)
111− -- ** Link accessors
112− , Param (..)
113− , linkSegments
114− , linkQueryParams
115−) where
116−
117−import Data.List
118−import Data.Proxy
119− (Proxy (..))
120−import Data.Semigroup
121− ((<>))
122−import Data.Singletons.Bool
123− (SBool (..), SBoolI (..))
124−import qualified Data.Text as Text
125−import qualified Data.Text.Encoding as TE
126−import Data.Type.Bool
127− (If)
128−import GHC.TypeLits
129− (KnownSymbol, symbolVal)
130−import Network.URI
131− (URI (..), escapeURIString, isUnreserved)
132−import Prelude ()
133−import Prelude.Compat
134−
135−import Servant.API.Alternative
136− ((:<|>) ((:<|>)))
137−import Servant.API.BasicAuth
138− (BasicAuth)
139−import Servant.API.Capture
140− (Capture', CaptureAll)
141−import Servant.API.Description
142− (Description, Summary)
143−import Servant.API.Empty
144− (EmptyAPI (..))
145−import Servant.API.Experimental.Auth
146− (AuthProtect)
147−import Servant.API.Header
148− (Header')
149−import Servant.API.HttpVersion
150− (HttpVersion)
151−import Servant.API.IsSecure
152− (IsSecure)
153−import Servant.API.Modifiers
154− (FoldRequired)
155−import Servant.API.QueryParam
156− (QueryFlag, QueryParam', QueryParams)
157−import Servant.API.Raw
158− (Raw)
159−import Servant.API.RemoteHost
160− (RemoteHost)
161−import Servant.API.ReqBody
162− (ReqBody')
163−import Servant.API.Stream
164− (Stream)
165−import Servant.API.Sub
166− (type (:>))
167−import Servant.API.TypeLevel
168−import Servant.API.Vault
169− (Vault)
170−import Servant.API.Verbs
171− (Verb)
172−import Servant.API.WithNamedContext
173− (WithNamedContext)
174−import Web.HttpApiData
175−
176−-- | A safe link datatype.
177−-- The only way of constructing a 'Link' is using 'safeLink', which means any
178−-- 'Link' is guaranteed to be part of the mentioned API.
179−data Link = Link
180− { _segments :: [Escaped]
181− , _queryParams :: [Param]
182− } deriving Show
183−
184−newtype Escaped = Escaped String
185−
186−escaped :: String -> Escaped
187−escaped = Escaped . escapeURIString isUnreserved
188−
189−getEscaped :: Escaped -> String
190−getEscaped (Escaped s) = s
191−
192−instance Show Escaped where
193− showsPrec d (Escaped s) = showsPrec d s
194− show (Escaped s) = show s
195−
196−linkSegments :: Link -> [String]
197−linkSegments = map getEscaped . _segments
198−
199−linkQueryParams :: Link -> [Param]
200−linkQueryParams = _queryParams
201−
202−instance ToHttpApiData Link where
203− toHeader = TE.encodeUtf8 . toUrlPiece
204− toUrlPiece l =
205− let uri = linkURI l
206− in Text.pack $ uriPath uri ++ uriQuery uri
207−
208−-- | Query parameter.
209−data Param
210− = SingleParam String Text.Text
211− | ArrayElemParam String Text.Text
212− | FlagParam String
213− deriving Show
214−
215−addSegment :: Escaped -> Link -> Link
216−addSegment seg l = l { _segments = _segments l <> [seg] }
217−
218−addQueryParam :: Param -> Link -> Link
219−addQueryParam qp l =
220− l { _queryParams = _queryParams l <> [qp] }
221−
222−-- | Transform 'Link' into 'URI'.
223−--
224−-- >>> type API = "something" :> Get '[JSON] Int
225−-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
226−-- something
227−--
228−-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
229−-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
230−-- sum?x[]=1&x[]=2&x[]=3
231−--
232−-- >>> type API = "foo/bar" :> Get '[JSON] Int
233−-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
234−-- foo%2Fbar
235−--
236−-- >>> type SomeRoute = "abc" :> Capture "email" String :> Put '[JSON] ()
237−-- >>> let someRoute = Proxy :: Proxy SomeRoute
238−-- >>> safeLink someRoute someRoute "test@example.com"
239−-- Link {_segments = ["abc","test%40example.com"], _queryParams = []}
240−--
241−-- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
242−-- abc/test%40example.com
243−--
244−linkURI :: Link -> URI
245−linkURI = linkURI' LinkArrayElementBracket
246−
247−-- | How to encode array query elements.
248−data LinkArrayElementStyle
249− = LinkArrayElementBracket -- ^ @foo[]=1&foo[]=2@
250− | LinkArrayElementPlain -- ^ @foo=1&foo=2@
251− deriving (Eq, Ord, Show, Enum, Bounded)
252−
253−-- | Configurable 'linkURI'.
254−--
255−-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
256−-- >>> linkURI' LinkArrayElementBracket $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
257−-- sum?x[]=1&x[]=2&x[]=3
258−--
259−-- >>> linkURI' LinkArrayElementPlain $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
260−-- sum?x=1&x=2&x=3
261−--
262−linkURI' :: LinkArrayElementStyle -> Link -> URI
263−linkURI' addBrackets (Link segments q_params) =
264− URI mempty -- No scheme (relative)
265− Nothing -- Or authority (relative)
266− (intercalate "/" $ map getEscaped segments)
267− (makeQueries q_params) mempty
1+module Servant.Utils.Links
2+ {-# DEPRECATED "Use Servant.Links." #-}
3+ ( module Servant.Links )
2684 where
269− makeQueries :: [Param] -> String
270− makeQueries [] = ""
271− makeQueries xs =
272− "?" <> intercalate "&" (fmap makeQuery xs)
273−
274− makeQuery :: Param -> String
275− makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
276− makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
277− makeQuery (FlagParam k) = escape k
278−
279− style = case addBrackets of
280− LinkArrayElementBracket -> "[]="
281− LinkArrayElementPlain -> "="
282−
283−escape :: String -> String
284−escape = escapeURIString isUnreserved
285−
286−-- | Create a valid (by construction) relative URI with query params.
287−--
288−-- This function will only typecheck if `endpoint` is part of the API `api`
289−safeLink
290− :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
291− => Proxy api -- ^ The whole API that this endpoint is a part of
292− -> Proxy endpoint -- ^ The API endpoint you would like to point to
293− -> MkLink endpoint Link
294−safeLink = safeLink' id
295−
296−-- | More general 'safeLink'.
297−--
298−safeLink'
299− :: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
300− => (Link -> a)
301− -> Proxy api -- ^ The whole API that this endpoint is a part of
302− -> Proxy endpoint -- ^ The API endpoint you would like to point to
303− -> MkLink endpoint a
304−safeLink' toA _ endpoint = toLink toA endpoint (Link mempty mempty)
305−
306−-- | Create all links in an API.
307−--
308−-- Note that the @api@ type must be restricted to the endpoints that have
309−-- valid links to them.
310−--
311−-- >>> type API = "foo" :> Capture "name" Text :> Get '[JSON] Text :<|> "bar" :> Capture "name" Int :> Get '[JSON] Double
312−-- >>> let fooLink :<|> barLink = allLinks (Proxy :: Proxy API)
313−-- >>> :t fooLink
314−-- fooLink :: Text -> Link
315−-- >>> :t barLink
316−-- barLink :: Int -> Link
317−--
318−-- Note: nested APIs don't work well with this approach
319−--
320−-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link
321−-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
322−-- = Char -> (Int -> Link) :<|> (Double -> Link)
323−allLinks
324− :: forall api. HasLink api
325− => Proxy api
326− -> MkLink api Link
327−allLinks = allLinks' id
328−
329−-- | More general 'allLinks'. See `safeLink'`.
330−allLinks'
331− :: forall api a. HasLink api
332− => (Link -> a)
333− -> Proxy api
334− -> MkLink api a
335−allLinks' toA api = toLink toA api (Link mempty mempty)
336−
337−-- | Construct a toLink for an endpoint.
338−class HasLink endpoint where
339− type MkLink endpoint (a :: *)
340− toLink
341− :: (Link -> a)
342− -> Proxy endpoint -- ^ The API endpoint you would like to point to
343− -> Link
344− -> MkLink endpoint a
345−
346−-- Naked symbol instance
347−instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
348− type MkLink (sym :> sub) a = MkLink sub a
349− toLink toA _ =
350− toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
351− where
352− seg = symbolVal (Proxy :: Proxy sym)
353−
354−-- QueryParam instances
355−instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
356− => HasLink (QueryParam' mods sym v :> sub)
357− where
358− type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
359− toLink toA _ l mv =
360− toLink toA (Proxy :: Proxy sub) $
361− case sbool :: SBool (FoldRequired mods) of
362− STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
363− SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
364− where
365− k :: String
366− k = symbolVal (Proxy :: Proxy sym)
367−
368−instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
369− => HasLink (QueryParams sym v :> sub)
370− where
371− type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
372− toLink toA _ l =
373− toLink toA (Proxy :: Proxy sub) .
374− foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
375− where
376− k = symbolVal (Proxy :: Proxy sym)
377−
378−instance (KnownSymbol sym, HasLink sub)
379− => HasLink (QueryFlag sym :> sub)
380− where
381− type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
382− toLink toA _ l False =
383− toLink toA (Proxy :: Proxy sub) l
384− toLink toA _ l True =
385− toLink toA (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
386− where
387− k = symbolVal (Proxy :: Proxy sym)
388−
389−-- :<|> instance - Generate all links at once
390−instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
391− type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
392− toLink toA _ l = toLink toA (Proxy :: Proxy a) l :<|> toLink toA (Proxy :: Proxy b) l
393−
394−-- Misc instances
395−instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
396− type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
397− toLink toA _ = toLink toA (Proxy :: Proxy sub)
398−
399−instance (ToHttpApiData v, HasLink sub)
400− => HasLink (Capture' mods sym v :> sub)
401− where
402− type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
403− toLink toA _ l v =
404− toLink toA (Proxy :: Proxy sub) $
405− addSegment (escaped . Text.unpack $ toUrlPiece v) l
406−
407−instance (ToHttpApiData v, HasLink sub)
408− => HasLink (CaptureAll sym v :> sub)
409− where
410− type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
411− toLink toA _ l vs = toLink toA (Proxy :: Proxy sub) $
412− foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
413−
414−instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
415− type MkLink (Header' mods sym a :> sub) r = MkLink sub r
416− toLink = simpleToLink (Proxy :: Proxy sub)
417−
418−instance HasLink sub => HasLink (Vault :> sub) where
419− type MkLink (Vault :> sub) a = MkLink sub a
420− toLink = simpleToLink (Proxy :: Proxy sub)
421−
422−instance HasLink sub => HasLink (Description s :> sub) where
423− type MkLink (Description s :> sub) a = MkLink sub a
424− toLink = simpleToLink (Proxy :: Proxy sub)
425−
426−instance HasLink sub => HasLink (Summary s :> sub) where
427− type MkLink (Summary s :> sub) a = MkLink sub a
428− toLink = simpleToLink (Proxy :: Proxy sub)
429−
430−instance HasLink sub => HasLink (HttpVersion :> sub) where
431− type MkLink (HttpVersion:> sub) a = MkLink sub a
432− toLink = simpleToLink (Proxy :: Proxy sub)
433−
434−instance HasLink sub => HasLink (IsSecure :> sub) where
435− type MkLink (IsSecure :> sub) a = MkLink sub a
436− toLink = simpleToLink (Proxy :: Proxy sub)
437−
438−instance HasLink sub => HasLink (WithNamedContext name context sub) where
439− type MkLink (WithNamedContext name context sub) a = MkLink sub a
440− toLink toA _ = toLink toA (Proxy :: Proxy sub)
441−
442−instance HasLink sub => HasLink (RemoteHost :> sub) where
443− type MkLink (RemoteHost :> sub) a = MkLink sub a
444− toLink = simpleToLink (Proxy :: Proxy sub)
445−
446−instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
447− type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
448− toLink = simpleToLink (Proxy :: Proxy sub)
449−
450−instance HasLink EmptyAPI where
451− type MkLink EmptyAPI a = EmptyAPI
452− toLink _ _ _ = EmptyAPI
453−
454−-- Verb (terminal) instances
455−instance HasLink (Verb m s ct a) where
456− type MkLink (Verb m s ct a) r = r
457− toLink toA _ = toA
458−
459−instance HasLink Raw where
460− type MkLink Raw a = a
461− toLink toA _ = toA
462−
463−instance HasLink (Stream m fr ct a) where
464− type MkLink (Stream m fr ct a) r = r
465− toLink toA _ = toA
466−
467−-- AuthProtext instances
468−instance HasLink sub => HasLink (AuthProtect tag :> sub) where
469− type MkLink (AuthProtect tag :> sub) a = MkLink sub a
470− toLink = simpleToLink (Proxy :: Proxy sub)
471−
472−-- | Helper for implemneting 'toLink' for combinators not affecting link
473−-- structure.
474−simpleToLink
475− :: forall sub a combinator.
476− (HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
477− => Proxy sub
478− -> (Link -> a)
479− -> Proxy (combinator :> sub)
480− -> Link
481− -> MkLink (combinator :> sub) a
482−simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
483−
4845
485−-- $setup
486−-- >>> import Servant.API
487−-- >>> import Data.Text (Text)
6+import Servant.Links