summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2018-12-12 01:12:25 -0500
committerJoe Crayne <joe@jerkface.net>2018-12-16 14:08:26 -0500
commit1819d80705986d36c3264f60d05a5383c73bc33f (patch)
tree5d3c2b8980a4cc74988090c658e25da82bd2727a /src/Network
parentd27be4aaf8182bc8c5dd84c7b8cc7f5250614613 (diff)
Reduced dependencies, updated cabal file.
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/Address.hs34
-rw-r--r--src/Network/Tox/Crypto/Transport.hs33
-rw-r--r--src/Network/Tox/Handshake.hs2
3 files changed, 61 insertions, 8 deletions
diff --git a/src/Network/Address.hs b/src/Network/Address.hs
index 246463c0..e1cec34d 100644
--- a/src/Network/Address.hs
+++ b/src/Network/Address.hs
@@ -84,6 +84,9 @@ module Network.Address
84 , sockAddrPort 84 , sockAddrPort
85 , setPort 85 , setPort
86 , getBindAddress 86 , getBindAddress
87 , localhost4
88 , localhost6
89 , linesBy
87 ) where 90 ) where
88 91
89import Control.Applicative 92import Control.Applicative
@@ -109,7 +112,6 @@ import Data.IP hiding (fromSockAddr)
109import Data.IP 112import Data.IP
110#endif 113#endif
111import Data.List as L 114import Data.List as L
112import Data.List.Split as L
113import Data.Maybe (fromMaybe, catMaybes) 115import Data.Maybe (fromMaybe, catMaybes)
114import Data.Monoid 116import Data.Monoid
115import Data.Hashable 117import Data.Hashable
@@ -212,7 +214,8 @@ instance Serialize a => Serialize (NodeAddr a) where
212-- 214--
213instance IsString (NodeAddr IPv4) where 215instance IsString (NodeAddr IPv4) where
214 fromString str 216 fromString str
215 | [hostAddrStr, portStr] <- splitWhen (== ':') str 217 | (hostAddrStr, portStr0) <- L.break (== ':') str
218 , let portStr = L.drop 1 portStr0
216 , Just hostAddr <- readMaybe hostAddrStr 219 , Just hostAddr <- readMaybe hostAddrStr
217 , Just portNum <- toEnum <$> readMaybe portStr 220 , Just portNum <- toEnum <$> readMaybe portStr
218 = NodeAddr hostAddr portNum 221 = NodeAddr hostAddr portNum
@@ -540,7 +543,8 @@ instance Default PeerAddr where
540-- 543--
541instance IsString PeerAddr where 544instance IsString PeerAddr where
542 fromString str 545 fromString str
543 | [hostAddrStr, portStr] <- splitWhen (== ':') str 546 | (hostAddrStr, portStr0) <- L.break (== ':') str
547 , let portStr = L.drop 1 portStr0
544 , Just hostAddr <- readMaybe hostAddrStr 548 , Just hostAddr <- readMaybe hostAddrStr
545 , Just portNum <- toEnum <$> readMaybe portStr 549 , Just portNum <- toEnum <$> readMaybe portStr
546 = PeerAddr Nothing (IPv4 hostAddr) portNum 550 = PeerAddr Nothing (IPv4 hostAddr) portNum
@@ -958,6 +962,20 @@ instance Default Version where
958 def = Version [0] [] 962 def = Version [0] []
959 {-# INLINE def #-} 963 {-# INLINE def #-}
960 964
965dropLastIf :: (a -> Bool) -> [a] -> [a]
966dropLastIf pred [] = []
967dropLastIf pred (x:xs) = init' x xs
968 where init' y [] | pred y = []
969 init' y [] = [y]
970 init' y (z:zs) = y : init' z zs
971
972linesBy :: (a -> Bool) -> [a] -> [[a]]
973linesBy pred ys = dropLastIf L.null $ L.map dropDelim $ L.groupBy (\_ x -> not $ pred x) ys
974 where
975 dropDelim [] = []
976 dropDelim (x:xs) | pred x = xs
977 | otherwise = x:xs
978
961-- | For dot delimited version strings. 979-- | For dot delimited version strings.
962-- Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@ 980-- Example: @fromString \"0.1.0.2\" == Version [0, 1, 0, 2]@
963-- 981--
@@ -966,7 +984,7 @@ instance IsString Version where
966 | Just nums <- chunkNums str = Version nums [] 984 | Just nums <- chunkNums str = Version nums []
967 | otherwise = error $ "fromString: invalid version string " ++ str 985 | otherwise = error $ "fromString: invalid version string " ++ str
968 where 986 where
969 chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) 987 chunkNums = sequence . L.map readMaybe . linesBy ('.' ==)
970 988
971instance Pretty Version where 989instance Pretty Version where
972 pPrint = text . showVersion 990 pPrint = text . showVersion
@@ -1120,7 +1138,7 @@ fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
1120 1138
1121 getMainlineVersion = do 1139 getMainlineVersion = do
1122 str <- BC.unpack <$> getByteString 7 1140 str <- BC.unpack <$> getByteString 7
1123 let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str 1141 let mnums = L.filter (not . L.null) $ linesBy ('-' ==) str
1124 return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) [] 1142 return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
1125 1143
1126 getAzureusImpl = parseSoftware <$> getByteString 2 1144 getAzureusImpl = parseSoftware <$> getByteString 2
@@ -1227,3 +1245,9 @@ either4or6 a6@(SockAddrInet6 port _ addr _)
1227data WantIP = Want_IP4 | Want_IP6 | Want_Both 1245data WantIP = Want_IP4 | Want_IP6 | Want_Both
1228 deriving (Eq, Enum, Ord, Show) 1246 deriving (Eq, Enum, Ord, Show)
1229 1247
1248localhost6 :: SockAddr
1249localhost6 = SockAddrInet6 0 0 (0,0,0,1) 0 -- [::1]:0
1250
1251localhost4 :: SockAddr
1252localhost4 = SockAddrInet 0 16777343 -- 127.0.0.1:0
1253
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
diff --git a/src/Network/Tox/Handshake.hs b/src/Network/Tox/Handshake.hs
index 6df9edab..c48b7415 100644
--- a/src/Network/Tox/Handshake.hs
+++ b/src/Network/Tox/Handshake.hs
@@ -8,10 +8,10 @@ module Network.Tox.Handshake where
8 8
9import Control.Arrow 9import Control.Arrow
10import Control.Concurrent.STM 10import Control.Concurrent.STM
11import Control.Lens
12import Control.Monad 11import Control.Monad
13import Crypto.Hash 12import Crypto.Hash
14import Crypto.Tox 13import Crypto.Tox
14import Data.Functor.Identity
15import Data.Time.Clock.POSIX 15import Data.Time.Clock.POSIX
16import Network.Tox.Crypto.Transport 16import Network.Tox.Crypto.Transport
17import Network.Tox.DHT.Handlers (createCookieSTM) 17import Network.Tox.DHT.Handlers (createCookieSTM)