Adds user update and listing functionality

src/SimpleService/Handler.purs

@@ -7,6 +7,7 @@ import Data.Either (Either(..))
 import Data.Foldable (intercalate)
 import Data.Foreign (renderForeignError)
 import Data.Foreign.Class (encode)
+import Data.Foreign.NullOrUndefined (unNullOrUndefined)
 import Data.Int (fromString)
 import Data.Maybe (Maybe(..))
 import Database.PostgreSQL as PG
@@ -14,7 +15,7 @@ import Node.Express.Handler (Handler)
 import Node.Express.Request (getBody, getRouteParam)
 import Node.Express.Response (end, sendJson, setStatus)
 import SimpleServer.Persistence as P
-import SimpleServer.Types (User(..))
+import SimpleServer.Types
 
 getUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
 getUser pool = getRouteParam "id" >>= case _ of
@@ -46,19 +47,45 @@ createUser pool = getBody >>= case _ of
   Left errs -> respond 422 { error: intercalate ", " $ map renderForeignError errs}
   Right u@(User user) ->
     if user.id <= 0
-      then respond 422 { error: "User ID must be more than 0: " <> show user.id}
+      then respond 422 { error: "User ID must be positive: " <> show user.id}
       else if user.name == ""
         then respond 422 { error: "User name must not be empty" }
         else do
           liftAff (PG.withConnection pool $ flip P.insertUser u)
           respondNoContent 201
 
+updateUser :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
+updateUser pool = getRouteParam "id" >>= case _ of
+  Nothing -> respond 422 { error: "User ID is required" }
+  Just sUserId -> case fromString sUserId of
+    Nothing -> respond 422 { error: "User ID must be positive: " <> sUserId }
+    Just userId -> getBody >>= case _ of
+      Left errs -> respond 422 { error: intercalate ", " $ map renderForeignError errs}
+      Right (UserPatch userPatch) -> case unNullOrUndefined userPatch.name of
+        Nothing -> respondNoContent 204
+        Just userName -> if userName == ""
+          then respond 422 { error: "User name must not be empty" }
+          else do
+            savedUser <- liftAff $ PG.withConnection pool \conn -> PG.withTransaction conn do
+              P.findUser conn userId >>= case _ of
+                Nothing -> pure Nothing
+                Just (User user) -> do
+                  let user' = User (user { name = userName })
+                  P.updateUser conn user'
+                  pure $ Just user'
+            case savedUser of
+              Nothing -> respond 404 { error: "User not found with id: " <> sUserId }
+              Just user -> respond 200 (encode user)
+
+listUsers :: forall eff. PG.Pool -> Handler (postgreSQL :: PG.POSTGRESQL | eff)
+listUsers pool = liftAff (PG.withConnection pool P.listUsers) >>= encode >>> respond 200
+
 respond :: forall eff a. Int -> a -> Handler eff
 respond status body = do
   setStatus status
   sendJson body
 
-respondNoContent :: forall eff a. Int -> Handler eff
+respondNoContent :: forall eff. Int -> Handler eff
 respondNoContent status = do
   setStatus status
   end

src/SimpleService/Persistence.purs

@@ -3,6 +3,7 @@ module SimpleServer.Persistence
   , findUser
   , updateUser
   , deleteUser
+  , listUsers
   ) where
 
 import Prelude
@@ -25,6 +26,9 @@ updateUserQuery = "update users set name = $1 where id = $2"
 deleteUserQuery :: String
 deleteUserQuery = "delete from users where id = $1"
 
+listUsersQuery :: String
+listUsersQuery = "select id, name from users"
+
 insertUser :: forall eff. PG.Connection -> User -> Aff (postgreSQL :: PG.POSTGRESQL | eff) Unit
 insertUser conn user = PG.execute conn (PG.Query insertUserQuery) user
 
@@ -36,3 +40,6 @@ updateUser conn (User {id, name}) = PG.execute conn (PG.Query updateUserQuery) (
 
 deleteUser :: forall eff. PG.Connection -> UserID -> Aff (postgreSQL :: PG.POSTGRESQL | eff) Unit
 deleteUser conn userID = PG.execute conn (PG.Query deleteUserQuery) (PG.Row1 userID)
+
+listUsers :: forall eff. PG.Connection -> Aff (postgreSQL :: PG.POSTGRESQL | eff) (Array User)
+listUsers conn = PG.query conn (PG.Query listUsersQuery) PG.Row0

src/SimpleService/Server.purs

@@ -8,18 +8,22 @@ import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
 import Control.Monad.Eff.Exception (catchException)
 import Database.PostgreSQL as PG
-import Node.Express.App (App, delete, get, listenHttp, post, useExternal)
-import Node.Express.Types (EXPRESS)
-import SimpleService.Handler (createUser, deleteUser, getUser)
+import Node.Express.App (App, delete, get, http, listenHttp, post, useExternal)
+import Node.Express.Types (EXPRESS, Method(..))
+import SimpleService.Handler (createUser, deleteUser, getUser, listUsers, updateUser)
 import SimpleService.Middleware.BodyParser (jsonBodyParser)
 
 app :: forall eff. PG.Pool -> App (postgreSQL :: PG.POSTGRESQL | eff)
 app pool = do
   useExternal jsonBodyParser
 
-  get "/v1/user/:id" $ getUser pool
+  get "/v1/user/:id"    $ getUser pool
   delete "/v1/user/:id" $ deleteUser pool
-  post "/v1/users" $ createUser pool
+  post "/v1/users"      $ createUser pool
+  patch "/v1/user/:id"  $ updateUser pool
+  get "/v1/users"       $ listUsers pool
+  where
+    patch = http (CustomMethod "patch")
 
 runServer :: forall eff.
              Int

src/SimpleService/Types.purs

@@ -6,6 +6,7 @@ import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Foreign.Class (class Decode, class Encode)
 import Data.Foreign.Generic (defaultOptions, genericDecode, genericEncode)
+import Data.Foreign.NullOrUndefined (NullOrUndefined)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Database.PostgreSQL (class FromSQLRow, class ToSQLRow, fromSQLValue, toSQLValue)
@@ -37,3 +38,10 @@ instance userFromSQLRow :: FromSQLRow User where
 
 instance userToSQLRow :: ToSQLRow User where
   toSQLRow (User {id, name}) = [toSQLValue id, toSQLValue name]
+
+newtype UserPatch = UserPatch { name :: NullOrUndefined String }
+
+derive instance genericUserPatch :: Generic UserPatch _
+
+instance decodeUserPatch :: Decode UserPatch where
+  decode = genericDecode $ defaultOptions { unwrapSingleConstructors = true }