summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-06-11 01:29:00 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-06-11 01:29:00 -0400
commitbac59cece66e97900554fdee394e8f86027a7d25 (patch)
tree211aabe948cb827ad10b2752865ec1a51ca1def9
parentf9e7c320eea31ce3cbec647e295d375ac09b7d82 (diff)
Fix build with wai 0.3.0.
This version of wai changed the type of Middleware, so I cannot seem to liftIO inside it. So, got rid of a lot of not really needed complexity to use System.Log.Logger's logging stuff, and just use the standard wai stdout logger when debug logging is enabled. Format may change some, and it logs http to stdout instead of stderr now. Doesn't matter for the webapp since both go to the same log anyway.
-rw-r--r--Assistant/Threads/WebApp.hs10
-rw-r--r--Utility/WebApp.hs33
-rw-r--r--debian/changelog1
-rw-r--r--debian/control2
-rw-r--r--git-annex.cabal2
5 files changed, 12 insertions, 36 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 8d977194b..416c07874 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -47,6 +47,8 @@ import Yesod
import Network.Socket (SockAddr, HostName)
import Data.Text (pack, unpack)
import qualified Network.Wai.Handler.WarpTLS as TLS
+import Network.Wai.Middleware.RequestLogger
+import System.Log.Logger
mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
@@ -83,7 +85,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
setUrlRenderer urlrenderer $ yesodRender webapp (pack "")
app <- toWaiAppPlain webapp
app' <- ifM debugEnabled
- ( return $ httpDebugLogger app
+ ( return $ logStdout app
, return app
)
runWebApp tlssettings listenhost' app' $ \addr -> if noannex
@@ -135,3 +137,9 @@ getTlsSettings = do
#else
return Nothing
#endif
+
+{- Checks if debugging is actually enabled. -}
+debugEnabled :: IO Bool
+debugEnabled = do
+ l <- getRootLogger
+ return $ getLevel l <= Just DEBUG
diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs
index c5e2a439e..0f3378a15 100644
--- a/Utility/WebApp.hs
+++ b/Utility/WebApp.hs
@@ -18,16 +18,12 @@ import qualified Yesod
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS
-import Network.Wai.Logger
-import Control.Monad.IO.Class
import Network.HTTP.Types
-import System.Log.Logger
import qualified Data.CaseInsensitive as CI
import Network.Socket
import "crypto-api" Crypto.Random
import qualified Web.ClientSession as CS
import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.UTF8 as L8
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -158,35 +154,6 @@ getSocket h = do
listen sock maxListenQueue
return sock
-{- Checks if debugging is actually enabled. -}
-debugEnabled :: IO Bool
-debugEnabled = do
- l <- getRootLogger
- return $ getLevel l <= Just DEBUG
-
-{- WAI middleware that logs using System.Log.Logger at debug level.
- -
- - Recommend only inserting this middleware when debugging is actually
- - enabled, as it's not optimised at all.
- -}
-httpDebugLogger :: Wai.Middleware
-httpDebugLogger waiApp req = do
- logRequest req
- waiApp req
-
-logRequest :: MonadIO m => Wai.Request -> m ()
-logRequest req = do
- liftIO $ debugM "WebApp" $ unwords
- [ showSockAddr $ Wai.remoteHost req
- , frombs $ Wai.requestMethod req
- , frombs $ Wai.rawPathInfo req
- --, show $ Wai.httpVersion req
- --, frombs $ lookupRequestField "referer" req
- , frombs $ lookupRequestField "user-agent" req
- ]
- where
- frombs v = L8.toString $ L.fromChunks [v]
-
lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString
lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
diff --git a/debian/changelog b/debian/changelog
index fb3f0fd1f..c4205ac12 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -6,6 +6,7 @@ git-annex (5.20140607) UNRELEASED; urgency=medium
* Avoid bad commits after interrupted direct mode sync (or merge).
* Windows: Fix opening webapp when repository is in a directory with
spaces in the path.
+ * Fix build with wai 0.3.0.
-- Joey Hess <joeyh@debian.org> Mon, 09 Jun 2014 14:44:09 -0400
diff --git a/debian/control b/debian/control
index 7f31cf937..e37f7d05e 100644
--- a/debian/control
+++ b/debian/control
@@ -40,7 +40,7 @@ Build-Depends:
libghc-warp-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
libghc-wai-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
- libghc-wai-logger-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
+ libghc-wai-extra-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],
libghc-securemem-dev,
libghc-byteable-dev,
libghc-dns-dev,
diff --git a/git-annex.cabal b/git-annex.cabal
index c258b8a05..776ccc245 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -189,7 +189,7 @@ Executable git-annex
if flag(Webapp)
Build-Depends:
yesod, yesod-default, yesod-static, yesod-form, yesod-core,
- http-types, transformers, wai, wai-logger, warp, warp-tls,
+ http-types, transformers, wai, wai-extra, warp, warp-tls,
blaze-builder, crypto-api, hamlet, clientsession,
template-haskell, data-default, aeson, network-conduit,
shakespeare