Deny Authentication in Servant.Auth with RIO

Question

I'm trying to combine Servant authentication (servant-auth-server package) with RIO as my handler monad to avoid the ExceptT anti-pattern. However, I can't line up the types properly for handling denied authentications.

My (simplified) API endpoint is

type UserEndpoint = "user" :> (
              Get '[JSON] User                                       
        :<|>  ReqBody '[JSON] UpdatedUser :> Put '[JSON] User        
    )

and the corresponding server

protectedServer
  :: HasLogFunc m
  => AuthResult AuthUserId
  -> ServerT UserEndpoint (RIO m)
protectedServer (Authenticated authUser) =
  getUser authUser :<|> updateUser authUser
-- Otherwise, we return a 401.
protectedServer _ = throwIO err401

A type error arises in the branch for denied authentication:

    Could not deduce (MonadIO ((:<|>) (RIO m User)))
      arising from a use of ‘throwIO’
    [..]

I don't grok this type error. To my understanding (and given the signature of protectedServer), the return type should be ServerT UserEndpoint (RIO m), which should have an instance of MonadIO, so that exception handling according to the exceptions tutorial should use throwIO instead of throwAll from Servant.Auth.Server. It seems that I haven't fully understood Servant's type machinery yet, where is my mistake?

The two handler functions are defined as

updateUser :: HasLogFunc m => AuthUserId -> UpdatedUser -> RIO m User
updateUser authUser updateUser = ...

getUser :: HasLogFunc m => AuthUserId -> RIO m User
getUser authUser = ...

If you put a typed hole [`_`](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/typed_holes.html) in the place of `throwIO err401`, what is the inferred type of the hole? Also, if you try to run [`:kind! ServerT UserEndpoint (RIO ())`](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/ghci.html#ghci-cmd-:kind) in ghci, what is the expanded type that is returned? — danidiaz, Apr 26 '21 at 08:14
@danidiaz, the inferred type is `_ :: RIO m User :<|> (UpdatedUser -> RIO m User)` Where: ‘m’ is a rigid type variable bound by the type signature for: `protectedServer :: forall m. HasLogFunc m => AuthResult AuthUserId -> ServerT UserEndpoint (RIO m)`. Shouldn't `:<|>` combine the handler types into the output type, which here is `ServerT UserEndpoint (RIO m)`? — Ulrich Schuster, Apr 26 '21 at 08:17
A single `throwIO err401` like the one you are returning does not have type `_ :<|> _`. It seems that you have to compose the endpoint implementations with [`:<|>`](http://hackage.haskell.org/package/servant-0.18.2/docs/Servant-API.html#t::-60--124--62-), just like you did in the authenticated branch, only this time returning 401 codes. — danidiaz, Apr 26 '21 at 08:21
I don't understand why GHC infers that type in the first place, even though the function's signature says something else. Would that mean to have a separate authentication check in each handler function? That would be rather painful, verbose, and error prone. — Ulrich Schuster, Apr 26 '21 at 08:25
When giving an implementation for a server, if there are multiple endpoints like in your API, you have to supply a handler function for each of the endpoints, and combine them with `:<|>`. When you write a *single* `throwIO err401`, that is *not* a combination of implementations, it's a single handler! So you need to do just like you did in the authenticated branch: provide one handler per endpoint, and combine them with (`:<|>`). — danidiaz, Apr 26 '21 at 08:29
@danidiaz Thanks for the hint. I fixed the type error with the following definition for the unauthenticated case: `protectedServer _ = throwIO err401 :<|> (\_ -> throwIO err401)` It does type check, but it seems rather cumbersome, especially for more complex APIs :-( — Ulrich Schuster, Apr 26 '21 at 08:52

danidiaz · Accepted Answer · 2021-04-26T16:28:09.153

The problem was that throwIO err401 is a single RIO action. But when a servant server has more than one endpoint, each different handler must be composed with the :<|> combinator.

If your API has has many endpoints, it will quickly become annoying to write 401-returning handlers for each and every one. Fortunately, it seems that servant-auth-server provides a throwAll helper function which automatically builds error-returning handlers for an entire API.

Edit: as Ulrich has noted, the problem with throwAll is that it only works with MonadError monads, and RIO is not an instance of MonadError. But it should be possible to modify the typeclass so that it supports RIO.

First, some imports and helper datatypes:

{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleInstances,
             TypeFamilies, DataKinds, ImportQualifiedPost
             #-}
module Main where

import RIO (RIO) -- rio
import RIO qualified
import Data.Tagged               (Tagged (..)) -- package tagged
import Servant                   ((:<|>) (..), ServerError(..))
import Network.HTTP.Types -- package http-types
import Network.Wai -- package wai
import Data.ByteString.Char8 qualified as BS

And this is the main RIOThrowAll typeclass:

class RIOThrowAll a where
    rioThrowAll :: ServerError -> a

-- for a composition of endpoints
instance (RIOThrowAll a, RIOThrowAll b) => RIOThrowAll (a :<|> b) where
    rioThrowAll e = rioThrowAll e :<|> rioThrowAll e

-- if we have a function, we ignore the argument and delegate on the result
instance (RIOThrowAll b) => RIOThrowAll (a -> b) where
    rioThrowAll e = \_ -> rioThrowAll e

-- if we reach a RIO action at the tip of a function
instance RIOThrowAll (RIO.RIO env x) where
    rioThrowAll e = RIO.throwIO e

-- this is only for Raw endpoints which embed a WAI app directly
instance RIOThrowAll (Tagged (RIO.RIO env x) Application) where
  rioThrowAll e = Tagged $ \_req respond ->
      respond $ responseLBS (mkStatus (errHTTPCode e) (BS.pack $ errReasonPhrase e))
                            (errHeaders e)
                            (errBody e)

The problem with the `throwAll` helper is that it works only in Servant's own `Handler` monad, which is an ExceptT stack. I haven't found a way to make it work with RIOs approach to throw exceptions in IO. — Ulrich Schuster, Apr 26 '21 at 09:21
@UlrichSchuster Added a version of the [`ThrowAll`](http://hackage.haskell.org/package/servant-auth-server-0.4.6.0/docs/Servant-Auth-Server.html#t:ThrowAll) typeclass which should work with `RIO`. — danidiaz, Apr 26 '21 at 13:02
Oh wow, thanks very much for the elaborate answer! It'll take me some time to grok it and integrate it with my project. Once I figure it out, I'll report on my success here. — Ulrich Schuster, Apr 26 '21 at 13:36
I implemented the type class provided by @danidiaz above, it works like a charm. My RIO/Servant exploration is available here: https://github.com/uliSchuster/servant-auth-rio — Ulrich Schuster, Apr 27 '21 at 17:39

Deny Authentication in Servant.Auth with RIO

1 Answers1