summaryrefslogtreecommitdiff
path: root/src/Network/Tox/Crypto/Transport.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox/Crypto/Transport.hs')
-rw-r--r--src/Network/Tox/Crypto/Transport.hs33
1 files changed, 31 insertions, 2 deletions
diff --git a/src/Network/Tox/Crypto/Transport.hs b/src/Network/Tox/Crypto/Transport.hs
index 6e2ab60b..2c13e168 100644
--- a/src/Network/Tox/Crypto/Transport.hs
+++ b/src/Network/Tox/Crypto/Transport.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE DataKinds #-} 2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE FlexibleInstances #-} 3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GADTs #-} 4{-# LANGUAGE GADTs #-}
@@ -43,8 +44,10 @@ module Network.Tox.Crypto.Transport
43 , HasMessage(..) 44 , HasMessage(..)
44 , HasMessageType(..) 45 , HasMessageType(..)
45 -- lenses 46 -- lenses
47#ifdef VERSION_lens
46 , groupNumber, groupNumberToJoin, peerNumber, messageNumber 48 , groupNumber, groupNumberToJoin, peerNumber, messageNumber
47 , messageName, messageData, name, title, message, messageType 49 , messageName, messageData, name, title, message, messageType
50#endif
48 -- constructor 51 -- constructor
49 -- utils 52 -- utils
50 , sizedN 53 , sizedN
@@ -77,7 +80,8 @@ import Data.Monoid
77import Data.Word 80import Data.Word
78import Data.Bits 81import Data.Bits
79import Crypto.Hash 82import Crypto.Hash
80import Control.Lens 83import Data.Functor.Contravariant
84import Data.Functor.Identity
81import Data.Text as T 85import Data.Text as T
82import Data.Text.Encoding as T 86import Data.Text.Encoding as T
83import Data.Serialize as S 87import Data.Serialize as S
@@ -284,8 +288,10 @@ putCryptoMessage seqno (Pkt t :=> Identity x) = do
284 putPacket seqno x 288 putPacket seqno x
285 289
286 290
291#ifdef VERSION_lens
287erCompat :: String -> a 292erCompat :: String -> a
288erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type" 293erCompat lens = error $ "Use of '" ++ lens ++ "' lens on incompatible CryptoMessage type"
294#endif
289 295
290 296
291newtype GroupChatId = GrpId ByteString -- 33 bytes 297newtype GroupChatId = GrpId ByteString -- 33 bytes
@@ -330,8 +336,10 @@ instance HasGroupChatID CryptoMessage where
330 setGroupChatID _ _= error "setGroupChatID on non-groupchat message." 336 setGroupChatID _ _= error "setGroupChatID on non-groupchat message."
331-} 337-}
332 338
339#ifdef VERSION_lens
333groupChatID :: (Functor f, HasGroupChatID x) => (GroupChatId -> f GroupChatId) -> (x -> f x) 340groupChatID :: (Functor f, HasGroupChatID x) => (GroupChatId -> f GroupChatId) -> (x -> f x)
334groupChatID = lens getGroupChatID setGroupChatID 341groupChatID = lens getGroupChatID setGroupChatID
342#endif
335 343
336type GroupNumber = Word16 344type GroupNumber = Word16
337type PeerNumber = Word16 345type PeerNumber = Word16
@@ -362,8 +370,10 @@ instance HasGroupNumber CryptoMessage where
362 setGroupNumber _ _ = error "setGroupNumber on CryptoMessage without group number field." 370 setGroupNumber _ _ = error "setGroupNumber on CryptoMessage without group number field."
363-} 371-}
364 372
373#ifdef VERSION_lens
365groupNumber :: (Functor f, HasGroupNumber x) => (Word16 -> f Word16) -> (x -> f x) 374groupNumber :: (Functor f, HasGroupNumber x) => (Word16 -> f Word16) -> (x -> f x)
366groupNumber = lens getGroupNumber setGroupNumber 375groupNumber = lens getGroupNumber setGroupNumber
376#endif
367 377
368class HasGroupNumberToJoin x where 378class HasGroupNumberToJoin x where
369 getGroupNumberToJoin :: x -> GroupNumber 379 getGroupNumberToJoin :: x -> GroupNumber
@@ -384,8 +394,10 @@ instance HasGroupNumberToJoin CryptoMessage where
384 setGroupNumberToJoin _ _ = error "setGroupNumberToJoin on CryptoMessage without group number (to join) field." 394 setGroupNumberToJoin _ _ = error "setGroupNumberToJoin on CryptoMessage without group number (to join) field."
385-} 395-}
386 396
397#ifdef VERSION_lens
387groupNumberToJoin :: (Functor f, HasGroupNumberToJoin x) => (GroupNumber -> f GroupNumber) -> (x -> f x) 398groupNumberToJoin :: (Functor f, HasGroupNumberToJoin x) => (GroupNumber -> f GroupNumber) -> (x -> f x)
388groupNumberToJoin = lens getGroupNumberToJoin setGroupNumberToJoin 399groupNumberToJoin = lens getGroupNumberToJoin setGroupNumberToJoin
400#endif
389 401
390class HasPeerNumber x where 402class HasPeerNumber x where
391 getPeerNumber :: x -> PeerNumber 403 getPeerNumber :: x -> PeerNumber
@@ -406,8 +418,10 @@ instance HasPeerNumber CryptoMessage where
406 setPeerNumber _ _ = error "setPeerNumber on CryptoMessage without peer number field." 418 setPeerNumber _ _ = error "setPeerNumber on CryptoMessage without peer number field."
407-} 419-}
408 420
421#ifdef VERSION_lens
409peerNumber :: (Functor f, HasPeerNumber x) => (Word16 -> f Word16) -> (x -> f x) 422peerNumber :: (Functor f, HasPeerNumber x) => (Word16 -> f Word16) -> (x -> f x)
410peerNumber = lens getPeerNumber setPeerNumber 423peerNumber = lens getPeerNumber setPeerNumber
424#endif
411 425
412class HasMessageNumber x where 426class HasMessageNumber x where
413 getMessageNumber :: x -> MessageNumber 427 getMessageNumber :: x -> MessageNumber
@@ -428,9 +442,10 @@ instance HasMessageNumber CryptoMessage where
428 setMessageNumber _ _ = error "setMessageNumber on CryptoMessage without message number field." 442 setMessageNumber _ _ = error "setMessageNumber on CryptoMessage without message number field."
429-} 443-}
430 444
445#ifdef VERSION_lens
431messageNumber :: (Functor f, HasMessageNumber x) => (Word32 -> f Word32) -> (x -> f x) 446messageNumber :: (Functor f, HasMessageNumber x) => (Word32 -> f Word32) -> (x -> f x)
432messageNumber = lens getMessageNumber setMessageNumber 447messageNumber = lens getMessageNumber setMessageNumber
433 448#endif
434 449
435class HasMessageName x where 450class HasMessageName x where
436 getMessageName :: x -> MessageName 451 getMessageName :: x -> MessageName
@@ -453,8 +468,10 @@ instance HasMessageName CryptoMessage where
453 setMessageName _ _ = error "setMessageName on CryptoMessage without message name field." 468 setMessageName _ _ = error "setMessageName on CryptoMessage without message name field."
454-} 469-}
455 470
471#ifdef VERSION_lens
456messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x) 472messageName :: (Functor f, HasMessageName x) => (MessageName -> f MessageName) -> (x -> f x)
457messageName = lens getMessageName setMessageName 473messageName = lens getMessageName setMessageName
474#endif
458 475
459data KnownLossyness = KnownLossy | KnownLossless 476data KnownLossyness = KnownLossy | KnownLossless
460 deriving (Eq,Ord,Show,Enum) 477 deriving (Eq,Ord,Show,Enum)
@@ -497,8 +514,10 @@ instance AsWord64 MessageType where
497 fromWord64 x | x < 1024, x .|. 0x0200 == 0x0200 = GrpMsg (toEnum8 ((x - 512) `div` 256)) (toEnum8 x) 514 fromWord64 x | x < 1024, x .|. 0x0200 == 0x0200 = GrpMsg (toEnum8 ((x - 512) `div` 256)) (toEnum8 x)
498 fromWord64 x = error "Not clear how to convert Word64 to MessageType" 515 fromWord64 x = error "Not clear how to convert Word64 to MessageType"
499 516
517#ifdef VERSION_lens
500word16 :: (Functor f, AsWord16 x) => (Word16 -> f Word16) -> (x -> f x) 518word16 :: (Functor f, AsWord16 x) => (Word16 -> f Word16) -> (x -> f x)
501word16 = lens toWord16 (\_ x -> fromWord16 x) 519word16 = lens toWord16 (\_ x -> fromWord16 x)
520#endif
502 521
503instance Ord MessageType where 522instance Ord MessageType where
504 compare (Msg x) (Msg y) = compare x y 523 compare (Msg x) (Msg y) = compare x y
@@ -540,9 +559,11 @@ instance HasMessageType CryptoData where
540 setMessageType cd@(CryptoData { bufferData=bd }) typ = cd { bufferData=setMessageType bd typ } 559 setMessageType cd@(CryptoData { bufferData=bd }) typ = cd { bufferData=setMessageType bd typ }
541-} 560-}
542 561
562#ifdef VERSION_lens
543-- | This lens should always succeed on CryptoMessage 563-- | This lens should always succeed on CryptoMessage
544messageType :: (Functor f, HasMessageType x) => (MessageType -> f MessageType) -> (x -> f x) 564messageType :: (Functor f, HasMessageType x) => (MessageType -> f MessageType) -> (x -> f x)
545messageType = lens getMessageType setMessageType 565messageType = lens getMessageType setMessageType
566#endif
546 567
547type MessageData = B.ByteString 568type MessageData = B.ByteString
548 569
@@ -568,8 +589,10 @@ instance HasMessageData CryptoMessage where
568 setMessageData _ _ = error "setMessageData on CryptoMessage without message data field." 589 setMessageData _ _ = error "setMessageData on CryptoMessage without message data field."
569-} 590-}
570 591
592#ifdef VERSION_lens
571messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x) 593messageData :: (Functor f, HasMessageData x) => (MessageData -> f MessageData) -> (x -> f x)
572messageData = lens getMessageData setMessageData 594messageData = lens getMessageData setMessageData
595#endif
573 596
574class HasTitle x where 597class HasTitle x where
575 getTitle :: x -> Text 598 getTitle :: x -> Text
@@ -598,8 +621,10 @@ instance HasTitle CryptoMessage where
598 setTitle _ _ = error "setTitle on CryptoMessage without title field." 621 setTitle _ _ = error "setTitle on CryptoMessage without title field."
599-} 622-}
600 623
624#ifdef VERSION_lens
601title :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x) 625title :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
602title = lens getTitle setTitle 626title = lens getTitle setTitle
627#endif
603 628
604class HasMessage x where 629class HasMessage x where
605 getMessage :: x -> Text 630 getMessage :: x -> Text
@@ -628,8 +653,10 @@ instance HasMessage CryptoMessage where
628 setMessage _ _ = error "setMessage on CryptoMessage without message field." 653 setMessage _ _ = error "setMessage on CryptoMessage without message field."
629-} 654-}
630 655
656#ifdef VERSION_lens
631message :: (Functor f, HasMessage x) => (Text -> f Text) -> (x -> f x) 657message :: (Functor f, HasMessage x) => (Text -> f Text) -> (x -> f x)
632message = lens getMessage setMessage 658message = lens getMessage setMessage
659#endif
633 660
634class HasName x where 661class HasName x where
635 getName :: x -> Text 662 getName :: x -> Text
@@ -648,8 +675,10 @@ instance HasName CryptoMessage where
648 setName _ _ = error "setName on CryptoMessage without name field." 675 setName _ _ = error "setName on CryptoMessage without name field."
649-} 676-}
650 677
678#ifdef VERSION_lens
651name :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x) 679name :: (Functor f, HasTitle x) => (Text -> f Text) -> (x -> f x)
652name = lens getTitle setTitle 680name = lens getTitle setTitle
681#endif
653 682
654data PeerInfo 683data PeerInfo
655 = PeerInfo 684 = PeerInfo