diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,4 @@
+#!/usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
diff --git a/src/Web/Uploadcare.hs b/src/Web/Uploadcare.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Uploadcare.hs
@@ -0,0 +1,13 @@
+module Web.Uploadcare
+(
+ Client(..)
+, newClient
+, closeClient
+, File(..)
+, getFile
+, deleteFile
+, saveFile
+) where
+
+import Web.Uploadcare.API
+import Web.Uploadcare.Client
diff --git a/src/Web/Uploadcare/API.hs b/src/Web/Uploadcare/API.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Uploadcare/API.hs
@@ -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
diff --git a/src/Web/Uploadcare/Client.hs b/src/Web/Uploadcare/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Uploadcare/Client.hs
@@ -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
diff --git a/src/Web/Uploadcare/Internal.hs b/src/Web/Uploadcare/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Uploadcare/Internal.hs
@@ -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"
diff --git a/uploadcare.cabal b/uploadcare.cabal
new file mode 100644
--- /dev/null
+++ b/uploadcare.cabal
@@ -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.
+
+license: MIT
+license-file: LICENSE
+author: Dimitry Solovyov
+maintainer: Dimitry Solovyov
+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