summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/Tox/Crypto/Transport.hs74
1 files changed, 59 insertions, 15 deletions
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 20b0abae..1583ef6f 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -61,6 +61,7 @@ data NetCrypto
61parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr) 61parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr)
62parseNetCrypto pkt@(B.uncons -> Just (0x1a,_)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetHandshake <$> runGet get pkt 62parseNetCrypto pkt@(B.uncons -> Just (0x1a,_)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetHandshake <$> runGet get pkt
63parseNetCrypto pkt@(B.uncons -> Just (0x1b,_)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetCrypto <$> runGet get pkt 63parseNetCrypto pkt@(B.uncons -> Just (0x1b,_)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetCrypto <$> runGet get pkt
64parseNetCrypto _ _ = Left "parseNetCrypto: ?"
64 65
65encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr) 66encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr)
66encodeNetCrypto (NetHandshake x) saddr = (B.cons 0x1a (runPut $ put x),saddr) 67encodeNetCrypto (NetHandshake x) saddr = (B.cons 0x1a (runPut $ put x),saddr)
@@ -160,12 +161,12 @@ userStatus = lens getter setter
160 setter (TwoByte USERSTATUS _) status = TwoByte USERSTATUS (fromIntegral . fromEnum $ status) 161 setter (TwoByte USERSTATUS _) status = TwoByte USERSTATUS (fromIntegral . fromEnum $ status)
161 setter _ _ = erCompat "userStatus" 162 setter _ _ = erCompat "userStatus"
162 163
163nick :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage) 164nick :: Functor f => (Text -> f Text)-> (CryptoMessage -> f CryptoMessage)
164nick = lens getter setter 165nick = lens getter setter
165 where 166 where
166 getter (UpToN NICKNAME bstr) = T.unpack $ T.decodeUtf8 bstr 167 getter (UpToN NICKNAME bstr) = T.decodeUtf8 bstr
167 getter _ = erCompat "nick" 168 getter _ = erCompat "nick"
168 setter (UpToN NICKNAME _) nick = UpToN NICKNAME (T.encodeUtf8 . T.pack $ nick) 169 setter (UpToN NICKNAME _) nick = UpToN NICKNAME (T.encodeUtf8 $ nick)
169 setter _ _ = erCompat "nick" 170 setter _ _ = erCompat "nick"
170 171
171statusMessage :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage) 172statusMessage :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage)
@@ -336,13 +337,13 @@ instance HasMessageName CryptoMessage where
336 getMessageName (UpToN (fromEnum -> 0xC7) (sizedN 9 -> B.splitAt 8 -> (_,onebyte))) 337 getMessageName (UpToN (fromEnum -> 0xC7) (sizedN 9 -> B.splitAt 8 -> (_,onebyte)))
337 = let [n] = B.unpack onebyte 338 = let [n] = B.unpack onebyte
338 in toEnum . fromIntegral $ n 339 in toEnum . fromIntegral $ n
339 getMessageName _ = error "getMessageName on CryptoMessage without message number field." 340 getMessageName _ = error "getMessageName on CryptoMessage without message name field."
340 341
341 setMessageName (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename 342 setMessageName (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename
342 = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)]) 343 = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)])
343 setMessageName (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename 344 setMessageName (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename
344 = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)]) 345 = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)])
345 setMessageName _ _ = error "setMessageName on CryptoMessage without message number field." 346 setMessageName _ _ = error "setMessageName on CryptoMessage without message name field."
346 347
347messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x) 348messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x)
348messageName = lens getMessageName setMessageName 349messageName = lens getMessageName setMessageName
@@ -356,17 +357,51 @@ class HasMessageData x where
356instance HasMessageData CryptoMessage where 357instance HasMessageData CryptoMessage where
357 getMessageData (UpToN (fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata 358 getMessageData (UpToN (fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata
358 getMessageData (UpToN (fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata 359 getMessageData (UpToN (fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata
359 getMessageData _ = error "getMessageData on CryptoMessage without message number field." 360 getMessageData _ = error "getMessageData on CryptoMessage without message data field."
360 361
361 setMessageData (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- MESSAGE_GROUPCHAT 362 setMessageData (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- MESSAGE_GROUPCHAT
362 = UpToN xE (B.concat [bs,messagedata]) 363 = UpToN xE (B.concat [bs,messagedata])
363 setMessageData (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- LOSSY_GROUPCHAT 364 setMessageData (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- LOSSY_GROUPCHAT
364 = UpToN xE (B.concat [bs,messagedata]) 365 = UpToN xE (B.concat [bs,messagedata])
365 setMessageData _ _ = error "setMessageData on CryptoMessage without message number field." 366 setMessageData _ _ = error "setMessageData on CryptoMessage without message data field."
366 367
367messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x) 368messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x)
368messageData = lens getMessageData setMessageData 369messageData = lens getMessageData setMessageData
369 370
371class HasTitle x where
372 getTitle :: x -> Text
373 setTitle :: x -> Text -> x
374
375instance HasTitle CryptoMessage where
376 getTitle (UpToN (fromEnum -> 0x62) (sizedAtLeastN 4 -> B.splitAt 3 -> (_,B.uncons -> Just (0x0a,mdata)))) = decodeUtf8 mdata
377 getTitle _ = error "getTitle on CryptoMessage without title field."
378
379 -- If its not
380 setTitle (UpToN xE@(fromEnum -> 0x62) (sizedAtLeastN 4 -> B.splitAt 3 -> (bs,B.uncons -> Just (_,xs)))) messagedata -- MESSAGE_GROUPCHAT
381 = UpToN xE (B.concat [bs,B.cons 0x0a (encodeUtf8 messagedata)])
382 setTitle _ _ = error "setTitle on CryptoMessage without title field."
383
384title :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
385title = lens getTitle setTitle
386
387class HasName x where
388 getName :: x -> Text
389 setName :: x -> Text -> x
390
391
392instance HasName CryptoMessage where
393 -- Only MESSAGE_GROUPCHAT:NameChange has Name field
394 getName (UpToN xE (sizedAtLeastN 4 -> B.splitAt 3 -> (_,B.uncons -> Just (toEnum . fromIntegral -> NameChange,mdata)))) | isGroupChatMsg xE = decodeUtf8 mdata
395 getName _ = error "getName on CryptoMessage without name field."
396
397 -- If its not NameChange, this setter will set it to NameChange
398 setName (UpToN xE (sizedAtLeastN 4 -> B.splitAt 3 -> (bs,B.uncons -> Just (_,xs)))) name
399 | isGroupChatMsg xE = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum NameChange) (encodeUtf8 name)])
400 setName _ _ = error "setName on CryptoMessage without name field."
401
402name :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
403name = lens getTitle setTitle
404
370data PeerInfo 405data PeerInfo
371 = PeerInfo 406 = PeerInfo
372 { piPeerNum :: PeerNumber 407 { piPeerNum :: PeerNumber
@@ -375,6 +410,10 @@ data PeerInfo
375 , piName :: ByteString -- byte-prefix for length 410 , piName :: ByteString -- byte-prefix for length
376 } deriving (Eq,Show) 411 } deriving (Eq,Show)
377 412
413instance HasPeerNumber PeerInfo where
414 getPeerNumber = piPeerNum
415 setPeerNumber x n = x { piPeerNum = n }
416
378instance Serialize PeerInfo where 417instance Serialize PeerInfo where
379 get = do 418 get = do
380 w16 <- get 419 w16 <- get
@@ -404,6 +443,7 @@ msg :: MessageID -> CryptoMessage
404msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid 443msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid
405msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0 444msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0
406msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty 445msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty
446msg mid = UpToN mid B.empty
407 447
408leaveMsg :: Serialize a => a -> CryptoMessage 448leaveMsg :: Serialize a => a -> CryptoMessage
409leaveMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01) 449leaveMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01)
@@ -429,11 +469,15 @@ msgSizeParam FILE_SENDREQUEST = Just (False,300) -- 1+1+4+8+32+max255 = up to 30
429msgSizeParam FILE_CONTROL = Just (False,7) -- 8 bytes if seek, otherwise 4 469msgSizeParam FILE_CONTROL = Just (False,7) -- 8 bytes if seek, otherwise 4
430msgSizeParam INVITE_GROUPCHAT = Just (False,38) 470msgSizeParam INVITE_GROUPCHAT = Just (False,38)
431msgSizeParam ONLINE_PACKET = Just (True,35) 471msgSizeParam ONLINE_PACKET = Just (True,35)
432msgSizeParam DIRECT_GROUPCHAT = Nothing -- 1+2+1 thus Just (True,3) leave & peer-query, but variable in response packets 472msgSizeParam DIRECT_GROUPCHAT {-0x62-} = Nothing -- 1+2+1 thus Just (True,3) leave & peer-query, but variable in response packets
433msgSizeParam MESSAGE_GROUPCHAT = Nothing -- variable 473msgSizeParam MESSAGE_GROUPCHAT {-0x63-} = Nothing -- variable
434msgSizeParam LOSSY_GROUPCHAT = Nothing -- variable 474msgSizeParam LOSSY_GROUPCHAT {-0xC7-} = Nothing -- variable
435msgSizeParam _ = Nothing 475msgSizeParam _ = Nothing
436 476
477isGroupChatMsg MESSAGE_GROUPCHAT = True
478isGroupChatMsg LOSSY_GROUPCHAT = True
479isGroupChatMsg _ = False
480
437-- TODO: Flesh this out. 481-- TODO: Flesh this out.
438data MessageID -- First byte indicates data 482data MessageID -- First byte indicates data
439 = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte) 483 = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte)
@@ -532,10 +576,10 @@ data MessageID -- First byte indicates data
532 | MessengerLossless093 576 | MessengerLossless093
533 | MessengerLossless094 577 | MessengerLossless094
534 | MessengerLossless095 578 | MessengerLossless095
535 | INVITE_GROUPCHAT 579 | INVITE_GROUPCHAT -- 0x60
536 | ONLINE_PACKET 580 | ONLINE_PACKET -- 0x61
537 | DIRECT_GROUPCHAT 581 | DIRECT_GROUPCHAT -- 0x62
538 | MESSAGE_GROUPCHAT 582 | MESSAGE_GROUPCHAT -- 0x63
539 | MessengerLossless100 583 | MessengerLossless100
540 | MessengerLossless101 584 | MessengerLossless101
541 | MessengerLossless102 585 | MessengerLossless102
@@ -635,7 +679,7 @@ data MessageID -- First byte indicates data
635 | MessengerLossy196 679 | MessengerLossy196
636 | MessengerLossy197 680 | MessengerLossy197
637 | MessengerLossy198 681 | MessengerLossy198
638 | LOSSY_GROUPCHAT 682 | LOSSY_GROUPCHAT -- 0xC7
639 | MessengerLossy200 683 | MessengerLossy200
640 | MessengerLossy201 684 | MessengerLossy201
641 | MessengerLossy202 685 | MessengerLossy202