7 files changed, 138 insertions, 24 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index e420beba..69a1207b 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -51,6 +51,7 @@ library
                        Data.Torrent.Tree
 --                     Network.BitTorrent
                        Network.BitTorrent.Client
+                       Network.BitTorrent.Client.Swarm
                        Network.BitTorrent.Core
                        Network.BitTorrent.Core.Fingerprint
                        Network.BitTorrent.Core.PeerId
@@ -95,7 +96,7 @@ library
                        -- Concurrency
 --                     , SafeSemaphore
 --                     , BoundedChan >= 1.0.1.0
---                     , stm         >= 2.4
+                     , stm         >= 2.4
 
                        -- Streaming
                      , conduit          >= 1.0
@@ -110,7 +111,7 @@ library
                      , intset       >= 0.1
                      , split        >= 0.2
                      , text         >= 0.11.0
---                     , unordered-containers
+                     , unordered-containers
                      , vector       >= 0.10
 
                        -- Hashing
@@ -211,3 +212,12 @@ test-suite spec
 --
 --                     , bittorrent
 --  ghc-options:         -O2 -Wall -fno-warn-orphans
+
+executable client-example
+  default-language:    Haskell2010
+  hs-source-dirs:      examples
+  main-is:             Client.hs
+  build-depends:       base        == 4.*
+                     , bittorrent
+                     , pretty-class
+                     , data-default
\ No newline at end of file
diff --git a/examples/Client.hs b/examples/Client.hs
new file mode 100644
index 00000000..efafba72
--- /dev/null
+++ b/examples/Client.hs
@@ -0,0 +1,17 @@
+module Main (main) where
+
+import Control.Concurrent
+import Data.Default
+import Data.Torrent
+import Network.BitTorrent.Client
+import System.Environment
+import Text.PrettyPrint.Class
+
+
+main :: IO ()
+main = do
+  [path]  <- getArgs
+  torrent <- fromFile path
+  client  <- newClient def
+  addTorrent torrent client
+  return ()
\ No newline at end of file
diff --git a/examples/Main.hs b/examples/Main.hs
deleted file mode 100644
index ef12cc70..00000000
--- a/examples/Main.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Main (main) where
-
-import Control.Concurrent
-import Network.BitTorrent
-import Network.BitTorrent.Sessions
-import System.Environment
-
-main :: IO ()
-main = do
-  [path]  <- getArgs
-  torrent <- fromFile path
-  print (contentLayout "./" (tInfo torrent))
-  let loc = TorrentLoc path "/tmp"
-
-  withDefaultClient (head defaultPorts) 3000 $ \ client -> do
-    openSwarmSession client loc
-    threadDelay 1000000000000
-    return ()
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
diff --git a/tests/Network/BitTorrent/Tracker/RPCSpec.hs b/tests/Network/BitTorrent/Tracker/RPCSpec.hs
new file mode 100644
index 00000000..6bc72e86
--- /dev/null
+++ b/tests/Network/BitTorrent/Tracker/RPCSpec.hs
@@ -0,0 +1,29 @@
+module Network.BitTorrent.Tracker.RPCSpec (spec) where
+import Control.Monad
+import Data.Default
+import Data.List as L
+import Network.URI
+import Test.Hspec
+
+import Network.BitTorrent.Tracker.MessageSpec hiding (spec)
+import Network.BitTorrent.Tracker.RPC.HTTPSpec as HTTP hiding (spec)
+import Network.BitTorrent.Tracker.RPC.UDPSpec as UDP hiding (spec)
+import Network.BitTorrent.Tracker.RPC as RPC
+
+uris :: [URI]
+uris = UDP.trackerURIs ++ HTTP.trackerURIs
+
+spec :: Spec
+spec = do
+  forM_ uris $ \ uri ->
+    context (show uri) $ do
+      describe "announce" $ do
+        it "have valid response" $ do
+          q    <- arbitrarySample
+          info <- connect uri >>= announce q
+          validateInfo q info
+
+      describe "scrape" $ do
+        it "have valid response" $ do
+          xs <- connect uri >>= scrape [def]
+          L.length xs `shouldSatisfy` (>= 1)