    -----------------------------------------------------------------------------
    -- |
    -- 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 -> String
    (Int -> ScrapeInfo -> ShowS)
    -> (ScrapeInfo -> String)
    -> ([ScrapeInfo] -> ShowS)
    -> Show ScrapeInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ScrapeInfo -> ShowS
    showsPrec :: Int -> ScrapeInfo -> ShowS
    $cshow :: ScrapeInfo -> String
    show :: ScrapeInfo -> String
    $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 String BEncode
    dict)
                -> do BDict files  <- String -> Map String BEncode -> Maybe BEncode
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    "files" Map String 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 -> [String] -> Maybe String
    scrapeUrl ByteString
    _hash [] = Maybe String
    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) <- (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    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" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest
                                           then String
    "?info_hash="String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    info_hash
                                           else String
    "&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)
            (String, String)
    _ -> ByteString -> [String] -> Maybe String
    scrapeUrl ByteString
    hash [String]
    rs

    urlEncode :: String -> String
    urlEncode :: ShowS
    urlEncode [] = []
    urlEncode String
    s = (Char -> ShowS) -> String -> 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 [] 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 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]
    : String
    cs
                                  else Char
    c Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    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'