Intro

I am using servant to serve dynamic websites, as well as APIs. Last time I added SEO plugin to its ecosystem. This time I am going to extend servant itself. Here we go.

Problem statement

Consider URI fragment. In Web it could be recognized as HTML anchor. It is not part of REST API. It is a part of URL. And not the deprecated one.

Consider GitHub, e.g. follow the link and look on its URL: https://github.com/haskell-servant/servant/blob/master/default.nix#L22. Page content is the same with and without anchor #L22 at the end of URL. This anchor changes content representation (i.e. highlights line #22).

I would like to have this feature available inside servant core package, since fragment is a part of URI and could be used on both server and client side. Despite it might be abused in non-HTML use-cases.

Fragment

According to RFC 3986, Fragment provides secondary information in advance to primary URI. It might be specified or not. It could be at the end of URI.

It could be appended directly to path and only once. Otherwise, if query string is not empty, it could be present at the end of query string.

According to RFC 2616, Fragment should be secured on both client and server sides. curl strips the fragment from URL. Web browsers also removes it before sending to server.

Nevertheless, fragment could be served in redirects on server side. It could appear on HTML page as an anchor to corresponding section and even used for indexing single page applications.

Like sitemap, it is supported in yesod framework but not in servant.

Proposal for Servant

What I initially wanted was looked like data Fragment (a :: *) that transformed to Maybe a on both client and server side.
I also wanted to violate HTTP spec and bypass security considerations allowing fragment to be sent from client or to be handled by server.
Fragment of any type should be present per API endpoint only once. Uniqueness should be checked during compilation time.
On server side parsing errors should be ignored.

However, it turns out that is not quite good to decide about parsing behaviour for users.

Proposal for Servant #2

With modifiers combinator it transforms to data Fragment' (mods :: [*]) (a :: *).
Second statement from previous proposal (HTTP violation) remains the same.
Third statement from previous proposal (fragment uniqueness in API endpoint) remains the same.
It should be possible for user to handle parsing errors on server side. Thus, default fragment should be lenient in terms of servant.

Proposal for Servant #3

During discussion about implementation details with Servant Contributors I was convinced to follow HTTP spec and remove client/server part of the feature.

Thus, the final approach looks like:

Following combinator should be introduced for Fragment: data Fragment (a :: *).
Fragment of any type should be present per API endpoint only once. Uniqueness should be checked during compilation time.
Server should ignore fragment.
Client should ignore fragment.
Fragment should be available via Link.

Design and Implementation

servant is a single repository with multiple packages inside. It represents the core of servant ecosystem and maintained by Servant Contributors.

It provides following packages:

servant (core).
servant-client-core.
servant-client.
servant-server.
servant-docs.
servant-foreign.
And even more…

All requirements will be splitted across the packages.

Functional requirements

`servant`

Separate combinator for URI Fragment should be produced.
Fragment is always representing no value for server.
Framgent is always representing no value for client.
It should be restricted by constraint which allows only one fragment per API endpoint.
In case of more than one fragment, custom error should be raised during compilation.
Compilation error should print API subset that contains two fragments in one endpoint.
Compilation error should be triggered from both sides: client and server.
User should be able to supply his own type for fragment.
Link from Servant.Links should support fragment.
URI with fragment should be restored from Link if fragment specified.

Implementation details

servant (core)

