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

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

    ChatroomSetChange(..),
    watchChatrooms,

    ChatMessage,
    cmsgFrom, cmsgReplyTo, cmsgTime, cmsgText, cmsgLeave,
    cmsgRoom, cmsgRoomData,
    ChatMessageData(..),
    sendChatroomMessage,
    sendChatroomMessageByStateData,

    ChatroomService(..),
) where

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

import Data.Bool
import Data.Either
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Set qualified as S
import Data.Text (Text)
import Data.Time

import Erebos.Identity
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 ChatMessageData = ChatMessageData
    { ChatMessageData -> [Stored (Signed ChatMessageData)]
mdPrev :: [Stored (Signed ChatMessageData)]
    , ChatMessageData -> [Stored (Signed ChatroomData)]
mdRoom :: [Stored (Signed ChatroomData)]
    , ChatMessageData -> ComposedIdentity
mdFrom :: ComposedIdentity
    , ChatMessageData -> Maybe (Stored (Signed ChatMessageData))
mdReplyTo :: Maybe (Stored (Signed ChatMessageData))
    , ChatMessageData -> ZonedTime
mdTime :: ZonedTime
    , ChatMessageData -> Maybe Text
mdText :: Maybe Text
    , ChatMessageData -> Bool
mdLeave :: Bool
    }

data ChatMessage = ChatMessage
    { ChatMessage -> Stored (Signed ChatMessageData)
cmsgData :: Stored (Signed ChatMessageData)
    }

validateSingleMessage :: Stored (Signed ChatMessageData) -> Maybe ChatMessage
validateSingleMessage :: Stored (Signed ChatMessageData) -> Maybe ChatMessage
validateSingleMessage Stored (Signed ChatMessageData)
sdata = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Stored (Signed ChatMessageData) -> Signed ChatMessageData
forall a. Stored a -> a
fromStored Stored (Signed ChatMessageData)
sdata Signed ChatMessageData -> Stored PublicKey -> Bool
forall a. Signed a -> Stored PublicKey -> Bool
`isSignedBy` ComposedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage (ChatMessageData -> ComposedIdentity
mdFrom (Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned Stored (Signed ChatMessageData)
sdata))
    ChatMessage -> Maybe ChatMessage
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChatMessage -> Maybe ChatMessage)
-> ChatMessage -> Maybe ChatMessage
forall a b. (a -> b) -> a -> b
$ Stored (Signed ChatMessageData) -> ChatMessage
ChatMessage Stored (Signed ChatMessageData)
sdata

cmsgFrom :: ChatMessage -> ComposedIdentity
cmsgFrom :: ChatMessage -> ComposedIdentity
cmsgFrom = ChatMessageData -> ComposedIdentity
mdFrom (ChatMessageData -> ComposedIdentity)
-> (ChatMessage -> ChatMessageData)
-> ChatMessage
-> ComposedIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned (Stored (Signed ChatMessageData) -> ChatMessageData)
-> (ChatMessage -> Stored (Signed ChatMessageData))
-> ChatMessage
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> Stored (Signed ChatMessageData)
cmsgData

cmsgReplyTo :: ChatMessage -> Maybe ChatMessage
cmsgReplyTo :: ChatMessage -> Maybe ChatMessage
cmsgReplyTo = (Stored (Signed ChatMessageData) -> ChatMessage)
-> Maybe (Stored (Signed ChatMessageData)) -> Maybe ChatMessage
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stored (Signed ChatMessageData) -> ChatMessage
ChatMessage (Maybe (Stored (Signed ChatMessageData)) -> Maybe ChatMessage)
-> (ChatMessage -> Maybe (Stored (Signed ChatMessageData)))
-> ChatMessage
-> Maybe ChatMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessageData -> Maybe (Stored (Signed ChatMessageData))
mdReplyTo (ChatMessageData -> Maybe (Stored (Signed ChatMessageData)))
-> (ChatMessage -> ChatMessageData)
-> ChatMessage
-> Maybe (Stored (Signed ChatMessageData))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned (Stored (Signed ChatMessageData) -> ChatMessageData)
-> (ChatMessage -> Stored (Signed ChatMessageData))
-> ChatMessage
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> Stored (Signed ChatMessageData)
cmsgData

cmsgTime :: ChatMessage -> ZonedTime
cmsgTime :: ChatMessage -> ZonedTime
cmsgTime = ChatMessageData -> ZonedTime
mdTime (ChatMessageData -> ZonedTime)
-> (ChatMessage -> ChatMessageData) -> ChatMessage -> ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned (Stored (Signed ChatMessageData) -> ChatMessageData)
-> (ChatMessage -> Stored (Signed ChatMessageData))
-> ChatMessage
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> Stored (Signed ChatMessageData)
cmsgData

cmsgText :: ChatMessage -> Maybe Text
cmsgText :: ChatMessage -> Maybe Text
cmsgText = ChatMessageData -> Maybe Text
mdText (ChatMessageData -> Maybe Text)
-> (ChatMessage -> ChatMessageData) -> ChatMessage -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned (Stored (Signed ChatMessageData) -> ChatMessageData)
-> (ChatMessage -> Stored (Signed ChatMessageData))
-> ChatMessage
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> Stored (Signed ChatMessageData)
cmsgData

cmsgLeave :: ChatMessage -> Bool
cmsgLeave :: ChatMessage -> Bool
cmsgLeave = ChatMessageData -> Bool
mdLeave (ChatMessageData -> Bool)
-> (ChatMessage -> ChatMessageData) -> ChatMessage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned (Stored (Signed ChatMessageData) -> ChatMessageData)
-> (ChatMessage -> Stored (Signed ChatMessageData))
-> ChatMessage
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> Stored (Signed ChatMessageData)
cmsgData

cmsgRoom :: ChatMessage -> Maybe Chatroom
cmsgRoom :: ChatMessage -> Maybe Chatroom
cmsgRoom = (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)
-> (ChatMessage -> Either String Chatroom)
-> ChatMessage
-> Maybe Chatroom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except String Chatroom -> Either String Chatroom
forall e a. Except e a -> Either e a
runExcept (Except String Chatroom -> Either String Chatroom)
-> (ChatMessage -> Except String Chatroom)
-> ChatMessage
-> Either String Chatroom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored (Signed ChatroomData)] -> Except String Chatroom
validateChatroom ([Stored (Signed ChatroomData)] -> Except String Chatroom)
-> (ChatMessage -> [Stored (Signed ChatroomData)])
-> ChatMessage
-> Except String Chatroom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> [Stored (Signed ChatroomData)]
cmsgRoomData

