Update client example

3 files changed, 80 insertions, 4 deletions

diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs
index fc2b904a..a6151857 100644
--- a/src/Network/BitTorrent/Client.hs
+++ b/src/Network/BitTorrent/Client.hs
@@ -1,16 +1,21 @@
 module Network.BitTorrent.Client
        ( Options (..)
-       , Client (..)
+       , Client
+       , newClient
+       , addTorrent
        ) where
 
+import Control.Concurrent.STM
 import Data.Default
 import Data.Function
+import Data.HashMap.Strict as HM
 import Data.Ord
 import Data.Text
 import Network
 
 import Data.Torrent
 import Data.Torrent.InfoHash
+import Network.BitTorrent.Client.Swarm
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Message
 
@@ -19,6 +24,7 @@ data Options = Options
   { fingerprint :: Fingerprint
   , name        :: Text
   , port        :: PortNumber
+  , extensions  :: [Extension]
   }
 
 instance Default Options where
@@ -26,11 +32,14 @@ instance Default Options where
     { fingerprint = def
     , name        = "hs-bittorrent"
     , port        = 6882
+    , extensions  = []
     }
 
 data Client = Client
-  { clientPeerId      :: !PeerId
-  , allowedExtensions :: !Caps
+  { clientPeerId       :: !PeerId
+  , clientListenerPort :: !PortNumber
+  , allowedExtensions  :: !Caps
+  , torrents           :: TVar (HashMap InfoHash Swarm)
   }
 
 instance Eq Client where
@@ -38,3 +47,21 @@ instance Eq Client where
 
 instance Ord Client where
   compare = comparing clientPeerId
+
+newClient :: Options -> IO Client
+newClient Options {..} = do
+  pid <- genPeerId
+  ts  <- newTVarIO HM.empty
+  return Client
+    { clientPeerId       = pid
+    , clientListenerPort = port
+    , allowedExtensions  = toCaps extensions
+    , torrents           = ts
+    }
+
+addTorrent :: Torrent -> Client -> IO ()
+addTorrent t Client {..} = do
+  leecher <- newLeecher clientPeerId clientListenerPort t
+  let ih = idInfoHash (tInfoDict t)
+  atomically $ modifyTVar' torrents (HM.insert ih leecher)
+  askPeers leecher >>= print
\ No newline at end of file
diff --git a/src/Network/BitTorrent/Client/Swarm.hs b/src/Network/BitTorrent/Client/Swarm.hs
new file mode 100644
index 00000000..a9dca048
--- /dev/null
+++ b/src/Network/BitTorrent/Client/Swarm.hs
@@ -0,0 +1,49 @@
+module Network.BitTorrent.Client.Swarm
+       ( Swarm
+       , newLeecher
+       , askPeers
+       ) where
+
+import Data.Default
+import Network
+
+import Data.Torrent
+import Data.Torrent.InfoHash
+import Network.BitTorrent.Core
+import Network.BitTorrent.Tracker.Message
+import Network.BitTorrent.Tracker.RPC as RPC
+
+
+data Swarm = Swarm
+  { swarmTopic   :: InfoHash
+  , thisPeerId   :: PeerId
+  , listenerPort :: PortNumber
+  , trackerConn  :: Tracker
+--  , infoDict     ::
+  }
+
+newLeecher :: PeerId -> PortNumber -> Torrent -> IO Swarm
+newLeecher pid port Torrent {..} = do
+  tracker <- connect tAnnounce
+  return Swarm
+    { swarmTopic   = idInfoHash tInfoDict
+    , thisPeerId   = pid
+    , listenerPort = port
+    , trackerConn  = tracker
+    }
+
+getAnnounceQuery :: Swarm -> AnnounceQuery
+getAnnounceQuery Swarm {..} = AnnounceQuery
+  { reqInfoHash = swarmTopic
+  , reqPeerId   = thisPeerId
+  , reqPort     = listenerPort
+  , reqProgress = def
+  , reqIP       = Nothing
+  , reqNumWant  = Nothing
+  , reqEvent    = Nothing
+  }
+
+askPeers :: Swarm -> IO [PeerAddr]
+askPeers s @ Swarm {..} = do
+  AnnounceInfo {..} <- RPC.announce (getAnnounceQuery s) trackerConn
+  return (getPeerList respPeers)
diff --git a/src/Network/BitTorrent/Tracker/Wai.hs b/src/Network/BitTorrent/Tracker/Wai.hs
index c43c7a3a..69510fa0 100644
--- a/src/Network/BitTorrent/Tracker/Wai.hs
+++ b/src/Network/BitTorrent/Tracker/Wai.hs
@@ -79,7 +79,7 @@ getAnnounceR = undefined
 getScrapeR :: TrackerSettings -> ScrapeQuery -> ResourceT IO ScrapeInfo
 getScrapeR = undefined
 
--- content-type: "text/plain" ?
+-- content-type: "text/plain"!
 tracker :: TrackerSettings -> Application
 tracker settings Request {..}
   | requestMethod /= methodGet