Базовая HTTP-аутентификация в Snap?

Я уверен, что должен упустить что-то очевидное, но я не могу найти встроенного способа использования базовой HTTP-аутентификации в приложении Snap. Снаплет аутентификации (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-монаде:

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-аутентификации в https://hackage.haskell.org/package/wai-extra, но мне не очень повезло выяснить, есть ли способ интегрировать это в Snap; единственные пакеты интеграции wai, которые я нашел, устарели.


authentication haskell haskell-snap-framework
person Kris Nuttycombe    schedule 26.05.2015    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Я предполагаю, что либо это не было сделано, либо люди, которые это сделали, посчитали, что это было достаточно просто, чтобы его не стоило публиковать в hackage. Последнее имеет смысл, потому что, как правило, загрузка чего-либо в hackage подразумевает некоторое ожидание того, что вы это поддержите. Но если вы считаете, что это необходимо, не стесняйтесь поставить его на взлом самостоятельно.

person mightybyte    schedule 26.05.2015