Question

我确信我必须遗漏一些显而易见的东西，但我找不到任何内置方法在Snap应用程序中使用HTTP Basic auth。 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带来一些期望，你会支持它。但如果您认为需要随意将它放在hackage上。

Snap中的HTTP Basic Auth？

1 个答案: