diff options
author | joe <joe@jerkface.net> | 2017-10-29 17:36:52 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-10-29 17:36:52 -0400 |
commit | f4dc7e5d85492d257c5b7e8e0e01eefa7a6da47d (patch) | |
tree | 7bf39bb5f05c77065be2c6975ce91d81d2c92c45 /src/Network/Tox | |
parent | 41dd1e80778bb2f65d28569d859dd85255712876 (diff) |
Serlialize instance for PeerInfo.
Diffstat (limited to 'src/Network/Tox')
-rw-r--r-- | src/Network/Tox/Crypto/Transport.hs | 26 |
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 | ||
144 | erCompat :: String -> a | ||
144 | erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type" | 145 | erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type" |
145 | 146 | ||
146 | typingStatus :: Functor f => (UserStatus -> f UserStatus)-> (CryptoMessage -> f CryptoMessage) | 147 | typingStatus :: 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 | ||
202 | sizedN :: Int -> ByteString -> ByteString | ||
201 | sizedN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0) | 203 | sizedN 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 | ||
206 | sizedAtLeastN :: Int -> ByteString -> ByteString | ||
204 | sizedAtLeastN n bs = if B.length bs < n then B.append bs (B.replicate (n - B.length bs) 0) | 207 | sizedAtLeastN 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 | ||
378 | instance 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 | -- |
403 | msg :: MessageID -> CryptoMessage | ||
381 | msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid | 404 | msg mid | Just (True,0) <- msgSizeParam mid = OneByte mid |
382 | msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0 | 405 | msg mid | Just (True,1) <- msgSizeParam mid = TwoByte mid 0 |
383 | msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty | 406 | msg mid | Just (False,_) <- msgSizeParam mid = UpToN mid B.empty |
384 | 407 | ||
408 | leaveMsg :: Serialize a => a -> CryptoMessage | ||
385 | leaveMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01) | 409 | leaveMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x01) |
410 | |||
411 | peerQueryMsg :: Serialize a => a -> CryptoMessage | ||
386 | peerQueryMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x08) | 412 | peerQueryMsg groupnum = UpToN DIRECT_GROUPCHAT (B.snoc (S.encode groupnum) 0x08) |
387 | 413 | ||
388 | 414 | ||