imagepaste-0.2.0.0: src/EngineScrin.hs

module EngineScrin (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 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)

scrinUploadUrl = "http://scrin.org/"

scrinFields = [
  Engine.TextField "resize_x" "",
  Engine.TextField "resize_y" "",
  Engine.TextField "thumb-sets" "none",
  Engine.TextField "thumb-size-h" "100",
  Engine.TextField "thumb-size-w" "100",
  Engine.TextField "x" "",
  Engine.TextField "y" ""]

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

handler :: Engine.PasteHandler ()
handler = getPostkeyAndCookies >> sendFile

-- | Retrieves Cookies and Postkey from login page
getPostkeyAndCookies :: Engine.PasteHandler ()
getPostkeyAndCookies = do
  -- start login page
  context <- get
  liftIO $ msgDebug "Getting start page..."
  startPage <- liftIO $ Engine.fetch (getRequest scrinUploadUrl) True
  let cookies = Engine.cookiesRemoveSet startPage
  liftIO $ msgDebug $ "cookies: " ++ show cookies
  put $ Engine.addCustomHeaders context [cookies]

  let mPostkey = Processing.extractLink (rspBody startPage) "input" "value" ""
  liftIO $ msgDebug $ "postkey: " ++ show mPostkey

  let postkey = fromMaybe "" mPostkey
      fields = Engine.pcFields context
      newContext = context { Engine.pcFields = Engine.TextField "postkey" postkey : fields }

  put newContext

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