cmsgRoomData :: ChatMessage -> [ Stored (Signed ChatroomData) ]
cmsgRoomData :: ChatMessage -> [Stored (Signed ChatroomData)]
cmsgRoomData = [[Stored (Signed ChatroomData)]] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Stored (Signed ChatroomData)]]
 -> [Stored (Signed ChatroomData)])
-> (ChatMessage -> [[Stored (Signed ChatroomData)]])
-> ChatMessage
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signed ChatMessageData -> Maybe [Stored (Signed ChatroomData)])
-> [Stored (Signed ChatMessageData)]
-> [[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)])
-> (Signed ChatMessageData -> [Stored (Signed ChatroomData)])
-> Signed ChatMessageData
-> Maybe [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessageData -> [Stored (Signed ChatroomData)]
mdRoom (ChatMessageData -> [Stored (Signed ChatroomData)])
-> (Signed ChatMessageData -> ChatMessageData)
-> Signed ChatMessageData
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatMessageData -> ChatMessageData
forall a. Stored a -> a
fromStored (Stored ChatMessageData -> ChatMessageData)
-> (Signed ChatMessageData -> Stored ChatMessageData)
-> Signed ChatMessageData
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed ChatMessageData -> Stored ChatMessageData
forall a. Signed a -> Stored a
signedData) ([Stored (Signed ChatMessageData)]
 -> [[Stored (Signed ChatroomData)]])
