@@ -1,4 +1,5 @@
11{-# LANGUAGE PolyKinds #-}
2+{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleInstances #-}
45{-# LANGUAGE TypeFamilies #-}
@@ -6,77 +7,146 @@
67{-# LANGUAGE FunctionalDependencies #-}
78{-# LANGUAGE ScopedTypeVariables #-}
89{-# LANGUAGE UndecidableInstances #-}
9−-- | Type safe internal links.
10+
11+-- | Type safe generation of internal links.
12+--
13+-- Given an API with a few endpoints:
14+--
15+-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
16+-- >>> import Servant.API
17+-- >>> import Servant.Utils.Links
18+-- >>> import Data.Proxy
19+-- >>>
20+-- >>>
21+-- >>>
22+-- >>> type Hello = "hello" :> Get Int
23+-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete
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 'URI' out the
33+-- other end.
1034--
11−-- Provides the function 'mkLink':
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:
1241--
13−-- @
14−-- type API = Proxy ("hello" :> Get Int
15−-- :<|> "bye" :> QueryParam "name" String :> Post Bool)
42+-- >>> let hello = Proxy :: Proxy ("hello" :> Get Int)
43+-- >>> print (safeLink api hello :: URI)
44+-- hello
1645--
17−-- api :: API
18−-- api = proxy
46+-- If the API has an endpoint with parameters then we can generate links with
47+-- or without those:
1948--
20−-- link1 :: Proxy ("hello" :> Get Int)
21−-- link1 = proxy
49+-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete)
50+-- >>> print $ safeLink api with "Hubert"
51+-- bye?name=Hubert
2252--
23−-- link2 :: Proxy ("hello" :> Delete)
24−-- link2 = proxy
53+-- >>> let without = Proxy :: Proxy ("bye" :> Delete)
54+-- >>> print $ safeLink api without
55+-- bye
2556--
26−-- mkLink link1 API -- typechecks, returns 'Link "/hello"'
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:
2760--
28−-- mkLink link2 API -- doesn't typecheck
29−-- @
61+-- >>> :set -XConstraintKinds
62+-- >>> :{
63+-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
64+-- >>> => Proxy endpoint -> MkLink endpoint
65+-- >>> apiLink = safeLink api
66+-- >>> :}
3067--
31−-- That is, 'mkLink' takes two arguments, a link proxy and a sitemap, and
32−-- returns a 'Link', but only typechecks if the link proxy is a valid link,
33−-- and part of the sitemap.
68+-- Attempting to construct a link to an endpoint that does not exist in api
69+-- will result in a type error like this:
3470--
35−-- __N.B.:__ 'mkLink' assumes a capture matches any string (without slashes).
71+-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete)
72+-- >>> safeLink api bad_link
73+-- <BLANKLINE>
74+-- <interactive>:64:1:
75+-- Could not deduce (Or
76+-- (IsElem' Delete (Get Int))
77+-- (IsElem'
78+-- ("hello" :> Delete)
79+-- ("bye" :> (QueryParam "name" String :> Delete))))
80+-- arising from a use of ‘safeLink’
81+-- In the expression: safeLink api bad_link
82+-- In an equation for ‘it’: it = safeLink api bad_link
83+--
84+-- This error is essentially saying that the type family couldn't find
85+-- bad_link under api after trying the open (but empty) type family
86+-- `IsElem'` as a last resort.
3687module Servant.Utils.Links (
37− -- * Link and mkLink
38− -- | The only end-user utilities
39− mkLink
40− , Link
41− -- * Internal
42− -- | These functions will likely only be of interest if you are writing
43− -- more API combinators and would like to extend the behavior of
44− -- 'mkLink'
45− , ValidLinkIn()
46− , VLinkHelper(..)
47− , IsElem
48− , IsLink
49− )where
88+ -- * Building and using safe links
89+ --
90+ -- | Note that 'URI' is Network.URI.URI from the network-uri package.
91+ safeLink
92+ , URI(..)
93+ -- * Adding custom types
94+ , HasLink(..)
95+ , linkURI
96+ , Link
97+ , IsElem'
98+ -- * Illustrative exports
99+ , IsElem
100+ , Or
101+) where
50102
103+import Data.List
51104import Data.Proxy ( Proxy(..) )
52−import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
105+import Data.Text (Text, unpack)
106+import Data.Monoid ( Monoid(..), (<>) )
107+import Network.URI ( URI(..), escapeURIString, isUnreserved )
108+import GHC.TypeLits ( KnownSymbol, symbolVal )
109+import GHC.Exts(Constraint)
53110
111+import Servant.Common.Text
54112import Servant.API.Capture ( Capture )
55113import Servant.API.ReqBody ( ReqBody )
56114import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
57115import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
116+import Servant.API.Header ( Header )
58117import Servant.API.Get ( Get )
59118import Servant.API.Post ( Post )
60119import Servant.API.Put ( Put )
61120import Servant.API.Delete ( Delete )
62121import Servant.API.Sub ( type (:>) )
122+import Servant.API.Raw ( Raw )
63123import Servant.API.Alternative ( type (:<|>) )
64124
125+-- | If either a or b produce an empty constraint, produce an empty constraint.
126+type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
127+ Or () b = ()
128+ Or a () = ()
65129
66−type family Or a b where
67− Or 'False 'False = 'False
68− Or 'True b = 'True
69− Or a 'True = 'True
70−
71−type family And a b where
72− And 'True 'True = 'True
73− And a 'False = 'False
74− And 'False b = 'False
130+-- | You may use this type family to tell the type checker that your custom type
131+-- may be skipped as part of a link. This is useful for things like
132+-- 'QueryParam' that are optional in a URI and do not affect them if they are
133+-- omitted.
134+--
135+-- >>> data CustomThing
136+-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s
137+--
138+-- Note that 'IsElem' is called, which will mutually recurse back to `IsElem'`
139+-- if it exhausts all other options again.
140+--
141+-- Once you have written a HasLink instance for CustomThing you are ready to
142+-- go.
143+type family IsElem' a s :: Constraint
75144
76−type family IsElem a s where
145+-- | Closed type family, check if endpoint is within api
146+type family IsElem endpoint api :: Constraint where
77147 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
78148 IsElem (e :> sa) (e :> sb) = IsElem sa sb
79− IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
149+ IsElem sa (Header x :> sb) = IsElem sa sb
80150 IsElem sa (ReqBody x :> sb) = IsElem sa sb
81151 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
82152 IsElem sa (QueryParams x y :> sb) = IsElem sa sb
@@ -84,48 +154,185 @@ type family IsElem a s where
84154 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
85155 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
86156 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
87− IsElem e e = 'True
88− IsElem e a = 'False
157+ IsElem e e = ()
158+ IsElem e a = IsElem' e a
89159
90−type family IsLink'' l where
91− IsLink'' (e :> Get x) = IsLink' e
92− IsLink'' (e :> Post x) = IsLink' e
93− IsLink'' (e :> Put x) = IsLink' e
94− IsLink'' (e :> Delete) = IsLink' e
95− IsLink'' a = 'False
160+-- | A safe link datatype.
161+-- The only way of constructing a 'Link' is using 'safeLink', which means any
162+-- 'Link' is guaranteed to be part of the mentioned API.
163+data Link = Link
164+ { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
165+ , _queryParams :: [Param Query]
166+ } deriving Show
96167
97−type family IsLink' e where
98− IsLink' (f :: Symbol) = 'True
99168
100−type family IsLink e where
101− IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
102− (IsLink'' (a :> b))
169+-- Phantom types for Param
170+data Matrix
171+data Query
103172
173+-- | Query/Matrix param
174+data Param a
175+ = SingleParam String Text
176+ | ArrayElemParam String Text
177+ | FlagParam String
178+ deriving Show
104179
105−-- | The 'ValidLinkIn f s' constraint holds when 's' is an API that
106−-- contains 'f', and 'f' is a link.
107−class ValidLinkIn f s where
108− mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
109− -- is an URI within `s`
180+addSegment :: String -> Link -> Link
181+addSegment seg l = l { _segments = _segments l <> [seg] }
110182
111−instance ( IsElem f s ~ 'True
112− , IsLink f ~ 'True
113− , VLinkHelper f) => ValidLinkIn f s where
114− mkLink _ _ = Link (vlh (Proxy :: Proxy f))
183+addQueryParam :: Param Query -> Link -> Link
184+addQueryParam qp l =
185+ l { _queryParams = _queryParams l <> [qp] }
115186
116−-- | A safe link datatype.
117−-- The only way of constructing a 'Link' is using 'mkLink', which means any
118−-- 'Link' is guaranteed to be part of the mentioned API.
119−data Link = Link String deriving Show
187+-- Not particularly efficient for many updates. Something to optimise if it's
188+-- a problem.
189+addMatrixParam :: Param Matrix -> Link -> Link
190+addMatrixParam param l = l { _segments = f (_segments l) }
191+ where
192+ f [] = []
193+ f xs = init xs <> [g (last xs)]
194+ -- Modify the segment at the "top" of the stack
195+ g :: String -> String
196+ g seg =
197+ case param of
198+ SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v)
199+ ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v)
200+ FlagParam k -> seg <> ";" <> k
201+
202+linkURI :: Link -> URI
203+linkURI (Link segments q_params) =
204+ URI mempty -- No scheme (relative)
205+ Nothing -- Or authority (relative)
206+ (intercalate "/" segments)
207+ (makeQueries q_params) mempty
208+ where
209+ makeQueries :: [Param Query] -> String
210+ makeQueries [] = ""
211+ makeQueries xs =
212+ "?" <> intercalate "&" (fmap makeQuery xs)
213+
214+ makeQuery :: Param Query -> String
215+ makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (unpack v)
216+ makeQuery (SingleParam k v) = escape k <> "=" <> escape (unpack v)
217+ makeQuery (FlagParam k) = escape k
218+
219+escape :: String -> String
220+escape = escapeURIString isUnreserved
221+
222+-- | Create a valid (by construction) relative URI with query params.
223+--
224+-- This function will only typecheck if `endpoint` is part of the API `api`
225+safeLink
226+ :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
227+ => Proxy api -- ^ The whole API that this endpoint is a part of
228+ -> Proxy endpoint -- ^ The API endpoint you would like to point to
229+ -> MkLink endpoint
230+safeLink _ endpoint = toLink endpoint (Link mempty mempty)
231+
232+-- | Construct a toLink for an endpoint.
233+class HasLink endpoint where
234+ type MkLink endpoint
235+ toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to
236+ -> Link
237+ -> MkLink endpoint
238+
239+-- Naked symbol instance
240+instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
241+ type MkLink (sym :> sub) = MkLink sub
242+ toLink _ =
243+ toLink (Proxy :: Proxy sub) . addSegment seg
244+ where
245+ seg = symbolVal (Proxy :: Proxy sym)
246+
247+
248+-- QueryParam instances
249+instance (KnownSymbol sym, ToText v, HasLink sub)
250+ => HasLink (QueryParam sym v :> sub) where
251+ type MkLink (QueryParam sym v :> sub) = v -> MkLink sub
252+ toLink _ l v =
253+ toLink (Proxy :: Proxy sub)
254+ (addQueryParam (SingleParam k (toText v)) l)
255+ where
256+ k :: String
257+ k = symbolVal (Proxy :: Proxy sym)
258+
259+instance (KnownSymbol sym, ToText v, HasLink sub)
260+ => HasLink (QueryParams sym v :> sub) where
261+ type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
262+ toLink _ l =
263+ toLink (Proxy :: Proxy sub) .
264+ foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l
265+ where
266+ k = symbolVal (Proxy :: Proxy sym)
267+
268+instance (KnownSymbol sym, HasLink sub)
269+ => HasLink (QueryFlag sym :> sub) where
270+ type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
271+ toLink _ l False =
272+ toLink (Proxy :: Proxy sub) l
273+ toLink _ l True =
274+ toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
275+ where
276+ k = symbolVal (Proxy :: Proxy sym)
277+
278+-- MatrixParam instances
279+instance (KnownSymbol sym, ToText v, HasLink sub)
280+ => HasLink (MatrixParam sym v :> sub) where
281+ type MkLink (MatrixParam sym v :> sub) = v -> MkLink sub
282+ toLink _ l v =
283+ toLink (Proxy :: Proxy sub) $
284+ addMatrixParam (SingleParam k (toText v)) l
285+ where
286+ k = symbolVal (Proxy :: Proxy sym)
287+
288+instance (KnownSymbol sym, ToText v, HasLink sub)
289+ => HasLink (MatrixParams sym v :> sub) where
290+ type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub
291+ toLink _ l =
292+ toLink (Proxy :: Proxy sub) .
293+ foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l
294+ where
295+ k = symbolVal (Proxy :: Proxy sym)
296+
297+instance (KnownSymbol sym, HasLink sub)
298+ => HasLink (MatrixFlag sym :> sub) where
299+ type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub
300+ toLink _ l False =
301+ toLink (Proxy :: Proxy sub) l
302+ toLink _ l True =
303+ toLink (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l
304+ where
305+ k = symbolVal (Proxy :: Proxy sym)
306+
307+-- Misc instances
308+instance HasLink sub => HasLink (ReqBody a :> sub) where
309+ type MkLink (ReqBody a :> sub) = MkLink sub
310+ toLink _ = toLink (Proxy :: Proxy sub)
311+
312+instance (ToText v, HasLink sub)
313+ => HasLink (Capture sym v :> sub) where
314+ type MkLink (Capture sym v :> sub) = v -> MkLink sub
315+ toLink _ l v =
316+ toLink (Proxy :: Proxy sub) $
317+ addSegment (escape . unpack $ toText v) l
318+
319+-- Verb (terminal) instances
320+instance HasLink (Get r) where
321+ type MkLink (Get r) = URI
322+ toLink _ = linkURI
120323
121−class VLinkHelper f where
122− vlh :: forall proxy. proxy f -> String
324+instance HasLink (Post r) where
325+ type MkLink (Post r) = URI
326+ toLink _ = linkURI
123327
124−instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where
125− vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)
328+instance HasLink (Put r) where
329+ type MkLink (Put r) = URI
330+ toLink _ = linkURI
126331
127−instance VLinkHelper (Get x) where
128− vlh _ = ""
332+instance HasLink Delete where
333+ type MkLink Delete = URI
334+ toLink _ = linkURI
129335
130−instance VLinkHelper (Post x) where
131− vlh _ = ""
336+instance HasLink Raw where
337+ type MkLink Raw = URI
338+ toLink _ = linkURI