summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2019-02-04 12:43:09 +0300
committerdefanor <defanor@uberspace.net>2019-02-04 12:43:09 +0300
commite180c98004e213ff99d963f391b5f973ce952f7a (patch)
treeb52a5699625c0db80e3f3b3886da93bf429aeab9
parentbc46b6bd4575c7f8ff04232f1c6edd1c92eb8e05 (diff)
downloadpgxhtml-e180c98004e213ff99d963f391b5f973ce952f7a.zip
pgxhtml-e180c98004e213ff99d963f391b5f973ce952f7a.tar.gz
pgxhtml-e180c98004e213ff99d963f391b5f973ce952f7a.tar.bz2
Remove the wai-extra dependency
-rw-r--r--Main.hs17
-rw-r--r--pgxhtml.cabal2
2 files changed, 16 insertions, 3 deletions
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
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