-> (ChatMessage -> [Stored (Signed ChatMessageData)])
-> ChatMessage
-> [[Stored (Signed ChatroomData)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored (Signed ChatMessageData)
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. a -> [a] -> [a]
: []) (Stored (Signed ChatMessageData)
 -> [Stored (Signed ChatMessageData)])
-> (ChatMessage -> Stored (Signed ChatMessageData))
-> ChatMessage
-> [Stored (Signed ChatMessageData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessage -> Stored (Signed ChatMessageData)
cmsgData

instance Storable ChatMessageData where
    store' :: ChatMessageData -> Store
store' ChatMessageData {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
Maybe Text
Maybe (Stored (Signed ChatMessageData))
ZonedTime
ComposedIdentity
mdPrev :: ChatMessageData -> [Stored (Signed ChatMessageData)]
mdRoom :: ChatMessageData -> [Stored (Signed ChatroomData)]
mdFrom :: ChatMessageData -> ComposedIdentity
mdReplyTo :: ChatMessageData -> Maybe (Stored (Signed ChatMessageData))
mdTime :: ChatMessageData -> ZonedTime
mdText :: ChatMessageData -> Maybe Text
mdLeave :: ChatMessageData -> Bool
mdPrev :: [Stored (Signed ChatMessageData)]
mdRoom :: [Stored (Signed ChatroomData)]
mdFrom :: ComposedIdentity
mdReplyTo :: Maybe (Stored (Signed ChatMessageData))
mdTime :: ZonedTime
mdText :: Maybe Text
mdLeave :: Bool
..} = (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 ChatMessageData) -> StoreRec c)
-> [Stored (Signed ChatMessageData)] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Stored (Signed ChatMessageData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"SPREV") [Stored (Signed ChatMessageData)]
mdPrev
        (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
"room") [Stored (Signed ChatroomData)]
mdRoom
        (Stored (Signed ExtendedIdentityData) -> StoreRec c)
-> [Stored (Signed ExtendedIdentityData)] -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> Stored (Signed ExtendedIdentityData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"from") ([Stored (Signed ExtendedIdentityData)] -> StoreRec c)
-> [Stored (Signed ExtendedIdentityData)] -> StoreRec c
forall a b. (a -> b) -> a -> b
$ ComposedIdentity -> [Stored (Signed ExtendedIdentityData)]
forall (m :: * -> *).
Identity m -> m (Stored (Signed ExtendedIdentityData))
idExtDataF ComposedIdentity
mdFrom
        String -> Maybe (Stored (Signed ChatMessageData)) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> Maybe a -> StoreRec c
storeMbRef String
"reply-to" Maybe (Stored (Signed ChatMessageData))
mdReplyTo
        String -> ZonedTime -> StoreRec c
forall a (c :: * -> *). StorableDate a => String -> a -> StoreRec c
storeDate String
"time" ZonedTime
mdTime
        String -> Maybe Text -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
String -> Maybe a -> StoreRec c
storeMbText String
"text" Maybe Text
mdText
        Bool -> StoreRec c -> StoreRec c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mdLeave (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
"leave"

    load' :: Load ChatMessageData
load' = LoadRec ChatMessageData -> Load ChatMessageData
forall a. LoadRec a -> Load a
loadRec (LoadRec ChatMessageData -> Load ChatMessageData)
-> LoadRec ChatMessageData -> Load ChatMessageData
forall a b. (a -> b) -> a -> b
$ do
        [Stored (Signed ChatMessageData)]
mdPrev <- String -> LoadRec [Stored (Signed ChatMessageData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"SPREV"
        [Stored (Signed ChatroomData)]
mdRoom <- String -> LoadRec [Stored (Signed ChatroomData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"room"
        ComposedIdentity
mdFrom <- String -> LoadRec ComposedIdentity
loadIdentity String
"from"
        Maybe (Stored (Signed ChatMessageData))
mdReplyTo <- String -> LoadRec (Maybe (Stored (Signed ChatMessageData)))
forall a. Storable a => String -> LoadRec (Maybe a)
loadMbRef String
"reply-to"
        ZonedTime
mdTime <- String -> LoadRec ZonedTime
forall a. StorableDate a => String -> LoadRec a
loadDate String
"time"
        Maybe Text
mdText <- String -> LoadRec (Maybe Text)
forall a. StorableText a => String -> LoadRec (Maybe a)
loadMbText String
"text"
        Bool
mdLeave <- 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
"leave"
        ChatMessageData -> LoadRec ChatMessageData
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatMessageData {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
Maybe Text
Maybe (Stored (Signed ChatMessageData))
ZonedTime
ComposedIdentity
mdPrev :: [Stored (Signed ChatMessageData)]
mdRoom :: [Stored (Signed ChatroomData)]
mdFrom :: ComposedIdentity
mdReplyTo :: Maybe (Stored (Signed ChatMessageData))
mdTime :: ZonedTime
mdText :: Maybe Text
mdLeave :: Bool
mdPrev :: [Stored (Signed ChatMessageData)]
mdRoom :: [Stored (Signed ChatroomData)]
mdFrom :: ComposedIdentity
mdReplyTo :: Maybe (Stored (Signed ChatMessageData))
mdTime :: ZonedTime
mdText :: Maybe Text
mdLeave :: Bool
..}

threadToListSince :: [ Stored (Signed ChatMessageData) ] -> [ Stored (Signed ChatMessageData) ] -> [ ChatMessage ]
threadToListSince :: [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
threadToListSince [Stored (Signed ChatMessageData)]
since [Stored (Signed ChatMessageData)]
thread = Set (Stored (Signed ChatMessageData))
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
helper ([Stored (Signed ChatMessageData)]
-> Set (Stored (Signed ChatMessageData))
forall a. Ord a => [a] -> Set a
S.fromList [Stored (Signed ChatMessageData)]
since) [Stored (Signed ChatMessageData)]
thread
  where
    helper :: S.Set (Stored (Signed ChatMessageData)) -> [Stored (Signed ChatMessageData)] -> [ChatMessage]
    helper :: Set (Stored (Signed ChatMessageData))
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
helper Set (Stored (Signed ChatMessageData))
seen [Stored (Signed ChatMessageData)]
msgs
        | Stored (Signed ChatMessageData)
msg : [Stored (Signed ChatMessageData)]
msgs' <- (Stored (Signed ChatMessageData) -> Bool)
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Stored (Signed ChatMessageData)
-> Set (Stored (Signed ChatMessageData)) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set (Stored (Signed ChatMessageData))
seen) ([Stored (Signed ChatMessageData)]
 -> [Stored (Signed ChatMessageData)])
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. [a] -> [a]
reverse ([Stored (Signed ChatMessageData)]
 -> [Stored (Signed ChatMessageData)])
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ (Stored (Signed ChatMessageData)
 -> Stored (Signed ChatMessageData) -> Ordering)
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Stored (Signed ChatMessageData)
 -> (UTCTime, Stored (Signed ChatMessageData)))
-> Stored (Signed ChatMessageData)
-> Stored (Signed ChatMessageData)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Stored (Signed ChatMessageData)
-> (UTCTime, Stored (Signed ChatMessageData))
cmpView) [Stored (Signed ChatMessageData)]
msgs =
            ([ChatMessage] -> [ChatMessage])
-> (ChatMessage -> [ChatMessage] -> [ChatMessage])
-> Maybe ChatMessage
-> [ChatMessage]
-> [ChatMessage]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ChatMessage] -> [ChatMessage]
forall a. a -> a
id (:) (Stored (Signed ChatMessageData) -> Maybe ChatMessage
validateSingleMessage Stored (Signed ChatMessageData)
msg) ([ChatMessage] -> [ChatMessage]) -> [ChatMessage] -> [ChatMessage]
forall a b. (a -> b) -> a -> b
$
               Set (Stored (Signed ChatMessageData))
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
helper (Stored (Signed ChatMessageData)
-> Set (Stored (Signed ChatMessageData))
-> Set (Stored (Signed ChatMessageData))
forall a. Ord a => a -> Set a -> Set a
S.insert Stored (Signed ChatMessageData)
msg Set (Stored (Signed ChatMessageData))
seen) ([Stored (Signed ChatMessageData)]
msgs' [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. [a] -> [a] -> [a]
++ ChatMessageData -> [Stored (Signed ChatMessageData)]
mdPrev (Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned Stored (Signed ChatMessageData)
msg))
        | Bool
otherwise = []
    cmpView :: Stored (Signed ChatMessageData)
-> (UTCTime, Stored (Signed ChatMessageData))
cmpView Stored (Signed ChatMessageData)
msg = (ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime) -> ZonedTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ ChatMessageData -> ZonedTime
mdTime (ChatMessageData -> ZonedTime) -> ChatMessageData -> ZonedTime
forall a b. (a -> b) -> a -> b
$ Stored (Signed ChatMessageData) -> ChatMessageData
forall a. Stored (Signed a) -> a
fromSigned Stored (Signed ChatMessageData)
msg, Stored (Signed ChatMessageData)
msg)

sendChatroomMessage
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => ChatroomState -> Text -> m ()
sendChatroomMessage :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
ChatroomState -> Text -> m ()
sendChatroomMessage ChatroomState
rstate Text
msg = Stored ChatroomStateData -> Text -> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> Text -> m ()
sendChatroomMessageByStateData ([Stored ChatroomStateData] -> Stored ChatroomStateData
forall a. HasCallStack => [a] -> a
head ([Stored ChatroomStateData] -> Stored ChatroomStateData)
-> [Stored ChatroomStateData] -> Stored ChatroomStateData
forall a b. (a -> b) -> a -> b
$ ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
rstate) Text
msg

sendChatroomMessageByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData -> Text -> m ()
sendChatroomMessageByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> Text -> m ()
sendChatroomMessageByStateData Stored ChatroomStateData
lookupData Text
msg = m (Maybe ChatroomState) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ChatroomState) -> m ())
-> m (Maybe ChatroomState) -> m ()
forall a b. (a -> b) -> a -> b
$ (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
    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
        ComposedIdentity
self <- Identity Identity -> ComposedIdentity
forall (m :: * -> *).
(Foldable m, Applicative m) =>
Identity m -> ComposedIdentity
finalOwner (Identity Identity -> ComposedIdentity)
-> (Stored LocalState -> Identity Identity)
-> Stored LocalState
-> ComposedIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalState -> Identity Identity
localIdentity (LocalState -> Identity Identity)
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> Identity Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> ComposedIdentity)
-> m (Stored LocalState) -> m ComposedIdentity
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
        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
$ ComposedIdentity -> Stored PublicKey
forall (m :: * -> *). Identity m -> Stored PublicKey
idKeyMessage ComposedIdentity
self
        ZonedTime
time <- IO ZonedTime -> m ZonedTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
        Stored (Signed ChatMessageData)
