src/main/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import Prelude hiding (log, length, readFile, getContents)
   5
   6 import Control.Monad.Reader(runReaderT)
   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
  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 peerId :: String
  21 peerId = "-HS0001-*-*-20150215"
  22
  23 exit :: IO ByteString
  24 exit = exitSuccess
  25
  26 usage :: IO ()
  27 usage = putStrLn "usage: functorrent torrent-file"
  28
  29 parse :: [String] -> IO ByteString
  30 parse [] = getContents
  31 parse [a] = do
  32   fileExist <- doesFileExist a
  33   if fileExist
  34     then readFile a
  35     else error "file does not exist"
  36 parse _ = exit
  37
  38 main :: IO ()
  39 main = do
  40     args <- getArgs
  41     logR <- initLogger
  42     let log = logMessage logR
  43     log "Starting up functorrent"
  44     log $ "Parsing arguments " ++ concat args
  45     torrentStr <- parse args
  46     case torrentToMetainfo torrentStr of
  47      Left e -> logError e log
  48      Right m -> do
  49        log "Input File OK"
  50        log $ "Downloading file : " ++ name (info m)
  51        log "Trying to fetch peers"
  52
  53        log $ "Trackers: " ++ head (announceList m)
  54        trackerResp <- runReaderT (getTrackerResponse peerId) m
  55        case  trackerResp of
  56         Left e -> log $ "Error" ++ unpack e
  57         Right peerList -> do
  58           log $ "Peers List : " ++ (show . peers $ peerList)
  59           let p1 = head (peers peerList)
  60           handlePeerMsgs p1 peerId m
  61     logStop logR