2 - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
4 - This file is part of FuncTorrent.
6 - FuncTorrent is free software; you can redistribute it and/or modify
7 - it under the terms of the GNU General Public License as published by
8 - the Free Software Foundation; either version 3 of the License, or
9 - (at your option) any later version.
11 - FuncTorrent is distributed in the hope that it will be useful,
12 - but WITHOUT ANY WARRANTY; without even the implied warranty of
13 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 - GNU General Public License for more details.
16 - You should have received a copy of the GNU General Public License
17 - along with FuncTorrent; if not, see <http://www.gnu.org/licenses/>
20 module FuncTorrent.Metainfo
26 import Prelude hiding (lookup)
27 import Data.ByteString.Char8 (ByteString, unpack)
28 import Data.Map as M ((!), lookup)
29 import Crypto.Hash.SHA1 (hash)
30 import Data.Maybe (maybeToList)
32 import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger)
34 -- only single file mode supported for the time being.
35 data Info = Info { pieceLength :: !Integer
36 , pieces :: !ByteString
37 , private :: !(Maybe Integer)
39 , lengthInBytes :: !Integer
40 , md5sum :: !(Maybe String)
43 data Metainfo = Metainfo { info :: !Info
44 , announceList :: ![String]
45 , creationDate :: !(Maybe Integer)
46 , comment :: !(Maybe String)
47 , createdBy :: !(Maybe String)
48 , encoding :: !(Maybe String)
49 , infoHash :: !ByteString
52 mkInfo :: BVal -> Maybe Info
53 mkInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length"
54 (Bstr pieces') = m ! "pieces"
56 (Bstr name') = m ! "name"
57 (Bint length') = m ! "length"
59 in Just Info { pieceLength = pieceLength'
63 , lengthInBytes = length'
67 mkMetaInfo :: BVal -> Either String Metainfo
68 mkMetaInfo (Bdict m) =
69 let (Just info') = mkInfo $ m ! "info"
70 announce' = lookup "announce" m
71 announceList' = lookup "announce-list" m
72 creationDate' = lookup "creation date" m
73 comment' = lookup "comment" m
74 createdBy' = lookup "created by" m
75 encoding' = lookup "encoding" m
78 , announceList = maybeToList (announce' >>= bstrToString)
79 ++ getAnnounceList announceList'
80 , creationDate = bValToInteger =<< creationDate'
81 , comment = bstrToString =<< comment'
82 , createdBy = bstrToString =<< createdBy'
83 , encoding = bstrToString =<< encoding'
84 , infoHash = hash . encode $ (m ! "info")
86 mkMetaInfo _ = Left "mkMetaInfo: expect an input dict"
88 getAnnounceList :: Maybe BVal -> [String]
89 getAnnounceList Nothing = []
90 getAnnounceList (Just (Bint _)) = []
91 getAnnounceList (Just (Bstr _)) = []
92 getAnnounceList (Just (Blist l)) = map (\s -> case s of
93 (Bstr s') -> unpack s'
94 (Blist s') -> case s' of
95 [Bstr s''] -> unpack s''
98 getAnnounceList (Just (Bdict _)) = []
100 torrentToMetainfo :: ByteString -> Either String Metainfo
101 torrentToMetainfo s =
103 Right d -> mkMetaInfo d
104 Left e -> Left $ show e