mdata <- Signed ChatMessageData -> m (Stored (Signed ChatMessageData))
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore (Signed ChatMessageData -> m (Stored (Signed ChatMessageData)))
-> m (Signed ChatMessageData)
-> m (Stored (Signed ChatMessageData))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SecretKey -> Stored ChatMessageData -> m (Signed ChatMessageData)
forall (m :: * -> *) a.
MonadStorage m =>
SecretKey -> Stored a -> m (Signed a)
sign SecretKey
secret (Stored ChatMessageData -> m (Signed ChatMessageData))
-> m (Stored ChatMessageData) -> m (Signed ChatMessageData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChatMessageData -> m (Stored ChatMessageData)
forall a. Storable a => a -> m (Stored a)
forall (m :: * -> *) a.
(MonadStorage m, Storable a) =>
a -> m (Stored a)
mstore ChatMessageData
            { mdPrev :: [Stored (Signed ChatMessageData)]
mdPrev = ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
cstate
            , mdRoom :: [Stored (Signed ChatroomData)]
mdRoom = if [Stored (Signed ChatMessageData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
cstate)
                          then [Stored (Signed ChatroomData)]
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Maybe Chatroom
-> [Stored (Signed ChatroomData)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Chatroom -> [Stored (Signed ChatroomData)]
roomData (ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
cstate)
                          else []
            , mdFrom :: ComposedIdentity
mdFrom = ComposedIdentity
self
            , mdReplyTo :: Maybe (Stored (Signed ChatMessageData))
mdReplyTo = Maybe (Stored (Signed ChatMessageData))
forall a. Maybe a
Nothing
            , mdTime :: ZonedTime
mdTime = ZonedTime
time
            , mdText :: Maybe Text
mdText = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg
            , mdLeave :: Bool
mdLeave = Bool
False
            }
        [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 = []
            , rsdSubscribe :: Maybe Bool
rsdSubscribe = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = [ Stored (Signed ChatMessageData)
mdata ]
            }


data ChatroomStateData = ChatroomStateData
    { ChatroomStateData -> [Stored ChatroomStateData]
rsdPrev :: [Stored ChatroomStateData]
    , ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdRoom :: [Stored (Signed ChatroomData)]
    , ChatroomStateData -> Maybe Bool
rsdSubscribe :: Maybe Bool
    , ChatroomStateData -> [Stored (Signed ChatMessageData)]
rsdMessages :: [Stored (Signed ChatMessageData)]
    }

data ChatroomState = ChatroomState
    { ChatroomState -> [Stored ChatroomStateData]
roomStateData :: [Stored ChatroomStateData]
    , ChatroomState -> Maybe Chatroom
roomStateRoom :: Maybe Chatroom
    , ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData :: [Stored (Signed ChatMessageData)]
    , ChatroomState -> Bool
roomStateSubscribe :: Bool
    , ChatroomState -> [ChatMessage]
roomStateMessages :: [ChatMessage]
    }

instance Storable ChatroomStateData where
    store' :: ChatroomStateData -> Store
store' ChatroomStateData {[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
Maybe Bool
rsdPrev :: ChatroomStateData -> [Stored ChatroomStateData]
rsdRoom :: ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdSubscribe :: ChatroomStateData -> Maybe Bool
rsdMessages :: ChatroomStateData -> [Stored (Signed ChatMessageData)]
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdSubscribe :: Maybe Bool
rsdMessages :: [Stored (Signed ChatMessageData)]
..} = (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"
        Maybe Bool -> (Bool -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Bool
rsdSubscribe ((Bool -> StoreRec c) -> StoreRec c)
-> (Bool -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Int -> StoreRec c
forall a (c :: * -> *). Integral a => String -> a -> StoreRec c
storeInt String
"subscribe" (Int -> StoreRec c) -> (Bool -> Int) -> Bool -> StoreRec c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> Bool -> a
bool @Int Int
0 Int
1
        [Stored (Signed ChatMessageData)]
-> (Stored (Signed ChatMessageData) -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored (Signed ChatMessageData)]
rsdMessages ((Stored (Signed ChatMessageData) -> StoreRec c) -> StoreRec c)
-> (Stored (Signed ChatMessageData) -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Stored (Signed ChatMessageData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"msg"

    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"
        Maybe Bool
rsdSubscribe <- (Int -> Bool) -> Maybe Int -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
(/=) @Int Int
0) (Maybe Int -> Maybe Bool)
-> LoadRec (Maybe Int) -> LoadRec (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> LoadRec (Maybe Int)
forall a. Num a => String -> LoadRec (Maybe a)
loadMbInt String
"subscribe"
        [Stored (Signed ChatMessageData)]
rsdMessages <- String -> LoadRec [Stored (Signed ChatMessageData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"msg"
        ChatroomStateData -> LoadRec ChatroomStateData
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatroomStateData {[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
Maybe Bool
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdSubscribe :: Maybe Bool
rsdMessages :: [Stored (Signed ChatMessageData)]
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdSubscribe :: Maybe Bool
rsdMessages :: [Stored (Signed ChatMessageData)]
..}

instance Mergeable ChatroomState where
    type Component ChatroomState = ChatroomStateData

    mergeSorted :: [Stored (Component ChatroomState)] -> ChatroomState
mergeSorted [Stored (Component ChatroomState)]
roomStateData =
        let 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]
roomStateData
            roomStateMessageData :: [Stored (Signed ChatMessageData)]
roomStateMessageData = [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatMessageData)]
 -> [Stored (Signed ChatMessageData)])
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ [[Stored (Signed ChatMessageData)]]
-> [Stored (Signed ChatMessageData)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Stored (Signed ChatMessageData)]]
 -> [Stored (Signed ChatMessageData)])
-> [[Stored (Signed ChatMessageData)]]
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ ((ChatroomStateData -> Maybe [Stored (Signed ChatMessageData)])
 -> [Stored ChatroomStateData]
 -> [[Stored (Signed ChatMessageData)]])
-> [Stored ChatroomStateData]
-> (ChatroomStateData -> Maybe [Stored (Signed ChatMessageData)])
-> [[Stored (Signed ChatMessageData)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ChatroomStateData -> Maybe [Stored (Signed ChatMessageData)])
-> [Stored ChatroomStateData]
-> [[Stored (Signed ChatMessageData)]]
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> [b]
findProperty [Stored (Component ChatroomState)]
[Stored ChatroomStateData]
roomStateData ((ChatroomStateData -> Maybe [Stored (Signed ChatMessageData)])
 -> [[Stored (Signed ChatMessageData)]])
-> (ChatroomStateData -> Maybe [Stored (Signed ChatMessageData)])
-> [[Stored (Signed ChatMessageData)]]
forall a b. (a -> b) -> a -> b
$ \case
                ChatroomStateData {[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
Maybe Bool
rsdPrev :: ChatroomStateData -> [Stored ChatroomStateData]
rsdRoom :: ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdSubscribe :: ChatroomStateData -> Maybe Bool
rsdMessages :: ChatroomStateData -> [Stored (Signed ChatMessageData)]
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdSubscribe :: Maybe Bool
rsdMessages :: [Stored (Signed ChatMessageData)]
..} | [Stored (Signed ChatMessageData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stored (Signed ChatMessageData)]
rsdMessages -> Maybe [Stored (Signed ChatMessageData)]
forall a. Maybe a
Nothing
                                       | Bool
otherwise        -> [Stored (Signed ChatMessageData)]
-> Maybe [Stored (Signed ChatMessageData)]
forall a. a -> Maybe a
Just [Stored (Signed ChatMessageData)]
rsdMessages
            roomStateSubscribe :: Bool
roomStateSubscribe = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ChatroomStateData -> Maybe Bool)
-> [Stored ChatroomStateData] -> Maybe Bool
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b
findPropertyFirst ChatroomStateData -> Maybe Bool
rsdSubscribe [Stored (Component ChatroomState)]
[Stored ChatroomStateData]
roomStateData
            roomStateMessages :: [ChatMessage]
roomStateMessages = [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
threadToListSince [] ([Stored (Signed ChatMessageData)] -> [ChatMessage])
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
forall a b. (a -> b) -> a -> b
$ (Stored ChatroomStateData -> [Stored (Signed ChatMessageData)])
-> [Stored ChatroomStateData] -> [Stored (Signed ChatMessageData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ChatroomStateData -> [Stored (Signed ChatMessageData)]
rsdMessages (ChatroomStateData -> [Stored (Signed ChatMessageData)])
-> (Stored ChatroomStateData -> ChatroomStateData)
-> Stored ChatroomStateData
-> [Stored (Signed ChatMessageData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored ChatroomStateData -> ChatroomStateData
forall a. Stored a -> a
fromStored) [Stored (Component ChatroomState)]
[Stored ChatroomStateData]
roomStateData
         in ChatroomState {Bool
[Stored (Signed ChatMessageData)]
[Stored (Component ChatroomState)]
[Stored ChatroomStateData]
[ChatMessage]
Maybe Chatroom
roomStateData :: [Stored ChatroomStateData]
roomStateMessageData :: [Stored (Signed ChatMessageData)]
roomStateRoom :: Maybe Chatroom
roomStateSubscribe :: Bool
roomStateMessages :: [ChatMessage]
roomStateData :: [Stored (Component ChatroomState)]
roomStateRoom :: Maybe Chatroom
roomStateMessageData :: [Stored (Signed ChatMessageData)]
roomStateSubscribe :: Bool
roomStateMessages :: [ChatMessage]
..}

    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 ]
        , rsdSubscribe :: Maybe Bool
rsdSubscribe = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
        , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = []
        }

    (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 ]
            , rsdSubscribe :: Maybe Bool
rsdSubscribe = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = []
            }


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

chatroomSetSubscribe
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData -> Bool -> m ()
chatroomSetSubscribe :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> Bool -> m ()
chatroomSetSubscribe Stored ChatroomStateData
lookupData Bool
subscribe = m (Maybe ChatroomState) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ChatroomState) -> m ())
-> m (Maybe ChatroomState) -> m ()
forall a b. (a -> b) -> a -> b
$ (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
    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
        [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 = []
            , rsdSubscribe :: Maybe Bool
rsdSubscribe = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
subscribe
            , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = []
            }

getMessagesSinceState :: ChatroomState -> ChatroomState -> [ChatMessage]
getMessagesSinceState :: ChatroomState -> ChatroomState -> [ChatMessage]
getMessagesSinceState ChatroomState
cur ChatroomState
old = [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)] -> [ChatMessage]
threadToListSince (ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
old) (ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
cur)


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)]
    , ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomSubscribe :: [Stored (Signed ChatroomData)]
    , ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: [Stored (Signed ChatroomData)]
    , ChatroomService -> [Stored (Signed ChatMessageData)]
chatRoomMessage :: [Stored (Signed ChatMessageData)]
    }
    deriving (ChatroomService -> ChatroomService -> Bool
(ChatroomService -> ChatroomService -> Bool)
-> (ChatroomService -> ChatroomService -> Bool)
-> Eq ChatroomService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChatroomService -> ChatroomService -> Bool
== :: ChatroomService -> ChatroomService -> Bool
$c/= :: ChatroomService -> ChatroomService -> Bool
/= :: ChatroomService -> ChatroomService -> Bool
Eq)

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

instance Storable ChatroomService where
    store' :: ChatroomService -> Store
store' ChatroomService {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
chatRoomQuery :: ChatroomService -> Bool
chatRoomInfo :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomSubscribe :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomMessage :: ChatroomService -> [Stored (Signed ChatMessageData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
chatRoomSubscribe :: [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: [Stored (Signed ChatroomData)]
chatRoomMessage :: [Stored (Signed ChatMessageData)]
..} = (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"
        [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)]
chatRoomSubscribe ((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-subscribe"
        [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)]
chatRoomUnsubscribe ((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-unsubscribe"
        [Stored (Signed ChatMessageData)]
-> (Stored (Signed ChatMessageData) -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored (Signed ChatMessageData)]
chatRoomMessage ((Stored (Signed ChatMessageData) -> StoreRec c) -> StoreRec c)
-> (Stored (Signed ChatMessageData) -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Stored (Signed ChatMessageData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"room-message"

    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"
        [Stored (Signed ChatroomData)]
chatRoomSubscribe <- String -> LoadRec [Stored (Signed ChatroomData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"room-subscribe"
        [Stored (Signed ChatroomData)]
chatRoomUnsubscribe <- String -> LoadRec [Stored (Signed ChatroomData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"room-unsubscribe"
        [Stored (Signed ChatMessageData)]
chatRoomMessage <- String -> LoadRec [Stored (Signed ChatMessageData)]
forall a. Storable a => String -> LoadRec [a]
loadRefs String
"room-message"
        ChatroomService -> LoadRec ChatroomService
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatroomService {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
chatRoomSubscribe :: [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: [Stored (Signed ChatroomData)]
chatRoomMessage :: [Stored (Signed ChatMessageData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
chatRoomSubscribe :: [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: [Stored (Signed ChatroomData)]
chatRoomMessage :: [Stored (Signed ChatMessageData)]
..}

data PeerState = PeerState
    { PeerState -> Bool
psSendRoomUpdates :: Bool
    , PeerState -> [(Stored ChatroomStateData, ChatroomState)]
psLastList :: [(Stored ChatroomStateData, ChatroomState)]
    , PeerState -> [Stored (Signed ChatroomData)]
psSubscribedTo :: [ Stored (Signed ChatroomData) ] -- least root for each room
    }

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 = []
        , psSubscribedTo :: [Stored (Signed ChatroomData)]
psSubscribedTo = []
        }

    serviceHandler :: Stored ChatroomService -> ServiceHandler ChatroomService ()
serviceHandler Stored ChatroomService
spacket = do
        let ChatroomService {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
chatRoomQuery :: ChatroomService -> Bool
chatRoomInfo :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomSubscribe :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: ChatroomService -> [Stored (Signed ChatroomData)]
chatRoomMessage :: ChatroomService -> [Stored (Signed ChatMessageData)]
chatRoomQuery :: Bool
chatRoomInfo :: [Stored (Signed ChatroomData)]
chatRoomSubscribe :: [Stored (Signed ChatroomData)]
chatRoomUnsubscribe :: [Stored (Signed ChatroomData)]
chatRoomMessage :: [Stored (Signed ChatMessageData)]
..} = Stored ChatroomService -> ChatroomService
forall a. Stored a -> a
fromStored Stored ChatroomService
spacket

        Bool
previouslyUpdated <- PeerState -> Bool
psSendRoomUpdates (PeerState -> Bool)
-> ServiceHandler ChatroomService PeerState
-> ServiceHandler ChatroomService Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServiceHandler ChatroomService (ServiceState ChatroomService)
ServiceHandler ChatroomService PeerState
forall s. ServiceHandler s (ServiceState s)
svcGet
        (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 -> Bool
not Bool
previouslyUpdated) (ServiceHandler ChatroomService ()
 -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ do
            Set ChatroomState -> ServiceHandler ChatroomService ()
syncChatroomsToPeer (Set ChatroomState -> ServiceHandler ChatroomService ())
-> (Stored LocalState -> Set ChatroomState)
-> Stored LocalState
-> ServiceHandler ChatroomService ()
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 -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService (Stored LocalState)
-> ServiceHandler ChatroomService ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ServiceHandler ChatroomService (Stored LocalState)
forall a (m :: * -> *). MonadHead a m => m (Stored a)
getLocalHead

        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 (Signed ChatroomData)]
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Maybe Chatroom
-> [Stored (Signed ChatroomData)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Chatroom -> [Stored (Signed ChatroomData)]
roomData (Maybe Chatroom -> [Stored (Signed ChatroomData)])
-> (ChatroomState -> Maybe Chatroom)
-> ChatroomState
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> Maybe Chatroom
roomStateRoom

                        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 (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)]] -> [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 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
                                , rsdSubscribe :: Maybe Bool
rsdSubscribe = Maybe Bool
forall a. Maybe a
Nothing
                                , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = []
                                }
                            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

        [Stored (Signed ChatroomData)]
-> (Stored (Signed ChatroomData)
    -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored (Signed ChatroomData)]
chatRoomSubscribe ((Stored (Signed ChatroomData)
  -> ServiceHandler ChatroomService ())
 -> ServiceHandler ChatroomService ())
-> (Stored (Signed ChatroomData)
    -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ \Stored (Signed ChatroomData)
subscribeData -> do
            Maybe ChatroomState
mbRoomState <- Stored (Signed ChatroomData)
-> ServiceHandler ChatroomService (Maybe ChatroomState)
forall (m :: * -> *).
MonadHead LocalState m =>
Stored (Signed ChatroomData) -> m (Maybe ChatroomState)
findChatroomByRoomData Stored (Signed ChatroomData)
subscribeData
            Maybe ChatroomState
-> (ChatroomState -> ServiceHandler ChatroomService (Maybe ()))
-> ServiceHandler ChatroomService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ChatroomState
mbRoomState ((ChatroomState -> ServiceHandler ChatroomService (Maybe ()))
 -> ServiceHandler ChatroomService ())
-> (ChatroomState -> ServiceHandler ChatroomService (Maybe ()))
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ \ChatroomState
roomState ->
                Maybe Chatroom
-> (Chatroom -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService (Maybe ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
roomState) ((Chatroom -> ServiceHandler ChatroomService ())
 -> ServiceHandler ChatroomService (Maybe ()))
-> (Chatroom -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService (Maybe ())
forall a b. (a -> b) -> a -> b
$ \Chatroom
room -> do
                    let leastRoot :: Stored (Signed ChatroomData)
leastRoot = [Stored (Signed ChatroomData)] -> Stored (Signed ChatroomData)
forall a. HasCallStack => [a] -> a
head ([Stored (Signed ChatroomData)] -> Stored (Signed ChatroomData))
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> Stored (Signed ChatroomData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)])
-> [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)]
forall a. Storable a => Stored a -> [Stored a]
storedRoots ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom -> Stored (Signed ChatroomData))
-> Chatroom -> Stored (Signed ChatroomData)
forall a b. (a -> b) -> a -> b
$ Chatroom
room
                    (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
ps -> ServiceState ChatroomService
ps { psSubscribedTo = leastRoot : psSubscribedTo ps }
                    ChatroomService -> ServiceHandler ChatroomService ()
forall s. Service s => s -> ServiceHandler s ()
replyPacket ChatroomService
emptyPacket
                        { chatRoomMessage = roomStateMessageData roomState
                        }

        [Stored (Signed ChatroomData)]
-> (Stored (Signed ChatroomData)
    -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stored (Signed ChatroomData)]
chatRoomUnsubscribe ((Stored (Signed ChatroomData)
  -> ServiceHandler ChatroomService ())
 -> ServiceHandler ChatroomService ())
-> (Stored (Signed ChatroomData)
    -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ \Stored (Signed ChatroomData)
unsubscribeData -> do
            Maybe ChatroomState
mbRoomState <- Stored (Signed ChatroomData)
-> ServiceHandler ChatroomService (Maybe ChatroomState)
forall (m :: * -> *).
MonadHead LocalState m =>
Stored (Signed ChatroomData) -> m (Maybe ChatroomState)
findChatroomByRoomData Stored (Signed ChatroomData)
unsubscribeData
            Maybe Chatroom
-> (Chatroom -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe ChatroomState
mbRoomState Maybe ChatroomState
-> (ChatroomState -> Maybe Chatroom) -> Maybe Chatroom
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChatroomState -> Maybe Chatroom
roomStateRoom) ((Chatroom -> ServiceHandler ChatroomService ())
 -> ServiceHandler ChatroomService ())
-> (Chatroom -> ServiceHandler ChatroomService ())
-> ServiceHandler ChatroomService ()
forall a b. (a -> b) -> a -> b
$ \Chatroom
room -> do
                let leastRoot :: Stored (Signed ChatroomData)
leastRoot = [Stored (Signed ChatroomData)] -> Stored (Signed ChatroomData)
forall a. HasCallStack => [a] -> a
head ([Stored (Signed ChatroomData)] -> Stored (Signed ChatroomData))
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> Stored (Signed ChatroomData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)])
-> [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)]
forall a. Storable a => Stored a -> [Stored a]
storedRoots ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom -> Stored (Signed ChatroomData))
-> Chatroom -> Stored (Signed ChatroomData)
forall a b. (a -> b) -> a -> b
$ Chatroom
room
                (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
ps -> ServiceState ChatroomService
ps { psSubscribedTo = filter (/= leastRoot) (psSubscribedTo ps) }

        Bool
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Stored (Signed ChatMessageData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stored (Signed ChatMessageData)]
chatRoomMessage)) (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 ChatMessageData)
-> ServiceHandler ChatroomService (Set ChatroomState)
upd Set ChatroomState
set (Stored (Signed ChatMessageData)
msgData :: Stored (Signed ChatMessageData))
                        | Just ChatMessage
msg <- Stored (Signed ChatMessageData) -> Maybe ChatMessage
validateSingleMessage Stored (Signed ChatMessageData)
msgData = do
                            let roomInfo :: [Stored (Signed ChatroomData)]
roomInfo = ChatMessage -> [Stored (Signed ChatroomData)]
cmsgRoomData ChatMessage
msg
                                currentRoots :: [Stored (Signed ChatroomData)]
currentRoots = [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) -> [Stored (Signed ChatroomData)])
-> [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 (Signed ChatroomData)]
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Maybe Chatroom
-> [Stored (Signed ChatroomData)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Chatroom -> [Stored (Signed ChatroomData)]
roomData (Maybe Chatroom -> [Stored (Signed ChatroomData)])
-> (ChatroomState -> Maybe Chatroom)
-> ChatroomState
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> Maybe Chatroom
roomStateRoom

                            let prevData :: [Stored ChatroomStateData]
prevData = (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
                                prev :: ChatroomState
prev = [Stored (Component ChatroomState)] -> ChatroomState
forall a. Mergeable a => [Stored (Component a)] -> a
mergeSorted [Stored (Component ChatroomState)]
[Stored ChatroomStateData]
prevData
                                prevMessages :: [Stored (Signed ChatMessageData)]
prevMessages = ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
prev
                                messages :: [Stored (Signed ChatMessageData)]
messages = [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatMessageData)]
 -> [Stored (Signed ChatMessageData)])
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ Stored (Signed ChatMessageData)
msgData Stored (Signed ChatMessageData)
-> [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. a -> [a] -> [a]
: [Stored (Signed ChatMessageData)]
prevMessages

                            -- update local state only if subscribed and we got some new messages
                            if ChatroomState -> Bool
roomStateSubscribe ChatroomState
prev Bool -> Bool -> Bool
&& [Stored (Signed ChatMessageData)]
messages [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Stored (Signed ChatMessageData)]
prevMessages
                              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]
prevData
                                    , rsdRoom :: [Stored (Signed ChatroomData)]
rsdRoom = []
                                    , rsdSubscribe :: Maybe Bool
rsdSubscribe = Maybe Bool
forall a. Maybe a
Nothing
                                    , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = [Stored (Signed ChatMessageData)]
messages
                                    }
                                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
                        | Bool
otherwise = 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 ChatMessageData)
 -> ServiceHandler ChatroomService (Set ChatroomState))
-> Set ChatroomState
-> [Stored (Signed ChatMessageData)]
-> 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 ChatMessageData)
-> ServiceHandler ChatroomService (Set ChatroomState)
upd Set ChatroomState
roomSet [Stored (Signed ChatMessageData)]
chatRoomMessage

    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)]
[Stored (Signed ChatroomData)]
psSendRoomUpdates :: PeerState -> Bool
psLastList :: PeerState -> [(Stored ChatroomStateData, ChatroomState)]
psSubscribedTo :: PeerState -> [Stored (Signed ChatroomData)]
psSendRoomUpdates :: Bool
psLastList :: [(Stored ChatroomStateData, ChatroomState)]
psSubscribedTo :: [Stored (Signed ChatroomData)]
..} <- 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
            diff :: [ChatroomSetChange]
diff = [(Stored ChatroomStateData, ChatroomState)]
-> [(Stored ChatroomStateData, ChatroomState)]
-> [ChatroomSetChange]
makeChatroomDiff [(Stored ChatroomStateData, ChatroomState)]
psLastList [(Stored ChatroomStateData, ChatroomState)]
curList

        [Stored (Signed ChatroomData)]
roomUpdates <- ([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 [ChatroomSetChange]
diff ((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
oldroom ChatroomState
room
                    | ChatroomState -> [Stored ChatroomStateData]
roomStateData ChatroomState
oldroom [Stored ChatroomStateData] -> [Stored ChatroomStateData] -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatroomState -> [Stored ChatroomStateData]
roomStateData 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
otherwise -> Maybe [Stored (Signed ChatroomData)]
forall a. Maybe a
Nothing

        ([Stored (Signed ChatroomData)]
subscribe, [Stored (Signed ChatroomData)]
unsubscribe) <- ([Maybe
    [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
 -> ([Stored (Signed ChatroomData)],
     [Stored (Signed ChatroomData)]))
-> ServiceHandler
     ChatroomService
     [Maybe
        [Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
-> ServiceHandler
     ChatroomService
     ([Stored (Signed ChatroomData)], [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 ([Either
   (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
-> ([Stored (Signed ChatroomData)], [Stored (Signed ChatroomData)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either
    (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
 -> ([Stored (Signed ChatroomData)],
     [Stored (Signed ChatroomData)]))
-> ([Maybe
       [Either
          (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
    -> [Either
          (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> [Maybe
      [Either
         (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
-> ([Stored (Signed ChatroomData)], [Stored (Signed ChatroomData)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Either
    (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> ([Maybe
       [Either
          (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
    -> [[Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]])
-> [Maybe
      [Either
         (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe
   [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
-> [[Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
forall a. [Maybe a] -> [a]
catMaybes) (ServiceHandler
   ChatroomService
   [Maybe
      [Either
         (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
 -> ServiceHandler
      ChatroomService
      ([Stored (Signed ChatroomData)], [Stored (Signed ChatroomData)]))
-> ServiceHandler
     ChatroomService
     [Maybe
        [Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
-> ServiceHandler
     ChatroomService
     ([Stored (Signed ChatroomData)], [Stored (Signed ChatroomData)])
forall a b. (a -> b) -> a -> b
$
            [ChatroomSetChange]
-> (ChatroomSetChange
    -> ServiceHandler
         ChatroomService
         (Maybe
            [Either
               (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]))
-> ServiceHandler
     ChatroomService
     [Maybe
        [Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ChatroomSetChange]
diff ((ChatroomSetChange
  -> ServiceHandler
       ChatroomService
       (Maybe
          [Either
             (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]))
 -> ServiceHandler
      ChatroomService
      [Maybe
         [Either
            (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]])
-> (ChatroomSetChange
    -> ServiceHandler
         ChatroomService
         (Maybe
            [Either
               (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]))
-> ServiceHandler
     ChatroomService
     [Maybe
        [Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]]
forall a b. (a -> b) -> a -> b
$ Maybe
  [Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
-> ServiceHandler
     ChatroomService
     (Maybe
        [Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
forall a. a -> ServiceHandler ChatroomService a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
   [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
 -> ServiceHandler
      ChatroomService
      (Maybe
         [Either
            (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]))
-> (ChatroomSetChange
    -> Maybe
         [Either
            (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> ChatroomSetChange
-> ServiceHandler
     ChatroomService
     (Maybe
        [Either
           (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                AddedChatroom ChatroomState
room
                    | ChatroomState -> Bool
roomStateSubscribe ChatroomState
room
                    -> (Stored (Signed ChatroomData)
 -> Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData)))
-> [Stored (Signed ChatroomData)]
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall a b. (a -> b) -> [a] -> [b]
map Stored (Signed ChatroomData)
-> Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))
forall a b. a -> Either a b
Left ([Stored (Signed ChatroomData)]
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> Maybe Chatroom
-> Maybe
     [Either
        (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
room
                RemovedChatroom ChatroomState
oldroom
                    | ChatroomState -> Bool
roomStateSubscribe ChatroomState
oldroom
                    -> (Stored (Signed ChatroomData)
 -> Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData)))
-> [Stored (Signed ChatroomData)]
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall a b. (a -> b) -> [a] -> [b]
map Stored (Signed ChatroomData)
-> Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))
forall a b. b -> Either a b
Right ([Stored (Signed ChatroomData)]
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> Maybe Chatroom
-> Maybe
     [Either
        (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
oldroom
                UpdatedChatroom ChatroomState
oldroom ChatroomState
room
                    | ChatroomState -> Bool
roomStateSubscribe ChatroomState
oldroom Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatroomState -> Bool
roomStateSubscribe ChatroomState
room
                    -> (Stored (Signed ChatroomData)
 -> Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData)))
-> [Stored (Signed ChatroomData)]
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall a b. (a -> b) -> [a] -> [b]
map (if ChatroomState -> Bool
roomStateSubscribe ChatroomState
room then Stored (Signed ChatroomData)
-> Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))
forall a b. a -> Either a b
Left else Stored (Signed ChatroomData)
-> Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))
forall a b. b -> Either a b
Right) ([Stored (Signed ChatroomData)]
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Either
      (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData (Chatroom
 -> [Either
       (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))])
-> Maybe Chatroom
-> Maybe
     [Either
        (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
room
                ChatroomSetChange
_ -> Maybe
  [Either
     (Stored (Signed ChatroomData)) (Stored (Signed ChatroomData))]
forall a. Maybe a
Nothing

        [Stored (Signed ChatMessageData)]
messages <- ([[Stored (Signed ChatMessageData)]]
 -> [Stored (Signed ChatMessageData)])
-> ServiceHandler
     ChatroomService [[Stored (Signed ChatMessageData)]]
-> ServiceHandler ChatroomService [Stored (Signed ChatMessageData)]
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 ChatMessageData)]]
-> [Stored (Signed ChatMessageData)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ServiceHandler ChatroomService [[Stored (Signed ChatMessageData)]]
 -> ServiceHandler
      ChatroomService [Stored (Signed ChatMessageData)])
-> ServiceHandler
     ChatroomService [[Stored (Signed ChatMessageData)]]
-> ServiceHandler ChatroomService [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ do
            let leastRootFor :: Chatroom -> Stored (Signed ChatroomData)
leastRootFor = [Stored (Signed ChatroomData)] -> Stored (Signed ChatroomData)
forall a. HasCallStack => [a] -> a
head ([Stored (Signed ChatroomData)] -> Stored (Signed ChatroomData))
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> Stored (Signed ChatroomData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)])
-> [Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stored (Signed ChatroomData) -> [Stored (Signed ChatroomData)]
forall a. Storable a => Stored a -> [Stored a]
storedRoots ([Stored (Signed ChatroomData)] -> [Stored (Signed ChatroomData)])
-> (Chatroom -> [Stored (Signed ChatroomData)])
-> Chatroom
-> [Stored (Signed ChatroomData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chatroom -> [Stored (Signed ChatroomData)]
roomData
            [ChatroomSetChange]
-> (ChatroomSetChange
    -> ServiceHandler
         ChatroomService [Stored (Signed ChatMessageData)])
-> ServiceHandler
     ChatroomService [[Stored (Signed ChatMessageData)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ChatroomSetChange]
diff ((ChatroomSetChange
  -> ServiceHandler
       ChatroomService [Stored (Signed ChatMessageData)])
 -> ServiceHandler
      ChatroomService [[Stored (Signed ChatMessageData)]])
-> (ChatroomSetChange
    -> ServiceHandler
         ChatroomService [Stored (Signed ChatMessageData)])
-> ServiceHandler
     ChatroomService [[Stored (Signed ChatMessageData)]]
forall a b. (a -> b) -> a -> b
$ [Stored (Signed ChatMessageData)]
-> ServiceHandler ChatroomService [Stored (Signed ChatMessageData)]
forall a. a -> ServiceHandler ChatroomService a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Stored (Signed ChatMessageData)]
 -> ServiceHandler
      ChatroomService [Stored (Signed ChatMessageData)])
-> (ChatroomSetChange -> [Stored (Signed ChatMessageData)])
-> ChatroomSetChange
-> ServiceHandler ChatroomService [Stored (Signed ChatMessageData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                AddedChatroom ChatroomState
rstate
                    | Just Chatroom
room <- ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
rstate
                    , Chatroom -> Stored (Signed ChatroomData)
leastRootFor Chatroom
room 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)]
psSubscribedTo
                    -> ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
rstate
                UpdatedChatroom ChatroomState
oldstate ChatroomState
rstate
                    | Just Chatroom
room <- ChatroomState -> Maybe Chatroom
roomStateRoom ChatroomState
rstate
                    , Chatroom -> Stored (Signed ChatroomData)
leastRootFor Chatroom
room 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)]
psSubscribedTo
                    , ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
oldstate [Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)] -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
rstate
                    -> ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateMessageData ChatroomState
rstate
                ChatroomSetChange
_ -> []

        let packet :: ChatroomService
packet = ChatroomService
emptyPacket
                { chatRoomInfo = roomUpdates
                , chatRoomSubscribe = subscribe
                , chatRoomUnsubscribe = unsubscribe
                , chatRoomMessage = messages
                }

        Bool
-> ServiceHandler ChatroomService ()
-> ServiceHandler ChatroomService ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ChatroomService
packet ChatroomService -> ChatroomService -> Bool
forall a. Eq a => a -> a -> Bool
/= ChatroomService
emptyPacket) (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
packet
        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 }