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

    ChatroomState(..),
    ChatroomStateData(..),
    createChatroom,
    deleteChatroomByStateData,
    updateChatroomByStateData,
    listChatrooms,
    findChatroomByRoomData,
    findChatroomByStateData,
    chatroomSetSubscribe,
    chatroomMembers,
    joinChatroom, joinChatroomByStateData,
    joinChatroomAs, joinChatroomAsByStateData,
    leaveChatroom, leaveChatroomByStateData,
    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.Foldable
import Data.Function
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 = Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
sendRawChatroomMessageByStateData Stored ChatroomStateData
lookupData Maybe UnifiedIdentity
forall a. Maybe a
Nothing Maybe (Stored (Signed ChatMessageData))
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg) Bool
False

sendRawChatroomMessageByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData -> Maybe UnifiedIdentity -> Maybe (Stored (Signed ChatMessageData)) -> Maybe Text -> Bool -> m ()
sendRawChatroomMessageByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
sendRawChatroomMessageByStateData Stored ChatroomStateData
lookupData Maybe UnifiedIdentity
mbIdentity Maybe (Stored (Signed ChatMessageData))
mdReplyTo Maybe Text
mdText Bool
mdLeave = 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
mdFrom <- UnifiedIdentity -> ComposedIdentity
forall (m :: * -> *).
(Foldable m, Applicative m) =>
Identity m -> ComposedIdentity
finalOwner (UnifiedIdentity -> ComposedIdentity)
-> m UnifiedIdentity -> m ComposedIdentity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if
            | Just UnifiedIdentity
identity <- Maybe UnifiedIdentity
mbIdentity -> UnifiedIdentity -> m UnifiedIdentity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnifiedIdentity
identity
            | Just UnifiedIdentity
identity <- ChatroomState -> Maybe UnifiedIdentity
roomStateIdentity ChatroomState
cstate -> UnifiedIdentity -> m UnifiedIdentity
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UnifiedIdentity
identity
            | Bool
otherwise -> LocalState -> UnifiedIdentity
localIdentity (LocalState -> UnifiedIdentity)
-> (Stored LocalState -> LocalState)
-> Stored LocalState
-> UnifiedIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored LocalState -> LocalState
forall a. Stored a -> a
fromStored (Stored LocalState -> UnifiedIdentity)
-> m (Stored LocalState) -> m UnifiedIdentity
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
mdFrom
        ZonedTime
mdTime <- IO ZonedTime -> m ZonedTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
        let 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 []

        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 {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
mdReplyTo :: Maybe (Stored (Signed ChatMessageData))
mdText :: Maybe Text
mdLeave :: Bool
mdFrom :: ComposedIdentity
mdTime :: ZonedTime
mdPrev :: [Stored (Signed ChatMessageData)]
mdRoom :: [Stored (Signed ChatroomData)]
..}
        [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
emptyChatroomStateData
            { rsdPrev = roomStateData cstate
            , rsdSubscribe = Just (not mdLeave)
            , rsdIdentity = mbIdentity
            , rsdMessages = [ mdata ]
            }


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

emptyChatroomStateData :: ChatroomStateData
emptyChatroomStateData :: ChatroomStateData
emptyChatroomStateData = ChatroomStateData
    { rsdPrev :: [Stored ChatroomStateData]
rsdPrev = []
    , rsdRoom :: [Stored (Signed ChatroomData)]
rsdRoom = []
    , rsdDelete :: Bool
rsdDelete = Bool
False
    , rsdSubscribe :: Maybe Bool
rsdSubscribe = Maybe Bool
forall a. Maybe a
Nothing
    , rsdIdentity :: Maybe UnifiedIdentity
rsdIdentity = Maybe UnifiedIdentity
forall a. Maybe a
Nothing
    , rsdMessages :: [Stored (Signed ChatMessageData)]
rsdMessages = []
    }

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
roomStateDeleted :: Bool
    , ChatroomState -> Bool
roomStateSubscribe :: Bool
    , ChatroomState -> Maybe UnifiedIdentity
roomStateIdentity :: Maybe UnifiedIdentity
    , ChatroomState -> [ChatMessage]
roomStateMessages :: [ChatMessage]
    }

