src/FuncTorrent/Server.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module FuncTorrent.Server where
   3
   4 import Control.Concurrent (forkIO)
   5 import Control.Monad (forever)
   6 import Network (withSocketsDo, listenOn, accept, Socket, PortID ( PortNumber ))
   7 import System.IO (hSetBuffering, BufferMode ( NoBuffering ))
   8
   9 import FuncTorrent.Metainfo (Metainfo)
  10 import FuncTorrent.Peer (handlePeerMsgs, Peer(..), PieceMap)
  11 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
  12
  13 -- server is listening on any port from 6881 - 6889
  14 -- return the port number used
  15 start :: IO (Socket, PortID)
  16 start = withSocketsDo $ do
  17   let portnums = [6881 .. 6889]
  18   sock <- listenOn $ PortNumber $ fromIntegral (head portnums)
  19   return (sock, PortNumber $ head portnums)
  20
  21 run :: Socket -> String -> Metainfo -> PieceMap -> FS.MsgChannel -> IO ()
  22 run listenSock peerid m pieceMap c = forever $ do
  23   (handle, ip, port) <- accept listenSock
  24   let peer = Peer "" ip (fromIntegral port)
  25   hSetBuffering handle NoBuffering
  26   forkIO $ handlePeerMsgs peer peerid m pieceMap False c