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 {-# LANGUAGE OverloadedStrings #-}
21 module FuncTorrent.Metainfo
27 import Prelude hiding (lookup)
28 import Data.ByteString.Char8 (ByteString, unpack)
29 import Data.Map as M ((!), lookup)
30 import Data.List (intersperse)
31 import Crypto.Hash.SHA1 (hash)
32 import Data.Maybe (maybeToList)
34 import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger)
36 data FileMeta = FileMeta { lengthInBytes :: !Integer
37 , md5sum :: !(Maybe String)
41 data Info = Info { pieceLength :: !Integer
42 , pieces :: !ByteString
43 , private :: !(Maybe Integer)
45 , filemeta :: [FileMeta]
48 data Metainfo = Metainfo { info :: !(Maybe Info)
49 , announceList :: ![String]
50 , creationDate :: !(Maybe Integer)
51 , comment :: !(Maybe String)
52 , createdBy :: !(Maybe String)
53 , encoding :: !(Maybe String)
54 , infoHash :: !ByteString
57 bvalToInfo :: BVal -> Maybe Info
58 bvalToInfo (Bdict minfo) = let (Bint pieceLength') = minfo ! "piece length"
59 (Bstr pieces') = minfo ! "pieces"
61 (Bstr name') = minfo ! "name"
62 -- is the key "files" present? If so, it is a multi-file torrent
63 -- if not, it is a single file torrent.
64 filesIfMulti = lookup "files" minfo
65 partialInfo = Info { pieceLength = pieceLength'
73 Nothing -> let (Bint length') = minfo ! "length"
74 filemeta' = FileMeta { lengthInBytes = length'
76 , path = unpack name' }
77 in Just (partialInfo { filemeta = [filemeta'] })
78 Just (Blist files) -> mapM toFileMeta files >>=
80 Just partialInfo { filemeta = filemeta' }
82 bvalToInfo _ = Nothing
84 toFileMeta :: BVal -> Maybe FileMeta
85 toFileMeta (Bdict fm) = let (Bint length') = fm ! "length"
86 (Blist pathElems) = fm ! "path"
87 pathStrings = fmap bstrToString pathElems
89 sequence pathStrings >>=
90 \pathList -> let path' = concat $ intersperse "/" pathList
91 in Just (FileMeta { lengthInBytes = length'
94 toFileMeta _ = Nothing
96 mkMetaInfo :: BVal -> Either String Metainfo
97 mkMetaInfo (Bdict minfo) =
98 let info' = bvalToInfo $ minfo ! "info"
99 announce' = lookup "announce" minfo
100 announceList' = lookup "announce-list" minfo
101 creationDate' = lookup "creation date" minfo
102 comment' = lookup "comment" minfo
103 createdBy' = lookup "created by" minfo
104 encoding' = lookup "encoding" minfo
107 , announceList = maybeToList (announce' >>= bstrToString)
108 ++ getAnnounceList announceList'
109 , creationDate = bValToInteger =<< creationDate'
110 , comment = bstrToString =<< comment'
111 , createdBy = bstrToString =<< createdBy'
112 , encoding = bstrToString =<< encoding'
113 , infoHash = hash . encode $ (minfo ! "info")
115 mkMetaInfo _ = Left "mkMetaInfo: expect an input dict"
117 getAnnounceList :: Maybe BVal -> [String]
118 getAnnounceList Nothing = []
119 getAnnounceList (Just (Bint _)) = []
120 getAnnounceList (Just (Bstr _)) = []
121 getAnnounceList (Just (Blist l)) = map (\s -> case s of
122 (Bstr s') -> unpack s'
123 (Blist s') -> case s' of
124 [Bstr s''] -> unpack s''
127 getAnnounceList (Just (Bdict _)) = []
129 torrentToMetainfo :: ByteString -> Either String Metainfo
130 torrentToMetainfo s =
132 Right d -> mkMetaInfo d
133 Left e -> Left $ show e