haskell-aliyun (empty) → 0.1.0.0
raw patch · 8 files changed
+722/−0 lines, 8 filesdep +Cryptodep +aesondep +basesetup-changed
Dependencies added: Crypto, aeson, base, base64-bytestring, basic-prelude, blaze-builder, bytestring, case-insensitive, conduit, data-default, http-conduit, http-types, lifted-base, monad-control, old-locale, resourcet, safe, system-filepath, text, time, transformers, transformers-base, vector, xml2json
Files
- LICENSE +30/−0
- Network/Aliyun.hs +322/−0
- Network/Aliyun/Types.hs +177/−0
- Network/Aliyun/Utils.hs +50/−0
- README.rst +10/−0
- Setup.hs +2/−0
- haskell-aliyun.cabal +65/−0
- test.hs +66/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, yihuang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of yihuang nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Aliyun.hs view
@@ -0,0 +1,322 @@+{-# LANGUAGE OverloadedStrings+ , GeneralizedNewtypeDeriving+ , MultiParamTypeClasses+ , RecordWildCards+ , TypeFamilies+ , TupleSections+ , FlexibleContexts+ , Rank2Types+ #-}+module Network.Aliyun+ ( Yun(..)+ , YunConf(..)+ , YunEnv+ , BucketQuery(..)+ , runYun+ , runYunWithManager+ , listService+ , putBucket+ , getBucket+ , getBucketContents+ , getBucketContentsLifted+ , getBucketACL+ , deleteBucket+ , putObject+ , putObjectStr+ , putObjectStream+ , putObjectFile+ , getObject+ , getObjectRange+ , getObjectStream+ , getObjectRangeStream+ , copyObject+ , headObject+ , deleteObject+ , deleteObjects+ , module Network.Aliyun.Types+ ) where++import qualified Prelude as P+import BasicPrelude+import qualified Filesystem.Path as Path+import qualified Filesystem.Path.CurrentOS as Path+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text.Encoding as T+import Data.Time.Clock (UTCTime(UTCTime))++import Control.Monad.Trans.Resource (ResourceT)+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Control+import Control.Monad.Base+import qualified Control.Exception.Lifted as Lifted+import qualified Blaze.ByteString.Builder as B++import Data.Maybe (maybeToList)+import Data.Default (Default)+import Data.Time (getCurrentTime, formatTime)+import qualified Data.Conduit as C+import qualified Data.Conduit.Binary as C+import qualified Data.Conduit.List as C+import Data.Aeson (FromJSON)+import Text.XML.ToJSON (parseXML)++import qualified System.IO as IO+import System.Locale (defaultTimeLocale)+import Network.HTTP.Conduit+import qualified Network.HTTP.Types as W++import Network.Aliyun.Types+import Network.Aliyun.Utils++data YunConf = YunConf+ { yunHost :: !ByteString+ , yunId :: !ByteString+ , yunKey :: !ByteString+ }++type YunEnv = (YunConf, Manager)++newtype Yun a = Yun { unYun :: ReaderT YunEnv (ResourceT IO) a }+ deriving (Functor, Applicative, Monad, MonadIO, C.MonadResource, C.MonadThrow, C.MonadUnsafeIO)++instance MonadBase IO Yun where+ liftBase = Yun . liftBase++instance MonadBaseControl IO Yun where+ newtype StM Yun a = YunStM { unYunStM :: StM (ReaderT YunEnv (ResourceT IO)) a }+ liftBaseWith f = Yun . liftBaseWith $ \runInBase -> f $ liftM YunStM . runInBase . unYun+ restoreM = Yun . restoreM . unYunStM++askConf :: Yun YunConf+askConf = fst <$> Yun ask+askManager :: Yun Manager+askManager = snd <$> Yun ask+asksConf :: (YunConf -> a) -> Yun a+asksConf f = f <$> askConf++-- | run yun monad with a new http manager.+runYun :: YunConf -> Yun a -> IO a+runYun conf yun = withManager $ \man -> runReaderT (unYun yun) (conf, man)++-- | run yun monad with provided http manager.+runYunWithManager :: Manager -> YunConf -> Yun a -> ResourceT IO a+runYunWithManager man conf yun = runReaderT (unYun yun) (conf, man)++formatNow :: IO ByteString+formatNow = S.pack . formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" <$> getCurrentTime++data RequestHints = RequestHints+ { hMethod :: !ByteString+ , hPath :: !ByteString+ , hQuery :: !ByteString+ , hHeaders :: !W.RequestHeaders+ , hBody :: !(RequestBody Yun)+ , hNeedMd5 :: !Bool+ }++instance Default RequestHints where+ def = RequestHints "GET" "/" "" [] (RequestBodyLBS empty) False++mkRequest :: RequestHints -> Yun (Request Yun)+mkRequest RequestHints{..} = do+ conf <- askConf+ time <- liftIO formatNow+ let req = def { host = yunHost conf+ , method = hMethod+ , path = hPath+ , queryString = hQuery+ , requestHeaders = ("Date", time) : hHeaders+ , requestBody = hBody+ }+ return $ authorizeRequest req (yunId conf) (yunKey conf) hNeedMd5++streamRequest :: RequestHints -> Yun (Response (C.ResumableSource Yun S.ByteString))+streamRequest hints = do+ req <- mkRequest hints+ askManager >>= http req++lbsRequest :: RequestHints -> Yun (Response LByteString)+lbsRequest hints =+ streamRequest hints >>= lbsResponse++xmlResponse :: (C.MonadThrow m, FromJSON a) => Response LByteString -> m a+xmlResponse = parseXML . responseBody++-- | list all the buckets.+listService :: Yun BucketList+listService =+ xmlResponse =<< lbsRequest def++-- | create or update a bucket.+putBucket :: ByteString -> Maybe ByteString -> Yun LByteString+putBucket name macl = do+ let hds = maybeToList $ ("x-oss-acl",) <$> macl+ responseBody <$>+ lbsRequest def{ hMethod = "PUT"+ , hPath = "/"++name+ , hHeaders = hds+ }++-- | bucket item query conditions.+data BucketQuery = BucketQuery+ { qryPrefix :: !ByteString+ , qryMaxKeys :: !Int+ , qryMarker :: !(Maybe Text)+ , qryDelimiter :: !(Maybe Char)+ }+instance Default BucketQuery where+ def = BucketQuery "" 1000 Nothing Nothing++-- | query bucket items.+getBucket :: ByteString -> BucketQuery -> Yun Bucket+getBucket name qry =+ xmlResponse =<< lbsRequest def{ hPath = "/"++name, hQuery=qs }+ where+ qs = S.concat+ [ "prefix=", qryPrefix qry+ , "&max-keys=", S.pack $ P.show (qryMaxKeys qry)+ , maybe "" (("&marker="++) . T.encodeUtf8) (qryMarker qry)+ , maybe "" (("&delimiter="++) . S.singleton) (qryDelimiter qry)+ ]++-- | Generic version of `getBucketContents'.+getBucketContentsLifted :: Monad m => (forall a. Yun a -> m a) -> ByteString -> ByteString -> C.Source m BucketContent+getBucketContentsLifted liftYun name prefix = loop def{qryDelimiter=Just '/', qryPrefix=prefix}+ where+ withFilePath f = either id id . Path.toText . f . Path.fromText++ loop qry = do+ bucket <- lift $ liftYun $ getBucket name qry+ -- yield directories+ mapM_ ( C.yield+ . flip ContentDirectory (UTCTime (toEnum 60000) 0)+ . withFilePath Path.dirname+ )+ (bucketDirectories bucket)+ -- yield files+ mapM_ ( C.yield+ . ContentFile+ . (\f -> f{fileKey = withFilePath Path.filename (fileKey f)})+ )+ (bucketContents bucket)+ when (bucketIsTruncated bucket) $+ loop qry{qryMarker=bucketNextMarker bucket}++-- | get bucket items streamlined, support more then 1000 items.+getBucketContents :: ByteString -> ByteString -> C.Source Yun BucketContent+getBucketContents = getBucketContentsLifted id++-- | query bucket acl info.+getBucketACL :: ByteString -> Yun BucketACL+getBucketACL name =+ xmlResponse =<< lbsRequest def{ hPath = S.concat ["/", name, "?acl"] }++-- | delete bucket by name+deleteBucket :: ByteString -> Yun LByteString+deleteBucket name =+ responseBody <$>+ lbsRequest def{ hMethod = "DELETE"+ , hPath = "/"++name+ }++-- | upload a file.+putObject :: ByteString -> ByteString -> RequestBody Yun -> Yun LByteString+putObject bucket name body =+ responseBody <$>+ lbsRequest def{ hMethod = "PUT"+ , hPath = S.concat ["/", bucket, "/", name]+ , hBody = body+ }++-- | Upload a file with `LByteString' content.+putObjectStr :: ByteString -> ByteString -> LByteString -> Yun LByteString+putObjectStr bucket name body = putObject bucket name (RequestBodyLBS body)++-- | Upload a file from disk streamlined.+putObjectFile :: ByteString -> ByteString -> IO.FilePath -> Yun LByteString+putObjectFile bucket name path =+ Lifted.bracket+ (liftIO $ IO.openBinaryFile path IO.ReadMode)+ (liftIO . IO.hClose)+ (\h -> do+ size <- fromIntegral <$> liftIO (IO.hFileSize h)+ let src = C.sourceHandle h C.$= C.map B.fromByteString+ putObjectStream bucket name size src+ )++-- | Upload a file from a source streamlined.+-- aliyun don't support chunked tranfer-encoding, so size must be passed.+putObjectStream :: ByteString -> ByteString -> Int64 -> C.Source Yun B.Builder -> Yun LByteString+putObjectStream bucket name size source =+ putObject bucket name (RequestBodySource size source)++-- TODO put object multipart++-- | download a file.+getObject :: ByteString -> ByteString -> Yun LByteString+getObject bucket name = getObjectRange bucket name Nothing++-- | download a file streamlined.+getObjectStream :: ByteString -> ByteString -> Yun (C.ResumableSource Yun S.ByteString)+getObjectStream bucket name = getObjectRangeStream bucket name Nothing++-- | download a range of file.+getObjectRange :: ByteString -> ByteString -> Maybe ByteString -> Yun LByteString+getObjectRange bucket name mrange = do+ let hds = maybeToList $ ("Range",) . ("bytes="++) <$> mrange+ responseBody <$>+ lbsRequest def{ hPath = S.concat ["/", bucket, "/", name]+ , hHeaders = hds+ }++-- | download a range of file streamlined.+getObjectRangeStream :: ByteString -> ByteString -> Maybe ByteString -> Yun (C.ResumableSource Yun S.ByteString)+getObjectRangeStream bucket name mrange = do+ let hds = maybeToList $ ("Range",) . ("bytes="++) <$> mrange+ responseBody <$>+ streamRequest def{ hPath = S.concat ["/", bucket, "/", name]+ , hHeaders = hds+ }++-- | copy an object.+copyObject :: ByteString -> ByteString -> ByteString -> Yun CopyResult+copyObject bucket name source =+ xmlResponse =<<+ lbsRequest def{ hMethod = "PUT"+ , hPath = S.concat ["/", bucket, "/", name]+ , hHeaders = [("x-oss-copy-source", source)]+ }++-- | HEAD request get object.+headObject :: ByteString -> ByteString -> Yun LByteString+headObject bucket name =+ responseBody <$>+ lbsRequest def{ hMethod = "HEAD"+ , hPath = S.concat ["/", bucket, "/", name]+ }++-- | delete object.+deleteObject :: ByteString -> ByteString -> Yun LByteString+deleteObject bucket name =+ responseBody <$>+ lbsRequest def{ hMethod = "DELETE"+ , hPath = S.concat ["/", bucket, "/", name]+ }++-- | batch delete multiple objects.+deleteObjects :: ByteString -> [ByteString] -> Bool -> Yun DeleteResult+deleteObjects bucket names verbose = do+ let body = L.fromChunks $+ [ "<Delete><Quiet>"+ , if verbose then "false" else "true"+ , "</Quiet>"+ ] +++ concat [["<Object><Key>", name, "</Key></Object>"] | name <- names] +++ [ "</Delete>" ]+ xmlResponse =<<+ lbsRequest def{ hMethod = "POST"+ , hPath = S.concat ["/", bucket, "?delete"]+ , hBody = RequestBodyLBS body+ , hNeedMd5 = True+ }
+ Network/Aliyun/Types.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Aliyun.Types+ ( Owner(..)+ , BucketList(..)+ , BucketFile(..)+ , Bucket(..)+ , BucketContent(..)+ , BucketACL(..)+ , DeleteResult(..)+ , CopyResult(..)+ ) where++import qualified Prelude as P+import BasicPrelude+import Safe (readMay)+import Control.Applicative ((<|>))++import qualified Data.Text as T+import qualified Data.Vector as V+import Data.Aeson.Types (typeMismatch, Parser)+import Data.Aeson (FromJSON(parseJSON), Value(..), (.:), (.:?))+import Data.Time.Clock (UTCTime(UTCTime))+import Data.Time.Format (parseTime)+import System.Locale (defaultTimeLocale)++data Owner = Owner+ { ownerId :: !Text+ , ownerName :: !Text+ } deriving (Show)++instance FromJSON Owner where+ parseJSON (Object o) =+ Owner <$> o .: "ID" <*> o .: "DisplayName"+ parseJSON o =+ typeMismatch "Object" o++data BucketList = BucketList+ { bucketOwner :: !Owner+ , bucketList :: ![(Text, UTCTime)]+ } deriving (Show)++instance FromJSON BucketList where+ parseJSON (Object o) = do+ root <- o .: "ListAllMyBucketsResult"+ let getBuckets = root .: "Buckets" >>= (.: "Bucket")+ BucketList <$> (root .: "Owner" >>= parseJSON)+ <*> ( (getBuckets >>= pList pBucket)+ <|> pure []+ )+ where+ pBucket (Object a) =+ (,) <$> a .: "Name"+ <*> (pTime <$> a .: "CreationDate")+ pBucket a = typeMismatch "Object [BucketList.bucketList[i]]" a+ parseJSON a = typeMismatch "BucketList" a++data BucketFile = BucketFile+ { fileKey :: !Text+ , fileLastModified :: !UTCTime+ , fileETag :: !Text+ , fileType :: !Text+ , fileSize :: !Integer -- to support very large file+ , fileStorage :: !Text+ , fileOwner :: !Owner+ } deriving (Show)++instance FromJSON BucketFile where+ parseJSON (Object o) =+ BucketFile <$> o .: "Key"+ <*> (pTime <$> o .: "LastModified")+ <*> o .: "ETag"+ <*> o .: "Type"+ <*> (o .: "Size" >>= strRead (readMay . T.unpack))+ <*> o .: "StorageClass"+ <*> o .: "Owner"+ parseJSON a = typeMismatch "Object" a++data Bucket = Bucket+ { bucketName :: !Text+ , bucketPrefix :: !Text+ , bucketMarker :: !Text+ , bucketMaxKeys :: !Int+ , bucketDelimiter :: !Text+ , bucketIsTruncated :: !Bool+ , bucketNextMarker :: !(Maybe Text)+ , bucketContents :: ![BucketFile]+ , bucketDirectories :: ![Text]+ } deriving (Show)++instance FromJSON Bucket where+ parseJSON (Object o) = do+ r <- o .: "ListBucketResult"+ let getCommonPrefixes = r .: "CommonPrefixes" >>= (.: "Prefix")+ Bucket <$> r .: "Name"+ <*> r .: "Prefix"+ <*> r .: "Marker"+ <*> (r .: "MaxKeys" >>= strRead (readMay . T.unpack))+ <*> r .: "Delimiter"+ <*> (r .: "IsTruncated" >>= strBool)+ <*> r .:? "NextMarker"+ <*> ( (r .: "Contents" >>= pList parseJSON)+ <|> pure []+ )+ <*> ( (getCommonPrefixes >>= pList parseJSON)+ <|> pure []+ )+ parseJSON a = typeMismatch "Object" a++data BucketContent = ContentFile !BucketFile+ | ContentDirectory !Text !UTCTime+ deriving (Show)++data BucketACL = BucketACL+ { bucketACLOwner :: !Owner+ , bucketACLs :: ![Text]+ } deriving (Show)++instance FromJSON BucketACL where+ parseJSON (Object o) = do+ r <- o .: "AccessControlPolicy"+ let getAcls = r .: "AccessControlList" >>= (.: "Grant")+ BucketACL <$> (r .: "Owner" >>= parseJSON)+ <*> ( (getAcls >>= pList parseJSON)+ <|> pure []+ )+ parseJSON a = typeMismatch "Object" a++newtype DeleteResult = DeleteResult [Text]+ deriving (Show)++instance FromJSON DeleteResult where+ parseJSON (Object a) = do+ r <- a .: "DeleteResult"+ DeleteResult <$> ( (r .: "Deleted" >>= pList pKey)+ <|> pure []+ )+ where+ pKey (Object o) = o .: "Key"+ pKey o = typeMismatch "Object" o+ parseJSON o = typeMismatch "Object" o++data CopyResult = CopyResult+ { copyLastModified :: !UTCTime+ , copyETag :: !Text+ } deriving (Show)++instance FromJSON CopyResult where+ parseJSON (Object o) = do+ r <- o .: "CopyObjectResult"+ CopyResult <$> (pTime <$> r .: "LastModified")+ <*> r .: "ETag"+ parseJSON o = typeMismatch "Object" o++-- parser utils++strRead :: (FromJSON a) => (Text -> Maybe a) -> Value -> Parser a+strRead conv o = case o of+ String s ->+ maybe (fail $ "convert failed:"++T.unpack s)+ pure+ (conv s)+ _ -> parseJSON o++strBool :: Value -> Parser Bool+strBool = strRead conv+ where+ conv "true" = Just True+ conv "false" = Just False+ conv _ = Nothing++pList :: (Value -> Parser a) -> Value -> Parser [a]+pList p (Array a) = mapM p (V.toList a)+pList p a = (:[]) <$> p a++pTime :: String -> UTCTime+pTime s = fromMaybe (UTCTime (toEnum 0) 0) $ parseTime defaultTimeLocale "%FT%T.000Z" s+
+ Network/Aliyun/Utils.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Aliyun.Utils where++import qualified Prelude+import BasicPrelude++import qualified Data.ByteString as B+import qualified Data.CaseInsensitive as CI+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Lazy as L+import Data.HMAC (hmac_sha1)+import qualified Data.Digest.MD5 as MD5++import qualified Network.HTTP.Types as W+import Network.HTTP.Conduit++canonicalizeHeaders :: W.RequestHeaders -> ByteString+canonicalizeHeaders hds =+ let hds' = [hd | hd <- hds, "x-oss-" `S.isPrefixOf` CI.foldedCase (fst hd)]++ -- merge grouped headers.+ merge :: [W.Header] -> W.Header+ merge [] = error "impossible [canonicalizeHeaders]"+ merge xs@((name, _):_) = (name, S.concat . intersperse "," $ map snd xs)++ hds'' = map merge . group . sortBy (comparing fst) $ hds'+ in S.concat [S.concat [CI.foldedCase k, ":", v, "\n"] | (k,v) <- hds'']++bodyContent :: RequestBody m -> LByteString+bodyContent (RequestBodyLBS s) = s+bodyContent _ = error "unimplemented [bodyContent]"++authorizeRequest :: Request m -> ByteString -> ByteString -> Bool -> Request m+authorizeRequest req identity key needMD5 =+ let date = fromMaybe "" $ lookup "Date" hds+ ctype = fromMaybe "" $ lookup "Content-Type" hds+ bodyMD5 = B64.encode . B.pack . MD5.hash . L.unpack . bodyContent . requestBody $ req+ hds' = requestHeaders req+ hds = if needMD5 then ("Content-MD5", bodyMD5) : hds' else hds'+ s = S.concat [ method req, "\n"+ , if needMD5 then bodyMD5 else "", "\n"+ , ctype, "\n"+ , date, "\n", canonicalizeHeaders hds+ , path req+ ]+ auth = S.concat [ "OSS ", identity, ":"+ , B64.encode $ B.pack (hmac_sha1 (B.unpack key) (B.unpack s))+ ]+ in req { requestHeaders = ("Authorization", auth) : hds }
+ README.rst view
@@ -0,0 +1,10 @@+Streamlined aliyun OSS api in Haskell.++Features+========++* Support persistent http connection.++* Support streamlined file uploading and downloading, using constant memory.++* Support streamlined listing of bucket contents with more then 1000 items.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ haskell-aliyun.cabal view
@@ -0,0 +1,65 @@+-- Initial haskell-aliyun.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: haskell-aliyun++-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++-- A short (one-line) description of the package.+synopsis: haskell client of aliyun service.++-- A longer description of the package.+description: See git page (https://github.com/yihuang/haskell-aliyun/)++-- URL for the project homepage or repository.+homepage: https://github.com/yihuang/haskell-aliyun/++-- The license under which the package is released.+license: BSD3++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: yihuang++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: yi.codeplayer@gmail.com++-- A copyright notice.+-- copyright: ++category: Network++build-type: Simple++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.8++Extra-Source-Files: README.rst+ , test.hs++source-repository head+ type: git+ location: git://github.com/yihuang/haskell-aliyun++library+ ghc-options: -Wall -O2+ -- Modules exported by the library.+ exposed-modules: Network.Aliyun+ , Network.Aliyun.Types+ , Network.Aliyun.Utils+ + -- Modules included in this library but not exported.+ -- other-modules: ++ -- Other library packages from which modules are imported.+ build-depends: base ==4.*, bytestring >=0.9, conduit >=0.5, http-conduit >=1.5, http-types >=0.7, transformers >=0.2, monad-control >=0.3, transformers-base >=0.4, time >=1.4, old-locale >=1.0, Crypto >=4.2, data-default >=0.5, resourcet >=0.3, basic-prelude >=0.2, base64-bytestring >=0.1, case-insensitive >=0.4, blaze-builder >= 0.3, lifted-base >= 0.1, xml2json >= 0.2, aeson >= 0.6, vector >= 0.9, text >= 0.11, safe >= 0.3, system-filepath >= 0.4
+ test.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}+import qualified Prelude+import BasicPrelude+import Network.Aliyun+import Data.Default (def)+import qualified Data.Text.Encoding as T+import Data.ByteString.Lazy.Char8 ()+import qualified Data.Conduit as C+import qualified Data.Conduit.List as C++{-+ - Before run test.hs, create a file named "config" in current directory,+ - which contains two lines, the first line is identity, second line is secret key.+ -}++loadConf :: FilePath -> IO YunConf+loadConf path = do+ (ident : key : _) <- lines <$> readFile path+ return $ YunConf "storage.aliyun.com" (T.encodeUtf8 ident) (T.encodeUtf8 key)++p :: (MonadIO m, Show a) => m a -> m ()+p m = m >>= liftIO . putStrLn . show++main :: IO ()+main = do+ conf <- loadConf "./config"+ runYun conf $ do+ --liftIO $ putStrLn "put stream object test4"+ --p $ putObjectStream "yihuang_bucket" "test4" (C.sourceList ["hello", "world"] C.$= C.map B.fromByteString)++ liftIO $ putStrLn "list service"+ p listService+ liftIO $ putStrLn "put bucket"+ p $ putBucket "yihuang_bucket" Nothing+ liftIO $ putStrLn "list service"+ p listService+ liftIO $ putStrLn "get bucket"+ p $ getBucket "yihuang_bucket" def+ liftIO $ putStrLn "get bucket acl"+ p $ getBucketACL "yihuang_bucket"+ liftIO $ putStrLn "put bucket acl"+ p $ putBucket "yihuang_bucket" (Just "public-read-write")+ liftIO $ putStrLn "get bucket acl"+ p $ getBucketACL "yihuang_bucket"+ liftIO $ putStrLn "put string object test1"+ p $ putObjectStr "yihuang_bucket" "test1" "hello world"+ liftIO $ putStrLn "put file object test2"+ p $ putObjectFile "yihuang_bucket" "test2" "./data"+ liftIO $ putStrLn "get bucket"+ p $ getBucket "yihuang_bucket" def+ p $ getBucket "yihuang_bucket" def{qryMaxKeys=1}+ p $ getBucketContents "yihuang_bucket" def{qryMaxKeys=1} C.$$ C.consume+ liftIO $ putStrLn "get object test1"+ p $ getObject "yihuang_bucket" "test1"+ liftIO $ putStrLn "get object test2"+ p $ getObject "yihuang_bucket" "test2"+ liftIO $ putStrLn "get object range test2"+ p $ getObjectRange "yihuang_bucket" "test2" (Just "6-11")+ liftIO $ putStrLn "copy object test3"+ p $ copyObject "yihuang_bucket" "test3" "/yihuang_bucket/test2"+ liftIO $ putStrLn "head object test3"+ p $ headObject "yihuang_bucket" "test3"+ liftIO $ putStrLn "delete object test3"+ p $ deleteObject "yihuang_bucket" "test3"+ liftIO $ putStrLn "delete multiple objects test1 test2"+ p $ deleteObjects "yihuang_bucket" ["test1", "test2"] True