Merge branch 'dht-presence' of blackbird:bittorrent

5 files changed, 20 insertions, 15 deletions

diff --git a/bittorrent/src/Network/BitTorrent/Tracker.hs b/bittorrent/src/Network/BitTorrent/Tracker.hs
index 6db67559..1191f921 100644
--- a/bittorrent/src/Network/BitTorrent/Tracker.hs
+++ b/bittorrent/src/Network/BitTorrent/Tracker.hs
@@ -23,6 +23,7 @@ module Network.BitTorrent.Tracker
        , trackerList
        , Session
        , Event (..)
+       , trackers
        , newSession
        , closeSession
        , withSession
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/List.hs b/bittorrent/src/Network/BitTorrent/Tracker/List.hs
index 0eb11641..1507b4be 100644
--- a/bittorrent/src/Network/BitTorrent/Tracker/List.hs
+++ b/bittorrent/src/Network/BitTorrent/Tracker/List.hs
@@ -16,6 +16,7 @@ module Network.BitTorrent.Tracker.List
        , TrackerList
 
          -- * Construction
+       , trackers
        , trackerList
        , shuffleTiers
        , mapWithURI
@@ -116,6 +117,9 @@ fixList mxss mx = do
   let xss' = L.filter (not . L.null) xss
   return $ maybe xss' (addBackup xss') mx
 
+trackers :: [URI] -> TrackerList ()
+trackers uris = TierList $ map (\uri -> [(uri,())]) uris
+
 -- | Extract set of trackers from torrent file. The 'tAnnounce' key is
 -- only ignored if the 'tAnnounceList' key is present.
 trackerList :: Torrent -> TrackerList ()
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/Message.hs b/bittorrent/src/Network/BitTorrent/Tracker/Message.hs
index b9b6a9d3..e01ebbf4 100644
--- a/bittorrent/src/Network/BitTorrent/Tracker/Message.hs
+++ b/bittorrent/src/Network/BitTorrent/Tracker/Message.hs
@@ -404,8 +404,8 @@ parseAnnounceQuery params = AnnounceQuery
 --   For more info see: <http://www.bittorrent.org/beps/bep_0023.html>
 --
 data PeerList ip
-  = PeerList        [PeerAddr IP]
-  | CompactPeerList [PeerAddr ip]
+  = PeerList        [PeerAddr]
+  | CompactPeerList [PeerAddr]
     deriving (Show, Eq, Typeable, Functor)
 
 -- | The empty non-compact peer list.
