src/Network/BitTorrent/Exchange/Manager.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

module Network.BitTorrent.Exchange.Manager
       ( Options (..)
       , Manager
       , Handler
       , newManager
       , closeManager
       ) where

import Control.Concurrent
import Control.Exception hiding (Handler)
import Control.Monad
import Data.Default
import Network.Socket

import Network.BitTorrent.Core


data Options = Options
  { optBacklog  :: Int
  , optPeerAddr :: PeerAddr IP
  } deriving (Show, Eq)

instance Default Options where
  def = Options
    { optBacklog  = maxListenQueue
    , optPeerAddr = def
    }

data Manager = Manager
  { listener :: !ThreadId
  }

type Handler = Socket -> PeerAddr IP -> IO ()

listenIncoming :: Options -> Handler -> IO ()
listenIncoming Options {..} handler = do
  bracket (socket AF_INET Stream defaultProtocol) close $ \ sock -> do
    bind sock (toSockAddr optPeerAddr)
    listen sock optBacklog
    forever $ do
      (conn, addr) <- accept sock
      case fromSockAddr addr of
        Nothing    -> return ()
        Just paddr -> do
          forkIO $ handler conn paddr
          return ()

newManager :: Options -> Handler -> IO Manager
newManager opts handler = do
  tid <- forkIO $ listenIncoming opts handler
  return (Manager tid)

closeManager :: Manager -> IO ()
closeManager Manager {..} = do
  killThread listener