CODEWITHSUNDEEP
haskellservant
l7r7
l7r7

Reputation: 1328

Servant client pagination

Given the following Servant API definition:

type API =
  "single-content" :> Get '[JSON] Int
    :<|> "contents" :> QueryParam "page" Int :> Get '[JSON] (Headers '[Header "Link" String] [Int])

The second endpoint is paginated, and contains a next Link header in the response if there are more elements.

I can generate client functions using servant-client:

paginatedClient :: Maybe Int -> ClientM (Headers '[Header "Link" String] [Int])
singleClient :: ClientM Int
singleClient :<|> paginatedClient = client (Proxy :: Proxy API)

I'm looking for a way to extend the client function for the paginated endpoint so that it automatically picks up the link from the response headers, call the next page, and accumulate the results.
Ideally, the type signature wouldn't change compared to the default client. It would be fine if the request would live in a different monad than ClientM.

I found some prior art and had some ideas, but nothing that brings me closer to my goal:

Upvotes: 1

Views: 180

Answers (1)

danidiaz
danidiaz

Reputation: 27766

Besides the usual Servant packages and imports, this answer also depends on http-client.

This is a function that takes a URL string and a Servant client action, and overwrites the path (and query string) of all HTTP requests performed by the action with the URL parameter.

import Network.HTTP.Client.Internal qualified as Http

overrideUrl :: String -> ClientM a -> ClientM a
overrideUrl url action = do
    request <- Http.parseRequest url
    let transformClientRequest original = 
            original { 
                Http.path = request.path, 
                Http.queryString = request.queryString  
                }
        transformMakeClientRequest f baseUrl servantReq = do 
            httpReq <- f baseUrl servantReq 
            pure $ transformClientRequest httpReq
        transformClientEnv clientEnv = 
            clientEnv { 
                  makeClientRequest = 
                    transformMakeClientRequest clientEnv.makeClientRequest 
                }
    local transformClientEnv action

It works by tweaking the values in the ClientEnv using local.

This is a function that takes a Servant client action that returns a monoidal value along with a "next page" link, and returns another action that collects all the results while following the links:

paginated :: 
    forall (s :: Symbol) rest a . Monoid a => 
    ClientM (Headers (Header s String ': rest) a) ->
    ClientM (Headers (Header s String ': rest) a)
paginated initial = do
    let go action acc = do
            r <- action
            let acc' = acc <> getResponse r
                HCons header _ = getHeadersHList r
            case header of 
                UndecodableHeader {} -> do
                    liftIO $ throwIO $ userError "undecodable header"
                MissingHeader -> do
                    pure $ r { getResponse = acc' }
                Header next -> do
                    go (overrideUrl next initial) acc'
    go initial mempty

paginated makes use of overrideUrl to go to a different link each time, while keeping the same request headers and other configuration.

The question now is how to apply the paginated decorator to your client. It's not done at the type level. Instead, you have to take your API client value, go into the particular client function that you want to paginate, and transform its ClientM action with the decorator in order to obtain a new API client. (If the client function has parameters, you'll need a bit more busywork to reach the ClientM action.)

Decorating the API client value is much easier if you use NamedRoutes (video) because then the client functions become name fields in a record, instead of being anonymous slots in and positional struture.

An example with named routes:

type PaginatedApi = NamedRoutes Foo

data Foo mode = Foo {
    firstContent :: 
        mode 
        :- "contents" 
        :> Get '[JSON] (Headers '[Header "Link" String] [Int]),
    extraContent :: 
        mode 
        :- "contents-extra" 
        :> Capture "page" Int 
        :> Get '[JSON] (Headers '[Header "Link" String] [Int])
  } deriving stock (Generic)

fooClient :: Client ClientM PaginatedApi
fooClient = client (Proxy @PaginatedApi)

fooClientDecorated :: Client ClientM PaginatedApi
fooClientDecorated = fooClient { firstContent = paginated fooClient.firstContent}

Upvotes: 2

Related Questions