CODEWITHSUNDEEP
haskellauthenticationhaskell-snap-framework
Kris Nuttycombe
Kris Nuttycombe

Reputation: 4580

HTTP Basic Auth in Snap?

I'm certain that I must be missing something obvious, but I can't find any built-in way to use HTTP Basic auth within a Snap application. The Auth snaplet (https://hackage.haskell.org/package/snap-0.14.0.4) doesn't appear to provide any mechanism for using HTTP Basic, so at this point I've basically written my own:

type AuthHeader = (Text, ByteString)

authHeaderParser :: Parser AuthHeader
authHeaderParser = do
  let isBase64Char w = (w >= 47 && w <= 57 ) ||
                       (w >= 64 && w <= 90 ) ||
                       (w >= 97 && w <= 122) ||
                       (w == 43 || w == 61 )
  b64     <- string "Basic " *> takeWhile1 isBase64Char 
  decoded <- either fail pure $ B64.decode b64 
  case split 58 decoded of
    (uname : pwd : []) -> pure $ (decodeUtf8 uname, pwd)
    _ -> fail "Could not unpack auth header into username and password components"

I then use this like so; throwChallenge and throwDenied are a couple of helpers that I think are the correct way to approach the necessary short-circuiting in the Snap monad:

import qualified Snap.Snaplet.Auth as AU

requireLogin :: Handler App App AU.AuthUser 
requireLogin = do
  req <- getRequest
  rawHeader    <- maybe throwChallenge pure $ getHeader "Authorization" req 
  (uname, pwd) <- either (throwDenied . AU.AuthError) pure $ parseOnly authHeaderParser rawHeader 
  authResult   <- with auth $ AU.loginByUsername uname (AU.ClearText pwd) False
  either throwDenied pure authResult

throwChallenge :: MonadSnap m => m a 
throwChallenge = do
    modifyResponse $ (setResponseStatus 401 "Unauthorized") . 
                     (setHeader "WWW-Authenticate" "Basic realm=myrealm")
    getResponse >>= finishWith

throwDenied :: MonadSnap m => AU.AuthFailure -> m a 
throwDenied failure = do
    modifyResponse $ setResponseStatus 403 "Access Denied"
    writeText $ "Access Denied: " <> tshow failure
    getResponse >>= finishWith

It works, but it seems ridiculous to have to write this myself for a web framework in 2015. So where the heck is it?

Oh, also, I'm aware that there's WAI middleware for providing HTTP Basic auth in https://hackage.haskell.org/package/wai-extra, but I've not had much luck figuring out whether there's a way to integrate this in Snap; the only wai integration packages I've found are deprecated.

Upvotes: 2

Views: 315

Answers (1)

mightybyte
mightybyte

Reputation: 7272

I'm guessing either it hasn't been done or people who did it felt it was simple enough that it wasn't worth posting to hackage. The latter makes sense because typically uploading something to hackage carries with it some expectation that you'll support it. But if you think it's needed feel free to put it on hackage yourself.

Upvotes: 1

Related Questions