src/main/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import Prelude hiding (log, length, readFile, getContents)
   5
   6 import Control.Concurrent (forkIO)
   7 import Data.ByteString.Char8 (ByteString, getContents, readFile, unpack)
   8 import System.Environment (getArgs)
   9 import System.Exit (exitSuccess)
  10 import System.Directory (doesFileExist)
  11 import System.Random (getStdGen, randomRs)
  12
  13 import FuncTorrent.Logger (initLogger, logMessage, logStop)
  14 import FuncTorrent.Metainfo (Info(..), Metainfo(..), torrentToMetainfo)
  15 import FuncTorrent.Peer (handlePeerMsgs)
  16 import qualified FuncTorrent.Server as Server
  17 import FuncTorrent.Tracker (peers, getTrackerResponse)
  18
  19 logError :: String -> (String -> IO ()) -> IO ()
  20 logError e logMsg = logMsg $ "parse error: \n" ++ e
  21
  22 exit :: IO ByteString
  23 exit = exitSuccess
  24
  25 usage :: IO ()
  26 usage = putStrLn "usage: functorrent torrent-file"
  27
  28 parse :: [String] -> IO ByteString
  29 parse [] = getContents
  30 parse [a] = do
  31   fileExist <- doesFileExist a
  32   if fileExist
  33     then readFile a
  34     else error "file does not exist"
  35 parse _ = exit
  36
  37 -- peer id is exactly 20 bytes long.
  38 -- peer id starts with '-', followed by 2 char client id'
  39 -- followed by 4 ascii digits for version number, followed by
  40 -- a '-'. Rest are random digits to fill the 20 bytes.
  41 mkPeerID :: IO String
  42 mkPeerID = do
  43   stdgen <- getStdGen
  44   let digits = randomRs (0, 9) stdgen :: [Integer]
  45   return $ "-HS9001-" ++ (concatMap show $ take (20 - 8) digits)
  46
  47 main :: IO ()
  48 main = do
  49     args <- getArgs
  50     logR <- initLogger
  51     peerId <- mkPeerID
  52     let log = logMessage logR
  53     log "Starting up functorrent"
  54     log $ "Parsing arguments " ++ concat args
  55     torrentStr <- parse args
  56     case torrentToMetainfo torrentStr of
  57      Left e -> logError e log
  58      Right m -> do
  59        log "Input File OK"
  60        log $ "Downloading file : " ++ name (info m)
  61
  62        log $ "starting server"
  63        (serverSock, portnum) <- Server.start
  64        log "Trying to fetch peers"
  65        forkIO $ Server.run serverSock peerId m
  66        log $ "Trackers: " ++ head (announceList m)
  67        trackerResp <- getTrackerResponse peerId m
  68        case  trackerResp of
  69         Left e -> log $ "Error" ++ unpack e
  70         Right peerList -> do
  71           log $ "Peers List : " ++ (show . peers $ peerList)
  72           let p1 = head (peers peerList)
  73           handlePeerMsgs p1 peerId m
  74     logStop logR