src/FuncTorrent/MagnetURI.hs

   1 {-
   2 Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   3
   4 This file is part of FuncTorrent.
   5
   6 FuncTorrent is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 FuncTorrent is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
  18 -}
  19
  20 {-# LANGUAGE OverloadedStrings #-}
  21
  22 -- | Parse magnet URI
  23 -- The spec for magnetURI: https://en.wikipedia.org/wiki/Magnet_URI_scheme
  24 -- An example from tpb:
  25 --   magnet:?xt=urn:btih:1f8a4ee3c3f57e81f8f0b4e658177201fc2a3118&dn=Honey+Bee+2+%5B2017%5D+Malayalam+DVDRiP+x264+AAC+700MB+ZippyMovieZ+E&tr=udp%3A%2F%2Ftracker.leechers-paradise.org%3A6969&tr=udp%3A%2F%2Fzer0day.ch%3A1337&tr=udp%3A%2F%2Fopen.demonii.com%3A1337&tr=udp%3A%2F%2Ftracker.coppersurfer.tk%3A6969&tr=udp%3A%2F%2Fexodus.desync.com%3A6969
  26 -- xt   - extra topic - urn containing filehash
  27 -- btih - bittorrent infohash
  28 -- dn   - display name (for the user)
  29 -- tr   - tracker URL
  30 -- xl   - exact length
  31 -- mt   - link to a meta file (manifest topic) that contains a list of magnet links
  32 -- urn  - uniform resource name
  33
  34 -- How does a client join the swarm with only the magnet uri?
  35 -- This is detailed in http://www.bittorrent.org/beps/bep_0009.html
  36 -- The protocol depends on the extensions protocol specified in BEP 0010.
  37 -- http://www.bittorrent.org/beps/bep_0009.html
  38
  39 -- 1. First we parse the magnet uri and get a list of trackers
  40 -- 2. We then use the usual tracker protocol to get a list of peers.
  41 -- 3. Then we talk to the peers to create the metadata via the BEP 0009 protocol
  42
  43 module FuncTorrent.MagnetURI where
  44
  45 import Text.ParserCombinators.Parsec
  46 import qualified Text.Parsec.ByteString as ParsecBS
  47 import Data.ByteString.Char8 (ByteString, pack)
  48 import Network.HTTP.Base (urlDecode)
  49
  50 data Magnetinfo = Magnetinfo { infoHash :: ByteString
  51                              , trackerlist :: [String]
  52                              , name :: String
  53                              , xlen :: Maybe Integer
  54                              }
  55                 deriving (Eq, Show)
  56
  57 magnetHdr :: ParsecBS.Parser String
  58 magnetHdr = string "magnet:?"
  59
  60 kvpair :: ParsecBS.Parser (String, String)
  61 kvpair = do
  62   k <- many1 letter
  63   _ <- char '='
  64   v <- many1 (noneOf "&")
  65   return (k, v)
  66
  67 magnetBody :: ParsecBS.Parser Magnetinfo
  68 magnetBody = do
  69   pairs <- kvpair `sepBy1` (char '&')
  70   -- walk through pairs, populate Magnetinfo (fold?)
  71   return $ foldl f magnetInfo pairs
  72     where f magnetRecord pair =
  73             let (k, v) = pair
  74             in
  75               case k of
  76                 "xt" -> magnetRecord { infoHash = pack v }
  77                 "tr" -> let trVal = trackerlist magnetRecord
  78                         in
  79                           magnetRecord { trackerlist = trVal ++ [urlDecode v] }
  80                 "dn" -> magnetRecord { name = urlDecode v }
  81                 "xl" -> magnetRecord { xlen = Just (read v :: Integer) }
  82                 _    -> magnetInfo
  83           magnetInfo = Magnetinfo { infoHash = mempty
  84                                   , trackerlist = mempty
  85                                   , name = mempty
  86                                   , xlen = Nothing }
  87
  88 magnetUri :: ParsecBS.Parser Magnetinfo
  89 magnetUri = magnetHdr >> magnetBody
  90
  91 parseMagneturi :: ByteString -> Either String Magnetinfo
  92 parseMagneturi input =
  93   case parse magnetUri "magnetParse" input of
  94     Right minfo -> Right minfo
  95     Left e -> Left $ "Cannot parse the magnet URI: " ++ show e