captcha works

This commit is contained in:
Evgeny Poberezkin
2025-03-01 23:09:15 +00:00
parent dde4548e03
commit c0f1cf8c16
@@ -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