diff --git a/bower.json b/bower.json index 23bb7d8..3411e79 100644 --- a/bower.json +++ b/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" diff --git a/setenv.sh b/setenv.sh index eab31be..f8d34fe 100644 --- a/setenv.sh +++ b/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 diff --git a/src/Main.purs b/src/Main.purs index aae1a9d..3395eec 100644 --- a/src/Main.purs +++ b/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 diff --git a/src/SimpleService/Handler.purs b/src/SimpleService/Handler.purs index 4cf34d0..1a09a65 100644 --- a/src/SimpleService/Handler.purs +++ b/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 diff --git a/src/SimpleService/Logger.purs b/src/SimpleService/Logger.purs new file mode 100644 index 0000000..f89318f --- /dev/null +++ b/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 } diff --git a/src/SimpleService/Server.purs b/src/SimpleService/Server.purs index 8425567..a2d3c55 100644 --- a/src/SimpleService/Server.purs +++ b/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