summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Crypto/Tox.hs16
-rw-r--r--src/Network/Tox.hs4
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs103
-rw-r--r--src/Network/Tox/Crypto/Transport.hs46
4 files changed, 150 insertions, 19 deletions
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index a25f9f4f..9f86f6a4 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -7,7 +7,7 @@
7{-# LANGUAGE DeriveTraversable #-} 7{-# LANGUAGE DeriveTraversable #-}
8{-# LANGUAGE ExplicitNamespaces #-} 8{-# LANGUAGE ExplicitNamespaces #-}
9{-# LANGUAGE TypeOperators #-} 9{-# LANGUAGE TypeOperators #-}
10{-# LANGUAGE MagicHash, UnboxedTuples #-} 10{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns #-}
11module Crypto.Tox 11module Crypto.Tox
12 ( PublicKey 12 ( PublicKey
13 , publicKey 13 , publicKey
@@ -35,6 +35,7 @@ module Crypto.Tox
35 , Nonce8(..) 35 , Nonce8(..)
36 , Nonce24(..) 36 , Nonce24(..)
37 , incrementNonce24 37 , incrementNonce24
38 , addtoNonce24
38 , Nonce32(..) 39 , Nonce32(..)
39 , getRemainingEncrypted 40 , getRemainingEncrypted
40 , putEncrypted 41 , putEncrypted
@@ -258,17 +259,18 @@ hsalsa20 k n = BA.append a b
258newtype Nonce24 = Nonce24 ByteString 259newtype Nonce24 = Nonce24 ByteString
259 deriving (Eq, Ord, ByteArrayAccess,Data) 260 deriving (Eq, Ord, ByteArrayAccess,Data)
260 261
261incrementNonce24 :: Nonce24 -> IO Nonce24 262addtoNonce24 :: Nonce24 -> Word -> IO Nonce24
262incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init 263addtoNonce24 (Nonce24 n24) n = Nonce24 <$> BA.copy n24 init
263 where 264 where
264 init :: Ptr Word -> IO () 265 init :: Ptr Word -> IO ()
265 init ptr | fitsInInt (Proxy :: Proxy Word64) = do 266 init ptr | fitsInInt (Proxy :: Proxy Word64) = do
266 let frmBE64 = fromIntegral . fromBE64 . fromIntegral 267 let frmBE64 = fromIntegral . fromBE64 . fromIntegral
267 tBE64 = fromIntegral . toBE64 . fromIntegral 268 tBE64 = fromIntegral . toBE64 . fromIntegral
269 !(W# input) = n
268 W# w1 <- frmBE64 <$> peek ptr 270 W# w1 <- frmBE64 <$> peek ptr
269 W# w2 <- frmBE64 <$> peekElemOff ptr 1 271 W# w2 <- frmBE64 <$> peekElemOff ptr 1
270 W# w3 <- frmBE64 <$> peekElemOff ptr 2 272 W# w3 <- frmBE64 <$> peekElemOff ptr 2
271 let (# overflw, sum #) = plusWord2# w3 (int2Word# 1#) 273 let (# overflw, sum #) = plusWord2# w3 input
272 (# overflw', sum' #) = plusWord2# w2 overflw 274 (# overflw', sum' #) = plusWord2# w2 overflw
273 (# discard, sum'' #) = plusWord2# w1 overflw' 275 (# discard, sum'' #) = plusWord2# w1 overflw'
274 poke ptr $ tBE64 (W# sum'') 276 poke ptr $ tBE64 (W# sum'')
@@ -278,13 +280,14 @@ incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init
278 init ptr | fitsInInt (Proxy :: Proxy Word32) = do 280 init ptr | fitsInInt (Proxy :: Proxy Word32) = do
279 let frmBE32 = fromIntegral . fromBE32 . fromIntegral 281 let frmBE32 = fromIntegral . fromBE32 . fromIntegral
280 tBE32 = fromIntegral . toBE32 . fromIntegral 282 tBE32 = fromIntegral . toBE32 . fromIntegral
283 !(W# input) = n
281 W# w1 <- frmBE32 <$> peek ptr 284 W# w1 <- frmBE32 <$> peek ptr
282 W# w2 <- frmBE32 <$> peekElemOff ptr 1 285 W# w2 <- frmBE32 <$> peekElemOff ptr 1
283 W# w3 <- frmBE32 <$> peekElemOff ptr 2 286 W# w3 <- frmBE32 <$> peekElemOff ptr 2
284 W# w4 <- frmBE32 <$> peekElemOff ptr 3 287 W# w4 <- frmBE32 <$> peekElemOff ptr 3
285 W# w5 <- frmBE32 <$> peekElemOff ptr 4 288 W# w5 <- frmBE32 <$> peekElemOff ptr 4
286 W# w6 <- frmBE32 <$> peekElemOff ptr 5 289 W# w6 <- frmBE32 <$> peekElemOff ptr 5
287 let (# overflw_, sum_ #) = plusWord2# w6 (int2Word# 1#) 290 let (# overflw_, sum_ #) = plusWord2# w6 input
288 (# overflw__, sum__ #) = plusWord2# w5 overflw_ 291 (# overflw__, sum__ #) = plusWord2# w5 overflw_
289 (# overflw___, sum___ #) = plusWord2# w6 overflw__ 292 (# overflw___, sum___ #) = plusWord2# w6 overflw__
290 (# overflw, sum #) = plusWord2# w3 overflw___ 293 (# overflw, sum #) = plusWord2# w3 overflw___
@@ -298,6 +301,9 @@ incrementNonce24 (Nonce24 n24) = Nonce24 <$> BA.copy n24 init
298 pokeElemOff ptr 5 $ tBE32 (W# sum_) 301 pokeElemOff ptr 5 $ tBE32 (W# sum_)
299 init _ = error "incrementNonce24: I only support 64 and 32 bits" 302 init _ = error "incrementNonce24: I only support 64 and 32 bits"
300 303
304incrementNonce24 :: Nonce24 -> IO Nonce24
305incrementNonce24 nonce24 = addtoNonce24 nonce24 1
306
301quoted :: ShowS -> ShowS 307quoted :: ShowS -> ShowS
302quoted shows s = '"':shows ('"':s) 308quoted shows s = '"':shows ('"':s)
303 309
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 87835769..2f778874 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -89,7 +89,7 @@ import Crypto.Tox
89import Data.Word64Map (fitsInInt) 89import Data.Word64Map (fitsInInt)
90import qualified Data.Word64Map (empty) 90import qualified Data.Word64Map (empty)
91import Network.Tox.Crypto.Transport (NetCrypto) 91import Network.Tox.Crypto.Transport (NetCrypto)
92import Network.Tox.Crypto.Handlers (newSessionsState, cryptoNetHandler) 92import Network.Tox.Crypto.Handlers (newSessionsState, cryptoNetHandler, cryptoDefaultHooks)
93import qualified Network.Tox.DHT.Handlers as DHT 93import qualified Network.Tox.DHT.Handlers as DHT
94import qualified Network.Tox.DHT.Transport as DHT 94import qualified Network.Tox.DHT.Transport as DHT
95import Network.Tox.NodeId 95import Network.Tox.NodeId
@@ -309,7 +309,7 @@ newTox keydb addr = do
309 (const id) 309 (const id)
310 310
311 roster <- newRoster 311 roster <- newRoster
312 sessionsState <- newSessionsState crypto 312 sessionsState <- newSessionsState crypto cryptoDefaultHooks
313 return Tox 313 return Tox
314 { toxDHT = dhtclient 314 { toxDHT = dhtclient
315 , toxOnion = onionclient 315 , toxOnion = onionclient
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 29f55e54..c5476371 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -12,27 +12,48 @@ import Crypto.Hash
12import Control.Applicative 12import Control.Applicative
13import Control.Monad 13import Control.Monad
14import Data.Time.Clock.POSIX 14import Data.Time.Clock.POSIX
15import qualified Data.ByteString as B
16import Control.Lens
17import Data.Function
18import Data.Serialize as S
19import Data.Word
20import GHC.Conc (unsafeIOToSTM)
21
22-- util, todo: move to another module
23maybeToEither (Just x) = Right x
24maybeToEither Nothing = Left "maybeToEither"
15 25
16data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed 26data NetCryptoSessionStatus = Unaccepted | Accepted | Confirmed
17 deriving (Eq,Ord,Show,Enum) 27 deriving (Eq,Ord,Show,Enum)
18 28
19 29
30type IOHook addr x = addr -> x -> IO (Maybe (x -> x))
31type NetCryptoHook = IOHook SockAddr CryptoData
32
33
20data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus 34data NetCryptoSession = NCrypto { ncState :: TVar NetCryptoSessionStatus
21 , ncTheirPacketNonce:: TVar Nonce24 -- base nonce + packet number 35 , ncTheirBaseNonce :: TVar Nonce24 -- base nonce + packet number
22 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number 36 , ncMyPacketNonce :: TVar Nonce24 -- base nonce + packet number
23 , ncHandShake :: TVar (Maybe (Handshake Encrypted)) 37 , ncHandShake :: TVar (Maybe (Handshake Encrypted))
24 , ncCookie :: TVar (Maybe Cookie) 38 , ncCookie :: TVar (Maybe Cookie)
25 , ncTheirSessionPublic :: Maybe PublicKey 39 , ncTheirSessionPublic :: Maybe PublicKey
26 , ncSessionSecret :: SecretKey 40 , ncSessionSecret :: SecretKey
27 , ncSockAddr :: SockAddr 41 , ncSockAddr :: SockAddr
42 , ncHooks :: TVar (Map.Map MessageType [NetCryptoHook])
28 } 43 }
29 44
30data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession) 45data NetCryptoSessions = NCSessions { netCryptoSessions :: TVar (Map.Map SockAddr NetCryptoSession)
31 , transportCrypto :: TransportCrypto 46 , transportCrypto :: TransportCrypto
47 , defaultHooks :: Map.Map MessageType [NetCryptoHook]
32 } 48 }
33 49
34newSessionsState :: TransportCrypto -> IO NetCryptoSessions 50newSessionsState :: TransportCrypto -> Map.Map MessageType [NetCryptoHook] -> IO NetCryptoSessions
35newSessionsState crypto = error "todo" 51newSessionsState crypto hooks = do
52 x <- atomically $ newTVar Map.empty
53 return NCSessions { netCryptoSessions = x
54 , transportCrypto = crypto
55 , defaultHooks = hooks
56 }
36 57
37data HandshakeParams 58data HandshakeParams
38 = HParam 59 = HParam
@@ -48,6 +69,7 @@ newHandShakeData = error "todo"
48 69
49cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto)) 70cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto))
50cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do 71cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do
72 -- Handle Handshake Message
51 let crypto = transportCrypto sessions 73 let crypto = transportCrypto sessions
52 allsessions = netCryptoSessions sessions 74 allsessions = netCryptoSessions sessions
53 anyRight xs f = foldr1 (<|>) $ map f xs 75 anyRight xs f = foldr1 (<|>) $ map f xs
@@ -81,17 +103,18 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
81 Left _ -> return () 103 Left _ -> return ()
82 Right hp@(HParam 104 Right hp@(HParam
83 { hpTheirBaseNonce = Just theirBaseNonce 105 { hpTheirBaseNonce = Just theirBaseNonce
84 , hpOtherCookie = Just otherCookie 106 , hpOtherCookie = Just otherCookie
85 , hpTheirSessionKeyPublic = theirSessionKey 107 , hpTheirSessionKeyPublic = theirSessionKey
86 , hpMySecretKey = key 108 , hpMySecretKey = key
87 , hpCookieRemotePubkey = remotePublicKey 109 , hpCookieRemotePubkey = remotePublicKey
88 , hpCookieRemoteDhtkey = remoteDhtPublicKey 110 , hpCookieRemoteDhtkey = remoteDhtPublicKey
89 }) -> do 111 }) -> do
90 sessionsmap <- atomically $ readTVar allsessions 112 sessionsmap <- atomically $ readTVar allsessions
113 -- Do a lookup, in case we decide to handle the update case differently
91 case Map.lookup addr sessionsmap of 114 case Map.lookup addr sessionsmap of
92 Nothing -> do -- create new session 115 _ -> do -- create new session
93 ncState0 <- atomically $ newTVar Accepted 116 ncState0 <- atomically $ newTVar Accepted
94 ncTheirPacketNonce0 <- atomically $ newTVar theirBaseNonce 117 ncTheirBaseNonce0 <- atomically $ newTVar theirBaseNonce
95 n24 <- atomically $ transportNewNonce crypto 118 n24 <- atomically $ transportNewNonce crypto
96 let myhandshakeData = newHandShakeData crypto hp 119 let myhandshakeData = newHandShakeData crypto hp
97 plain = encodePlain myhandshakeData 120 plain = encodePlain myhandshakeData
@@ -105,22 +128,78 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
105 ncHandShake0 <- atomically $ newTVar (Just myhandshake) 128 ncHandShake0 <- atomically $ newTVar (Just myhandshake)
106 cookie0 <- atomically $ newTVar (Just otherCookie) 129 cookie0 <- atomically $ newTVar (Just otherCookie)
107 newsession <- generateSecretKey 130 newsession <- generateSecretKey
131 ncHooks0 <- atomically $ newTVar (defaultHooks sessions)
108 let netCryptoSession = 132 let netCryptoSession =
109 NCrypto { ncState = ncState0 133 NCrypto { ncState = ncState0
110 , ncTheirPacketNonce= ncTheirPacketNonce0 134 , ncTheirBaseNonce= ncTheirBaseNonce0
111 , ncMyPacketNonce = ncMyPacketNonce0 135 , ncMyPacketNonce = ncMyPacketNonce0
112 , ncHandShake = ncHandShake0 136 , ncHandShake = ncHandShake0
113 , ncCookie = cookie0 137 , ncCookie = cookie0
114 , ncTheirSessionPublic = Just theirSessionKey 138 , ncTheirSessionPublic = Just theirSessionKey
115 , ncSessionSecret = newsession 139 , ncSessionSecret = newsession
116 , ncSockAddr = addr 140 , ncSockAddr = addr
141 , ncHooks = ncHooks0
117 } 142 }
118 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession) 143 atomically $ modifyTVar allsessions (Map.insert addr netCryptoSession)
119 Just netCryptoSession -> return () -- TODO: UPdate existing session
120 return Nothing 144 return Nothing
121cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do 145cryptoNetHandler sessions addr (NetCrypto (CryptoPacket nonce16 encrypted)) = do
122 let crypto = transportCrypto sessions 146 let crypto = transportCrypto sessions
147 allsessions = netCryptoSessions sessions
148 sessionsmap <- atomically $ readTVar allsessions
123 -- Handle Encrypted Message 149 -- Handle Encrypted Message
124 -- TODO 150 case Map.lookup addr sessionsmap of
125 return Nothing 151 Nothing -> return Nothing -- drop packet, we have no session
126-- cryptoNetHandler _ _ _ = return $ Just id 152 Just (NCrypto {ncState, ncHooks,ncSessionSecret,ncTheirSessionPublic,ncTheirBaseNonce}) -> do
153 theirBaseNonce <- atomically $ readTVar ncTheirBaseNonce
154 -- Try to decrypt message
155 let diff :: Word16
156 diff = nonce16 - fromIntegral (last2Bytes theirBaseNonce) -- truncating to Word16
157 tempNonce <- addtoNonce24 theirBaseNonce (fromIntegral diff) -- expanding to Word
158 let lr = do -- Either Monad --
159 pubkey <- maybeToEither ncTheirSessionPublic
160 decodePlain =<< decrypt (computeSharedSecret ncSessionSecret pubkey tempNonce) encrypted
161 case lr of
162 Left _ -> return Nothing -- decryption failed, ignore packet
163 Right cd@(CryptoData {bufferStart, bufferEnd, bufferData=cm}) -> do -- decryption succeeded,
164 -- TODO: Why do I need bufferStart & bufferEnd?
165 --
166 -- buffer_start = highest packet number handled + 1
167 -- , recvbuffers buffer_start
168 --
169 -- bufferEnd = sendbuffer buffer_end if lossy, otherwise packet number
170 -- update ncTheirBaseNonce if necessary
171 when (diff > 2 * dATA_NUM_THRESHOLD)$
172 atomically $ do
173 y <- readTVar ncTheirBaseNonce
174 -- all because Storable forces IO...
175 x <- unsafeIOToSTM $ addtoNonce24 y (fromIntegral dATA_NUM_THRESHOLD)
176 writeTVar ncTheirBaseNonce y
177 -- then set session confirmed,
178 atomically $ writeTVar ncState Confirmed
179 hookmap <- atomically $ readTVar ncHooks
180 -- run hook
181 flip fix cd $ \lookupAgain cd -> do
182 let msgTyp = cd ^. messageType
183 case Map.lookup msgTyp hookmap of
184 Nothing -> return Nothing -- discarding, because no hooks
185 Just hooks -> flip fix (hooks,cd,msgTyp) $ \loop (hooks,cd,typ) -> do
186 let _ = cd :: CryptoData
187 case (hooks,cd) of
188 ([],_) -> return Nothing
189 (hook:more,cd) -> do
190 r <- hook addr cd :: IO (Maybe (CryptoData -> CryptoData))
191 case r of
192 Just f -> let newcd = f cd
193 newtyp = newcd ^. messageType
194 in if newtyp == typ then loop (more,newcd,newtyp)
195 else lookupAgain newcd
196 Nothing -> return Nothing -- message consumed
197 where
198 last2Bytes :: Nonce24 -> Word
199 last2Bytes (Nonce24 bs) = case S.decode (B.drop 22 bs) of
200 Right n -> n
201 _ -> error "unreachable-last2Bytes"
202 dATA_NUM_THRESHOLD = 21845 -- = 65535 / 3
203
204
205cryptoDefaultHooks = Map.empty
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 634a7a43..8739c853 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -1,4 +1,5 @@
1{-# LANGUAGE KindSignatures #-} 1{-# LANGUAGE KindSignatures #-}
2{-# LANGUAGE NamedFieldPuns #-}
2{-# LANGUAGE ViewPatterns #-} 3{-# LANGUAGE ViewPatterns #-}
3{-# LANGUAGE FlexibleInstances #-} 4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE LambdaCase #-} 5{-# LANGUAGE LambdaCase #-}
@@ -43,6 +44,8 @@ module Network.Tox.Crypto.Transport
43 , sizedN 44 , sizedN
44 , sizedAtLeastN 45 , sizedAtLeastN
45 , isIndirectGrpChat 46 , isIndirectGrpChat
47 , LossyOrLossless(..)
48 , lossyness
46 ) where 49 ) where
47 50
48import Crypto.Tox 51import Crypto.Tox
@@ -148,6 +151,10 @@ data CryptoData = CryptoData
148 , bufferData :: CryptoMessage 151 , bufferData :: CryptoMessage
149 } 152 }
150 153
154instance Serialize CryptoData where
155 get = CryptoData <$> get <*> get <*> get
156 put (CryptoData start end dta) = put start >> put end >> put dta
157
151-- The 'UserStatus' equivalent in Presence is: 158-- The 'UserStatus' equivalent in Presence is:
152-- 159--
153-- data JabberShow = Offline 160-- data JabberShow = Offline
@@ -176,6 +183,25 @@ instance Sized CryptoMessage where
176 TwoByte {} -> 2 183 TwoByte {} -> 2
177 UpToN { msgBytes = bs } -> 1 + B.length bs 184 UpToN { msgBytes = bs } -> 1 + B.length bs
178 185
186instance Serialize CryptoMessage where
187 get = do
188 i <- get :: Get MessageID
189 n <- remaining
190 case msgSizeParam i of
191 Just (True,1) -> return $ OneByte i
192 Just (True,2) -> TwoByte i <$> get
193 _ -> UpToN i <$> getByteString n
194
195 put (OneByte i) = putWord8 (fromIntegral . fromEnum $ i)
196 put (TwoByte i b) = do putWord8 (fromIntegral . fromEnum $ i)
197 putWord8 b
198 put (UpToN i x) = do putWord8 (fromIntegral . fromEnum $ i)
199 putByteString x
200
201instance Serialize MessageID where
202 get = toEnum . fromIntegral <$> getWord8
203 put x = putWord8 (fromIntegral . fromEnum $ x)
204
179erCompat :: String -> a 205erCompat :: String -> a
180erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type" 206erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type"
181 207
@@ -381,6 +407,12 @@ data MessageType = Msg MessageID
381 | GrpMsg MessageName 407 | GrpMsg MessageName
382 deriving (Eq,Show) 408 deriving (Eq,Show)
383 409
410instance Ord MessageType where
411 compare (Msg x) (Msg y) = compare x y
412 compare (GrpMsg x) (GrpMsg y) = compare x y
413 compare (Msg _) (GrpMsg _) = LT
414 compare (GrpMsg _) (Msg _) = GT
415
384class HasMessageType x where 416class HasMessageType x where
385 getMessageType :: x -> MessageType 417 getMessageType :: x -> MessageType
386 setMessageType :: x -> MessageType -> x 418 setMessageType :: x -> MessageType -> x
@@ -403,6 +435,10 @@ instance HasMessageType CryptoMessage where
403 setMessageType (TwoByte mid0 x) (Msg mid) = UpToN mid (B.singleton x) 435 setMessageType (TwoByte mid0 x) (Msg mid) = UpToN mid (B.singleton x)
404 setMessageType (UpToN mid0 x) (Msg mid) = UpToN mid x 436 setMessageType (UpToN mid0 x) (Msg mid) = UpToN mid x
405 437
438instance HasMessageType CryptoData where
439 getMessageType (CryptoData { bufferData }) = getMessageType bufferData
440 setMessageType cd@(CryptoData { bufferData=bd }) typ = cd { bufferData=setMessageType bd typ }
441
406-- | This lens should always succeed on CryptoMessage 442-- | This lens should always succeed on CryptoMessage
407messageType :: (Functor f, HasMessageType x) => (MessageType -> f MessageType) -> (x -> f x) 443messageType :: (Functor f, HasMessageType x) => (MessageType -> f MessageType) -> (x -> f x)
408messageType = lens getMessageType setMessageType 444messageType = lens getMessageType setMessageType
@@ -564,6 +600,16 @@ isIndirectGrpChat MESSAGE_GROUPCHAT = True
564isIndirectGrpChat LOSSY_GROUPCHAT = True 600isIndirectGrpChat LOSSY_GROUPCHAT = True
565isIndirectGrpChat _ = False 601isIndirectGrpChat _ = False
566 602
603data LossyOrLossless = UnknownLossyness | Lossless | Lossy
604 deriving (Eq,Ord,Enum,Show,Bounded)
605
606lossyness :: MessageID -> LossyOrLossless
607lossyness (fromEnum -> x) | x < 3 = Lossy
608lossyness (fromEnum -> x) | x >= 16, x < 192 = Lossless
609lossyness (fromEnum -> x) | x >= 192, x < 255 = Lossy
610lossyness (fromEnum -> 255) = Lossless
611lossyness _ = UnknownLossyness
612
567-- TODO: Flesh this out. 613-- TODO: Flesh this out.
568data MessageID -- First byte indicates data 614data MessageID -- First byte indicates data
569 = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte) 615 = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 20:32:47 +0000