{-# 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]
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
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 ByteString
bs
= case ByteString -> Maybe BEncode
bRead ByteString
bs of
Just (BDict Map String BEncode
dict)
-> do BDict Map String BEncode
files <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"files" Map String BEncode
dict
[BDict Map String BEncode
dict'] <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a -> [a]
Map.elems Map String BEncode
files)
BInt Integer
seeders <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"complete" Map String BEncode
dict'
BInt Integer
peers <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"incomplete" Map String BEncode
dict'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScrapeInfo
{ scrapeSeeds :: Integer
scrapeSeeds = Integer
seeders
, scrapeLeechers :: Integer
scrapeLeechers = Integer
peers }
Maybe BEncode
_ -> forall a. Maybe a
Nothing
scrapeUrl :: ByteString -> [String] -> Maybe String
scrapeUrl :: ByteString -> [String] -> Maybe String
scrapeUrl ByteString
_hash [] = forall a. Maybe a
Nothing
scrapeUrl ByteString
hash (String
announce:[String]
rs)
= case String -> (String, String)
splitFileName String
announce of
(String
path,String
file_)
| (String
file,String
ext) <- String -> (String, String)
splitExtension String
file_
, (String
"announce",String
rest) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'?') String
file
-> let info_hash :: String
info_hash = ShowS
urlEncode (ByteString -> String
BS.unpack ByteString
hash)
file' :: String
file' = String
"scrape" forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
then String
"?info_hash="forall a. [a] -> [a] -> [a]
++String
info_hash
else String
"&info_hash="forall a. [a] -> [a] -> [a]
++String
info_hash
in forall a. a -> Maybe a
Just (String
path String -> ShowS
</> String
file' String -> ShowS
<.> String
ext)
(String, String)
_ -> ByteString -> [String] -> Maybe String
scrapeUrl ByteString
hash [String]
rs
urlEncode :: String -> String
urlEncode :: ShowS
urlEncode [] = []
urlEncode String
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
worker [] String
s
where worker :: Char -> ShowS
worker Char
c String
cs =
if Char -> Bool
isReservedChar Char
c then let (Int
a, Int
b) = Char -> Int
ord Char
c forall a. Integral a => a -> a -> (a, a)
`divMod` Int
16
in Char
'%' forall a. a -> [a] -> [a]
: Int -> Char
intToDigit Int
a forall a. a -> [a] -> [a]
: Int -> Char
intToDigit Int
b forall a. a -> [a] -> [a]
: String
cs
else Char
c forall a. a -> [a] -> [a]
: String
cs
isReservedChar :: Char -> Bool
isReservedChar Char
x =
Char
x forall a. Ord a => a -> a -> Bool
< Char
'0' Bool -> Bool -> Bool
|| Char
x forall a. Ord a => a -> a -> Bool
> Char
'9' Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
< Char
'A' Bool -> Bool -> Bool
|| Char
x forall a. Ord a => a -> a -> Bool
> Char
'Z'
Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
< Char
'a' Bool -> Bool -> Bool
|| Char
x forall a. Ord a => a -> a -> Bool
> Char
'z'