Я уверен, что я должен упустить что-то очевидное, но я не могу найти встроенный способ использования HTTP Basic auth в приложении Snap. Snaplet Auth (https://hackage.haskell.org/package/snap-0.14.0.4) не представляется предоставить какой-либо механизм для использования HTTP Basic, поэтому на данный момент я в основном написал мой собственный:HTTP Basic Auth in Snap?
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 пара помощников, что я думаю является правильным способом приблизиться к необходимому короткому замыканию в Привязать монады:
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 для предоставления HTTP Basic auth в https://hackage.haskell.org/package/wai-extra, но мне не очень повезло в том, есть ли способ интегрировать это в Snap; единственные пакеты интеграции wai, которые я нашел, устарели.