X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FMagnetURI.hs;fp=src%2FFuncTorrent%2FMagnetURI.hs;h=e0fd5450b47f07614eebef7360356cbbbfd0bace;hb=cbd20378040719573cbc8c24650673197f9db935;hp=4c695b584b6d85826de49aa2b04954bb2a3ff392;hpb=fa2428e1c93e5795d60693f7c2734f924b8df80f;p=functorrent.git
diff --git a/src/FuncTorrent/MagnetURI.hs b/src/FuncTorrent/MagnetURI.hs
index 4c695b5..e0fd545 100644
--- a/src/FuncTorrent/MagnetURI.hs
+++ b/src/FuncTorrent/MagnetURI.hs
@@ -17,6 +17,8 @@ You should have received a copy of the GNU General Public License
along with FuncTorrent; if not, see
-}
+{-# LANGUAGE OverloadedStrings #-}
+
-- | Parse magnet URI
-- The spec for magnetURI: https://en.wikipedia.org/wiki/Magnet_URI_scheme
-- An example from tpb:
@@ -40,4 +42,46 @@ along with FuncTorrent; if not, see
module FuncTorrent.MagnetURI where
+import Text.ParserCombinators.Parsec
+import qualified Text.Parsec.ByteString as ParsecBS
+import Data.ByteString.Char8 (ByteString, pack)
+
+data Magnetinfo = Magnetinfo { infoHash :: ByteString
+ , trackerlist :: [String]
+ , name :: String
+ , xlen :: Maybe Integer
+ }
+ deriving (Eq, Show)
+
+magnetHdr :: ParsecBS.Parser String
+magnetHdr = string "magnet:?"
+
+kvpair :: ParsecBS.Parser (String, String)
+kvpair = do
+ k <- many1 letter
+ _ <- char '='
+ v <- many1 (letter <|> digit <|> (char ':'))
+ return (k, v)
+
+magnetBody :: ParsecBS.Parser Magnetinfo
+magnetBody = do
+ pairs <- kvpair `sepBy1` (char '&')
+ -- walk through pairs, populate Magnetinfo (fold?)
+ return $ foldl f magnetInfo pairs
+ where f magnetRecord pair = let (k, v) = pair in
+ case k of
+ "xt" -> magnetRecord { infoHash = pack v }
+ "tr" -> let trVal = trackerlist magnetRecord in
+ magnetRecord { trackerlist = trVal ++ [v] }
+ "dn" -> magnetRecord { name = v }
+ "xl" -> magnetRecord { xlen = Just (read v :: Integer) }
+ magnetInfo = Magnetinfo { infoHash = mempty
+ , trackerlist = mempty
+ , name = mempty
+ , xlen = Nothing }
+
+magnetUri :: ParsecBS.Parser Magnetinfo
+magnetUri = magnetHdr >> magnetBody
+parseMagneturi :: ByteString -> Either ParseError Magnetinfo
+parseMagneturi input = parse magnetUri "magnetParse" input