X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FBencode.hs;h=d4eb58c5ac12d0e4f811eb050f95266733b9f262;hb=d8f6d2ee948393ef149c19b72547aff57dfda7f6;hp=f1a29809f731149f15fbc8975ef21cb0f226d4e3;hpb=7b2aa2757f2b2074f5e4d15efe4211354b258588;p=functorrent.git diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs index f1a2980..d4eb58c 100644 --- a/src/FuncTorrent/Bencode.hs +++ b/src/FuncTorrent/Bencode.hs @@ -1,9 +1,25 @@ +{- + - 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.Bencode (BVal(..) - , bValToBList - , bValToBytestr - , bValToInfoDict , bValToInteger , bstrToString , decode @@ -12,13 +28,13 @@ module FuncTorrent.Bencode import Prelude hiding (length, concat) -import Control.Applicative ((<*)) import Data.ByteString (ByteString, length, concat) import Data.ByteString.Char8 (unpack, pack) -import Data.Functor ((<$>)) -import Data.Map.Strict (Map, fromList, keys, (!)) +import Data.Char (isLetter, isAscii) +import Data.Map.Strict (Map, fromList, toList) import Text.ParserCombinators.Parsec import qualified Text.Parsec.ByteString as ParsecBS +import Test.QuickCheck data BVal = Bint Integer | Bstr ByteString @@ -26,6 +42,27 @@ data BVal = Bint Integer | Bdict (Map String BVal) deriving (Ord, Eq, Show) +genNonEmptyString :: Gen String +genNonEmptyString = arbitrary `suchThat` (\s -> ((s /= "") && + (all isAscii s) && + (all isLetter s))) + +instance Arbitrary ByteString where + arbitrary = pack <$> arbitrary + +instance Arbitrary BVal where + arbitrary = sized bval + where + bval :: Int -> Gen BVal + bval 0 = oneof [ Bint <$> arbitrary + , Bstr <$> arbitrary] + bval n = oneof [ Bint <$> arbitrary + , Bstr <$> arbitrary + , Blist <$> vectorOf n (bval (n `div` 4)) + , do keys <- vectorOf n genNonEmptyString + vals <- vectorOf n (bval (n `div` 4)) + return $ Bdict $ fromList $ zip keys vals ] + -- getters bValToInteger :: BVal -> Maybe Integer bValToInteger (Bint x) = Just x @@ -35,14 +72,6 @@ bValToBytestr :: BVal -> Maybe ByteString bValToBytestr (Bstr bs) = Just bs bValToBytestr _ = Nothing -bValToBList :: BVal -> Maybe [BVal] -bValToBList (Blist lst) = Just lst -bValToBList _ = Nothing - -bValToInfoDict :: BVal -> Maybe (Map String BVal) -bValToInfoDict (Bdict dict) = Just dict -bValToInfoDict _ = Nothing - bstrToString :: BVal -> Maybe String bstrToString bval = unpack <$> bValToBytestr bval @@ -118,9 +147,14 @@ bencList = between (char 'l') (char 'e') (many bencVal) -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")]) bencDict :: ParsecBS.Parser (Map String BVal) bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair - where kvpair = do k <- bencStr + where kvpair = do k <- bdictKey v <- bencVal - return (unpack k, v) + return (k, v) + bdictKey = do + ds <- many1 digit <* char ':' + s <- count (read ds) anyChar + return s + bencVal :: ParsecBS.Parser BVal bencVal = Bstr <$> bencStr <|> @@ -160,4 +194,5 @@ encode (Blist xs) = concat ["l", concat $ map encode xs, "e"] encode (Bdict d) = concat ["d", concat kvlist, "e"] where kvlist :: [ByteString] - kvlist = [concat [encode . Bstr . pack $ k , encode (d ! k)] | k <- keys d] + kvlist = [encPair kv | kv <- toList d] + encPair (k, v) = concat [encode (Bstr (pack k)), encode v]