From eceeb8c264803d6224c27d67948434dcdc9f65bb Mon Sep 17 00:00:00 2001
From: Philippe PITTOLI <karchnu@karchnu.fr>
Date: Fri, 28 Jun 2024 16:46:15 +0200
Subject: [PATCH] Authentication: accept passwords without lower limit on the
 number of characters.

---
 src/App/Page/Authentication.purs |  6 +++---
 src/App/Validation/Password.purs | 27 ++++++++++++++++++++++++---
 2 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/src/App/Page/Authentication.purs b/src/App/Page/Authentication.purs
index 7d06bd4..e6d6e8b 100644
--- a/src/App/Page/Authentication.purs
+++ b/src/App/Page/Authentication.purs
@@ -298,11 +298,11 @@ handleAction = case _ of
         H.raise $ Log $ UnableToSend "Write your password!"
 
       _, _ -> do
-        case L.login login, P.password pass of
+        case L.login login, P.password_on_authentication_page pass of
           Left errors, _ -> H.modify_ _ { errors = [ Login    errors ] }
           _, Left errors -> H.modify_ _ { errors = [ Password errors ] }
-          _, _            -> do H.modify_ _ { errors = [] }
-                                H.raise $ AuthenticateToAuthd (Tuple login pass)
+          _, _           -> do H.modify_ _ { errors = [] }
+                               H.raise $ AuthenticateToAuthd (Tuple login pass)
         H.raise $ Log $ SystemLog $ "authenticate (login: " <> login <> ")"
 
   PasswordRecoveryAttempt ev -> do
diff --git a/src/App/Validation/Password.purs b/src/App/Validation/Password.purs
index 2496bb2..42918d8 100644
--- a/src/App/Validation/Password.purs
+++ b/src/App/Validation/Password.purs
@@ -25,6 +25,11 @@ min_password_size = 15
 max_password_size :: Int
 max_password_size = 100
 
+min_password_size_auth :: Int
+min_password_size_auth = 0
+max_password_size_auth :: Int
+max_password_size_auth = 100
+
 parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
 parse (G.Parser p) str c = case p { string: str, position: 0 } of
   Left x  -> invalid $ [c x]
@@ -35,9 +40,25 @@ password_parser = do
   l <- G.many1 (vchar <|> G.char ' ') G.<:> \_ -> CannotParse
   _ <- SomeParsers.eof                G.<:> \_ -> CannotEntirelyParse
   pos <- G.current_position
-  if pos < min_password_size || pos > max_password_size
-  then G.Parser \i -> G.failureError i.position (Just $ Size min_password_size max_password_size pos)
-  else pure $ CU.fromCharArray l
+  if between min_password_size max_password_size pos
+  then pure $ CU.fromCharArray l
+  else G.Parser \i -> G.failureError i.position (Just $ Size min_password_size max_password_size pos)
+
+-- The only change actually is the size of the accepted password.
+password_auth_parser :: G.Parser PasswordParsingError String
+password_auth_parser = do
+  l <- G.many1 (vchar <|> G.char ' ') G.<:> \_ -> CannotParse
+  _ <- SomeParsers.eof                G.<:> \_ -> CannotEntirelyParse
+  pos <- G.current_position
+  if between min_password_size_auth max_password_size_auth pos
+  then pure $ CU.fromCharArray l
+  else G.Parser \i -> G.failureError i.position (Just $ Size min_password_size_auth max_password_size_auth pos)
 
 password :: String -> Either (Array Error) String
 password s = toEither $ parse password_parser s ParsingError
+
+-- | The password on the authentication page is a little different because
+-- | migrated accounts may not follow the rules for new clients as seen on the
+-- | registration page.
+password_on_authentication_page :: String -> Either (Array Error) String
+password_on_authentication_page s = toEither $ parse password_auth_parser s ParsingError