module Erebos.Chatroom (
    Chatroom(..),
    ChatroomData(..),
    validateChatroom,

    ChatroomState(..),
    ChatroomStateData(..),
    createChatroom,
    updateChatroomByStateData,
    listChatrooms,
    findChatroomByRoomData,
    findChatroomByStateData,

    ChatroomSetChange(..),
    watchChatrooms,

    ChatroomService(..),
) where

import Control.Arrow
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class

import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Text (Text)

import Erebos.PubKey
import Erebos.Service
import Erebos.Set
import Erebos.State
import Erebos.Storage
import Erebos.Storage.Merge
import Erebos.Util


data ChatroomData = ChatroomData
    { ChatroomData -> [Stored (Signed ChatroomData)]
rdPrev :: [Stored (Signed ChatroomData)]
    , ChatroomData -> Maybe Text
rdName :: Maybe Text
    , ChatroomData -> Maybe Text
rdDescription :: Maybe Text
    , ChatroomData -> Stored PublicKey
rdKey :: Stored PublicKey
    }

data Chatroom = Chatroom
    { Chatroom -> [Stored (Signed ChatroomData)]
roomData :: [Stored (Signed ChatroomData)]
    , Chatroom -> Maybe Text
roomName :: Maybe Text
    , Chatroom -> Maybe Text
roomDescription :: Maybe Text
    , Chatroom -> Stored PublicKey
roomKey :: Stored PublicKey
    }

instance Storable ChatroomData where
    store' :: ChatroomData -> Store
store' ChatroomData {[Stored (Signed ChatroomData)]
Maybe Text
Stored PublicKey
rdPrev :: ChatroomData -> [Stored (Signed ChatroomData)]
rdName :: ChatroomData -> Maybe Text
rdDescription :: ChatroomData -> Maybe Text
rdKey :: ChatroomData -> Stored PublicKey
rdPrev :: [Stored (Signed ChatroomData)]
rdName :: Maybe Text
rdDescription :: Maybe Text
rdKey :: Stored PublicKey
..} = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        (Stored (Signed ChatroomData) -> StoreRec c)
-> [Stored (Signed ChatroomData)] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Stored (Signed ChatroomData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"SPREV") [Stored (Signed ChatroomData)]
rdPrev
        String -> Maybe Text -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
String -> Maybe a -> StoreRec c
storeMbText String
"name" Maybe Text
rdName
        String -> Maybe Text -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
String -> Maybe a -> StoreRec c
storeMbText String
"description" Maybe Text
rdDescription
        String -> Stored PublicKey -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"key" Stored PublicKey
rdKey

    load' :: Load ChatroomData
load' = LoadRec ChatroomData -> Load ChatroomData
forall a. LoadRec a -> Load a
loadRec (LoadRec ChatroomData -> Load ChatroomData)
-> LoadRec ChatroomData -> Load ChatroomData
forall a b. (a -> b) -> a -> b
$ do
        [Stored (Signed ChatroomData)]
rdPrev <- String -> LoadRec [Stored (Signed ChatroomData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"SPREV"
        Maybe Text
rdName <- String -> LoadRec (Maybe Text)
forall a. StorableText a => String -> LoadRec (Maybe a)
loadMbText String
"name"
        Maybe Text
rdDescription <- String -> LoadRec (Maybe Text)
forall a. StorableText a => String -> LoadRec (Maybe a)
loadMbText String
"description"
        Stored PublicKey
rdKey <- String -> LoadRec (Stored PublicKey)
forall a. Storable a => String -> LoadRec a
loadRef String
"key"
        ChatroomData -> LoadRec ChatroomData
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatroomData {[Stored (Signed ChatroomData)]
Maybe Text
Stored PublicKey
rdPrev :: [Stored (Signed ChatroomData)]
rdName :: Maybe Text
rdDescription :: Maybe Text
rdKey :: Stored PublicKey
rdPrev :: [Stored (Signed ChatroomData)]
rdName :: Maybe Text
rdDescription :: Maybe Text
rdKey :: Stored PublicKey
..}

validateChatroom :: [Stored (Signed ChatroomData)] -> Except String Chatroom
validateChatroom :: [Stored (Signed ChatroomData)] -> Except String Chatroom
validateChatroom [Stored (Signed ChatroomData)]
roomData = do
    Bool -> ExceptT String Identity () -> ExceptT String Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Stored (Signed ChatroomData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stored (Signed ChatroomData)]
roomData) (ExceptT String Identity () -> ExceptT String Identity ())
-> ExceptT String Identity () -> ExceptT String Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String Identity ()
forall a. String -> ExceptT String Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"null data"
    Bool -> ExceptT String Identity () -> ExceptT String Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ (Stored (Signed ChatroomData) -> All)
-> [Stored (Signed ChatroomData)] -> All
forall a m.
(Storable a, Monoid m) =>
(Stored a -> m) -> [Stored a] -> m
walkAncestors Stored (Signed ChatroomData) -> All
verifySignatures [Stored (Signed ChatroomData)]
roomData) (ExceptT String Identity () -> ExceptT String Identity ())
-> ExceptT String Identity () -> ExceptT String Identity ()
forall a b. (a -> b) -> a -> b
$ do
        String -> ExceptT String Identity ()
forall a. String -> ExceptT String Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"signature verification failed"

    let roomName :: Maybe Text
roomName = (Signed ChatroomData -> Maybe Text)
-> [Stored (Signed ChatroomData)] -> Maybe Text
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b
findPropertyFirst (ChatroomData -> Maybe Text
rdName (ChatroomData -> Maybe Text)
-> (Signed ChatroomData -> ChatroomData)
-> Signed ChatroomData
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatroomData -> ChatroomData
forall a. Stored a -> a
fromStored (Stored ChatroomData -> ChatroomData)
-> (Signed ChatroomData -> Stored ChatroomData)
-> Signed ChatroomData
-> ChatroomData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed ChatroomData -> Stored ChatroomData
forall a. Signed a -> Stored a
signedData) [Stored (Signed ChatroomData)]
roomData
        roomDescription :: Maybe Text
roomDescription = (Signed ChatroomData -> Maybe Text)
-> [Stored (Signed ChatroomData)] -> Maybe Text
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b
findPropertyFirst (ChatroomData -> Maybe Text
rdDescription (ChatroomData -> Maybe Text)
-> (Signed ChatroomData -> ChatroomData)
-> Signed ChatroomData
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatroomData -> ChatroomData
forall a. Stored a -> a
fromStored (Stored ChatroomData -> ChatroomData)
-> (Signed ChatroomData -> Stored ChatroomData)
-> Signed ChatroomData
-> ChatroomData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed ChatroomData -> Stored ChatroomData
forall a. Signed a -> Stored a
signedData) [Stored (Signed ChatroomData)]
roomData
    Stored PublicKey
roomKey <- ExceptT String Identity (Stored PublicKey)
-> (Stored PublicKey -> ExceptT String Identity (Stored PublicKey))
-> Maybe (Stored PublicKey)
-> ExceptT String Identity (Stored PublicKey)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ExceptT String Identity (Stored PublicKey)
forall a. String -> ExceptT String Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"missing key") Stored PublicKey -> ExceptT String Identity (Stored PublicKey)
forall a. a -> ExceptT String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Stored PublicKey)
 -> ExceptT String Identity (Stored PublicKey))
-> Maybe (Stored PublicKey)
-> ExceptT String Identity (Stored PublicKey)
forall a b. (a -> b) -> a -> b
$
        (Signed ChatroomData -> Maybe (Stored PublicKey))
