4 files changed, 105 insertions, 139 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 91d227b2..af6caefa 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -72,7 +72,6 @@ library
                        Network.BitTorrent.Exchange.Assembler
                        Network.BitTorrent.Exchange.Block
                        Network.BitTorrent.Exchange.Connection
-                       Network.BitTorrent.Exchange.Connection.Status
                        Network.BitTorrent.Exchange.Manager
                        Network.BitTorrent.Exchange.Message
                        Network.BitTorrent.Exchange.Selection
diff --git a/src/Network/BitTorrent/Exchange/Connection.hs b/src/Network/BitTorrent/Exchange/Connection.hs
index dde9a468..fd9022da 100644
--- a/src/Network/BitTorrent/Exchange/Connection.hs
+++ b/src/Network/BitTorrent/Exchange/Connection.hs
@@ -49,6 +49,19 @@ module Network.BitTorrent.Exchange.Connection
        , connSession
        , connStats
 
+         -- ** Status
+       , PeerStatus (..)
+       , ConnectionStatus (..)
+       , updateStatus
+       , statusUpdates
+       , clientStatus
+       , remoteStatus
+       , canUpload
+       , canDownload
+       , defaultUnchokeSlots
+       , defaultRechokeInterval
+
+
          -- * Setup
        , ConnectionPrefs  (..)
        , SessionLink      (..)
@@ -102,21 +115,21 @@ import Control.Monad.State
 import Control.Lens
 import Data.ByteString as BS
 import Data.ByteString.Lazy as BSL
-import Data.Conduit
+import Data.Conduit as C
 import Data.Conduit.Cereal
 import Data.Conduit.List
 import Data.Conduit.Network
 import Data.Default
 import Data.IORef
 import Data.List as L
-import Data.Maybe
+import Data.Maybe as M
 import Data.Monoid
 import Data.Serialize as S
 import Data.Typeable
 import Network
 import Network.Socket hiding (Connected)
 import Network.Socket.ByteString as BS
-import Text.PrettyPrint as PP hiding (($$), (<>))
+import Text.PrettyPrint as PP hiding ((<>))
 import Text.PrettyPrint.Class
 import Text.Show.Functions ()
 import System.Log.FastLogger (ToLogStr(..))
@@ -125,7 +138,6 @@ import System.Timeout
 import Data.Torrent.Bitfield as BF
 import Data.Torrent.InfoHash
 import Network.BitTorrent.Core
-import Network.BitTorrent.Exchange.Connection.Status
 import Network.BitTorrent.Exchange.Message as Msg
 
 -- TODO handle port message?
@@ -463,6 +475,93 @@ instance Default Options where
     }
 
 {-----------------------------------------------------------------------
+--  Peer status
+-----------------------------------------------------------------------}
+
+-- | Connections contain two bits of state on either end: choked or
+-- not, and interested or not.
+data PeerStatus = PeerStatus
+  { -- | Choking is a notification that no data will be sent until
+    -- unchoking happens.
+    _choking    :: !Bool
+
+    -- |
+  , _interested :: !Bool
+  } deriving (Show, Eq, Ord)
+
+$(makeLenses ''PeerStatus)
+
+instance Pretty PeerStatus where
+  pretty PeerStatus {..} =
+    pretty (Choking _choking) <+> "and" <+> pretty (Interested _interested)
+
+-- | Connections start out choked and not interested.
+instance Default PeerStatus where
+  def = PeerStatus True False
+
+instance Monoid PeerStatus where
+  mempty      = def
+  mappend a b = PeerStatus
+    { _choking    = _choking    a && _choking    b
+    , _interested = _interested a || _interested b
+    }
+
+-- | Can be used to update remote peer status using incoming 'Status'
+-- message.
+updateStatus :: StatusUpdate -> PeerStatus -> PeerStatus
+updateStatus (Choking    b) = choking    .~ b
+updateStatus (Interested b) = interested .~ b
+
+-- | Can be used to generate outcoming messages.
+statusUpdates :: PeerStatus -> PeerStatus -> [StatusUpdate]
+statusUpdates a b = M.catMaybes $
+  [ if _choking    a == _choking    b then Nothing
+    else Just $ Choking    $ _choking    b
+  , if _interested a == _interested b then Nothing
+    else Just $ Interested $ _interested b
+  ]
+
+{-----------------------------------------------------------------------
+--  Connection status
+-----------------------------------------------------------------------}
+
+-- | Status of the both endpoints.
+data ConnectionStatus = ConnectionStatus
+  { _clientStatus :: !PeerStatus
+  , _remoteStatus :: !PeerStatus
+  } deriving (Show, Eq)
+
+$(makeLenses ''ConnectionStatus)
+
+instance Pretty ConnectionStatus where
+  pretty ConnectionStatus {..} =
+    "this  " PP.<+> pretty _clientStatus PP.$$
+    "remote" PP.<+> pretty _remoteStatus
+
+-- | Connections start out choked and not interested.
+instance Default ConnectionStatus where
+  def = ConnectionStatus def def
+
+-- | Can the client transfer to the remote peer?
+canUpload :: ConnectionStatus -> Bool
+canUpload ConnectionStatus {..}
+  = _interested _remoteStatus && not (_choking _clientStatus)
+
+-- | Can the client transfer from the remote peer?
+canDownload :: ConnectionStatus -> Bool
+canDownload ConnectionStatus {..}
+  = _interested _clientStatus && not (_choking _remoteStatus)
+
+-- | Indicates how many peers are allowed to download from the client
+-- by default.
+defaultUnchokeSlots :: Int
+defaultUnchokeSlots = 4
+
+-- |
+defaultRechokeInterval :: Int
+defaultRechokeInterval = 10 * 1000 * 1000
+
+{-----------------------------------------------------------------------
 --  Connection
 -----------------------------------------------------------------------}
 
