servant a functional dependency error with `enter`

I slightly changed the app shown in the servant tutorial to make Reader monad a ReaderT, like so

{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeOperators              #-}

module Lib
    ( runServer
    ) where

import           Control.Monad.Except
import           Control.Monad.Reader
import qualified Data.Text                as T
import           Network.Wai
import           Servant

type WebApi
  =    "static" :> Raw
  :<|> "foo" :> Get '[PlainText] T.Text

type Foo = String

server :: ServerT WebApi (ReaderT Foo (ExceptT ServantErr IO))
server = static :<|> foo
  where
    static :: Application
    static = undefined

    -- Handler T.Text
    foo :: ReaderT Foo (ExceptT ServantErr IO) T.Text
    foo = undefined

webAPI :: Proxy WebApi
webAPI = Proxy

readerToHandler :: Foo -> ReaderT Foo (ExceptT ServantErr IO) :~> ExceptT ServantErr IO
readerToHandler t = Nat (\x -> runReaderT x t)

-- readerServer :: ServerT WebApi (ExceptT ServantErr IO)
-- readerServer = enter (readerToHandler "foobarbaz") server

-- serve' :: Application
-- serve' = serve webAPI server

runServer :: IO ()
runServer = return ()

The trouble is I can't enable readerServer function, type checking fails with this inscrutable error

src/Lib.hs:45:16: error:
    • Couldn't match type ‘IO’ with ‘ExceptT ServantErr IO’
        arising from a functional dependency between:
          constraint ‘Servant.Utils.Enter.Enter
                        (IO ResponseReceived)
                        (ReaderT Foo (ExceptT ServantErr IO) :~> ExceptT ServantErr IO)
                        (IO ResponseReceived)’
            arising from a use of ‘enter’
          instance ‘Servant.Utils.Enter.Enter (m a) (m :~> n) (n a)’
            at <no location info>
    • In the expression: enter (readerToHandler "foobarbaz") server
      In an equation for ‘readerServer’:
          readerServer = enter (readerToHandler "foobarbaz") server
Failed, modules loaded: none.

Any ideas what's going wrong?

Solution

The problem is the presence of the Raw endpoint, which doesn't interact well with enter. This is a known annoyance in Servant.

The Enter typeclass determines what sets of handlers can be transformed, and with what transformations. It has three instances:

Enter (m a) ((:~>) m n) (n a) The simplest case. If you have a monadic action and a natural transformation that takes it to a different monad, you can apply the transformation.
Enter b arg ret => Enter (a -> b) arg (a -> ret). If you have a handler that takes a parameter and you know how to transform the final monadic action of the handler, you can transform the handler using the same arg transformation.
(Enter typ1 arg1 ret1, Enter typ2 arg2 ret2, (~) * arg1 arg2) => Enter ((:<|>) typ1 typ2) arg1 ((:<|>) ret1 ret2) If you have a composition :<|> of handlers and each handler can be transformed individually using the same natural transformation arg1, then you can transform the composition with arg1 as well.

This last condition fails in your example, because the handler for Raw has type Application, which is Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived, while the other handler is a ReaderT Foo (ExceptT ServantErr IO) action. The types don't match, so the composition doesn't have an Enter instance.

There is a workaround: call enter on your custom handlers, and only afterwards compose them with the Application handler.

type WebApi
  =    "static" :> Raw
  :<|> FooEndpoint

type FooEndpoint = "foo" :> Get '[PlainText] T.Text

readerServer :: ServerT WebApi (ExceptT ServantErr IO)
readerServer = static :<|> enter (readerToHandler "foobarbaz") foo
  where
    static :: Application
    static = undefined
    foo :: ReaderT Foo (ExceptT ServantErr IO) T.Text
    foo = undefined