@@ -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 #-}
13−-- | Type safe generation of internal links.
15−-- Given an API with a few endpoints:
17−-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
18−-- >>> import Servant.API
19−-- >>> import Servant.Utils.Links
1+module Servant.Utils.Links
20−-- >>> import Data.Proxy
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
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
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:
42−-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
43−-- >>> toUrlPiece (safeLink api hello :: Link)
46−-- If the API has an endpoint with parameters then we can generate links with
49−-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] NoContent)
50−-- >>> toUrlPiece $ safeLink api with (Just "Hubert")
53−-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
54−-- >>> toUrlPiece $ safeLink api without
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
61−-- >>> :set -XConstraintKinds
63−-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
64−-- >>> => Proxy endpoint -> MkLink endpoint Link
65−-- >>> apiLink = safeLink api
68−-- `safeLink'` allows to make specialise the output:
70−-- >>> safeLink' toUrlPiece api without
74−-- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
75−-- >>> => Proxy endpoint -> MkLink endpoint Text
76−-- >>> apiTextLink = safeLink' toUrlPiece api
79−-- >>> apiTextLink without
82−-- Attempting to construct a link to an endpoint that does not exist in api
83−-- will result in a type error like this:
85−-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] NoContent)
86−-- >>> safeLink api bad_link
88−-- ...Could not deduce...
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 (
2+ {-# DEPRECATED "Use Servant.Links." #-}
95− module Servant.API.TypeLevel,
3+ ( module Servant.Links )
97− -- * Building and using safe links
99− -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
105− -- * Adding custom types
110− , LinkArrayElementStyle (..)
111− -- ** Link accessors
120−import Data.Semigroup
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
129− (KnownSymbol, symbolVal)
131− (URI (..), escapeURIString, isUnreserved)
133−import Prelude.Compat
135−import Servant.API.Alternative
137−import Servant.API.BasicAuth
139−import Servant.API.Capture
140− (Capture', CaptureAll)
141−import Servant.API.Description
142− (Description, Summary)
143−import Servant.API.Empty
145−import Servant.API.Experimental.Auth
147−import Servant.API.Header
149−import Servant.API.HttpVersion
151−import Servant.API.IsSecure
153−import Servant.API.Modifiers
155−import Servant.API.QueryParam
156− (QueryFlag, QueryParam', QueryParams)
157−import Servant.API.Raw
159−import Servant.API.RemoteHost
161−import Servant.API.ReqBody
163−import Servant.API.Stream
165−import Servant.API.Sub
167−import Servant.API.TypeLevel
168−import Servant.API.Vault
170−import Servant.API.Verbs
172−import Servant.API.WithNamedContext
174−import Web.HttpApiData
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.
180− { _segments :: [Escaped]
181− , _queryParams :: [Param]
184−newtype Escaped = Escaped String
186−escaped :: String -> Escaped
187−escaped = Escaped . escapeURIString isUnreserved
189−getEscaped :: Escaped -> String
190−getEscaped (Escaped s) = s
192−instance Show Escaped where
193− showsPrec d (Escaped s) = showsPrec d s
194− show (Escaped s) = show s
196−linkSegments :: Link -> [String]
197−linkSegments = map getEscaped . _segments
199−linkQueryParams :: Link -> [Param]
200−linkQueryParams = _queryParams
202−instance ToHttpApiData Link where
203− toHeader = TE.encodeUtf8 . toUrlPiece
206− in Text.pack $ uriPath uri ++ uriQuery uri
208−-- | Query parameter.
210− = SingleParam String Text.Text
211− | ArrayElemParam String Text.Text
215−addSegment :: Escaped -> Link -> Link
216−addSegment seg l = l { _segments = _segments l <> [seg] }
218−addQueryParam :: Param -> Link -> Link
220− l { _queryParams = _queryParams l <> [qp] }
222−-- | Transform 'Link' into 'URI'.
224−-- >>> type API = "something" :> Get '[JSON] Int
225−-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
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
232−-- >>> type API = "foo/bar" :> Get '[JSON] Int
233−-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
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 = []}
241−-- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
242−-- abc/test%40example.com
244−linkURI :: Link -> URI
245−linkURI = linkURI' LinkArrayElementBracket
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)
253−-- | Configurable 'linkURI'.
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
259−-- >>> linkURI' LinkArrayElementPlain $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
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
269− makeQueries :: [Param] -> String
272− "?" <> intercalate "&" (fmap makeQuery xs)
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
279− style = case addBrackets of
280− LinkArrayElementBracket -> "[]="
281− LinkArrayElementPlain -> "="
283−escape :: String -> String
284−escape = escapeURIString isUnreserved
286−-- | Create a valid (by construction) relative URI with query params.
288−-- This function will only typecheck if `endpoint` is part of the API `api`
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
296−-- | More general 'safeLink'.
299− :: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
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)
306−-- | Create all links in an API.
308−-- Note that the @api@ type must be restricted to the endpoints that have
309−-- valid links to them.
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)
314−-- fooLink :: Text -> Link
316−-- barLink :: Int -> Link
318−-- Note: nested APIs don't work well with this approach
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)
324− :: forall api. HasLink api
327−allLinks = allLinks' id
329−-- | More general 'allLinks'. See `safeLink'`.
331− :: forall api a. HasLink api
335−allLinks' toA api = toLink toA api (Link mempty mempty)
337−-- | Construct a toLink for an endpoint.
338−class HasLink endpoint where
339− type MkLink endpoint (a :: *)
342− -> Proxy endpoint -- ^ The API endpoint you would like to point to
344− -> MkLink endpoint a
346−-- Naked symbol instance
347−instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
348− type MkLink (sym :> sub) a = MkLink sub a
350− toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
352− seg = symbolVal (Proxy :: Proxy sym)
354−-- QueryParam instances
355−instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
356− => HasLink (QueryParam' mods sym v :> sub)
358− type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
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
366− k = symbolVal (Proxy :: Proxy sym)
368−instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
369− => HasLink (QueryParams sym v :> sub)
371− type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
373− toLink toA (Proxy :: Proxy sub) .
374− foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
376− k = symbolVal (Proxy :: Proxy sym)
378−instance (KnownSymbol sym, HasLink sub)
379− => HasLink (QueryFlag sym :> sub)
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
387− k = symbolVal (Proxy :: Proxy sym)
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
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)
399−instance (ToHttpApiData v, HasLink sub)
400− => HasLink (Capture' mods sym v :> sub)
402− type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
404− toLink toA (Proxy :: Proxy sub) $
405− addSegment (escaped . Text.unpack $ toUrlPiece v) l
407−instance (ToHttpApiData v, HasLink sub)
408− => HasLink (CaptureAll sym v :> sub)
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
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)
418−instance HasLink sub => HasLink (Vault :> sub) where
419− type MkLink (Vault :> sub) a = MkLink sub a
420− toLink = simpleToLink (Proxy :: Proxy sub)
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)
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)
430−instance HasLink sub => HasLink (HttpVersion :> sub) where
431− type MkLink (HttpVersion:> sub) a = MkLink sub a
432− toLink = simpleToLink (Proxy :: Proxy sub)
434−instance HasLink sub => HasLink (IsSecure :> sub) where
435− type MkLink (IsSecure :> sub) a = MkLink sub a
436− toLink = simpleToLink (Proxy :: Proxy sub)
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)
442−instance HasLink sub => HasLink (RemoteHost :> sub) where
443− type MkLink (RemoteHost :> sub) a = MkLink sub a
444− toLink = simpleToLink (Proxy :: Proxy sub)
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)
450−instance HasLink EmptyAPI where
451− type MkLink EmptyAPI a = EmptyAPI
452− toLink _ _ _ = EmptyAPI
454−-- Verb (terminal) instances
455−instance HasLink (Verb m s ct a) where
456− type MkLink (Verb m s ct a) r = r
459−instance HasLink Raw where
460− type MkLink Raw a = a
463−instance HasLink (Stream m status fr ct a) where
464− type MkLink (Stream m status fr ct a) r = r
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)
472−-- | Helper for implemneting 'toLink' for combinators not affecting link
475− :: forall sub a combinator.
476− (HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
479− -> Proxy (combinator :> sub)
481− -> MkLink (combinator :> sub) a
482−simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
486−-- >>> import Servant.API
6+import Servant.Links
487−-- >>> import Data.Text (Text)