6 files changed, 65 insertions, 26 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index fdcfc6d9..febea84e 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -58,6 +58,7 @@ library
 
 
   build-depends:
+                       -- Basic packages
                        base       == 4.*
                      , stm        >= 2.4
                      , mtl
@@ -90,6 +91,7 @@ library
                      , network-conduit      == 1.*
                      , cereal-conduit       >= 0.5
 
+                       -- Misc
                      , cryptohash
                      , filepath    >= 1
                      , bits-atomic >= 0.1
@@ -106,6 +108,7 @@ executable exsample
   hs-source-dirs:      exsamples
   build-depends:       base == 4.*
                      , bittorrent
+                     , mtl
 
 
 test-suite info-hash
diff --git a/exsamples/Main.hs b/exsamples/Main.hs
index b0224886..81958613 100644
--- a/exsamples/Main.hs
+++ b/exsamples/Main.hs
@@ -1,8 +1,10 @@
 module Main (main) where
 
+import Control.Concurrent
 import Data.Bitfield
 import Network.BitTorrent
 import System.Environment
+import Control.Monad.Reader
 
 
 main :: IO ()
@@ -13,8 +15,11 @@ main = do
   client  <- newClient []
   swarm   <- newLeacher  client torrent
 
-  discover swarm $ \se -> do
-    peers <- getPeerList se
-    print peers
+  discover swarm $ do
+    addr <- asks connectedPeerAddr
+    liftIO $ print $ "connected to" ++ show addr
+    e <- awaitEvent
+    liftIO $ print e
+    liftIO $ threadDelay (100 * 1000000)
 
-  print "Bye-bye!"
\ No newline at end of file
+  print "Bye-bye! =_="
\ No newline at end of file
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index c37129cb..8f0f42ce 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -7,35 +7,50 @@
 --
 {-# LANGUAGE RecordWildCards #-}
 module Network.BitTorrent
-       ( module BT
-       , module Data.Torrent
+       (
+         module Data.Torrent
 
-         -- * Tracker
+         -- * Session
+       , ClientSession
+       , newClient
 
-         -- * P2P
-       , ClientSession, newClient
-       , SwarmSession, newLeacher, newSeeder
-       , PeerSession
+       , SwarmSession
+       , newLeacher, newSeeder
+
+         -- * Discovery
        , discover
+
+         -- * Peer to Peer
+       , P2P, PeerSession
+            ( connectedPeerAddr, enabledExtensions
+            , peerBitfield, peerSessionStatus
+            )
+
+       , awaitEvent, signalEvent
        ) where
 
+import Control.Monad
 import Data.IORef
 
 import Data.Torrent
 import Network.BitTorrent.Internal
-import Network.BitTorrent.Extension as BT
-import Network.BitTorrent.Peer as BT
-import Network.BitTorrent.Exchange as BT
-import Network.BitTorrent.Tracker as BT
+import Network.BitTorrent.Exchange
+import Network.BitTorrent.Tracker
+
+
 
 -- discover should hide tracker and DHT communication under the hood
 -- thus we can obtain unified interface
 
-discover :: SwarmSession -> (TSession -> IO a) -> IO a
-discover SwarmSession {..} action = do
+discover :: SwarmSession -> P2P () -> IO ()
+discover swarm @ SwarmSession {..} action = do
   let conn = TConnection (tAnnounce torrentMeta) (tInfoHash torrentMeta)
                          (clientPeerID clientSession) port
   progress <- readIORef (currentProgress clientSession)
-  withTracker progress conn action
+  withTracker progress conn $ \tses -> do
+    forever $ do
+      addr <- getPeerAddr tses
+      withPeer swarm addr action
+
 
 port = 10000
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index dd1f9d0b..2173cf8b 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -45,6 +45,7 @@ import Data.Torrent
 data Event = Available Bitfield
            | Want
            | Block
+             deriving Show
 
 {-----------------------------------------------------------------------
     Peer wire
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index e231fb2c..39e10ce2 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -85,11 +85,16 @@ instance Ord ClientSession where
   compare = comparing clientPeerID
 
 newClient :: [Extension] -> IO ClientSession
-newClient exts = ClientSession <$> newPeerID
-                               <*> pure exts
-                               <*> newTVarIO S.empty
-                               <*> Ev.new
-                               <*> newIORef (startProgress 0)
+newClient exts = do
+  mgr <- Ev.new
+  forkIO $ loop mgr
+
+  ClientSession
+    <$> newPeerID
+    <*> pure exts
+    <*> newTVarIO S.empty
+    <*> pure mgr
+    <*> newIORef (startProgress 0)
 
 {-----------------------------------------------------------------------
     Swarm session
@@ -207,7 +212,7 @@ maxIncomingTime :: Int
 maxIncomingTime = 120 * sec
 
 maxOutcomingTime :: Int
-maxOutcomingTime = 60 * sec
+maxOutcomingTime = 1 * sec
 
 -- | Should be called after we have received any message from a peer.
 updateIncoming :: PeerSession -> IO ()
@@ -221,8 +226,13 @@ updateOutcoming PeerSession {..}  =
   updateTimeout (eventManager (clientSession swarmSession))
     outcomingTimeout maxOutcomingTime
 
-sendKA :: Socket -> IO ()
-sendKA sock = sendAll sock (encode BT.KeepAlive)
+sendKA :: Socket -> SwarmSession -> IO ()
+sendKA sock SwarmSession {..} = do
+  print "I'm sending keep alive."
+  sendAll sock (encode BT.KeepAlive)
+  let mgr = eventManager clientSession
+  updateTimeout mgr
+  print "Done.."
 
 abortSession :: IO ()
 abortSession = error "abortSession: not implemented"
diff --git a/tests/Main.hs b/tests/Main.hs
index f71f2b00..3a379f47 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -27,6 +27,11 @@ import Data.Torrent
 import Network.BitTorrent as BT
 import Network.BitTorrent.Exchange.Protocol
 import Network.BitTorrent.Tracker.Protocol
+import Network.BitTorrent.Extension
+import Network.BitTorrent.Exchange
+import Network.BitTorrent.Tracker
+import Network.BitTorrent.Peer
+
 -- import Debug.Trace