title lens, comments

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
 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