Add logging
This commit is contained in:
parent
8dcd8d253e
commit
f040266284
|
@ -15,7 +15,10 @@
|
||||||
"purescript-express": "^0.5.2",
|
"purescript-express": "^0.5.2",
|
||||||
"purescript-integers": "^3.1.0",
|
"purescript-integers": "^3.1.0",
|
||||||
"purescript-node-process": "^4.0.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": {
|
"devDependencies": {
|
||||||
"purescript-psci-support": "^3.0.0"
|
"purescript-psci-support": "^3.0.0"
|
||||||
|
|
|
@ -3,6 +3,6 @@ export SS_DB_USER="abhinav"
|
||||||
export SS_DB_PASSWORD=""
|
export SS_DB_PASSWORD=""
|
||||||
export SS_DB_HOST="localhost"
|
export SS_DB_HOST="localhost"
|
||||||
export SS_DB_PORT=5432
|
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_POOL_SIZE=10
|
||||||
export SS_DB_IDLE_CONN_TIMEOUT_MILLIS=1000
|
export SS_DB_IDLE_CONN_TIMEOUT_MILLIS=1000
|
||||||
|
|
|
@ -3,7 +3,8 @@ module Main where
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Control.Monad.Eff (Eff)
|
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.Either (Either(..))
|
||||||
import Data.Set (toUnfoldable)
|
import Data.Set (toUnfoldable)
|
||||||
import Data.String (joinWith)
|
import Data.String (joinWith)
|
||||||
|
@ -12,15 +13,17 @@ import Node.Express.Types (EXPRESS)
|
||||||
import Node.Process (PROCESS)
|
import Node.Process (PROCESS)
|
||||||
import Node.Process as Process
|
import Node.Process as Process
|
||||||
import SimpleService.Config (readServerConfig)
|
import SimpleService.Config (readServerConfig)
|
||||||
|
import SimpleService.Logger as Log
|
||||||
import SimpleService.Server (runServer)
|
import SimpleService.Server (runServer)
|
||||||
|
|
||||||
main :: forall eff. Eff ( console :: CONSOLE
|
main :: forall eff. Eff ( console :: CONSOLE
|
||||||
, express :: EXPRESS
|
, express :: EXPRESS
|
||||||
, postgreSQL :: PG.POSTGRESQL
|
, postgreSQL :: PG.POSTGRESQL
|
||||||
, process :: PROCESS
|
, process :: PROCESS
|
||||||
|
, now :: NOW
|
||||||
| eff) Unit
|
| eff) Unit
|
||||||
main = readServerConfig >>= case _ of
|
main = readServerConfig >>= case _ of
|
||||||
Left missingKeys -> do
|
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
|
Process.exit 1
|
||||||
Right { port, databaseConfig } -> runServer port databaseConfig
|
Right { port, databaseConfig } -> runServer port databaseConfig
|
||||||
|
|
|
@ -1,8 +1,11 @@
|
||||||
module SimpleService.Handler where
|
module SimpleService.Handler where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
import SimpleService.Types
|
||||||
|
|
||||||
import Control.Monad.Aff.Class (liftAff)
|
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 Control.Monad.Trans.Class (lift)
|
||||||
import Data.Bifunctor (lmap)
|
import Data.Bifunctor (lmap)
|
||||||
import Data.Either (Either)
|
import Data.Either (Either)
|
||||||
|
@ -19,31 +22,36 @@ import Database.PostgreSQL as PG
|
||||||
import Node.Express.Handler (Handler)
|
import Node.Express.Handler (Handler)
|
||||||
import Node.Express.Request (getBody, getRouteParam)
|
import Node.Express.Request (getBody, getRouteParam)
|
||||||
import Node.Express.Response (end, sendJson, setStatus)
|
import Node.Express.Response (end, sendJson, setStatus)
|
||||||
|
import SimpleService.Logger as Log
|
||||||
import SimpleService.Persistence as P
|
import SimpleService.Persistence as P
|
||||||
import SimpleService.Validation as V
|
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 ->
|
getUser pool = V.withValidation getUserId \userId ->
|
||||||
liftAff (PG.withConnection pool $ flip P.findUser userId) >>= case _ of
|
liftAff (PG.withConnection pool $ flip P.findUser userId) >>= case _ of
|
||||||
Nothing -> respond 404 { error: "User not found with id: " <> show userId }
|
Nothing -> respond 404 { error: "User not found with id: " <> show userId }
|
||||||
Just user -> respond 200 (encode user)
|
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
|
deleteUser pool = V.withValidation getUserId \userId -> do
|
||||||
found <- liftAff $ PG.withConnection pool \conn -> PG.withTransaction conn do
|
found <- liftAff $ PG.withConnection pool \conn -> PG.withTransaction conn do
|
||||||
P.findUser conn userId >>= case _ of
|
P.findUser conn userId >>= case _ of
|
||||||
Nothing -> pure false
|
Nothing -> pure false
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
P.deleteUser conn userId
|
P.deleteUser conn userId
|
||||||
|
Log.debug $ "Deleted user " <> show userId
|
||||||
pure true
|
pure true
|
||||||
if found
|
if found
|
||||||
then respondNoContent 204
|
then respondNoContent 204
|
||||||
else respond 404 { error: "User not found with id: " <> show userId }
|
else respond 404 { error: "User not found with id: " <> show userId }
|
||||||
|
|
||||||
createUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
|
createUser :: forall eff. PG.Pool
|
||||||
createUser pool = V.withValidation getUser \user@(User _) -> do
|
-> 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)
|
liftAff (PG.withConnection pool $ flip P.insertUser user)
|
||||||
|
Log.debug $ "Created user " <> show id
|
||||||
respondNoContent 201
|
respondNoContent 201
|
||||||
where
|
where
|
||||||
getUser = lift getBody
|
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 ID must be positive" (\(User user) -> user.id > 0)
|
||||||
>>= V.exceptCond "User name must not be empty" (\(User user) -> user.name /= "")
|
>>= 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)
|
updateUser pool = V.withValidation (Tuple <$> getUserId <*> getUserPatch)
|
||||||
\(Tuple userId (UserPatch userPatch)) ->
|
\(Tuple userId (UserPatch userPatch)) ->
|
||||||
case unNullOrUndefined userPatch.name of
|
case unNullOrUndefined userPatch.name of
|
||||||
|
@ -63,6 +72,7 @@ updateUser pool = V.withValidation (Tuple <$> getUserId <*> getUserPatch)
|
||||||
Just (User user) -> do
|
Just (User user) -> do
|
||||||
let user' = User (user { name = userName })
|
let user' = User (user { name = userName })
|
||||||
P.updateUser conn user'
|
P.updateUser conn user'
|
||||||
|
Log.debug $ "Updated user " <> show userId
|
||||||
pure $ Just user'
|
pure $ Just user'
|
||||||
case savedUser of
|
case savedUser of
|
||||||
Nothing -> respond 404 { error: "User not found with id: " <> show userId }
|
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
|
getUserPatch = lift getBody >>= V.except <<< renderForeignErrors
|
||||||
getUserName = V.exceptCond "User name must not be empty" (_ /= "")
|
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
|
listUsers pool = liftAff (PG.withConnection pool P.listUsers) >>= encode >>> respond 200
|
||||||
|
|
||||||
getUserId :: forall eff. V.Validation eff Int
|
getUserId :: forall eff. V.Validation eff Int
|
||||||
|
|
|
@ -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 }
|
|
@ -5,25 +5,40 @@ import Prelude
|
||||||
import Control.Monad.Aff (runAff)
|
import Control.Monad.Aff (runAff)
|
||||||
import Control.Monad.Eff (Eff)
|
import Control.Monad.Eff (Eff)
|
||||||
import Control.Monad.Eff.Class (liftEff)
|
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.Exception (message)
|
||||||
|
import Control.Monad.Eff.Now (NOW)
|
||||||
import Data.Either (fromRight)
|
import Data.Either (fromRight)
|
||||||
|
import Data.Maybe (maybe)
|
||||||
|
import Data.String (toUpper)
|
||||||
import Data.String.Regex (Regex, regex) as Re
|
import Data.String.Regex (Regex, regex) as Re
|
||||||
import Data.String.Regex.Flags (noFlags) as Re
|
import Data.String.Regex.Flags (noFlags) as Re
|
||||||
import Database.PostgreSQL as PG
|
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.Response (sendJson, setStatus)
|
||||||
import Node.Express.Types (EXPRESS, Method(..))
|
import Node.Express.Types (EXPRESS, Method(..))
|
||||||
import Partial.Unsafe (unsafePartial)
|
import Partial.Unsafe (unsafePartial)
|
||||||
import SimpleService.Handler (createUser, deleteUser, getUser, listUsers, updateUser)
|
import SimpleService.Handler (createUser, deleteUser, getUser, listUsers, updateUser)
|
||||||
|
import SimpleService.Logger as Log
|
||||||
import SimpleService.Middleware.BodyParser (jsonBodyParser)
|
import SimpleService.Middleware.BodyParser (jsonBodyParser)
|
||||||
|
|
||||||
allRoutePattern :: Re.Regex
|
allRoutePattern :: Re.Regex
|
||||||
allRoutePattern = unsafePartial $ fromRight $ Re.regex "/.*" Re.noFlags
|
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
|
app pool = do
|
||||||
useExternal jsonBodyParser
|
useExternal jsonBodyParser
|
||||||
|
use requestLogger
|
||||||
|
|
||||||
get "/v1/user/:id" $ getUser pool
|
get "/v1/user/:id" $ getUser pool
|
||||||
delete "/v1/user/:id" $ deleteUser pool
|
delete "/v1/user/:id" $ deleteUser pool
|
||||||
|
@ -36,6 +51,7 @@ app pool = do
|
||||||
sendJson {error: "Route not found"}
|
sendJson {error: "Route not found"}
|
||||||
|
|
||||||
useOnError \err -> do
|
useOnError \err -> do
|
||||||
|
Log.error $ "Uncaught error in handler: " <> show err
|
||||||
setStatus 500
|
setStatus 500
|
||||||
sendJson {error: message err}
|
sendJson {error: message err}
|
||||||
where
|
where
|
||||||
|
@ -47,8 +63,10 @@ runServer :: forall eff.
|
||||||
-> Eff ( express :: EXPRESS
|
-> Eff ( express :: EXPRESS
|
||||||
, postgreSQL :: PG.POSTGRESQL
|
, postgreSQL :: PG.POSTGRESQL
|
||||||
, console :: CONSOLE
|
, console :: CONSOLE
|
||||||
|
, now :: NOW
|
||||||
| eff ) Unit
|
| eff ) Unit
|
||||||
runServer port databaseConfig = void $ runAff logShow pure do
|
runServer port databaseConfig =
|
||||||
pool <- PG.newPool databaseConfig
|
void $ runAff (\err -> Log.error $ "Error in running server: " <> show err) pure do
|
||||||
let app' = app pool
|
pool <- PG.newPool databaseConfig
|
||||||
void $ liftEff $ listenHttp app' port \_ -> log $ "Server listening on :" <> show port
|
let app' = app pool
|
||||||
|
void $ liftEff $ listenHttp app' port \_ -> Log.info $ "Server listening on :" <> show port
|
||||||
|
|
Loading…
Reference in New Issue