-----------------------------------------------------------------------------
-- |
-- 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
$creadsPrec :: Int -> ReadS ScrapeInfo
readsPrec :: Int -> ReadS ScrapeInfo
$creadList :: ReadS [ScrapeInfo]
readList :: ReadS [ScrapeInfo]
$creadPrec :: ReadPrec ScrapeInfo
readPrec :: ReadPrec ScrapeInfo
$creadListPrec :: ReadPrec [ScrapeInfo]
readListPrec :: ReadPrec [ScrapeInfo]
Read,Int -> ScrapeInfo -> ShowS
[ScrapeInfo] -> ShowS
ScrapeInfo -> [Char]
(Int -> ScrapeInfo -> ShowS)
-> (ScrapeInfo -> [Char])
-> ([ScrapeInfo] -> ShowS)
-> Show ScrapeInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScrapeInfo -> ShowS
showsPrec :: Int -> ScrapeInfo -> ShowS
$cshow :: ScrapeInfo -> [Char]
show :: ScrapeInfo -> [Char]
$cshowList :: [ScrapeInfo] -> ShowS
showList :: [ScrapeInfo] -> ShowS
Show)

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

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

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