-> [Stored (Signed ChatroomData)] -> Maybe (Stored PublicKey)
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b
findPropertyFirst (Stored PublicKey -> Maybe (Stored PublicKey)
forall a. a -> Maybe a
Just (Stored PublicKey -> Maybe (Stored PublicKey))
-> (Signed ChatroomData -> Stored PublicKey)
-> Signed ChatroomData
-> Maybe (Stored PublicKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomData -> Stored PublicKey
rdKey (ChatroomData -> Stored PublicKey)
-> (Signed ChatroomData -> ChatroomData)
-> Signed ChatroomData
-> Stored PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatroomData -> ChatroomData
forall a. Stored a -> a
fromStored (Stored ChatroomData -> ChatroomData)
-> (Signed ChatroomData -> Stored ChatroomData)
-> Signed ChatroomData
-> ChatroomData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed ChatroomData -> Stored ChatroomData
forall a. Signed a -> Stored a
signedData) [Stored (Signed ChatroomData)]
roomData
    Chatroom -> Except String Chatroom
forall a. a -> ExceptT String Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Chatroom {[Stored (Signed ChatroomData)]
Maybe Text
Stored PublicKey
roomData :: [Stored (Signed ChatroomData)]
roomName :: Maybe Text
roomDescription :: Maybe Text
roomKey :: Stored PublicKey
roomData :: [Stored (Signed ChatroomData)]
roomName :: Maybe Text
roomDescription :: Maybe Text
roomKey :: Stored PublicKey
..}
  where
    verifySignatures :: Stored (Signed ChatroomData) -> All
verifySignatures Stored (Signed ChatroomData)
sdata =
        let rdata :: ChatroomData
rdata = Stored (Signed ChatroomData) -> ChatroomData
forall a. Stored (Signed a) -> a
fromSigned Stored (Signed ChatroomData)
sdata
            required :: [Stored PublicKey]
required = [[Stored PublicKey]] -> [Stored PublicKey]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [ ChatroomData -> Stored PublicKey
rdKey ChatroomData
rdata ]
                , (Stored (Signed ChatroomData) -> Stored PublicKey)
-> [Stored (Signed ChatroomData)] -> [Stored PublicKey]
forall a b. (a -> b) -> [a] -> [b]
map (ChatroomData -> Stored PublicKey
rdKey (ChatroomData -> Stored PublicKey)
-> (Stored (Signed ChatroomData) -> ChatroomData)
-> Stored (Signed ChatroomData)
-> Stored PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatroomData) -> ChatroomData
forall a. Stored (Signed a) -> a
fromSigned) ([Stored (Signed ChatroomData)] -> [Stored PublicKey])
-> [Stored (Signed ChatroomData)] -> [Stored PublicKey]
forall a b. (a -> b) -> a -> b
$ ChatroomData -> [Stored (Signed ChatroomData)]
rdPrev ChatroomData
rdata
                ]
         in Bool -> All
All (Bool -> All) -> Bool -> All
forall a b. (a -> b) -> a -> b
$ (Stored PublicKey -> Bool) -> [Stored PublicKey] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Stored (Signed ChatroomData) -> Signed ChatroomData
forall a. Stored a -> a
fromStored Stored (Signed ChatroomData)
sdata Signed ChatroomData -> Stored PublicKey -> Bool
forall a. Signed a -> Stored PublicKey -> Bool
`isSignedBy`) [Stored PublicKey]
required


data ChatroomStateData = ChatroomStateData
    { ChatroomStateData -> [Stored ChatroomStateData]
rsdPrev :: [Stored ChatroomStateData]
    , ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdRoom :: [Stored (Signed ChatroomData)]
    }

data ChatroomState = ChatroomState
    { ChatroomState -> [Stored ChatroomStateData]
roomStateData :: [Stored ChatroomStateData]
    , ChatroomState -> Maybe Chatroom
roomStateRoom :: Maybe Chatroom
    }

instance Storable ChatroomStateData where
    store' :: ChatroomStateData -> Store
store' ChatroomStateData {[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
rsdPrev :: ChatroomStateData -> [Stored ChatroomStateData]
rsdRoom :: ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
..} = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        [Stored ChatroomStateData]
-> (Stored ChatroomStateData -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored ChatroomStateData]
rsdPrev ((Stored ChatroomStateData -> StoreRec c) -> StoreRec c)
-> (Stored ChatroomStateData -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Stored ChatroomStateData -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"PREV"
        [Stored (Signed ChatroomData)]
-> (Stored (Signed ChatroomData) -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored (Signed ChatroomData)]
rsdRoom ((Stored (Signed ChatroomData) -> StoreRec c) -> StoreRec c)
-> (Stored (Signed ChatroomData) -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Stored (Signed ChatroomData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"room"

    load' :: Load ChatroomStateData
load' = LoadRec ChatroomStateData -> Load ChatroomStateData
forall a. LoadRec a -> Load a
loadRec (LoadRec ChatroomStateData -> Load ChatroomStateData)
-> LoadRec ChatroomStateData -> Load ChatroomStateData
forall a b. (a -> b) -> a -> b
$ do
        [Stored ChatroomStateData]
rsdPrev <- String -> LoadRec [Stored ChatroomStateData]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"PREV"
        [Stored (Signed ChatroomData)]
rsdRoom <- String -> LoadRec [Stored (Signed ChatroomData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"room"
        ChatroomStateData -> LoadRec ChatroomStateData
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatroomStateData {[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
..}

instance Mergeable ChatroomState where
    type Component ChatroomState = ChatroomStateData

    mergeSorted :: [Stored (Component ChatroomState)] -> ChatroomState
mergeSorted [Stored (Component ChatroomState)]
cdata = ChatroomState
        { roomStateData :: [Stored ChatroomStateData]
roomStateData = [Stored (Component ChatroomState)]
[Stored ChatroomStateData]
cdata
        , roomStateRoom :: Maybe Chatroom
roomStateRoom = (String -> Maybe Chatroom)
-> (Chatroom -> Maybe Chatroom)
-> Either String Chatroom
-> Maybe Chatroom
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Chatroom -> String -> Maybe Chatroom
forall a b. a -> b -> a
const Maybe Chatroom
forall a. Maybe a
Nothing) Chatroom -> Maybe Chatroom
forall a. a -> Maybe a
Just (Either String Chatroom -> Maybe Chatroom)
-> Either String Chatroom -> Maybe Chatroom
forall a b. (a -> b) -> a -> b
$ Except String Chatroom -> Either String Chatroom
forall e a. Except e a -> Either e a
runExcept (Except String Chatroom -> Either String Chatroom)
-> Except String Chatroom -> Either String Chatroom
forall a b. (a -> b) -> a -> b
$
            [Stored (Signed ChatroomData)] -> Except String Chatroom
validateChatroom ([Stored (Signed ChatroomData)] -> Except String Chatroom)
-> [Stored (Signed ChatroomData)] -> Except String Chatroom
forall a b. (a -> b) -> a -> b
$ [[Stored (Signed ChatroomData)]] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Stored (Signed ChatroomData)]]
 -> [Stored (Signed ChatroomData)])
-> [[Stored (Signed ChatroomData)]]
-> [Stored (Signed ChatroomData)]
forall a b. (a -> b) -> a -> b
$ (ChatroomStateData -> Maybe [Stored (Signed ChatroomData)])
-> [Stored ChatroomStateData] -> [[Stored (Signed ChatroomData)]]
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> [b]
findProperty ((\case [] -> Maybe [Stored (Signed ChatroomData)]
forall a. Maybe a
Nothing; [Stored (Signed ChatroomData)]
xs -> [Stored (Signed ChatroomData)]
-> Maybe [Stored (Signed ChatroomData)]
forall a. a -> Maybe a
Just [Stored (Signed ChatroomData)]
xs) ([Stored (Signed ChatroomData)]
 -> Maybe [Stored (Signed ChatroomData)])
-> (ChatroomStateData -> [Stored (Signed ChatroomData)])
-> ChatroomStateData
-> Maybe [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdRoom) [Stored (Component ChatroomState)]
[Stored ChatroomStateData]
cdata
        }

    toComponents :: ChatroomState -> [Stored (Component ChatroomState)]
toComponents = ChatroomState -> [Stored (Component ChatroomState)]
ChatroomState -> [Stored ChatroomStateData]
roomStateData

instance SharedType (Set ChatroomState) where
    sharedTypeID :: forall (proxy :: * -> *). proxy (Set ChatroomState) -> SharedTypeID
sharedTypeID proxy (Set ChatroomState)
_ = String -> SharedTypeID
mkSharedTypeID String
"7bc71cbf-bc43-42b1-b413-d3a2c9a2aae0"

createChatroom :: (MonadStorage m, MonadHead LocalState m, MonadIO m, MonadError String m) => Maybe Text -> Maybe Text -> m ChatroomState
createChatroom :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadIO m,
 MonadError String m) =>
Maybe Text -> Maybe Text -> m ChatroomState
createChatroom Maybe Text
rdName Maybe Text
rdDescription = do
    (SecretKey
secret, Stored PublicKey
rdKey) <- IO (SecretKey, Stored PublicKey) -> m (SecretKey, Stored PublicKey)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SecretKey, Stored PublicKey)
 -> m (SecretKey, Stored PublicKey))
