make user updatable via API

src/API.hs

@@ -21,9 +21,9 @@ import Model as M
 
 import Types
 
-type UserAPI = "user" :>
+type UserAPI =
-  ( "list" :> QueryParam "refine" Refine :> Get '[JSON] [User]
+  "user" :>
-  :<|> "new" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
+    ( "list" :> QueryParam "refine" Refine :> Get '[JSON] [User]
-  )
+    :<|> "new" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
-
+    :<|> "update" :> ReqBody '[JSON] (Int, UserSubmit) :> Post '[JSON] ()
-data SortBy = Name
+    )

src/Main.hs

@@ -37,7 +37,8 @@ userApi = Proxy
 users :: Connection -> Server UserAPI
 users conn =
   userList :<|>
-  userNew
+  userNew :<|>
+  userUpdate
   where
     userList :: Maybe Refine -> Handler [User]
     userList ref = liftIO $ userSelect conn ref
@@ -45,3 +46,7 @@ users conn =
     userNew  us = liftIO $ do
       now <- getCurrentTime
       head <$> runInsert_ conn (insertUser us (utctDay now))
+    userUpdate :: (Int, UserSubmit) -> Handler ()
+    userUpdate (id, us) = liftIO $ do
+      now <- getCurrentTime
+      void $ runUpdate_ conn (updateUser id us (utctDay now))

src/Model/User.hs

@@ -38,7 +38,15 @@ data User = User
     deriving (Generic, Show)
 
 instance ToJSON User where
-    toEncoding = genericToEncoding defaultOptions
+  toEncoding (User id ident balance ts email avatar _) =
+    pairs
+      (  "userId" .= id
+      <> "userIdent" .= ident
+      <> "userBalance" .= balance
+      <> "userTimeStamp" .= ts
+      <> "userEmail" .= email
+      <> "userAvatar" .= avatar
+      )
 
 instance FromJSON User
 
@@ -126,4 +134,21 @@ insertUser us now = Insert
     ]
   , iReturning = rReturning (\(id, _, _, _, _, _, _) -> id)
   , iOnConflict = Nothing
-}
+  }
+
+updateUser :: Int -> UserSubmit -> Day -> Update Int64
+updateUser id us now = Update
+  { uTable = userTable
+  , uUpdateWith = updateEasy (\(id_, _, i3, _, _, i6, _) ->
+      ( id_
+      , C.constant (userSubmitIdent us)
+      , i3
+      , C.constant (now)
+      , C.constant (userSubmitEmail us)
+      , i6
+      , C.constant (userSubmitPin us)
+      )
+    )
+  , uWhere = (\(i1, _, _, _, _, _, _) -> i1 .== C.constant id)
+  , uReturning = rCount
+  }