imagepaste-0.2.0.0: src/EngineFastpic.hs

module EngineFastpic (config, handler) where

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

import qualified Data.Map as Map

import qualified Engine

fastpicUploadUrl = "http://fastpic.ru/upload"

fastpicFields = [Engine.EmptyFilenameField n | n <- [2..6]] ++
                [Engine.TextField "uploading" "1",
                 Engine.TextField "check_thumb" "size",
                 Engine.TextField "thumb_text" "Uvelichit'",
                 Engine.TextField "thumb_size" "170",
                 Engine.TextField "res_select" "500",
                 Engine.TextField "orig_resize" "500",
                 Engine.TextField "orig_rotate" "0",
                 Engine.TextField "jpeg_quality" "75",
                 Engine.TextField "submit" "Zagruzit'"]

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

-- | Parses response, downloads refresh page and parses it too
handler :: Engine.PasteHandler ()
handler = do
  context <- get
  response <- liftIO $ Engine.sendPostWithFile context
  maybe (return ()) parseRefreshPage (getRefreshLink response)

parseRefreshPage :: String -> Engine.PasteHandler ()
parseRefreshPage url = Engine.fetchAndGrabHtml url False (Engine.grabExtractLinks "input" "value" Engine.FileExtension)
                         >>= Engine.saveFirstLink

-- | Returns Refresh URL from fastpic.ru upload response
getRefreshLink :: Response String -> Maybe String
getRefreshLink response = cut where
  refresh = HdrCustom "Refresh"
  headers = getHeaders response
  cut = fmap (drop 6) (lookupHeader refresh headers)