-> (Storage -> IO (SecretKey, Stored PublicKey))
-> Storage
-> m (SecretKey, Stored PublicKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storage -> IO (SecretKey, Stored PublicKey)
forall sec pub. KeyPair sec pub => Storage -> IO (sec, Stored pub)
generateKeys (Storage -> m (SecretKey, Stored PublicKey))
-> m Storage -> m (SecretKey, Stored PublicKey)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage
    let rdPrev :: [a]
rdPrev = []
    Stored (Signed ChatroomData)
rdata <- Signed ChatroomData -> m (Stored (Signed ChatroomData))
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (Signed ChatroomData -> m (Stored (Signed ChatroomData)))
-> m (Signed ChatroomData) -> m (Stored (Signed ChatroomData))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SecretKey -> Stored ChatroomData -> m (Signed ChatroomData)
forall (m :: * -> *) a.
MonadStorage m =>
SecretKey -> Stored a -> m (Signed a)
sign SecretKey
secret (Stored ChatroomData -> m (Signed ChatroomData))
-> m (Stored ChatroomData) -> m (Signed ChatroomData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatroomData -> m (Stored ChatroomData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChatroomData {[Stored (Signed ChatroomData)]
Maybe Text
Stored PublicKey
forall a. [a]
rdPrev :: [Stored (Signed ChatroomData)]
rdName :: Maybe Text
rdDescription :: Maybe Text
rdKey :: Stored PublicKey
rdName :: Maybe Text
rdDescription :: Maybe Text
rdKey :: Stored PublicKey
rdPrev :: forall a. [a]
..}
    ChatroomState
cstate <- [Stored (Component ChatroomState)] -> ChatroomState
[Stored ChatroomStateData] -> ChatroomState
forall a. Mergeable a => [Stored (Component a)] -> a
mergeSorted ([Stored ChatroomStateData] -> ChatroomState)
-> (Stored ChatroomStateData -> [Stored ChatroomStateData])
-> Stored ChatroomStateData
-> ChatroomState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored ChatroomStateData
-> [Stored ChatroomStateData] -> [Stored ChatroomStateData]
forall a. a -> [a] -> [a]
:[]) (Stored ChatroomStateData -> ChatroomState)
-> m (Stored ChatroomStateData) -> m ChatroomState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomStateData -> m (Stored ChatroomStateData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChatroomStateData
        { rsdPrev :: [Stored ChatroomStateData]
rsdPrev = []
        , rsdRoom :: [Stored (Signed ChatroomData)]
rsdRoom = [ Stored (Signed ChatroomData)
rdata ]
        }

    (Stored LocalState -> m (Stored LocalState, ChatroomState))
-> m ChatroomState
forall b. (Stored LocalState -> m (Stored LocalState, b)) -> m b
forall a (m :: * -> *) b.
MonadHead a m =>
(Stored a -> m (Stored a, b)) -> m b
updateLocalHead ((Stored LocalState -> m (Stored LocalState, ChatroomState))
 -> m ChatroomState)
-> (Stored LocalState -> m (Stored LocalState, ChatroomState))
-> m ChatroomState
forall a b. (a -> b) -> a -> b
$ (Set ChatroomState -> m (Set ChatroomState, ChatroomState))
-> Stored LocalState -> m (Stored LocalState, ChatroomState)
forall a b (m :: * -> *).
(SharedType a, MonadHead LocalState m) =>
(a -> m (a, b)) -> Stored LocalState -> m (Stored LocalState, b)
updateSharedState ((Set ChatroomState -> m (Set ChatroomState, ChatroomState))
 -> Stored LocalState -> m (Stored LocalState, ChatroomState))
-> (Set ChatroomState -> m (Set ChatroomState, ChatroomState))
-> Stored LocalState
-> m (Stored LocalState, ChatroomState)
forall a b. (a -> b) -> a -> b
$ \Set ChatroomState
rooms -> do
        Storage
st <- m Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage
        (, ChatroomState
cstate) (Set ChatroomState -> (Set ChatroomState, ChatroomState))
-> m (Set ChatroomState) -> m (Set ChatroomState, ChatroomState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage
-> ChatroomState -> Set ChatroomState -> m (Set ChatroomState)
forall a (m :: * -> *).
(Mergeable a, MonadIO m) =>
Storage -> a -> Set a -> m (Set a)
storeSetAdd Storage
st ChatroomState
cstate Set ChatroomState
rooms

findAndUpdateChatroomState
    :: (MonadStorage m, MonadHead LocalState m)
    => (ChatroomState -> Maybe (m ChatroomState))
    -> m (Maybe ChatroomState)
findAndUpdateChatroomState :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m) =>
(ChatroomState -> Maybe (m ChatroomState))
-> m (Maybe ChatroomState)
findAndUpdateChatroomState ChatroomState -> Maybe (m ChatroomState)
f = do
    (Stored LocalState -> m (Stored LocalState, Maybe ChatroomState))
-> m (Maybe ChatroomState)
forall b. (Stored LocalState -> m (Stored LocalState, b)) -> m b
forall a (m :: * -> *) b.
MonadHead a m =>
(Stored a -> m (Stored a, b)) -> m b
updateLocalHead ((Stored LocalState -> m (Stored LocalState, Maybe ChatroomState))
 -> m (Maybe ChatroomState))
-> (Stored LocalState
    -> m (Stored LocalState, Maybe ChatroomState))
-> m (Maybe ChatroomState)
forall a b. (a -> b) -> a -> b
$ (Set ChatroomState -> m (Set ChatroomState, Maybe ChatroomState))
-> Stored LocalState -> m (Stored LocalState, Maybe ChatroomState)
forall a b (m :: * -> *).
(SharedType a, MonadHead LocalState m) =>
(a -> m (a, b)) -> Stored LocalState -> m (Stored LocalState, b)
updateSharedState ((Set ChatroomState -> m (Set ChatroomState, Maybe ChatroomState))
 -> Stored LocalState -> m (Stored LocalState, Maybe ChatroomState))
-> (Set ChatroomState
    -> m (Set ChatroomState, Maybe ChatroomState))
-> Stored LocalState
-> m (Stored LocalState, Maybe ChatroomState)
forall a b. (a -> b) -> a -> b
$ \Set ChatroomState
roomSet -> do
        let roomList :: [ChatroomState]
roomList = (ChatroomState -> ChatroomState -> Ordering)
-> Set ChatroomState -> [ChatroomState]
forall a. Mergeable a => (a -> a -> Ordering) -> Set a -> [a]
fromSetBy ((ChatroomState -> Maybe Text)
-> ChatroomState -> ChatroomState -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((ChatroomState -> Maybe Text)
 -> ChatroomState -> ChatroomState -> Ordering)
-> (ChatroomState -> Maybe Text)
-> ChatroomState
-> ChatroomState
-> Ordering
forall a b. (a -> b) -> a -> b
$ Chatroom -> Maybe Text
roomName (Chatroom -> Maybe Text)
-> (ChatroomState -> Maybe Chatroom) -> ChatroomState -> Maybe Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ChatroomState -> Maybe Chatroom
roomStateRoom) Set ChatroomState
roomSet
        case [Maybe (ChatroomState, m ChatroomState)]
-> [(ChatroomState, m ChatroomState)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (ChatroomState, m ChatroomState)]
 -> [(ChatroomState, m ChatroomState)])
-> [Maybe (ChatroomState, m ChatroomState)]
-> [(ChatroomState, m ChatroomState)]
forall a b. (a -> b) -> a -> b
$ (ChatroomState -> Maybe (ChatroomState, m ChatroomState))
-> [ChatroomState] -> [Maybe (ChatroomState, m ChatroomState)]
forall a b. (a -> b) -> [a] -> [b]
map (\ChatroomState
x -> (ChatroomState
x,) (m ChatroomState -> (ChatroomState, m ChatroomState))
-> Maybe (m ChatroomState)
-> Maybe (ChatroomState, m ChatroomState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> Maybe (m ChatroomState)
f ChatroomState
x) [ChatroomState]
roomList of
            ((ChatroomState
orig, m ChatroomState
act) : [(ChatroomState, m ChatroomState)]
_) -> do
                ChatroomState
upd <- m ChatroomState
act
                if ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
orig [Stored ChatroomStateData] -> [Stored ChatroomStateData] -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
upd
                  then do
                    Storage
st <- m Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage
                    Set ChatroomState
roomSet' <- Storage
-> ChatroomState -> Set ChatroomState -> m (Set ChatroomState)
forall a (m :: * -> *).
(Mergeable a, MonadIO m) =>
Storage -> a -> Set a -> m (Set a)
storeSetAdd Storage
st ChatroomState
upd Set ChatroomState
roomSet
                    (Set ChatroomState, Maybe ChatroomState)
-> m (Set ChatroomState, Maybe ChatroomState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ChatroomState
roomSet', ChatroomState -> Maybe ChatroomState
forall a. a -> Maybe a
Just ChatroomState
upd)
                  else do
                    (Set ChatroomState, Maybe ChatroomState)
-> m (Set ChatroomState, Maybe ChatroomState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ChatroomState
roomSet, ChatroomState -> Maybe ChatroomState
forall a. a -> Maybe a
Just ChatroomState
upd)
            [] -> (Set ChatroomState, Maybe ChatroomState)
-> m (Set ChatroomState, Maybe ChatroomState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ChatroomState
roomSet, Maybe ChatroomState
forall a. Maybe a
Nothing)

updateChatroomByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData
    -> Maybe Text
    -> Maybe Text
    -> m (Maybe ChatroomState)
updateChatroomByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData
-> Maybe Text -> Maybe Text -> m (Maybe ChatroomState)
updateChatroomByStateData Stored ChatroomStateData
lookupData Maybe Text
newName Maybe Text
newDesc = (ChatroomState -> Maybe (m ChatroomState))
-> m (Maybe ChatroomState)
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m) =>
(ChatroomState -> Maybe (m ChatroomState))
-> m (Maybe ChatroomState)
findAndUpdateChatroomState ((ChatroomState -> Maybe (m ChatroomState))
 -> m (Maybe ChatroomState))
-> (ChatroomState -> Maybe (m ChatroomState))
-> m (Maybe ChatroomState)
forall a b. (a -> b) -> a -> b
$ \ChatroomState
cstate -> do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Stored ChatroomStateData -> Bool)
-> [Stored ChatroomStateData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Stored ChatroomStateData
lookupData Stored ChatroomStateData -> Stored ChatroomStateData -> Bool
forall a. Storable a => Stored a -> Stored a -> Bool
`precedesOrEquals`) ([Stored ChatroomStateData] -> Bool)
-> [Stored ChatroomStateData] -> Bool
forall a b. (a -> b) -> a -> b
$ ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
cstate
    Chatroom
room <- ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
cstate
    m ChatroomState -> Maybe (m ChatroomState)
forall a. a -> Maybe a
Just (m ChatroomState -> Maybe (m ChatroomState))
-> m ChatroomState -> Maybe (m ChatroomState)
forall a b. (a -> b) -> a -> b
$ do
        SecretKey
secret <- Stored PublicKey -> m SecretKey
forall sec pub (m :: * -> *).
(KeyPair sec pub, MonadIO m, MonadError String m) =>
Stored pub -> m sec
loadKey (Stored PublicKey -> m SecretKey)
-> Stored PublicKey -> m SecretKey
forall a b. (a -> b) -> a -> b
$ Chatroom -> Stored PublicKey
roomKey Chatroom
room
        Stored (Signed ChatroomData)
rdata <- Signed ChatroomData -> m (Stored (Signed ChatroomData))
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (Signed ChatroomData -> m (Stored (Signed ChatroomData)))
-> m (Signed ChatroomData) -> m (Stored (Signed ChatroomData))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SecretKey -> Stored ChatroomData -> m (Signed ChatroomData)
forall (m :: * -> *) a.
MonadStorage m =>
SecretKey -> Stored a -> m (Signed a)
sign SecretKey
secret (Stored ChatroomData -> m (Signed ChatroomData))
-> m (Stored ChatroomData) -> m (Signed ChatroomData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatroomData -> m (Stored ChatroomData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChatroomData
            { rdPrev :: [Stored (Signed ChatroomData)]
rdPrev = Chatroom -> [Stored (Signed ChatroomData)]
roomData Chatroom
room
            , rdName :: Maybe Text
rdName = Maybe Text
newName
            , rdDescription :: Maybe Text
rdDescription = Maybe Text
newDesc
            , rdKey :: Stored PublicKey
rdKey = Chatroom -> Stored PublicKey
roomKey Chatroom
room
            }
        [Stored (Component ChatroomState)] -> ChatroomState
[Stored ChatroomStateData] -> ChatroomState
forall a. Mergeable a => [Stored (Component a)] -> a
mergeSorted ([Stored ChatroomStateData] -> ChatroomState)
-> (Stored ChatroomStateData -> [Stored ChatroomStateData])
-> Stored ChatroomStateData
-> ChatroomState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored ChatroomStateData
-> [Stored ChatroomStateData] -> [Stored ChatroomStateData]
forall a. a -> [a] -> [a]
:[]) (Stored ChatroomStateData -> ChatroomState)
-> m (Stored ChatroomStateData) -> m ChatroomState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomStateData -> m (Stored ChatroomStateData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChatroomStateData
            { rsdPrev :: [Stored ChatroomStateData]
rsdPrev = ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
cstate
            , rsdRoom :: [Stored (Signed ChatroomData)]
rsdRoom = [ Stored (Signed ChatroomData)
rdata ]
            }


listChatrooms :: MonadHead LocalState m => m [ChatroomState]
listChatrooms :: forall (m :: * -> *). MonadHead LocalState m => m [ChatroomState]
listChatrooms = (ChatroomState -> ChatroomState -> Ordering)
-> Set ChatroomState -> [ChatroomState]
forall a. Mergeable a => (a -> a -> Ordering) -> Set a -> [a]
fromSetBy ((ChatroomState -> Maybe Text)
-> ChatroomState -> ChatroomState -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((ChatroomState -> Maybe Text)
 -> ChatroomState -> ChatroomState -> Ordering)
-> (ChatroomState -> Maybe Text)
-> ChatroomState
-> ChatroomState
-> Ordering
forall a b. (a -> b) -> a -> b
$ Chatroom -> Maybe Text
roomName (Chatroom -> Maybe Text)
-> (ChatroomState -> Maybe Chatroom) -> ChatroomState -> Maybe Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ChatroomState -> Maybe Chatroom
roomStateRoom) (Set ChatroomState -> [ChatroomState])
-> (Stored LocalState -> Set ChatroomState)
-> Stored LocalState
-> [ChatroomState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [Stored SharedState] -> Set ChatroomState
forall a. SharedType a => [Stored SharedState] -> a
lookupSharedValue ([Stored SharedState] -> Set ChatroomState)
-> (Stored LocalState -> [Stored SharedState])
-> Stored LocalState
-> Set ChatroomState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> [ChatroomState])
-> m (Stored LocalState) -> m [ChatroomState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stored LocalState)
forall a (m :: * -> *). MonadHead a m => m (Stored a)
getLocalHead

findChatroom :: MonadHead LocalState m => (ChatroomState -> Bool) -> m (Maybe ChatroomState)
findChatroom :: forall (m :: * -> *).
MonadHead LocalState m =>
(ChatroomState -> Bool) -> m (Maybe ChatroomState)
findChatroom ChatroomState -> Bool
p = do
    [ChatroomState]
list <- ((Stored ChatroomStateData, ChatroomState) -> ChatroomState)
-> [(Stored ChatroomStateData, ChatroomState)] -> [ChatroomState]
forall a b. (a -> b) -> [a] -> [b]
map (Stored ChatroomStateData, ChatroomState) -> ChatroomState
forall a b. (a, b) -> b
snd ([(Stored ChatroomStateData, ChatroomState)] -> [ChatroomState])
-> (Stored LocalState
    -> [(Stored ChatroomStateData, ChatroomState)])
-> Stored LocalState
-> [ChatroomState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]
chatroomSetToList (Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)])
-> (Stored LocalState -> Set ChatroomState)
-> Stored LocalState
-> [(Stored ChatroomStateData, ChatroomState)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored SharedState] -> Set ChatroomState
forall a. SharedType a => [Stored SharedState] -> a
lookupSharedValue ([Stored SharedState] -> Set ChatroomState)
-> (Stored LocalState -> [Stored SharedState])
-> Stored LocalState
-> Set ChatroomState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> [ChatroomState])
-> m (Stored LocalState) -> m [ChatroomState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Stored LocalState)
forall a (m :: * -> *). MonadHead a m => m (Stored a)
getLocalHead
    Maybe ChatroomState -> m (Maybe ChatroomState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChatroomState -> m (Maybe ChatroomState))