@@ -413,11 +413,11 @@ instance Default (PeerList IP) where
   def = PeerList []
   {-# INLINE def #-}
 
-getPeerList :: PeerList IP -> [PeerAddr IP]
+getPeerList :: PeerList IP -> [PeerAddr]
 getPeerList (PeerList        xs) = xs
 getPeerList (CompactPeerList xs) = xs
 
-instance Serialize a => BEncode (PeerList a) where
+instance BEncode (PeerList a) where
   toBEncode (PeerList        xs) = toBEncode xs
   toBEncode (CompactPeerList xs) = toBEncode $ runPut (mapM_ put xs)
 
@@ -491,10 +491,10 @@ instance BEncode AnnounceInfo where
             | L.null v6s = (CompactPeerList v4s, Nothing)
             | otherwise  = (CompactPeerList v4s, Just (CompactPeerList v6s))
 
-          toEither :: PeerAddr IP -> Either (PeerAddr IPv4) (PeerAddr IPv6)
+          toEither :: PeerAddr -> Either PeerAddr PeerAddr
           toEither PeerAddr {..} = case peerHost of
-            IPv4 ipv4 -> Left  $ PeerAddr peerId ipv4 peerPort
-            IPv6 ipv6 -> Right $ PeerAddr peerId ipv6 peerPort
+            ipv4@IPv4{} -> Left  $ PeerAddr peerId ipv4 peerPort
+            ipv6@IPv6{} -> Right $ PeerAddr peerId ipv6 peerPort
 
   fromBEncode (BDict d)
     | Just t <- BE.lookup "failure reason" d = Failure <$> fromBEncode t
@@ -514,7 +514,7 @@ instance BEncode AnnounceInfo where
                          \but the `peers6' field present"
 
       merge (CompactPeerList ipv4s) Nothing
-        = pure $ CompactPeerList (fmap IPv4 <$> ipv4s)
+        = pure $ CompactPeerList ipv4s
 
       merge (CompactPeerList _    ) (Just (PeerList _))
         = fail "PeerList: the `peers6' field value \
@@ -522,7 +522,7 @@ instance BEncode AnnounceInfo where
 
       merge (CompactPeerList ipv4s) (Just (CompactPeerList ipv6s))
         = pure $ CompactPeerList $
-                 (fmap IPv4 <$> ipv4s) <> (fmap IPv6 <$> ipv6s)
+                 ipv4s <> ipv6s
 
   fromBEncode _ = decodingError "Announce info"
 
@@ -533,13 +533,13 @@ instance Serialize AnnounceInfo where
     putWord32be $ fromIntegral respInterval
     putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete
     putWord32be $ fromIntegral $ fromMaybe 0 respComplete
-    forM_ (fmap ipv4 <$> getPeerList respPeers) put
+    forM_ (getPeerList respPeers) put
 
   get = do
     interval <- getWord32be
     leechers <- getWord32be
     seeders  <- getWord32be
-    peers    <- many $ fmap IPv4 <$> get
+    peers    <- many $ isolate 6 get -- isolated to specify IPv4.
 
     return $ AnnounceInfo {
         respWarning     = Nothing
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
index 9b6e056a..6f7a53bf 100644
--- a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
+++ b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
@@ -129,7 +129,7 @@ fillRequest Options {..} q r = r
 
 httpTracker :: BEncode a => Manager -> URI -> SimpleQuery -> IO a
 httpTracker Manager {..} uri q = packHttpException $ do
-  request  <- fillRequest options q <$> setUri def {- http-client instance for Request -} uri
+  request  <- fillRequest options q <$> setUri defaultRequest uri
   response <- runResourceT $ httpLbs request httpMgr
   case BE.decode $ BL.toStrict $ responseBody response of
     Left  msg  -> throwIO (ParserFailure msg)
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/Session.hs b/bittorrent/src/Network/BitTorrent/Tracker/Session.hs
index aa4a832f..db6ebaff 100644
--- a/bittorrent/src/Network/BitTorrent/Tracker/Session.hs
+++ b/bittorrent/src/Network/BitTorrent/Tracker/Session.hs
@@ -98,7 +98,7 @@ data TrackerSession = TrackerSession
     statusSent    :: !(Maybe Status)
 
     -- | Can be used to retrieve peer set.
-  , trackerPeers  :: Cached [PeerAddr IP]
+  , trackerPeers  :: Cached [PeerAddr]
 
     -- | Can be used to show brief swarm stats in client GUI.
   , trackerScrape :: Cached LastScrape
@@ -129,7 +129,7 @@ nextStatus Completed = Nothing -- must keep previous status
 seconds :: Int -> NominalDiffTime
 seconds n = realToFrac (toEnum n :: Uni)
 
-cachePeers :: AnnounceInfo -> IO (Cached [PeerAddr IP])
+cachePeers :: AnnounceInfo -> IO (Cached [PeerAddr])
 cachePeers AnnounceInfo {..} =
   newCached (seconds respInterval)
             (seconds (fromMaybe respInterval respMinInterval))
@@ -264,7 +264,7 @@ notify mgr ses event = do
 -- TODO run announce if sesion have no peers
 -- | The returned list of peers can have duplicates.
 --   This function /may/ block. Use async if needed.
-askPeers :: Manager -> Session -> IO [PeerAddr IP]
+askPeers :: Manager -> Session -> IO [PeerAddr]
 askPeers _mgr ses = do
   list    <- readMVar (sessionTrackers ses)
   L.concat <$> collect (tryTakeData . trackerPeers) list