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
  12 -- server is listening on any port from 6881 - 6889
  13 -- return the port number used
  14 start :: IO (Socket, PortID)
  15 start = withSocketsDo $ do
  16   let portnums = [6881 .. 6889]
  17   sock <- listenOn $ PortNumber $ fromIntegral (head portnums)
  18   return (sock, PortNumber $ head portnums)
  19
  20 run :: Socket -> String -> Metainfo -> PieceMap -> IO ()
  21 run listenSock peerid m pieceMap = forever $ do
  22   (handle, ip, port) <- accept listenSock
  23   let peer = Peer "" ip (fromIntegral port)
  24   hSetBuffering handle NoBuffering
  25   forkIO $ handlePeerMsgs peer peerid m pieceMap False