From c0f1cf8c16e4bf1076a0ce8d0d532a1a9cabe16f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sat, 1 Mar 2025 23:09:15 +0000
Subject: [PATCH] captcha works

---
 .../src/Directory/Service.hs                   | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 0837f4dc5b..d85fbfa56f 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -26,6 +26,7 @@ import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
 import Data.List (find, intercalate)
+import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, maybeToList)
 import Data.Set (Set)
@@ -92,7 +93,7 @@ data PendingCaptcha = PendingCaptcha
   }
 
 captchaLength :: Int
-captchaLength = 7
+captchaLength = 6
 
 maxCaptchaAttempts :: Int
 maxCaptchaAttempts = 5
@@ -163,6 +164,8 @@ acceptMemberHook
         | useMemberFilter img (useCaptcha a) -> (GAManual, GRMember)
         | useMemberFilter img (makeObserver a) -> (GAAuto, GRObserver)
         | otherwise -> (GAAuto, memberRole)
+    -- TODO [captcha] uncomment for testing
+    -- pure (GAManual, GRMember)
     where
       checkName :: ExceptT GroupRejectionReason IO ()
       checkName
@@ -435,12 +438,12 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             Just Nothing -> sendToApprove toGroup gr gaId
 
     dePendingMember :: GroupInfo -> GroupMember -> IO ()
-    dePendingMember g m
+    dePendingMember g@GroupInfo {groupProfile = GroupProfile {displayName}}  m
       | memberRequiresCaptcha a m = sendMemberCaptcha g m captchaNotice 0
       | otherwise = approvePendingMember a g m
       where
         a = groupMemberAcceptance g
-        captchaNotice = "This image is generated in SimpleX Directory service, without any 3rd party APIs.\nEnter the text in the image to join group."
+        captchaNotice = "Captcha is generated by SimpleX Directory service.\n\n*Send captcha text* to join the group " <> displayName <> "."
 
     sendMemberCaptcha :: GroupInfo -> GroupMember -> Text -> Int -> IO ()
     sendMemberCaptcha GroupInfo {groupId} m noticeText prevAttempts = do
@@ -457,8 +460,9 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           let c = chars !! i
           getCaptchaStr (n - 1) (c : s)
         chars = "23456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
-        getCaptcha t = T.pack <$> readProcess (captchaGenerator opts) [t] ""
-        sendCaptcha img = sendComposedMessages cc (SRGroup groupId $ Just gmId) [MCText noticeText, MCImage "" img]
+        getCaptcha t = firstLine <$> readProcess (captchaGenerator opts) [t] ""
+        firstLine = maybe "" L.head . L.nonEmpty . T.lines . T.pack
+        sendCaptcha img= sendComposedMessages cc (SRGroup groupId $ Just gmId) [MCText noticeText, MCImage "" img]
         gmId = groupMemberId' m
 
     approvePendingMember :: DirectoryMemberAcceptance -> GroupInfo -> GroupMember -> IO ()
@@ -502,8 +506,10 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         tooManyAttempts = "Too many failed attempts, you can't join group."
 
     memberRequiresCaptcha :: DirectoryMemberAcceptance -> GroupMember -> Bool
-    memberRequiresCaptcha a GroupMember {memberProfile = LocalProfile {image}} = do
+    memberRequiresCaptcha a GroupMember {memberProfile = LocalProfile {image}} =
       useMemberFilter image $ useCaptcha a
+      -- TODO [captcha] uncomment for testing
+      -- True
 
     sendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO ()
     sendToApprove GroupInfo {groupProfile = p@GroupProfile {displayName, image = image'}} GroupReg {dbGroupId, dbContactId} gaId = do