{-# LANGUAGE OverloadedStrings #-}
-module FuncTorrent.Bencode
- (BVal(..),
- InfoDict,
- bstrToString,
- encode,
- decode
+module FuncTorrent.Bencode (
+ BVal(..)
+ , InfoDict
+ , bstrToString
+ , bValToInteger
+ , bValToInfoDict
+ , bValToBList
+ , bValToBstr
+ , encode
+ , decode
) where
import Prelude hiding (length, concat)
| Bdict InfoDict
deriving (Ord, Eq, Show)
+-- getters
+bValToInteger :: BVal -> Maybe Integer
+bValToInteger (Bint x) = Just x
+bValToInteger _ = Nothing
+
+bValToBstr :: BVal -> Maybe ByteString
+bValToBstr (Bstr bs) = Just bs
+bValToBstr _ = Nothing
+
+bValToBList :: BVal -> Maybe [BVal]
+bValToBList (Blist lst) = Just lst
+bValToBList _ = Nothing
+
+bValToInfoDict :: BVal -> Maybe InfoDict
+bValToInfoDict (Bdict dict) = Just dict
+bValToInfoDict _ = Nothing
+
+bstrToString :: BVal -> Maybe String
+bstrToString bval = unpack <$> bValToBstr bval
+
type InfoDict = Map String BVal
-- $setup
encode (Bint i) = pack $ "i" ++ show i ++ "e"
encode (Blist xs) = pack $ "l" ++ unpack (concat $ map encode xs) ++ "e"
encode (Bdict d) = concat [concat ["d", encode . Bstr . pack $ k , encode (d ! k) , "e"] | k <- keys d]
-
--- getters
-bstrToString :: BVal -> Maybe String
-bstrToString (Bstr s) = Just $ unpack s
-bstrToString _ = Nothing
import Crypto.Hash.SHA1 (hash)
import Data.Maybe (maybeToList)
-import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString)
+import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString, bValToInteger)
-- only single file mode supported for the time being.
data Info = Info { pieceLength :: !Integer
, md5sum = md5sum'}
mkInfo _ = Nothing
-maybeBstrToString :: Maybe BVal -> Maybe String
-maybeBstrToString (Just (Bstr bs)) = Just $ unpack bs
-maybeBstrToString _ = Nothing
-
-maybeBstrToInteger :: Maybe BVal -> Maybe Integer
-maybeBstrToInteger (Just (Bint bs)) = Just bs
-maybeBstrToInteger _ = 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 "creation date" m
- 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 = maybeBstrToInteger creationDate'
- , comment = maybeBstrToString comment'
- , createdBy = maybeBstrToString createdBy'
- , encoding = maybeBstrToString encoding'
- }
+mkMetaInfo :: BVal -> Maybe Metainfo
+mkMetaInfo (Bdict m) =
+ let (Just info') = mkInfo $ 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 Just Metainfo {
+ info = info'
+ , announceList = maybeToList (announce' >>= bstrToString)
+ ++ getAnnounceList announceList'
+ , creationDate = bValToInteger =<< creationDate'
+ , comment = bstrToString =<< comment'
+ , createdBy = bstrToString =<< createdBy'
+ , encoding = bstrToString =<< encoding'
+ }
mkMetaInfo _ = Nothing
getAnnounceList :: Maybe BVal -> [String]