From 8ff9938d97ffec090df20b010ac2682f7bef88f3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 11 Jun 2014 01:29:00 -0400
Subject: [PATCH] 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.
---
 Assistant/Threads/WebApp.hs | 10 +++++++++-
 Utility/WebApp.hs           | 33 ---------------------------------
 debian/changelog            |  1 +
 debian/control              |  2 +-
 git-annex.cabal             |  2 +-
 5 files changed, 12 insertions(+), 36 deletions(-)

diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 8d977194b2..416c078741 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 c5e2a439e0..0f3378a15a 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 fb3f0fd1fe..c4205ac12e 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 7f31cf9378..e37f7d05ee 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 c258b8a059..776ccc2459 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