make user updates possible

src/API.hs

@@ -26,8 +26,10 @@ type UserAPI =
     ( "list" :> AuthProtect "header-auth"
       :> QueryParam "refine" Refine :> Get '[JSON] [User]
     :<|> "new" :> ReqBody '[JSON] UserSubmit :> Post '[JSON] Int
-    :<|> "update" :> AuthProtect "header-auth"
-      :> ReqBody '[JSON] (Int, UserSubmit) :> Post '[JSON] ()
+    :<|> "details" :> AuthProtect "header-auth"
+      :> Capture "id" Int :> Get '[JSON] UserDetails
+    :<|> "details" :> AuthProtect "header-auth"
+      :> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
     )
   :<|> "auth" :> 
     ( "get" :> ReqBody '[JSON] Int :> Post '[JSON] AuthInfo

src/Main.hs

@@ -97,7 +97,8 @@ authHandler conn = mkAuthHandler handler
 users =
   userList :<|>
   userNew :<|>
-  userUpdate
+  userGetUpdate :<|>
+  userPostUpdate
   where
     userList :: Maybe Int -> Maybe Refine -> MateHandler [User]
     userList muid ref = do
@@ -111,18 +112,36 @@ users =
       conn <- rsConnection <$> ask
       head <$> (liftIO $ runInsert_ conn (insertUser us (utctDay now) randSalt))
 
-    userUpdate :: Maybe Int -> (Int, UserSubmit) -> MateHandler ()
-    userUpdate Nothing _ =
+    userGetUpdate :: Maybe Int -> Int -> MateHandler UserDetails
+    userGetUpdate Nothing _ =
       throwError $ err403
         { errBody = "No Authorization present"
         }
-    userUpdate (Just aid) (id, us) = if aid == id
+    userGetUpdate (Just aid) id =
+      if aid == id
       then do
         now <- liftIO $ getCurrentTime
         conn <- rsConnection <$> ask
-        void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now))
+        -- void $ liftIO $ runUpdate_ conn (updateUser id us (utctDay now))
+        userDetailsSelect conn id
       else
-      throwError $ err401
+      throwError $ err403
+        { errBody = "Wrong Authorization present"
+        }
+
+    userPostUpdate :: Maybe Int -> Int -> UserDetailsSubmit -> MateHandler ()
+    userPostUpdate Nothing _ _ =
+      throwError $ err403
+        { errBody = "No Authorization present"
+        }
+    userPostUpdate (Just aid) id uds =
+      if aid == id
+      then do
+        now <- liftIO $ getCurrentTime
+        conn <- rsConnection <$> ask
+        void $ liftIO $ runUpdate_ conn (updateUserDetails id uds (utctDay now))
+      else
+      throwError $ err403
         { errBody = "Wrong Authorization present"
         }
 

src/Model/User.hs

@@ -104,6 +104,34 @@ userSelect conn ref sw = do
       )
     users
 
+userDetailsSelect
+  :: PGS.Connection
+  -> Int
+  -> MateHandler UserDetails
+userDetailsSelect conn id = do
+  today <- utctDay <$> (liftIO $ getCurrentTime)
+  users <- liftIO $ runSelect conn (
+      keepWhen (\(uid, _, _, _, _, _, _, _, _) ->
+        uid .== C.constant id
+        ) <<< queryTable userTable
+      ) :: MateHandler
+          [ ( Int
+            , Text
+            , Int
+            , Day
+            , Maybe Text
+            , Maybe Int
+            , ByteString
+            , Maybe ByteString
+            , Maybe Int
+            )
+          ]
+  head <$> mapM
+    (\(i1, i2, i3, i4, i5, i6, i7, i8, i9) -> return $
+      UserDetails i2 i3 i5 i6 (AuthSalt i7) (toEnum <$> i9)
+      )
+    users
+
 insertUser :: UserSubmit -> Day -> ByteString -> Insert [Int]
 insertUser us now randSalt = Insert
   { iTable = userTable
@@ -124,19 +152,19 @@ insertUser us now randSalt = Insert
   , iOnConflict = Nothing
   }
 
-updateUser :: Int -> UserSubmit -> Day -> Update Int64
-updateUser id us now = Update
+updateUserDetails :: Int -> UserDetailsSubmit -> Day -> Update Int64
+updateUserDetails id uds now = Update
   { uTable = userTable
-  , uUpdateWith = updateEasy (\(id_, _, i3, _, _, i6, i7, i8, i9) ->
+  , uUpdateWith = updateEasy (\(id_, _, _, _, _, _, i7, i8, _) ->
       ( id_
-      , C.constant (userSubmitIdent us)
-      , i3
+      , C.constant (userDetailsSubmitIdent uds)
+      , C.constant (userDetailsSubmitBalance uds)
       , C.constant now
-      , C.constant (userSubmitEmail us)
-      , i6
+      , C.constant (userDetailsSubmitEmail uds)
+      , C.constant (userDetailsSubmitAvatar uds)
       , i7
-      , i8
-      , i9
+      , C.constant ((\(AuthHash h) -> h) <$> userDetailsSubmitHash uds)
+      , C.constant (fromEnum <$> userDetailsSubmitAlgo uds)
       )
     )
   , uWhere = (\(i1, _, _, _, _, _, _, _, _) -> i1 .== C.constant id)

src/Types/User.hs

@@ -38,6 +38,7 @@ instance ToJSON User where
 
 instance FromJSON User
 
+
 data UserSubmit = UserSubmit
   { userSubmitIdent :: T.Text
   , userSubmitEmail :: Maybe T.Text
@@ -49,3 +50,35 @@ instance ToJSON UserSubmit where
   toEncoding = genericToEncoding defaultOptions
 
 instance FromJSON UserSubmit
+
+
+data UserDetails = UserDetails
+  { userDetailsIdent   :: T.Text
+  , userDetailsBalance :: Int
+  , userDetailsEmail   :: Maybe T.Text
+  , userDetailsAvatar  :: Maybe Int
+  , userDetailsSalt    :: AuthSalt
+  , userDetailsAlgo    :: Maybe AuthAlgorithm
+  }
+  deriving (Generic, Show)
+
+instance ToJSON UserDetails where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON UserDetails
+
+
+data UserDetailsSubmit = UserDetailsSubmit
+  { userDetailsSubmitIdent   :: T.Text
+  , userDetailsSubmitBalance :: Int
+  , userDetailsSubmitEmail   :: Maybe T.Text
+  , userDetailsSubmitAvatar  :: Maybe Int
+  , userDetailsSubmitHash    :: Maybe AuthHash
+  , userDetailsSubmitAlgo    :: Maybe AuthAlgorithm
+  }
+  deriving (Generic, Show)
+
+instance ToJSON UserDetailsSubmit where
+  toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON UserDetailsSubmit