about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--src/API.hs4
-rw-r--r--src/App.hs9
-rw-r--r--src/Types.hs9
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{..}