diff options
| -rw-r--r-- | Main.hs | 17 | ||||
| -rw-r--r-- | pgxhtml.cabal | 2 |
2 files changed, 16 insertions, 3 deletions
@@ -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 diff --git a/pgxhtml.cabal b/pgxhtml.cabal index 0af9c36..79370ae 100644 --- a/pgxhtml.cabal +++ b/pgxhtml.cabal @@ -17,6 +17,7 @@ executable pgxhtml main-is: Main.hs other-extensions: OverloadedStrings build-depends: base >=4.9 && <5 + , base64-bytestring >= 1.0.0.1 , bytestring >=0.10 && <0.11 , filepath >=1.4 && <1.5 , http-api-data >=0.3 && <0.4 @@ -26,7 +27,6 @@ executable pgxhtml , text >=1.2 && <1.3 , unordered-containers >=0.2 && <0.3 , wai >=3.2 && <3.3 - , wai-extra >=3.0 && <3.1 , wai-handler-fastcgi >= 3.0.0.2 default-language: Haskell2010 pkgconfig-depends: libxml-2.0, libxslt, libexslt |