From 1d4b5f97c4323895d77aa197c3faf832c538aed9 Mon Sep 17 00:00:00 2001
From: Sam T <pxqr.sta@gmail.com>
Date: Fri, 28 Jun 2013 23:44:45 +0400
Subject: + Default P2P.

---
 src/Network/BitTorrent.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

(limited to 'src/Network/BitTorrent.hs')

diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index ec0adb51..b97db4b0 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -73,6 +73,7 @@ import Control.Monad.Reader
 
 import Network
 
+import Data.Bitfield
 import Data.Torrent
 import Network.BitTorrent.Internal
 import Network.BitTorrent.Exchange
@@ -81,6 +82,8 @@ import Network.BitTorrent.Tracker
 import Network.BitTorrent.Extension
 import Network.BitTorrent.Peer
 
+import System.Torrent.Storage
+
 
 -- | Client session with default parameters. Use it for testing only.
 defaultClient :: IO ClientSession
@@ -105,3 +108,33 @@ discover swarm action = do
       addr <- getPeerAddr tses
       spawnP2P swarm addr $ do
         action
+
+-- Event translation table looks like:
+--
+--   Available -> Want
+--   Want      -> Fragment
+--   Fragment  -> Available
+--
+-- If we join the chain we get the event loop:
+--
+--   Available -> Want -> Fragment --\
+--      /|\                           |
+--       \---------------------------/
+--
+
+-- | Default P2P action.
+exchange :: Storage -> P2P ()
+exchange storage = handleEvent handler
+  where
+    handler (Available bf)
+      | Just m <- findMin bf = return (Want (BlockIx m 0 10))
+      |     otherwise        = error "impossible"
+                               -- TODO findMin :: Bitfield -> PieceIx
+
+    handler (Want     bix) = do
+      blk <- liftIO $ getBlk bix storage
+      return (Fragment blk)
+
+    handler (Fragment blk) = do
+      liftIO $ putBlk blk storage
+      return (Available (singleton (blkPiece blk) (error "singleton") ))
-- 
cgit v1.2.3