From 1d7c77f51d287c9d636630142791952890d17622 Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Fri, 31 Jul 2020 11:37:45 +0100
Subject: [PATCH] Support POST /unfreeze

Allow admins and managers to unfreeze accounts that we froze for security
reasons.
---
 src/API.hs   | 4 ++++
 src/App.hs   | 9 +++++++++
 src/Types.hs | 9 +++++++++
 3 files changed, 22 insertions(+)

diff --git a/src/API.hs b/src/API.hs
index cc737c16b..8bdb6bdfb 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 df7091051..e3806610a 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 485111f38..7bfdf6cfd 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{..}