diff options
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 10 | ||||
| -rw-r--r-- | Utility/WebApp.hs | 33 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | debian/control | 2 | ||||
| -rw-r--r-- | git-annex.cabal | 2 |
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 |