From 4a2bb67f5fbd3d1f8e939cea32384132076f1c7e Mon Sep 17 00:00:00 2001 From: Debian Live user Date: Sun, 29 Oct 2017 23:00:15 +0000 Subject: title lens, comments --- src/Network/Tox/Crypto/Transport.hs | 74 +++++++++++++++++++++++++++++-------- 1 file changed, 59 insertions(+), 15 deletions(-) (limited to 'src/Network') 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 parseNetCrypto :: ByteString -> SockAddr -> Either String (NetCrypto, SockAddr) parseNetCrypto pkt@(B.uncons -> Just (0x1a,_)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetHandshake <$> runGet get pkt parseNetCrypto pkt@(B.uncons -> Just (0x1b,_)) saddr = left ("parseNetCrypto: "++) $ (,saddr) . NetCrypto <$> runGet get pkt +parseNetCrypto _ _ = Left "parseNetCrypto: ?" encodeNetCrypto :: NetCrypto -> SockAddr -> (ByteString, SockAddr) encodeNetCrypto (NetHandshake x) saddr = (B.cons 0x1a (runPut $ put x),saddr) @@ -160,12 +161,12 @@ userStatus = lens getter setter setter (TwoByte USERSTATUS _) status = TwoByte USERSTATUS (fromIntegral . fromEnum $ status) setter _ _ = erCompat "userStatus" -nick :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage) +nick :: Functor f => (Text -> f Text)-> (CryptoMessage -> f CryptoMessage) nick = lens getter setter where - getter (UpToN NICKNAME bstr) = T.unpack $ T.decodeUtf8 bstr + getter (UpToN NICKNAME bstr) = T.decodeUtf8 bstr getter _ = erCompat "nick" - setter (UpToN NICKNAME _) nick = UpToN NICKNAME (T.encodeUtf8 . T.pack $ nick) + setter (UpToN NICKNAME _) nick = UpToN NICKNAME (T.encodeUtf8 $ nick) setter _ _ = erCompat "nick" statusMessage :: Functor f => (String -> f String)-> (CryptoMessage -> f CryptoMessage) @@ -336,13 +337,13 @@ instance HasMessageName CryptoMessage where getMessageName (UpToN (fromEnum -> 0xC7) (sizedN 9 -> B.splitAt 8 -> (_,onebyte))) = let [n] = B.unpack onebyte in toEnum . fromIntegral $ n - getMessageName _ = error "getMessageName on CryptoMessage without message number field." + getMessageName _ = error "getMessageName on CryptoMessage without message name field." setMessageName (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)]) setMessageName (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 8 -> (bs,xs))) messagename = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum messagename) (B.drop 1 xs)]) - setMessageName _ _ = error "setMessageName on CryptoMessage without message number field." + setMessageName _ _ = error "setMessageName on CryptoMessage without message name field." messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x) messageName = lens getMessageName setMessageName @@ -356,17 +357,51 @@ class HasMessageData x where instance HasMessageData CryptoMessage where getMessageData (UpToN (fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata getMessageData (UpToN (fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (_,mdata))) = mdata - getMessageData _ = error "getMessageData on CryptoMessage without message number field." + getMessageData _ = error "getMessageData on CryptoMessage without message data field." setMessageData (UpToN xE@(fromEnum -> 0x63) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- MESSAGE_GROUPCHAT = UpToN xE (B.concat [bs,messagedata]) setMessageData (UpToN xE@(fromEnum -> 0xC7) (sizedAtLeastN 9 -> B.splitAt 9 -> (bs,xs))) messagedata -- LOSSY_GROUPCHAT = UpToN xE (B.concat [bs,messagedata]) - setMessageData _ _ = error "setMessageData on CryptoMessage without message number field." + setMessageData _ _ = error "setMessageData on CryptoMessage without message data field." messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x) messageData = lens getMessageData setMessageData +class HasTitle x where + getTitle :: x -> Text + setTitle :: x -> Text -> x + +instance HasTitle CryptoMessage where + getTitle (UpToN (fromEnum -> 0x62) (sizedAtLeastN 4 -> B.splitAt 3 -> (_,B.uncons -> Just (0x0a,mdata)))) = decodeUtf8 mdata + getTitle _ = error "getTitle on CryptoMessage without title field." + + -- If its not + setTitle (UpToN xE@(fromEnum -> 0x62) (sizedAtLeastN 4 -> B.splitAt 3 -> (bs,B.uncons -> Just (_,xs)))) messagedata -- MESSAGE_GROUPCHAT + = UpToN xE (B.concat [bs,B.cons 0x0a (encodeUtf8 messagedata)]) + setTitle _ _ = error "setTitle on CryptoMessage without title field." + +title :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x) +title = lens getTitle setTitle + +class HasName x where + getName :: x -> Text + setName :: x -> Text -> x + + +instance HasName CryptoMessage where + -- Only MESSAGE_GROUPCHAT:NameChange has Name field + getName (UpToN xE (sizedAtLeastN 4 -> B.splitAt 3 -> (_,B.uncons -> Just (toEnum . fromIntegral -> NameChange,mdata)))) | isGroupChatMsg xE = decodeUtf8 mdata + getName _ = error "getName on CryptoMessage without name field." + + -- If its not NameChange, this setter will set it to NameChange + setName (UpToN xE (sizedAtLeastN 4 -> B.splitAt 3 -> (bs,B.uncons -> Just (_,xs)))) name + | isGroupChatMsg xE = UpToN xE (B.concat [bs,B.cons (fromIntegral $ fromEnum NameChange) (encodeUtf8 name)]) + setName _ _ = error "setName on CryptoMessage without name field." + +name :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x) +name = lens getTitle setTitle + data PeerInfo = PeerInfo { piPeerNum :: PeerNumber @@ -375,6 +410,10 @@ data PeerInfo , piName :: ByteString -- byte-prefix for length } deriving (Eq,Show) +instance HasPeerNumber PeerInfo where + getPeerNumber = piPeerNum + setPeerNumber x n = x { piPeerNum = n } + instance Serialize PeerInfo where get = do w16 <- get @@ -404,6 +443,7 @@ msg :: MessageID -> CryptoMessage msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0 msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty +msg mid = UpToN mid B.empty leaveMsg :: Serialize a => a -> CryptoMessage leaveMsg 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 msgSizeParam FILE_CONTROL = Just (False,7) -- 8 bytes if seek, otherwise 4 msgSizeParam INVITE_GROUPCHAT = Just (False,38) msgSizeParam ONLINE_PACKET = Just (True,35) -msgSizeParam DIRECT_GROUPCHAT = Nothing -- 1+2+1 thus Just (True,3) leave & peer-query, but variable in response packets -msgSizeParam MESSAGE_GROUPCHAT = Nothing -- variable -msgSizeParam LOSSY_GROUPCHAT = Nothing -- variable +msgSizeParam DIRECT_GROUPCHAT {-0x62-} = Nothing -- 1+2+1 thus Just (True,3) leave & peer-query, but variable in response packets +msgSizeParam MESSAGE_GROUPCHAT {-0x63-} = Nothing -- variable +msgSizeParam LOSSY_GROUPCHAT {-0xC7-} = Nothing -- variable msgSizeParam _ = Nothing +isGroupChatMsg MESSAGE_GROUPCHAT = True +isGroupChatMsg LOSSY_GROUPCHAT = True +isGroupChatMsg _ = False + -- TODO: Flesh this out. data MessageID -- First byte indicates data = Padding -- ^ 0 padding (skipped until we hit a non zero (data id) byte) @@ -532,10 +576,10 @@ data MessageID -- First byte indicates data | MessengerLossless093 | MessengerLossless094 | MessengerLossless095 - | INVITE_GROUPCHAT - | ONLINE_PACKET - | DIRECT_GROUPCHAT - | MESSAGE_GROUPCHAT + | INVITE_GROUPCHAT -- 0x60 + | ONLINE_PACKET -- 0x61 + | DIRECT_GROUPCHAT -- 0x62 + | MESSAGE_GROUPCHAT -- 0x63 | MessengerLossless100 | MessengerLossless101 | MessengerLossless102 @@ -635,7 +679,7 @@ data MessageID -- First byte indicates data | MessengerLossy196 | MessengerLossy197 | MessengerLossy198 - | LOSSY_GROUPCHAT + | LOSSY_GROUPCHAT -- 0xC7 | MessengerLossy200 | MessengerLossy201 | MessengerLossy202 -- cgit v1.2.3