fix test

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

@@ -28,7 +28,7 @@ data DirectoryOpts = DirectoryOpts
     blockedExtensionRules :: Maybe FilePath,
     nameSpellingFile :: Maybe FilePath,
     profileNameLimit :: Int,
-    captchaGenerator :: FilePath,
+    captchaGenerator :: Maybe FilePath,
     directoryLog :: Maybe FilePath,
     serviceName :: T.Text,
     runCLI :: Bool,
@@ -99,11 +99,12 @@ directoryOpts appDir defaultDbName = do
           <> value maxBound
       )
   captchaGenerator <-
-    strOption
-      ( long "captcha-generator"
-          <> metavar "CAPTCHA_GENERATOR"
-          <> help "Executable to generate captcha files, must accept text as parameter and save file to stdout as base64 up to 12500 bytes"
-      )
+    optional $
+      strOption
+        ( long "captcha-generator"
+            <> metavar "CAPTCHA_GENERATOR"
+            <> help "Executable to generate captcha files, must accept text as parameter and save file to stdout as base64 up to 12500 bytes"
+        )
   directoryLog <-
     Just
       <$> strOption

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

@@ -448,11 +448,11 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     sendMemberCaptcha :: GroupInfo -> GroupMember -> Text -> Int -> IO ()
     sendMemberCaptcha GroupInfo {groupId} m noticeText prevAttempts = do
       s <- getCaptchaStr captchaLength ""
-      img <- getCaptcha s
+      mc <- getCaptcha s
       sentAt <- getCurrentTime
       let captcha = PendingCaptcha {captchaText = T.pack s, sentAt, attempts = prevAttempts + 1}
       atomically $ TM.insert gmId captcha $ pendingCaptchas env
-      sendCaptcha $ ImageData img
+      sendCaptcha mc
       where
         getCaptchaStr 0 s = pure s
         getCaptchaStr n s = do
@@ -460,9 +460,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           let c = chars !! i
           getCaptchaStr (n - 1) (c : s)
         chars = "23456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
-        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]
+        getCaptcha s = case captchaGenerator opts of
+          Nothing -> pure textMsg
+          Just script -> content <$> readProcess script [s] ""
+          where
+            textMsg = MCText $ T.pack s 
+            content r = case T.lines $ T.pack r of
+              [] -> textMsg
+              "" : _ -> textMsg
+              img : _ -> MCImage "" $ ImageData img
+        sendCaptcha mc = sendComposedMessages cc (SRGroup groupId $ Just gmId) [MCText noticeText, mc]
         gmId = groupMemberId' m
 
     approvePendingMember :: DirectoryMemberAcceptance -> GroupInfo -> GroupMember -> IO ()

simplex-chat.cabal

@@ -518,6 +518,7 @@ test-suite simplex-chat-test
     , mtl >=2.3.1 && <3.0
     , network ==3.1.*
     , optparse-applicative >=0.15 && <0.17
+    , random >=1.1 && <1.3
     , silently ==1.2.*
     , simple-logger ==0.1.*
     , simplex-chat

tests/Bots/DirectoryTests.hs

@@ -86,11 +86,11 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
       adminUsers = [],
       superUsers,
       ownersGroup,
+      blockedFragmentsFile = Nothing,
       blockedWordsFile = Nothing,
       blockedExtensionRules = Nothing,
       nameSpellingFile = Nothing,
       profileNameLimit = maxBound,
-      acceptAsObserver = Nothing,
       captchaGenerator = Nothing,
       directoryLog = Just $ ps </> "directory_service.log",
       serviceName = "SimpleX-Directory",
@@ -1115,7 +1115,9 @@ runDirectory cfg opts@DirectoryOpts {directoryLog} action = do
   threadDelay 500000
   action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t)
   where
-    bot st = simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts
+    bot st = do
+      env <- newServiceState opts
+      simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts env
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
 registerGroup su u n fn = registerGroupId su u n fn 1 1