ChatroomState(..),

ChatroomStateData(..),

createChatroom,

updateChatroomByStateData,

listChatrooms,

findChatroomByRoomData,

else []

mdata <- mstore =<< sign secret =<< mstore ChatMessageData {..}

{ rsdPrev = roomStateData cstate

, rsdSubscribe = Just (not mdLeave)

, rsdIdentity = mbIdentity

, rsdMessages = [ mdata ]

data ChatroomStateData = ChatroomStateData

{ rsdPrev :: [Stored ChatroomStateData]

, rsdRoom :: [Stored (Signed ChatroomData)]

, rsdSubscribe :: Maybe Bool

, rsdIdentity :: Maybe UnifiedIdentity

, rsdMessages :: [Stored (Signed ChatMessageData)]

}

data ChatroomState = ChatroomState

{ roomStateData :: [Stored ChatroomStateData]

, roomStateRoom :: Maybe Chatroom

, roomStateMessageData :: [Stored (Signed ChatMessageData)]

, roomStateSubscribe :: Bool

, roomStateIdentity :: Maybe UnifiedIdentity

, roomStateMessages :: [ChatMessage]

store' ChatroomStateData {..} = storeRec $ do

forM_ rsdPrev $ storeRef "PREV"

forM_ rsdRoom $ storeRef "room"

forM_ rsdSubscribe $ storeInt "subscribe" . bool @Int 0 1

forM_ rsdIdentity $ storeRef "id" . idExtData

forM_ rsdMessages $ storeRef "msg"

load' = loadRec $ do

rsdPrev <- loadRefs "PREV"

rsdRoom <- loadRefs "room"

rsdSubscribe <- fmap ((/=) @Int 0) <$> loadMbInt "subscribe"

rsdIdentity <- loadMbUnifiedIdentity "id"

rsdMessages <- loadRefs "msg"

roomStateMessageData = filterAncestors $ concat $ flip findProperty roomStateData $ \case

ChatroomStateData {..} | null rsdMessages -> Nothing

| otherwise -> Just rsdMessages

roomStateIdentity = findPropertyFirst rsdIdentity roomStateData

roomStateMessages = threadToListSince [] $ concatMap (rsdMessages . fromStored) roomStateData

in ChatroomState {..}

(secret, rdKey) <- liftIO . generateKeys =<< getStorage

let rdPrev = []

rdata <- mstore =<< sign secret =<< mstore ChatroomData {..}

, rsdSubscribe = Just True

}

updateLocalHead $ updateSharedState $ \rooms -> do

return (roomSet, Just upd)

[] -> return (roomSet, Nothing)

updateChatroomByStateData

:: (MonadStorage m, MonadHead LocalState m, MonadError String m)

=> Stored ChatroomStateData

, rdDescription = newDesc

, rdKey = roomKey room

}

{ rsdPrev = roomStateData cstate

, rsdRoom = [ rdata ]

, rsdSubscribe = Just True

}

listChatrooms :: MonadHead LocalState m => m [ChatroomState]

lookupSharedValue . lsShared . fromStored <$> getLocalHead

findChatroom :: MonadHead LocalState m => (ChatroomState -> Bool) -> m (Maybe ChatroomState)

chatroomSetSubscribe lookupData subscribe = void $ findAndUpdateChatroomState $ \cstate -> do

guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate

Just $ do

{ rsdPrev = roomStateData cstate

, rsdSubscribe = Just subscribe

}

chatroomMembers :: ChatroomState -> [ ComposedIdentity ]

return $ makeChatroomDiff lastList curList

chatroomSetToList :: Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]

where

cmp :: ChatroomState -> Stored ChatroomStateData

cmp = head . filterAncestors . concatMap storedRoots . toComponents

-- update local state only if we got roomInfo not present there

if roomInfo `notElem` prevRoom && roomInfo `elem` room

then do

{ rsdPrev = prev

, rsdRoom = room

}

storeSetAddComponent sdata set

else return set

-- update local state only if subscribed and we got some new messages

if roomStateSubscribe prev && messages /= prevMessages

then do

{ rsdPrev = prevData

, rsdMessages = messages

}

storeSetAddComponent sdata set

conversationHistory,

sendMessage,

) where

import Control.Monad.Except

sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m (Maybe Message)

sendMessage (DirectMessageConversation thread) text = fmap Just $ DirectMessageMessage <$> (fromStored <$> sendDirectMessage (msgPeer thread) text) <*> pure False

sendMessage (ChatroomConversation rstate) text = sendChatroomMessage rstate text >> return Nothing

module Erebos.Discovery (

DiscoveryService(..),

DiscoveryConnection(..)

) where

import Data.Maybe

import Data.Text (Text)

import Data.Text qualified as T

import Network.Socket

import Erebos.Storable

data DiscoveryConnection = DiscoveryConnection

{ dconnSource :: Ref

, dconnTarget :: Ref

, dconnAddress :: Maybe Text

#ifdef ENABLE_ICE_SUPPORT

#endif

}

where

dconnAddress = Nothing

#ifdef ENABLE_ICE_SUPPORT

#endif

instance Storable DiscoveryService where