@@ -681,7 +780,7 @@ runWire action sock chan conn = flip runReaderT conn $ runConnected $
     conduitGet S.get       $=
       trackFlow RemotePeer $=
          action            $=
-      trackFlow ThisPeer   $$
+      trackFlow ThisPeer   C.$$
     sinkChan chan
 
 -- | This function will block until a peer send new message. You can
@@ -835,7 +934,7 @@ closePending PendingConnection {..} = do
 
 chanToSock :: Int -> Chan Message -> Socket -> IO ()
 chanToSock ka chan sock =
-  sourceChan ka chan $= conduitPut S.put $$ sinkSocket sock
+  sourceChan ka chan $= conduitPut S.put C.$$ sinkSocket sock
 
 afterHandshaking :: ChannelSide -> PeerAddr IP -> Socket -> HandshakePair
                  -> ConnectionConfig s -> IO ()
diff --git a/src/Network/BitTorrent/Exchange/Connection/Status.hs b/src/Network/BitTorrent/Exchange/Connection/Status.hs
deleted file mode 100644
index f6abc580..00000000
--- a/src/Network/BitTorrent/Exchange/Connection/Status.hs
+++ /dev/null
@@ -1,131 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   Each P2P connection endpoint should keep track status of both
---   sides.
---
-{-# LANGUAGE TemplateHaskell   #-}
-module Network.BitTorrent.Exchange.Connection.Status
-       ( -- * Peer status
-         PeerStatus(..)
-       , choking
-       , interested
-
-         -- ** Query
-       , updateStatus
-       , statusUpdates
-
-         -- * Connection status
-       , ConnectionStatus(..)
-       , clientStatus
-       , remoteStatus
-
-         -- ** Query
-       , canUpload
-       , canDownload
-
-         -- * Extra
-       , defaultUnchokeSlots
-       , defaultRechokeInterval
-       ) where
-
-import Control.Lens
-import Data.Default
-import Data.Maybe
-import Data.Monoid
-import Text.PrettyPrint as PP hiding ((<>))
-import Text.PrettyPrint.Class
-
-import Network.BitTorrent.Exchange.Message
-
-
-{-----------------------------------------------------------------------
---  Peer status
------------------------------------------------------------------------}
-
--- | Connections contain two bits of state on either end: choked or
--- not, and interested or not.
-data PeerStatus = PeerStatus
-  { -- | Choking is a notification that no data will be sent until
-    -- unchoking happens.
-    _choking    :: !Bool
-
-    -- |
-  , _interested :: !Bool
-  } deriving (Show, Eq, Ord)
-
-$(makeLenses ''PeerStatus)
-
-instance Pretty PeerStatus where
-  pretty PeerStatus {..} =
-    pretty (Choking _choking) <+> "and" <+> pretty (Interested _interested)
-
--- | Connections start out choked and not interested.
-instance Default PeerStatus where
-  def = PeerStatus True False
-
-instance Monoid PeerStatus where
-  mempty      = def
-  mappend a b = PeerStatus
-    { _choking    = _choking    a && _choking    b
-    , _interested = _interested a || _interested b
-    }
-
--- | Can be used to update remote peer status using incoming 'Status'
--- message.
-updateStatus :: StatusUpdate -> PeerStatus -> PeerStatus
-updateStatus (Choking    b) = choking    .~ b
-updateStatus (Interested b) = interested .~ b
-
--- | Can be used to generate outcoming messages.
-statusUpdates :: PeerStatus -> PeerStatus -> [StatusUpdate]
-statusUpdates a b = catMaybes $
-  [ if _choking    a == _choking    b then Nothing
-    else Just $ Choking    $ _choking    b
-  , if _interested a == _interested b then Nothing
-    else Just $ Interested $ _interested b
-  ]
-
-{-----------------------------------------------------------------------
---  Connection status
------------------------------------------------------------------------}
-
--- | Status of the both endpoints.
-data ConnectionStatus = ConnectionStatus
-  { _clientStatus :: !PeerStatus
-  , _remoteStatus :: !PeerStatus
-  } deriving (Show, Eq)
-
-$(makeLenses ''ConnectionStatus)
-
-instance Pretty ConnectionStatus where
-  pretty ConnectionStatus {..} =
-    "this  " <+> pretty _clientStatus $$
-    "remote" <+> pretty _remoteStatus
-
--- | Connections start out choked and not interested.
-instance Default ConnectionStatus where
-  def = ConnectionStatus def def
-
--- | Can the client transfer to the remote peer?
-canUpload :: ConnectionStatus -> Bool
-canUpload ConnectionStatus {..}
-  = _interested _remoteStatus && not (_choking _clientStatus)
-
--- | Can the client transfer from the remote peer?
-canDownload :: ConnectionStatus -> Bool
-canDownload ConnectionStatus {..}
-  = _interested _clientStatus && not (_choking _remoteStatus)
-
--- | Indicates how many peers are allowed to download from the client
--- by default.
-defaultUnchokeSlots :: Int
-defaultUnchokeSlots = 4
-
--- |
-defaultRechokeInterval :: Int
-defaultRechokeInterval = 10 * 1000 * 1000
\ No newline at end of file
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index 91ea8da9..6f480ce4 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -54,7 +54,6 @@ import Network.BitTorrent.Internal.Types
 import Network.BitTorrent.Core
 import Network.BitTorrent.Exchange.Block   as Block
 import Network.BitTorrent.Exchange.Connection
-import Network.BitTorrent.Exchange.Connection.Status
 import Network.BitTorrent.Exchange.Message as Message
 import Network.BitTorrent.Exchange.Session.Metadata as Metadata
 import Network.BitTorrent.Exchange.Session.Status   as SS