X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FMetainfo.hs;h=801b53d4a88d039f79cb4102767bea9b909fa247;hb=e82e69136d468dac0b133e4f8c99d5f91cbdc598;hp=92b7b96a6b98a10c7b0d9a357c8ff0d55d0ec9b4;hpb=9e665dc72cd3230502340154173f22096895bd5f;p=functorrent.git diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 92b7b96..801b53d 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -1,74 +1,133 @@ +{- + - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan + - + - 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 + -} + +{-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Metainfo - (Info, - Metainfo, - mkMetaInfo, - mkInfo, - announce, - lengthInBytes, - info, - name + (Info(..), + Metainfo(..), + torrentToMetainfo ) where import Prelude hiding (lookup) -import Data.ByteString.Char8 (ByteString, pack, unpack) +import Data.ByteString.Char8 (ByteString, unpack) import Data.Map as M ((!), lookup) +import Data.List (intersperse) +import Crypto.Hash.SHA1 (hash) +import Data.Maybe (maybeToList) + +import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger) -import FuncTorrent.Bencode (BVal(..)) +data FileMeta = FileMeta { lengthInBytes :: !Integer + , md5sum :: !(Maybe String) + , path :: String + } deriving (Eq, Show) --- only single file mode supported for the time being. data Info = Info { pieceLength :: !Integer , pieces :: !ByteString , private :: !(Maybe Integer) , name :: !String - , lengthInBytes :: !Integer - , md5sum :: !(Maybe String) + , filemeta :: [FileMeta] } deriving (Eq, Show) -data Metainfo = Metainfo { info :: !Info - , announce :: !String - , announceList :: !(Maybe [[String]]) - , creationDate :: !(Maybe String) +data Metainfo = Metainfo { info :: !(Maybe 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 ! Bstr (pack "piece length") - (Bstr pieces') = m ! Bstr (pack "pieces") - private' = Nothing - (Bstr name') = m ! Bstr (pack "name") - (Bint length') = m ! Bstr (pack "length") - md5sum' = Nothing - in Just Info { pieceLength = pieceLength' - , pieces = pieces' - , private = private' - , name = unpack name' - , lengthInBytes = length' - , md5sum = md5sum'} -mkInfo _ = Nothing +bvalToInfo :: BVal -> Maybe Info +bvalToInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length" + (Bstr pieces') = m ! "pieces" + private' = Nothing + (Bstr name') = m ! "name" + -- is the key "files" present? If so, it is a multi-file torrent + -- if not, it is a single file torrent. + filesIfMulti = lookup "files" m + (Bint length') = m ! "length" + md5sum' = Nothing + partialInfo = Info { pieceLength = pieceLength' + , pieces = pieces' + , private = private' + , name = unpack name' + } + in + case filesIfMulti of + Nothing -> let (Bint length') = m ! "length" + filemeta' = FileMeta { lengthInBytes = length' + , md5sum = Nothing + , path = unpack name' } + in Just (partialInfo { filemeta = [filemeta'] }) + Just (Blist files) -> mapM toFileMeta files >>= + \filemeta' -> + Just partialInfo { filemeta = filemeta' } +bvalToInfo _ = Nothing + +toFileMeta :: BVal -> Maybe FileMeta +toFileMeta (Bdict fm) = let (Bint length) = fm ! "length" + (Blist pathElems) = fm ! "path" + pathStrings = fmap bstrToString pathElems + in + sequence pathStrings >>= + \pathList -> let path' = concat $ intersperse "/" pathList + in Just (FileMeta { lengthInBytes = length + , md5sum = Nothing + , path = path' }) +toFileMeta _ = Nothing + +mkMetaInfo :: BVal -> Either String Metainfo +mkMetaInfo (Bdict m) = + let info' = bvalToInfo $ 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" -maybeBstrToString :: Maybe BVal -> Maybe String -maybeBstrToString Nothing = Nothing -maybeBstrToString (Just s) = let (Bstr bs) = s - in Just (unpack bs) +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 _)) = [] -mkMetaInfo :: BVal -> Maybe Metainfo -mkMetaInfo (Bdict m) = let (Just info') = mkInfo (m ! Bstr (pack "info")) - (Bstr announce') = m ! Bstr (pack "announce") - -- announceList = lookup (Bstr (pack "announce list")) - announceList' = Nothing - -- creationDate = lookup (Bstr (pack "creation date")) m - creationDate' = Nothing - comment' = lookup (Bstr (pack "comment")) m - createdBy' = lookup (Bstr (pack "created by")) m - encoding' = lookup (Bstr (pack "encoding")) m - in Just Metainfo { info = info' - , announce = unpack announce' - , announceList = announceList' - , creationDate = creationDate' - , comment = maybeBstrToString comment' - , createdBy = maybeBstrToString createdBy' - , encoding = maybeBstrToString encoding' - } -mkMetaInfo _ = Nothing +torrentToMetainfo :: ByteString -> Either String Metainfo +torrentToMetainfo s = + case decode s of + Right d -> mkMetaInfo d + Left e -> Left $ show e