Support POST /unfreeze
Allow admins and managers to unfreeze accounts that we froze for security reasons.
This commit is contained in:
parent
43eff5f1d0
commit
1d7c77f51d
3 changed files with 22 additions and 0 deletions
|
@ -62,3 +62,7 @@ type API =
|
|||
:<|> "logout"
|
||||
:> SessionCookie
|
||||
:> Get '[JSON] (Headers '[Header "Set-Cookie" SetCookie] NoContent)
|
||||
:<|> "unfreeze"
|
||||
:> SessionCookie
|
||||
:> ReqBody '[JSON] T.UnfreezeAccountRequest
|
||||
:> Post '[JSON] NoContent
|
||||
|
|
|
@ -67,6 +67,7 @@ server T.Config{..} = createAccount
|
|||
:<|> listTrips
|
||||
:<|> login
|
||||
:<|> logout
|
||||
:<|> unfreezeAccount
|
||||
where
|
||||
-- Admit Admins + whatever the predicate `p` passes.
|
||||
adminsAnd cookie p = Auth.assert dbFile cookie (\acct@T.Account{..} -> accountRole == T.Admin || p acct)
|
||||
|
@ -188,6 +189,14 @@ server T.Config{..} = createAccount
|
|||
liftIO $ Sessions.delete dbFile uuid
|
||||
pure $ addHeader Auth.emptyCookie NoContent
|
||||
|
||||
unfreezeAccount :: T.SessionCookie
|
||||
-> T.UnfreezeAccountRequest
|
||||
-> Handler NoContent
|
||||
unfreezeAccount cookie T.UnfreezeAccountRequest{..} =
|
||||
adminsAnd cookie (\T.Account{..} -> accountRole == T.Manager) $ do
|
||||
liftIO $ LoginAttempts.reset dbFile unfreezeAccountRequestUsername
|
||||
pure NoContent
|
||||
|
||||
run :: T.Config -> IO ()
|
||||
run config =
|
||||
Warp.run 3000 (serve (Proxy @ API) $ server config)
|
||||
|
|
|
@ -467,3 +467,12 @@ updateTrip UpdateTripRequest{..} Trip{..} = Trip
|
|||
, tripEndDate = M.fromMaybe tripEndDate updateTripRequestEndDate
|
||||
, tripComment = M.fromMaybe tripComment updateTripRequestComment
|
||||
}
|
||||
|
||||
data UnfreezeAccountRequest = UnfreezeAccountRequest
|
||||
{ unfreezeAccountRequestUsername :: Username
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON UnfreezeAccountRequest where
|
||||
parseJSON = withObject "UnfreezeAccountRequest" $ \x -> do
|
||||
unfreezeAccountRequestUsername <- x .: "username"
|
||||
pure UnfreezeAccountRequest{..}
|
||||
|
|
Loading…
Reference in a new issue