+ Add session exception.

1 files changed, 26 insertions, 1 deletions

diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index da104240..a3e1a5cd 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -16,6 +16,7 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -23,20 +24,31 @@
 module Network.BitTorrent.Internal
        ( Progress(..), startProgress
 
+         -- * Client
        , ClientSession (clientPeerID, allowedExtensions)
        , newClient, getCurrentProgress
 
+         -- * Swarm
        , SwarmSession(SwarmSession, torrentMeta, clientSession)
        , newLeacher, newSeeder
 
+         -- * Peer
        , PeerSession(PeerSession, connectedPeerAddr
                     , swarmSession, enabledExtensions
                     )
        , SessionState
+       , withPeerSession
+
+         -- ** Exceptions
+       , SessionException(..)
+       , isSessionException
+       , putSessionException
+       , sessionError
+
+         -- ** Properties
        , bitfield, status
        , emptyBF, fullBF, singletonBF, adjustBF
        , getPieceCount, getClientBF
-       , sessionError, withPeerSession
 
          -- * Timeouts
        , updateIncoming, updateOutcoming
@@ -55,6 +67,7 @@ import Data.Default
 import Data.Function
 import Data.Ord
 import Data.Set as S
+import Data.Typeable
 
 import Data.Serialize hiding (get)
 import Text.PrettyPrint
@@ -212,6 +225,7 @@ data PeerSession = PeerSession {
     -- to avoid reduntant KA messages.
   , outcomingTimeout   :: TimeoutKey
 
+    -- TODO use dupChan for broadcasting
   , broadcastMessages :: Chan   [Message]
   , sessionState      :: IORef   SessionState
   }
@@ -234,6 +248,17 @@ instance (MonadIO m, MonadReader PeerSession m)
   get   = asks sessionState >>= liftIO . readIORef
   put s = asks sessionState >>= \ref -> liftIO $ writeIORef ref s
 
+data SessionException = SessionException
+                        deriving (Show, Typeable)
+
+instance Exception SessionException
+
+isSessionException :: Monad m => SessionException -> m ()
+isSessionException _ = return ()
+
+putSessionException :: SessionException -> IO ()
+putSessionException = print
+
 sessionError :: MonadIO m => Doc -> m ()
 sessionError msg
   = liftIO $ throwIO $ userError $ render $ msg <+> "in session"