imgur (empty) → 1.0

raw patch · 4 files changed

+105/−0 lines, 4 filesdep +basedep +data-default-classdep +http-clientsetup-changed

Dependencies added: base, data-default-class, http-client, req, text, xml-conduit, xml-lens

Files

• LICENSE +7/−0
• Setup.hs +3/−0
• imgur.cabal +34/−0
• src/Imgur.hs +61/−0

@@ -0,0 +1,7 @@+Copyright 2019-present Dmitry Ivanov++Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at++http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,34 @@+cabal-version: 1.12+name:           imgur+version:        1.0+synopsis:       A function to post an image to imgur+description:    Please see README.md+category:       Tools+homepage:       https://github.com/ethercrow/imgur#readme+bug-reports:    https://github.com/ethercrow/imgur/issues+maintainer:     Dmitry Ivanov <ethercrow@gmail.com>+license:        Apache-2.0+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/ethercrow/imgur++library+  exposed-modules:+      Imgur+  other-modules:+      Paths_imgur+  hs-source-dirs:+      src+  ghc-options: -Wall -ferror-spans+  build-depends:+      base >=4.9 && <5+    , data-default-class+    , http-client+    , req >=2.0+    , text+    , xml-conduit+    , xml-lens+  default-language: Haskell2010

@@ -0,0 +1,61 @@+{-# language OverloadedStrings #-}+{-# language DataKinds #-}+module Imgur+  ( post+  )+where++import qualified Data.Text as T+import qualified Network.HTTP.Client.MultipartFormData as LM+import Network.HTTP.Req+import Text.XML+import Text.XML.Lens++endpoint :: Url 'Https+endpoint = https "api.imgur.com" /: "3" /: "image.xml"++headers :: Option 'Https+headers = header "Authorization" "Client-ID c9a6efb3d7932fd"++post :: FilePath -> IO T.Text+post imagePath = do+  resp <-+    runReq defaultHttpConfig $ do+      body <- reqBodyMultipart [LM.partFileSource "image" imagePath]+      req POST endpoint body lbsResponse headers+  let document = parseLBS_ def $ responseBody resp+  case document ^? root . el "data" ./ el "link" . text of+    Just path -> pure path+    _ -> error ("Failed to parse imgur response " <> show document)++-- <?xml version=\\\"1.0\\\" encoding=\\\"utf-8\\\"?>+-- <data type=\\\"array\\\" success=\\\"1\\\" status=\\\"200\\\">+-- <id>2p0uC3f</id>+-- <title/>+-- <description/>+-- <datetime>1562347046</datetime>+-- <type>image/png</type>+-- <animated>false</animated>+-- <width>13</width>+-- <height>13</height>+-- <size>1858</size>+-- <views>0</views>+-- <bandwidth>0</bandwidth>+-- <vote/>+-- <favorite>false</favorite>+-- <nsfw/>+-- <section/>+-- <account_url/>+-- <account_id>0</account_id>+-- <is_ad>false</is_ad>+-- <in_most_viral>false</in_most_viral>+-- <has_sound>false</has_sound>+-- <tags/>+-- <ad_type>0</ad_type>+-- <ad_url/>+-- <edited>0</edited>+-- <in_gallery>false</in_gallery>+-- <deletehash>AAAAAAAAAAAA</deletehash>+-- <name/>+-- <link>https://i.imgur.com/AAAAAAA.png</link>+-- </data>