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/>
21 module FuncTorrent.Metainfo
28 import Prelude hiding (lookup)
29 import Data.ByteString.Char8 (ByteString, unpack)
30 import Data.Map as M ((!), lookup)
31 import Crypto.Hash.SHA1 (hash)
32 import Data.Maybe (maybeToList)
34 import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger)
36 -- only single file mode supported for the time being.
37 data Info = Info { pieceLength :: !Integer
38 , pieces :: !ByteString
39 , private :: !(Maybe Integer)
41 , lengthInBytes :: !Integer
42 , md5sum :: !(Maybe String)
45 data Metainfo = Metainfo { info :: !Info
46 , announceList :: ![String]
47 , creationDate :: !(Maybe Integer)
48 , comment :: !(Maybe String)
49 , createdBy :: !(Maybe String)
50 , encoding :: !(Maybe String)
51 , infoHash :: !ByteString
54 mkInfo :: BVal -> Maybe Info
55 mkInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length"
56 (Bstr pieces') = m ! "pieces"
58 (Bstr name') = m ! "name"
59 (Bint length') = m ! "length"
61 in Just Info { pieceLength = pieceLength'
65 , lengthInBytes = length'
69 mkMetaInfo :: BVal -> Either String Metainfo
70 mkMetaInfo (Bdict m) =
71 let (Just info') = mkInfo $ m ! "info"
72 announce' = lookup "announce" m
73 announceList' = lookup "announce-list" m
74 creationDate' = lookup "creation date" m
75 comment' = lookup "comment" m
76 createdBy' = lookup "created by" m
77 encoding' = lookup "encoding" m
80 , announceList = maybeToList (announce' >>= bstrToString)
81 ++ getAnnounceList announceList'
82 , creationDate = bValToInteger =<< creationDate'
83 , comment = bstrToString =<< comment'
84 , createdBy = bstrToString =<< createdBy'
85 , encoding = bstrToString =<< encoding'
86 , infoHash = hash . encode $ (m ! "info")
88 mkMetaInfo _ = Left "mkMetaInfo: expect an input dict"
90 getAnnounceList :: Maybe BVal -> [String]
91 getAnnounceList Nothing = []
92 getAnnounceList (Just (Bint _)) = []
93 getAnnounceList (Just (Bstr _)) = []
94 getAnnounceList (Just (Blist l)) = map (\s -> case s of
95 (Bstr s') -> unpack s'
96 (Blist s') -> case s' of
97 [Bstr s''] -> unpack s''
100 getAnnounceList (Just (Bdict _)) = []
102 torrentToMetainfo :: ByteString -> Either String Metainfo
103 torrentToMetainfo s =
105 Right d -> mkMetaInfo d
106 Left e -> Left $ show e