A simple Google PageRank™ checker

gistfile1.hs

{-# LANGUAGE BangPatterns #-}

import Data.Bits
import Data.Char            (ord)
import Data.Maybe           (fromMaybe, listToMaybe)
import Numeric              (showHex)
import Network.Browser
import Network.HTTP
import System.Environment   (getArgs)
import System.Exit          (exitFailure)

checksum :: String -> String
checksum = checksum' 0 0x01020345

checksum' :: Int -> Int -> String -> String
checksum' !i !result query
    | i == length query = '8' : showHex result ""
    | otherwise         = let seed = "Mining PageRank is AGAINST GOOGLE'S TERMS OF SERVICE. Yes, I'm talking to you, scammer."
                              r1   = ord (seed !! (i `mod` length seed)) `xor` ord (query !! i)
                              r2   = result `xor` r1
                              r3   = (r2 `shiftR` 23) .|. (r2 `shiftL` 9)
                              r4   = r3 .&. 0xffffffff
                           in checksum' (i+1) r4 query

mkQueryURL :: String -> String
mkQueryURL name = "http://toolbarqueries.google.com/tbr?client=navclient-auto&ch=" ++ checksum name ++ "&features=Rank&q=info:" ++ name

printRank :: String -> IO ()
printRank r
    | null r              = putStrLn "0"
    | take 5 r == "Rank_" = putStrLn . reverse . takeWhile (/= ':') . reverse . head . lines $ r
    | otherwise           = putStrLn ("Cannot parse PageRank response line: " ++ r) >> exitFailure

main :: IO ()
main = do
    !url     <- (fromMaybe (error "Empty argument") . listToMaybe) `fmap` getArgs
    (_, rsp) <- Network.Browser.browse $ do
                    setOutHandler (const (return ()))
                    setErrHandler (const (return ()))
                    setAllowRedirects True
                    setMaxRedirects (Just 1)
                    setUserAgent "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; GTB5; SLCC1; .NET CLR 2.0.50727; .NET CLR 3.0.04506)"
                    request . getRequest . mkQueryURL $ url
    printRank . take 16 . rspBody $ rsp