Commits

Yuri Bochkarev committed 41e3e13 Merge

merge

Comments (0)

Files changed (6)

 * imagebin.com
 * imm.io
 * scrin.org
+* uploadscreenshot.com
 * imgur.com
 
 ### Building
     [_] simplify login handlers
 
 [_] architecture
+    [_] learn all engines to extract both direct link and link to page
     [-] consider PasteHandler monad stack returning Maybe link as
         a computation result instead of modifying PasteContext
     [+] engine may return error (e.g. when trying to paste zip file to fastpic)
     [+] logging
         [+] add Log module with msgDebug, msgInfo functions
     [_] learn oauth authorization principles
+    [_] add oauth support
 
 [_] engines
+    [+] add uploadscreenshot.com (apikey=1c7688a8199888584473517828)
     [+] add imm.io
     [_] add imageshack.us
     [_] add yfrog.com
     [-] add minus.com (http://minus.com/pages/api, no anonymous API access)
     [_] add yandex.fotki
     [_] add twitpic.com (http://dev.twitpic.com, apikey=a1a5b6fe0ab2f61cbf88c7cb4fc4728b)
+    [_] add thumbsnap.com (http://thumbsnap.com/api/docs)
+    [_] add ipic.su
 
     [+] fastpic
     [+] flashtux
         3. $HOME/imp/imp.conf
         4. $XDG_CONFIG_DIRS/imp/imp.conf
     [+] read from JSON file
+    [_] add option to choose which link to show: direct or link to page
 
 [+] engine priority
     [+] add default internal engine order
 import Control.Monad (liftM)
 import Control.Applicative ((<$>), (<*>))
 
-import qualified Text.HTML.TagSoup as TS
 import qualified Text.JSON as J
 
 import qualified Data.Map as Map
 import Control.Monad.Reader (ask)
 import Control.Monad.IO.Class (liftIO)
 
-import qualified Text.HTML.TagSoup as TS
 import Text.JSON
 
 import qualified Data.Map as Map
+module EngineScrnsht (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 Text.HTML.TagSoup as TS
+
+import qualified Engine
+import qualified Configuration
+import Log (msgDebug, msgInfo)
+
+-- | Data structures according to API: http://www.uploadscreenshot.com/api-documentation
+data ScrnshtReply = ScrnshtReply {
+  srId        :: Int,
+  srUrl       :: String,
+  srShortUrl  :: String,
+  srStatsUrl  :: String,
+  srDeleteUrl :: String,
+  srSmall     :: String,
+  srLarge     :: String,
+  srOriginal  :: String
+} deriving Show
+
+scrnshtUploadUrl = "http://img1.uploadscreenshot.com/api-upload.php"
+
+scrnshtFields = [Engine.TextField "apiKey" "1c7688a8199888584473517828",
+                 Engine.TextField "xmlOutput" "1"]
+
+config = Engine.PasteContext {
+  Engine.pcUploadLink    = scrnshtUploadUrl,
+  Engine.pcFileTagName   = "userfile",
+  Engine.pcFileName      = "",
+  Engine.pcFields        = scrnshtFields,
+  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 "scrnsht") where
+    returnHandler Nothing = upload
+    returnHandler _       = signin >> upload
+
+signin :: Engine.PasteHandler ()
+signin = do
+  context <- get
+  config <- ask
+
+  let auth = Configuration.getEngineAuth config "scrnsht"
+      (name, password) = maybe ("", "") (\a -> (Configuration.eaName a, Configuration.eaPassword a)) auth
+      credentials = [Engine.TextField "username" name,
+                     Engine.TextField "userPasswordMD5" password]
+
+  liftIO $ msgDebug $ "putting credentials: " ++ show credentials
+  put $ Engine.addFields context credentials
+
+tagsToInfo :: [TS.Tag String] -> Maybe ScrnshtReply
+tagsToInfo tags = result where
+  pairs = [(no, v) | TS.TagOpen no _:TS.TagText v:TS.TagClose nc:_ <- List.tails tags, no == nc]
+  l v = fromMaybe "" (lookup v pairs)
+  result = maybe Nothing (\_ -> Just info) $ lookup "success" pairs
+  info = ScrnshtReply (read (l "id") :: Int)
+                      (l "url")
+                      (l "shorturl")
+                      (l "statsurl")
+                      (l "deleteurl")
+                      (l "small")
+                      (l "large")
+                      (l "original")
+
+upload :: Engine.PasteHandler ()
+upload = do
+  context <- get
+
+  liftIO $ msgDebug "Sending post with file"
+  liftIO $ msgDebug $ show context
+
+  response <- liftIO $ Engine.sendPostWithFile context
+
+  let text = rspBody response
+      tags = TS.parseTags text :: [TS.Tag String]
+      info = tagsToInfo tags
+      link = maybe Nothing (\x -> Just $ srOriginal x) info
+
+  put context { Engine.pcResultLink = link }
+
 import qualified EngineImagebin
 import qualified EngineImm
 import qualified EngineScrin
+import qualified EngineScrnsht
 import qualified EngineImgur
 
-engineConfigs = Map.fromList [("fastpic",  (EngineFastpic.config,  EngineFastpic.handler)),
-                              ("rghost",   (EngineRghost.config,   EngineRghost.handler)),
-                              ("ipicture", (EngineIpicture.config, EngineIpicture.handler)),
-                              ("ompldr",   (EngineOmpldr.config,   EngineOmpldr.handler)),
-                              ("flashtux", (EngineFlashtux.config, EngineFlashtux.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))]
+engineConfigs = Map.fromList [
+    ("fastpic",  (EngineFastpic.config,  EngineFastpic.handler)),
+    ("rghost",   (EngineRghost.config,   EngineRghost.handler)),
+    ("ipicture", (EngineIpicture.config, EngineIpicture.handler)),
+    ("ompldr",   (EngineOmpldr.config,   EngineOmpldr.handler)),
+    ("flashtux", (EngineFlashtux.config, EngineFlashtux.handler)),
+    ("imagebin", (EngineImagebin.config, EngineImagebin.handler)),
+    ("radikal",  (EngineRadikal.config,  EngineRadikal.handler)),
+    ("scrnsht",  (EngineScrnsht.config,  EngineScrnsht.handler)),
+    ("scrin",    (EngineScrin.config,    EngineScrin.handler)),
+    ("imgur",    (EngineImgur.config,    EngineImgur.handler)),
+    ("imm",      (EngineImm.config,      EngineImm.handler))]
 
 usage :: String
 usage = "imp v" ++ Version.version ++ " (changeset " ++ Version.changeset ++ ")"