module Ketchup.Auth
( basicAuth
) where
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Base64 as B64
import Ketchup.Httpd
import Ketchup.Utils
basicAuth :: [(B.ByteString, B.ByteString)]
-> B.ByteString
-> Handler
-> Handler
basicAuth couples realm success hnd req =
case authHead of
Nothing -> send401
Just x -> case authData `elem` couples of
False -> send401
True -> success hnd req
where
authData = parseAuth $ x !! 0
where
authHead = lookup "Authorization" $ headers req
authField = B.concat ["Basic realm=\"",realm,"\""]
send401 = sendReply hnd 401 [("WWW-Authenticate", [authField])
,("Content-Type", ["text/html"])]
"<h1>401 Unauthorized</h1>"
parseAuth :: B.ByteString -> (B.ByteString, B.ByteString)
parseAuth authStr =
breakBS ":" $ B64.decodeLenient authData
where
authData = snd parts
parts = breakBS " " authStr