Format with hindentHEADmaster

2 files changed, 81 insertions, 57 deletions

diff --git a/src/Application.hs b/src/Application.hs
index 8ed2f7e..2005fc7 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -2,60 +2,76 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Application (
-  app
-) where
+module Application
+  ( app
+  ) where
 
 import Control.Monad.Trans (liftIO)
 import Data.ByteString.Base64 (encode)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as LBS
 import Data.Default.Class (def)
 import Data.Pool (Pool, withResource)
 import Data.Text.Lazy (Text, toLower)
-import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
-import Database.MySQL.Simple (Connection, Only(..), query, execute)
-import Network.HTTP.Types (notFound404, badRequest400)
+import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
+import Database.MySQL.Simple (Connection, Only(..), execute, query)
+import Network.HTTP.Types (badRequest400, notFound404)
 import Network.Wai (Application, Middleware)
-import Network.Wai.Middleware.RequestLogger (Destination(Handle),
-  mkRequestLogger, RequestLoggerSettings(destination, outputFormat),
-  OutputFormat(CustomOutputFormat))
-import Network.Wai.Middleware.Static (addBase, hasPrefix, staticPolicy, (>->))
+import Network.Wai.Middleware.RequestLogger
+  ( Destination(Handle)
+  , OutputFormat(CustomOutputFormat)
+  , RequestLoggerSettings(destination, outputFormat)
+  , mkRequestLogger
+  )
+import Network.Wai.Middleware.Static ((>->), addBase, hasPrefix, staticPolicy)
 import System.Entropy (getEntropy)
 import System.IO (stderr)
-import Web.Scotty (ScottyM, ActionM, header, middleware, file, get, post,
-  status, text, scottyApp)
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.ByteString.Lazy.Char8 as LBS
+import Web.Scotty
+  ( ActionM
+  , ScottyM
+  , file
+  , get
+  , header
+  , middleware
+  , post
+  , scottyApp
+  , status
+  , text
+  )
 
 import LogFormat (logFormat)
 
-
 app :: Pool Connection -> FilePath -> IO Application
 app p f = do
-  logger <- mkRequestLogger def{ destination = Handle stderr
-                               , outputFormat = CustomOutputFormat logFormat }
+  logger <-
+    mkRequestLogger
+      def
+        { destination = Handle stderr
+        , outputFormat = CustomOutputFormat logFormat
+        }
   scottyApp (juanDeLaCosa p logger f)
 
 juanDeLaCosa :: Pool Connection -> Middleware -> FilePath -> ScottyM ()
 juanDeLaCosa p logger dataDir = do
   middleware logger
-
   middleware $ staticPolicy (hasPrefix "static" >-> addBase dataDir)
   get "/" $ file (dataDir ++ "/" ++ "index.html")
-
   post "/resetMyPassword" $ apiResetMyPassword p
   get "/whoAmI" $ apiWhoAmI p
 
-
 apiWhoAmI :: Pool Connection -> ActionM ()
 apiWhoAmI p =
   header "From" >>= \case
     Nothing -> status badRequest400 >> text "Missing header `From'"
     Just email -> do
       let login = emailToLogin email
-      [ Only n ] <- withDB p $ \c ->
-              query c "SELECT COUNT(*) FROM mysql.user WHERE User=? AND Host='%'"
-                        [ LBS.toStrict . encodeUtf8 $ login ]
-      if (n::Int) > 0
+      [Only n] <-
+        withDB p $ \c ->
+          query
+            c
+            "SELECT COUNT(*) FROM mysql.user WHERE User=? AND Host='%'"
+            [LBS.toStrict . encodeUtf8 $ login]
+      if (n :: Int) > 0
         then text login
         else status notFound404 >> text login
 
@@ -66,14 +82,16 @@ apiResetMyPassword p =
     Just email -> do
       let login = emailToLogin email
       password <- liftIO $ BS.takeWhile (/= '=') . encode <$> getEntropy 13
-      _ <- withDB p $ \c -> execute c "SET PASSWORD FOR ?@'%' = PASSWORD(?)"
-                             [ LBS.toStrict . encodeUtf8 $ login, password ]
+      _ <-
+        withDB p $ \c ->
+          execute
+            c
+            "SET PASSWORD FOR ?@'%' = PASSWORD(?)"
+            [LBS.toStrict . encodeUtf8 $ login, password]
       text . decodeUtf8 . LBS.fromStrict $ password
 
-
 withDB :: Pool Connection -> (Connection -> IO a) -> ActionM a
 withDB p a = liftIO $ withResource p (liftIO . a)
 
 emailToLogin :: Text -> Text
 emailToLogin = toLower
-
diff --git a/src/LogFormat.hs b/src/LogFormat.hs
index 9eb25f1..0f75079 100644
--- a/src/LogFormat.hs
+++ b/src/LogFormat.hs
@@ -1,40 +1,46 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module LogFormat (
-  logFormat
-) where
+module LogFormat
+  ( logFormat
+  ) where
 
+import qualified Data.ByteString.Char8 as BS
 import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
 import Network.HTTP.Types (Status(statusCode))
-import Network.Wai (Request, httpVersion, requestHeaders, requestMethod,
-  rawPathInfo, requestHeaderReferer, requestHeaderUserAgent)
+import Network.Wai
+  ( Request
+  , httpVersion
+  , rawPathInfo
+  , requestHeaderReferer
+  , requestHeaderUserAgent
+  , requestHeaders
+  , requestMethod
+  )
 import System.Log.FastLogger (LogStr, toLogStr)
-import qualified Data.ByteString.Char8 as BS
 
 -- Sligthly modified Combined Log Format.
 -- User ID extracted from the From header.
 logFormat :: BS.ByteString -> Request -> Status -> Maybe Integer -> LogStr
-logFormat t req st msize = ""
-  <> toLogStr (fromMaybe "-" $ lookup "X-Forwarded-For" headers)
-  <> " - "
-  <> toLogStr (fromMaybe "-" $ lookup "From" headers)
-  <> " ["
-  <> toLogStr t
-  <> "] \""
-  <> toLogStr (requestMethod req)
-  <> " "
-  <> toLogStr (rawPathInfo req)
-  <> " "
-  <> toLogStr (show $ httpVersion req)
-  <> "\" "
-  <> toLogStr (show $ statusCode st)
-  <> " "
-  <> toLogStr (maybe "-" show msize)
-  <> " \""
-  <> toLogStr (fromMaybe "" $ requestHeaderReferer req)
-  <> "\" \""
-  <> toLogStr (fromMaybe "" $ requestHeaderUserAgent req)
-  <> "\"\n"
-  where headers = requestHeaders req
-
+logFormat t req st msize =
+  "" <>
+  toLogStr (fromMaybe "-" $ lookup "X-Forwarded-For" headers) <>
+  " - " <>
+  toLogStr (fromMaybe "-" $ lookup "From" headers) <>
+  " [" <>
+  toLogStr t <>
+  "] \"" <>
+  toLogStr (requestMethod req) <>
+  " " <>
+  toLogStr (rawPathInfo req) <>
+  " " <>
+  toLogStr (show $ httpVersion req) <>
+  "\" " <>
+  toLogStr (show $ statusCode st) <>
+  " " <>
+  toLogStr (maybe "-" show msize) <>
+  " \"" <>
+  toLogStr (fromMaybe "" $ requestHeaderReferer req) <>
+  "\" \"" <> toLogStr (fromMaybe "" $ requestHeaderUserAgent req) <> "\"\n"
+  where
+    headers = requestHeaders req