make user updates possible

This commit is contained in:
nek0 2019-05-16 18:37:04 +02:00
parent f2d0384c33
commit d806b8c3ff
4 changed files with 100 additions and 18 deletions

View file

@ -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

View file

@ -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"
}

View file

@ -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)

View file

@ -38,6 +38,7 @@ instance ToJSON User where
instance FromJSON User
data UserSubmit = UserSubmit
{ userSubmitIdent :: T.Text
, userSubmitEmail :: Maybe T.Text
@ -46,6 +47,38 @@ data UserSubmit = UserSubmit
deriving (Generic, Show)
instance ToJSON UserSubmit where
toEncoding = genericToEncoding defaultOptions
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