@@ -8,76 +8,102 @@
8{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE UndecidableInstances #-}
9{-# LANGUAGE UndecidableInstances #-}
11−-- | Type safe internal links.
11+-- | Type safe generation of internal links.
13−-- Provides the function 'mkLink':
13+-- Given an API with a few endpoints:
15−-- @
15+-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
16−-- {-# LANGUAGE DataKinds #-}
16+-- >>> import Servant.API
17−-- {-# LANGUAGE TypeFamilies #-}
17+-- >>> import Servant.Utils.Links
18−-- {-# LANGUAGE TypeOperators #-}
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
20−-- import Servant.API
27+-- It is possible to generate links that are guaranteed to be within 'API' with
21−-- import Servant.Utils.Links
28+-- 'safeLink'.
23−-- -- You might want to put some custom types in your API
30+-- The first argument to 'safeLink' is a symbol representing the endpoint you
24−-- data Thing = Thing
31+-- would like to point to. This will need to end in a verb like Get, or Post.
26−-- -- If you want these to form part of a valid URL, just add them to the
33+-- You may omit 'QueryParam's and the like should you not want to provide them,
27−-- -- open type family IsElem' like so:
34+-- but certain other types like 'Capture' must be included.
28−-- type instance IsElem' e (Thing :> s) = IsElem e s
30−-- type API = "hello" :> Thing :> Get Int
36+-- The reason you may want to omit 'QueryParam's is that safeLink is a bit
31−-- :<|> "bye" :> QueryParam "name" String :> Post Bool
37+-- magical: if parameters are included that could take input it will return a
38+-- function that accepts that input and generates a link.
33−-- api :: API
40+-- This is best shown with an example. Here, a link is generated with no
34−-- api = undefined
41+-- parameters:
36−-- link1 :: "hello" :> Get Int
43+-- >>> let hello = Proxy :: Proxy ("hello" :> Get Int)
37−-- link1 = undefined
44+-- >>> print $ safeLink hello api
39−-- link2 :: "hello" :> Delete
47+-- If the API has an endpoint with parameters then we can generate links with
40−-- link2 = undefined
48+-- or without those:
42−-- main :: IO ()
50+-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete)
43−-- main =
51+-- >>> print $ safeLink with api "Hubert"
44−-- -- typechecks, prints "/hello"'
52+-- bye?name=Hubert
45−-- let Link str = mkLink link1 api
48−-- -- doesn't typecheck
54+-- >>> let without = Proxy :: Proxy ("bye" :> Delete)
49−-- -- mkLink link2 api
55+-- >>> print $ safeLink without api
52−-- That is, 'mkLink' takes two arguments, a link and a sitemap, and
58+-- Attempting to construct a link to an endpoint that does not exist in api
53−-- returns a 'Link', but only typechecks if the link proxy is a valid link,
59+-- will result in a type error like this:
54−-- and part of the sitemap.
56−-- __N.B.:__ 'mkLink' assumes a capture matches any string (without slashes).
61+-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete)
62+-- >>> safeLink bad_link api
64+-- <interactive>:56:1:
65+-- Could not deduce (Or
66+-- (IsElem' Delete (Get Int))
68+-- ("hello" :> Delete)
69+-- ("bye" :> (QueryParam "name" String :> Delete))))
70+-- arising from a use of ‘safeLink’
71+-- In the expression: safeLink bad_link api
72+-- In an equation for ‘it’: it = safeLink bad_link api
74+-- This error is essentially saying that the type family couldn't find
75+-- bad_link under api after trying the open (but empty) type family
76+-- `IsElem'` as a last resort.
57module Servant.Utils.Links (
77module Servant.Utils.Links (
58− -- * Link and mkLink
78+ -- * Building and using safe links
59− -- | The only end-user utilities
79+ --
60− mkLink
80+ -- | Note that 'URI' is Network.URI.URI from the network-uri package.
61− , Link, unLink
81+ safeLink
62− -- * Internal
82+ , URI(..)
63− -- | These functions will likely only be of interest if you are writing
83+ -- * Adding custom types
64− -- more API combinators and would like to extend the behavior of
84+ , HasLink(..)
65− -- 'mkLink'
85+ , linkURI
66− , ValidLinkIn()
86+ , Link
67− , VLinkHelper(..)
87+ , IsElem'
68− , IsElem
88+ -- * Illustrative exports
69− , IsElem'
89+ , IsElem
73import Data.Proxy ( Proxy(..) )
94import Data.Proxy ( Proxy(..) )
95+import Data.Text (Text, unpack)
96+import Data.Monoid ( Monoid(..), (<>) )
97+import Network.URI ( URI(..), escapeURIString, isUnreserved )
74−import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
98+import GHC.TypeLits ( KnownSymbol, symbolVal )
75import GHC.Exts(Constraint)
99import GHC.Exts(Constraint)
101+import Servant.Common.Text
77import Servant.API.Capture ( Capture )
102import Servant.API.Capture ( Capture )
78import Servant.API.ReqBody ( ReqBody )
103import Servant.API.ReqBody ( ReqBody )
79import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
104import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
80import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
105import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
106+import Servant.API.Header ( Header )
81import Servant.API.Get ( Get )
107import Servant.API.Get ( Get )
82import Servant.API.Post ( Post )
108import Servant.API.Post ( Post )
83import Servant.API.Put ( Put )
109import Servant.API.Put ( Put )
@@ -86,20 +112,27 @@ import Servant.API.Sub ( type (:>) )
86import Servant.API.Raw ( Raw )
112import Servant.API.Raw ( Raw )
87import Servant.API.Alternative ( type (:<|>) )
113import Servant.API.Alternative ( type (:<|>) )
89−
115+-- | If either a or b produce an empty constraint, produce an empty constraint.
90type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
116type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
91 Or () b = ()
117 Or () b = ()
92 Or a () = ()
118 Or a () = ()
94−type family And (a :: Constraint) (b :: Constraint) :: Constraint where
120+-- | You may use this type family to tell the type checker that your custom type
95− And () () = ()
121+-- is a valid part of a link like so:
123+-- Not that 'IsElem' is called, which mutually recurses back to `IsElem'`
125+-- >>> data CustomThing
126+-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s
128+-- Now you can add a HasLink instance and you are ready to go.
97type family IsElem' a s :: Constraint
129type family IsElem' a s :: Constraint
131+-- | Closed type family, check if endpoint is within api
99−type family IsElem a s :: Constraint where
132+type family IsElem endpoint api :: Constraint where
100 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
133 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
101 IsElem (e :> sa) (e :> sb) = IsElem sa sb
134 IsElem (e :> sa) (e :> sb) = IsElem sa sb
102− IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
135+ IsElem sa (Header x :> sb) = IsElem sa sb
103 IsElem sa (ReqBody x :> sb) = IsElem sa sb
136 IsElem sa (ReqBody x :> sb) = IsElem sa sb
104 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
137 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
105 IsElem sa (QueryParams x y :> sb) = IsElem sa sb
138 IsElem sa (QueryParams x y :> sb) = IsElem sa sb
@@ -110,45 +143,187 @@ type family IsElem a s :: Constraint where
110 IsElem e e = ()
143 IsElem e e = ()
111 IsElem e a = IsElem' e a
144 IsElem e a = IsElem' e a
113−type family IsLink'' l :: Constraint where
146+-- | A safe link datatype.
114− IsLink'' (e :> Get x) = IsLink' e
147+-- The only way of constructing a 'Link' is using 'safeLink', which means any
115− IsLink'' (e :> Post x) = IsLink' e
148+-- 'Link' is guaranteed to be part of the mentioned API.
116− IsLink'' (e :> Put x) = IsLink' e
149+data Link = Link
117− IsLink'' (e :> Delete) = IsLink' e
150+ { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
118− IsLink'' (e :> Raw) = IsLink' e
151+ , _queryParams :: [Param Query]
120−type family IsLink' e :: Constraint where
155+-- Phantom types for Param
121− IsLink' (f :: Symbol) = ()
156+data Matrix
123−type family IsLink e :: Constraint where
159+-- | Query/Matrix param
124− IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
160+data Param a
125− (IsLink'' (a :> b))
161+ = SingleParam String Text
162+ | ArrayElemParam String Text
166+addSegment :: String -> Link -> Link
167+addSegment seg l = l { _segments = _segments l ++ [seg] }
128−-- | The 'ValidLinkIn f s' constraint holds when 's' is an API that
169+addQueryParam :: Param Query -> Link -> Link
129−-- contains 'f', and 'f' is a link.
170+addQueryParam qp l =
130−class ValidLinkIn f s where
171+ l { _queryParams = _queryParams l ++ [qp] }
131− mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
132− -- is an URI within `s`
134−instance ( IsElem f s
173+-- Not particularly efficient for many updates. Something to optimise if it's
135− , IsLink f
174+-- a problem.
136− , VLinkHelper f) => ValidLinkIn f s where
175+addMatrixParam :: Param Matrix -> Link -> Link
137− mkLink _ _ = Link (vlh (Proxy :: Proxy f))
176+addMatrixParam param l = l { _segments = f (_segments l) }
179+ f xs = init xs ++ [g (last xs)]
180+ -- Modify the segment at the "top" of the stack
181+ g :: String -> String
184+ SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v)
185+ ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v)
186+ FlagParam k -> seg <> ";" <> k
139−-- | A safe link datatype.
188+instance Monoid Link where
140−-- The only way of constructing a 'Link' is using 'mkLink', which means any
189+ mempty = Link mempty mempty
141−-- 'Link' is guaranteed to be part of the mentioned API.
190+ mappend (Link a1 b1) (Link a2 b2) =
142−newtype Link = Link { unLink :: String } deriving Show
191+ Link (a1 <> a2) (b1 <> b2)
193+linkURI :: Link -> URI
194+linkURI (Link segments q_params) =
195+ URI mempty -- No scheme (relative)
196+ Nothing -- Or authority (relative)
197+ (intercalate "/" segments)
198+ (makeQueries q_params) mempty
200+ makeQueries :: [Param Query] -> String
203+ "?" <> intercalate "&" (fmap makeQuery xs)
205+ makeQuery :: Param Query -> String
206+ makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (unpack v)
207+ makeQuery (SingleParam k v) = escape k <> "=" <> escape (unpack v)
208+ makeQuery (FlagParam k) = escape k
210+escape :: String -> String
211+escape = escapeURIString isUnreserved
213+-- | Create a valid (by construction) relative URI with query params.
215+-- This function will only typecheck if `endpoint` is part of the API `api`
217+ :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
218+ => Proxy endpoint -- ^ The API endpoint you would like to point to
219+ -> Proxy api -- ^ The whole API that you this endpoint is a part of
221+safeLink endpoint _ = link endpoint mempty
223+-- | Construct a link for an endpoint
224+class HasLink endpoint where
225+ type MkLink endpoint
226+ link :: Proxy endpoint -- ^ The API endpoint you would like to point to
230+-- Naked symbol instance
231+instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
232+ type MkLink (sym :> sub) = MkLink sub
234+ link (Proxy :: Proxy sub) . addSegment seg
236+ seg = symbolVal (Proxy :: Proxy sym)
239+-- QueryParam instances
240+instance (KnownSymbol sym, ToText v, HasLink sub)
241+ => HasLink (QueryParam sym v :> sub) where
242+ type MkLink (QueryParam sym v :> sub) = v -> MkLink sub
244+ link (Proxy :: Proxy sub)
245+ (addQueryParam (SingleParam k (toText v)) l)
248+ k = symbolVal (Proxy :: Proxy sym)
250+instance (KnownSymbol sym, ToText v, HasLink sub)
251+ => HasLink (QueryParams sym v :> sub) where
252+ type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
254+ link (Proxy :: Proxy sub) .
255+ foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l
257+ k = symbolVal (Proxy :: Proxy sym)
259+instance (KnownSymbol sym, HasLink sub)
260+ => HasLink (QueryFlag sym :> sub) where
261+ type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
263+ link (Proxy :: Proxy sub) l
265+ link (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
267+ k = symbolVal (Proxy :: Proxy sym)
269+-- MatrixParam instances
270+instance (KnownSymbol sym, ToText v, HasLink sub)
271+ => HasLink (MatrixParam sym v :> sub) where
272+ type MkLink (MatrixParam sym v :> sub) = v -> MkLink sub
274+ link (Proxy :: Proxy sub) $
275+ addMatrixParam (SingleParam k (toText v)) l
277+ k = symbolVal (Proxy :: Proxy sym)
279+instance (KnownSymbol sym, ToText v, HasLink sub)
280+ => HasLink (MatrixParams sym v :> sub) where
281+ type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub
283+ link (Proxy :: Proxy sub) .
284+ foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l
286+ k = symbolVal (Proxy :: Proxy sym)
288+instance (KnownSymbol sym, HasLink sub)
289+ => HasLink (MatrixFlag sym :> sub) where
290+ type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub
292+ link (Proxy :: Proxy sub) l
294+ link (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l
296+ k = symbolVal (Proxy :: Proxy sym)
299+instance HasLink sub => HasLink (ReqBody a :> sub) where
300+ type MkLink (ReqBody a :> sub) = MkLink sub
301+ link _ = link (Proxy :: Proxy sub)
303+instance (ToText v, HasLink sub)
304+ => HasLink (Capture sym v :> sub) where
305+ type MkLink (Capture sym v :> sub) = v -> MkLink sub
307+ link (Proxy :: Proxy sub) $
308+ addSegment (escape . unpack $ toText v) l
310+-- Verb (terminal) instances
311+instance HasLink (Get r) where
312+ type MkLink (Get r) = URI
144−class VLinkHelper f where
315+instance HasLink (Post r) where
145− vlh :: forall proxy. proxy f -> String
316+ type MkLink (Post r) = URI
147−instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where
319+instance HasLink (Put r) where
148− vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)
320+ type MkLink (Put r) = URI
150−instance VLinkHelper (Get x) where
323+instance HasLink Delete where
151− vlh _ = ""
324+ type MkLink Delete = URI
153−instance VLinkHelper (Post x) where
327+instance HasLink Raw where
154− vlh _ = ""
328+ type MkLink Raw = URI