-> Maybe ChatroomState -> m (Maybe ChatroomState)
forall a b. (a -> b) -> a -> b
$ (ChatroomState -> Bool) -> [ChatroomState] -> Maybe ChatroomState
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ChatroomState -> Bool
p [ChatroomState]
list

findChatroomByRoomData :: MonadHead LocalState m => Stored (Signed ChatroomData) -> m (Maybe ChatroomState)
findChatroomByRoomData :: forall (m :: * -> *).
MonadHead LocalState m =>
Stored (Signed ChatroomData) -> m (Maybe ChatroomState)
findChatroomByRoomData Stored (Signed ChatroomData)
cdata = (ChatroomState -> Bool) -> m (Maybe ChatroomState)
forall (m :: * -> *).
MonadHead LocalState m =>
(ChatroomState -> Bool) -> m (Maybe ChatroomState)
findChatroom ((ChatroomState -> Bool) -> m (Maybe ChatroomState))
-> (ChatroomState -> Bool) -> m (Maybe ChatroomState)
forall a b. (a -> b) -> a -> b
$
    Bool -> (Chatroom -> Bool) -> Maybe Chatroom -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Stored (Signed ChatroomData) -> Bool)
-> [Stored (Signed ChatroomData)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Stored (Signed ChatroomData)
cdata Stored (Signed ChatroomData)
-> Stored (Signed ChatroomData) -> Bool
forall a. Storable a => Stored a -> Stored a -> Bool
`precedesOrEquals`) ([Stored (Signed ChatroomData)] -> Bool)
-> (Chatroom -> [Stored (Signed ChatroomData)]) -> Chatroom -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData) (Maybe Chatroom -> Bool)
-> (ChatroomState -> Maybe Chatroom) -> ChatroomState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> Maybe Chatroom
roomStateRoom