instance Storable ChatroomStateData where
    store' :: ChatroomStateData -> Store
store' ChatroomStateData {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
Maybe Bool
Maybe UnifiedIdentity
rsdPrev :: ChatroomStateData -> [Stored ChatroomStateData]
rsdSubscribe :: ChatroomStateData -> Maybe Bool
rsdIdentity :: ChatroomStateData -> Maybe UnifiedIdentity
rsdMessages :: ChatroomStateData -> [Stored (Signed ChatMessageData)]
rsdRoom :: ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdDelete :: ChatroomStateData -> Bool
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdDelete :: Bool
rsdSubscribe :: Maybe Bool
rsdIdentity :: Maybe UnifiedIdentity
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"
        Bool -> StoreRec c -> StoreRec c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when  Bool
rsdDelete (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
"delete"
        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
        Maybe UnifiedIdentity
-> (UnifiedIdentity -> StoreRec c) -> StoreRec c
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe UnifiedIdentity
rsdIdentity ((UnifiedIdentity -> StoreRec c) -> StoreRec c)
-> (UnifiedIdentity -> StoreRec c) -> StoreRec c
forall a b. (a -> b) -> a -> b
$ String -> Stored (Signed ExtendedIdentityData) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
String -> a -> StoreRec c
storeRef String
"id" (Stored (Signed ExtendedIdentityData) -> StoreRec c)
-> (UnifiedIdentity -> Stored (Signed ExtendedIdentityData))
-> UnifiedIdentity
-> StoreRec c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnifiedIdentity -> Stored (Signed ExtendedIdentityData)
idExtData
        [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"
        Bool
rsdDelete <- 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
"delete"
        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"
        Maybe UnifiedIdentity
rsdIdentity <- String -> LoadRec (Maybe UnifiedIdentity)
loadMbUnifiedIdentity String
"id"
        [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 {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
Maybe Bool
Maybe UnifiedIdentity
rsdPrev :: [Stored ChatroomStateData]
rsdSubscribe :: Maybe Bool
rsdIdentity :: Maybe UnifiedIdentity
rsdMessages :: [Stored (Signed ChatMessageData)]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdDelete :: Bool
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdDelete :: Bool
rsdSubscribe :: Maybe Bool
rsdIdentity :: Maybe UnifiedIdentity
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 {Bool
[Stored (Signed ChatMessageData)]
[Stored (Signed ChatroomData)]
[Stored ChatroomStateData]
Maybe Bool
Maybe UnifiedIdentity
rsdPrev :: ChatroomStateData -> [Stored ChatroomStateData]
rsdSubscribe :: ChatroomStateData -> Maybe Bool
rsdIdentity :: ChatroomStateData -> Maybe UnifiedIdentity
rsdMessages :: ChatroomStateData -> [Stored (Signed ChatMessageData)]
rsdRoom :: ChatroomStateData -> [Stored (Signed ChatroomData)]
rsdDelete :: ChatroomStateData -> Bool
rsdPrev :: [Stored ChatroomStateData]
rsdRoom :: [Stored (Signed ChatroomData)]
rsdDelete :: Bool
rsdSubscribe :: Maybe Bool
rsdIdentity :: Maybe UnifiedIdentity
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
            roomStateDeleted :: Bool
roomStateDeleted = (Stored ChatroomStateData -> Bool)
-> [Stored ChatroomStateData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ChatroomStateData -> Bool
rsdDelete (ChatroomStateData -> Bool)
-> (Stored ChatroomStateData -> ChatroomStateData)
-> Stored ChatroomStateData
-> Bool
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
            roomStateSubscribe :: Bool
roomStateSubscribe = Bool -> Bool
not Bool
roomStateDeleted Bool -> Bool -> Bool
&& (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)
            roomStateIdentity :: Maybe UnifiedIdentity
roomStateIdentity = (ChatroomStateData -> Maybe UnifiedIdentity)
-> [Stored ChatroomStateData] -> Maybe UnifiedIdentity
forall a b. Storable a => (a -> Maybe b) -> [Stored a] -> Maybe b
findPropertyFirst ChatroomStateData -> Maybe UnifiedIdentity
rsdIdentity [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 UnifiedIdentity
Maybe Chatroom
roomStateData :: [Stored ChatroomStateData]
roomStateIdentity :: Maybe UnifiedIdentity
roomStateMessageData :: [Stored (Signed ChatMessageData)]
roomStateRoom :: Maybe Chatroom
roomStateDeleted :: Bool
roomStateSubscribe :: Bool
roomStateMessages :: [ChatMessage]
roomStateData :: [Stored (Component ChatroomState)]
roomStateRoom :: Maybe Chatroom
roomStateMessageData :: [Stored (Signed ChatMessageData)]
roomStateDeleted :: Bool
roomStateSubscribe :: Bool
roomStateIdentity :: Maybe UnifiedIdentity
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
emptyChatroomStateData
        { rsdRoom = [ rdata ]
        , rsdSubscribe = Just True
        }

    (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)

deleteChatroomByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData -> m ()
deleteChatroomByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> m ()
deleteChatroomByStateData Stored ChatroomStateData
lookupData = 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
emptyChatroomStateData
            { rsdPrev = roomStateData cstate
            , rsdDelete = True
            }

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
emptyChatroomStateData
            { rsdPrev = roomStateData cstate
            , rsdRoom = [ rdata ]
            , rsdSubscribe = Just True
            }


listChatrooms :: MonadHead LocalState m => m [ChatroomState]
listChatrooms :: forall (m :: * -> *). MonadHead LocalState m => m [ChatroomState]
listChatrooms = (ChatroomState -> Bool) -> [ChatroomState] -> [ChatroomState]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ChatroomState -> Bool) -> ChatroomState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> Bool
roomStateDeleted) ([ChatroomState] -> [ChatroomState])
-> (Stored LocalState -> [ChatroomState])
-> Stored LocalState
-> [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 -> 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
emptyChatroomStateData
            { rsdPrev = roomStateData cstate
            , rsdSubscribe = Just subscribe
            }

chatroomMembers :: ChatroomState -> [ ComposedIdentity ]
chatroomMembers :: ChatroomState -> [ComposedIdentity]
chatroomMembers ChatroomState {Bool
[Stored (Signed ChatMessageData)]
[Stored ChatroomStateData]
[ChatMessage]
Maybe UnifiedIdentity
Maybe Chatroom
roomStateData :: ChatroomState -> [Stored ChatroomStateData]
roomStateIdentity :: ChatroomState -> Maybe UnifiedIdentity
roomStateMessageData :: ChatroomState -> [Stored (Signed ChatMessageData)]
roomStateRoom :: ChatroomState -> Maybe Chatroom
roomStateDeleted :: ChatroomState -> Bool
roomStateSubscribe :: ChatroomState -> Bool
roomStateMessages :: ChatroomState -> [ChatMessage]
roomStateData :: [Stored ChatroomStateData]
roomStateRoom :: Maybe Chatroom
roomStateMessageData :: [Stored (Signed ChatMessageData)]
roomStateDeleted :: Bool
roomStateSubscribe :: Bool
roomStateIdentity :: Maybe UnifiedIdentity
roomStateMessages :: [ChatMessage]
..} =
    ([Stored (Signed ChatMessageData)] -> ComposedIdentity)
-> [[Stored (Signed ChatMessageData)]] -> [ComposedIdentity]
forall a b. (a -> b) -> [a] -> [b]
map (ChatMessageData -> ComposedIdentity
mdFrom (ChatMessageData -> ComposedIdentity)
-> ([Stored (Signed ChatMessageData)] -> ChatMessageData)
-> [Stored (Signed ChatMessageData)]
-> 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)
-> ([Stored (Signed ChatMessageData)]
    -> Stored (Signed ChatMessageData))
-> [Stored (Signed ChatMessageData)]
-> ChatMessageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored (Signed ChatMessageData)]
-> Stored (Signed ChatMessageData)
forall a. HasCallStack => [a] -> a
head) ([[Stored (Signed ChatMessageData)]] -> [ComposedIdentity])
-> [[Stored (Signed ChatMessageData)]] -> [ComposedIdentity]
forall a b. (a -> b) -> a -> b
$
    ([Stored (Signed ChatMessageData)] -> Bool)
-> [[Stored (Signed ChatMessageData)]]
-> [[Stored (Signed ChatMessageData)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Stored (Signed ChatMessageData) -> Bool)
-> [Stored (Signed ChatMessageData)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Stored (Signed ChatMessageData) -> Bool)
 -> [Stored (Signed ChatMessageData)] -> Bool)
-> (Stored (Signed ChatMessageData) -> Bool)
-> [Stored (Signed ChatMessageData)]
-> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool)
-> (Stored (Signed ChatMessageData) -> Bool)
-> Stored (Signed ChatMessageData)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessageData -> Bool
mdLeave (ChatMessageData -> Bool)
-> (Stored (Signed ChatMessageData) -> ChatMessageData)
-> Stored (Signed ChatMessageData)
-> 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)]]
 -> [[Stored (Signed ChatMessageData)]])
