make user updatable via API

This commit is contained in:
nek0 2019-04-16 06:23:08 +02:00
parent 7f3dfc9c29
commit 55ab85f927
3 changed files with 39 additions and 9 deletions

View file

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

View file

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

View file

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