From 2b58ed1338b2518e8f5ced87b43d6bbf35e0fa8f Mon Sep 17 00:00:00 2001 From: James Crayne Date: Fri, 3 Nov 2017 00:06:14 +0000 Subject: GrpMsg should have lossyness field --- src/Network/Tox/Crypto/Transport.hs | 43 +++++++++++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 9 deletions(-) (limited to 'src') 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 -- cgit v1.2.3