From 55ab85f9274eb3a57e5e9004dfe3b144905f2b36 Mon Sep 17 00:00:00 2001
From: nek0 <nek0@nek0.eu>
Date: Tue, 16 Apr 2019 06:23:08 +0200
Subject: [PATCH] make user updatable via API

---
 src/API.hs        | 12 ++++++------
 src/Main.hs       |  7 ++++++-
 src/Model/User.hs | 29 +++++++++++++++++++++++++++--
 3 files changed, 39 insertions(+), 9 deletions(-)

diff --git a/src/API.hs b/src/API.hs
index 3f5ebbd..8eafe48 100644
--- a/src/API.hs
+++ b/src/API.hs
@@ -21,9 +21,9 @@ import Model as M
 
 import Types
 
-type UserAPI = "user" :>
-  ( "list" :> QueryParam "refine" Refine :> Get '[JSON] [User]
-  :<|> "new" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
-  )
-
-data SortBy = Name
+type UserAPI =
+  "user" :>
+    ( "list" :> QueryParam "refine" Refine :> Get '[JSON] [User]
+    :<|> "new" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
+    :<|> "update" :> ReqBody '[JSON] (Int, UserSubmit) :> Post '[JSON] ()
+    )
diff --git a/src/Main.hs b/src/Main.hs
index 3ec28d2..d5587a7 100644
--- a/src/Main.hs
+++ b/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))
diff --git a/src/Model/User.hs b/src/Model/User.hs
index 358174f..5007dfc 100644
--- a/src/Model/User.hs
+++ b/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
+  }