Dmitry M
Dmitry M

Reputation: 53

haskell servant servant-auth and servant-checked-exceptions problem

I am try to use this packages with servant:

servant-auth, servant-auth-server,

servant-checked-exceptions

This code:

type Unprotected = "reg2" :> QueryParam "name" String
                 :> QueryParam "email" String
                 :> QueryParam "pwd" String
                 :> Throws HRegFieldErrors
                 :> Throws UserRegError

type Protected =  "test" 
                 :> Throws SomeError
                 :> Get '[PlainText] String
                 :<|> ...

I found that reg2 handler for API works fine, but for protected section test handler I got this error:

app/Main.hs:185:20: error:
    • Couldn't match type: Envelope
                             '[SomeError]
                             (Headers
                                '[Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie]
                                [Char])
                     with: Headers
                             '[Header "Set-Cookie" SetCookie]
                             (Headers
                                '[Header "Set-Cookie" SetCookie] (Envelope '[SomeError] [Char]))
        arising from a use of ‘serveWithContext’
    • In the second argument of ‘($)’, namely
        ‘serveWithContext api cfg (server env jwtCfg)’
      In a stmt of a 'do' block:
        run 8080 $ serveWithContext api cfg (server env jwtCfg)
      In the expression:
        do print "wait for mysql"
           print "try to connect..."
           pool_ <- myResourcePool
           let i_config = ...
           ....
    |
185 |         run 8080 $ serveWithContext api cfg (server env jwtCfg)

handler for test:

protected :: Env -> Servant.Auth.Server.AuthResult AuthData -> Server Protected
protected env (Servant.Auth.Server.Authenticated authdata) = test
      where
        test :: Handler (Envelope '[SomeError] String)
        test = do
                            liftIO $ print "test"
                            pureErrEnvelope SomeError
protected _ _ = throwAll err401

start server code:

type API auths = (Servant.Auth.Server.Auth auths AuthData :> Protected) :<|> Unprotected
server :: Env -> JWTSettings -> Server (API auths)
server env jwts = protected env :<|> unprotected env jwts

let i_config = Config { appName = "MyApp", version = 1 }
let env = Env {cfg = i_config, pool = pool_}
-- pool <- myResourcePool
print "start servant server http://localhost:8080"
--run 8080 (serve appAPI $ server env)
myKey <- generateKey
let jwtCfg = defaultJWTSettings myKey--jwt_secret
    cfg = defaultCookieSettings :. jwtCfg :. EmptyContext
    api = Proxy :: Proxy (API '[JWT])
run 8080 $ serveWithContext api cfg (server env jwtCfg)

Also I found that if I move test handler to "Unprotected section" it works fine. So I think that servant-checked-exceptions "Throws" or "Envelope" some how lead to this errors inside Protected section. How to fix this?

Upvotes: 3

Views: 68

Answers (0)

Related Questions