imagepaste-0.2.0.0: src/EngineRadikal.hs

module EngineRadikal (config, handler) where

import Data.Maybe
import Network.HTTP.Headers
import Network.HTTP
import Control.Monad.State (modify, get, put)
import Control.Monad.Reader (ask)
import Control.Monad.IO.Class (liftIO)

import qualified Control.Arrow
import qualified Data.Map as Map
import qualified Data.List as List

import qualified Engine
import qualified Tools
import qualified Processing
import qualified Configuration
import Log (msgDebug, msgInfo)

radikalUploadUrl = "http://radikal.ru/action.aspx"
radikalAuthUrl = "http://radikal.ru/REGISTER/PageLogin.aspx"

radikalFields = [
  Engine.TextField "upload" "yes",
  Engine.TextField "GEO_POINT_ID" "",
  Engine.TextField "URLF" "",
  Engine.TextField "" "0",
  Engine.TextField "M" "640",
  Engine.TextField "JQ" "85",
  Engine.TextField "IM" "7",
  Engine.TextField "VM" "180",
  Engine.TextField "R" "0",
  Engine.TextField "VE" "yes",
  Engine.TextField "V" "Uvelishit'",
  Engine.TextField "X" "",
  Engine.TextField "FS" ""]

authFields = [
  Engine.TextField "postpass" "yes",
  Engine.TextField "rurl" "http://www.radikal.ru/default.aspx"]

config = Engine.PasteContext {
  Engine.pcUploadLink    = radikalUploadUrl,
  Engine.pcFileTagName   = "F",
  Engine.pcFileName      = "",
  Engine.pcFields        = radikalFields,
  Engine.pcEncodingType  = Engine.MultipartFormData,
  Engine.pcContents      = "",
  Engine.pcResultLink    = Nothing,
  Engine.pcCustomFields  = Map.empty,
  Engine.pcAllowRedirect = False,
  Engine.pcCustomHeaders = []
  }

authConfig = Engine.PasteContext {
  Engine.pcUploadLink    = radikalAuthUrl,
  Engine.pcFileTagName   = "",
  Engine.pcFileName      = "",
  Engine.pcFields        = authFields,
  Engine.pcEncodingType  = Engine.MultipartFormData,
  Engine.pcContents      = "",
  Engine.pcResultLink    = Nothing,
  Engine.pcCustomFields  = Map.empty,
  Engine.pcAllowRedirect = False,
  Engine.pcCustomHeaders = []
  }

handler :: Engine.PasteHandler ()
handler = do
  config <- ask
  returnHandler (Configuration.getEngineAuth config "radikal") where
    returnHandler Nothing = getLoginPage >> sendFile
    returnHandler _       = getLoginPage >> auth >> sendFile

-- | Retrieves UID and SID from login page
getLoginPage :: Engine.PasteHandler ()
getLoginPage = do
  -- start login page
  context <- get
  liftIO $ msgDebug "Getting login page..."
  loginPage <- liftIO $ Engine.fetch (getRequest radikalAuthUrl) True
  let cookies = Engine.cookiesRemoveSet loginPage
  liftIO $ msgDebug $ "cookies: " ++ show cookies
  put $ Engine.addCustomHeaders context [cookies]

auth :: Engine.PasteHandler ()
auth = do
  config <- ask
  context <- get

  -- add username and password form fields to authConfig context
  -- add cookies (UID, SID) to authConfig from the context
  let 
      auth = Configuration.getEngineAuth config "radikal"
      (name, password) = maybe ("", "") (Configuration.eaName Control.Arrow.&&& Configuration.eaPassword) auth
      withFields = Engine.addFields authConfig [Engine.TextField "username" name,
                                                Engine.TextField "upassword" password]
      withCookies = Engine.addCustomHeaders withFields $ Engine.pcCustomHeaders context
  
  liftIO $ msgDebug "Sending post without file"
  liftIO $ msgDebug $ "withFields: " ++ show withFields
  liftIO $ msgDebug $ "withCookies: " ++ show withCookies
  
  -- send login request
  liftIO $ msgDebug "Sending HTTP FORM POST..."
  response <- liftIO $ Engine.sendPostWithoutFile withCookies
  
  let cookies = Engine.cookiesRemoveSet response
      newHeaders = cookies : Engine.pcCustomHeaders withCookies
      mergedCookie = Engine.mergeCookies newHeaders "; "
      authorizedContext = context { Engine.pcCustomHeaders = [mergedCookie] }

  liftIO $ msgDebug $ "newHeaders: " ++ show newHeaders
  liftIO $ msgDebug $ "newCookies: " ++ show cookies
  liftIO $ msgDebug $ "mergedCookie: " ++ show mergedCookie

  put authorizedContext
  
sendFile :: Engine.PasteHandler ()
sendFile = Engine.uploadAndGrabHtml (Engine.grabExtractLinks "input" "value" Engine.FileExtension)
             >>= Engine.saveFirstLink