src/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Main where
   3
   4 import Prelude hiding (length, readFile, writeFile)
   5 import Data.ByteString.Char8 (ByteString, readFile, writeFile, length)
   6 import System.Environment (getArgs)
   7 import System.Exit (exitSuccess)
   8 import Text.ParserCombinators.Parsec (ParseError)
   9
  10 import FuncTorrent.Bencode (decode, BVal(..))
  11 import FuncTorrent.Logger (initLogger, logMessage, logStop)
  12 import FuncTorrent.Metainfo (announce, lengthInBytes, mkMetaInfo, info, name)
  13 import FuncTorrent.Peer (getPeers, getPeerResponse, handShakeMsg)
  14 import FuncTorrent.Tracker (connect, prepareRequest)
  15
  16 logError :: ParseError -> (String -> IO ()) -> IO ()
  17 logError e logMsg = logMsg $ "parse error: \n" ++ show e
  18
  19 peerId :: String
  20 peerId = "-HS0001-*-*-20150215"
  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 [] = usage >> exit
  30 parse [a] = readFile a
  31 parse _ = exit
  32
  33 main :: IO ()
  34 main = do
  35     args <- getArgs
  36     logR <- initLogger
  37     let logMsg = logMessage logR
  38     logMsg $ "Parsing input file: " ++ concat args
  39     torrentStr <- parse args
  40     case decode torrentStr of
  41       Right d ->
  42           case mkMetaInfo d of
  43             Nothing -> logMsg "parse error"
  44             Just m -> do
  45               logMsg "Input File OK"
  46
  47               let len = lengthInBytes $ info m
  48                   (Bdict d') = d
  49
  50               logMsg "Trying to fetch peers: "
  51               body <- connect (announce m) (prepareRequest d' peerId len)
  52
  53               -- TODO: Write to ~/.functorrent/caches
  54               writeFile (name (info m) ++ ".cache") body
  55
  56               let peerResponse = show $ getPeers $ getPeerResponse body
  57               logMsg $ "Peers List : " ++ peerResponse
  58
  59               let hsMsgLen = show $ length $ handShakeMsg d' peerId
  60               logMsg $ "Hand-shake message length : " ++ hsMsgLen
  61
  62       Left e -> logError e logMsg
  63     logStop logR