Type instance and phantom type

Question

I ran into a strange error, I cannot find a way to fix it. I’m using servant and I am trying to build a generic authentication library (no backend by default, for instance).

The code is the following:

type TokenProtect auth = AuthProtect "auth-token"
type instance AuthServerData (TokenProtect auth) = Id auth

Id is another type family. The error message is the following.

    • Family instance purports to bind type variable ‘auth’
        but the real LHS (expanding synonyms) is:
          AuthServerData (AuthProtect "auth-token") = ...
    • In the type instance declaration for ‘AuthServerData’

Do you know how I can fix this code?

Answer 1

You'll need to turn TokenProtect into a newtype wrapper:

newtype TokenProtect auth = TokenProtect (AuthProtect "auth-token")
type instance AuthServerData (TokenProtect auth) = Id auth

The reason for that is that type synonyms are just that: synonyms; so your code is equivalent to writing

type instance AuthServerData (AuthProtect "auth-token") = Id auth

which of course refers to the unbound type variable auth.

Answer 2

I encountered the issue using Servant, and I think my use case was similar to the original questioner's. Basically I wanted AuthProtect to allow me to thread a type constrained by some type synonym provided by a class through to my handlers, like

class IsDatabase db where 
   type DatabaseAuthResult db :: *
instance IsDatabase MyDBType
   type DatabaseAuthResult MyDBType = DBUser

Therefore needing something like the original poster's code:

type TokenProtect db = AuthProtect "auth-token"
type instance AuthServerData (TokenProtect db) = DatabaseAuthResult db

As far as I can work out, this is simply not possible within the structure of Servant's general auth implementation. Cactus' answer correctly says that you have to wrap the existential in a newtype, but that in itself will simply lead to a compilation error to do with Servant constraints, probably some issue with a HasServer instance.

There is a general answer to this issue, however, which is simply to replicate Servant's AuthProtect, AuthHandler etc with your own implementation, and write your own version of HasServer for it.

-- import for all the internal servant stuff like addAuthCheck
import Servant.Server.Internal.RoutingApplication

data DBAuthProtect (tag :: k) db deriving (Typeable)
newtype DBAuthHandler r db result = DBAuthHandler {unDBAuthHandler :: r -> Handler result}

instance ( HasServer api context
         , HasContextEntry context (DBAuthHandler Request db (AuthServerData (DBAuthProtect tag db))))
  => HasServer (DBAuthProtect tag db :> api) context where
  type ServerT (DBAuthProtect tag db :> api) m = AuthServerData (DBAuthProtect tag db) -> ServerT api m
  route Proxy context subserver = 
    route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)
      where 
       authHandler :: Request -> Handler (AuthServerData (DBAuthProtect tag db))
       authHandler = unDBAuthHandler (getContextEntry context)
       authCheck :: Request -> DelayedIO (AuthServerData (DBAuthProtect tag db))
       authCheck = (>>= either delayedFailFatal return) . liftIO . runExceptT . authHandler

You can then use this similarly to AuthProtect, so something like

type TokenProtect db = DBAuthProtect "auth-token" db
type instance AuthServerData (TokenProtect db) = DatabaseAuthResult db
type ProtectedAPI db = "private" :> TokenProtect db :> Get [...]
dbAuthHandler :: (IsDatabase db) => db -> DBAuthHandler Request db (DatabaseAuthResult db)
dbAuthHandler db = DBAuthHandler $ \ req -> do 
  -- req :: Request
  -- ... do some work here and return a type (DatabaseAuthResult db), so for MyDBType you would return DBUser - you have both the db itself and the request to work with

Finally you put this all together by using Servant's serveWithContext and in the context you provide the handler partially applied

mkContext :: db -> Context '[DBAuthHandler Request db (AuthServerData db)]
mkContext db = dbAuthHandler db :. EmptyContext

main :: IO ()
main = do 
  db <- getMyDBSomehow -- a concrete type, say MyDBType
  let myApi = (Proxy :: Proxy (ProtectedAPI MyDBType))
  serveWithContext myApi (mkContext db) handlers      

Basically the way this works is to thread a type variable through the various bits and pieces so you end up with an api parameterised by a db type (similarly for handlers), allowing you to use type synonyms in your api type and therefore in your handlers.

If you are using a custom monad for your app you can improve on this pattern by using enter when running your authHandler (and add any context your app monad needs to the context you pass to you serveWithContext, but that is beyond the scope of this question...).