azurify (empty) → 0.1.0.0
raw patch · 8 files changed
+627/−0 lines, 8 filesdep +SHAdep +basedep +base64-bytestringsetup-changed
Dependencies added: SHA, base, base64-bytestring, bytestring, case-insensitive, cmdargs, conduit, directory, http-conduit, http-date, http-types, hxt, network, old-locale, time, transformers, utf8-string
Files
- Azure.hs +264/−0
- Azure/BlobDataTypes.hs +33/−0
- Azure/BlobListParser.hs +40/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- azurify.cabal +57/−0
- azurify.hs +158/−0
- readme.md +43/−0
+ Azure.hs view
@@ -0,0 +1,264 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+ Azurify is an incomplete yet sort-of-functional library and command line client to access the Azure Blob Storage API++ The following features are implemented:++ * Creating and deleting containers++ * Listing the contents of a container++ * Downloading blobs++ * Uploading a new block blob if it's no larger than 64MB++ * Deleting a blob++ * Breaking a blob lease+-}+module Azure ( createContainer+ , deleteContainer+ , listContainer+ , changeContainerACL+ , createBlob+ , deleteBlob+ , getBlob+ , breakLease+ , module Azure.BlobDataTypes) where++import Azure.BlobDataTypes+import Azure.BlobListParser++import Network.HTTP.Conduit+import Network.HTTP.Date+import Network.HTTP.Types.Header+import Network.HTTP.Types.Status+import System.Locale+import Data.List+import Data.Time+import Data.Time.Clock.POSIX+import Data.Char (isSpace)+import Data.CaseInsensitive (foldedCase)+import Data.Maybe (fromJust, isJust)+import Network (withSocketsDo)++import Data.Conduit++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.ByteString.Lazy.UTF8 as LUTF8++import Control.Arrow (second)+import Control.Monad.IO.Class (liftIO)++import Data.Digest.Pure.SHA (hmacSha256, bytestringDigest)+import qualified Data.ByteString.Base64 as B64++(+++) = B.append++maybeResponseError rsp = let status = (responseStatus rsp) in+ if statusCode status >= 300 || statusCode status < 200+ then Just (statusCode status, responseBody rsp)+ else Nothing++-- |Create a new container+createContainer :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ Authorisation key+ -> B.ByteString -- ^ Container name+ -> AccessControl -- ^ Access control of the container+ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when creating was successful, otherwise HTTP status and content+createContainer account authKey containerName accessControl = do+ let resource = "/" +++ containerName+ rsp <- doRequest account authKey resource [("restype", "container")] "PUT" "" hdrs+ return $ maybeResponseError rsp+ where hdrs = case accessControl of+ ContainerPublic -> [("x-ms-blob-public-access", "container")]+ BlobPublic -> [("x-ms-blob-public-access", "blob")]+ Private -> []++-- |Delete a container+deleteContainer :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ Authorisation key+ -> B.ByteString -- ^ Container name+ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when creating was successful, otherwise HTTP status and content+deleteContainer account authKey containerName = do+ let resource = "/" +++ containerName+ rsp <- doRequest account authKey resource [("restype", "container")] "DELETE" "" []+ return $ maybeResponseError rsp++-- |List all blobs in a given container+listContainer :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ Authorisation key+ -> B.ByteString -- ^ Container name+ -> IO (Either (Int, L.ByteString) [Blob]) -- ^ Either the HTTP error code and content OR a list of Blobs+listContainer account authKey containerName = do+ let resource = "/" +++ containerName+ rsp <- doRequest account authKey resource [("restype", "container"), ("comp", "list")] "GET" "" []+ case maybeResponseError rsp of+ Just err -> return $ Left err+ Nothing -> do+ blobs <- parse $ L8.unpack $ responseBody rsp+ return $ Right blobs++-- |Set the access control on a container+changeContainerACL :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ The authorisation key+ -> B.ByteString -- ^ Container name+ -> AccessControl -- ^ Access control specifier+ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when successful, HTTP error code and content otherwise+changeContainerACL account authKey containerName accessControl = do+ let resource = "/" +++ containerName+ rsp <- doRequest account authKey resource [("restype", "container"), ("comp", "acl")] "PUT" "" hdrs+ return $ maybeResponseError rsp+ where hdrs = case accessControl of+ ContainerPublic -> [("x-ms-blob-public-access", "container")]+ BlobPublic -> [("x-ms-blob-public-access", "blob")]+ Private -> []++-- |Upload a new blob to a container+createBlob :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ The authorisation key+ -> B.ByteString -- ^ Container name+ -> BlobSettings -- ^ The blob itself, note that Page blobs are *not supported*+ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when successful, HTTP error code and content otherwise+createBlob account authKey containerName blobSettings =+ case blobSettingsType blobSettings of+ BlockBlob -> createBlockBlob account authKey containerName blobSettings+ PageBlob -> error "Page blob not implemented yet"++createBlockBlob :: B.ByteString -> B.ByteString -> B.ByteString -> BlobSettings -> IO (Maybe (Int, L.ByteString))+createBlockBlob account authKey containerName blobSettings = do+ let resource = "/" +++ containerName +++ "/" +++ blobSettingsName blobSettings+ rsp <- doRequest account authKey resource [] "PUT" (fromJust $ blobSettingsContents blobSettings) hdrs+ return $ maybeResponseError rsp+ where hdrs = map (second fromJust) $ filter (\(_,a) -> isJust a)+ [ ("Content-Type", blobSettingsContentType blobSettings)+ , ("Content-Encoding", blobSettingsContentEncoding blobSettings)+ , ("Content-Language", blobSettingsContentLanguage blobSettings)+ , ("Content-MD5", blobSettingsContentMD5 blobSettings)+ , ("Cache-Control", blobSettingsCacheControl blobSettings)+ , ("x-ms-blob-type", Just "BlockBlob") ]++createPageBlob :: B.ByteString -> B.ByteString -> B.ByteString -> BlobSettings -> IO (Maybe (Int, L.ByteString))+createPageBlob account authKey containerName blobSettings = do+ let resource = "/" +++ containerName +++ "/" +++ blobSettingsName blobSettings+ rsp <- doRequest account authKey resource [] "PUT" "" hdrs+ return $ maybeResponseError rsp+ where hdrs = map (second fromJust) $ filter (\(_,a) -> isJust a)+ [ ("Content-Type", blobSettingsContentType blobSettings)+ , ("Content-Encoding", blobSettingsContentEncoding blobSettings)+ , ("Content-Language", blobSettingsContentLanguage blobSettings)+ , ("Content-MD5", blobSettingsContentMD5 blobSettings)+ , ("Cache-Control", blobSettingsCacheControl blobSettings)+ , ("x-ms-blob-type", Just "PageBlob")+ , ("x-ms-blob-content-length", Just $ B8.pack $ show $ B.length $ fromJust $ blobSettingsContents blobSettings)+ ]++-- |Delete a blob from a container+deleteBlob :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ The authorsation key+ -> B.ByteString -- ^ The container name+ -> B.ByteString -- ^ The blob name+ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when successful, HTTP error code and content otherwise+deleteBlob account authKey containerName blobName = do+ let resource = "/" +++ containerName +++ "/" +++ blobName+ rsp <- doRequest account authKey resource [] "DELETE" "" [] -- TODO: Add support for snapshots+ return $ maybeResponseError rsp++-- |Download a blob+getBlob :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ The authorisation key+ -> B.ByteString -- ^ The container name+ -> B.ByteString -- ^ The blob name+ -> IO (Either (Int, L.ByteString) L.ByteString) -- ^ Nothing when successful, HTTP error code and content otherwise+getBlob account authKey containerName blobName = do+ let resource = "/" +++ containerName +++ "/" +++ blobName+ rsp <- doRequest account authKey resource [] "GET" "" []+ return $ case maybeResponseError rsp of+ Just err -> Left err+ Nothing -> Right $ responseBody rsp++-- |Break a lease of a blob+breakLease :: B.ByteString -- ^ The account name+ -> B.ByteString -- ^ The authorisation key+ -> B.ByteString -- ^ The container name+ -> B.ByteString -- ^ The blob name+ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when successful, HTTP error code and content otherwise+breakLease account authKey containerName blobName = do+ let resource = "/" +++ containerName +++ "/" +++ blobName+ rsp <- doRequest account authKey resource [("comp", "lease")] "PUT" "" [("x-ms-lease-action", "break")]+ return $ maybeResponseError rsp++doRequest :: B.ByteString -> B.ByteString -> B.ByteString -> [(B.ByteString, B.ByteString)] -> B.ByteString -> B.ByteString -> [Header] -> IO (Response L.ByteString)+doRequest account authKey resource params reqType reqBody extraHeaders = do+ now <- liftIO httpTime+ withSocketsDo $ withManager $ \manager -> do+ initReq <- parseUrl $ B8.unpack ("http://" +++ account +++ ".blob.core.windows.net" +++ resource +++ encodeParams params)+ let headers = ("x-ms-version", "2011-08-18")+ : ("x-ms-date", now)+ : extraHeaders ++ requestHeaders initReq+ let signData = defaultSignData { verb = reqType+ , contentLength = if reqType `elem` ["PUT", "DELETE"] || not (B.null reqBody) then B8.pack $ show $ B.length reqBody else ""+ , canonicalizedHeaders = canonicalizeHeaders headers+ , canonicalizedResource = canonicalizeResource account resource params }+ let signature = sign authKey signData+ let authHeader = ("Authorization", "SharedKey " +++ account +++ ":" +++ signature)+ let request = initReq { method = reqType+ , requestHeaders = authHeader : headers+ , checkStatus = \_ _ _ -> Nothing -- don't throw an exception when a non-2xx error code is received+ , requestBody = RequestBodyBS reqBody }+ httpLbs request manager++encodeParams :: [(B.ByteString, B.ByteString)] -> B.ByteString+encodeParams [] = ""+encodeParams ((k,v):ps) = "?" +++ k +++ "=" +++ v +++ encodeRest ps+ where encodeRest = B.concat . map (\(k,v) -> "&" +++ k +++ "=" +++ v)++canonicalizeHeaders :: [Header] -> B.ByteString+canonicalizeHeaders headers = B.intercalate "\n" unfoldHeaders+ where headerStrs = map (\(a, b) -> strip $ foldedCase a +++ ":" +++ strip b) headers+ xmsHeaders = filter (\hdr -> "x-ms" `B.isPrefixOf` hdr) headerStrs+ sortedHeaders = sort xmsHeaders+ unfoldHeaders = map (B8.pack . unwords . words . B8.unpack) sortedHeaders++canonicalizeResource :: B.ByteString -> B.ByteString -> [(B.ByteString, B.ByteString)] -> B.ByteString+canonicalizeResource accountName uriPath params = "/" +++ accountName +++ uriPath +++ "\n" +++ canonParams+ where canonParams = strip $ B.intercalate "\n" $ map (\(k,v) -> k +++ ":" +++ v) $ sortBy (\(k1,v1) (k2,v2) -> compare k1 k2) params++strip :: B.ByteString -> B.ByteString+strip = f . f+ where f = B8.pack . reverse . dropWhile isSpace . B8.unpack++data SignData = SignData { verb :: B.ByteString+ , contentEncoding :: B.ByteString+ , contentLanguage :: B.ByteString+ , contentLength :: B.ByteString+ , contentMD5 :: B.ByteString+ , contentType :: B.ByteString+ , date :: B.ByteString+ , ifModifiedSince :: B.ByteString+ , ifMatch :: B.ByteString+ , ifNoneMatch :: B.ByteString+ , ifUnmodifiedSince :: B.ByteString+ , range :: B.ByteString+ , canonicalizedHeaders :: B.ByteString+ , canonicalizedResource :: B.ByteString+ }++defaultSignData = SignData undefined "" "" "" "" "" "" "" "" "" "" "" undefined undefined++stringToSign :: SignData -> B.ByteString+stringToSign (SignData verb ce clan clen cmd5 ct date ifMod ifMatch ifNMatch ifUnmod range canonHeaders canonResource) =+ strip $ B.intercalate "\n" [verb, ce, clan, clen, cmd5, ct, date, ifMod, ifMatch, ifNMatch, ifUnmod, range, canonHeaders, canonResource]++httpTime :: IO B.ByteString+httpTime = fmap (B8.pack . formatTime defaultTimeLocale "%a, %d %b %Y %X GMT") getCurrentTime++sign :: B.ByteString -> SignData -> B.ByteString+sign key = B64.encode . toStrict . bytestringDigest . hmacSha256 (toLazy $ B64.decodeLenient key) . LUTF8.fromString . B8.unpack . stringToSign++toLazy a = L.fromChunks [a]+toStrict = B.concat . L.toChunks
+ Azure/BlobDataTypes.hs view
@@ -0,0 +1,33 @@+module Azure.BlobDataTypes where++import qualified Data.ByteString as B++data AccessControl = ContainerPublic -- ^ the container can be enumerated and all blobs can be read by anonymous users+ | BlobPublic -- ^ blobs can be read by anonymous users, but the container cannot be enumerated+ | Private -- ^ blobs can't be read by anonymous users and the container cannot be enumerated++data BlobType = PageBlob | BlockBlob deriving (Show)++data BlobSettings = BlobSettings { blobSettingsName :: B.ByteString+ , blobSettingsContentType :: Maybe B.ByteString+ , blobSettingsContentEncoding :: Maybe B.ByteString+ , blobSettingsContentLanguage :: Maybe B.ByteString+ , blobSettingsContentMD5 :: Maybe B.ByteString+ , blobSettingsCacheControl :: Maybe B.ByteString+ , blobSettingsType :: BlobType+ , blobSettingsContentLength :: Maybe Integer -- ^ only for page blobs, set to Nothing for block blob+ , blobSettingsContents :: Maybe B.ByteString -- ^ only for block blobs, set to Empty for page blob+ }++data Blob = Blob { blobName :: B.ByteString+ , blobUrl :: B.ByteString+ , blobLastModified :: B.ByteString+ , blobETag :: B.ByteString+ , blobContentLength :: Integer+ , blobContentType :: B.ByteString+ , blobContentEncoding :: B.ByteString+ , blobContentLanguage :: B.ByteString+ , blobContentMD5 :: B.ByteString+ , blobCacheControl :: B.ByteString+ , blobType :: BlobType+ } deriving (Show)
+ Azure/BlobListParser.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE Arrows, OverloadedStrings #-}++module Azure.BlobListParser where++import Azure.BlobDataTypes++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Text.XML.HXT.Core hiding (Blob)++parse xml = runX (readString [] xml >>> getBlobs >>> xmlBlob)++getBlobs :: (ArrowXml a) => a XmlTree XmlTree+getBlobs = deep (hasName "Blob")++xmlBlob :: (ArrowXml a) => a XmlTree Blob+xmlBlob = proc tag -> do+ name <- (getText <<< getChildren <<< deep (hasName "Name")) -< tag+ url <- (getText <<< getChildren <<< deep (hasName "Url")) -< tag+ lastMod <- (getText <<< getChildren <<< deep (hasName "Last-Modified")) -< tag+ etag <- (getText <<< getChildren <<< deep (hasName "Etag")) `orElse` (constA "") -< tag+ contentLen <- (getText <<< getChildren <<< deep (hasName "Content-Length")) -< tag+ contentType <- (getText <<< getChildren <<< deep (hasName "Content-Type")) `orElse` (constA "") -< tag+ contentEnc <- (getText <<< getChildren <<< deep (hasName "Content-Encoding")) `orElse` (constA "") -< tag+ contentLang <- (getText <<< getChildren <<< deep (hasName "Content-Language")) `orElse` (constA "") -< tag+ contentMD5 <- (getText <<< getChildren <<< deep (hasName "Content-MD5")) `orElse` (constA "") -< tag+ cacheControl <- (getText <<< getChildren <<< deep (hasName "Cache-Control")) `orElse` (constA "") -< tag+ blobType <- (getText <<< getChildren <<< deep (hasName "BlobType")) -< tag+ returnA -< Blob { blobName = B8.pack name+ , blobUrl = B8.pack url+ , blobLastModified = B8.pack lastMod+ , blobETag = B8.pack etag+ , blobContentLength = read contentLen+ , blobContentType = B8.pack contentType+ , blobContentEncoding = B8.pack contentEnc+ , blobContentLanguage = B8.pack contentLang+ , blobContentMD5 = B8.pack contentMD5+ , blobCacheControl = B8.pack cacheControl+ , blobType = if blobType == "PageBlob" then PageBlob else BlockBlob+ }
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Arno van Lumig++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 Arno van Lumig 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ azurify.cabal view
@@ -0,0 +1,57 @@+name: azurify+version: 0.1.0.0+synopsis: A simple library for accessing Azure blob storage+description: An interface for a few basic functions of the Microsoft Azure blob storage. Creating and deleting containers as well as uploading, downloading and breaking leases of blobs is supported.+homepage: http://arnovanlumig.com/azurify.html+license: BSD3+license-file: LICENSE+author: Arno van Lumig+maintainer: arno@vanlumig.com+category: Development+build-type: Simple+cabal-version: >=1.8++extra-source-files: Azure/BlobDataTypes.hs, Azure/BlobListParser.hs, readme.md++Library+ Exposed-Modules: Azure+ build-depends:+ base >= 4.5,+ bytestring >= 0.9.2.1,+ http-conduit >= 1.5.0.3,+ http-types >= 0.7.0,+ transformers >= 0.3.0.0,+ conduit >= 0.5.2.2,+ network >= 2.3.0.13,+ http-date >= 0.0.2,+ time >= 1.4,+ old-locale >= 1.0.0.4,+ SHA >= 1.5.1,+ base64-bytestring >= 0.1.2.0,+ case-insensitive >= 0.4.0.1,+ utf8-string >= 0.3.7,+ hxt >= 9.2.2,+ cmdargs >= 0.10,+ directory >= 1.1.0.2++executable azurify+ main-is: azurify.hs+ hs-source-dirs: . Azure/+ build-depends:+ base >= 4.5 && < 5,+ bytestring >= 0.9.2.1,+ http-conduit >= 1.5.0.3,+ http-types >= 0.7.0,+ transformers >= 0.3.0.0,+ conduit >= 0.5.2.2,+ network >= 2.3.0.13,+ http-date >= 0.0.2,+ time >= 1.4,+ old-locale >= 1.0.0.4,+ SHA >= 1.5.1,+ base64-bytestring >= 0.1.2.0,+ case-insensitive >= 0.4.0.1,+ utf8-string >= 0.3.7,+ hxt >= 9.2.2,+ cmdargs >= 0.10,+ directory >= 1.1.0.2
+ azurify.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}++module Main where++import qualified Azure as Az+import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as L+import System.Console.CmdArgs+import System.Directory(getCurrentDirectory)++data Commands = UploadBlob { uploadBlobPath :: String+ , uploadBlobStorageName :: String+ , uploadBlobContainerName :: String+ , uploadBlobFileName :: String+ , uploadBlobContentType :: Maybe String+ , uploadBlobContentEncoding :: Maybe String+ , uploadBlobContentLanguage :: Maybe String+ , uploadBlobContentCache :: Maybe String+ }+ | DeleteBlob { deleteBlobStorageName :: String+ , deleteBlobContainerName :: String+ , deleteBlobBlobName :: String+ }+ | DownloadBlob { downloadBlobStorageName :: String+ , downloadBlobContainerName :: String+ , downloadBlobBlobName :: String+ }+ | CreateContainer { createContainerStorageName :: String+ , createContainerContainerName :: String+ , createContainerACL :: Maybe String+ }+ | DeleteContainer { deleteContainerStorageName :: String+ , deleteContainerContainerName :: String+ , deleteContainerForce :: Maybe Bool+ }+ | ListContainer { listContainerStorageName :: String+ , listContainerContainerName :: String+ }+ | BreakBlobLease { breakLeaseStorageName :: String+ , breakLeaseContainerName :: String+ , breakLeaseBlobName :: String+ }+ deriving (Show, Data, Typeable, Eq)++uploadBlob = UploadBlob { uploadBlobPath = def &= typ "file" &= argPos 0+ , uploadBlobStorageName = def &= typ "accountname" &= argPos 1+ , uploadBlobContainerName = def &= typ "containername" &= argPos 2+ , uploadBlobFileName = def &= typ "blobname" &= argPos 3+ , uploadBlobContentType = def &= name "contenttype"+ , uploadBlobContentEncoding = def &= name "contentencoding"+ , uploadBlobContentLanguage = def &= name "contentlanguage"+ , uploadBlobContentCache = def &= name "cachecontrol"+ } &= help "Upload a blob"++downloadBlob = DownloadBlob { downloadBlobStorageName = def &= typ "accountname" &= argPos 0+ , downloadBlobContainerName = def &= typ "containername" &= argPos 1+ , downloadBlobBlobName = def &= typ "blobname" &= argPos 2+ } &= help "Download a blob"++deleteBlob = DeleteBlob { deleteBlobStorageName = def &= typ "accountname" &= argPos 0+ , deleteBlobContainerName = def &= typ "containername" &= argPos 1+ , deleteBlobBlobName = def &= typ "blobname" &= argPos 2+ } &= help "Delete a blob"++breakBlobLease = BreakBlobLease { breakLeaseStorageName = def &= typ "accountname" &= argPos 0+ , breakLeaseContainerName = def &= typ "containername" &= argPos 1+ , breakLeaseBlobName = def &= typ "blobname" &= argPos 2+ }++listContainer = ListContainer { listContainerStorageName = def &= typ "accountname" &= argPos 0+ , listContainerContainerName = def &= typ "containername" &= argPos 1+ } &= help "List all blobs in a container"++createContainer = CreateContainer { createContainerStorageName = def &= typ "accountname" &= argPos 0+ , createContainerContainerName = def &= typ "containername" &= argPos 1+ , createContainerACL = def &= typ "blobpublic|containerpublic|private" &= argPos 2+ } &= help "Create a container with the specified access control"++deleteContainer = DeleteContainer { deleteContainerStorageName = def &= typ "accountname" &= argPos 0+ , deleteContainerContainerName = def &= typ "containername" &= argPos 1+ , deleteContainerForce = def &= name "force"+ } &= help "Delete the container and all the blobs inside it"++mode = cmdArgsMode $ modes [uploadBlob, downloadBlob, deleteBlob, breakBlobLease, listContainer, createContainer, deleteContainer] &= help "Access the Azure blob storage" &= program "azurify" &= summary "Azurify v1.0"++main :: IO ()+main = do+ m <- cmdArgsRun mode+ putStrLn "Please enter your authkey:"+ azureKey <- B.getLine+ case m of+ UploadBlob path account container name contType contEnc contLang contCache -> do+ contents <- B.readFile path+ res <- Az.createBlob (B8.pack account)+ azureKey (B8.pack container)+ (Az.BlobSettings (B8.pack name)+ (B8.pack `fmap` contType)+ (B8.pack `fmap` contEnc)+ (B8.pack `fmap` contLang)+ Nothing+ (B8.pack `fmap` contCache)+ Az.BlockBlob+ Nothing+ (Just contents)+ )+ case res of+ Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ Nothing -> return ()+ DownloadBlob account container blobname -> do -- TODO: progress indicator+ pwd <- getCurrentDirectory+ res <- Az.getBlob (B8.pack account) azureKey (B8.pack container) (B8.pack blobname)+ let path = pwd ++ "/" ++ blobname+ putStrLn path+ case res of+ Left (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ Right content -> L.writeFile path content+ DeleteBlob account container blobname -> do+ res <- Az.deleteBlob (B8.pack account) azureKey (B8.pack container) (B8.pack blobname)+ case res of+ Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ _ -> return ()+ BreakBlobLease account container blobname -> do+ res <- Az.breakLease (B8.pack account) azureKey (B8.pack container) (B8.pack blobname)+ case res of+ Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ _ -> return ()+ ListContainer account container -> do -- TODO: output formatting+ res <- Az.listContainer (B8.pack account) azureKey (B8.pack container)+ case res of+ Left (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ Right blobs -> mapM_ print blobs+ CreateContainer account container access -> do+ let acl = case access of {+ Just "blobpublic" -> Az.BlobPublic;+ Just "containerpublic" -> Az.ContainerPublic;+ Just "private" -> Az.Private;+ Nothing -> Az.Private;+ _ -> error "invalid access control specified";+ }+ res <- Az.createContainer (B8.pack account) azureKey (B8.pack container) acl+ case res of+ Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ Nothing -> return ()+ DeleteContainer account container force -> do+ if force == (Just True) then do+ res <- Az.listContainer (B8.pack account) azureKey (B8.pack container)+ case res of+ Left (stat, err) -> putStrLn "error listing container" >> print stat >> putStrLn "\n" >> print err+ Right (x:_) -> error "Container not empty, use --force to ignore"+ else do+ res <- Az.deleteContainer (B8.pack account) azureKey (B8.pack container)+ case res of+ Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err+ Nothing -> return ()++
+ readme.md view
@@ -0,0 +1,43 @@+Azurify+=======++What's this?+------------++Azurify is an incomplete yet sort-of-functional library and command line client to access the Azure Blob Storage API [1]++The following features are implemented:+- Creating and deleting containers+- Listing the contents of a container+- Downloading blobs+- Uploading a new block blob *if it's no larger than 64MB*+- Deleting a blob+- Breaking a blob lease++The following features are *not* implemented (yet):+- Setting container and blob metadata+- Uploading blobs larger than 64MB+- Uploading page blobs+- Doing anything else with leases+- Anything with snapshots+- Proper error handling++How do I use this?+------------------++The cabal file will build a binary called ``azurify``. The following commands are supported:++- ``azurify uploadblob path/to/file accountname containername blobname``: to upload the local file ``path/to/file`` to the specified location;+- ``azurify downloadblob accountname containername blobname``: to download the specified blob the the current directory;+- ``azurify deleteblob accountname containername blobname``: to delete the specified blob;+- ``azurify breakbloblease accountname containername blobname``: to break the lease on the specified blob;+- ``azurify listcontainer accountname containername``: to output a list of blobs in the specified container;+- ``azurify createcontainer accountname containername [accesscontrol]``: accesscontrol may be either blobpublic, containerpublic or private. blobpublic means that the blobs will be downloadable by everyone, but the container can't be listed without an access key. containerpublic means that all blobs are downloadable by everyone and that everyone can list the container. private means that the access key is required to download blobs or list the container;+- ``azurify deletecontainer accountname containername``: delete the container with the given name. It will fail if the container is non-empty, if you want to delete it anyway use ``--force``.++You can also use the library in your Haskell applications, all you need are the functions exported in the ``azure.hs`` file.++Can I use this?+---------------++Azurify is BSD licensed (see LICENSE) so yes, you can use it.