src/main/Main.hs

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