2015-05-26 6 views
2

Я уверен, что я должен упустить что-то очевидное, но я не могу найти встроенный способ использования 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, которые я нашел, устарели.

ответ

1

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