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 Control.Monad (void) import qualified Control.Arrow 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 = lookRead as in 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 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 "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 = lookRead as 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 ("", "") (Configuration.eaName Control.Arrow.&&& Configuration.eaPassword) 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) = void $ put context { Engine.pcResultLink = Just $ link reply } parseResult _ = return () parseResult ((J.decode $ rspBody response) :: J.Result ImgurReply)