Commits

Yuri Bochkarev committed 487c9fe

+ added imgur support (with auth support)

Comments (0)

Files changed (3)

notes/features.txt

     [_] add imageshack.us
     [_] add yfrog.com
     [_] add tinypic.com
-    [_] add imgur.com
+    [+] add imgur.com (auth, apikey=420de151712e1f55f03221c4939c2080)
     [+] add scrin.org
 
     [+] fastpic

src/EngineImgur.hs

+module EngineImgur (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 Control.Applicative ((<$>), (<*>))
+
+import qualified Data.Map as Map
+import qualified Data.List as List
+import qualified Text.JSON as J
+
+import qualified Engine
+import qualified Tools
+import qualified Processing
+import qualified Configuration
+import Log (msgDebug, msgInfo)
+
+-- | Data structures according to API: http://api.imgur.com/resources_anon
+data ImgurReply = ImgurReply {
+  irUpload :: ImgurUpload
+} deriving Show
+
+data ImgurUpload = ImgurUpload {
+  iuImage :: ImgurReplyImage,
+  iuLinks :: ImgurReplyLinks
+} deriving Show
+
+data ImgurReplyImage = ImgurReplyImage {
+--  iriName       :: String,
+--  iriTitle      :: String,
+--  iriCaption    :: String,
+  iriHash       :: String,
+  iriDeletehash :: String,
+  iriDatetime   :: String,
+  iriType       :: String,
+  iriAnimated   :: String,
+  iriWidth      :: Int,
+  iriHeight     :: Int,
+  iriSize       :: Int,
+  iriViews      :: Int,
+  iriBandwidth  :: Int
+} deriving Show
+
+data ImgurReplyLinks = ImgurReplyLinks {
+  irlOriginal   :: String,
+  irlImgur      :: String,
+  irlDelete     :: String,
+  irlSmall      :: String,
+  irlLarge      :: String
+} deriving Show
+
+mLookup a as = maybe (fail $ "No such element: " ++ a) return (lookup a as)
+lookRead as id = mLookup id as  >>= J.readJSON
+
+--dummyImage = ImgurReplyImage "" "" "" "" "" "" "" "" 0 0 0 0 0
+dummyImage = ImgurReplyImage "" "" "" "" "" 0 0 0 0 0
+dummyLinks = ImgurReplyLinks "" "" "" "" ""
+dummyUpload = ImgurUpload dummyImage dummyLinks
+dummyReply = ImgurReply dummyUpload
+
+instance J.JSON ImgurReply where
+  showJSON _ = J.JSNull
+  
+  readJSON (J.JSObject obj) =
+    let as = J.fromJSObject obj
+        f id = lookRead as id
+    in do
+      ImgurReply <$> f "upload"
+    
+  readJSON _ = return $ dummyReply
+
+instance J.JSON ImgurUpload where
+  showJSON _ = J.JSNull
+  
+  readJSON (J.JSObject obj) =
+    let as = J.fromJSObject obj
+        f id = lookRead as id
+    in do
+      ImgurUpload <$> f "image" <*> f "links"
+    
+  readJSON _ = return $ dummyUpload
+
+instance J.JSON ImgurReplyImage where
+  showJSON _ = J.JSNull
+  
+  readJSON (J.JSObject obj) =
+    let as = J.fromJSObject obj
+        f id = lookRead as id
+    in ImgurReplyImage
+--           <$> f "name"
+--           <*> f "title"
+--           <*> f "caption"
+           <$> f "hash"
+           <*> f "deletehash"
+           <*> f "datetime"
+           <*> f "type"
+           <*> f "animated"
+           <*> f "width"
+           <*> f "height"
+           <*> f "size"
+           <*> f "views"
+           <*> f "bandwidth"
+  
+  readJSON _ = return $ dummyImage
+
+instance J.JSON ImgurReplyLinks where
+  showJSON _ = J.JSNull
+  
+  readJSON (J.JSObject obj) =
+    let as = J.fromJSObject obj
+        f id = lookRead as id
+    in ImgurReplyLinks
+           <$> f "original"
+           <*> f "imgur_page"
+           <*> f "delete_page"
+           <*> f "small_square"
+           <*> f "large_thumbnail"
+  
+  readJSON _ = return $ dummyLinks
+
+imgurUploadUrl = "http://api.imgur.com/2/upload.json"
+imgurSigninUrl = "http://api.imgur.com/2/signin"
+
+imgurFields = [Engine.TextField "key" "420de151712e1f55f03221c4939c2080"]
+
+config = Engine.PasteContext {
+  Engine.pcUploadLink    = imgurUploadUrl,
+  Engine.pcFileTagName   = "image",
+  Engine.pcFileName      = "",
+  Engine.pcFields        = imgurFields,
+  Engine.pcEncodingType  = Engine.MultipartFormData,
+  Engine.pcContents      = "",
+  Engine.pcResultLink    = Nothing,
+  Engine.pcCustomFields  = Map.empty,
+  Engine.pcAllowRedirect = False,
+  Engine.pcCustomHeaders = []
+  }
+
+signinConfig = Engine.PasteContext {
+  Engine.pcUploadLink    = imgurSigninUrl,
+  Engine.pcFileTagName   = "",
+  Engine.pcFileName      = "",
+  Engine.pcFields        = [],
+  Engine.pcEncodingType  = Engine.UrlEncoded,
+  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 "imgur") where
+    returnHandler Nothing = upload
+    returnHandler _       = signin >> upload
+
+-- | Retrieves cookies
+signin :: Engine.PasteHandler ()
+signin = do
+  -- start login page
+  context <- get
+  config <- ask
+
+  let loginContext = signinConfig { Engine.pcFields = Engine.pcFields context ++ completeLoginFields }
+      auth = Configuration.getEngineAuth config "imgur"
+      (name, password) = maybe ("", "") (\a -> (Configuration.eaName a, Configuration.eaPassword a)) auth
+      completeLoginFields = [Engine.TextField "username" name,
+                             Engine.TextField "password" password]
+
+  response <- liftIO $ Engine.sendPostWithoutFile loginContext
+
+  let cookies = Engine.cookiesRemoveSet response
+      authorizedContext = context { Engine.pcCustomHeaders = [cookies] }
+  liftIO $ msgDebug $ "cookies: " ++ show cookies
+
+  put authorizedContext
+
+upload :: Engine.PasteHandler ()
+upload = do
+  context <- get
+
+  liftIO $ msgDebug "Sending post with file"
+  liftIO $ msgDebug $ show context
+
+  response <- liftIO $ Engine.sendPostWithFile context
+
+  let link reply = irlOriginal $ iuLinks $ irUpload reply
+      parseResult (J.Ok reply) = do
+        put context { Engine.pcResultLink = Just $ link reply }
+        return ()
+      parseResult _ = do
+        return ()
+
+  parseResult ((J.decode $ rspBody response) :: J.Result ImgurReply)
 import qualified EngineImagebin
 import qualified EngineImm
 import qualified EngineScrin
+import qualified EngineImgur
 
 engineConfigs = Map.fromList [("fastpic",  (EngineFastpic.config,  EngineFastpic.handler)),
                               ("rghost",   (EngineRghost.config,   EngineRghost.handler)),
                               ("imagebin", (EngineImagebin.config, EngineImagebin.handler)),
                               ("radikal",  (EngineRadikal.config,  EngineRadikal.handler)),
                               ("scrin",    (EngineScrin.config ,   EngineScrin.handler)),
+                              ("imgur",    (EngineImgur.config ,   EngineImgur.handler)),
                               ("imm",      (EngineImm.config,      EngineImm.handler))]
 
 usage :: String