Add logging

bower.json

@@ -15,7 +15,10 @@
     "purescript-express": "^0.5.2",
     "purescript-integers": "^3.1.0",
     "purescript-node-process": "^4.0.0",
-    "purescript-config": "^0.0.6"
+    "purescript-config": "^0.0.6",
+    "purescript-logging": "^2.0.0",
+    "purescript-now": "^3.0.0",
+    "purescript-formatters": "^3.0.0"
   },
   "devDependencies": {
     "purescript-psci-support": "^3.0.0"

setenv.sh

@@ -3,6 +3,6 @@ export SS_DB_USER="abhinav"
 export SS_DB_PASSWORD=""
 export SS_DB_HOST="localhost"
 export SS_DB_PORT=5432
-export SS_DB_DATABASE="simple_server"
+export SS_DB_DATABASE="simple_service"
 export SS_DB_POOL_SIZE=10
 export SS_DB_IDLE_CONN_TIMEOUT_MILLIS=1000

src/Main.purs

@@ -3,7 +3,8 @@ module Main where
 import Prelude
 
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Eff.Console (CONSOLE)
+import Control.Monad.Eff.Now (NOW)
 import Data.Either (Either(..))
 import Data.Set (toUnfoldable)
 import Data.String (joinWith)
@@ -12,15 +13,17 @@ import Node.Express.Types (EXPRESS)
 import Node.Process (PROCESS)
 import Node.Process as Process
 import SimpleService.Config (readServerConfig)
+import SimpleService.Logger as Log
 import SimpleService.Server (runServer)
 
 main :: forall eff. Eff ( console :: CONSOLE
                         , express :: EXPRESS
                         , postgreSQL :: PG.POSTGRESQL
                         , process :: PROCESS
+                        , now :: NOW
                         | eff) Unit
 main = readServerConfig >>= case _ of
   Left missingKeys -> do
-    log $ "Unable to start. Missing Env keys: " <> joinWith ", " (toUnfoldable missingKeys)
+    Log.error $ "Unable to start. Missing Env keys: " <> joinWith ", " (toUnfoldable missingKeys)
     Process.exit 1
   Right { port, databaseConfig } -> runServer port databaseConfig

src/SimpleService/Handler.purs

@@ -1,8 +1,11 @@
 module SimpleService.Handler where
 
 import Prelude
+import SimpleService.Types
 
 import Control.Monad.Aff.Class (liftAff)
+import Control.Monad.Eff.Console (CONSOLE)
+import Control.Monad.Eff.Now (NOW)
 import Control.Monad.Trans.Class (lift)
 import Data.Bifunctor (lmap)
 import Data.Either (Either)
@@ -19,31 +22,36 @@ import Database.PostgreSQL as PG
 import Node.Express.Handler (Handler)
 import Node.Express.Request (getBody, getRouteParam)
 import Node.Express.Response (end, sendJson, setStatus)
+import SimpleService.Logger as Log
 import SimpleService.Persistence as P
 import SimpleService.Validation as V
-import SimpleService.Types
 
-getUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
+getUser :: forall eff. PG.Pool
+        -> Handler (postgreSQL :: PG.POSTGRESQL, console :: CONSOLE, now :: NOW | eff)
 getUser pool = V.withValidation getUserId \userId ->
   liftAff (PG.withConnection pool $ flip P.findUser userId) >>= case _ of
     Nothing -> respond 404 { error: "User not found with id: " <> show userId }
     Just user -> respond 200 (encode user)
 
-deleteUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
+deleteUser :: forall eff. PG.Pool
+           -> Handler (postgreSQL :: PG.POSTGRESQL, console :: CONSOLE, now :: NOW | eff)
 deleteUser pool = V.withValidation getUserId \userId -> do
   found <- liftAff $ PG.withConnection pool \conn -> PG.withTransaction conn do
     P.findUser conn userId >>= case _ of
       Nothing -> pure false
       Just _  -> do
         P.deleteUser conn userId
+        Log.debug $ "Deleted user " <> show userId
         pure true
   if found
     then respondNoContent 204
     else respond 404 { error: "User not found with id: " <> show userId }
 
-createUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
-createUser pool = V.withValidation getUser \user@(User _) -> do
+createUser :: forall eff. PG.Pool
+           -> Handler (postgreSQL :: PG.POSTGRESQL, console :: CONSOLE, now :: NOW | eff)
+createUser pool = V.withValidation getUser \user@(User {id}) -> do
   liftAff (PG.withConnection pool $ flip P.insertUser user)
+  Log.debug $ "Created user " <> show id
   respondNoContent 201
   where
     getUser = lift getBody
@@ -51,7 +59,8 @@ createUser pool = V.withValidation getUser \user@(User _) -> do
       >>= V.exceptCond "User ID must be positive" (\(User user) -> user.id > 0)
       >>= V.exceptCond "User name must not be empty" (\(User user) -> user.name /= "")
 
-updateUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
+updateUser :: forall eff. PG.Pool
+           -> Handler (postgreSQL :: PG.POSTGRESQL, console :: CONSOLE, now :: NOW | eff)
 updateUser pool = V.withValidation (Tuple <$> getUserId <*> getUserPatch)
                                    \(Tuple userId (UserPatch userPatch)) ->
     case unNullOrUndefined userPatch.name of
@@ -63,6 +72,7 @@ updateUser pool = V.withValidation (Tuple <$> getUserId <*> getUserPatch)
             Just (User user) -> do
               let user' = User (user { name = userName })
               P.updateUser conn user'
+              Log.debug $ "Updated user " <> show userId
               pure $ Just user'
         case savedUser of
           Nothing -> respond 404 { error: "User not found with id: " <> show userId }
@@ -71,7 +81,8 @@ updateUser pool = V.withValidation (Tuple <$> getUserId <*> getUserPatch)
     getUserPatch = lift getBody >>= V.except <<< renderForeignErrors
     getUserName = V.exceptCond "User name must not be empty" (_ /= "")
 
-listUsers :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
+listUsers :: forall eff. PG.Pool
+          -> Handler (postgreSQL :: PG.POSTGRESQL, console :: CONSOLE, now :: NOW | eff)
 listUsers pool = liftAff (PG.withConnection pool P.listUsers) >>= encode >>> respond 200
 
 getUserId :: forall eff. V.Validation eff Int

src/SimpleService/Logger.purs

@@ -0,0 +1,64 @@
+module SimpleService.Logger
+  ( debug
+  , info
+  , warn
+  , error
+  ) where
+
+import Prelude
+
+import Control.Logger as L
+import Control.Monad.Eff.Class (class MonadEff, liftEff)
+import Control.Monad.Eff.Console as C
+import Control.Monad.Eff.Now (NOW, now)
+import Data.DateTime.Instant (toDateTime)
+import Data.Either (fromRight)
+import Data.Formatter.DateTime (Formatter, format, parseFormatString)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.String (toUpper)
+import Partial.Unsafe (unsafePartial)
+
+data Level = Debug | Info | Warn | Error
+
+derive instance eqLevel :: Eq Level
+derive instance ordLevel :: Ord Level
+derive instance genericLevel :: Generic Level _
+
+instance showLevel :: Show Level where
+  show = toUpper <<< genericShow
+
+type Entry =
+  { level   :: Level
+  , message :: String
+  }
+
+dtFormatter :: Formatter
+dtFormatter = unsafePartial $ fromRight $ parseFormatString "YYYY-MM-DD HH:mm:ss.SSS"
+
+logger :: forall m e.
+          (MonadEff (console :: C.CONSOLE, now :: NOW | e) m) => L.Logger m Entry
+logger = L.Logger $ \{ level, message } -> liftEff do
+  time <- toDateTime <$> now
+  C.log $ "[" <> format dtFormatter time <> "] " <> show level <> " " <> message
+
+log :: forall m e.
+        MonadEff (console :: C.CONSOLE , now :: NOW | e) m
+     => Entry -> m Unit
+log entry@{level} = L.log (L.cfilter (\e -> e.level == level) logger) entry
+
+debug :: forall m e.
+         MonadEff (console :: C.CONSOLE , now :: NOW | e) m => String -> m Unit
+debug message = log { level: Debug, message }
+
+info :: forall m e.
+        MonadEff (console :: C.CONSOLE , now :: NOW | e) m => String -> m Unit
+info message = log { level: Info, message }
+
+warn :: forall m e.
+        MonadEff (console :: C.CONSOLE , now :: NOW | e) m => String -> m Unit
+warn message = log { level: Warn, message }
+
+error :: forall m e.
+         MonadEff (console :: C.CONSOLE , now :: NOW | e) m => String -> m Unit
+error message = log { level: Error, message }

src/SimpleService/Server.purs

@@ -5,25 +5,40 @@ import Prelude
 import Control.Monad.Aff (runAff)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
-import Control.Monad.Eff.Console (CONSOLE, log, logShow)
+import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Eff.Exception (message)
+import Control.Monad.Eff.Now (NOW)
 import Data.Either (fromRight)
+import Data.Maybe (maybe)
+import Data.String (toUpper)
 import Data.String.Regex (Regex, regex) as Re
 import Data.String.Regex.Flags (noFlags) as Re
 import Database.PostgreSQL as PG
-import Node.Express.App (App, all, delete, get, http, listenHttp, post, useExternal, useOnError)
+import Node.Express.App (App, all, delete, get, http, listenHttp, post, use, useExternal, useOnError)
+import Node.Express.Handler (Handler, next)
+import Node.Express.Request (getMethod, getPath)
 import Node.Express.Response (sendJson, setStatus)
 import Node.Express.Types (EXPRESS, Method(..))
 import Partial.Unsafe (unsafePartial)
 import SimpleService.Handler (createUser, deleteUser, getUser, listUsers, updateUser)
+import SimpleService.Logger as Log
 import SimpleService.Middleware.BodyParser (jsonBodyParser)
 
 allRoutePattern :: Re.Regex
 allRoutePattern = unsafePartial $ fromRight $ Re.regex "/.*" Re.noFlags
 
-app :: forall eff. PG.Pool -> App (postgreSQL :: PG.POSTGRESQL | eff)
+requestLogger :: forall eff. Handler (console :: CONSOLE, now :: NOW | eff)
+requestLogger = do
+  method <- getMethod
+  path   <- getPath
+  Log.debug $ "HTTP: " <> maybe "" id ((toUpper <<< show) <$> method) <> " " <> path
+  next
+
+app :: forall eff. PG.Pool
+                -> App (postgreSQL :: PG.POSTGRESQL, console :: CONSOLE, now :: NOW | eff)
 app pool = do
   useExternal jsonBodyParser
+  use requestLogger
 
   get "/v1/user/:id"    $ getUser pool
   delete "/v1/user/:id" $ deleteUser pool
@@ -36,6 +51,7 @@ app pool = do
     sendJson {error: "Route not found"}
 
   useOnError \err -> do
+    Log.error $ "Uncaught error in handler: " <> show err
     setStatus 500
     sendJson {error: message err}
   where
@@ -47,8 +63,10 @@ runServer :: forall eff.
           -> Eff ( express :: EXPRESS
                  , postgreSQL :: PG.POSTGRESQL
                  , console :: CONSOLE
+                 , now :: NOW
                  | eff ) Unit
-runServer port databaseConfig =  void $ runAff logShow pure do
-  pool <- PG.newPool databaseConfig
-  let app' = app pool
-  void $ liftEff $ listenHttp app' port \_ -> log $ "Server listening on :" <> show port
+runServer port databaseConfig =
+  void $ runAff (\err -> Log.error $ "Error in running server: " <> show err) pure do
+    pool <- PG.newPool databaseConfig
+    let app' = app pool
+    void $ liftEff $ listenHttp app' port \_ -> Log.info $ "Server listening on :" <> show port