findChatroomByStateData :: MonadHead LocalState m => Stored ChatroomStateData -> m (Maybe ChatroomState)
findChatroomByStateData :: forall (m :: * -> *).
MonadHead LocalState m =>
Stored ChatroomStateData -> m (Maybe ChatroomState)
findChatroomByStateData Stored ChatroomStateData
cdata = (ChatroomState -> Bool) -> m (Maybe ChatroomState)
forall (m :: * -> *).
MonadHead LocalState m =>
(ChatroomState -> Bool) -> m (Maybe ChatroomState)
findChatroom ((ChatroomState -> Bool) -> m (Maybe ChatroomState))
-> (ChatroomState -> Bool) -> m (Maybe ChatroomState)
forall a b. (a -> b) -> a -> b
$ (Stored ChatroomStateData -> Bool)
-> [Stored ChatroomStateData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Stored ChatroomStateData
cdata Stored ChatroomStateData -> Stored ChatroomStateData -> Bool
forall a. Storable a => Stored a -> Stored a -> Bool
`precedesOrEquals`) ([Stored ChatroomStateData] -> Bool)
-> (ChatroomState -> [Stored ChatroomStateData])
-> ChatroomState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> [Stored ChatroomStateData]
roomStateData


data ChatroomSetChange = AddedChatroom ChatroomState
                       | RemovedChatroom ChatroomState
                       | UpdatedChatroom ChatroomState ChatroomState

watchChatrooms :: MonadIO m => Head LocalState -> (Set ChatroomState -> Maybe [ChatroomSetChange] -> IO ()) -> m WatchedHead
watchChatrooms :: forall (m :: * -> *).
MonadIO m =>
Head LocalState
-> (Set ChatroomState -> Maybe [ChatroomSetChange] -> IO ())
-> m WatchedHead
watchChatrooms Head LocalState
h Set ChatroomState -> Maybe [ChatroomSetChange] -> IO ()
f = IO WatchedHead -> m WatchedHead
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WatchedHead -> m WatchedHead)
-> IO WatchedHead -> m WatchedHead
forall a b. (a -> b) -> a -> b
$ do
    IORef (Maybe [(Stored ChatroomStateData, ChatroomState)])
lastVar <- Maybe [(Stored ChatroomStateData, ChatroomState)]
-> IO (IORef (Maybe [(Stored ChatroomStateData, ChatroomState)]))
forall a. a -> IO (IORef a)
newIORef Maybe [(Stored ChatroomStateData, ChatroomState)]
forall a. Maybe a
Nothing
    Head LocalState
-> (Head LocalState -> Set ChatroomState)
-> (Set ChatroomState -> IO ())
-> IO WatchedHead
forall a b.
(HeadType a, Eq b) =>
Head a -> (Head a -> b) -> (b -> IO ()) -> IO WatchedHead
watchHeadWith Head LocalState
h ([Stored SharedState] -> Set ChatroomState
forall a. SharedType a => [Stored SharedState] -> a
lookupSharedValue ([Stored SharedState] -> Set ChatroomState)
-> (Head LocalState -> [Stored SharedState])
-> Head LocalState
-> Set ChatroomState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Head LocalState -> LocalState)
-> Head LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Head LocalState -> LocalState
forall a. Head a -> a
headObject) ((Set ChatroomState -> IO ()) -> IO WatchedHead)
-> (Set ChatroomState -> IO ()) -> IO WatchedHead
forall a b. (a -> b) -> a -> b
$ \Set ChatroomState
cur -> do
        let curList :: [(Stored ChatroomStateData, ChatroomState)]
curList = Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]
chatroomSetToList Set ChatroomState
cur
        Maybe [(Stored ChatroomStateData, ChatroomState)]
mbLast <- IORef (Maybe [(Stored ChatroomStateData, ChatroomState)])
-> IO (Maybe [(Stored ChatroomStateData, ChatroomState)])
forall a. IORef a -> IO a
readIORef IORef (Maybe [(Stored ChatroomStateData, ChatroomState)])
lastVar
        IORef (Maybe [(Stored ChatroomStateData, ChatroomState)])
-> Maybe [(Stored ChatroomStateData, ChatroomState)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe [(Stored ChatroomStateData, ChatroomState)])
lastVar (Maybe [(Stored ChatroomStateData, ChatroomState)] -> IO ())
-> Maybe [(Stored ChatroomStateData, ChatroomState)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Stored ChatroomStateData, ChatroomState)]
-> Maybe [(Stored ChatroomStateData, ChatroomState)]
forall a. a -> Maybe a
Just [(Stored ChatroomStateData, ChatroomState)]
curList
        Set ChatroomState -> Maybe [ChatroomSetChange] -> IO ()
f Set ChatroomState
cur (Maybe [ChatroomSetChange] -> IO ())
-> Maybe [ChatroomSetChange] -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            [(Stored ChatroomStateData, ChatroomState)]
lastList <- Maybe [(Stored ChatroomStateData, ChatroomState)]
mbLast
            [ChatroomSetChange] -> Maybe [ChatroomSetChange]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ChatroomSetChange] -> Maybe [ChatroomSetChange])
