Snap 中的 HTTP 基本身份验证？

Question

我确定我一定遗漏了一些明显的东西，但我找不到任何在 Snap 应用程序中使用 HTTP Basic 身份验证的内置方法。 Auth snaplet (https://hackage.haskell.org/package/snap-0.14.0.4) 似乎没有提供任何使用 HTTP Basic 的机制，所以此时我基本上是自己编写的：

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"

然后我就这样使用它； throwChallenge 和 throwDenied 是我认为的几个助手，它们是在 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

它有效，但在 2015 年必须自己为 Web 框架编写这个似乎很荒谬。那么它到底在哪里？

哦，另外，我知道 https://hackage.haskell.org/package/wai-extra 中有用于提供 HTTP Basic 身份验证的 WAI 中间件，但我不太幸运地弄清楚是否有办法将其集成到 Snap 中；我发现的唯一 wai 集成包已弃用。

Answer 1

我猜要么还没有完成，要么做过的人觉得它很简单，不值得发布到 hackage。后者是有道理的，因为通常将某些内容上传到 hackage 会带来一些您会支持它的期望。但是，如果您认为有必要，请自行将其黑客化。

Snap 中的 HTTP 基本身份验证？

HTTP Basic Auth in Snap?

authentication

haskell

haskell-snap-framework