summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Crypto')
-rw-r--r--src/Network/Tox/Crypto/Transport.hs26
1 files changed, 26 insertions, 0 deletions
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 09c492ef..20b0abae 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -141,6 +141,7 @@ instance Sized CryptoMessage where
141 TwoByte {} -> 2 141 TwoByte {} -> 2
142 UpToN { msgBytes = bs } -> 1 + B.length bs 142 UpToN { msgBytes = bs } -> 1 + B.length bs
143 143
144erCompat :: String -> a
144erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type" 145erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type"
145 146
146typingStatus :: Functor f => (UserStatus -> f UserStatus)-> (CryptoMessage -> f CryptoMessage) 147typingStatus :: Functor f => (UserStatus -> f UserStatus)-> (CryptoMessage -> f CryptoMessage)
@@ -198,9 +199,11 @@ class HasGroupChatID x where
198 getGroupChatID :: x -> GroupChatId 199 getGroupChatID :: x -> GroupChatId
199 setGroupChatID :: x -> GroupChatId -> x 200 setGroupChatID :: x -> GroupChatId -> x
200 201
202sizedN :: Int -> ByteString -> ByteString
201sizedN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0) 203sizedN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0)
202 else B.take n bs 204 else B.take n bs
203 205
206sizedAtLeastN :: Int -> ByteString -> ByteString
204sizedAtLeastN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0) 207sizedAtLeastN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0)
205 else bs 208 else bs
206 209
@@ -372,17 +375,40 @@ data PeerInfo
372 , piName :: ByteString -- byte-prefix for length 375 , piName :: ByteString -- byte-prefix for length
373 } deriving (Eq,Show) 376 } deriving (Eq,Show)
374 377
378instance Serialize PeerInfo where
379 get = do
380 w16 <- get
381 ukey <- id2key <$> get
382 dkey <- id2key <$> get
383 w8 <- get :: Get Word8
384 PeerInfo w16 ukey dkey <$> getBytes (fromIntegral w8)
385
386 put (PeerInfo w16 ukey dkey bs) = do
387 put w16
388 put $ key2id ukey
389 put $ key2id dkey
390 let sz :: Word8
391 sz = case B.length bs of
392 n | n <= 255 -> fromIntegral n
393 | otherwise -> 255
394 put sz
395 putByteString $ B.take (fromIntegral sz) bs
396
375 397
376-- | 398-- |
377-- default constructor, handy for formations such as: 399-- default constructor, handy for formations such as:
378-- 400--
379-- > userStatus .~ Busy $ msg USERSTATUS 401-- > userStatus .~ Busy $ msg USERSTATUS
380-- 402--
403msg :: MessageID -> CryptoMessage
381msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid 404msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid
382msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0 405msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0
383msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty 406msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty
384 407
408leaveMsg :: Serialize a => a -> CryptoMessage
385leaveMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01) 409leaveMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01)
410
411peerQueryMsg :: Serialize a => a -> CryptoMessage
386peerQueryMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x08) 412peerQueryMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x08)
387 413
388 414