@@ -1,4 +1,5 @@
1{-# LANGUAGE PolyKinds #-}
1{-# LANGUAGE PolyKinds #-}
2+{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
@@ -6,77 +7,146 @@
6{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE UndecidableInstances #-}
9{-# LANGUAGE UndecidableInstances #-}
9−-- | Type safe internal links.
11+-- | Type safe generation of internal links.
13+-- Given an API with a few endpoints:
15+-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
16+-- >>> import Servant.API
17+-- >>> import Servant.Utils.Links
18+-- >>> import Data.Proxy
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
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
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:
14−-- type API = Proxy ("hello" :> Get Int
42+-- >>> let hello = Proxy :: Proxy ("hello" :> Get Int)
15−-- :<|> "bye" :> QueryParam "name" String :> Post Bool)
43+-- >>> print (safeLink api hello :: URI)
17−-- api :: API
46+-- If the API has an endpoint with parameters then we can generate links with
18−-- api = proxy
47+-- or without those:
20−-- link1 :: Proxy ("hello" :> Get Int)
49+-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete)
21−-- link1 = proxy
50+-- >>> print $ safeLink api with "Hubert"
23−-- link2 :: Proxy ("hello" :> Delete)
53+-- >>> let without = Proxy :: Proxy ("bye" :> Delete)
24−-- link2 = proxy
54+-- >>> print $ safeLink api without
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
28−-- mkLink link2 API -- doesn't typecheck
61+-- >>> :set -XConstraintKinds
63+-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
64+-- >>> => Proxy endpoint -> MkLink endpoint
65+-- >>> apiLink = safeLink api
31−-- That is, 'mkLink' takes two arguments, a link proxy and a sitemap, and
68+-- Attempting to construct a link to an endpoint that does not exist in api
32−-- returns a 'Link', but only typechecks if the link proxy is a valid link,
69+-- will result in a type error like this:
33−-- and part of the sitemap.
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
74+-- <interactive>:64:1:
75+-- Could not deduce (Or
76+-- (IsElem' Delete (Get Int))
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
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.
36module Servant.Utils.Links (
87module Servant.Utils.Links (
37− -- * Link and mkLink
88+ -- * Building and using safe links
38− -- | The only end-user utilities
89+ --
39− mkLink
90+ -- | Note that 'URI' is Network.URI.URI from the network-uri package.
41− -- * Internal
92+ , URI(..)
42− -- | These functions will likely only be of interest if you are writing
93+ -- * Adding custom types
43− -- more API combinators and would like to extend the behavior of
94+ , HasLink(..)
44− -- 'mkLink'
95+ , linkURI
45− , ValidLinkIn()
96+ , Link
46− , VLinkHelper(..)
97+ , IsElem'
98+ -- * Illustrative exports
51import Data.Proxy ( Proxy(..) )
104import Data.Proxy ( Proxy(..) )
105+import Data.Text (Text, unpack)
106+import Data.Monoid ( Monoid(..), (<>) )
107+import Network.URI ( URI(..), escapeURIString, isUnreserved )
52−import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
108+import GHC.TypeLits ( KnownSymbol, symbolVal )
109+import GHC.Exts(Constraint)
111+import Servant.Common.Text
54import Servant.API.Capture ( Capture )
112import Servant.API.Capture ( Capture )
55import Servant.API.ReqBody ( ReqBody )
113import Servant.API.ReqBody ( ReqBody )
56import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
114import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
57import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
115import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
116+import Servant.API.Header ( Header )
58import Servant.API.Get ( Get )
117import Servant.API.Get ( Get )
59import Servant.API.Post ( Post )
118import Servant.API.Post ( Post )
60import Servant.API.Put ( Put )
119import Servant.API.Put ( Put )
61import Servant.API.Delete ( Delete )
120import Servant.API.Delete ( Delete )
62import Servant.API.Sub ( type (:>) )
121import Servant.API.Sub ( type (:>) )
122+import Servant.API.Raw ( Raw )
63import Servant.API.Alternative ( type (:<|>) )
123import Servant.API.Alternative ( type (:<|>) )
125+-- | If either a or b produce an empty constraint, produce an empty constraint.
126+type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
66−type family Or a b where
130+-- | You may use this type family to tell the type checker that your custom type
67− Or 'False 'False = 'False
131+-- may be skipped as part of a link. This is useful for things like
68− Or 'True b = 'True
132+-- 'QueryParam' that are optional in a URI and do not affect them if they are
69− Or a 'True = 'True
133+-- omitted.
71−type family And a b where
135+-- >>> data CustomThing
72− And 'True 'True = 'True
136+-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s
73− And a 'False = 'False
137+--
74− And 'False b = 'False
138+-- Note that 'IsElem' is called, which will mutually recurse back to `IsElem'`
139+-- if it exhausts all other options again.
141+-- Once you have written a HasLink instance for CustomThing you are ready to
143+type family IsElem' a s :: Constraint
145+-- | Closed type family, check if endpoint is within api
76−type family IsElem a s where
146+type family IsElem endpoint api :: Constraint where
77 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
147 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
78 IsElem (e :> sa) (e :> sb) = IsElem sa sb
148 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
80 IsElem sa (ReqBody x :> sb) = IsElem sa sb
150 IsElem sa (ReqBody x :> sb) = IsElem sa sb
81 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
151 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
82 IsElem sa (QueryParams x y :> sb) = IsElem sa sb
152 IsElem sa (QueryParams x y :> sb) = IsElem sa sb
@@ -84,48 +154,185 @@ type family IsElem a s where
84 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
154 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
85 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
155 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
86 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
156 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
87− IsElem e e = 'True
157+ IsElem e e = ()
88− IsElem e a = 'False
158+ IsElem e a = IsElem' e a
90−type family IsLink'' l where
160+-- | A safe link datatype.
91− IsLink'' (e :> Get x) = IsLink' e
161+-- The only way of constructing a 'Link' is using 'safeLink', which means any
92− IsLink'' (e :> Post x) = IsLink' e
162+-- 'Link' is guaranteed to be part of the mentioned API.
93− IsLink'' (e :> Put x) = IsLink' e
163+data Link = Link
94− IsLink'' (e :> Delete) = IsLink' e
164+ { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
95− IsLink'' a = 'False
165+ , _queryParams :: [Param Query]
97−type family IsLink' e where
98− IsLink' (f :: Symbol) = 'True
100−type family IsLink e where
169+-- Phantom types for Param
101− IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
170+data Matrix
102− (IsLink'' (a :> b))
171+data Query
173+-- | Query/Matrix param
175+ = SingleParam String Text
176+ | ArrayElemParam String Text
105−-- | The 'ValidLinkIn f s' constraint holds when 's' is an API that
180+addSegment :: String -> Link -> Link
106−-- contains 'f', and 'f' is a link.
181+addSegment seg l = l { _segments = _segments l <> [seg] }
107−class ValidLinkIn f s where
108− mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
109− -- is an URI within `s`
111−instance ( IsElem f s ~ 'True
183+addQueryParam :: Param Query -> Link -> Link
112− , IsLink f ~ 'True
184+addQueryParam qp l =
113− , VLinkHelper f) => ValidLinkIn f s where
185+ l { _queryParams = _queryParams l <> [qp] }
114− mkLink _ _ = Link (vlh (Proxy :: Proxy f))
116−-- | A safe link datatype.
187+-- Not particularly efficient for many updates. Something to optimise if it's
117−-- The only way of constructing a 'Link' is using 'mkLink', which means any
188+-- a problem.
118−-- 'Link' is guaranteed to be part of the mentioned API.
189+addMatrixParam :: Param Matrix -> Link -> Link
119−data Link = Link String deriving Show
190+addMatrixParam param l = l { _segments = f (_segments l) }
193+ f xs = init xs <> [g (last xs)]
194+ -- Modify the segment at the "top" of the stack
195+ g :: String -> String
198+ SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v)
199+ ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v)
200+ FlagParam k -> seg <> ";" <> k
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
209+ makeQueries :: [Param Query] -> String
212+ "?" <> intercalate "&" (fmap makeQuery xs)
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
219+escape :: String -> String
220+escape = escapeURIString isUnreserved
222+-- | Create a valid (by construction) relative URI with query params.
224+-- This function will only typecheck if `endpoint` is part of the API `api`
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
230+safeLink _ endpoint = toLink endpoint (Link mempty mempty)
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
239+-- Naked symbol instance
240+instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
241+ type MkLink (sym :> sub) = MkLink sub
243+ toLink (Proxy :: Proxy sub) . addSegment seg
245+ seg = symbolVal (Proxy :: Proxy sym)
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
253+ toLink (Proxy :: Proxy sub)
254+ (addQueryParam (SingleParam k (toText v)) l)
257+ k = symbolVal (Proxy :: Proxy sym)
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
263+ toLink (Proxy :: Proxy sub) .
264+ foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l
266+ k = symbolVal (Proxy :: Proxy sym)
268+instance (KnownSymbol sym, HasLink sub)
269+ => HasLink (QueryFlag sym :> sub) where
270+ type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
272+ toLink (Proxy :: Proxy sub) l
274+ toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
276+ k = symbolVal (Proxy :: Proxy sym)
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
283+ toLink (Proxy :: Proxy sub) $
284+ addMatrixParam (SingleParam k (toText v)) l
286+ k = symbolVal (Proxy :: Proxy sym)
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
292+ toLink (Proxy :: Proxy sub) .
293+ foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l
295+ k = symbolVal (Proxy :: Proxy sym)
297+instance (KnownSymbol sym, HasLink sub)
298+ => HasLink (MatrixFlag sym :> sub) where
299+ type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub
301+ toLink (Proxy :: Proxy sub) l
303+ toLink (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l
305+ k = symbolVal (Proxy :: Proxy sym)
308+instance HasLink sub => HasLink (ReqBody a :> sub) where
309+ type MkLink (ReqBody a :> sub) = MkLink sub
310+ toLink _ = toLink (Proxy :: Proxy sub)
312+instance (ToText v, HasLink sub)
313+ => HasLink (Capture sym v :> sub) where
314+ type MkLink (Capture sym v :> sub) = v -> MkLink sub
316+ toLink (Proxy :: Proxy sub) $
317+ addSegment (escape . unpack $ toText v) l
319+-- Verb (terminal) instances
320+instance HasLink (Get r) where
321+ type MkLink (Get r) = URI
121−class VLinkHelper f where
324+instance HasLink (Post r) where
122− vlh :: forall proxy. proxy f -> String
325+ type MkLink (Post r) = URI
124−instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where
328+instance HasLink (Put r) where
125− vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)
329+ type MkLink (Put r) = URI
127−instance VLinkHelper (Get x) where
332+instance HasLink Delete where
128− vlh _ = ""
333+ type MkLink Delete = URI
130−instance VLinkHelper (Post x) where
336+instance HasLink Raw where
131− vlh _ = ""
337+ type MkLink Raw = URI