Make functorrent a library and an executable
authorJaseem Abid <jaseemabid@gmail.com>
Sat, 21 Mar 2015 14:02:57 +0000 (19:32 +0530)
committerJaseem Abid <jaseemabid@gmail.com>
Sat, 21 Mar 2015 14:02:57 +0000 (19:32 +0530)
This is a prerequisite for testing, as well as code organization.

1. `$ cabal repl` will build and import Functorrent library.
2. Making module exports explicit

15 files changed:
functorrent.cabal
src/Bencode.hs [deleted file]
src/FuncTorrent.hs [new file with mode: 0644]
src/FuncTorrent/Bencode.hs [new file with mode: 0644]
src/FuncTorrent/Logger.hs [new file with mode: 0644]
src/FuncTorrent/Metainfo.hs [new file with mode: 0644]
src/FuncTorrent/Peer.hs [new file with mode: 0644]
src/FuncTorrent/Tracker.hs [new file with mode: 0644]
src/FuncTorrent/Utils.hs [new file with mode: 0644]
src/Logger.hs [deleted file]
src/Main.hs
src/Metainfo.hs [deleted file]
src/Peer.hs [deleted file]
src/Tracker.hs [deleted file]
src/Utils.hs [deleted file]

index 915fe71f146619f34884980ec1b7ad4d45cb7a9c..e72f301bdbc7958f4d8b4a4b527666e794c30bff 100644 (file)
@@ -1,5 +1,5 @@
--- Initial functorrent.cabal generated by cabal init.  For further 
--- documentation, see http://haskell.org/cabal/users-guide/
+-- Initial functorrent.cabal generated by cabal init. For further documentation,
+-- see http://haskell.org/cabal/users-guide/
 
 name:                functorrent
 version:             0.1.0.0
@@ -9,28 +9,49 @@ license:             GPL-3
 license-file:        LICENSE
 author:              Ramakrishnan Muthukrishnan
 maintainer:          ram@rkrishnan.org
--- copyright:           
+-- copyright:
 category:            Network
 build-type:          Simple
--- extra-source-files:  
-cabal-version:       >=1.10
+extra-source-files:  README
+cabal-version:       >=1.18
 
-executable functorrent
-  main-is:             Main.hs
-  -- other-modules:       
-  -- other-extensions:    
+library
+  exposed-modules:     FuncTorrent
+                       FuncTorrent.Bencode,
+                       FuncTorrent.Logger,
+                       FuncTorrent.Metainfo,
+                       FuncTorrent.Peer,
+                       FuncTorrent.Tracker
+  other-extensions:    OverloadedStrings
+  hs-source-dirs:      src
+  ghc-options:         -Wall -fwarn-incomplete-patterns
+  default-language:    Haskell2010
   build-depends:       base,
                        HTTP,
                        base16-bytestring,
                        binary,
-                       bytestring,                    
+                       bytestring,
                        containers,
                        cryptohash,
                        doctest,
-                       network-uri, 
+                       network-uri,
                        parsec,
                        time
 
+executable functorrent
+  main-is:             Main.hs
+  other-extensions:    OverloadedStrings
   hs-source-dirs:      src
   ghc-options:         -Wall -fwarn-incomplete-patterns
   default-language:    Haskell2010
