X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FMetainfo.hs;h=bec28b84dd172e61c4c69846e8b801294990ab3e;hb=a239b81e780317adbd62be75541bbbe99ba5e06b;hp=216fd2414231d2731376fd50a700d204695f2109;hpb=2595e40bb28065f5a6d123a3a33e0cbdd817293f;p=functorrent.git diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 216fd24..bec28b8 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -1,76 +1,118 @@ +{- + - 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, - announceList, - mkMetaInfo, - mkInfo, - lengthInBytes, - info, - name, + (Info(..), + Metainfo(..), + torrentToMetainfo ) where import Prelude hiding (lookup) 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(..), bstrToString) +import FuncTorrent.Bencode (BVal(..), encode, decode, bstrToString, bValToInteger) + +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 +data Metainfo = Metainfo { info :: !(Maybe Info) , announceList :: ![String] - , creationDate :: !(Maybe 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 ! "piece length" - (Bstr pieces') = m ! "pieces" - private' = Nothing - (Bstr name') = m ! "name" - (Bint length') = m ! "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 minfo) = let (Bint pieceLength') = minfo ! "piece length" + (Bstr pieces') = minfo ! "pieces" + private' = Nothing + (Bstr name') = minfo ! "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" minfo + partialInfo = Info { pieceLength = pieceLength' + , pieces = pieces' + , private = private' + , name = unpack name' + , filemeta = [] + } + in + case filesIfMulti of + Nothing -> let (Bint length') = minfo ! "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' } + Just _ -> Nothing +bvalToInfo _ = Nothing -maybeBstrToString :: Maybe BVal -> Maybe String -maybeBstrToString Nothing = Nothing -maybeBstrToString (Just s) = let (Bstr bs) = s - in Just (unpack bs) +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 -> Maybe Metainfo -mkMetaInfo (Bdict m) = let (Just info') = mkInfo $ m ! "info" - announce' = lookup "announce" m - announceList' = lookup "announce-list" m - -- creationDate = lookup (Bstr (pack "creation date")) m - creationDate' = Nothing - comment' = lookup "comment" m - createdBy' = lookup "created by" m - encoding' = lookup "encoding" m - in Just Metainfo { info = info' - , announceList = maybeToList (announce' >>= bstrToString) - ++ getAnnounceList announceList' - , creationDate = creationDate' - , comment = maybeBstrToString comment' - , createdBy = maybeBstrToString createdBy' - , encoding = maybeBstrToString encoding' - } -mkMetaInfo _ = Nothing +mkMetaInfo :: BVal -> Either String Metainfo +mkMetaInfo (Bdict minfo) = + let info' = bvalToInfo $ minfo ! "info" + announce' = lookup "announce" minfo + announceList' = lookup "announce-list" minfo + creationDate' = lookup "creation date" minfo + comment' = lookup "comment" minfo + createdBy' = lookup "created by" minfo + encoding' = lookup "encoding" minfo + 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 $ (minfo ! "info") + } +mkMetaInfo _ = Left "mkMetaInfo: expect an input dict" getAnnounceList :: Maybe BVal -> [String] getAnnounceList Nothing = [] @@ -82,5 +124,11 @@ getAnnounceList (Just (Blist l)) = map (\s -> case s of [Bstr s''] -> unpack s'' _ -> "" _ -> "") l - getAnnounceList (Just (Bdict _)) = [] + +torrentToMetainfo :: ByteString -> Either String Metainfo +torrentToMetainfo s = + case decode s of + Right d -> mkMetaInfo d + Left e -> Left ("Cannot parse the torrent file: " ++ show e) +