directory: use lowercase letters in captcha, accept any case for same-looking letters (#5744)

apps/simplex-directory-service/src/Directory/Captcha.hs

@@ -11,30 +11,27 @@ getCaptchaStr n s = do
   i <- randomRIO (0, length captchaChars - 1)
   let c = captchaChars !! i
   getCaptchaStr (n - 1) (c : s)
+  where
+    captchaChars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
 
 matchCaptchaStr :: T.Text -> T.Text -> Bool
 matchCaptchaStr captcha guess = T.length captcha == T.length guess && matchChars (T.zip captcha guess)
   where
     matchChars [] = True
-    matchChars ((c, g) : cs) =
-      let g' = fromMaybe g $ M.lookup g captchaMatches
-       in c == g' && matchChars cs
-
-captchaChars :: String
-captchaChars = "23456789ABCDEFGHIJKLMNOPQRSTUVWXYZabdefghijkmnpqrty"
-
-captchaMatches :: M.Map Char Char
-captchaMatches =
-  M.fromList
-    [ ('0', 'O'),
-      ('1', 'I'),
-      ('c', 'C'),
-      ('l', 'I'),
-      ('o', 'O'),
-      ('s', 'S'),
-      ('u', 'U'),
-      ('v', 'V'),
-      ('w', 'W'),
-      ('x', 'X'),
-      ('z', 'Z')
-    ]
+    matchChars ((c, g) : cs) = matchChar c == matchChar g && matchChars cs
+    matchChar c = fromMaybe c $ M.lookup c captchaMatches
+    captchaMatches =
+      M.fromList
+        [ ('0', 'O'),
+          ('1', 'I'),
+          ('c', 'C'),
+          ('l', 'I'),
+          ('o', 'O'),
+          ('p', 'P'),
+          ('s', 'S'),
+          ('u', 'U'),
+          ('v', 'V'),
+          ('w', 'W'),
+          ('x', 'X'),
+          ('z', 'Z')
+        ]

simplex-chat.cabal

@@ -476,6 +476,7 @@ test-suite simplex-chat-test
       Broadcast.Bot
       Broadcast.Options
       Directory.BlockedWords
+      Directory.Captcha
       Directory.Events
       Directory.Options
       Directory.Search

tests/Bots/DirectoryTests.hs

@@ -982,11 +982,13 @@ testCaptcha _ps = do
   let captcha = "23456789ABCDEFGHIJKLMNOPQRSTUVWXYZabdefghijkmnpqrty"
   matchCaptchaStr captcha captcha `shouldBe` True
   matchCaptchaStr captcha "23456789ABcDEFGH1JKLMNoPQRsTuvwxYzabdefghijkmnpqrty" `shouldBe` True
-  matchCaptchaStr "OOIICSUVWXZ" "OOIICSUVWXZ" `shouldBe` True
-  matchCaptchaStr "OOIICSUVWXZ" "0o1lcsuvwxz" `shouldBe` True
-  matchCaptchaStr "OOIICSUVWXZ" "" `shouldBe` False
-  matchCaptchaStr "OOIICSUVWXZ" "0o1lcsuvwx" `shouldBe` False
-  matchCaptchaStr "OOIICSUVWXZ" "0o1lcsuvwxzz" `shouldBe` False
+  matchCaptchaStr "23456789ABcDEFGH1JKLMNoPQRsTuvwxYzabdefghijkmnpqrty" captcha `shouldBe` True
+  matchCaptchaStr "OOIICPSUVWXZ" "OOIICPSUVWXZ" `shouldBe` True
+  matchCaptchaStr "OOIICPSUVWXZ" "0o1lcpsuvwxz" `shouldBe` True
+  matchCaptchaStr "0o1lcpsuvwxz" "OOIICPSUVWXZ" `shouldBe` True
+  matchCaptchaStr "OOIICPSUVWXZ" "" `shouldBe` False
+  matchCaptchaStr "OOIICPSUVWXZ" "0o1lcpsuvwx" `shouldBe` False
+  matchCaptchaStr "OOIICPSUVWXZ" "0o1lcpsuvwxzz" `shouldBe` False
 
 listGroups :: HasCallStack => TestCC -> TestCC -> TestCC -> IO ()
 listGroups superUser bob cath = do