diff options
author | William Carroll <wpcarro@gmail.com> | 2020-07-31T10·37+0100 |
---|---|---|
committer | William Carroll <wpcarro@gmail.com> | 2020-07-31T10·37+0100 |
commit | 1d7c77f51d287c9d636630142791952890d17622 (patch) | |
tree | 596edb7d9b6e76ae86058896ad47749186ddf18c | |
parent | 43eff5f1d037b3e45a3b7a274048527e2a95103d (diff) |
Support POST /unfreeze
Allow admins and managers to unfreeze accounts that we froze for security reasons.
-rw-r--r-- | src/API.hs | 4 | ||||
-rw-r--r-- | src/App.hs | 9 | ||||
-rw-r--r-- | src/Types.hs | 9 |
3 files changed, 22 insertions, 0 deletions
diff --git a/src/API.hs b/src/API.hs index cc737c16bd72..8bdb6bdfbb73 100644 --- a/src/API.hs +++ b/src/API.hs @@ -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 diff --git a/src/App.hs b/src/App.hs index df70910510e0..e3806610aa5b 100644 --- a/src/App.hs +++ b/src/App.hs @@ -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) diff --git a/src/Types.hs b/src/Types.hs index 485111f38bac..7bfdf6cfd000 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -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{..} |