summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGELOG.md8
-rw-r--r--README.md11
-rw-r--r--erebos.cabal11
-rw-r--r--main/Main.hs113
-rw-r--r--main/Test.hs30
-rw-r--r--src/Erebos/Chatroom.hs65
-rw-r--r--src/Erebos/Identity.hs33
-rw-r--r--src/Erebos/Network.hs59
-rw-r--r--src/Erebos/Network/Protocol.hs100
-rw-r--r--src/Erebos/Network/ifaddrs.c84
-rw-r--r--src/Erebos/Network/ifaddrs.h2
-rw-r--r--src/Erebos/Storage/Internal.hs6
-rw-r--r--src/Erebos/Storage/Key.hs7
-rw-r--r--src/Erebos/Storage/Merge.hs7
-rw-r--r--test/chatroom.test82
15 files changed, 500 insertions, 118 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 3d26fab..de69a6e 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,13 @@
# Revision history for erebos
+## 0.1.6 -- 2024-08-12
+
+* Chatroom members list and join/leave commands
+* Fix sending multiple data responses in a stream
+* Added `--storage`/`--memory-storage` command-line options
+* Compatibility with GHC up to 9.10
+* Local discovery with IPv6
+
## 0.1.5 -- 2024-07-16
* Public chatrooms for multiple participants
diff --git a/README.md b/README.md
index ac262d9..9535aab 100644
--- a/README.md
+++ b/README.md
@@ -121,6 +121,17 @@ are signed, so message author can not be forged.
: Create public unmoderated chatroom. Room name can be passed as command
argument or entered interactively.
+`/members`
+: List members of the chatroom – usesers who sent any message or joined via the
+`join` command.
+
+`/join`
+: Join chatroom without sending text message.
+
+`/leave`
+: Leave the chatroom. User will no longer be listed as a member and erebos tool
+ will no longer collect message of this chatroom.
+
### Add contacts
To ensure the identity of the contact and prevent man-in-the-middle attack,
diff --git a/erebos.cabal b/erebos.cabal
index 3061da8..2629048 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -1,7 +1,7 @@
Cabal-Version: 3.0
Name: erebos
-Version: 0.1.5
+Version: 0.1.6
Synopsis: Decentralized messaging and synchronization
Description:
Library and simple CLI interface implementing the Erebos identity
@@ -54,7 +54,7 @@ common common
-Wno-error=unused-imports
build-depends:
- base >=4.13 && <4.20,
+ base ^>= { 4.15, 4.16, 4.17, 4.18, 4.19, 4.20 },
default-extensions:
DefaultSignatures
@@ -116,7 +116,6 @@ library
Erebos.Storage.Internal
other-modules:
Erebos.Flow
- Erebos.Storage.List
Erebos.Storage.Platform
Erebos.Util
@@ -144,7 +143,7 @@ library
bytestring >=0.10 && <0.13,
clock >=0.8 && < 0.9,
containers >= 0.6 && <0.8,
- cryptonite >=0.25 && <0.31,
+ crypton ^>= { 1.0 },
deepseq >= 1.4 && <1.6,
directory >= 1.3 && <1.4,
filepath >=1.4 && <1.6,
@@ -188,14 +187,14 @@ executable erebos
build-depends:
bytestring,
- cryptonite,
+ crypton,
directory,
erebos,
haskeline >=0.7 && <0.9,
mtl,
network,
process >=1.6 && <1.7,
- template-haskell >=2.17 && <2.22,
+ template-haskell ^>= { 2.17, 2.18, 2.19, 2.20, 2.21, 2.22 },
text,
time,
transformers >= 0.5 && <0.7,
diff --git a/main/Main.hs b/main/Main.hs
index d5b06ea..94c0418 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -61,12 +61,17 @@ import Version
data Options = Options
{ optServer :: ServerOptions
, optServices :: [ServiceOption]
+ , optStorage :: StorageOption
, optChatroomAutoSubscribe :: Maybe Int
, optDmBotEcho :: Maybe Text
, optShowHelp :: Bool
, optShowVersion :: Bool
}
+data StorageOption = DefaultStorage
+ | FilesystemStorage FilePath
+ | MemoryStorage
+
data ServiceOption = ServiceOption
{ soptName :: String
, soptService :: SomeService
@@ -78,6 +83,7 @@ defaultOptions :: Options
defaultOptions = Options
{ optServer = defaultServerOptions
, optServices = availableServices
+ , optStorage = DefaultStorage
, optChatroomAutoSubscribe = Nothing
, optDmBotEcho = Nothing
, optShowHelp = False
@@ -110,6 +116,12 @@ options =
, Option ['s'] ["silent"]
(NoArg (so $ \opts -> opts { serverLocalDiscovery = False }))
"do not send announce packets for local discovery"
+ , Option [] [ "storage" ]
+ (ReqArg (\path -> \opts -> opts { optStorage = FilesystemStorage path }) "<path>")
+ "use storage in <path>"
+ , Option [] [ "memory-storage" ]
+ (NoArg (\opts -> opts { optStorage = MemoryStorage }))
+ "use memory storage"
, Option [] ["chatroom-auto-subscribe"]
(ReqArg (\count -> \opts -> opts { optChatroomAutoSubscribe = Just (read count) }) "<count>")
"automatically subscribe for up to <count> chatrooms"
@@ -142,8 +154,20 @@ servicesOptions = concatMap helper $ "all" : map soptName availableServices
main :: IO ()
main = do
- st <- liftIO $ openStorage . fromMaybe "./.erebos" =<< lookupEnv "EREBOS_DIR"
- getArgs >>= \case
+ (opts, args) <- (getOpt RequireOrder (options ++ servicesOptions) <$> getArgs) >>= \case
+ (o, args, []) -> do
+ return (foldl (flip id) defaultOptions o, args)
+ (_, _, errs) -> do
+ progName <- getProgName
+ hPutStrLn stderr $ concat errs <> "Try `" <> progName <> " --help' for more information."
+ exitFailure
+
+ st <- liftIO $ case optStorage opts of
+ DefaultStorage -> openStorage . fromMaybe "./.erebos" =<< lookupEnv "EREBOS_DIR"
+ FilesystemStorage path -> openStorage path
+ MemoryStorage -> memoryStorage
+
+ case args of
["cat-file", sref] -> do
readRef st (BC.pack sref) >>= \case
Nothing -> error "ref does not exist"
@@ -159,7 +183,7 @@ main = do
forM_ (signedSignature signed) $ \sig -> do
putStr $ "SIG "
BC.putStrLn $ showRef $ storedRef $ sigKey $ fromStored sig
- "identity" -> case validateIdentityF (wrappedLoad <$> refs) of
+ "identity" -> case validateExtendedIdentityF (wrappedLoad <$> refs) of
Just identity -> do
let disp :: Identity m -> IO ()
disp idt = do
@@ -169,7 +193,7 @@ main = do
case idOwner idt of
Nothing -> return ()
Just owner -> do
- mapM_ (putStrLn . ("OWNER " ++) . BC.unpack . showRefDigest . refDigest . storedRef) $ idDataF owner
+ mapM_ (putStrLn . ("OWNER " ++) . BC.unpack . showRefDigest . refDigest . storedRef) $ idExtDataF owner
disp owner
disp identity
Nothing -> putStrLn $ "Identity verification failed"
@@ -193,32 +217,30 @@ main = do
["test"] -> runTestTool st
- args -> case getOpt Permute (options ++ servicesOptions) args of
- (o, [], []) -> do
- let opts = foldl (flip id) defaultOptions o
- header = "Usage: erebos [OPTION...]"
- serviceDesc ServiceOption {..} = padService (" " <> soptName) <> soptDescription
-
- padTo n str = str <> replicate (n - length str) ' '
- padOpt = padTo 37
- padService = padTo 16
-
- if | optShowHelp opts -> putStr $ usageInfo header options <> unlines
- (
- [ padOpt " --enable-<service>" <> "enable network service <service>"
- , padOpt " --disable-<service>" <> "disable network service <service>"
- , padOpt " --enable-all" <> "enable all network services"
- , padOpt " --disable-all" <> "disable all network services"
- , ""
- , "Available network services:"
- ] ++ map serviceDesc availableServices
- )
- | optShowVersion opts -> putStrLn versionLine
- | otherwise -> interactiveLoop st opts
- (_, _, errs) -> do
- progName <- getProgName
- hPutStrLn stderr $ concat errs <> "Try `" <> progName <> " --help' for more information."
- exitFailure
+ [] -> do
+ let header = "Usage: erebos [OPTION...]"
+ serviceDesc ServiceOption {..} = padService (" " <> soptName) <> soptDescription
+
+ padTo n str = str <> replicate (n - length str) ' '
+ padOpt = padTo 37
+ padService = padTo 16
+
+ if | optShowHelp opts -> putStr $ usageInfo header options <> unlines
+ (
+ [ padOpt " --enable-<service>" <> "enable network service <service>"
+ , padOpt " --disable-<service>" <> "disable network service <service>"
+ , padOpt " --enable-all" <> "enable all network services"
+ , padOpt " --disable-all" <> "disable all network services"
+ , ""
+ , "Available network services:"
+ ] ++ map serviceDesc availableServices
+ )
+ | optShowVersion opts -> putStrLn versionLine
+ | otherwise -> interactiveLoop st opts
+
+ (cmdname : _) -> do
+ hPutStrLn stderr $ "Unknown command `" <> cmdname <> "'"
+ exitFailure
inputSettings :: Settings IO
@@ -231,8 +253,10 @@ interactiveLoop st opts = runInputT inputSettings $ do
tui <- haveTerminalUI
extPrint <- getExternalPrint
- let extPrintLn str = extPrint $ case reverse str of ('\n':_) -> str
- _ -> str ++ "\n";
+ let extPrintLn str = do
+ let str' = case reverse str of ('\n':_) -> str
+ _ -> str ++ "\n";
+ extPrint $! str' -- evaluate str before calling extPrint to avoid blinking
let getInputLinesTui eprompt = do
prompt <- case eprompt of
@@ -428,6 +452,11 @@ getSelectedPeer = gets csContext >>= \case
SelectedPeer peer -> return peer
_ -> throwError "no peer selected"
+getSelectedChatroom :: CommandM ChatroomState
+getSelectedChatroom = gets csContext >>= \case
+ SelectedChatroom rstate -> return rstate
+ _ -> throwError "no chatroom selected"
+
getSelectedConversation :: CommandM Conversation
getSelectedConversation = gets csContext >>= \case
SelectedPeer peer -> peerIdentity peer >>= \case
@@ -472,6 +501,9 @@ commands =
, ("ice-connect", cmdIceConnect)
, ("ice-send", cmdIceSend)
#endif
+ , ("join", cmdJoin)
+ , ("leave", cmdLeave)
+ , ("members", cmdMembers)
, ("select", cmdSelectContext)
, ("quit", cmdQuit)
]
@@ -524,6 +556,19 @@ showPeer pidentity paddr =
PeerIdentityFull pid -> T.unpack $ displayIdentity pid
in name ++ " [" ++ show paddr ++ "]"
+cmdJoin :: Command
+cmdJoin = joinChatroom =<< getSelectedChatroom
+
+cmdLeave :: Command
+cmdLeave = leaveChatroom =<< getSelectedChatroom
+
+cmdMembers :: Command
+cmdMembers = do
+ Just room <- findChatroomByStateData . head . roomStateData =<< getSelectedChatroom
+ forM_ (chatroomMembers room) $ \x -> do
+ liftIO $ putStrLn $ maybe "<unnamed>" T.unpack $ idName x
+
+
cmdSelectContext :: Command
cmdSelectContext = do
n <- read <$> asks ciLine
@@ -629,8 +674,8 @@ watchChatroomsForCli eprint h chatroomSetVar contextVar autoSubscribe = do
[ maybe "<unnamed>" T.unpack $ roomName =<< cmsgRoom msg
, formatTime defaultTimeLocale " [%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ cmsgTime msg
, maybe "<unnamed>" T.unpack $ idName $ cmsgFrom msg
- , ": "
- , maybe "<no message>" T.unpack $ cmsgText msg
+ , if cmsgLeave msg then " left" else ""
+ , maybe (if cmsgLeave msg then "" else " joined") ((": " ++) . T.unpack) $ cmsgText msg
]
modifyMVar_ subscribedNumVar $ return
. (if roomStateSubscribe rstate then (+ 1) else id)
diff --git a/main/Test.hs b/main/Test.hs
index 97eaee7..c6448b8 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -97,7 +97,7 @@ runTestTool st = do
Nothing -> return ()
runExceptT (evalStateT testLoop initTestState) >>= \case
- Left x -> hPutStrLn stderr x
+ Left x -> B.hPutStr stderr $ (`BC.snoc` '\n') $ BC.pack x
Right () -> return ()
getLineMb :: MonadIO m => m (Maybe Text)
@@ -121,7 +121,7 @@ outLine :: Output -> String -> IO ()
outLine mvar line = do
evaluate $ foldl' (flip seq) () line
withMVar mvar $ \() -> do
- putStrLn line
+ B.putStr $ (`BC.snoc` '\n') $ BC.pack line
hFlush stdout
cmdOut :: String -> Command
@@ -283,6 +283,9 @@ commands = map (T.pack *** id)
, ("chatroom-set-name", cmdChatroomSetName)
, ("chatroom-subscribe", cmdChatroomSubscribe)
, ("chatroom-unsubscribe", cmdChatroomUnsubscribe)
+ , ("chatroom-members", cmdChatroomMembers)
+ , ("chatroom-join", cmdChatroomJoin)
+ , ("chatroom-leave", cmdChatroomLeave)
, ("chatroom-message-send", cmdChatroomMessageSend)
]
@@ -428,7 +431,7 @@ cmdStartServer = do
h <- getOrLoadHead
rsPeers <- liftIO $ newMVar (1, [])
- rsServer <- liftIO $ startServer defaultServerOptions h (hPutStrLn stderr)
+ rsServer <- liftIO $ startServer defaultServerOptions h (B.hPutStr stderr . (`BC.snoc` '\n') . BC.pack)
[ someServiceAttr $ pairingAttributes (Proxy @AttachService) out rsPeers "attach"
, someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
, someServiceAttr $ directMessageAttributes out
@@ -732,6 +735,7 @@ cmdChatroomWatchLocal = do
, [ show . refDigest . storedRef . head . filterAncestors . concatMap storedRoots . toComponents $ room ]
, [ "room", maybe "<unnamed>" T.unpack $ roomName =<< cmsgRoom msg ]
, [ "from", maybe "<unnamed>" T.unpack $ idName $ cmsgFrom msg ]
+ , if cmsgLeave msg then [ "leave" ] else []
, maybe [] (("text":) . (:[]) . T.unpack) $ cmsgText msg
]
@@ -754,6 +758,26 @@ cmdChatroomUnsubscribe = do
to <- getChatroomStateData cid
void $ chatroomSetSubscribe to False
+cmdChatroomMembers :: Command
+cmdChatroomMembers = do
+ [ cid ] <- asks tiParams
+ Just chatroom <- findChatroomByStateData =<< getChatroomStateData cid
+ forM_ (chatroomMembers chatroom) $ \user -> do
+ cmdOut $ unwords [ "chatroom-members-item", maybe "<unnamed>" T.unpack $ idName user ]
+ cmdOut "chatroom-members-done"
+
+cmdChatroomJoin :: Command
+cmdChatroomJoin = do
+ [ cid ] <- asks tiParams
+ joinChatroomByStateData =<< getChatroomStateData cid
+ cmdOut "chatroom-join-done"
+
+cmdChatroomLeave :: Command
+cmdChatroomLeave = do
+ [ cid ] <- asks tiParams
+ leaveChatroomByStateData =<< getChatroomStateData cid
+ cmdOut "chatroom-leave-done"
+
cmdChatroomMessageSend :: Command
cmdChatroomMessageSend = do
[cid, msg] <- asks tiParams
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs
index ae373b6..c8b5805 100644
--- a/src/Erebos/Chatroom.hs
+++ b/src/Erebos/Chatroom.hs
@@ -11,6 +11,9 @@ module Erebos.Chatroom (
findChatroomByRoomData,
findChatroomByStateData,
chatroomSetSubscribe,
+ chatroomMembers,
+ joinChatroom, joinChatroomByStateData,
+ leaveChatroom, leaveChatroomByStateData,
getMessagesSinceState,
ChatroomSetChange(..),
@@ -33,6 +36,8 @@ import Control.Monad.IO.Class
import Data.Bool
import Data.Either
+import Data.Foldable
+import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
@@ -180,23 +185,23 @@ sendChatroomMessage rstate msg = sendChatroomMessageByStateData (head $ roomStat
sendChatroomMessageByStateData
:: (MonadStorage m, MonadHead LocalState m, MonadError String m)
=> Stored ChatroomStateData -> Text -> m ()
-sendChatroomMessageByStateData lookupData msg = void $ findAndUpdateChatroomState $ \cstate -> do
+sendChatroomMessageByStateData lookupData msg = sendRawChatroomMessageByStateData lookupData Nothing (Just msg) False
+
+sendRawChatroomMessageByStateData
+ :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+ => Stored ChatroomStateData -> Maybe (Stored (Signed ChatMessageData)) -> Maybe Text -> Bool -> m ()
+sendRawChatroomMessageByStateData lookupData mdReplyTo mdText mdLeave = void $ findAndUpdateChatroomState $ \cstate -> do
guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate
Just $ do
- self <- finalOwner . localIdentity . fromStored <$> getLocalHead
- secret <- loadKey $ idKeyMessage self
- time <- liftIO getZonedTime
- mdata <- mstore =<< sign secret =<< mstore ChatMessageData
- { mdPrev = roomStateMessageData cstate
- , mdRoom = if null (roomStateMessageData cstate)
- then maybe [] roomData (roomStateRoom cstate)
- else []
- , mdFrom = self
- , mdReplyTo = Nothing
- , mdTime = time
- , mdText = Just msg
- , mdLeave = False
- }
+ mdFrom <- finalOwner . localIdentity . fromStored <$> getLocalHead
+ secret <- loadKey $ idKeyMessage mdFrom
+ mdTime <- liftIO getZonedTime
+ let mdPrev = roomStateMessageData cstate
+ mdRoom = if null (roomStateMessageData cstate)
+ then maybe [] roomData (roomStateRoom cstate)
+ else []
+
+ mdata <- mstore =<< sign secret =<< mstore ChatMessageData {..}
mergeSorted . (:[]) <$> mstore ChatroomStateData
{ rsdPrev = roomStateData cstate
, rsdRoom = []
@@ -341,6 +346,36 @@ chatroomSetSubscribe lookupData subscribe = void $ findAndUpdateChatroomState $
, rsdMessages = []
}
+chatroomMembers :: ChatroomState -> [ ComposedIdentity ]
+chatroomMembers ChatroomState {..} =
+ map (mdFrom . fromSigned . head) $
+ filter (any $ not . mdLeave . fromSigned) $ -- keep only users that hasn't left
+ map (filterAncestors . map snd) $ -- gather message data per each identity and filter ancestors
+ groupBy ((==) `on` fst) $ -- group on identity root
+ sortBy (comparing fst) $ -- sort by first root of identity data
+ map (\x -> ( head . filterAncestors . concatMap storedRoots . idDataF . mdFrom . fromSigned $ x, x )) $
+ toList $ ancestors $ roomStateMessageData
+
+joinChatroom
+ :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+ => ChatroomState -> m ()
+joinChatroom rstate = joinChatroomByStateData (head $ roomStateData rstate)
+
+joinChatroomByStateData
+ :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+ => Stored ChatroomStateData -> m ()
+joinChatroomByStateData lookupData = sendRawChatroomMessageByStateData lookupData Nothing Nothing False
+
+leaveChatroom
+ :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+ => ChatroomState -> m ()
+leaveChatroom rstate = leaveChatroomByStateData (head $ roomStateData rstate)
+
+leaveChatroomByStateData
+ :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+ => Stored ChatroomStateData -> m ()
+leaveChatroomByStateData lookupData = sendRawChatroomMessageByStateData lookupData Nothing Nothing True
+
getMessagesSinceState :: ChatroomState -> ChatroomState -> [ChatMessage]
getMessagesSinceState cur old = threadToListSince (roomStateMessageData old) (roomStateMessageData cur)
diff --git a/src/Erebos/Identity.hs b/src/Erebos/Identity.hs
index 8761fde..f2094f6 100644
--- a/src/Erebos/Identity.hs
+++ b/src/Erebos/Identity.hs
@@ -35,7 +35,6 @@ import Data.Foldable
import Data.Function
import Data.List
import Data.Maybe
-import Data.Ord
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
@@ -304,25 +303,18 @@ verifySignatures sidd = do
throwError "signature verification failed"
lookupProperty :: forall a m. Foldable m => (ExtendedIdentityData -> Maybe a) -> m (Stored (Signed ExtendedIdentityData)) -> Maybe a
-lookupProperty sel topHeads = findResult filteredLayers
- where findPropHeads :: Stored (Signed ExtendedIdentityData) -> [(Stored (Signed ExtendedIdentityData), a)]
- findPropHeads sobj | Just x <- sel $ fromSigned sobj = [(sobj, x)]
- | otherwise = findPropHeads =<< (eiddPrev $ fromSigned sobj)
+lookupProperty sel topHeads = findResult propHeads
+ where
+ findPropHeads :: Stored (Signed ExtendedIdentityData) -> [ Stored (Signed ExtendedIdentityData) ]
+ findPropHeads sobj | Just _ <- sel $ fromSigned sobj = [ sobj ]
+ | otherwise = findPropHeads =<< (eiddPrev $ fromSigned sobj)
- propHeads :: [(Stored (Signed ExtendedIdentityData), a)]
- propHeads = findPropHeads =<< toList topHeads
+ propHeads :: [ Stored (Signed ExtendedIdentityData) ]
+ propHeads = filterAncestors $ findPropHeads =<< toList topHeads
- historyLayers :: [Set (Stored (Signed ExtendedIdentityData))]
- historyLayers = generations $ map fst propHeads
-
- filteredLayers :: [[(Stored (Signed ExtendedIdentityData), a)]]
- filteredLayers = scanl (\cur obsolete -> filter ((`S.notMember` obsolete) . fst) cur) propHeads historyLayers
-
- findResult ([(_, x)] : _) = Just x
- findResult ([] : _) = Nothing
- findResult [] = Nothing
- findResult [xs] = Just $ snd $ minimumBy (comparing fst) xs
- findResult (_:rest) = findResult rest
+ findResult :: [ Stored (Signed ExtendedIdentityData) ] -> Maybe a
+ findResult [] = Nothing
+ findResult xs = sel $ fromSigned $ minimum xs
mergeIdentity :: (MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity
mergeIdentity idt | Just idt' <- toUnifiedIdentity idt = return idt'
@@ -385,8 +377,9 @@ updateOwners updates orig@Identity { idOwner_ = Just owner, idUpdates_ = cupdate
updateOwners _ orig@Identity { idOwner_ = Nothing } = orig
sameIdentity :: (Foldable m, Foldable m') => Identity m -> Identity m' -> Bool
-sameIdentity x y = not $ S.null $ S.intersection (refset x) (refset y)
- where refset idt = foldr S.insert (ancestors $ toList $ idDataF idt) (idDataF idt)
+sameIdentity x y = intersectsSorted (roots x) (roots y)
+ where
+ roots idt = uniq $ sort $ concatMap storedRoots $ toList $ idDataF idt
unfoldOwners :: (Foldable m) => Identity m -> [ComposedIdentity]
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 402e163..2064d1c 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -54,6 +54,9 @@ import GHC.Conc.Sync (unsafeIOToSTM)
import Network.Socket hiding (ControlMessage)
import qualified Network.Socket.ByteString as S
+import Foreign.C.Types
+import Foreign.Marshal.Alloc
+
import Erebos.Channel
#ifdef ENABLE_ICE_SUPPORT
import Erebos.ICE
@@ -71,6 +74,9 @@ import Erebos.Storage.Merge
discoveryPort :: PortNumber
discoveryPort = 29665
+discoveryMulticastGroup :: HostAddress6
+discoveryMulticastGroup = tupleToHostAddress6 (0xff12, 0xb6a4, 0x6b1f, 0x0969, 0xcaee, 0xacc2, 0x5c93, 0x73e1) -- ff12:b6a4:6b1f:969:caee:acc2:5c93:73e1
+
announceIntervalSeconds :: Int
announceIntervalSeconds = 60
@@ -249,8 +255,6 @@ startServer opt serverOrigHead logd' serverServices = do
either (atomically . logd) return =<< runExceptT =<<
atomically (readTQueue serverIOActions)
- broadcastAddreses <- getBroadcastAddresses discoveryPort
-
let open addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
putMVar serverSocket sock
@@ -261,9 +265,14 @@ startServer opt serverOrigHead logd' serverServices = do
return sock
loop sock = do
- when (serverLocalDiscovery opt) $ forkServerThread server $ forever $ do
- atomically $ writeFlowBulk serverControlFlow $ map (SendAnnounce . DatagramAddress) broadcastAddreses
- threadDelay $ announceIntervalSeconds * 1000 * 1000
+ when (serverLocalDiscovery opt) $ forkServerThread server $ do
+ announceAddreses <- fmap concat $ sequence $
+ [ map (SockAddrInet6 discoveryPort 0 discoveryMulticastGroup) <$> joinMulticast sock
+ , getBroadcastAddresses discoveryPort
+ ]
+ forever $ do
+ atomically $ writeFlowBulk serverControlFlow $ map (SendAnnounce . DatagramAddress) announceAddreses
+ threadDelay $ announceIntervalSeconds * 1000 * 1000
let announceUpdate identity = do
st <- derivePartialStorage serverStorage
@@ -535,8 +544,12 @@ handlePacket identity secure peer chanSvc svcs (TransportHeader headers) prefs =
liftSTM $ finalizedChannel peer ch identity
_ -> return ()
- Rejected dgst -> do
- logd $ "rejected by peer: " ++ show dgst
+ Rejected dgst
+ | peerRequest : _ <- mapMaybe (\case TrChannelRequest d -> Just d; _ -> Nothing) headers
+ , peerRequest < dgst
+ -> return () -- Our request was rejected due to lower priority
+
+ | otherwise -> logd $ "rejected by peer: " ++ show dgst
DataRequest dgst
| secure || dgst `elem` plaintextRefs -> do
@@ -607,9 +620,15 @@ handlePacket identity secure peer chanSvc svcs (TransportHeader headers) prefs =
ChannelCookieWait {} -> return ()
ChannelCookieReceived {} -> process
ChannelCookieConfirmed {} -> process
- ChannelOurRequest our | dgst < refDigest (storedRef our) -> process
- | otherwise -> reject
- ChannelPeerRequest {} -> process
+ ChannelOurRequest our
+ | dgst < refDigest (storedRef our) -> process
+ | otherwise -> do
+ -- Reject peer channel request with lower priority
+ addHeader $ TrChannelRequest $ refDigest $ storedRef our
+ reject
+ ChannelPeerRequest prev
+ | dgst == wrDigest prev -> addHeader $ Acknowledged dgst
+ | otherwise -> process
ChannelOurAccept {} -> reject
ChannelEstablished {} -> process
ChannelClosed {} -> return ()
@@ -661,12 +680,14 @@ setupChannel identity peer upid = do
[ TrChannelRequest reqref
, AnnounceSelf $ refDigest $ storedRef $ idData identity
]
+ let sendChannelRequest = do
+ sendToPeerPlain peer [ Acknowledged reqref, Rejected reqref ] $
+ TransportPacket (TransportHeader hitems) [storedRef req]
+ setPeerChannel peer $ ChannelOurRequest req
liftIO $ atomically $ do
getPeerChannel peer >>= \case
- ChannelCookieConfirmed -> do
- sendToPeerPlain peer [ Acknowledged reqref, Rejected reqref ] $
- TransportPacket (TransportHeader hitems) [storedRef req]
- setPeerChannel peer $ ChannelOurRequest req
+ ChannelCookieReceived -> sendChannelRequest
+ ChannelCookieConfirmed -> sendChannelRequest
_ -> return ()
handleChannelRequest :: Peer -> UnifiedIdentity -> Ref -> WaitingRefCallback
@@ -932,9 +953,19 @@ runPeerServiceOn mbservice peer handler = liftIO $ do
logd $ "unhandled service '" ++ show (toUUID svc) ++ "'"
+foreign import ccall unsafe "Network/ifaddrs.h join_multicast" cJoinMulticast :: CInt -> Ptr CSize -> IO (Ptr Word32)
foreign import ccall unsafe "Network/ifaddrs.h broadcast_addresses" cBroadcastAddresses :: IO (Ptr Word32)
foreign import ccall unsafe "stdlib.h free" cFree :: Ptr Word32 -> IO ()
+joinMulticast :: Socket -> IO [ Word32 ]
+joinMulticast sock =
+ withFdSocket sock $ \fd ->
+ alloca $ \pcount -> do
+ ptr <- cJoinMulticast fd pcount
+ count <- fromIntegral <$> peek pcount
+ forM [ 0 .. count - 1 ] $ \i ->
+ peekElemOff ptr i
+
getBroadcastAddresses :: PortNumber -> IO [SockAddr]
getBroadcastAddresses port = do
ptr <- cBroadcastAddresses
diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs
index d759994..2955473 100644
--- a/src/Erebos/Network/Protocol.hs
+++ b/src/Erebos/Network/Protocol.hs
@@ -40,7 +40,17 @@ import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans
+import Crypto.Cipher.ChaChaPoly1305 qualified as C
+import Crypto.MAC.Poly1305 qualified as C (Auth(..), authTag)
+import Crypto.Error
+import Crypto.Random
+
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
import Data.Bits
+import Data.ByteArray (Bytes, ScrubbedBytes)
+import Data.ByteArray qualified as BA
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as BC
@@ -51,7 +61,6 @@ import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void
-import Data.Word
import System.Clock
@@ -96,14 +105,41 @@ data TransportHeaderItem
| StreamOpen Word8
deriving (Eq, Show)
-newtype Cookie = Cookie ByteString
- deriving (Eq, Show)
-
data SecurityRequirement = PlaintextOnly
| PlaintextAllowed
| EncryptedOnly
deriving (Eq, Ord)
+data Cookie = Cookie
+ { cookieNonce :: C.Nonce
+ , cookieValidity :: Word32
+ , cookieContent :: ByteString
+ , cookieMac :: C.Auth
+ }
+
+instance Eq Cookie where
+ (==) = (==) `on` (\c -> ( BA.convert (cookieNonce c) :: ByteString, cookieValidity c, cookieContent c, cookieMac c ))
+
+
+instance Show Cookie where
+ show Cookie {..} = show (nonce, cookieValidity, cookieContent, mac)
+ where C.Auth mac = cookieMac
+ nonce = BA.convert cookieNonce :: ByteString
+
+instance Binary Cookie where
+ put Cookie {..} = do
+ putByteString $ BA.convert cookieNonce
+ putWord32be cookieValidity
+ putByteString $ BA.convert cookieMac
+ putByteString cookieContent
+
+ get = do
+ Just cookieNonce <- maybeCryptoError . C.nonce12 <$> getByteString 12
+ cookieValidity <- getWord32be
+ Just cookieMac <- maybeCryptoError . C.authTag <$> getByteString 16
+ cookieContent <- BL.toStrict <$> getRemainingLazyByteString
+ return Cookie {..}
+
isHeaderItemAcknowledged :: TransportHeaderItem -> Bool
isHeaderItemAcknowledged = \case
Acknowledged {} -> False
@@ -123,8 +159,8 @@ transportToObject st (TransportHeader items) = Rec $ map single items
Rejected dgst -> (BC.pack "REJ", RecRef $ partialRefFromDigest st dgst)
ProtocolVersion ver -> (BC.pack "VER", RecText ver)
Initiation dgst -> (BC.pack "INI", RecRef $ partialRefFromDigest st dgst)
- CookieSet (Cookie bytes) -> (BC.pack "CKS", RecBinary bytes)
- CookieEcho (Cookie bytes) -> (BC.pack "CKE", RecBinary bytes)
+ CookieSet cookie -> (BC.pack "CKS", RecBinary $ BL.toStrict $ encode cookie)
+ CookieEcho cookie -> (BC.pack "CKE", RecBinary $ BL.toStrict $ encode cookie)
DataRequest dgst -> (BC.pack "REQ", RecRef $ partialRefFromDigest st dgst)
DataResponse dgst -> (BC.pack "RSP", RecRef $ partialRefFromDigest st dgst)
AnnounceSelf dgst -> (BC.pack "ANN", RecRef $ partialRefFromDigest st dgst)
@@ -145,8 +181,12 @@ transportFromObject (Rec items) = case catMaybes $ map single items of
| name == BC.pack "REJ", RecRef ref <- content -> Just $ Rejected $ refDigest ref
| name == BC.pack "VER", RecText ver <- content -> Just $ ProtocolVersion ver
| name == BC.pack "INI", RecRef ref <- content -> Just $ Initiation $ refDigest ref
- | name == BC.pack "CKS", RecBinary bytes <- content -> Just $ CookieSet (Cookie bytes)
- | name == BC.pack "CKE", RecBinary bytes <- content -> Just $ CookieEcho (Cookie bytes)
+ | name == BC.pack "CKS", RecBinary bytes <- content
+ , Right (_, _, cookie) <- decodeOrFail (BL.fromStrict bytes)
+ -> Just $ CookieSet cookie
+ | name == BC.pack "CKE", RecBinary bytes <- content
+ , Right (_, _, cookie) <- decodeOrFail (BL.fromStrict bytes)
+ -> Just $ CookieEcho cookie
| name == BC.pack "REQ", RecRef ref <- content -> Just $ DataRequest $ refDigest ref
| name == BC.pack "RSP", RecRef ref <- content -> Just $ DataResponse $ refDigest ref
| name == BC.pack "ANN", RecRef ref <- content -> Just $ AnnounceSelf $ refDigest ref
@@ -168,9 +208,12 @@ data GlobalState addr = (Eq addr, Show addr) => GlobalState
, gNextUp :: TMVar (Connection addr, (Bool, TransportPacket PartialObject))
, gLog :: String -> STM ()
, gStorage :: PartialStorage
+ , gStartTime :: TimeSpec
, gNowVar :: TVar TimeSpec
, gNextTimeout :: TVar TimeSpec
, gInitConfig :: Ref
+ , gCookieKey :: ScrubbedBytes
+ , gCookieStartTime :: Word32
}
data Connection addr = Connection
@@ -444,11 +487,14 @@ erebosNetworkProtocol initialIdentity gLog gDataFlow gControlFlow = do
mStorage <- memoryStorage
gStorage <- derivePartialStorage mStorage
- startTime <- getTime Monotonic
- gNowVar <- newTVarIO startTime
- gNextTimeout <- newTVarIO startTime
+ gStartTime <- getTime Monotonic
+ gNowVar <- newTVarIO gStartTime
+ gNextTimeout <- newTVarIO gStartTime
gInitConfig <- store mStorage $ (Rec [] :: Object)
+ gCookieKey <- getRandomBytes 32
+ gCookieStartTime <- runGet getWord32host . BL.pack . BA.unpack @ScrubbedBytes <$> getRandomBytes 4
+
let gs = GlobalState {..}
let signalTimeouts = forever $ do
@@ -702,11 +748,36 @@ generateCookieHeaders Connection {..} ch = catMaybes <$> sequence [ echoHeader,
_ -> return Nothing
createCookie :: GlobalState addr -> addr -> IO Cookie
-createCookie GlobalState {} addr = return (Cookie $ BC.pack $ show addr)
+createCookie GlobalState {..} addr = do
+ (nonceBytes :: Bytes) <- getRandomBytes 12
+ validUntil <- (fromNanoSecs (60 * 10^(9 :: Int)) +) <$> getTime Monotonic
+ let validSecondsFromStart = fromIntegral $ toNanoSecs (validUntil - gStartTime) `div` (10^(9 :: Int))
+ cookieValidity = validSecondsFromStart - gCookieStartTime
+ plainContent = BC.pack (show addr)
+ throwCryptoErrorIO $ do
+ cookieNonce <- C.nonce12 nonceBytes
+ st1 <- C.initialize gCookieKey cookieNonce
+ let st2 = C.finalizeAAD $ C.appendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1
+ (cookieContent, st3) = C.encrypt plainContent st2
+ cookieMac = C.finalize st3
+ return $ Cookie {..}
verifyCookie :: GlobalState addr -> addr -> Cookie -> IO Bool
-verifyCookie GlobalState {} addr (Cookie cookie) = return $ show addr == BC.unpack cookie
-
+verifyCookie GlobalState {..} addr Cookie {..} = do
+ ctime <- getTime Monotonic
+ return $ fromMaybe False $ maybeCryptoError $ do
+ st1 <- C.initialize gCookieKey cookieNonce
+ let st2 = C.finalizeAAD $ C.appendAAD (BL.toStrict $ runPut $ putWord32be cookieValidity) st1
+ (plainContent, st3) = C.decrypt cookieContent st2
+ mac = C.finalize st3
+
+ validSecondsFromStart = fromIntegral $ cookieValidity + gCookieStartTime
+ validUntil = gStartTime + fromNanoSecs (validSecondsFromStart * (10^(9 :: Int)))
+ return $ and
+ [ mac == cookieMac
+ , ctime <= validUntil
+ , show addr == BC.unpack plainContent
+ ]
reservePacket :: Connection addr -> STM ReservedToSend
reservePacket conn@Connection {..} = do
@@ -891,6 +962,7 @@ processOutgoing gs@GlobalState {..} = do
now <- readTVar gNowVar
if next <= now
then do
+ writeTVar cNextKeepAlive Nothing
identity <- fst <$> readTVar gIdentity
let header = TransportHeader [ AnnounceSelf $ refDigest $ storedRef $ idData identity ]
writeTQueue cSecureOutQueue (EncryptedOnly, TransportPacket header [], [])
diff --git a/src/Erebos/Network/ifaddrs.c b/src/Erebos/Network/ifaddrs.c
index efeca18..70685bc 100644
--- a/src/Erebos/Network/ifaddrs.c
+++ b/src/Erebos/Network/ifaddrs.c
@@ -1,13 +1,89 @@
#include "ifaddrs.h"
-#ifndef _WIN32
+#include <errno.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#ifndef _WIN32
#include <arpa/inet.h>
-#include <ifaddrs.h>
#include <net/if.h>
-#include <stdlib.h>
-#include <sys/types.h>
+#include <ifaddrs.h>
#include <endian.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#else
+#include <winsock2.h>
+#include <ws2ipdef.h>
+#include <ws2tcpip.h>
+#endif
+
+#define DISCOVERY_MULTICAST_GROUP "ff12:b6a4:6b1f:969:caee:acc2:5c93:73e1"
+
+uint32_t * join_multicast(int fd, size_t * count)
+{
+ size_t capacity = 16;
+ *count = 0;
+ uint32_t * interfaces = malloc(sizeof(uint32_t) * capacity);
+
+#ifdef _WIN32
+ interfaces[0] = 0;
+ *count = 1;
+#else
+ struct ifaddrs * addrs;
+ if (getifaddrs(&addrs) < 0)
+ return 0;
+
+ for (struct ifaddrs * ifa = addrs; ifa; ifa = ifa->ifa_next) {
+ if (ifa->ifa_addr && ifa->ifa_addr->sa_family == AF_INET6 &&
+ !(ifa->ifa_flags & IFF_LOOPBACK)) {
+ int idx = if_nametoindex(ifa->ifa_name);
+
+ bool seen = false;
+ for (size_t i = 0; i < *count; i++) {
+ if (interfaces[i] == idx) {
+ seen = true;
+ break;
+ }
+ }
+ if (seen)
+ continue;
+
+ if (*count + 1 >= capacity) {
+ capacity *= 2;
+ uint32_t * nret = realloc(interfaces, sizeof(uint32_t) * capacity);
+ if (nret) {
+ interfaces = nret;
+ } else {
+ free(interfaces);
+ *count = 0;
+ return NULL;
+ }
+ }
+
+ interfaces[*count] = idx;
+ (*count)++;
+ }
+ }
+
+ freeifaddrs(addrs);
+#endif
+
+ for (size_t i = 0; i < *count; i++) {
+ struct ipv6_mreq group;
+ group.ipv6mr_interface = interfaces[i];
+ inet_pton(AF_INET6, DISCOVERY_MULTICAST_GROUP, &group.ipv6mr_multiaddr);
+ int ret = setsockopt(fd, IPPROTO_IPV6, IPV6_ADD_MEMBERSHIP,
+ (const void *) &group, sizeof(group));
+ if (ret < 0)
+ fprintf(stderr, "IPV6_ADD_MEMBERSHIP failed: %s\n", strerror(errno));
+ }
+
+ return interfaces;
+}
+
+#ifndef _WIN32
uint32_t * broadcast_addresses(void)
{
diff --git a/src/Erebos/Network/ifaddrs.h b/src/Erebos/Network/ifaddrs.h
index 06d26ec..8852ec6 100644
--- a/src/Erebos/Network/ifaddrs.h
+++ b/src/Erebos/Network/ifaddrs.h
@@ -1,3 +1,5 @@
+#include <stddef.h>
#include <stdint.h>
+uint32_t * join_multicast(int fd, size_t * count);
uint32_t * broadcast_addresses(void);
diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs
index d419a5e..8b794d8 100644
--- a/src/Erebos/Storage/Internal.hs
+++ b/src/Erebos/Storage/Internal.hs
@@ -241,7 +241,7 @@ writeFileOnce file content = bracket (openLockFile locked)
doesFileExist file >>= \case
True -> removeFile locked
False -> do BL.hPut h content
- hFlush h
+ hClose h
renameFile locked file
where locked = file ++ ".lock"
@@ -254,13 +254,13 @@ writeFileChecked file prev content = bracket (openLockFile locked)
removeFile locked
return $ Left $ Just current
(Nothing, False) -> do B.hPut h content
- hFlush h
+ hClose h
renameFile locked file
return $ Right ()
(Just expected, True) -> do
current <- B.readFile file
if current == expected then do B.hPut h content
- hFlush h
+ hClose h
renameFile locked file
return $ return ()
else do removeFile locked
diff --git a/src/Erebos/Storage/Key.hs b/src/Erebos/Storage/Key.hs
index b6afc20..5da79e3 100644
--- a/src/Erebos/Storage/Key.hs
+++ b/src/Erebos/Storage/Key.hs
@@ -80,6 +80,7 @@ moveKeys from to = liftIO $ do
return M.empty
(StorageMemory { memKeys = fromKeys }, StorageMemory { memKeys = toKeys }) -> do
- modifyMVar_ fromKeys $ \fkeys -> do
- modifyMVar_ toKeys $ return . M.union fkeys
- return M.empty
+ when (fromKeys /= toKeys) $ do
+ modifyMVar_ fromKeys $ \fkeys -> do
+ modifyMVar_ toKeys $ return . M.union fkeys
+ return M.empty
diff --git a/src/Erebos/Storage/Merge.hs b/src/Erebos/Storage/Merge.hs
index 9d9db13..a3b0fd7 100644
--- a/src/Erebos/Storage/Merge.hs
+++ b/src/Erebos/Storage/Merge.hs
@@ -97,13 +97,16 @@ storedGeneration x =
doLookup x
+-- |Returns list of sets starting with the set of given objects and
+-- intcrementally adding parents.
generations :: Storable a => [Stored a] -> [Set (Stored a)]
generations = unfoldr gen . (,S.empty)
- where gen (hs, cur) = case filter (`S.notMember` cur) $ previous =<< hs of
+ where gen (hs, cur) = case filter (`S.notMember` cur) hs of
[] -> Nothing
added -> let next = foldr S.insert cur added
- in Just (next, (added, next))
+ in Just (next, (previous =<< added, next))
+-- |Returns set containing all given objects and their ancestors
ancestors :: Storable a => [Stored a] -> Set (Stored a)
ancestors = last . (S.empty:) . generations
diff --git a/test/chatroom.test b/test/chatroom.test
index 1998290..93de1ff 100644
--- a/test/chatroom.test
+++ b/test/chatroom.test
@@ -344,3 +344,85 @@ test ParallelThreads:
with p2:
expect /chatroom-message-new $room1_p2 room first_room from Owner. text message(..)/ capture msg
guard (msg == "1B")
+
+
+test ChatroomMembers:
+ spawn as p1
+ spawn as p2
+ spawn as p3
+
+ send "create-identity Device1 Owner1" to p1
+ send "create-identity Device2 Owner2" to p2
+ send "create-identity Device3 Owner3" to p3
+
+ for p in [ p1, p2, p3 ]:
+ with p:
+ send "chatroom-watch-local"
+ send "start-server"
+
+ send "chatroom-create first_room" to p1
+ expect /chatroom-create-done ([a-z0-9#]+) first_room.*/ from p1 capture room1_p1
+
+ expect /chatroom-watched-added $room1_p1 first_room sub true/ from p1
+ expect /chatroom-watched-added ([a-z0-9#]+) first_room sub false/ from p2 capture room1_p2
+ expect /chatroom-watched-added ([a-z0-9#]+) first_room sub false/ from p3 capture room1_p3
+
+ local:
+ send "chatroom-members $room1_p1" to p1
+ expect /chatroom-members-([a-z]+)/ from p1 capture done
+ guard (done == "done")
+ local:
+ send "chatroom-members $room1_p2" to p2
+ expect /chatroom-members-([a-z]+)/ from p2 capture done
+ guard (done == "done")
+
+ send "chatroom-message-send $room1_p1 message1" to p1
+ send "chatroom-message-send $room1_p1 message2" to p1
+ send "chatroom-join $room1_p2" to p2
+ send "chatroom-message-send $room1_p2 message3" to p2
+ send "chatroom-join $room1_p3" to p3
+
+ with p1:
+ expect /chatroom-message-new $room1_p1 room first_room from Owner1 text message2/
+ expect /chatroom-message-new $room1_p1 room first_room from Owner2 text message3/
+ expect /chatroom-message-new $room1_p1 room first_room from Owner3/
+ with p2:
+ expect /chatroom-message-new $room1_p2 room first_room from Owner1 text message2/
+ expect /chatroom-message-new $room1_p2 room first_room from Owner2 text message3/
+ expect /chatroom-message-new $room1_p2 room first_room from Owner3/
+ with p3:
+ expect /chatroom-message-new $room1_p3 room first_room from Owner1 text message2/
+ expect /chatroom-message-new $room1_p3 room first_room from Owner2 text message3/
+ expect /chatroom-message-new $room1_p3 room first_room from Owner3/
+
+ local:
+ send "chatroom-members $room1_p1" to p1
+ expect /chatroom-members-item Owner1/ from p1
+ expect /chatroom-members-item Owner2/ from p1
+ expect /chatroom-members-item Owner3/ from p1
+ expect /chatroom-members-([a-z]+)/ from p1 capture done
+ guard (done == "done")
+ local:
+ send "chatroom-members $room1_p2" to p2
+ expect /chatroom-members-item Owner1/ from p2
+ expect /chatroom-members-item Owner2/ from p2
+ expect /chatroom-members-item Owner3/ from p2
+ expect /chatroom-members-([a-z]+)/ from p2 capture done
+ guard (done == "done")
+
+ send "chatroom-leave $room1_p1" to p1
+ send "chatroom-leave $room1_p3" to p3
+
+ for p in [ p1, p2, p3 ]:
+ with p:
+ expect /chatroom-message-new [a-z0-9#]+ room first_room from Owner1 leave/
+ expect /chatroom-message-new [a-z0-9#]+ room first_room from Owner3 leave/
+
+ send "chatroom-members $room1_p1" to p1
+ send "chatroom-members $room1_p2" to p2
+ send "chatroom-members $room1_p3" to p3
+ for p in [ p1, p2, p3 ]:
+ with p:
+ expect /chatroom-members-item Owner2/
+ expect /chatroom-members-([a-z]+)/ capture done
+ guard (done == "done")
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-15 23:34:29 +0000