DiscoverySelf addrs priority -> do

mapM_ (storeText "self") addrs

mapM_ (storeInt "priority") priority

DiscoverySearch ref -> storeRawRef "search" ref

DiscoveryResult ref addr -> do

storeRawRef "result" ref

storeRawRef "target" $ dconnTarget conn

storeMbText "address" $ dconnAddress conn

#ifdef ENABLE_ICE_SUPPORT

#endif

load' = loadRec $ msum

guard (not $ null addrs)

DiscoverySelf addrs

<$> loadMbInt "priority"

, DiscoverySearch <$> loadRawRef "search"

, DiscoveryResult

<$> loadRawRef "result"

<*> loadRawRef "target"

<*> loadMbText "address"

#ifdef ENABLE_ICE_SUPPORT

#endif

data DiscoveryPeer = DiscoveryPeer

instance Service DiscoveryService where

serviceID _ = mkServiceID "dd59c89c-69cc-4703-b75b-4ddcd4b3c23c"

type ServiceGlobalState DiscoveryService = Map RefDigest DiscoveryPeer

emptyServiceGlobalState _ = M.empty

peer <- asks svcPeer

let insertHelper new old | dpPriority new > dpPriority old = new

| otherwise = old

[ipaddr, port] | DatagramAddress paddr <- peerAddress peer -> do

saddr <- liftIO $ head <$> getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)

return $ if paddr == addrAddress saddr

, dpIceSession = Nothing

#endif

}

return ()

DiscoverySearch ref -> do

-- TODO: check if we really requested that

server <- asks svcServer

self <- svcSelf

discoveryPeer <- asks svcPeer

let runAsService = runPeerService @DiscoveryService discoveryPeer

liftIO $ void $ forkIO $ forM_ addrs $ \addr -> if

#ifdef ENABLE_ICE_SUPPORT

rinfo <- iceRemoteInfo ice

res <- runExceptT $ sendToPeer discoveryPeer $

case res of

Right _ -> return ()

Left err -> putStrLn $ "Discovery: failed to send connection request: " ++ err

, dpIceSession = Just ice

}

#else

return ()

#endif

-- request for us, create ICE sesssion

server <- asks svcServer

peer <- asks svcPeer

else do

-- request to some of our peers, relay

| Just dp <- M.lookup (refDigest $ dconnTarget conn) dpeers

, Just ice <- dpIceSession dp

liftIO $ iceConnect ice rinfo $ void $ serverPeerIce server ice

| otherwise -> svcPrint $ "Discovery: connection request failed"

let addrToText saddr = do

( addr, port ) <- IP.fromSockAddr saddr

Just $ T.pack $ show addr <> " " <> show port

sendToPeer peer $ DiscoverySelf addrs Nothing

module Erebos.ICE (

IceSession,

IceSessionRole(..),

IceRemoteInfo,

iceDestroy,

iceRemoteInfo,

iceShow,

import Control.Monad.Identity

import Data.ByteString (ByteString, packCStringLen, useAsCString)

import Data.ByteString.Unsafe

import Data.Function

import Data.Text (Text)

import Data.Void

import Foreign.C.String

import Foreign.C.Types

import Foreign.Marshal.Alloc

import Foreign.Marshal.Array

import Foreign.Ptr

data IceSession = IceSession

{ isStrans :: PjIceStrans

, isChan :: MVar (Either [ByteString] (Flow Void ByteString))

}

{#enum pj_ice_sess_role as IceSessionRole {underscoreToCase} deriving (Show, Eq) #}

{#pointer *pj_ice_strans as ^ #}

rec sptr <- newStablePtr sess

cbptr <- newStablePtr $ cb sess

sess <- IceSession

<*> (newMVar $ Left [])

return $ sess

{

pj_caching_pool cp;

pj_pool_t * pool;

pj_sockaddr def_addr;

} ice;

fprintf(stderr, "ICE: %s: %s\n", msg, err);

}

{

while (true) {

pj_time_val max_timeout = { 0, 0 };

max_timeout.msec = 500;

pj_assert(timeout.sec >= 0 && timeout.msec >= 0);

if (timeout.msec >= 1000)

if (PJ_TIME_VAL_GT(timeout, max_timeout))

timeout = max_timeout;

if (c < 0)

pj_thread_sleep(PJ_TIME_VAL_MSEC(timeout));

}

if (done) {

pthread_mutex_unlock(&mutex);

}

pj_log_set_level(1);

pj_caching_pool_init(&ice.cp, NULL, 0);

ice.pool = pj_pool_create(&ice.cp.factory, "ice", 512, 512, NULL);

}

}

pj_thread_t * thread;

}

}

{

ice_init();

.on_ice_complete = cb_on_ice_complete,

};

if (status != PJ_SUCCESS)

ice_perror("error creating ice", status);

#include <pjnath.h>

#include <HsFFI.h>

void ice_destroy(pj_ice_strans * strans);

ssize_t ice_encode_session(pj_ice_strans *, char * ufrag, char * pass,

import Erebos.Storable

import Erebos.Storage.Head

serviceID :: proxy s -> ServiceID

serviceHandler :: Stored s -> ServiceHandler s ()