HTTP Basic Auth in Snap？

Question

我确信我肯定遗漏了一些显而易见的东西，但是我找不到任何内置的方法来使用HTTP在一个简单的应用程序中。Auth (https://hackage.haskell.org/package/snap-0.14.0.4)似乎没有提供任何使用HTTP的机制，因此在这一点上，我基本上已经编写了自己的：

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中实现必要的短路：

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年。那它到底在哪？

哦，我也知道有WAI中间件可以在https://hackage.haskell.org/package/wai-extra中提供HTTP，但是我还没搞清楚是否有一种方法可以在Snap中集成这一点；我发现的唯一的wai集成包都被废弃了。

Answer 1

我猜，要么是还没做过，要么是有人觉得它很简单，不值得发布到黑客上。后者是有意义的，因为通常上传一些东西到hackage会带来一定的期望，您将支持它。但是，如果你认为它是必要的，你可以随意把它放进黑客系统。