From e180c98004e213ff99d963f391b5f973ce952f7a Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Mon, 4 Feb 2019 12:43:09 +0300
Subject: Remove the wai-extra dependency

---
 Main.hs       | 17 +++++++++++++++--
 pgxhtml.cabal |  2 +-
 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
-- 
cgit v1.2.3