hspec tests for single/multi torrent, bencode etc

[functorrent.git] / src / FuncTorrent / Metainfo.hs

diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs
new file mode 100644 (file)
index 0000000..596ad68
--- /dev/null
+++ b/src/FuncTorrent/Metainfo.hs
@@ -0,0 +1,145 @@
+{-
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - This file is part of FuncTorrent.
+ -
+ - FuncTorrent is free software; you can redistribute it and/or modify
+ - it under the terms of the GNU General Public License as published by
+ - the Free Software Foundation; either version 3 of the License, or
+ - (at your option) any later version.
+ -
+ - FuncTorrent is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ - GNU General Public License for more details.
+ -
+ - You should have received a copy of the GNU General Public License
+ - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
+ -}
+
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module FuncTorrent.Metainfo
+    (Info(..)
+    , Metainfo(..)
+    , DynamicInfo(..)
+    , torrentToMetainfo
+    ) where
+
+import Prelude hiding (lookup)
+import Data.ByteString.Char8 (ByteString, unpack)
+import Data.Map as M ((!), lookup)
+import Crypto.Hash.SHA1 (hash)
+import Data.Maybe (maybeToList)
+
+import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger)
+
+-- only single file mode supported for the time being.
+data Info = Info { pieceLength :: !Integer
+                 , pieces :: !ByteString
+                 , private :: !(Maybe Integer)
+                 , dyninfo :: !DynamicInfo
+                 } deriving (Eq, Show)
+
+data DynamicInfo = SingleFileInfo { name :: String
+                                  , lengthInBytes :: Integer
+                                  , md5sum :: Maybe String
+                                  }
+                 | MultiFileInfo { dname :: String
+                                 , files :: [FileInfo]
+                                 }
+                 deriving (Eq, Show)
+
+data FileInfo = FileInfo { lengthInBytes :: Integer
+                         , md5sum :: Maybe String
+                         , path :: String
+                         } deriving (Eq, Show)
+
+data Metainfo = Metainfo { info :: !Info
+                         , announceList :: ![String]
+                         , creationDate :: !(Maybe Integer)
+                         , comment :: !(Maybe String)
+                         , createdBy :: !(Maybe String)
+                         , encoding :: !(Maybe String)
+                         , infoHash :: !ByteString
+                         } deriving (Eq, Show)
+
+mkInfo :: BVal -> Maybe Info
+mkInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length"
+                       (Bstr pieces') = m ! "pieces"
+                       private' = Nothing
+                       bdictfiles = lookup "files" m
+                   in
+                     case bdictfiles of
+                       Just fs -> let (Blist files') = fs
+                                      (Bstr name') = m ! "name"
+                                  in
+                                    Just Info { pieceLength = pieceLength'
+                                              , pieces = pieces'
+                                              , private = private'
+                                              , dyninfo = MultiFileInfo {
+                                                  dname = unpack name',
+                                                  files =
+                                                      map (\(Bdict f) ->
+                                                            let (Just len') = bValToInteger (f ! "length")
+                                                                (Bstr s') = f ! "path"
+                                                            in
+                                                              FileInfo { lengthInBytes = len',
+                                                                         md5sum = Nothing,
+                                                                         path = unpack s'
+                                                                     })
+                                                      files' }
+                                              }
+                       Nothing -> let (Bstr name') = m ! "name"
+                                      (Bint length') = m ! "length"
+                                      md5sum' = Nothing
+                                  in
+                                    Just Info { pieceLength = pieceLength'
+                                              , pieces = pieces'
+                                              , private = private'
+                                              , dyninfo = SingleFileInfo {
+                                                  name = unpack name',
+                                                  lengthInBytes = length',
+                                                  md5sum = md5sum'}
+                                              }
+
+mkInfo _ = Nothing
+
+mkMetaInfo :: BVal   -> Either String Metainfo
+mkMetaInfo (Bdict m)  =
+    let (Just info')  = mkInfo $ m ! "info"
+        announce'     = lookup "announce" m
+        announceList' = lookup "announce-list" m
+        creationDate' = lookup "creation date" m
+        comment'      = lookup "comment" m
+        createdBy'    = lookup "created by" m
+        encoding'     = lookup "encoding" m
+    in Right Metainfo {
+               info         = info'
+             , announceList = maybeToList (announce' >>= bstrToString)
+                              ++ getAnnounceList announceList'
+             , creationDate = bValToInteger =<< creationDate'
+             , comment      = bstrToString  =<< comment'
+             , createdBy    = bstrToString  =<< createdBy'
+             , encoding     = bstrToString  =<< encoding'
+             , infoHash     = hash . encode $ (m ! "info")
+             }
+mkMetaInfo _ = Left "mkMetaInfo: expect an input dict"
+
+getAnnounceList :: Maybe BVal -> [String]
+getAnnounceList Nothing          = []
+getAnnounceList (Just (Bint _))  = []
+getAnnounceList (Just (Bstr _))  = []
+getAnnounceList (Just (Blist l)) = map (\s -> case s of
+                                               (Bstr s') ->  unpack s'
+                                               (Blist s') -> case s' of
+                                                              [Bstr s''] -> unpack s''
+                                                              _ -> ""
+                                               _ -> "") l
+getAnnounceList (Just (Bdict _)) = []
+
+torrentToMetainfo :: ByteString -> Either String Metainfo
+torrentToMetainfo s =
+  case decode s of
+   Right d -> mkMetaInfo d
+   Left e -> Left $ show e