-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Torrent.Scrape
-- Copyright   :  (c) Lemmih 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- <http://en.wikipedia.org/wiki/Tracker_scrape>
-----------------------------------------------------------------------------

{-# LANGUAGE PatternGuards #-}

module Data.Torrent.Scrape
    ( ScrapeInfo(..)
    , parseScrapeInfo
    , scrapeUrl
    ) where

import Data.Char
import Data.BEncode
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.ByteString.Lazy (ByteString)
import System.FilePath
import qualified Data.Map as Map

data ScrapeInfo = ScrapeInfo
    { ScrapeInfo -> Integer
scrapeSeeds    :: Integer
    , ScrapeInfo -> Integer
scrapeLeechers :: Integer
    } deriving (ReadPrec [ScrapeInfo]
ReadPrec ScrapeInfo
Int -> ReadS ScrapeInfo
ReadS [ScrapeInfo]
(Int -> ReadS ScrapeInfo)
-> ReadS [ScrapeInfo]
-> ReadPrec ScrapeInfo
-> ReadPrec [ScrapeInfo]
-> Read ScrapeInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScrapeInfo]
$creadListPrec :: ReadPrec [ScrapeInfo]
readPrec :: ReadPrec ScrapeInfo
$creadPrec :: ReadPrec ScrapeInfo
readList :: ReadS [ScrapeInfo]
$creadList :: ReadS [ScrapeInfo]
readsPrec :: Int -> ReadS ScrapeInfo
$creadsPrec :: Int -> ReadS ScrapeInfo
Read,Int -> ScrapeInfo -> ShowS
[ScrapeInfo] -> ShowS
ScrapeInfo -> String
(Int -> ScrapeInfo -> ShowS)
-> (ScrapeInfo -> String)
-> ([ScrapeInfo] -> ShowS)
-> Show ScrapeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrapeInfo] -> ShowS
$cshowList :: [ScrapeInfo] -> ShowS
show :: ScrapeInfo -> String
$cshow :: ScrapeInfo -> String
showsPrec :: Int -> ScrapeInfo -> ShowS
$cshowsPrec :: Int -> ScrapeInfo -> ShowS
Show)

parseScrapeInfo :: ByteString -> Maybe ScrapeInfo
parseScrapeInfo :: ByteString -> Maybe ScrapeInfo
parseScrapeInfo bs :: ByteString
bs
    = case ByteString -> Maybe BEncode
bRead ByteString
bs of
        Just (BDict dict :: Map String BEncode
dict)
            -> do BDict files :: Map String BEncode
files  <- String -> Map String BEncode -> Maybe BEncode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "files" Map String BEncode
dict
                  [BDict dict' :: Map String BEncode
dict'] <- [BEncode] -> Maybe [BEncode]
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String BEncode -> [BEncode]
forall k a. Map k a -> [a]
Map.elems Map String BEncode
files)
                  BInt seeders :: Integer
seeders <- String -> Map String BEncode -> Maybe BEncode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "complete" Map String BEncode
dict'
                  BInt peers :: Integer
peers   <- String -> Map String BEncode -> Maybe BEncode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup "incomplete" Map String BEncode
dict'
                  ScrapeInfo -> Maybe ScrapeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (ScrapeInfo -> Maybe ScrapeInfo) -> ScrapeInfo -> Maybe ScrapeInfo
forall a b. (a -> b) -> a -> b
$ ScrapeInfo :: Integer -> Integer -> ScrapeInfo
ScrapeInfo
                             { scrapeSeeds :: Integer
scrapeSeeds = Integer
seeders
                             , scrapeLeechers :: Integer
scrapeLeechers = Integer
peers }
        _ -> Maybe ScrapeInfo
forall a. Maybe a
Nothing

scrapeUrl :: ByteString -> [String] -> Maybe String
scrapeUrl :: ByteString -> [String] -> Maybe String
scrapeUrl _hash :: ByteString
_hash [] = Maybe String
forall a. Maybe a
Nothing
scrapeUrl hash :: ByteString
hash (announce :: String
announce:rs :: [String]
rs)
    = case String -> (String, String)
splitFileName String
announce of
        (path :: String
path,file_ :: String
file_)
            | (file :: String
file,ext :: String
ext) <- String -> (String, String)
splitExtension String
file_
            , ("announce",rest :: String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='?') String
file
            -> let info_hash :: String
info_hash = ShowS
urlEncode (ByteString -> String
BS.unpack ByteString
hash)
                   file' :: String
file' = "scrape" String -> ShowS
forall a. [a] -> [a] -> [a]
++ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
                                       then "?info_hash="String -> ShowS
forall a. [a] -> [a] -> [a]
++String
info_hash
                                       else "&info_hash="String -> ShowS
forall a. [a] -> [a] -> [a]
++String
info_hash
               in String -> Maybe String
forall a. a -> Maybe a
Just (String
path String -> ShowS
</> String
file' String -> ShowS
<.> String
ext)
        _ -> ByteString -> [String] -> Maybe String
scrapeUrl ByteString
hash [String]
rs

urlEncode :: String -> String
urlEncode :: ShowS
urlEncode [] = []
urlEncode s :: String
s = (Char -> ShowS) -> String -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
worker [] String
s
  where worker :: Char -> ShowS
worker c :: Char
c cs :: String
cs =
          if Char -> Bool
isReservedChar Char
c then let (a :: Int
a, b :: Int
b) = Char -> Int
ord Char
c Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 16
                                   in '%' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit Int
a Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit Int
b Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
                              else Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs
        isReservedChar :: Char -> Bool
isReservedChar x :: Char
x =
          Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '0' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> '9' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< 'A' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> 'Z'
                             Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< 'a' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> 'z'