Add logging

master
Abhinav Sarkar 2017-09-30 22:22:14 +05:30
parent 8dcd8d253e
commit f040266284
6 changed files with 117 additions and 18 deletions

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 }

View File

@ -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