module Network.Google.Bookmarks (
EMail
, Password
, SmsToken
, listBookmarks
) where
import Control.Monad (liftM)
import Data.ByteString.Char8 as BS8 (ByteString, pack, unpack)
import Data.ByteString.Lazy.Char8 as LBS8 (ByteString, pack, unpack)
import Data.ByteString.Lazy.UTF8 (fromString, toString)
import Data.Maybe (fromJust)
import Data.Time.Clock (getCurrentTime)
import Network.Google (appendHeaders)
import Network.HTTP.Conduit (Request(..), RequestBody(..), Response(..), def, httpLbs, insertCookiesIntoRequest, parseUrl, updateCookieJar, withManager)
import Text.XML.Light (Element(..), QName(..), blank_name, filterElement, findAttr, parseXMLDoc)
type EMail = String
type Password = String
type SmsToken = String
listBookmarks ::
EMail
-> Password
-> SmsToken
-> IO Element
listBookmarks email password smsToken =
do
now <- getCurrentTime
withManager $ \manager -> do
requestGet1 <- parseUrl $ "https://accounts.google.com/Login?continue=" ++ listingUrl ++ "&hl=en&service=bookmarks&authuser=0"
responseGet1 <- httpLbs requestGet1 manager
let
encode = LBS8.unpack . fromString
cookieInserter cookieJar request = fst $ insertCookiesIntoRequest request cookieJar now
responseXml = fromJust . parseXMLDoc . toString . responseBody
bodyGet1 = responseXml responseGet1
(cookieJarGet1, _) = updateCookieJar responseGet1 requestGet1 now def
requestPost1 =
cookieInserter cookieJarGet1 $
(accountsPostRequest "/ServiceLoginAuth") {
requestBody = RequestBodyBS $ BS8.pack $
"continue=" ++ listingUrl
++ "&service=bookmarks"
++ "&dsh=" ++ extractValue "dsh" bodyGet1
++ "&GALX=" ++ extractValue "GALX" bodyGet1
++ "&bgresponse=js_disabled"
++ "&Email=" ++ encode email
++ "&Passwd=" ++ encode password
++ "&PersistentCookie=yes"
, redirectCount = 0
, checkStatus = \_ _ -> Nothing
}
responsePost1 <- httpLbs requestPost1 manager
let
(cookieJarPost1, _) = updateCookieJar responsePost1 requestPost1 now cookieJarGet1
requestPost2 =
cookieInserter cookieJarPost1 $
(accountsPostRequest "/SmsAuth") {
queryString = BS8.pack $ "?continue=" ++ listingUrl ++ "&service=bookmarks"
, requestBody = RequestBodyBS $ BS8.pack $
"continue=" ++ listingUrl
++ "&service=bookmarks"
++ "&exp=smsauthnojs"
++ "&smsUserPin=" ++ encode smsToken
++ "&PersistentCookie=yes"
, redirectCount = 0
, checkStatus = \_ _ -> Nothing
}
responsePost2 <- httpLbs requestPost2 manager
let
bodyPost2 = responseXml responsePost2
(cookieJarPost2, _) = updateCookieJar responsePost2 requestPost2 now cookieJarPost1
requestPost3 =
cookieInserter cookieJarPost2 $
(accountsPostRequest "/ServiceLoginAuth") {
queryString = BS8.pack $ "?continue=" ++ listingUrl
, requestBody = RequestBodyBS $ BS8.pack $
"continue=" ++ listingUrl
++ "&smsToken=" ++ extractValue "smsToken" bodyPost2
++ "&GALX=" ++ extractValue "GALX" bodyGet1
++ "&bgresponse=js_disabled"
}
responsePost3 <- httpLbs requestPost3 manager
return $ responseXml responsePost3
accountsPostRequest :: String -> Request m
accountsPostRequest path =
appendHeaders [("Content-Type", "application/x-www-form-urlencoded")] $
def {
method = BS8.pack "POST"
, secure = True
, host = BS8.pack "accounts.google.com"
, port = 443
, path = BS8.pack path
}
listingUrl :: String
listingUrl = "https%3A%2F%2Fwww.google.com%2Fbookmarks%2F%3Foutput%3Dxml%26num%3D100000"
extractValue :: String -> Element -> String
extractValue value root =
fromJust $ do
let
inputElement = blank_name {qName = "input"}
nameAttribute = blank_name {qName = "name"}
valueAttribute = blank_name {qName = "value"}
filter element = elName element == inputElement && findAttr nameAttribute element == Just value
element <- filterElement filter root
findAttr valueAttribute element