-> [[Stored (Signed ChatMessageData)]]
-> [[Stored (Signed ChatMessageData)]]
forall a b. (a -> b) -> a -> b
$ -- keep only users that hasn't left
    ([(Stored (Signed IdentityData), Stored (Signed ChatMessageData))]
 -> [Stored (Signed ChatMessageData)])
-> [[(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))]]
-> [[Stored (Signed ChatMessageData)]]
forall a b. (a -> b) -> [a] -> [b]
map ([Stored (Signed ChatMessageData)]
-> [Stored (Signed ChatMessageData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed ChatMessageData)]
 -> [Stored (Signed ChatMessageData)])
-> ([(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))]
    -> [Stored (Signed ChatMessageData)])
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
-> [Stored (Signed ChatMessageData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Stored (Signed IdentityData), Stored (Signed ChatMessageData))
 -> Stored (Signed ChatMessageData))
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> [a] -> [b]
map (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> Stored (Signed ChatMessageData)
forall a b. (a, b) -> b
snd) ([[(Stored (Signed IdentityData),
    Stored (Signed ChatMessageData))]]
 -> [[Stored (Signed ChatMessageData)]])
-> [[(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))]]
-> [[Stored (Signed ChatMessageData)]]
forall a b. (a -> b) -> a -> b
$ -- gather message data per each identity and filter ancestors
    ((Stored (Signed IdentityData), Stored (Signed ChatMessageData))
 -> (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
 -> Bool)
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
-> [[(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Stored (Signed IdentityData)
-> Stored (Signed IdentityData) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Stored (Signed IdentityData)
 -> Stored (Signed IdentityData) -> Bool)
-> ((Stored (Signed IdentityData), Stored (Signed ChatMessageData))
    -> Stored (Signed IdentityData))
-> (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> Stored (Signed IdentityData)
forall a b. (a, b) -> a
fst) ([(Stored (Signed IdentityData), Stored (Signed ChatMessageData))]
 -> [[(Stored (Signed IdentityData),
       Stored (Signed ChatMessageData))]])
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
-> [[(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))]]
forall a b. (a -> b) -> a -> b
$ -- group on identity root
    ((Stored (Signed IdentityData), Stored (Signed ChatMessageData))
 -> (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
 -> Ordering)
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Stored (Signed IdentityData), Stored (Signed ChatMessageData))
 -> Stored (Signed IdentityData))
-> (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Stored (Signed IdentityData), Stored (Signed ChatMessageData))
-> Stored (Signed IdentityData)
forall a b. (a, b) -> a
fst) ([(Stored (Signed IdentityData), Stored (Signed ChatMessageData))]
 -> [(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))])
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
forall a b. (a -> b) -> a -> b
$ -- sort by first root of identity data
    (Stored (Signed ChatMessageData)
 -> (Stored (Signed IdentityData), Stored (Signed ChatMessageData)))