-> [ChatroomSetChange] -> Maybe [ChatroomSetChange]
forall a b. (a -> b) -> a -> b
$ [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
lastList [(Stored ChatroomStateData, ChatroomState)]
curList

chatroomSetToList :: Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]
chatroomSetToList :: Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]
chatroomSetToList = (ChatroomState -> (Stored ChatroomStateData, ChatroomState))
-> [ChatroomState] -> [(Stored ChatroomStateData, ChatroomState)]
forall a b. (a -> b) -> [a] -> [b]
map (ChatroomState -> Stored ChatroomStateData
cmp (ChatroomState -> Stored ChatroomStateData)
-> (ChatroomState -> ChatroomState)
-> ChatroomState
-> (Stored ChatroomStateData, ChatroomState)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ChatroomState -> ChatroomState
forall a. a -> a
id) ([ChatroomState] -> [(Stored ChatroomStateData, ChatroomState)])
-> (Set ChatroomState -> [ChatroomState])
-> Set ChatroomState
-> [(Stored ChatroomStateData, ChatroomState)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChatroomState -> ChatroomState -> Ordering)
-> Set ChatroomState -> [ChatroomState]
forall a. Mergeable a => (a -> a -> Ordering) -> Set a -> [a]
fromSetBy ((ChatroomState -> Stored ChatroomStateData)
-> ChatroomState -> ChatroomState -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ChatroomState -> Stored ChatroomStateData
cmp)
  where
    cmp :: ChatroomState -> Stored ChatroomStateData
    cmp :: ChatroomState -> Stored ChatroomStateData
