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 DuplicateRecordFields #-}
22 module FuncTorrent.Metainfo
30 import Prelude hiding (lookup)
31 import Data.ByteString.Char8 (ByteString, unpack)
32 import Data.Map as M ((!), lookup)
33 import Data.List (intercalate)
34 import Crypto.Hash.SHA1 (hash)
35 import Data.Maybe (maybeToList)
37 import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger)
39 -- only single file mode supported for the time being.
40 data Info = Info { pieceLength :: !Integer
41 , pieces :: !ByteString
42 , private :: !(Maybe Integer)
43 , dyninfo :: !DynamicInfo
46 data DynamicInfo = SingleFileInfo { file :: FileInfo }
47 | MultiFileInfo { dname :: String
52 data FileInfo = FileInfo { lengthInBytes :: Integer
53 , md5sum :: Maybe String
57 data Metainfo = Metainfo { info :: !Info
58 , announceList :: ![String]
59 , creationDate :: !(Maybe Integer)
60 , comment :: !(Maybe String)
61 , createdBy :: !(Maybe String)
62 , encoding :: !(Maybe String)
63 , infoHash :: !ByteString
66 mkPath :: [BVal] -> String
67 mkPath xs = intercalate "/" $ map (\b -> let (Just s) = bstrToString b in s) xs
69 mkInfo :: BVal -> Maybe Info
70 mkInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length"
71 (Bstr pieces') = m ! "pieces"
73 bdictfiles = lookup "files" m
76 Just fs -> let (Blist files') = fs
77 (Bstr name') = m ! "name"
79 Just Info { pieceLength = pieceLength'
82 , dyninfo = MultiFileInfo {
86 let (Just len') = bValToInteger (f ! "length")
87 (Blist ds) = f ! "path"
90 FileInfo { lengthInBytes = len',
96 Nothing -> let (Bstr name') = m ! "name"
97 (Bint length') = m ! "length"
100 Just Info { pieceLength = pieceLength'
103 , dyninfo = SingleFileInfo {
106 lengthInBytes = length',
114 mkMetaInfo :: BVal -> Either String Metainfo
115 mkMetaInfo (Bdict m) =
116 let (Just info') = mkInfo $ m ! "info"
117 announce' = lookup "announce" m
118 announceList' = lookup "announce-list" m
119 creationDate' = lookup "creation date" m
120 comment' = lookup "comment" m
121 createdBy' = lookup "created by" m
122 encoding' = lookup "encoding" m
125 , announceList = maybeToList (announce' >>= bstrToString)
126 ++ getAnnounceList announceList'
127 , creationDate = bValToInteger =<< creationDate'
128 , comment = bstrToString =<< comment'
129 , createdBy = bstrToString =<< createdBy'
130 , encoding = bstrToString =<< encoding'
131 , infoHash = hash . encode $ (m ! "info")
133 mkMetaInfo _ = Left "mkMetaInfo: expect an input dict"
135 getAnnounceList :: Maybe BVal -> [String]
136 getAnnounceList Nothing = []
137 getAnnounceList (Just (Bint _)) = []
138 getAnnounceList (Just (Bstr _)) = []
139 getAnnounceList (Just (Blist l)) = map (\s -> case s of
140 (Bstr s') -> unpack s'
141 (Blist s') -> case s' of
142 [Bstr s''] -> unpack s''
145 getAnnounceList (Just (Bdict _)) = []
147 torrentToMetainfo :: ByteString -> Either String Metainfo
148 torrentToMetainfo s =
150 Right d -> mkMetaInfo d
151 Left e -> Left $ show e