diff options
author | Joe Crayne <joe@jerkface.net> | 2018-11-25 02:19:42 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-12-16 14:08:26 -0500 |
commit | dfcab14e4d593f6a51db3fa5cf61f0358dc0f280 (patch) | |
tree | 890436b311db227ace6f5d5a8f4f461241e7bf66 /src/Data | |
parent | b9d58803bafb2ae283c866df156e5422f58d6278 (diff) |
group chat invite message.
Diffstat (limited to 'src/Data')
-rw-r--r-- | src/Data/Tox/Msg.hs | 85 |
1 files changed, 71 insertions, 14 deletions
diff --git a/src/Data/Tox/Msg.hs b/src/Data/Tox/Msg.hs index 84fffb12..d42b092b 100644 --- a/src/Data/Tox/Msg.hs +++ b/src/Data/Tox/Msg.hs | |||
@@ -1,28 +1,32 @@ | |||
1 | {-# LANGUAGE DataKinds #-} | 1 | {-# LANGUAGE DataKinds #-} |
2 | {-# LANGUAGE DefaultSignatures #-} | 2 | {-# LANGUAGE DefaultSignatures #-} |
3 | {-# LANGUAGE FlexibleInstances #-} | 3 | {-# LANGUAGE FlexibleInstances #-} |
4 | {-# LANGUAGE GADTs #-} | 4 | {-# LANGUAGE GADTs #-} |
5 | {-# LANGUAGE KindSignatures #-} | 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
6 | {-# LANGUAGE MultiParamTypeClasses #-} | 6 | {-# LANGUAGE KindSignatures #-} |
7 | {-# LANGUAGE PolyKinds #-} | 7 | {-# LANGUAGE MultiParamTypeClasses #-} |
8 | {-# LANGUAGE TypeFamilies #-} | 8 | {-# LANGUAGE PolyKinds #-} |
9 | {-# LANGUAGE StandaloneDeriving #-} | 9 | {-# LANGUAGE StandaloneDeriving #-} |
10 | {-# LANGUAGE TypeFamilies #-} | ||
10 | module Data.Tox.Msg where | 11 | module Data.Tox.Msg where |
11 | 12 | ||
12 | import Data.ByteString as B | 13 | import Data.ByteString as B |
13 | import Data.Dependent.Sum | 14 | import Data.Dependent.Sum |
15 | import Data.Functor.Contravariant | ||
16 | import Data.Functor.Identity | ||
14 | import Data.GADT.Compare | 17 | import Data.GADT.Compare |
15 | import Data.GADT.Show | 18 | import Data.GADT.Show |
16 | import Data.Functor.Identity | 19 | import Data.Monoid |
17 | import Data.Serialize | 20 | import Data.Serialize |
18 | import Data.Text as T | 21 | import Data.Text as T |
19 | import Data.Text.Encoding as T | 22 | import Data.Text.Encoding as T |
20 | import Data.Typeable | 23 | import Data.Typeable |
21 | import Data.Word | 24 | import Data.Word |
22 | import GHC.TypeLits | 25 | import GHC.TypeLits |
23 | 26 | ||
24 | import Crypto.Tox | 27 | import Crypto.Tox |
25 | import Data.PacketBuffer (compressSequenceNumbers, decompressSequenceNumbers) | 28 | import Data.PacketBuffer (compressSequenceNumbers, decompressSequenceNumbers) |
29 | import Network.Tox.NodeId | ||
26 | 30 | ||
27 | newtype Unknown = Unknown B.ByteString deriving (Eq,Show) | 31 | newtype Unknown = Unknown B.ByteString deriving (Eq,Show) |
28 | newtype Padded = Padded B.ByteString deriving (Eq,Show) | 32 | newtype Padded = Padded B.ByteString deriving (Eq,Show) |
@@ -70,7 +74,7 @@ data Msg (n :: Nat) t where | |||
70 | FILE_SENDREQUEST :: Msg 80 Unknown | 74 | FILE_SENDREQUEST :: Msg 80 Unknown |
71 | FILE_CONTROL :: Msg 81 Unknown | 75 | FILE_CONTROL :: Msg 81 Unknown |
72 | FILE_DATA :: Msg 82 Unknown | 76 | FILE_DATA :: Msg 82 Unknown |
73 | INVITE_GROUPCHAT :: Msg 95 Unknown | 77 | INVITE_GROUPCHAT :: Msg 95 Invite |
74 | INVITE_CONFERENCE :: Msg 96 Unknown | 78 | INVITE_CONFERENCE :: Msg 96 Unknown |
75 | ONLINE_PACKET :: Msg 97 Unknown | 79 | ONLINE_PACKET :: Msg 97 Unknown |
76 | DIRECT_CONFERENCE :: Msg 98 Unknown | 80 | DIRECT_CONFERENCE :: Msg 98 Unknown |
@@ -229,3 +233,56 @@ lossyness m = case msgbyte m of | |||
229 | | 192 <= x, x < 255 -> Lossy | 233 | | 192 <= x, x < 255 -> Lossy |
230 | | otherwise -> Lossless | 234 | | otherwise -> Lossless |
231 | 235 | ||
236 | |||
237 | newtype ChatID = ChatID Nonce32 | ||
238 | deriving (Eq,Show,Serialize,Sized) | ||
239 | |||
240 | data InviteType = GroupInvite { groupName :: Text } | ||
241 | | AccptedInvite | ||
242 | | ConfirmedInvite { inviteNodes :: [NodeInfo] } | ||
243 | deriving (Eq,Show) | ||
244 | |||
245 | instance Sized InviteType where | ||
246 | size = VarSize $ \x -> case x of | ||
247 | GroupInvite name -> B.length (T.encodeUtf8 name) | ||
248 | AccptedInvite -> 0 | ||
249 | ConfirmedInvite ns -> 0 -- TODO: size of node list. | ||
250 | |||
251 | data Invite = Invite | ||
252 | { inviteChatID :: ChatID | ||
253 | , inviteChatKey :: PublicKey | ||
254 | , invite :: InviteType | ||
255 | } | ||
256 | deriving (Eq,Show) | ||
257 | |||
258 | instance Sized Invite where | ||
259 | size = contramap inviteChatID size | ||
260 | <> contramap (key2id . inviteChatKey) size | ||
261 | <> contramap invite size | ||
262 | |||
263 | instance Serialize Invite where | ||
264 | get = do | ||
265 | group_packet_id <- getWord8 -- expecting 254=GP_FRIEND_INVITE | ||
266 | invite_type <- getWord8 | ||
267 | chatid <- get | ||
268 | chatkey <- id2key <$> get | ||
269 | Invite chatid chatkey <$> case invite_type of | ||
270 | 0 -> do bs <- remaining >>= getBytes -- TODO: size can be determined from group shared state. | ||
271 | return $ GroupInvite $ decodeUtf8 bs | ||
272 | 1 -> return AccptedInvite | ||
273 | 2 -> return $ ConfirmedInvite [] -- TODO: decode nodes | ||
274 | |||
275 | put x = do | ||
276 | putWord8 254 -- GP_FRIEND_INVITE | ||
277 | putWord8 $ case invite x of | ||
278 | GroupInvite {} -> 0 -- GROUP_INVITE | ||
279 | AccptedInvite -> 1 -- GROUP_INVITE_ACCEPTED | ||
280 | ConfirmedInvite {} -> 2 -- GROUP_INVITE_CONFIRMATION | ||
281 | put $ inviteChatID x | ||
282 | put $ key2id $ inviteChatKey x | ||
283 | case invite x of | ||
284 | GroupInvite name -> putByteString $ encodeUtf8 name | ||
285 | AccptedInvite -> return () | ||
286 | ConfirmedInvite ns -> return () -- TODO: encode nodes. | ||
287 | |||
288 | instance Packet Invite where | ||