Fragment combinator defined as unhabitant data type (requirements #1, #8).

data Fragment (a :: *)

Link (Servant.Links)

The main idea here is to produce type-safe links for specific endpoints within API.

There is a Link.

class HasLink endpoint where
    type MkLink endpoint (a :: *)
    toLink
        :: (Link -> a)
        -> Proxy endpoint -- ^ The API endpoint you would like to point to
        -> Link
        -> MkLink endpoint a

HasLink is the way to make the Link through the API from its pieces.
linkURI' and linkURI are the functions to produce target URI from Link.
And few more functions like safeLink' and allLinks'.
And also instance ToHttpApiData Link is also affected.

Since fragment is optional part of URI and it could be present separately from path or query, Link should be extended with fragment:

data Link = Link
   { _segments    :: [Escaped]
   , _queryParams :: [Param]
   , _fragment    :: Maybe String
   } deriving Show

Fragment should become a member of HasLink type class (requirement #9):

instance (HasLink sub, ToHttpApiData v)
     => HasLink (Fragment v :> sub) where
   type MkLink (Fragment v :> sub) a = v -> MkLink sub a
   toLink toA _ l mv =
       toLink toA (Proxy :: Proxy sub) $
          addFragment ((Just . Text.unpack . toQueryParam) mv) l

MkLink type expands user supplied type to a function parameter.
Link would be extended with a Fragment via addFragment helper.

URI would be updated with escaped fragment (requirements #9, #10):

linkURI' :: LinkArrayElementStyle -> Link -> URI
linkURI' addBrackets (Link segments q_params mfragment) =
    URI mempty  -- No scheme (relative)
        Nothing -- Or authority (relative)
        (intercalate "/" $ map getEscaped segments)
        (makeQueries q_params)
        (makeFragment mfragment)
  where
    makeQueries :: [Param] -> String
    makeQueries [] = ""
    makeQueries xs =
        "?" <> intercalate "&" (fmap makeQuery xs)

    makeQuery :: Param -> String
    makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
    makeQuery (SingleParam k v)    = escape k <> "=" <> escape (Text.unpack v)
    makeQuery (FlagParam k)        = escape k

    makeFragment :: Fragment' -> String
    makeFragment Nothing = ""
    makeFragment (Just fr) = "#" <> escape fr

    style = case addBrackets of
        LinkArrayElementBracket -> "[]="
        LinkArrayElementPlain -> "="

Link instance would become extended with fragment.

instance ToHttpApiData Link where
     toHeader   = TE.encodeUtf8 . toUrlPiece
     toUrlPiece l =
         let uri = linkURI l
         in Text.pack $ uriPath uri ++ uriQuery uri
         in Text.pack $ uriPath uri ++ uriQuery uri ++ uriFragment uri

Understanding type families

Servant offers several type families to operate with API on type level.

Firstly, I wanted to practice with them.

>>> :set -XDataKinds -XTypeOperators -XPolyKinds -XTypeFamilies
>>> :kind! Endpoints (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent)
Endpoints (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent) :: [*]
= '[Fragment Bool
    :> (Fragment Int :> Verb 'GET 200 '[JSON] NoContent)]
>>> :{
| type family Filter (a :: *) (bs :: [*]) :: [*] where
|   Filter a '[] = '[]
|   Filter a (a ': bs) = a ': Filter a bs
|   Filter a (b ': bs) = Filter a bs
| :}
>>> :kind! Filter Bool '[Int, Char]
Filter Bool '[Int, Char] :: [*]
= '[]
>>> :kind! Filter Bool '[Int, Char, Bool, String]
Filter Bool '[Int, Char, Bool, String] :: [*]
= '[Bool]

Then I came with following algorithm: Map Snd (Filter ((> 1) . Fst) (Map (CountInEndPoint Fragment) (Endpoints api)).

Produce endpoints list from API with Endpoints.
Count fragments of any type in endpoints list for all endpoints.
Filter all remaining endpoints list where fragment of any type appears more than once.
Get all fragments and raise type level error for them.

However, I did not succeeded with this approach. Idea of Map as higher-order type-family that could accept type family as an argument and apply it to every list element was a bit hard for me.

And then it clicked. Constraint! And again: I do not need a list of types!

Type-level constraint

Type error I want to produce:

>>> :{
| type NotUniqueFragmentInApi api =
|     'Text "Only one Fragment allowed per endpoint in api ‘"
|     ':<>: 'ShowType api
|     ':<>: 'Text "’."
| :}
>>> :kind! (NotUniqueFragmentInApi (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent))
(NotUniqueFragmentInApi (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent)) :: ErrorMessage
= NotUniqueFragmentInApi
    (Fragment Bool :> (Fragment Int :> Get '[JSON] NoContent))

Type family for checking that fragment should not be present in API:

>>> :{
| type family FragmentNotIn api orig :: Constraint where
|   FragmentNotIn (sa :<|> sb)       orig =
|     And (FragmentNotIn sa orig) (FragmentNotIn sb orig)
|   FragmentNotIn (Fragment c :> sa) orig = TypeError (NotUniqueFragmentInApi orig)
|   FragmentNotIn (x :> sa)          orig = FragmentNotIn sa orig
|   FragmentNotIn (Fragment c)       orig = TypeError (NotUniqueFragmentInApi orig)
|   FragmentNotIn x                  orig = ()
| :}

<interactive>:45:3: error:
    • Illegal nested type family application ‘And
                                                (FragmentNotIn sa orig) (FragmentNotIn sb orig)’
      (Use UndecidableInstances to permit this)
    • In the equations for closed type family ‘FragmentNotIn’
      In the type family declaration for ‘FragmentNotIn’

GHC advises to enable UndecidableInstances extension. OK!

>>> :set -XUndecidableInstances
>>> :{
| type family FragmentNotIn api orig :: Constraint where
|   FragmentNotIn (sa :<|> sb)       orig =
|     And (FragmentNotIn sa orig) (FragmentNotIn sb orig)
|   FragmentNotIn (Fragment c :> sa) orig = TypeError (NotUniqueFragmentInApi orig)
|   FragmentNotIn (x :> sa)          orig = FragmentNotIn sa orig
|   FragmentNotIn (Fragment c)       orig = TypeError (NotUniqueFragmentInApi orig)
|   FragmentNotIn x                  orig = ()
| :}
>>> :kind! FragmentNotIn (Fragment Int :> Get '[JSON] NoContent) (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent)
FragmentNotIn (Fragment Int :> Get '[JSON] NoContent) (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent) :: Constraint
= (TypeError ...)
>>> :kind! FragmentNotIn (Get '[JSON] NoContent) (Fragment Int :> Get '[JSON] NoContent)
FragmentNotIn (Get '[JSON] NoContent) (Fragment Int :> Get '[JSON] NoContent) :: Constraint
= () :: Constraint

Good!

Now, define type family for checking uniqueness in whole API:

>>> :{
| type family FragmentUnique api :: Constraint where
|   FragmentUnique (sa :<|> sb)       = And (FragmentUnique sa) (FragmentUnique sb)
|   FragmentUnique (Fragment a :> sa) = FragmentNotIn sa (Fragment a :> sa)
|   FragmentUnique (x :> sa)          = FragmentUnique sa
|   FragmentUnique (Fragment a)       = ()
|   FragmentUnique x                  = ()
| :}

In order to make this constraint work on type-level I have to add extra type class.

>>> class FragmentUnique api => AtLeastOneFragment api

<interactive>:92:1: error:
    • Potential superclass cycle for ‘AtLeastOneFragment’
        one of whose superclass constraints is headed by a type family:
          ‘FragmentUnique api’
      Use UndecidableSuperClasses to accept this
    • In the class declaration for ‘AtLeastOneFragment’

GHC tells me to enable UndecidableSuperClasses extension!

>>> :set -XUndecidableSuperClasses
>>> class FragmentUnique api => AtLeastOneFragment api

Good!

Now, test instances for different APIs:

>>> instance AtLeastOneFragment (Fragment Bool :> Get '[JSON] NoContent)

<interactive>:95:10: error:
    • Illegal instance declaration for
        ‘AtLeastOneFragment (Fragment Bool :> Get '[JSON] NoContent)’
        (All instance types must be of the form (T a1 ... an)
         where a1 ... an are *distinct type variables*,
         and each type variable appears at most once in the instance head.
         Use FlexibleInstances if you want to disable this.)
    • In the instance declaration for
        ‘AtLeastOneFragment (Fragment Bool :> Get '[JSON] NoContent)’

Again, enable FlexibleInstances extension.

>>> :set -XFlexibleInstances
>>> instance AtLeastOneFragment (Fragment Bool :> Get '[JSON] NoContent)
>>> instance AtLeastOneFragment (Fragment Bool :> Fragment Int :> Get '[JSON] NoContent)

<interactive>:98:10: error:
    • Only one Fragment allowed per endpoint in api ‘Fragment Bool
                                                     :> (Fragment Int :> Get '[JSON] NoContent)’.
    • In the instance declaration for
        ‘AtLeastOneFragment
           (Fragment Bool :> (Fragment Int :> Get '[JSON] NoContent))’

Now I have type class that raises type errors when several fragments would be in API. And these kind of errors would be catched during compile time. Awesome! (Requirements #4, #5, #6, #7).

servant-client-core

Since Fragment is a new API combinator, I have to provide the instance of HasClient for it (requirement #3).

class RunClient m => HasClient m api where
  type Client (m :: * -> *) (api :: *) :: *
  clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
  hoistClientMonad
    :: Proxy m
    -> Proxy api
    -> (forall x. mon x -> mon' x)
    -> Client mon api
    -> Client mon' api

Client stands for producing type of a function for querying API.
clientWithRoute populates Request while traversing API.
hoistClientMonad is the way to hoist client from one monad to another.

AtLeastOneFragment constraint used here to restrict API with fragments and raise an error described in previous section (requirement #3, client-side).

instance ( AtLeastOneFragment api, HasClient m api
         , FragmentUnique (Fragment a :> api)
         ) => HasClient m (Fragment a :> api) where

  type Client m (Fragment a :> api) = Client m api

  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

  hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)

servant-server

Server API processed in HasServer type class:

class HasServer api context where
  type ServerT api (m :: * -> *) :: *

  route ::
       Proxy api
    -> Context context
    -> Delayed env (Server api)
    -> Router env

  hoistServerWithContext
      :: Proxy api
      -> Proxy context
      -> (forall x. m x -> n x)
      -> ServerT api m
      -> ServerT api n

ServerT represents the API type.
route takes API, context, Delayed env (Server api) and produces the Router. Delayed is a representation of a handler with scheduled delayed checks that can trigger errors. See its documentation for further explanation. Router stands for Application.
hoistServerWithContext is the way to hoist server from one monad to another with context provided by user.

instance ( AtLeastOneFragment api, HasServer api context
         , FragmentUnique (Fragment a1 :> api)
         )
    => HasServer (Fragment a1 :> api) context where

Again, AtLeastOneFragment constraint used here to restrict API with fragments and raise an error described in previous section (requirement #2, server-side).

  type ServerT (Fragment a1 :> api) m = ServerT api m

  route _ = route (Proxy :: Proxy api)
  
  hoistServerWithContext _ = hoistServerWithContext (Proxy :: Proxy api)

Tests

Servant offers ComprehensiveAPI to cover the most combinators, doctests to catch compile-time errors and hspec for functional tests of different packages and components.

ComprehensiveAPI

    :<|> "fragment" :> Fragment Int :> GET

I added this line in definition of a ComprehensiveAPIWithoutStreamingOrRaw' type and quickly discovered that Fragment impacts two different packages I have not used before: servant-docs and servant-foreign. I realised that ComprehensiveAPI is a good way to keep the whole set of packages consistent.

doctests

With doctest you can incorporate your tests right into documentation (haddock).

Example of fragment definition:

-- >>> -- /post#TRACKING
-- >>> type MyApi = "post" :> Fragment Text :> Get '[JSON] Tracking

Example of type-level test:

-- >>> type FailAPI = Fragment Bool :> Fragment Int :> Get '[JSON] NoContent
-- >>> instance AtLeastOneFragment FailAPI
-- ...
-- ...Only one Fragment allowed per endpoint in api...
-- ...
-- ...In the instance declaration for...

All imports could be incorporated into scope of module via $setup named chunk. See documentation for more details.

hspec

servant, servant-client and servant-server packages were covered with hspec tests.

Servant.Links generates correct URI for specified fragment.
Servant.Client generates correct client according to specified server.
Servant.Server generates correct server handlers.

Conclusion

One small piece of URL and a lot of details. I am happy to achieve this simple goal.

Fragment is available on hackage since servant-0.18.2.

Acknowledgments

pitometsu for bringing interesting idea to look at the fragment.
Servant Contributors: fizruk, fisx, arianvp and maksbotan - for patience during review this particular feature.

Andrey Prokopenko's Blog

URI Fragment support for Servant