packages feed

uploadcare (empty) → 0.1

raw patch · 7 files changed

+250/−0 lines, 7 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, bytestring, cryptohash, hex, http-conduit, http-types, old-locale, time

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012 Dimitry Solovyov++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ src/Web/Uploadcare.hs view
@@ -0,0 +1,13 @@+module Web.Uploadcare+(+  Client(..)+, newClient+, closeClient+, File(..)+, getFile+, deleteFile+, saveFile+) where++import Web.Uploadcare.API+import Web.Uploadcare.Client
+ src/Web/Uploadcare/API.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Uploadcare.API+(+  File(..)+, getFile+, deleteFile+, saveFile+) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson+import qualified Data.Aeson.Types as T+import Data.Attoparsec.Lazy (parse, Result(..))+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import Network.HTTP.Conduit (Response(..))+import Web.Uploadcare.Client (Client)+import Web.Uploadcare.Internal++data File = File {+    file_id :: String+  , last_keep_claim :: String+  , made_public :: Bool+  , mime_type :: String+  , on_s3 :: Bool+  , original_file_url :: String+  , original_filename :: String+  , removed :: Maybe String+  , size :: Integer+  , upload_date :: String+  , url :: String+  } deriving (Show)++instance FromJSON File where+    parseJSON (Object v) =+        File <$> v .: "file_id"+             <*> v .: "last_keep_claim"+             <*> v .: "made_public"+             <*> v .: "mime_type"+             <*> v .: "on_s3"+             <*> v .: "original_file_url"+             <*> v .: "original_filename"+             <*> v .: "removed"+             <*> v .: "size"+             <*> v .: "upload_date"+             <*> v .: "url"+    parseJSON _ = mzero++getFile :: Client -> ByteString -> IO (Maybe File)+getFile client fileId = do+    res <- request client "GET" path+    return $ parseResponse res+  where+    path = BS.concat ["/files/", fileId]+++deleteFile :: Client -> File -> IO ()+deleteFile client file = do+    _ <- request client "DELETE" path+    return ()+  where+    path = BS.concat ["/files/", fileId]+    fileId = BS.pack $ file_id file++saveFile :: Client -> File -> IO ()+saveFile client file = do+    _ <- request client "POST" path+    return ()+  where+    path = BS.concat ["/files/", fileId, "/storage"]+    fileId = BS.pack $ file_id file++parseResponse :: Response LBS.ByteString -> Maybe File+parseResponse res = case parse json body of+    (Done _ r) -> T.parseMaybe parseJSON r :: Maybe File+    _          -> Nothing+  where+    body = responseBody res
+ src/Web/Uploadcare/Client.hs view
@@ -0,0 +1,27 @@+module Web.Uploadcare.Client+(+  Client(..)+, newClient+, closeClient+) where++import Data.ByteString.Char8 (ByteString)+import Network.HTTP.Conduit (Manager, def, newManager, closeManager)++data Client = Client {+    manager :: Manager+  , publicKey :: ByteString+  , secretKey :: ByteString+  }++newClient :: ByteString -> ByteString -> IO Client+newClient connPublicKey connSecretKey = do+    connManager <- newManager def+    return $ Client {+        manager = connManager+      , publicKey = connPublicKey+      , secretKey = connSecretKey+      }++closeClient :: Client -> IO ()+closeClient = closeManager . manager
+ src/Web/Uploadcare/Internal.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Uploadcare.Internal+(+  makeSignature+, apiHeaders+, request+) where++import qualified Crypto.Hash.MD5 as MD5+import qualified Crypto.Hash.SHA1 as SHA1+import Crypto.MAC.HMAC (hmac)+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Char (toLower)+import Data.Hex (hex)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import Network.HTTP.Conduit+import Network.HTTP.Types.Header (RequestHeaders, hAccept, hContentType, hDate)+import Network.HTTP.Types.Method (Method)+import System.Locale (defaultTimeLocale)+import Web.Uploadcare.Client++jsonContentType :: ByteString+jsonContentType = "application/json"++makeSignature :: Client -> Method -> ByteString -> ByteString -> ByteString+              -> ByteString+makeSignature client rMethod rPath rBody timestamp =+    lowerHex . sign $ BS.intercalate "\n" [+        rMethod+      , lowerHex . MD5.hash $ rBody+      , jsonContentType+      , timestamp+      , rPath+      ]+  where+    lowerHex = BS.map toLower . hex+    sign = hmac SHA1.hash 64 $ secretKey client++apiHeaders :: Client -> ByteString -> ByteString -> RequestHeaders+apiHeaders client signature timestamp = [+        ("Authentication", auth)+      , (hAccept, "application/vnd.uploadcare-v0.2+json")+      , (hDate, timestamp)+      , (hContentType, jsonContentType)+      ]+  where+    auth = BS.concat ["UploadCare ", publicKey client, ":", signature]++request :: Client -> Method -> ByteString -> IO (Response LBS.ByteString)+request client rMethod rPath = do+    time <- getCurrentTime+    let timestamp = toTimestamp time+    let signature = makeSignature client rMethod rPath "" timestamp+    let req = def {+        method = rMethod+      , host = "api.uploadcare.com"+      , path = rPath+      , requestHeaders = apiHeaders client signature timestamp+    }+    res <- withManager $ httpLbs req+    return res+  where+    toTimestamp = BS.pack . formatTime defaultTimeLocale httpDateFormat+    httpDateFormat = "%a, %d %b %Y %H:%M:%S GMT"
+ uploadcare.cabal view
@@ -0,0 +1,38 @@+name:                uploadcare+version:             0.1+synopsis:            Haskell client for Uploadcare.+description:         Haskell client for the Uploadcare API.+                     Uploadcare handles file uploads and storage for you,+                     while you focus on other important things.+                     <http://uploadcare.com/>+license:             MIT+license-file:        LICENSE+author:              Dimitry Solovyov <dimituri@gmail.com>+maintainer:          Dimitry Solovyov <dimituri@gmail.com>+category:            Web, API+build-type:          Simple+cabal-version:       >= 1.8++library+  hs-source-dirs:      src+  exposed-modules: Web.Uploadcare+                   Web.Uploadcare.API+                   Web.Uploadcare.Client+                   Web.Uploadcare.Internal++  build-depends: base         >= 4       && < 5+               , aeson        >= 0.6.0.2 && < 0.6.1+               , attoparsec   >= 0.8     && < 0.11+               , bytestring   >= 0.9.2.1 && < 0.9.3+               , cryptohash   >= 0.7.5   && < 0.8+               , hex          >= 0.1.2   && < 0.2+               , http-conduit == 1.6.0.*+               , http-types   >= 0.7.1   && < 0.8+               , old-locale   >= 1.0.0.4 && < 1.0.1+               , time         >= 1.4     && < 1.4.1++  ghc-options: -Wall++source-repository head+  type:     git+  location: git://github.com/uploadcare/uploadcare-haskell.git