+  build-depends:       base,
+                       HTTP,
+                       base16-bytestring,
+                       binary,
+                       bytestring,
+                       containers,
+                       cryptohash,
+                       doctest,
+                       network-uri,
+                       parsec,
+                       time
diff --git a/src/Bencode.hs b/src/Bencode.hs
deleted file mode 100644 (file)
index 246fffc..0000000
+++ /dev/null
@@ -1,131 +0,0 @@
-module Bencode where
-
-import Control.Applicative ((<*))
-import Data.ByteString.Char8 (ByteString, pack, unpack)
-import Data.Functor ((<$>))
-import Data.Map.Strict (Map, fromList, keys, (!))
-import Text.ParserCombinators.Parsec
-import qualified Text.Parsec.ByteString as ParsecBS
-
-data BVal = Bint Integer
-          | Bstr ByteString
-          | Blist [BVal]
-          | Bdict InfoDict
-            deriving (Ord, Eq, Show)
-
-type InfoDict = Map BVal BVal
-
--- $setup
--- >>> import Data.Either
-
--- | parse strings
---
--- >>> parse bencStr "Bstr" (pack "4:spam")
--- Right "spam"
--- >>> parse bencStr "Bstr" (pack "0:")
--- Right ""
--- >>> parse bencStr "Bstr" (pack "0:hello")
--- Right ""
---
-bencStr :: ParsecBS.Parser ByteString
-bencStr = do _ <- spaces
-             ds <- many1 digit <* char ':'
-             s <- count (read ds) anyChar
-             return (pack s)
-
--- | parse integers
---
--- >>> parse bencInt "Bint" (pack "i42e")
--- Right 42
--- >>> parse bencInt "Bint" (pack "i123e")
--- Right 123
--- >>> parse bencInt "Bint" (pack "i1e")
--- Right 1
--- >>> parse bencInt "Bint" (pack "i0e")
--- Right 0
--- >>> parse bencInt "Bint" (pack "i-1e")
--- Right (-1)
--- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
--- True
--- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
--- True
--- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
--- True
-bencInt :: ParsecBS.Parser Integer
-bencInt = do _ <- spaces
-             ds <- between (char 'i') (char 'e') numbers
-             return (read ds)
-               where numbers = do d' <- char '-' <|> digit
-                                  ds' <- many digit
-                                  parseNumber d' ds'
-                     parseNumber '0' []  = return "0"
-                     parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
-                     parseNumber '-' []  = unexpected "sign without any digits"
-                     parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
-                     parseNumber d'' ds'' = return (d'':ds'')
-
--- | parse lists
---
--- >>> parse bencList "Blist" (pack "le")
--- Right []
--- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
--- Right ["spam","eggs"]
--- >>> parse bencList "Blist" (pack "l4:spami42ee")
--- Right ["spam",42]
--- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
--- Right ["spam","eggs",[42]]
-bencList :: ParsecBS.Parser [BVal]
-bencList = do _ <- spaces
-              between (char 'l') (char 'e') (many bencVal)
-
--- | parse dict
---
--- >>> parse bencDict "Bdict" (pack "de")
--- Right (fromList [])
--- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
--- Right (fromList [("cow","moo"),("spam","eggs")])
--- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
--- Right (fromList [("spam",["a","b"])])
--- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
--- Right (fromList [("publisher","bob"),("publisher-webpage","www.example.com"),("publisher.location","home")])
-bencDict :: ParsecBS.Parser (Map BVal BVal)
-bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
-  where kvpair = do k <- bencStr
-                    v <- bencVal
-                    return (Bstr k, v)
-
-bencVal :: ParsecBS.Parser BVal
-bencVal = Bstr <$> bencStr <|>
-          Bint <$> bencInt <|>
-          Blist <$> bencList <|>
-          Bdict <$> bencDict
-
-decode :: ByteString -> Either ParseError BVal
-decode = parse bencVal "BVal"
-
--- given an input dict or int or string, encode
--- it into a bencoded bytestring.
--- | encode bencoded-values
---
--- >>> encode (Bstr (pack ""))
--- "0:"
--- >>> encode (Bstr (pack "spam"))
--- "4:spam"
--- >>> encode (Bint 0)
--- "i0e"
--- >>> encode (Bint 42)
--- "i42e"
--- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
--- "l4:spam4:eggse"
--- >>> encode (Blist [])
--- "le"
--- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")]))
--- "d4:spam4:eggse"
-encode :: BVal -> String
-encode (Bstr bs) = let s = unpack bs
-                   in show (length s) ++ ":" ++ s
-encode (Bint i) = "i" ++ show i ++ "e"
-encode (Blist xs) = "l" ++ encodeList xs ++ "e"
-  where encodeList = foldr ((++) . encode) ""
-encode (Bdict d) = "d" ++ encodeDict d ++ "e"
-  where encodeDict m = concat [encode k ++ encode (m ! k) | k <- keys m]
diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs
new file mode 100644 (file)
index 0000000..acd679e
--- /dev/null
@@ -0,0 +1,32 @@
+module FuncTorrent
+    (BVal(..),
+     Info,
+     InfoDict,
+     Metainfo,
+     Peer,
+     PeerResp(..),
+     announce,
+     connect,
+     decode,
+     encode,
+     getPeerResponse,
+     getPeers,
+     handShakeMsg,
+     info,
+     infoHash,
+     initLogger,
+     lengthInBytes,
+     logMessage,
+     logStop,
+     mkInfo,
+     mkMetaInfo,
+     name,
+     prepareRequest,
+     urlEncodeHash
+    ) where
+
+import FuncTorrent.Bencode
+import FuncTorrent.Logger
+import FuncTorrent.Metainfo
+import FuncTorrent.Peer
+import FuncTorrent.Tracker
diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs
new file mode 100644 (file)
index 0000000..89446ea
--- /dev/null
@@ -0,0 +1,136 @@
+module FuncTorrent.Bencode
+    (BVal(..),
+     InfoDict,
+     encode,
+     decode
+    ) where
+
+import Control.Applicative ((<*))
+import Data.ByteString.Char8 (ByteString, pack, unpack)
+import Data.Functor ((<$>))
+import Data.Map.Strict (Map, fromList, keys, (!))
+import Text.ParserCombinators.Parsec
+import qualified Text.Parsec.ByteString as ParsecBS
+
+data BVal = Bint Integer
+          | Bstr ByteString
+          | Blist [BVal]
+          | Bdict InfoDict
+            deriving (Ord, Eq, Show)
+
+type InfoDict = Map BVal BVal
+
+-- $setup
+-- >>> import Data.Either
+
+-- | parse strings
+--
+-- >>> parse bencStr "Bstr" (pack "4:spam")
+-- Right "spam"
+-- >>> parse bencStr "Bstr" (pack "0:")
+-- Right ""
+-- >>> parse bencStr "Bstr" (pack "0:hello")
+-- Right ""
+--
+bencStr :: ParsecBS.Parser ByteString
+bencStr = do _ <- spaces
+             ds <- many1 digit <* char ':'
+             s <- count (read ds) anyChar
+             return (pack s)
+
+-- | parse integers
+--
+-- >>> parse bencInt "Bint" (pack "i42e")
+-- Right 42
+-- >>> parse bencInt "Bint" (pack "i123e")
+-- Right 123
+-- >>> parse bencInt "Bint" (pack "i1e")
+-- Right 1
+-- >>> parse bencInt "Bint" (pack "i0e")
+-- Right 0
+-- >>> parse bencInt "Bint" (pack "i-1e")
+-- Right (-1)
+-- >>> isLeft $ parse bencInt "Bint" (pack "i01e")
+-- True
+-- >>> isLeft $ parse bencInt "Bint" (pack "i00e")
+-- True
+-- >>> isLeft $ parse bencInt "Bint" (pack "i002e")
+-- True
+bencInt :: ParsecBS.Parser Integer
+bencInt = do _ <- spaces
+             ds <- between (char 'i') (char 'e') numbers
+             return (read ds)
+               where numbers = do d' <- char '-' <|> digit
+                                  ds' <- many digit
+                                  parseNumber d' ds'
+                     parseNumber '0' []  = return "0"
+                     parseNumber '0' _ = unexpected "numbers cannot be left-padded with zeros"
+                     parseNumber '-' []  = unexpected "sign without any digits"
+                     parseNumber '-' (d'':_) | d'' == '0' = unexpected "numbers cannot be left-padded with zeros"
+                     parseNumber d'' ds'' = return (d'':ds'')
+
+-- | parse lists
+--
+-- >>> parse bencList "Blist" (pack "le")
+-- Right []
+-- >>> parse bencList "Blist" (pack "l4:spam4:eggse")
+-- Right ["spam","eggs"]
+-- >>> parse bencList "Blist" (pack "l4:spami42ee")
+-- Right ["spam",42]
+-- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
+-- Right ["spam","eggs",[42]]
+bencList :: ParsecBS.Parser [BVal]
+bencList = do _ <- spaces
+              between (char 'l') (char 'e') (many bencVal)
+
+-- | parse dict
+--
+-- >>> parse bencDict "Bdict" (pack "de")
+-- Right (fromList [])
+-- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse")
+-- Right (fromList [("cow","moo"),("spam","eggs")])
+-- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee")
+-- Right (fromList [("spam",["a","b"])])
+-- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
+-- Right (fromList [("publisher","bob"),("publisher-webpage","www.example.com"),("publisher.location","home")])
+bencDict :: ParsecBS.Parser (Map BVal BVal)
+bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
+  where kvpair = do k <- bencStr
+                    v <- bencVal
+                    return (Bstr k, v)
+
+bencVal :: ParsecBS.Parser BVal
+bencVal = Bstr <$> bencStr <|>
+          Bint <$> bencInt <|>
+          Blist <$> bencList <|>
+          Bdict <$> bencDict
+
+decode :: ByteString -> Either ParseError BVal
+decode = parse bencVal "BVal"
+
+-- given an input dict or int or string, encode
+-- it into a bencoded bytestring.
+-- | encode bencoded-values
+--
+-- >>> encode (Bstr (pack ""))
+-- "0:"
+-- >>> encode (Bstr (pack "spam"))
+-- "4:spam"
+-- >>> encode (Bint 0)
+-- "i0e"
+-- >>> encode (Bint 42)
+-- "i42e"
+-- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))])
+-- "l4:spam4:eggse"
+-- >>> encode (Blist [])
+-- "le"
+-- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")]))
+-- "d4:spam4:eggse"
+encode :: BVal -> String
+encode (Bstr bs) = let s = unpack bs
+                   in show (length s) ++ ":" ++ s
+encode (Bint i) = "i" ++ show i ++ "e"
+encode (Blist xs) = "l" ++ encodeList xs ++ "e"
+  where encodeList = foldr ((++) . encode) ""
+encode (Bdict d) = "d" ++ encodeDict d ++ "e"
+  where encodeDict m = concat [encode k ++ encode (m ! k) | k <- keys m]
diff --git a/src/FuncTorrent/Logger.hs b/src/FuncTorrent/Logger.hs
new file mode 100644 (file)
index 0000000..255809b
--- /dev/null
@@ -0,0 +1,54 @@
+module FuncTorrent.Logger (
+      initLogger
+    , logMessage
+    , logStop
+    ) where
+
+import Control.Concurrent
+
+-- The below logger implementation has been taken from
+-- Parallel and Concurrent Programming in Haskell, Chapter 7
+-- The logger is implemented in a concurrent thread.
+
+-- Here the (MVar LogCommand) is used for actual thread communication
+-- So if multiple threads try to log, then the logger will be thread-safe
+-- Also the 'loop' in logger will wait for the message to come.
+--
+-- The MVar in stop is just to ensure the logger thread executes completely
+-- Before exiting the main application.
+--
+data Logger = Logger (MVar LogCommand)
+data LogCommand = Message String | Stop (MVar ())
+
+initLogger :: IO Logger
+initLogger = do
+    m <- newEmptyMVar
+    let l = Logger m
+    _ <- forkIO (logger l)
+    return l
+
+logger :: Logger -> IO ()
+logger (Logger m) = loop
+    where
+        loop = do
+            cmd <- takeMVar m
+            case cmd of
+                 Message msg -> do
+                     -- We can alternatively put the message to a file
+                     putStrLn msg
+                     -- Recursive
+                     loop
+                 Stop s -> do
+                     putStrLn "FuncTorrent: Exit succesfully"
+                     putMVar s ()
+
+-- Send log message to logger
+logMessage :: Logger -> String -> IO ()
+logMessage (Logger m) s = putMVar m (Message s)
+
+logStop :: Logger -> IO ()
+logStop (Logger m) = do
+    s <- newEmptyMVar
+    putMVar m (Stop s)
+    -- Wait for logger to complete the logging
+    takeMVar s
diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs
new file mode 100644 (file)
index 0000000..92b7b96
--- /dev/null
@@ -0,0 +1,74 @@
+module FuncTorrent.Metainfo
+    (Info,
+     Metainfo,
+     mkMetaInfo,
+     mkInfo,
+     announce,
+     lengthInBytes,
+     info,
+     name
+    ) where
+
+import Prelude hiding (lookup)
+import Data.ByteString.Char8 (ByteString, pack, unpack)
+import Data.Map as M ((!), lookup)
+
+import FuncTorrent.Bencode (BVal(..))
+
+-- only single file mode supported for the time being.
+data Info = Info { pieceLength :: !Integer
+                 , pieces :: !ByteString
+                 , private :: !(Maybe Integer)
+                 , name :: !String
+                 , lengthInBytes :: !Integer
+                 , md5sum :: !(Maybe String)
+                 } deriving (Eq, Show)
+
+data Metainfo = Metainfo { info :: !Info
+                         , announce :: !String
+                         , announceList :: !(Maybe [[String]])
+                         , creationDate :: !(Maybe String)
+                         , comment :: !(Maybe String)
+                         , createdBy :: !(Maybe String)
+                         , encoding :: !(Maybe String)
+                         } deriving (Eq, Show)
+
+mkInfo :: BVal -> Maybe Info
+mkInfo (Bdict m) = let (Bint pieceLength') = m ! Bstr (pack "piece length")
+                       (Bstr pieces') = m ! Bstr (pack "pieces")
+                       private' = Nothing
+                       (Bstr name') = m ! Bstr (pack "name")
+                       (Bint length') = m ! Bstr (pack "length")
+                       md5sum' = Nothing
+                   in Just Info { pieceLength = pieceLength'
+                                , pieces = pieces'
+                                , private = private'
+                                , name = unpack name'
+                                , lengthInBytes = length'
+                                , md5sum = md5sum'}
+mkInfo _ = Nothing
+
+maybeBstrToString :: Maybe BVal -> Maybe String
+maybeBstrToString Nothing = Nothing
+maybeBstrToString (Just s) = let (Bstr bs) = s
+                             in Just (unpack bs)
+
+mkMetaInfo :: BVal -> Maybe Metainfo
+mkMetaInfo (Bdict m) = let (Just info') = mkInfo (m ! Bstr (pack "info"))
+                           (Bstr announce') = m ! Bstr (pack "announce")
+                           -- announceList = lookup (Bstr (pack "announce list"))
+                           announceList' = Nothing
+                           -- creationDate = lookup (Bstr (pack "creation date")) m
+                           creationDate' = Nothing
+                           comment' = lookup (Bstr (pack "comment")) m
+                           createdBy' = lookup (Bstr (pack "created by")) m
+                           encoding' = lookup (Bstr (pack "encoding")) m
+                       in Just Metainfo { info = info'
+                                        , announce = unpack announce'
+                                        , announceList = announceList'
+                                        , creationDate = creationDate'
+                                        , comment = maybeBstrToString comment'
+                                        , createdBy = maybeBstrToString createdBy'
+                                        , encoding = maybeBstrToString encoding'
+                                        }
+mkMetaInfo _ = Nothing
diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
new file mode 100644 (file)
index 0000000..b9334ba
--- /dev/null
@@ -0,0 +1,72 @@
+module FuncTorrent.Peer
+    (Peer,
+     PeerResp(..),
+     getPeers,
+     getPeerResponse,
+     handShakeMsg
+    ) where
+
+import Prelude hiding (lookup, concat, replicate, splitAt)
+import Data.ByteString.Char8 (ByteString, pack, unpack, concat, replicate, splitAt)
+import Data.ByteString.Lazy (toChunks)
+import Data.Int (Int8)
+import Data.List (intercalate)
+import Data.Map as M ((!), lookup)
+import qualified Data.Binary as Bin (encode)
+import qualified Data.ByteString.Base16 as B16 (encode)
+
+import FuncTorrent.Bencode (BVal(..), InfoDict, decode)
+import FuncTorrent.Tracker (infoHash)
+import FuncTorrent.Utils (splitN)
+
+
+type Address = String
+type Port = Integer
+
+data Peer = Peer Address Port
+            deriving (Show)
+
+data PeerResp = PeerResponse { interval :: Maybe Integer
+                             , peers :: [Peer]
+                             , complete :: Maybe Integer
+                             , incomplete :: Maybe Integer
+                             } deriving (Show)
+
+toInt :: String -> Integer
+toInt = read
+
+getPeers :: PeerResp -> [Peer]
+getPeers = peers
+
+getPeerResponse :: ByteString -> PeerResp
+getPeerResponse body = case decode body of
+                        Right (Bdict peerM) ->
+                          let (Just (Bint i)) = lookup (Bstr (pack "lookup")) peerM
+                              (Bstr peersBS) = peerM ! Bstr (pack "peers")
+                              pl = map (\peer -> let (ip', port') = splitAt 4 peer
+                                                 in Peer (toIPNum ip') (toPortNum port'))
+                                   (splitN 6 peersBS)
+                          in PeerResponse { interval = Just i
+                                          , peers = pl
+                                          , complete = Nothing
+                                          , incomplete = Nothing
+                                          }
+                          where toPortNum = read . ("0x" ++) . unpack . B16.encode
+                                toIPNum = intercalate "." .
+                                          map (show . toInt . ("0x" ++) . unpack) .
+                                          splitN 2 . B16.encode
+
+                        _ -> PeerResponse { interval = Nothing
+                                          , peers = []
+                                          , complete = Nothing
+                                          , incomplete = Nothing
+                                          }
+
+
+handShakeMsg :: InfoDict -> String -> ByteString
+handShakeMsg m peer_id = let pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8)
+                             pstr = pack "BitTorrent protocol"
+                             reserved = replicate 8 '\0'
+                             infoH = infoHash m
+                             peerID = pack peer_id
+                         in concat [pstrlen, pstr, reserved, infoH, peerID]
diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
new file mode 100644 (file)
index 0000000..178aa97
--- /dev/null
@@ -0,0 +1,57 @@
+module FuncTorrent.Tracker
+    (connect,
+     infoHash,
+     prepareRequest,
+     urlEncodeHash
+    ) where
+
+import Prelude hiding (lookup)
+import Crypto.Hash.SHA1 (hash)
+import Data.ByteString.Char8 (ByteString, pack, unpack)
+import Data.Char (chr)
+import Data.List (intercalate)
+import Data.Maybe (fromJust)
+import Data.Map as M (Map, (!))
+import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
+import Network.HTTP.Base (urlEncode)
+import Network.URI (parseURI)
+import qualified Data.ByteString.Base16 as B16 (encode)
+
+import FuncTorrent.Bencode (BVal(..), InfoDict, encode)
+import FuncTorrent.Utils (splitN)
+
+type Url = String
+
+-- | urlEncodeHash
+--
+-- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a"
+-- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
+urlEncodeHash :: ByteString -> String
+urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
+  where encode' b@[c1, c2] = let c =  chr (read ("0x" ++ b))
+                            in escape c c1 c2
+        encode' _ = ""
+        escape i c1 c2 | i `elem` nonSpecialChars = [i]
+                       | otherwise = "%" ++ [c1] ++ [c2]
+
+        nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
+
+infoHash :: Map BVal BVal -> ByteString
+infoHash m = let info = m ! Bstr (pack "info")
+             in (hash . pack . encode) info
+
+prepareRequest :: InfoDict -> String -> Integer -> String
+prepareRequest d peer_id len =
+  let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)),
+           ("peer_id", urlEncode peer_id),
+           ("port", "6881"),
+           ("uploaded", "0"),
+           ("downloaded", "0"),
+           ("left", show len),
+           ("compact", "1"),
+           ("event", "started")]
+  in intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
+
+connect :: Url -> String -> IO ByteString
+connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody
+    where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr)
diff --git a/src/FuncTorrent/Utils.hs b/src/FuncTorrent/Utils.hs
new file mode 100644 (file)
index 0000000..e5a4a55
--- /dev/null
@@ -0,0 +1,7 @@
+module FuncTorrent.Utils where
+
+import qualified Data.ByteString.Char8 as BC
+
+splitN :: Int -> BC.ByteString -> [BC.ByteString]
+splitN n bs | BC.null bs = []
+            | otherwise = BC.take n bs : splitN n (BC.drop n bs)
diff --git a/src/Logger.hs b/src/Logger.hs
deleted file mode 100644 (file)
index c1a5894..0000000
+++ /dev/null
@@ -1,54 +0,0 @@
-module Logger (
-      initLogger
-    , logMessage
-    , logStop
-    ) where
-
-import Control.Concurrent
-
--- The below logger implementation has been taken from
--- Parallel and Concurrent Programming in Haskell, Chapter 7
--- The logger is implemented in a concurrent thread.
-
--- Here the (MVar LogCommand) is used for actual thread communication
--- So if multiple threads try to log, then the logger will be thread-safe
--- Also the 'loop' in logger will wait for the message to come.
--- 
--- The MVar in stop is just to ensure the logger thread executes completely
--- Before exiting the main application.
---
-data Logger = Logger (MVar LogCommand)
-data LogCommand = Message String | Stop (MVar ())
-
-initLogger :: IO Logger
-initLogger = do
-    m <- newEmptyMVar
-    let l = Logger m
-    _ <- forkIO (logger l)
-    return l
-
-logger :: Logger -> IO ()
-logger (Logger m) = loop
-    where
-        loop = do
-            cmd <- takeMVar m
-            case cmd of
-                 Message msg -> do
-                     -- We can alternatively put the message to a file
-                     putStrLn msg
-                     -- Recursive
-                     loop
-                 Stop s -> do
-                     putStrLn "FuncTorrent: Exit succesfully"
-                     putMVar s ()
-
--- Send log message to logger
-logMessage :: Logger -> String -> IO ()
-logMessage (Logger m) s = putMVar m (Message s)
-
-logStop :: Logger -> IO ()
-logStop (Logger m) = do
-    s <- newEmptyMVar
-    putMVar m (Stop s)
-    -- Wait for logger to complete the logging
-    takeMVar s
index bc4b8d31013948dbfd35c053c5fb18b3d623b2f2..c23b97ed5baadc7f0390cc5c8246770a72124990 100644 (file)
@@ -7,11 +7,11 @@ import System.Environment (getArgs)
 import System.Exit (exitSuccess)
 import Text.ParserCombinators.Parsec (ParseError)
 
-import Bencode (decode, BVal(..))
-import Logger (initLogger, logMessage, logStop)
-import Metainfo (announce, lengthInBytes, mkMetaInfo, info, name)
-import Peer (getPeers, getPeerResponse, handShakeMsg)
-import Tracker (connect, prepareRequest)
+import FuncTorrent.Bencode (decode, BVal(..))
+import FuncTorrent.Logger (initLogger, logMessage, logStop)
+import FuncTorrent.Metainfo (announce, lengthInBytes, mkMetaInfo, info, name)
+import FuncTorrent.Peer (getPeers, getPeerResponse, handShakeMsg)
+import FuncTorrent.Tracker (connect, prepareRequest)
 
 logError :: ParseError -> (String -> IO ()) -> IO ()
 logError e logMsg = logMsg $ "parse error: \n" ++ show e
diff --git a/src/Metainfo.hs b/src/Metainfo.hs
deleted file mode 100644 (file)
index c77b127..0000000
+++ /dev/null
@@ -1,64 +0,0 @@
-module Metainfo where
-
-import Prelude hiding (lookup)
-import Bencode (BVal(..))
-import Data.ByteString.Char8 (ByteString, pack, unpack)
-import Data.Map as M ((!), lookup)
-
--- only single file mode supported for the time being.
-data Info = Info { pieceLength :: !Integer
-                 , pieces :: !ByteString
-                 , private :: !(Maybe Integer)
-                 , name :: !String
-                 , lengthInBytes :: !Integer
-                 , md5sum :: !(Maybe String)
-                 } deriving (Eq, Show)
-
-data Metainfo = Metainfo { info :: !Info
-                         , announce :: !String
-                         , announceList :: !(Maybe [[String]])
-                         , creationDate :: !(Maybe String)
-                         , comment :: !(Maybe String)
-                         , createdBy :: !(Maybe String)
-                         , encoding :: !(Maybe String)
-                         } deriving (Eq, Show)
-
-mkInfo :: BVal -> Maybe Info
-mkInfo (Bdict m) = let (Bint pieceLength') = m ! Bstr (pack "piece length")
-                       (Bstr pieces') = m ! Bstr (pack "pieces")
-                       private' = Nothing
-                       (Bstr name') = m ! Bstr (pack "name")
-                       (Bint length') = m ! Bstr (pack "length")
-                       md5sum' = Nothing
-                   in Just Info { pieceLength = pieceLength'
-                                , pieces = pieces'
-                                , private = private'
-                                , name = unpack name'
-                                , lengthInBytes = length'
-                                , md5sum = md5sum'}
-mkInfo _ = Nothing
-
-maybeBstrToString :: Maybe BVal -> Maybe String
-maybeBstrToString Nothing = Nothing
-maybeBstrToString (Just s) = let (Bstr bs) = s
-                             in Just (unpack bs)
-
-mkMetaInfo :: BVal -> Maybe Metainfo
-mkMetaInfo (Bdict m) = let (Just info') = mkInfo (m ! Bstr (pack "info"))
-                           (Bstr announce') = m ! Bstr (pack "announce")
-                           -- announceList = lookup (Bstr (pack "announce list"))
-                           announceList' = Nothing
-                           -- creationDate = lookup (Bstr (pack "creation date")) m
-                           creationDate' = Nothing
-                           comment' = lookup (Bstr (pack "comment")) m
-                           createdBy' = lookup (Bstr (pack "created by")) m
-                           encoding' = lookup (Bstr (pack "encoding")) m
-                       in Just Metainfo { info = info'
-                                        , announce = unpack announce'
-                                        , announceList = announceList'
-                                        , creationDate = creationDate'
-                                        , comment = maybeBstrToString comment'
-                                        , createdBy = maybeBstrToString createdBy'
-                                        , encoding = maybeBstrToString encoding'
-                                        }
-mkMetaInfo _ = Nothing
diff --git a/src/Peer.hs b/src/Peer.hs
deleted file mode 100644 (file)
index b07b79d..0000000
+++ /dev/null
@@ -1,66 +0,0 @@
-module Peer where
-
-import Prelude hiding (lookup, concat, replicate, splitAt)
-
-import Bencode (BVal(..), InfoDict, decode)
-import Data.ByteString.Char8 (ByteString, pack, unpack, concat, replicate, splitAt)
-import Data.ByteString.Lazy (toChunks)
-import Data.Int (Int8)
-import Data.List (intercalate)
-import Data.Map as M ((!), lookup)
-import Tracker (infoHash)
-import Utils (splitN)
-import qualified Data.Binary as Bin (encode)
-import qualified Data.ByteString.Base16 as B16 (encode)
-
-
-type Address = String
-type Port = Integer
-
-data Peer = Peer Address Port
-            deriving (Show)
-
-data PeerResp = PeerResponse { interval :: Maybe Integer
-                             , peers :: [Peer]
-                             , complete :: Maybe Integer
-                             , incomplete :: Maybe Integer
-                             } deriving (Show)
-
-toInt :: String -> Integer
-toInt = read
-
-getPeers :: PeerResp -> [Peer]
-getPeers = peers
-
-getPeerResponse :: ByteString -> PeerResp
-getPeerResponse body = case decode body of
-                        Right (Bdict peerM) ->
-                          let (Just (Bint i)) = lookup (Bstr (pack "lookup")) peerM
-                              (Bstr peersBS) = peerM ! Bstr (pack "peers")
-                              pl = map (\peer -> let (ip', port') = splitAt 4 peer
-                                                 in Peer (toIPNum ip') (toPortNum port'))
-                                   (splitN 6 peersBS)
-                          in PeerResponse { interval = Just i
-                                          , peers = pl
-                                          , complete = Nothing
-                                          , incomplete = Nothing
-                                          }
-                          where toPortNum = read . ("0x" ++) . unpack . B16.encode
-                                toIPNum = intercalate "." .
-                                          map (show . toInt . ("0x" ++) . unpack) .
-                                          splitN 2 . B16.encode
-
-                        _ -> PeerResponse { interval = Nothing
-                                          , peers = []
-                                          , complete = Nothing
-                                          , incomplete = Nothing
-                                          }
-
-
-handShakeMsg :: InfoDict -> String -> ByteString
-handShakeMsg m peer_id = let pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8)
-                             pstr = pack "BitTorrent protocol"
-                             reserved = replicate 8 '\0'
-                             infoH = infoHash m
-                             peerID = pack peer_id
-                         in concat [pstrlen, pstr, reserved, infoH, peerID]
diff --git a/src/Tracker.hs b/src/Tracker.hs
deleted file mode 100644 (file)
index 6c558e5..0000000
+++ /dev/null
@@ -1,52 +0,0 @@
-module Tracker where
-
-import Prelude hiding (lookup)
-
-import Bencode (BVal(..), InfoDict, encode)
-import Crypto.Hash.SHA1 (hash)
-import Data.ByteString.Char8 (ByteString, pack, unpack)
-import Data.Char (chr)
-import Data.List (intercalate)
-import Data.Maybe (fromJust)
-import Data.Map as M (Map, (!))
-import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
-import Network.HTTP.Base (urlEncode)
-import Network.URI (parseURI)
-import Utils (splitN)
-import qualified Data.ByteString.Base16 as B16 (encode)
-
-type Url = String
-
--- | urlEncodeHash
---
--- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a"
--- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
-urlEncodeHash :: ByteString -> String
-urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
-  where encode' b@[c1, c2] = let c =  chr (read ("0x" ++ b))
-                            in escape c c1 c2
-        encode' _ = ""
-        escape i c1 c2 | i `elem` nonSpecialChars = [i]
-                       | otherwise = "%" ++ [c1] ++ [c2]
-
-        nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
-
-infoHash :: Map BVal BVal -> ByteString
-infoHash m = let info = m ! Bstr (pack "info")
-             in (hash . pack . encode) info
-
-prepareRequest :: InfoDict -> String -> Integer -> String
-prepareRequest d peer_id len =
-  let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)),
-           ("peer_id", urlEncode peer_id),
-           ("port", "6881"),
-           ("uploaded", "0"),
-           ("downloaded", "0"),
-           ("left", show len),
-           ("compact", "1"),
-           ("event", "started")]
-  in intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
-
-connect :: Url -> String -> IO ByteString
-connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody
-    where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr)
diff --git a/src/Utils.hs b/src/Utils.hs
deleted file mode 100644 (file)
index 019b06b..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-module Utils where
-
-import qualified Data.ByteString.Char8 as BC
-
-splitN :: Int -> BC.ByteString -> [BC.ByteString]
-splitN n bs | BC.null bs = []
-            | otherwise = BC.take n bs : splitN n (BC.drop n bs)