More consistency of types between magneturi/metainfo parsing

[functorrent.git] / src / FuncTorrent / MagnetURI.hs

diff --git a/src/FuncTorrent/MagnetURI.hs b/src/FuncTorrent/MagnetURI.hs
index 4c695b584b6d85826de49aa2b04954bb2a3ff392..506a169e156e88d43ade708efb772570e05098eb 100644 (file)
--- 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 <http://www.gnu.org/licenses/>
 -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 -- | Parse magnet URI
 -- The spec for magnetURI: https://en.wikipedia.org/wiki/Magnet_URI_scheme
 -- An example from tpb:
@@ -40,4 +42,54 @@ along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
 
 module FuncTorrent.MagnetURI where
 
+import Text.ParserCombinators.Parsec
+import qualified Text.Parsec.ByteString as ParsecBS
+import Data.ByteString.Char8 (ByteString, pack)
+import Network.HTTP.Base (urlDecode)
+
+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 (noneOf "&")
+  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 ++ [urlDecode v] }
+                "dn" -> magnetRecord { name = urlDecode v }
+                "xl" -> magnetRecord { xlen = Just (read v :: Integer) }
+                _    -> magnetInfo
+          magnetInfo = Magnetinfo { infoHash = mempty
+                                  , trackerlist = mempty
+                                  , name = mempty
+                                  , xlen = Nothing }
+
+magnetUri :: ParsecBS.Parser Magnetinfo
+magnetUri = magnetHdr >> magnetBody
 
+parseMagneturi :: ByteString -> Either String Magnetinfo
+parseMagneturi input =
+  case parse magnetUri "magnetParse" input of
+    Right minfo -> Right minfo
+    Left e -> Left $ "Cannot parse the magnet URI: " ++ show e