From e180c98004e213ff99d963f391b5f973ce952f7a Mon Sep 17 00:00:00 2001 From: defanor Date: Mon, 4 Feb 2019 12:43:09 +0300 Subject: Remove the wai-extra dependency --- Main.hs | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) (limited to 'Main.hs') diff --git a/Main.hs b/Main.hs index 2540c8b..165aaeb 100644 --- a/Main.hs +++ b/Main.hs @@ -43,7 +43,6 @@ import Database.PostgreSQL.LibPQ ExecStatus(..)) import Data.Maybe (mapMaybe, fromMaybe, catMaybes) import Data.Text.Encoding (encodeUtf8) -import Network.Wai.Middleware.HttpAuth (extractBasicAuth) import Network.HTTP.Types.Header (hWWWAuthenticate) import System.Timeout (timeout) import Network.Wai.Handler.FastCGI (run) @@ -53,12 +52,16 @@ import Control.Exception (bracket, finally) import System.FilePath (replaceExtension, takeFileName, ()) import System.Environment (lookupEnv) import Data.List (nubBy) +import Data.ByteString.Base64 (decodeLenient) import Foreign import Foreign.C -- * libxml bindings and functions +-- http://xmlsoft.org/html/index.html +-- http://xmlsoft.org/XSLT/html/index.html + data XmlDoc data XsltStylesheet data XsltTransformContext @@ -252,6 +255,16 @@ serve xsltDirectory ioc req respond = do (BL.fromStrict doc) respError st e = resp st (errorXML e) +-- https://tools.ietf.org/html/rfc7235 +-- https://tools.ietf.org/html/rfc7617 +baCredentials :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString) +baCredentials cred = do + (login, password) <- + BS.break (== ':') . decodeLenient <$> BS.stripPrefix "Basic " cred + if BS.length password > 0 + then Just (login, BS.tail password) + else Nothing + main :: IO () main = do exsltRegisterAll @@ -260,7 +273,7 @@ main = do run $ \req respond -> maybe (respond $ responseLBS status504 [] "") pure =<< timeout (to * 10 ^ (6 :: Int)) - (case ("authorised" `elem` pathInfo req, extractBasicAuth + (case ("authorised" `elem` pathInfo req, baCredentials =<< lookup hAuthorization (requestHeaders req)) of (True, Just (l, p)) -> serve xsltDir -- cgit v1.2.3