GrpMsg should have lossyness field

1 files changed, 34 insertions, 9 deletions

diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 8739c853..1e9156c6 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -403,15 +403,37 @@ instance HasMessageName CryptoMessage where
 messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x)
 messageName = lens getMessageName setMessageName
 
+data KnownLossyness = KnownLossy | KnownLossless
+    deriving (Eq,Ord,Show,Enum)
+
 data MessageType = Msg MessageID
-                 | GrpMsg MessageName
+                 | GrpMsg KnownLossyness MessageName
     deriving (Eq,Show)
 
+class AsWord16 a where
+   toWord16 :: a -> Word16
+   fromWord16 :: Word16 -> a
+
+toEnum8 ::Enum a => Word8 -> a
+toEnum8 = toEnum . fromIntegral
+fromEnum16 :: Enum a => a -> Word16
+fromEnum16 = fromIntegral . fromEnum
+
+instance AsWord16 MessageType where
+    toWord16 (Msg msgID) = fromIntegral (fromIntegral (fromEnum16 msgID) :: Word8)
+    toWord16 (GrpMsg lsy msgName) = 256 * (fromEnum16 lsy + 1) + fromIntegral (fromIntegral (fromEnum msgName) :: Word8)
+    fromWord16 x | x < 256 = Msg (toEnum $ fromIntegral x)
+    fromWord16 x           = GrpMsg (toEnum8 ((fromIntegral (x `div` 256)) - 1)) (toEnum8 (fromIntegral x :: Word8))
+
+word16 :: (Functor f, AsWord16 x) => (Word16 -> f Word16) -> (x -> f x)
+word16  = lens toWord16 (\_ x -> fromWord16 x)
+
 instance Ord MessageType where
     compare (Msg x) (Msg y) = compare x y
-    compare (GrpMsg x) (GrpMsg y) = compare x y
-    compare (Msg _) (GrpMsg _) = LT
-    compare (GrpMsg _) (Msg _) = GT
+    compare (GrpMsg lx x) (GrpMsg ly y) = let r1 = compare lx ly
+                                              in if r1==EQ then compare x y else r1
+    compare (Msg _) (GrpMsg _ _) = LT
+    compare (GrpMsg _ _) (Msg _) = GT
 
 class HasMessageType x where
     getMessageType :: x -> MessageType
@@ -420,13 +442,16 @@ class HasMessageType x where
 instance HasMessageType CryptoMessage where
     getMessageType (OneByte mid) = Msg mid
     getMessageType (TwoByte mid _) = Msg mid
-    getMessageType m@(UpToN mid _) | isIndirectGrpChat mid = GrpMsg (getMessageName m)
+    getMessageType m@(UpToN MESSAGE_GROUPCHAT _) = GrpMsg KnownLossless (getMessageName m)
+    getMessageType m@(UpToN LOSSY_GROUPCHAT   _) = GrpMsg KnownLossy    (getMessageName m)
     getMessageType (UpToN mid _) = Msg mid
 
-    setMessageType m@(UpToN mid _) (GrpMsg mname) | isIndirectGrpChat mid = setMessageName m mname
-    setMessageType (OneByte _   ) (GrpMsg mname) = setMessageName (UpToN MESSAGE_GROUPCHAT B.empty        ) mname
-    setMessageType (TwoByte  _ x) (GrpMsg mname) = setMessageName (UpToN MESSAGE_GROUPCHAT (B.singleton x)) mname
-    setMessageType (UpToN _ x) (GrpMsg mname) = setMessageName (UpToN MESSAGE_GROUPCHAT x) mname
+    setMessageType (OneByte _   ) (GrpMsg KnownLossless mname) = setMessageName (UpToN MESSAGE_GROUPCHAT B.empty        ) mname
+    setMessageType (TwoByte  _ x) (GrpMsg KnownLossless mname) = setMessageName (UpToN MESSAGE_GROUPCHAT (B.singleton x)) mname
+    setMessageType (OneByte _   ) (GrpMsg KnownLossy    mname) = setMessageName (UpToN LOSSY_GROUPCHAT B.empty        ) mname
+    setMessageType (TwoByte  _ x) (GrpMsg KnownLossy    mname) = setMessageName (UpToN LOSSY_GROUPCHAT (B.singleton x)) mname
+    setMessageType (UpToN _ x) (GrpMsg KnownLossless mname) = setMessageName (UpToN MESSAGE_GROUPCHAT x) mname
+    setMessageType (UpToN _ x) (GrpMsg KnownLossy    mname) = setMessageName (UpToN LOSSY_GROUPCHAT   x) mname
     setMessageType m (Msg mid) | Just (True,1) <- msgSizeParam mid = OneByte mid
     setMessageType (OneByte mid0  ) (Msg mid) | Just (True,2) <- msgSizeParam mid = TwoByte mid 0 
     setMessageType (TwoByte mid0 x) (Msg mid) | Just (True,2) <- msgSizeParam mid = TwoByte mid x