yesod-s3 0.1.0.0 → 0.1.1
raw patch · 2 files changed
+59/−7 lines, 2 filesdep +conduit-extradep +gddep +mtldep ~conduit
Dependencies added: conduit-extra, gd, mtl, resourcet
Dependency ranges changed: conduit
Files
- Yesod/S3.hs +52/−4
- yesod-s3.cabal +7/−3
Yesod/S3.hs view
@@ -1,4 +1,7 @@-module Yesod.S3 where+module Yesod.S3 (+ uploadImage,+ uploadFile,+ getLink) where import Data.ByteString.Lazy import Yesod.Core.Types@@ -9,19 +12,64 @@ import Network.AWS.AWSResult import Network.AWS.S3Object import qualified Data.Text as T+import Graphics.GD.ByteString.Lazy+import Data.Ratio+import Control.Monad.Error+import Control.Monad.Trans.Resource extractFile :: FileInfo -> IO ByteString extractFile f = runResourceT $ fileSourceRaw f $$ sinkLbs +data UploadError+ = InvalidContentType+ | ReqError ReqError+ | StringError String++instance Error UploadError where+ strMsg = StringError++uploadImage :: AWSConnection+ -> FileInfo+ -> String -- ^ The Bucket Name+ -> String -- ^ The Base Name+ -> [((Int,Int), Int, String)] -- ^ Styles for resizing, the ints are upper borders+ -> ErrorT UploadError IO [(String, String)] -- ^ Style and Object name+uploadImage conn fi bucket name styles = do+ bs <- liftIO $ extractFile fi+ let ft = T.unpack $ fileContentType fi+ img <- case ft of+ "image/png" -> liftIO $ loadPngByteString bs+ "image/jpg" -> liftIO $ loadJpegByteString bs+ "image/gif" -> liftIO $ loadGifByteString bs+ _ -> throwError InvalidContentType+ (x,y) <- liftIO $ imageSize img+ flip mapM styles $ \((x',y'),qual,style) -> do+ let xscale = x' % x+ yscale = y' % y+ (x'',y'') = if xscale<yscale+ then (x', floor $ fromIntegral y * xscale)+ else (floor $ fromIntegral x * yscale, y')+ img' <- liftIO $ resizeImage x'' y'' img+ bs' <- liftIO $ saveJpegByteString qual img'+ let name' = name ++ "-" ++ style+ obj = S3Object bucket name' "image/jpg" [] bs'+ res <- liftIO $ sendObjectMIC conn obj+ case res of+ Right () -> return (style, name')+ Left err -> throwError $ ReqError err+ uploadFile :: AWSConnection -> FileInfo -> String -- ^ The Bucket Name -> String -- ^ The Object Name- -> IO (AWSResult ())+ -> ErrorT UploadError IO () uploadFile conn fi bucket name = do- bs <- extractFile fi+ bs <- liftIO $ extractFile fi let obj = S3Object bucket name (T.unpack $ fileContentType fi) [] bs- sendObjectMIC conn obj+ res <- liftIO $ sendObjectMIC conn obj+ case res of+ Right () -> return ()+ Left err -> throwError $ ReqError err getLink :: AWSConnection -> String -- ^ The Bucket Name
yesod-s3.cabal view
@@ -1,5 +1,5 @@ name: yesod-s3-version: 0.1.0.0+version: 0.1.1 synopsis: Simple Helper Library for using Amazon's Simple Storage Service (S3) with Yesod -- description: homepage: https://github.com/tvh/yesod-s3@@ -23,5 +23,9 @@ yesod-core, bytestring, text,- conduit >= 1.0.5,- network+ conduit >= 1.1,+ network,+ gd,+ mtl,+ conduit-extra >= 1.1,+ resourcet