summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2013-12-07 05:09:42 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2013-12-07 05:09:42 +0400
commit44fc77ee51b5aef9d43e3d384845d73646ea1d0e (patch)
treed713d4eb943c8e30e019043b6f5b0042a27066fd
parent7d4471e55bcdcebbb4cd5c0b04cc024d8f4642d9 (diff)
Add instance IsString PeerAddr
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs37
1 files changed, 34 insertions, 3 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 71c92a15..846a14f9 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -21,19 +21,25 @@ module Network.BitTorrent.Core.PeerAddr
21 ) where 21 ) where
22 22
23import Control.Applicative 23import Control.Applicative
24import Control.Exception
24import Data.Aeson (ToJSON, FromJSON) 25import Data.Aeson (ToJSON, FromJSON)
25import Data.Aeson.TH 26import Data.Aeson.TH
26import Data.BEncode as BS 27import Data.BEncode as BS
27import Data.BEncode.BDict (BKey) 28import Data.BEncode.BDict (BKey)
28import Data.Bits 29import Data.Bits
29import Data.Char 30import Data.Char
31import Data.Default
30import Data.List as L 32import Data.List as L
33import Data.List.Split
31import Data.Serialize as S 34import Data.Serialize as S
35import Data.String
32import Data.Typeable 36import Data.Typeable
33import Data.Word 37import Data.Word
34import Network.Socket 38import Network.Socket
35import Text.PrettyPrint 39import Text.PrettyPrint
36import Text.PrettyPrint.Class 40import Text.PrettyPrint.Class
41import Text.Read (readMaybe)
42import System.IO.Unsafe
37 43
38import Network.BitTorrent.Core.PeerId 44import Network.BitTorrent.Core.PeerId
39 45
@@ -70,7 +76,7 @@ peer_ip_key = "ip"
70peer_port_key = "port" 76peer_port_key = "port"
71 77
72-- FIXME do we need to byteswap peerIP in bencode instance? 78-- FIXME do we need to byteswap peerIP in bencode instance?
73-- | The tracker announce response compatible encoding. 79-- | The tracker's 'announce response' compatible encoding.
74instance BEncode PeerAddr where 80instance BEncode PeerAddr where
75 toBEncode PeerAddr {..} = toDict $ 81 toBEncode PeerAddr {..} = toDict $
76 peer_id_key .=? peerId 82 peer_id_key .=? peerId
@@ -83,17 +89,42 @@ instance BEncode PeerAddr where
83 <*>! peer_ip_key 89 <*>! peer_ip_key
84 <*>! peer_port_key 90 <*>! peer_port_key
85 91
86-- | The tracker "compact peer list" compatible encoding. The 92-- | The tracker's 'compact peer list' compatible encoding. The
87-- 'peerId' is always 'Nothing'. 93-- 'peerId' is always 'Nothing'.
88-- 94--
89-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> 95-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
90-- 96--
91instance Serialize PeerAddr where 97instance Serialize PeerAddr where
92 put PeerAddr {..} = putWord32host peerId >> putWord peerPort 98 put PeerAddr {..} = putWord32host peerIP >> put peerPort
93 {-# INLINE put #-} 99 {-# INLINE put #-}
94 get = PeerAddr Nothing <$> getWord32host <*> get 100 get = PeerAddr Nothing <$> getWord32host <*> get
95 {-# INLINE get #-} 101 {-# INLINE get #-}
96 102
103-- | @127.0.0.1:6881@
104instance Default PeerAddr where
105 def = "127.0.0.1:6881"
106
107-- inet_addr is pure; so it is safe to throw IO
108unsafeCatchIO :: IO a -> Maybe a
109unsafeCatchIO m = unsafePerformIO $
110 catch (m >>= evaluate >>= return . Just) handler
111 where
112 handler :: IOError -> IO (Maybe a)
113 handler _ = pure Nothing
114
115-- | Example:
116--
117-- @peerPort \"127.0.0.1:6881\" == 6881@
118--
119instance IsString PeerAddr where
120 fromString str
121 | [hostAddrStr, portStr] <- splitWhen (== ':') str
122 , Just hostAddr <- unsafeCatchIO $ inet_addr hostAddrStr
123 , Just portNum <- toEnum <$> readMaybe portStr
124 = PeerAddr Nothing hostAddr portNum
125 | otherwise = error $ "fromString: unable to parse PeerAddr: " ++ str
126
127-- | fingerprint + "at" + dotted.host.inet.addr:port
97instance Pretty PeerAddr where 128instance Pretty PeerAddr where
98 pretty p @ PeerAddr {..} 129 pretty p @ PeerAddr {..}
99 | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr 130 | Just pid <- peerId = pretty (fingerprint pid) <+> "at" <+> paddr