From 246d370bd903edeb5570b6f016556528b8ca57fc Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud@pankzsoft.com>
Date: Wed, 5 Nov 2025 08:24:05 +0100
Subject: can cleanup registered users

---
 lambda-calcul/haskell/src/Minilang/App.hs | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

(limited to 'lambda-calcul/haskell/src/Minilang/App.hs')

diff --git a/lambda-calcul/haskell/src/Minilang/App.hs b/lambda-calcul/haskell/src/Minilang/App.hs
index 9086d27..915f264 100644
--- a/lambda-calcul/haskell/src/Minilang/App.hs
+++ b/lambda-calcul/haskell/src/Minilang/App.hs
@@ -24,7 +24,7 @@ import Minilang.REPL (withInputs)
 import Minilang.REPL.Purer (PurerEnv (..))
 import Minilang.REPL.Types (In (..), Out (..), initialREPL)
 import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
-import Servant (ServerT, err400, err500, errBody, (:<|>) (..))
+import Servant (ServerT, err400, err500, errBody, (:<|>) (..), err404)
 import Servant.Server (Application, Handler (..), Tagged (..))
 import System.Random (StdGen)
 
@@ -50,6 +50,7 @@ runApp env = Handler . ExceptT . try . flip runReaderT env . runAppM
 lambdaApp :: (MonadIO m, MonadReader Env m) => ServerT LambdaAPI m
 lambdaApp =
   registerUser
+    :<|> unregisterUser
     :<|> getLeaderboard
     :<|> getUser
     :<|> getChallenge
@@ -68,6 +69,22 @@ registerUser user@(User name) = do
       writeTVar tvar updatedMap
   pure token
 
+unregisterUser :: (MonadReader Env m, MonadIO m) => Maybe Token -> m Score
+unregisterUser Nothing = liftIO $ throwM $ err400 {errBody = "Missing token"}
+unregisterUser (Just token) = do
+  checkUserToken token
+  score <-
+    asks users
+      >>= liftIO . atomically . \tvar -> do
+        usersMap <- readTVar tvar
+        let score = Map.lookup token usersMap
+            updatedMap = Map.delete token usersMap
+        writeTVar tvar updatedMap
+        pure score
+  case score of
+    Nothing -> liftIO $ throwM $ err400 {errBody = "User does not exist"}
+    Just s -> pure s
+
 checkDuplicateUser :: (MonadIO m, MonadReader Env m) => Text -> m ()
 checkDuplicateUser name =
   asks users >>= \user -> liftIO $ atomically $ do
@@ -97,7 +114,7 @@ getUser :: (MonadIO m, MonadReader Env m) => Maybe Token -> m Score
 getUser mToken = do
   usersMap <- asks users >>= liftIO . readTVarIO
   case mToken >>= (`Map.lookup` usersMap) of
-    Nothing -> liftIO $ throwM $ err400 {errBody = "User does not exist"}
+    Nothing -> liftIO $ throwM $ err404 {errBody = "User does not exist"}
     Just score -> pure score
 
 getChallenge :: (MonadReader Env m, MonadIO m) => Maybe Token -> m Challenge
-- 
cgit v1.3.1