diff --git a/CHANGELOG.md b/CHANGELOG.md index 5c78253a9..21e752c68 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,25 @@ +# 6.0.4 + +SMP server: +- better performance/memory: fewer map updates on re-subscriptions (#1297), split and reduce STM transactions (#1294) +- send DELD when subscribed queue is deleted (#1312) +- add created/updated/used date to queues to manage expiration (#1306) + +XFTP server: truncate file creation time to 1 hour (#1310) + +Servers: +- bind control port only to 127.0.0.1 for better security in case of firewall misconfiguration (#1280) +- reduce memory used for period stats (#1298) + +Agent: process last notification from list (#1307) +- report receive file error with redirected file ID, when redirect is present (#1304) +- special error when deleted user record is not in database (#1303) +- fix race when sending a message to the deleted connection (#1296) +- support for multiple messages in a single notification + +Ntf server: +- only use SOCKS proxy for servers without public address (#1314) + # 6.0.3 Agent: diff --git a/package.yaml b/package.yaml index 26936b4af..da0ec8a9c 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: simplexmq -version: 6.0.3.0 +version: 6.0.4.0 synopsis: SimpleXMQ message broker description: | This package includes <./docs/Simplex-Messaging-Server.html server>, diff --git a/protocol/xrcp.md b/protocol/xrcp.md index 2ed2c8d62..9f7187e66 100644 --- a/protocol/xrcp.md +++ b/protocol/xrcp.md @@ -250,7 +250,7 @@ In pseudo-code: ``` // session 1 hostHelloSecret(1) = dhSecret(1) -sessionSecret(1) = sha3-256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello +sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1)) kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1)) // kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO @@ -262,7 +262,7 @@ dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n)) // session n hostHelloSecret(n) = dhSecret(n) -sessionSecret(n) = sha3-256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello +sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n)) // controllerDhKey(n) is either from invitation or from multicast announcement kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n)) diff --git a/scripts/main/simplex-servers-stopscript b/scripts/main/simplex-servers-stopscript index 53d9f13bf..acfed3431 100755 --- a/scripts/main/simplex-servers-stopscript +++ b/scripts/main/simplex-servers-stopscript @@ -1,30 +1,174 @@ #!/usr/bin/env sh set -eu -path_conf_var="/var/opt" -path_conf_smp="$path_conf_var/simplex" -path_conf_xftp="$path_conf_var/simplex-xftp" -path_conf_storelog_smp="$path_conf_smp/smp-server-store.log" -path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log" +# Common +# ------ date="$(date -u '+%Y-%m-%dT%H:%M:%S')" -backup_smp() { - if [ -e "$path_conf_storelog_smp" ]; then - cp "$path_conf_storelog_smp" "${path_conf_storelog_smp}.${date:-date-failed}" - fi +GRN='\033[0;32m' +YLW='\033[1;33m' +BLU='\033[1;34m' +RED='\033[0;31m' +NC='\033[0m' + +path_conf_var="/var/opt" + +smp_variables() { + path_conf_smp="$path_conf_var/simplex" + path_conf_smp_archive="$path_conf_smp/backups" + path_conf_smp_archive_storelog="$path_conf_smp_archive/queues" + path_conf_smp_archive_stats="$path_conf_smp_archive/stats" + path_conf_smp_archive_messages="$path_conf_smp_archive/messages" + path_conf_storelog_smp="$path_conf_smp/smp-server-store.log" + path_conf_storelog_smp_out="$path_conf_smp_archive_storelog/smp-server-store.log.${date:-date-failed}" + + path_conf_stats_smp="$path_conf_smp/smp-server-stats.log" + path_conf_stats_smp_out="$path_conf_smp_archive_stats/smp-server-stats.log.${date:-date-failed}" + + path_conf_messages_smp="$path_conf_smp/smp-server-messages.log" + path_conf_messages_smp_out="$path_conf_smp_archive_messages/smp-server-messages.log.${date:-date-failed}" } -backup_xftp() { - if [ -e "$path_conf_storelog_xftp" ]; then - cp "$path_conf_storelog_xftp" "${path_conf_storelog_xftp}.${date:-date-failed}" - fi +xftp_variables() { + path_conf_xftp="$path_conf_var/simplex-xftp" + path_conf_xftp_archive="$path_conf_xftp/backups" + + path_conf_xftp_archive_storelog="$path_conf_xftp_archive/queues" + path_conf_xftp_archive_stats="$path_conf_xftp_archive/stats" + + path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log" + path_conf_storelog_xftp_out="$path_conf_xftp_archive_storelog/file-server-store.log.${date:-date-failed}" + + path_conf_stats_xftp="$path_conf_xftp/file-server-stats.log" + path_conf_stats_xftp_out="$path_conf_xftp_archive_stats/file-server-stats.log.${date:-date-failed}" } -if [ "$1" = 'smp-server' ]; then - backup_smp -elif [ "$1" = 'xftp-server' ]; then - backup_xftp -else - backup_smp - backup_xftp -fi +checks() { + result=${SERVICE_RESULT:-exit-code} + status=${EXIT_STATUS:-TERM} + + case "$result" in + success) + case "$status" in + TERM) + printf "${RED}Refusing to backup files with failed service state${NC}\n" + exit 1 + ;; + *) + : + ;; + esac + ;; + *) + printf "${RED}Refusing to backup files with failed service state${NC}\n" + exit 1 + ;; + esac +} + +smp_check() { + if [ ! -d "$path_conf_smp_archive_storelog" ]; then + mkdir -p "$path_conf_smp_archive_storelog" + fi + if [ ! -d "$path_conf_smp_archive_messages" ]; then + mkdir -p "$path_conf_smp_archive_messages" + fi + if [ ! -d "$path_conf_smp_archive_stats" ]; then + mkdir -p "$path_conf_smp_archive_stats" + fi +} + +xftp_check() { + if [ ! -d "$path_conf_xftp_archive_storelog" ]; then + mkdir -p "$path_conf_xftp_archive_storelog" + fi + if [ ! -d "$path_conf_xftp_archive_stats" ]; then + mkdir -p "$path_conf_xftp_archive_stats" + fi +} + +backup() { + file="$1" + out="$2" + file_type="$3" + + if [ -e "$file" ]; then + if cp "$file" "$out"; then + printf "${YLW}${file_type}${NC} ${GRN}backup successful:${NC} ${BLU}%s${NC}\n" "${out}" + else + printf "${YLW}${file_type}${NC} ${RED}backup failed!${NC}\n" + fi + fi + + unset file out file_type +} + +cleanup() { + directory="$1" + + file_type="$2" + + files_date=$(find "$directory" -type f -exec stat --format="%y" {} + | awk '{print $1}' | sort -nr | uniq | awk 'NR==2') + + if [ -n "$files_date" ]; then + files=$(find "$directory" -type f -not -newermt "$files_date" -printf "%T@ %Tc %p\n" | sort -n | awk '{print $NF}') + + if [ -n "$files" ]; then + printf '%s' "$files" | xargs rm -f + printf "${YLW}Old ${file_type} files${NC}${GRN} has been deleted:${NC}\n" + files_colored=$(printf '%s' "$files" | awk '{print "\033[1;34m"$0"\033[0m"}') + printf "${files_colored}\n" + fi + fi + + unset directory file_type files_date files +} + +smp_backup() { + backup "$path_conf_storelog_smp" "$path_conf_storelog_smp_out" 'Storelog' + backup "$path_conf_messages_smp" "$path_conf_messages_smp_out" 'Messages' + backup "$path_conf_stats_smp" "$path_conf_stats_smp_out" 'Stats' +} + +smp_cleanup() { + cleanup "$path_conf_smp_archive_storelog" 'storelog' + cleanup "$path_conf_smp_archive_stats" 'stats' + cleanup "$path_conf_smp_archive_messages" 'messages' +} + +xftp_backup() { + backup "$path_conf_storelog_xftp" "$path_conf_storelog_xftp_out" 'Storelog' + backup "$path_conf_stats_xftp" "$path_conf_stats_xftp_out" 'Stats' +} + +xftp_cleanup() { + cleanup "$path_conf_xftp_archive_storelog" 'storelog' + cleanup "$path_conf_xftp_archive_stats" 'stats' +} + +main() { + type="${1:-}" + + checks + + case "$type" in + smp-server) + smp_variables + smp_check + smp_backup + smp_cleanup + ;; + xftp-server) + xftp_variables + xftp_check + xftp_backup + xftp_cleanup + ;; + *) + printf "${YLW}Unknown server type.${NC}\n" + exit 1 + ;; + esac +} + +main "$@" diff --git a/simplexmq.cabal b/simplexmq.cabal index 98cf23d06..86eda28b4 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: simplexmq -version: 6.0.3.0 +version: 6.0.4.0 synopsis: SimpleXMQ message broker description: This package includes <./docs/Simplex-Messaging-Server.html server>, <./docs/Simplex-Messaging-Client.html client> and diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 699a8cb06..66180d6d5 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -166,7 +166,7 @@ import Simplex.Messaging.Agent.Store import Simplex.Messaging.Agent.Store.SQLite import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations -import Simplex.Messaging.Client (ProtocolClient (..), SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse) +import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs) import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) @@ -181,7 +181,7 @@ import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBod import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) import qualified Simplex.Messaging.TMap as TM -import Simplex.Messaging.Transport (SMPVersion, THandleParams (sessionId)) +import Simplex.Messaging.Transport (SMPVersion) import Simplex.Messaging.Util import Simplex.Messaging.Version import Simplex.RemoteControl.Client @@ -1984,7 +1984,7 @@ deleteNtfToken' :: AgentClient -> DeviceToken -> AM () deleteNtfToken' c deviceToken = withStore' c getSavedNtfToken >>= \case Just tkn@NtfToken {deviceToken = savedDeviceToken} -> do - when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "deleteNtfToken: different token" + when (deviceToken /= savedDeviceToken) $ logWarn "deleteNtfToken: different token" deleteToken_ c tkn deleteNtfSubs c NSCSmpDelete _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token" @@ -2021,17 +2021,18 @@ toggleConnectionNtfs' c connId enable = do atomically $ sendNtfSubCommand ns (connId, cmd) deleteToken_ :: AgentClient -> NtfToken -> AM () -deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do +deleteToken_ c@AgentClient {subQ} tkn@NtfToken {ntfTokenId, ntfTknStatus} = do ns <- asks ntfSupervisor forM_ ntfTokenId $ \tknId -> do let ntfTknAction = Just NTADelete withStore' c $ \db -> updateNtfToken db tkn ntfTknStatus ntfTknAction atomically $ nsUpdateToken ns tkn {ntfTknStatus, ntfTknAction} - agentNtfDeleteToken c tknId tkn `catchAgentError` \case - NTF _ AUTH -> pure () - e -> throwE e + agentNtfDeleteToken c tknId tkn `catchAgentError` \e -> notify (ERR e) -- TODO cleanup task withStore' c $ \db -> removeNtfToken db tkn atomically $ nsRemoveNtfToken ns + where + notify :: forall e. AEntityI e => AEvent e -> AM () + notify cmd = atomically $ writeTBQueue subQ ("", "", AEvt (sAEntity @e) cmd) withToken :: AgentClient -> NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> AM a -> AM NtfTknStatus withToken c tkn@NtfToken {deviceToken, ntfMode} from_ (toStatus, toAction_) f = do @@ -2450,17 +2451,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId handleNotifyAck :: AM ACKd -> AM ACKd handleNotifyAck m = m `catchAgentError` \e -> notify (ERR e) >> ack SMP.END -> - atomically (TM.lookup tSess (smpClients c) $>>= (tryReadTMVar . sessionVar) >>= processEND) + atomically (ifM (activeClientSession c tSess sessId) (removeSubscription c connId $> True) (pure False)) >>= notifyEnd where - processEND = \case - Just (Right clnt) - | sessId == sessionId (thParams $ connectedClient clnt) -> - removeSubscription c connId $> True - _ -> pure False notifyEnd removed | removed = notify END >> logServer "<--" c srv rId "END" | otherwise = logServer "<--" c srv rId "END from disconnected client - ignored" + -- Possibly, we need to add some flag to connection that it was deleted + SMP.DELD -> atomically (removeSubscription c connId) >> notify DELD SMP.ERR e -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e r -> unexpected r where diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 178d87109..13e5011a2 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -344,6 +344,7 @@ data AEvent (e :: AEntity) where INFO :: PQSupport -> ConnInfo -> AEvent AEConn CON :: PQEncryption -> AEvent AEConn -- notification that connection is established END :: AEvent AEConn + DELD :: AEvent AEConn CONNECT :: AProtocolType -> TransportHost -> AEvent AENone DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone DOWN :: SMPServer -> [ConnId] -> AEvent AENone @@ -413,6 +414,7 @@ data AEventTag (e :: AEntity) where INFO_ :: AEventTag AEConn CON_ :: AEventTag AEConn END_ :: AEventTag AEConn + DELD_ :: AEventTag AEConn CONNECT_ :: AEventTag AENone DISCONNECT_ :: AEventTag AENone DOWN_ :: AEventTag AENone @@ -466,6 +468,7 @@ aEventTag = \case INFO {} -> INFO_ CON _ -> CON_ END -> END_ + DELD -> DELD_ CONNECT {} -> CONNECT_ DISCONNECT {} -> DISCONNECT_ DOWN {} -> DOWN_ diff --git a/src/Simplex/Messaging/Crypto/SNTRUP761.hs b/src/Simplex/Messaging/Crypto/SNTRUP761.hs index 6f903804e..99b2771f6 100644 --- a/src/Simplex/Messaging/Crypto/SNTRUP761.hs +++ b/src/Simplex/Messaging/Crypto/SNTRUP761.hs @@ -4,7 +4,7 @@ module Simplex.Messaging.Crypto.SNTRUP761 where -import Crypto.Hash (Digest, SHA3_256, hash) +import Crypto.Hash (Digest, SHA256, hash) import Data.ByteArray (ScrubbedBytes) import qualified Data.ByteArray as BA import Data.ByteString (ByteString) @@ -28,4 +28,4 @@ kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret kemHybridSecret k pk (KEMSharedKey kem) = let DhSecretX25519 dh = C.dh' k pk - in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA3_256) + in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256) diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 736f164ba..556d4a930 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -443,6 +443,8 @@ data NtfSubStatus NSInactive | -- | END received NSEnd + | -- | DELD received (connection was deleted) + NSDeleted | -- | SMP AUTH error NSAuth | -- | SMP error other than AUTH @@ -456,6 +458,7 @@ ntfShouldSubscribe = \case NSActive -> True NSInactive -> True NSEnd -> False + NSDeleted -> False NSAuth -> False NSErr _ -> False @@ -466,6 +469,7 @@ instance Encoding NtfSubStatus where NSActive -> "ACTIVE" NSInactive -> "INACTIVE" NSEnd -> "END" + NSDeleted -> "DELETED" NSAuth -> "AUTH" NSErr err -> "ERR " <> err smpP = @@ -475,6 +479,7 @@ instance Encoding NtfSubStatus where "ACTIVE" -> pure NSActive "INACTIVE" -> pure NSInactive "END" -> pure NSEnd + "DELETED" -> pure NSDeleted "AUTH" -> pure NSAuth "ERR" -> NSErr <$> (A.space *> A.takeByteString) _ -> fail "bad NtfSubStatus" diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 2f4093ac3..2c964f9bf 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -226,6 +226,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge Right SMP.END -> whenM (atomically $ activeClientSession' ca sessionId srv) $ updateSubStatus smpQueue NSEnd + Right SMP.DELD -> updateSubStatus smpQueue NSDeleted Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e Right _ -> logError "SMP server unexpected response" Left e -> logError $ "SMP client error: " <> tshow e diff --git a/src/Simplex/Messaging/Notifications/Server/Main.hs b/src/Simplex/Messaging/Notifications/Server/Main.hs index cd8561dd3..5002d2d45 100644 --- a/src/Simplex/Messaging/Notifications/Server/Main.hs +++ b/src/Simplex/Messaging/Notifications/Server/Main.hs @@ -16,7 +16,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Network.Socket (HostName) import Options.Applicative -import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig) +import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig) import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Notifications.Server (runNtfServer) @@ -26,6 +26,7 @@ import Simplex.Messaging.Notifications.Transport (supportedNTFHandshakes, suppor import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer) import Simplex.Messaging.Server.CLI import Simplex.Messaging.Server.Expiration +import Simplex.Messaging.Server.Main (textToHostMode) import Simplex.Messaging.Transport (simplexMQVersion) import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig) @@ -92,6 +93,10 @@ ntfServerCLI cfgPath logPath = <> "websockets: off\n\n\ \[SUBSCRIBER]\n\ \# Network configuration for notification server client.\n\ + \# `host_mode` can be 'public' (default) or 'onion'.\n\ + \# It defines prefferred hostname for destination servers with multiple hostnames.\n\ + \# host_mode: public\n\ + \# required_host_mode: off\n\n\ \# SOCKS proxy port for subscribing to SMP servers.\n\ \# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\ \# socks_proxy: localhost:9050\n\n\ @@ -134,6 +139,8 @@ ntfServerCLI cfgPath logPath = defaultNetworkConfig { socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini, socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini, + hostMode = either (const HMPublic) textToHostMode $ lookupValue "SUBSCRIBER" "host_mode" ini, + requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini, smpPingInterval = 60_000_000 -- 1 minutes } }, diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 9dc6a7ea9..cad84454f 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -484,6 +484,7 @@ data BrokerMsg where RRES :: EncFwdResponse -> BrokerMsg -- relay to proxy PRES :: EncResponse -> BrokerMsg -- proxy to client END :: BrokerMsg + DELD :: BrokerMsg INFO :: QueueInfo -> BrokerMsg OK :: BrokerMsg ERR :: ErrorType -> BrokerMsg @@ -705,6 +706,7 @@ data BrokerMsgTag | RRES_ | PRES_ | END_ + | DELD_ | INFO_ | OK_ | ERR_ @@ -778,6 +780,7 @@ instance Encoding BrokerMsgTag where RRES_ -> "RRES" PRES_ -> "PRES" END_ -> "END" + DELD_ -> "DELD" INFO_ -> "INFO" OK_ -> "OK" ERR_ -> "ERR" @@ -794,6 +797,7 @@ instance ProtocolMsgTag BrokerMsgTag where "RRES" -> Just RRES_ "PRES" -> Just PRES_ "END" -> Just END_ + "DELD" -> Just DELD_ "INFO" -> Just INFO_ "OK" -> Just OK_ "ERR" -> Just ERR_ @@ -1423,6 +1427,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where RRES (EncFwdResponse encBlock) -> e (RRES_, ' ', Tail encBlock) PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock) END -> e END_ + DELD + | v >= deletedEventSMPVersion -> e DELD_ + | otherwise -> e END_ INFO info -> e (INFO_, ' ', info) OK -> e OK_ ERR err -> e (ERR_, ' ', err) @@ -1448,6 +1455,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where RRES_ -> RRES <$> (EncFwdResponse . unTail <$> _smpP) PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP) END_ -> pure END + DELD_ -> pure DELD INFO_ -> INFO <$> _smpP OK_ -> pure OK ERR_ -> ERR <$> _smpP diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index e2d5edc4e..969c5399b 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -136,9 +136,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do expired <- restoreServerMessages restoreServerStats expired raceAny_ - ( serverThread s "server subscribedQ" subscribedQ subscribers pendingENDs subscriptions cancelSub - : serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ()) - : sendPendingENDsThread s + ( serverThread s "server subscribedQ" True subscribedQ subscribers pendingENDs subscriptions cancelSub + : serverThread s "server deletedQ" False deletedQ subscribers pendingDELDs subscriptions cancelSub + : serverThread s "server ntfSubscribedQ" True ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ()) + : serverThread s "server ntfDeletedQ" False ntfDeletedQ Env.notifiers pendingNtfDELDs ntfSubscriptions (\_ -> pure ()) + : sendPendingEvtsThread s : receiveFromProxyAgent pa : map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg ) @@ -163,13 +165,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do forall s. Server -> String -> - (Server -> TQueue (QueueId, ClientId, Subscribed)) -> + Subscribed -> + (Server -> TQueue (QueueId, ClientId)) -> (Server -> TMap QueueId (TVar Client)) -> (Server -> TVar (IM.IntMap (NonEmpty RecipientId))) -> (Client -> TMap QueueId s) -> (s -> IO ()) -> M () - serverThread s label subQ subs ends clientSubs unsub = do + serverThread s label subscribed subQ subs pendingEvts clientSubs unsub = do labelMyThread label cls <- asks clients liftIO . forever $ @@ -177,8 +180,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do $>>= endPreviousSubscriptions >>= mapM_ unsub where - updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId, Bool) -> STM (Maybe (QueueId, Client)) - updateSubscribers cls (qId, clntId, subscribed) = + updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId) -> STM (Maybe (QueueId, Client)) + updateSubscribers cls (qId, clntId) = -- Client lookup by ID is in the same STM transaction. -- In case client disconnects during the transaction, -- it will be re-evaluated, and the client won't be stored as subscribed. @@ -201,37 +204,41 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do | otherwise = (\yes -> if yes then Just (qId, c') else Nothing) <$> readTVar (connected c') endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s) endPreviousSubscriptions (qId, c) = do - atomically $ modifyTVar' (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c) + atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c) atomically $ TM.lookupDelete qId (clientSubs c) - sendPendingENDsThread :: Server -> M () - sendPendingENDsThread s = do + sendPendingEvtsThread :: Server -> M () + sendPendingEvtsThread s = do endInt <- asks $ pendingENDInterval . config cls <- asks clients forever $ do threadDelay endInt - sendPending cls $ pendingENDs s - sendPending cls $ pendingNtfENDs s + sendPending cls END $ pendingENDs s + sendPending cls DELD $ pendingDELDs s + sendPending cls END $ pendingNtfENDs s + sendPending cls DELD $ pendingNtfDELDs s where - sendPending cls ref = do + sendPending cls evt ref = do ends <- atomically $ swapTVar ref IM.empty unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) -> - mapM_ (queueENDs qIds) . join . IM.lookup cId =<< readTVarIO cls - queueENDs qIds c@Client {connected, sndQ = q} = + mapM_ (queueEvts qIds evt) . join . IM.lookup cId =<< readTVarIO cls + queueEvts qIds evt c@Client {connected, sndQ = q} = whenM (readTVarIO connected) $ do sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True) if sent then updateEndStats else -- if queue is full it can block - forkClient c ("sendPendingENDsThread.queueENDs") $ + forkClient c ("sendPendingEvtsThread.queueEvts") $ atomically (writeTBQueue q ts) >> updateEndStats where - ts = L.map (CorrId "",,END) qIds - updateEndStats = do - stats <- asks serverStats - let len = L.length qIds - liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len) - liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch + ts = L.map (CorrId "",,evt) qIds + updateEndStats = case evt of + END -> do + stats <- asks serverStats + let len = L.length qIds + liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len) + liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch + _ -> pure () receiveFromProxyAgent :: ProxyAgent -> M () receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} = @@ -892,7 +899,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M () -client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do +client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, deletedQ, ntfSubscribedQ, ntfDeletedQ, subscribers, notifiers} = do labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands" forever $ atomically (readTBQueue rcvQ) @@ -985,11 +992,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s processCommand (qr_, (corrId, entId, cmd)) = case cmd of Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command) Cmd SSender command -> Just <$> case command of - SKEY sKey -> (corrId,entId,) <$> case qr_ of - Just qr@QueueRec {sndSecure} - | sndSecure -> secureQueue_ "SKEY" qr sKey - | otherwise -> pure $ ERR AUTH - Nothing -> pure $ ERR INTERNAL + SKEY sKey -> + withQueue $ \QueueRec {sndSecure, recipientId} -> + (corrId,entId,) <$> if sndSecure then secureQueue_ "SKEY" recipientId sKey else pure $ ERR AUTH SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody PING -> pure (corrId, NoEntity, PONG) RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock @@ -1009,9 +1014,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s SUB -> withQueue (`subscribeQueue` entId) GET -> withQueue getMessage ACK msgId -> withQueue (`acknowledgeMsg` msgId) - KEY sKey -> (corrId,entId,) <$> case qr_ of - Just qr -> secureQueue_ "KEY" qr sKey - Nothing -> pure $ ERR INTERNAL + KEY sKey -> + withQueue $ \QueueRec {recipientId} -> + (corrId,entId,) <$> secureQueue_ "KEY" recipientId sKey NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey NDEL -> deleteQueueNotifier_ st OFF -> suspendQueue_ st @@ -1063,10 +1068,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s n <- asks $ queueIdBytes . config liftM2 (,) (randomId n) (randomId n) - secureQueue_ :: T.Text -> QueueRec -> SndPublicAuthKey -> M BrokerMsg - secureQueue_ name qr@QueueRec {recipientId = rId} sKey = time name $ do + secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg + secureQueue_ name rId sKey = time name $ do withLog $ \s -> logSecureQueue s rId sKey - updateQueueDate qr st <- asks queueStore stats <- asks serverStats incStat $ qSecured stats @@ -1086,20 +1090,22 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s liftIO (addQueueNotifier st entId ntfCreds) >>= \case Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret Left e -> pure $ ERR e - Right _ -> do + Right nId_ -> do withLog $ \s -> logAddNotifier s entId ntfCreds incStat . ntfCreated =<< asks serverStats + forM_ nId_ $ \nId -> atomically $ writeTQueue ntfDeletedQ (nId, clientId) pure $ NID notifierId rcvPublicDhKey deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg) deleteQueueNotifier_ st = do withLog (`logDeleteNotifier` entId) liftIO (deleteQueueNotifier st entId) >>= \case - Right () -> do + Right (Just nId) -> do -- Possibly, the same should be done if the queue is suspended, but currently we do not use it - atomically $ writeTQueue ntfSubscribedQ (entId, clientId, False) + atomically $ writeTQueue ntfDeletedQ (nId, clientId) incStat . ntfDeleted =<< asks serverStats pure ok + Right Nothing -> pure ok Left e -> pure $ err e suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg) @@ -1124,7 +1130,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s where newSub :: M Sub newSub = time "SUB newSub" . atomically $ do - writeTQueue subscribedQ (rId, clientId, True) + writeTQueue subscribedQ (rId, clientId) sub <- newSubscription NoSub TM.insert rId sub subscriptions pure sub @@ -1199,7 +1205,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s pure ok where newSub = do - writeTQueue ntfSubscribedQ (entId, clientId, True) + writeTQueue ntfSubscribedQ (entId, clientId) TM.insert entId () ntfSubscriptions acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg) @@ -1480,9 +1486,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case Right q -> do -- Possibly, the same should be done if the queue is suspended, but currently we do not use it - atomically $ writeTQueue subscribedQ (entId, clientId, False) + atomically $ writeTQueue deletedQ (entId, clientId) forM_ (notifierId <$> notifier q) $ \nId -> - atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False) + atomically $ writeTQueue ntfDeletedQ (nId, clientId) updateDeletedStats q pure ok Left e -> pure $ err e diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index dac00f228..8012f5154 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -136,12 +136,16 @@ data Env = Env type Subscribed = Bool data Server = Server - { subscribedQ :: TQueue (RecipientId, ClientId, Subscribed), + { subscribedQ :: TQueue (RecipientId, ClientId), + deletedQ :: TQueue (RecipientId, ClientId), subscribers :: TMap RecipientId (TVar Client), - ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed), + ntfSubscribedQ :: TQueue (NotifierId, ClientId), + ntfDeletedQ :: TQueue (NotifierId, ClientId), notifiers :: TMap NotifierId (TVar Client), pendingENDs :: TVar (IntMap (NonEmpty RecipientId)), + pendingDELDs :: TVar (IntMap (NonEmpty RecipientId)), pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)), + pendingNtfDELDs :: TVar (IntMap (NonEmpty NotifierId)), savingLock :: Lock } @@ -181,13 +185,17 @@ data Sub = Sub newServer :: IO Server newServer = do subscribedQ <- newTQueueIO + deletedQ <- newTQueueIO subscribers <- TM.emptyIO ntfSubscribedQ <- newTQueueIO + ntfDeletedQ <- newTQueueIO notifiers <- TM.emptyIO pendingENDs <- newTVarIO IM.empty + pendingDELDs <- newTVarIO IM.empty pendingNtfENDs <- newTVarIO IM.empty + pendingNtfDELDs <- newTVarIO IM.empty savingLock <- atomically createLock - return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock} + return Server {subscribedQ, deletedQ, subscribers, ntfSubscribedQ, ntfDeletedQ, notifiers, pendingENDs, pendingDELDs, pendingNtfENDs, pendingNtfDELDs, savingLock} newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client newClient clientId qSize thVersion sessionId createdAt = do diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index e06bdd3ee..8a1ea0a60 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -318,11 +318,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath = serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini, information = serverPublicInfo ini } - textToHostMode :: Text -> HostMode - textToHostMode = \case - "public" -> HMPublic - "onion" -> HMOnionViaSocks - s -> error . T.unpack $ "Invalid host_mode: " <> s textToOwnServers :: Text -> [ByteString] textToOwnServers = map encodeUtf8 . T.words @@ -346,6 +341,12 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath = where isOnion = \case THOnionHost _ -> True; _ -> False +textToHostMode :: Text -> HostMode +textToHostMode = \case + "public" -> HMPublic + "onion" -> HMOnionViaSocks + s -> error . T.unpack $ "Invalid host_mode: " <> s + data EmbeddedWebParams = EmbeddedWebParams { webStaticPath :: FilePath, webHttpPort :: Maybe Int, diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs index da9dc4bb3..5efff9cfd 100644 --- a/src/Simplex/Messaging/Server/QueueStore/STM.hs +++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs @@ -74,23 +74,26 @@ secureQueue QueueStore {queues} rId sKey = toResult <$> do let !q' = q {senderKey = Just sKey} in writeTVar qVar q' $> Just q' -addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec) +addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId)) addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do - ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $ - withQueue rId queues $ \qVar -> do + TM.lookupIO rId queues >>= \case + Just qVar -> atomically $ ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $ do q <- readTVar qVar - forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId + nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers $> notifierId let !q' = q {notifier = Just ntfCreds} writeTVar qVar q' TM.insert nId rId notifiers - pure q' + pure $ Right nId_ + Nothing -> pure $ Left AUTH -deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ()) +deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType (Maybe NotifierId)) deleteQueueNotifier QueueStore {queues, notifiers} rId = withQueue rId queues $ \qVar -> do q <- readTVar qVar - forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers - writeTVar qVar $! q {notifier = Nothing} + forM (notifier q) $ \NtfCreds {notifierId} -> do + TM.delete notifierId notifiers + writeTVar qVar $! q {notifier = Nothing} + pure notifierId suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ()) suspendQueue QueueStore {queues} rId = diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index 4b581bb6c..e681ec396 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -47,6 +47,7 @@ module Simplex.Messaging.Transport authCmdsSMPVersion, sendingProxySMPVersion, sndAuthKeySMPVersion, + deletedEventSMPVersion, simplexMQVersion, smpBlockSize, TransportConfig (..), @@ -130,6 +131,9 @@ smpBlockSize = 16384 -- 5 - basic auth for SMP servers (11/12/2022) -- 6 - allow creating queues without subscribing (9/10/2023) -- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024) +-- 8 - SMP proxy for sender commands +-- 9 - faster handshake: SKEY command for sender to secure queue +-- 10 - DELD event to subscriber when queue is deleted via another connnection data SMPVersion @@ -160,14 +164,17 @@ sendingProxySMPVersion = VersionSMP 8 sndAuthKeySMPVersion :: VersionSMP sndAuthKeySMPVersion = VersionSMP 9 +deletedEventSMPVersion :: VersionSMP +deletedEventSMPVersion = VersionSMP 10 + currentClientSMPRelayVersion :: VersionSMP -currentClientSMPRelayVersion = VersionSMP 9 +currentClientSMPRelayVersion = VersionSMP 10 legacyServerSMPRelayVersion :: VersionSMP legacyServerSMPRelayVersion = VersionSMP 6 currentServerSMPRelayVersion :: VersionSMP -currentServerSMPRelayVersion = VersionSMP 9 +currentServerSMPRelayVersion = VersionSMP 10 -- Max SMP protocol version to be used in e2e encrypted -- connection between client and server, as defined by SMP proxy. diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 62429a456..a25564a0b 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -166,7 +166,7 @@ testNtfMatrix t runTest = do it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest - it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest + it "prev servers; curr clients" $ runNtfTestCfg t 1 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest -- servers can be upgraded in any order it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 63508a033..0a1729ab8 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -385,6 +385,10 @@ testSwitchSub (ATransport t) = Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, ACK mId3) (ok3, OK) #== "accepts ACK from the 2nd TCP connection" + Resp "cdab" _ OK <- signSendRecv rh1 rKey ("cdab", rId, DEL) + Resp "" rId' DELD <- tGet1 rh2 + (rId', rId) #== "connection deleted event delivered to subscribed client" + 1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case Nothing -> return () Just _ -> error "nothing else is delivered to the 1st TCP connection" @@ -839,7 +843,8 @@ testMessageNotifications (ATransport t) = Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, ACK mId1) Resp "" _ (NMSG _ _) <- tGet1 nh1 Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, NSUB) - Resp "" _ END <- tGet1 nh1 + Resp "" nId2 END <- tGet1 nh1 + nId2 `shouldBe` nId Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello again") Resp "" _ (Msg mId2 msg2) <- tGet1 rh Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2) @@ -849,6 +854,8 @@ testMessageNotifications (ATransport t) = Nothing -> pure () Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection" Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, NDEL) + Resp "" nId3 DELD <- tGet1 nh2 + nId3 `shouldBe` nId Resp "7" _ OK <- signSendRecv sh sKey ("7", sId, _SEND' "hello there") Resp "" _ (Msg mId3 msg3) <- tGet1 rh (dec mId3 msg3, Right "hello there") #== "delivered from queue again" diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs index 8de86eff1..9803cb8b9 100644 --- a/tests/XFTPAgent.hs +++ b/tests/XFTPAgent.hs @@ -429,7 +429,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do ("", sfId', SFPROG _ _) <- sfGet sndr' liftIO $ sfId' `shouldBe` sfId - threadDelay 100000 + threadDelay 200000 withXFTPServerStoreLogOn $ \_ -> do -- send file - should continue uploading with server up @@ -443,7 +443,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do pure rfd1 -- prefix path should be removed after sending file - threadDelay 100000 + threadDelay 200000 doesDirectoryExist prefixPath `shouldReturn` False doesFileExist encPath `shouldReturn` False