From fe546e6c3926019efd614787f6c2e8cf12469aed Mon Sep 17 00:00:00 2001
From: Sam T <pxqr.sta@gmail.com>
Date: Mon, 6 May 2013 04:53:59 +0400
Subject: + Add Peer.Status module.

---
 src/Network/BitTorrent/Peer.hs        |  3 +-
 src/Network/BitTorrent/Peer/Status.hs | 65 +++++++++++++++++++++++++++++++++++
 2 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100644 src/Network/BitTorrent/Peer/Status.hs

(limited to 'src')

diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index ff32feb5..660f146f 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -13,4 +13,5 @@ module Network.BitTorrent.Peer
 
 import Network.BitTorrent.Peer.Addr as P
 import Network.BitTorrent.Peer.ClientInfo as P
-import Network.BitTorrent.Peer.ID as P
\ No newline at end of file
+import Network.BitTorrent.Peer.ID as P
+import Network.BitTorrent.Peer.Status as P
\ No newline at end of file
diff --git a/src/Network/BitTorrent/Peer/Status.hs b/src/Network/BitTorrent/Peer/Status.hs
new file mode 100644
index 00000000..806ba77d
--- /dev/null
+++ b/src/Network/BitTorrent/Peer/Status.hs
@@ -0,0 +1,65 @@
+-- |
+--   Copyright   :  (c) Sam T. 2013
+--   License     :  MIT
+--   Maintainer  :  pxqr.sta@gmail.com
+--   Stability   :  experimental
+--   Portability :  portable
+--
+module Network.BitTorrent.Peer.Status
+       ( PeerStatus(..)
+       , setChoking, setInterested
+       , initPeerStatus
+
+       , SessionStatus(..)
+       , initSessionStatus
+       , setClientStatus, setPeerStatus
+       , canUpload, canDownload
+
+       -- * Defaults
+       , defaultUnchokeSlots
+       ) where
+
+data PeerStatus = PeerStatus {
+    psChoking    :: Bool
+  , psInterested :: Bool
+  }
+
+-- | Any session between peers starts as choking and not interested.
+initPeerStatus :: PeerStatus
+initPeerStatus = PeerStatus True False
+
+setChoking :: Bool -> PeerStatus -> PeerStatus
+setChoking b ps = ps { psChoking = b }
+
+setInterested :: Bool -> PeerStatus -> PeerStatus
+setInterested b ps = ps { psInterested = b }
+
+
+
+data SessionStatus = SessionStatus {
+    seClientStatus :: PeerStatus
+  , sePeerStatus   :: PeerStatus
+  }
+
+initSessionStatus :: SessionStatus
+initSessionStatus = SessionStatus initPeerStatus initPeerStatus
+
+setClientStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus
+setClientStatus f ss = ss { seClientStatus = f (seClientStatus ss) }
+
+setPeerStatus :: (PeerStatus -> PeerStatus) -> SessionStatus -> SessionStatus
+setPeerStatus f ss = ss { sePeerStatus = f (sePeerStatus ss) }
+
+-- | Can the /client/ to upload to the /peer/?
+canUpload :: SessionStatus -> Bool
+canUpload SessionStatus { seClientStatus = client, sePeerStatus = peer}  =
+  psInterested peer && not (psChoking client)
+
+-- | Can the /client/ download from the /peer/?
+canDownload :: SessionStatus -> Bool
+canDownload SessionStatus { seClientStatus = client, sePeerStatus = peer }  =
+  psInterested client && not (psChoking peer)
+
+-- | Indicates have many peers are allowed to download from the client.
+defaultUnchokeSlots :: Int
+defaultUnchokeSlots = 4
\ No newline at end of file
-- 
cgit v1.2.3