-> [Stored (Signed ChatMessageData)]
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
forall a b. (a -> b) -> [a] -> [b]
map (\Stored (Signed ChatMessageData)
x -> ( [Stored (Signed IdentityData)] -> Stored (Signed IdentityData)
forall a. HasCallStack => [a] -> a
head ([Stored (Signed IdentityData)] -> Stored (Signed IdentityData))
-> (Stored (Signed ChatMessageData)
    -> [Stored (Signed IdentityData)])
-> Stored (Signed ChatMessageData)
-> Stored (Signed IdentityData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stored (Signed IdentityData)] -> [Stored (Signed IdentityData)]
forall a. Storable a => [Stored a] -> [Stored a]
filterAncestors ([Stored (Signed IdentityData)] -> [Stored (Signed IdentityData)])
-> (Stored (Signed ChatMessageData)
    -> [Stored (Signed IdentityData)])
-> Stored (Signed ChatMessageData)
-> [Stored (Signed IdentityData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stored (Signed IdentityData) -> [Stored (Signed IdentityData)])
-> [Stored (Signed IdentityData)] -> [Stored (Signed IdentityData)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stored (Signed IdentityData) -> [Stored (Signed IdentityData)]
forall a. Storable a => Stored a -> [Stored a]
storedRoots ([Stored (Signed IdentityData)] -> [Stored (Signed IdentityData)])
-> (Stored (Signed ChatMessageData)
    -> [Stored (Signed IdentityData)])
-> Stored (Signed ChatMessageData)
-> [Stored (Signed IdentityData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposedIdentity -> [Stored (Signed IdentityData)]
forall (m :: * -> *).
Identity m -> m (Stored (Signed IdentityData))
idDataF (ComposedIdentity -> [Stored (Signed IdentityData)])
-> (Stored (Signed ChatMessageData) -> ComposedIdentity)
-> Stored (Signed ChatMessageData)
-> [Stored (Signed IdentityData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessageData -> ComposedIdentity
mdFrom (ChatMessageData -> ComposedIdentity)
-> (Stored (Signed ChatMessageData) -> ChatMessageData)
-> Stored (Signed ChatMessageData)
-> 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) -> Stored (Signed IdentityData))
-> Stored (Signed ChatMessageData) -> Stored (Signed IdentityData)
forall a b. (a -> b) -> a -> b
$ Stored (Signed ChatMessageData)
x, Stored (Signed ChatMessageData)
x )) ([Stored (Signed ChatMessageData)]
 -> [(Stored (Signed IdentityData),
      Stored (Signed ChatMessageData))])
-> [Stored (Signed ChatMessageData)]
-> [(Stored (Signed IdentityData),
     Stored (Signed ChatMessageData))]
forall a b. (a -> b) -> a -> b
$
    Set (Stored (Signed ChatMessageData))
-> [Stored (Signed ChatMessageData)]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (Stored (Signed ChatMessageData))
 -> [Stored (Signed ChatMessageData)])
-> Set (Stored (Signed ChatMessageData))
-> [Stored (Signed ChatMessageData)]
forall a b. (a -> b) -> a -> b
$ [Stored (Signed ChatMessageData)]
-> Set (Stored (Signed ChatMessageData))
forall a. Storable a => [Stored a] -> Set (Stored a)
ancestors ([Stored (Signed ChatMessageData)]
 -> Set (Stored (Signed ChatMessageData)))
-> [Stored (Signed ChatMessageData)]
-> Set (Stored (Signed ChatMessageData))
forall a b. (a -> b) -> a -> b
$ [Stored (Signed ChatMessageData)]
roomStateMessageData

joinChatroom
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => ChatroomState -> m ()
joinChatroom :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
ChatroomState -> m ()
joinChatroom ChatroomState
rstate = Stored ChatroomStateData -> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> m ()
joinChatroomByStateData ([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)

joinChatroomByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData -> m ()
joinChatroomByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> m ()
joinChatroomByStateData Stored ChatroomStateData
lookupData = Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
sendRawChatroomMessageByStateData Stored ChatroomStateData
lookupData Maybe UnifiedIdentity
forall a. Maybe a
Nothing Maybe (Stored (Signed ChatMessageData))
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False

joinChatroomAs
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => UnifiedIdentity -> ChatroomState -> m ()
joinChatroomAs :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
UnifiedIdentity -> ChatroomState -> m ()
joinChatroomAs UnifiedIdentity
identity ChatroomState
rstate = UnifiedIdentity -> Stored ChatroomStateData -> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
UnifiedIdentity -> Stored ChatroomStateData -> m ()
joinChatroomAsByStateData UnifiedIdentity
identity ([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)

joinChatroomAsByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => UnifiedIdentity -> Stored ChatroomStateData -> m ()
joinChatroomAsByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
UnifiedIdentity -> Stored ChatroomStateData -> m ()
joinChatroomAsByStateData UnifiedIdentity
identity Stored ChatroomStateData
lookupData = Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
sendRawChatroomMessageByStateData Stored ChatroomStateData
lookupData (UnifiedIdentity -> Maybe UnifiedIdentity
forall a. a -> Maybe a
Just UnifiedIdentity
identity) Maybe (Stored (Signed ChatMessageData))
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False

leaveChatroom
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => ChatroomState -> m ()
leaveChatroom :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
ChatroomState -> m ()
leaveChatroom ChatroomState
rstate = Stored ChatroomStateData -> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> m ()
leaveChatroomByStateData ([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)

leaveChatroomByStateData
    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
    => Stored ChatroomStateData -> m ()
leaveChatroomByStateData :: forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData -> m ()
leaveChatroomByStateData Stored ChatroomStateData
lookupData = Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
forall (m :: * -> *).
(MonadStorage m, MonadHead LocalState m, MonadError String m) =>
Stored ChatroomStateData
-> Maybe UnifiedIdentity
-> Maybe (Stored (Signed ChatMessageData))
-> Maybe Text
-> Bool
-> m ()
sendRawChatroomMessageByStateData Stored ChatroomStateData
lookupData Maybe UnifiedIdentity
forall a. Maybe a
Nothing Maybe (Stored (Signed ChatMessageData))
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
True

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 -> Bool) -> [ChatroomState] -> [ChatroomState]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ChatroomState -> Bool) -> ChatroomState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatroomState -> Bool
roomStateDeleted) ([ChatroomState] -> [ChatroomState])
-> (Set ChatroomState -> [ChatroomState])
-> Set ChatroomState
-> [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
emptyChatroomStateData
                                { rsdPrev = prev
                                , rsdRoom = room
                                }
                            Stored (Component ChatroomState)
-> Set ChatroomState
-> ServiceHandler ChatroomService (Set ChatroomState)
forall a (m :: * -> *).
(Mergeable a, MonadStorage m, MonadIO m) =>
Stored (Component a) -> Set a -> m (Set a)
storeSetAddComponent Stored (Component ChatroomState)
Stored ChatroomStateData
sdata Set ChatroomState
set
                          else Set ChatroomState
-> ServiceHandler ChatroomService (Set ChatroomState)
forall a. a -> ServiceHandler ChatroomService a
forall (m :: * -> *) a. Monad m => a -> m a
return Set ChatroomState
set
                (Set ChatroomState
 -> Stored (Signed ChatroomData)
 -> ServiceHandler ChatroomService (Set ChatroomState))
-> Set ChatroomState
-> [Stored (Signed ChatroomData)]
-> ServiceHandler ChatroomService (Set ChatroomState)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Set ChatroomState
-> Stored (Signed ChatroomData)
-> ServiceHandler ChatroomService (Set ChatroomState)
upd Set ChatroomState
roomSet [Stored (Signed ChatroomData)]
chatRoomInfo

        [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
emptyChatroomStateData
                                    { rsdPrev = prevData
                                    , rsdMessages = 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 }