cmp = [Stored ChatroomStateData] -> Stored ChatroomStateData
forall a. HasCallStack => [a] -> a
head ([Stored ChatroomStateData] -> Stored ChatroomStateData)
-> (ChatroomState -> [Stored ChatroomStateData])
-> ChatroomState
-> Stored ChatroomStateData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored ChatroomStateData] -> [Stored ChatroomStateData]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored ChatroomStateData] -> [Stored ChatroomStateData])
-> (ChatroomState -> [Stored ChatroomStateData])
-> ChatroomState
-> [Stored ChatroomStateData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored ChatroomStateData -> [Stored ChatroomStateData])
-> [Stored ChatroomStateData] -> [Stored ChatroomStateData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stored ChatroomStateData -> [Stored ChatroomStateData]
forall a. Storable a => Stored a -> [Stored a]
storedRoots ([Stored ChatroomStateData] -> [Stored ChatroomStateData])
-> (ChatroomState -> [Stored ChatroomStateData])
-> ChatroomState
-> [Stored ChatroomStateData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> [Stored (Component ChatroomState)]
ChatroomState -> [Stored ChatroomStateData]
forall a. Mergeable a => a -> [Stored (Component a)]
toComponents

makeChatroomDiff
    :: [(Stored ChatroomStateData, ChatroomState)]
    -> [(Stored ChatroomStateData, ChatroomState)]
    -> [ChatroomSetChange]
makeChatroomDiff :: [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff (x :: (Stored ChatroomStateData, ChatroomState)
x@(Stored ChatroomStateData
cx, ChatroomState
vx) : [(Stored ChatroomStateData, ChatroomState)]
xs) (y :: (Stored ChatroomStateData, ChatroomState)
y@(Stored ChatroomStateData
cy, ChatroomState
vy) : [(Stored ChatroomStateData, ChatroomState)]
ys)
    | Stored ChatroomStateData
cx Stored ChatroomStateData -> Stored ChatroomStateData -> Bool
forall a. Ord a => a -> a -> Bool
< Stored ChatroomStateData
cy = ChatroomState -> ChatroomSetChange
RemovedChatroom ChatroomState
vx ChatroomSetChange -> [ChatroomSetChange] -> [ChatroomSetChange]
forall a. a -> [a] -> [a]
: [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
xs ((Stored ChatroomStateData, ChatroomState)
y (Stored ChatroomStateData, ChatroomState)
-> [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
forall a. a -> [a] -> [a]
: [(Stored ChatroomStateData, ChatroomState)]
ys)
    | Stored ChatroomStateData
cx Stored ChatroomStateData -> Stored ChatroomStateData -> Bool
forall a. Ord a => a -> a -> Bool
> Stored ChatroomStateData
cy = ChatroomState -> ChatroomSetChange
AddedChatroom ChatroomState
vy ChatroomSetChange -> [ChatroomSetChange] -> [ChatroomSetChange]
forall a. a -> [a] -> [a]
: [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff ((Stored ChatroomStateData, ChatroomState)
x (Stored ChatroomStateData, ChatroomState)
-> [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
forall a. a -> [a] -> [a]
: [(Stored ChatroomStateData, ChatroomState)]
xs) [(Stored ChatroomStateData, ChatroomState)]
ys
    | ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
vx [Stored ChatroomStateData] -> [Stored ChatroomStateData] -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
vy = ChatroomState -> ChatroomState -> ChatroomSetChange
UpdatedChatroom ChatroomState
vx ChatroomState
vy ChatroomSetChange -> [ChatroomSetChange] -> [ChatroomSetChange]
forall a. a -> [a] -> [a]
: [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
xs [(Stored ChatroomStateData, ChatroomState)]
ys
    | Bool
otherwise = [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
xs [(Stored ChatroomStateData, ChatroomState)]
ys
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
xs [] = ((Stored ChatroomStateData, ChatroomState) -> ChatroomSetChange)
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
forall a b. (a -> b) -> [a] -> [b]
map (ChatroomState -> ChatroomSetChange
RemovedChatroom (ChatroomState -> ChatroomSetChange)
-> ((Stored ChatroomStateData, ChatroomState) -> ChatroomState)
-> (Stored ChatroomStateData, ChatroomState)
-> ChatroomSetChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored ChatroomStateData, ChatroomState) -> ChatroomState
forall a b. (a, b) -> b
snd) [(Stored ChatroomStateData, ChatroomState)]
xs
makeChatroomDiff [] [(Stored ChatroomStateData, ChatroomState)]
ys = ((Stored ChatroomStateData, ChatroomState) -> ChatroomSetChange)
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
forall a b. (a -> b) -> [a] -> [b]
map (ChatroomState -> ChatroomSetChange
AddedChatroom (ChatroomState -> ChatroomSetChange)
-> ((Stored ChatroomStateData, ChatroomState) -> ChatroomState)
-> (Stored ChatroomStateData, ChatroomState)
-> ChatroomSetChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored ChatroomStateData, ChatroomState) -> ChatroomState
forall a b. (a, b) -> b
snd) [(Stored ChatroomStateData, ChatroomState)]
ys


data ChatroomService = ChatroomService
    { ChatroomService -> Bool
chatRoomQuery :: Bool
    , ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomInfo :: [Stored (Signed ChatroomData)]
    }

emptyPacket :: ChatroomService
emptyPacket :: ChatroomService
emptyPacket = ChatroomService
    { chatRoomQuery :: Bool
chatRoomQuery = Bool
False
    , chatRoomInfo :: [Stored (Signed ChatroomData)]
chatRoomInfo = []
    }

instance Storable ChatroomService where
    store' :: ChatroomService -> Store
store' ChatroomService {Bool
[Stored (Signed ChatroomData)]
chatRoomQuery :: ChatroomService -> Bool
chatRoomInfo :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
..} = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        Bool -> StoreRec c -> StoreRec c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when  Bool
chatRoomQuery (StoreRec c -> StoreRec c) -> StoreRec c -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> StoreRec c
forall (c :: * -> *). String -> StoreRec c
storeEmpty String
"room-query"
        [Stored (Signed ChatroomData)]
-> (Stored (Signed ChatroomData) -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored (Signed ChatroomData)]
chatRoomInfo ((Stored (Signed ChatroomData) -> StoreRec c) -> StoreRec c)
-> (Stored (Signed ChatroomData) -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Stored (Signed ChatroomData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"room-info"

    load' :: Load ChatroomService
load' = LoadRec ChatroomService -> Load ChatroomService
forall a. LoadRec a -> Load a
loadRec (LoadRec ChatroomService -> Load ChatroomService)
-> LoadRec ChatroomService -> Load ChatroomService
forall a b. (a -> b) -> a -> b
$ do
        Bool
chatRoomQuery <- Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> LoadRec (Maybe ()) -> LoadRec Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec (Maybe ())
loadMbEmpty String
"room-query"
        [Stored (Signed ChatroomData)]
chatRoomInfo <- String -> LoadRec [Stored (Signed ChatroomData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"room-info"
        ChatroomService -> LoadRec ChatroomService
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatroomService {Bool
[Stored (Signed ChatroomData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
..}

data PeerState = PeerState
    { PeerState -> Bool
psSendRoomUpdates :: Bool
    , PeerState -> [(Stored ChatroomStateData, ChatroomState)]
psLastList :: [(Stored ChatroomStateData, ChatroomState)]
    }

instance Service ChatroomService where
    serviceID :: forall (proxy :: * -> *). proxy ChatroomService -> ServiceID
serviceID proxy ChatroomService
_ = String -> ServiceID
mkServiceID String
"627657ae-3e39-468a-8381-353395ef4386"

    type ServiceState ChatroomService = PeerState
    emptyServiceState :: forall (proxy :: * -> *).
proxy ChatroomService -> ServiceState ChatroomService
emptyServiceState proxy ChatroomService
_ = PeerState
        { psSendRoomUpdates :: Bool
psSendRoomUpdates = Bool
False
        , psLastList :: [(Stored ChatroomStateData, ChatroomState)]
psLastList = []
        }

    serviceHandler :: Stored ChatroomService -> ServiceHandler ChatroomService ()
serviceHandler Stored ChatroomService
spacket = do
        let ChatroomService {Bool
[Stored (Signed ChatroomData)]
chatRoomQuery :: ChatroomService -> Bool
chatRoomInfo :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
..} = Stored ChatroomService -> ChatroomService
forall a. Stored a -> a
fromStored Stored ChatroomService
spacket
        (ServiceState ChatroomService -> ServiceState ChatroomService)
-> ServiceHandler ChatroomService ()
forall s. (ServiceState s -> ServiceState s) -> ServiceHandler s ()
svcModify ((ServiceState ChatroomService -> ServiceState ChatroomService)
 -> ServiceHandler ChatroomService ())
-> (ServiceState ChatroomService -> ServiceState ChatroomService)
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ \ServiceState ChatroomService
s -> ServiceState ChatroomService
s { psSendRoomUpdates = True }

        Bool
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
chatRoomQuery (ServiceHandler ChatroomService ()
 -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ do
            [ChatroomState]
rooms <- ServiceHandler ChatroomService [ChatroomState]
forall (m :: * -> *). MonadHead LocalState m => m [ChatroomState]
listChatrooms
            ChatroomService -> ServiceHandler ChatroomService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket ChatroomService
emptyPacket
                { chatRoomInfo = concatMap roomData $ catMaybes $ map roomStateRoom rooms
                }

        Bool
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Stored (Signed ChatroomData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stored (Signed ChatroomData)]
chatRoomInfo) (ServiceHandler ChatroomService ()
 -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ do
            (Stored LocalState
 -> ServiceHandler ChatroomService (Stored LocalState))
-> ServiceHandler ChatroomService ()
forall a (m :: * -> *).
MonadHead a m =>
(Stored a -> m (Stored a)) -> m ()
updateLocalHead_ ((Stored LocalState
  -> ServiceHandler ChatroomService (Stored LocalState))
 -> ServiceHandler ChatroomService ())
-> (Stored LocalState
    -> ServiceHandler ChatroomService (Stored LocalState))
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ (Set ChatroomState
 -> ServiceHandler ChatroomService (Set ChatroomState))
-> Stored LocalState
-> ServiceHandler ChatroomService (Stored LocalState)
forall a (m :: * -> *).
(SharedType a, MonadHead LocalState m) =>
(a -> m a) -> Stored LocalState -> m (Stored LocalState)
updateSharedState_ ((Set ChatroomState
  -> ServiceHandler ChatroomService (Set ChatroomState))
 -> Stored LocalState
 -> ServiceHandler ChatroomService (Stored LocalState))
-> (Set ChatroomState
    -> ServiceHandler ChatroomService (Set ChatroomState))
-> Stored LocalState
-> ServiceHandler ChatroomService (Stored LocalState)
forall a b. (a -> b) -> a -> b
$ \Set ChatroomState
roomSet -> do
                let rooms :: [ChatroomState]
rooms = (ChatroomState -> ChatroomState -> Ordering)
-> Set ChatroomState -> [ChatroomState]
forall a. Mergeable a => (a -> a -> Ordering) -> Set a -> [a]
fromSetBy ((ChatroomState -> Maybe Text)
-> ChatroomState -> ChatroomState -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((ChatroomState -> Maybe Text)
 -> ChatroomState -> ChatroomState -> Ordering)
-> (ChatroomState -> Maybe Text)
-> ChatroomState
-> ChatroomState
-> Ordering
forall a b. (a -> b) -> a -> b
$ Chatroom -> Maybe Text
roomName (Chatroom -> Maybe Text)
-> (ChatroomState -> Maybe Chatroom) -> ChatroomState -> Maybe Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ChatroomState -> Maybe Chatroom
roomStateRoom) Set ChatroomState
roomSet
                    upd :: Set ChatroomState
-> Stored (Signed ChatroomData)
-> ServiceHandler ChatroomService (Set ChatroomState)
upd Set ChatroomState
set (Stored (Signed ChatroomData)
roomInfo :: Stored (Signed ChatroomData)) = do
                        let currentRoots :: [Stored (Signed ChatroomData)]
currentRoots = Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)]
forall a. Storable a => Stored a -> [Stored a]
storedRoots Stored (Signed ChatroomData)
roomInfo
                            isCurrentRoom :: ChatroomState -> Bool
isCurrentRoom = (Stored (Signed ChatroomData) -> Bool)
-> [Stored (Signed ChatroomData)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (([Stored (Signed ChatroomData)]
-> [Stored (Signed ChatroomData)] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`intersectsSorted` [Stored (Signed ChatroomData)]
currentRoots) ([Stored (Signed ChatroomData)] -> Bool)
-> (Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)])
-> Stored (Signed ChatroomData)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)]
forall a. Storable a => Stored a -> [Stored a]
storedRoots) ([Stored (Signed ChatroomData)] -> Bool)
-> (ChatroomState -> [Stored (Signed ChatroomData)])
-> ChatroomState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                (Stored ChatroomStateData -> [Stored (Signed ChatroomData)])
-> [Stored ChatroomStateData] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdRoom (ChatroomStateData -> [Stored (Signed ChatroomData)])
-> (Stored ChatroomStateData -> ChatroomStateData)
-> Stored ChatroomStateData
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatroomStateData -> ChatroomStateData
forall a. Stored a -> a
fromStored) ([Stored ChatroomStateData] -> [Stored (Signed ChatroomData)])
-> (ChatroomState -> [Stored ChatroomStateData])
-> ChatroomState
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> [Stored ChatroomStateData]
roomStateData

                        let prev :: [Stored ChatroomStateData]
prev = (ChatroomState -> [Stored ChatroomStateData])
-> [ChatroomState] -> [Stored ChatroomStateData]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ChatroomState -> [Stored ChatroomStateData]
roomStateData ([ChatroomState] -> [Stored ChatroomStateData])
-> [ChatroomState] -> [Stored ChatroomStateData]
forall a b. (a -> b) -> a -> b
$ (ChatroomState -> Bool) -> [ChatroomState] -> [ChatroomState]
forall a. (a -> Bool) -> [a] -> [a]
filter ChatroomState -> Bool
isCurrentRoom [ChatroomState]
rooms
                            prevRoom :: [Stored (Signed ChatroomData)]
prevRoom = (Stored ChatroomStateData -> [Stored (Signed ChatroomData)])
-> [Stored ChatroomStateData] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdRoom (ChatroomStateData -> [Stored (Signed ChatroomData)])
-> (Stored ChatroomStateData -> ChatroomStateData)
-> Stored ChatroomStateData
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatroomStateData -> ChatroomStateData
forall a. Stored a -> a
fromStored) [Stored ChatroomStateData]
prev
                            room :: [Stored (Signed ChatroomData)]
room = [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall a b. (a -> b) -> a -> b
$ (Stored (Signed ChatroomData)
roomInfo Stored (Signed ChatroomData)
-> [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall a. a -> [a] -> [a]
: ) [Stored (Signed ChatroomData)]
prevRoom

                        -- update local state only if we got roomInfo not present there
                        if Stored (Signed ChatroomData)
roomInfo Stored (Signed ChatroomData)
-> [Stored (Signed ChatroomData)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Stored (Signed ChatroomData)]
prevRoom Bool -> Bool -> Bool
&& Stored (Signed ChatroomData)
roomInfo Stored (Signed ChatroomData)
-> [Stored (Signed ChatroomData)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Stored (Signed ChatroomData)]
room
                          then do
                            Stored ChatroomStateData
sdata <- ChatroomStateData
-> ServiceHandler ChatroomService (Stored ChatroomStateData)
forall a.
Storable a =>
a -> ServiceHandler ChatroomService (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChatroomStateData { rsdPrev :: [Stored ChatroomStateData]
rsdPrev = [Stored ChatroomStateData]
prev, rsdRoom :: [Stored (Signed ChatroomData)]
rsdRoom = [Stored (Signed ChatroomData)]
room }
                            Stored (Component ChatroomState)
-> Set ChatroomState
-> ServiceHandler ChatroomService (Set ChatroomState)
forall a (m :: * -> *).
(Mergeable a, MonadStorage m, MonadIO m) =>
Stored (Component a) -> Set a -> m (Set a)
storeSetAddComponent Stored (Component ChatroomState)
Stored ChatroomStateData
sdata Set ChatroomState
set
                          else Set ChatroomState
-> ServiceHandler ChatroomService (Set ChatroomState)
forall a. a -> ServiceHandler ChatroomService a
forall (m :: * -> *) a. Monad m => a -> m a
return Set ChatroomState
set
                (Set ChatroomState
 -> Stored (Signed ChatroomData)
 -> ServiceHandler ChatroomService (Set ChatroomState))
-> Set ChatroomState
-> [Stored (Signed ChatroomData)]
-> ServiceHandler ChatroomService (Set ChatroomState)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Set ChatroomState
-> Stored (Signed ChatroomData)
-> ServiceHandler ChatroomService (Set ChatroomState)
upd Set ChatroomState
roomSet [Stored (Signed ChatroomData)]
chatRoomInfo

    serviceNewPeer :: ServiceHandler ChatroomService ()
serviceNewPeer = do
        ChatroomService -> ServiceHandler ChatroomService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket ChatroomService
emptyPacket { chatRoomQuery = True }

    serviceStorageWatchers :: forall (proxy :: * -> *).
proxy ChatroomService -> [SomeStorageWatcher ChatroomService]
serviceStorageWatchers proxy ChatroomService
_ = (SomeStorageWatcher ChatroomService
-> [SomeStorageWatcher ChatroomService]
-> [SomeStorageWatcher ChatroomService]
forall a. a -> [a] -> [a]
:[]) (SomeStorageWatcher ChatroomService
 -> [SomeStorageWatcher ChatroomService])
-> SomeStorageWatcher ChatroomService
-> [SomeStorageWatcher ChatroomService]
forall a b. (a -> b) -> a -> b
$
        (Stored LocalState -> Set ChatroomState)
-> (Set ChatroomState -> ServiceHandler ChatroomService ())
-> SomeStorageWatcher ChatroomService
forall s a.
Eq a =>
(Stored LocalState -> a)
-> (a -> ServiceHandler s ()) -> SomeStorageWatcher s
SomeStorageWatcher ([Stored SharedState] -> Set ChatroomState
forall a. SharedType a => [Stored SharedState] -> a
lookupSharedValue ([Stored SharedState] -> Set ChatroomState)
-> (Stored LocalState -> [Stored SharedState])
-> Stored LocalState
-> Set ChatroomState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> [Stored SharedState]
lsShared (LocalState -> [Stored SharedState])
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> [Stored SharedState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored) Set ChatroomState -> ServiceHandler ChatroomService ()
syncChatroomsToPeer

syncChatroomsToPeer :: Set ChatroomState -> ServiceHandler ChatroomService ()
syncChatroomsToPeer :: Set ChatroomState -> ServiceHandler ChatroomService ()
syncChatroomsToPeer Set ChatroomState
set = do
    ps :: PeerState
ps@PeerState {Bool
[(Stored ChatroomStateData, ChatroomState)]
psSendRoomUpdates :: PeerState -> Bool
psLastList :: PeerState -> [(Stored ChatroomStateData, ChatroomState)]
psSendRoomUpdates :: Bool
psLastList :: [(Stored ChatroomStateData, ChatroomState)]
..} <- ServiceHandler ChatroomService (ServiceState ChatroomService)
ServiceHandler ChatroomService PeerState
forall s. ServiceHandler s (ServiceState s)
svcGet
    Bool
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
psSendRoomUpdates (ServiceHandler ChatroomService ()
 -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ do
        let curList :: [(Stored ChatroomStateData, ChatroomState)]
curList = Set ChatroomState -> [(Stored ChatroomStateData, ChatroomState)]
chatroomSetToList Set ChatroomState
set
        [Stored (Signed ChatroomData)]
updates <- ([Maybe [Stored (Signed ChatroomData)]]
 -> [Stored (Signed ChatroomData)])
-> ServiceHandler
     ChatroomService [Maybe [Stored (Signed ChatroomData)]]
-> ServiceHandler ChatroomService [Stored (Signed ChatroomData)]
forall a b.
(a -> b)
-> ServiceHandler ChatroomService a
-> ServiceHandler ChatroomService b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([[Stored (Signed ChatroomData)]] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Stored (Signed ChatroomData)]]
 -> [Stored (Signed ChatroomData)])
-> ([Maybe [Stored (Signed ChatroomData)]]
    -> [[Stored (Signed ChatroomData)]])
-> [Maybe [Stored (Signed ChatroomData)]]
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [Stored (Signed ChatroomData)]]
-> [[Stored (Signed ChatroomData)]]
forall a. [Maybe a] -> [a]
catMaybes) (ServiceHandler
   ChatroomService [Maybe [Stored (Signed ChatroomData)]]
 -> ServiceHandler ChatroomService [Stored (Signed ChatroomData)])
-> ServiceHandler
     ChatroomService [Maybe [Stored (Signed ChatroomData)]]
-> ServiceHandler ChatroomService [Stored (Signed ChatroomData)]
forall a b. (a -> b) -> a -> b
$
            [ChatroomSetChange]
-> (ChatroomSetChange
    -> ServiceHandler
         ChatroomService (Maybe [Stored (Signed ChatroomData)]))
-> ServiceHandler
     ChatroomService [Maybe [Stored (Signed ChatroomData)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
psLastList [(Stored ChatroomStateData, ChatroomState)]
curList) ((ChatroomSetChange
  -> ServiceHandler
       ChatroomService (Maybe [Stored (Signed ChatroomData)]))
 -> ServiceHandler
      ChatroomService [Maybe [Stored (Signed ChatroomData)]])
-> (ChatroomSetChange
    -> ServiceHandler
         ChatroomService (Maybe [Stored (Signed ChatroomData)]))
-> ServiceHandler
     ChatroomService [Maybe [Stored (Signed ChatroomData)]]
forall a b. (a -> b) -> a -> b
$ Maybe [Stored (Signed ChatroomData)]
-> ServiceHandler
     ChatroomService (Maybe [Stored (Signed ChatroomData)])
forall a. a -> ServiceHandler ChatroomService a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Stored (Signed ChatroomData)]
 -> ServiceHandler
      ChatroomService (Maybe [Stored (Signed ChatroomData)]))
-> (ChatroomSetChange -> Maybe [Stored (Signed ChatroomData)])
-> ChatroomSetChange
-> ServiceHandler
     ChatroomService (Maybe [Stored (Signed ChatroomData)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                AddedChatroom ChatroomState
room -> Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom -> [Stored (Signed ChatroomData)])
-> Maybe Chatroom -> Maybe [Stored (Signed ChatroomData)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
room
                RemovedChatroom {} -> Maybe [Stored (Signed ChatroomData)]
forall a. Maybe a
Nothing
                UpdatedChatroom ChatroomState
_ ChatroomState
room -> Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom -> [Stored (Signed ChatroomData)])
-> Maybe Chatroom -> Maybe [Stored (Signed ChatroomData)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
room
        Bool
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Stored (Signed ChatroomData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stored (Signed ChatroomData)]
updates) (ServiceHandler ChatroomService ()
 -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ do
            ChatroomService -> ServiceHandler ChatroomService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket (ChatroomService -> ServiceHandler ChatroomService ())
-> ChatroomService -> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ ChatroomService
emptyPacket { chatRoomInfo = updates }
        ServiceState ChatroomService -> ServiceHandler ChatroomService ()
forall s. ServiceState s -> ServiceHandler s ()
svcSet (ServiceState ChatroomService -> ServiceHandler ChatroomService ())
-> ServiceState ChatroomService
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ PeerState
ps { psLastList = curList }