azurify 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+141/−74 lines, 5 filesdep +data-defaultdep +textdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, text

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Azure.hs +39/−35
• Azure/BlobDataTypes.hs +23/−11
• Azure/BlobListParser.hs +1/−1
• azurify.cabal +51/−11
• azurify.hs +27/−16

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, CPP #-}  {-|     Azurify is an incomplete yet sort-of-functional library and command line client to access the Azure Blob Storage API@@ -19,7 +19,9 @@ -} module Azure ( createContainer              , deleteContainer+#ifndef NO_XML              , listContainer+#endif              , changeContainerACL              , createBlob              , deleteBlob@@ -28,23 +30,21 @@              , module Azure.BlobDataTypes) where  import Azure.BlobDataTypes+#ifndef NO_XML import Azure.BlobListParser+#endif  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@@ -89,6 +89,7 @@     rsp <- doRequest account authKey resource [("restype", "container")] "DELETE" "" []     return $ maybeResponseError rsp +#ifndef NO_XML -- |List all blobs in a given container listContainer :: B.ByteString -- ^ The account name               -> B.ByteString -- ^ Authorisation key@@ -102,6 +103,7 @@       Nothing -> do           blobs <- parse $ L8.unpack $ responseBody rsp           return $ Right blobs+#endif  -- |Set the access control on a container changeContainerACL :: B.ByteString -- ^ The account name@@ -125,37 +127,39 @@            -> 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") ]+    case blobSettings of+      BlockBlobSettings name contents common ->+        createBlockBlob name contents common+      PageBlobSettings name contentLength common ->+        createPageBlob name contentLength common+  where+    createBlockBlob :: B.ByteString -> B.ByteString -> CommonBlobSettings -> IO (Maybe (Int, L.ByteString))+    createBlockBlob name content conf = do+        let resource = "/" +++ containerName +++ "/" +++ name+        rsp <- doRequest account authKey resource [] "PUT" content hdrs+        return $ maybeResponseError rsp+        where hdrs = map (second fromJust) $ filter (\(_,a) -> isJust a)+                    [ ("Content-Type", blobSettingsContentType conf)+                    , ("Content-Encoding", blobSettingsContentEncoding conf)+                    , ("Content-Language", blobSettingsContentLanguage conf)+                    , ("Content-MD5", blobSettingsContentMD5 conf)+                    , ("Cache-Control", blobSettingsCacheControl conf)+                    , ("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)-                ]+    createPageBlob :: B.ByteString -> Integer -> CommonBlobSettings -> IO (Maybe (Int, L.ByteString))+    createPageBlob name contentLength conf = do+        let resource = "/" +++ containerName +++ "/" +++ name+        rsp <- doRequest account authKey resource [] "PUT" "" hdrs+        return $ maybeResponseError rsp+        where hdrs = map (second fromJust) $ filter (\(_,a) -> isJust a)+                    [ ("Content-Type", blobSettingsContentType conf)+                    , ("Content-Encoding", blobSettingsContentEncoding conf)+                    , ("Content-Language", blobSettingsContentLanguage conf)+                    , ("Content-MD5", blobSettingsContentMD5 conf)+                    , ("Cache-Control", blobSettingsCacheControl conf)+                    , ("x-ms-blob-type", Just "PageBlob")+                    , ("x-ms-blob-content-length", Just $ B8.pack $ show $ contentLength)+                    ]  -- |Delete a blob from a container deleteBlob :: B.ByteString -- ^ The account name

@@ -1,24 +1,36 @@ module Azure.BlobDataTypes where  import qualified Data.ByteString as B+import Data.Text (Text)+import Data.Default  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 CommonBlobSettings = BlobSettings {+                           blobSettingsContentType :: Maybe B.ByteString+                         , blobSettingsContentEncoding :: Maybe B.ByteString+                         , blobSettingsContentLanguage :: Maybe B.ByteString+                         , blobSettingsContentMD5 :: Maybe B.ByteString+                         , blobSettingsCacheControl :: Maybe B.ByteString+                         , blobSettingsMetaData :: [(Text, Text)]+                         } -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-                                 }+instance Default CommonBlobSettings where+  def = BlobSettings Nothing Nothing Nothing Nothing Nothing [] +data BlobSettings =+        BlockBlobSettings { blockBlobName :: B.ByteString+                          , blockBlobContents :: B.ByteString+                          , blockBlobSettings :: CommonBlobSettings+                          }+      | PageBlobSettings  { pageBlobName :: B.ByteString+                          , pageBlobContentLength :: Integer+                          , pageBlobSettings :: CommonBlobSettings+                          }++data BlobType = PageBlob | BlockBlob deriving (Show) data Blob = Blob { blobName :: B.ByteString                  , blobUrl :: B.ByteString                  , blobLastModified :: B.ByteString

@@ -4,10 +4,10 @@  import Azure.BlobDataTypes -import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Text.XML.HXT.Core hiding (Blob) +parse :: String -> IO [Blob] parse xml = runX (readString [] xml >>> getBlobs >>> xmlBlob)  getBlobs :: (ArrowXml a) => a XmlTree XmlTree

@@ -1,5 +1,5 @@ name:                azurify-version:             0.1.0.0+version:             0.2.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@@ -13,10 +13,39 @@  extra-source-files: Azure/BlobDataTypes.hs, Azure/BlobListParser.hs, readme.md -Library-  Exposed-Modules: Azure+Flag no-hxt+  Description: no xml parsing, and no hxt dependency+  Default: False++Flag library-only+  Description: don't build the executable+  Default: False++library+  ghc-options: -Wall++  if flag(no-hxt)+      cpp-options:   -DNO_XML++  extensions:+    OverloadedStrings+    CPP++  exposed-modules:+    Azure++  if flag(no-hxt)+    other-modules:+      Azure.BlobDataTypes+  else+    other-modules:+      Azure.BlobDataTypes+      Azure.BlobListParser+   build-depends:-    base >= 4.5,+    base >= 4.5 && < 5,+    text,+    data-default,     bytestring >= 0.9.2.1,     http-conduit >= 1.5.0.3,     http-types >= 0.7.0,@@ -25,20 +54,28 @@     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+    old-locale >= 1.0.0.4 +  if !flag(no-hxt)+    build-depends:+      hxt >= 9.2.2+ executable azurify+  if flag(library-only)+      Buildable: False++  if flag(no-hxt)+      cpp-options:   -DNO_XML+   main-is: azurify.hs-  hs-source-dirs: . Azure/   build-depends:-    base >= 4.5 && < 5,+    base >= 4.5,+    text,+    data-default,     bytestring >= 0.9.2.1,     http-conduit >= 1.5.0.3,     http-types >= 0.7.0,@@ -52,6 +89,9 @@     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++  if !flag(no-hxt)+    build-depends:+      hxt >= 9.2.2

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings, CPP, DeriveDataTypeable #-}  module Main where @@ -69,21 +69,33 @@                                 , breakLeaseBlobName = def &= typ "blobname" &= argPos 2                                 } +#ifndef NO_XML listContainer = ListContainer { listContainerStorageName = def &= typ "accountname" &= argPos 0                               , listContainerContainerName = def &= typ "containername" &= argPos 1                               } &= help "List all blobs in a container"+#endif  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" +#ifndef NO_XML 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"+#endif -mode = cmdArgsMode $ modes [uploadBlob, downloadBlob, deleteBlob, breakBlobLease, listContainer, createContainer, deleteContainer] &= help "Access the Azure blob storage" &= program "azurify" &= summary "Azurify v1.0"+mode = cmdArgsMode $ modes [uploadBlob, downloadBlob, deleteBlob, breakBlobLease+#ifndef NO_XML+         , listContainer+#endif+         , createContainer+#ifndef NO_XML+         , deleteContainer+#endif+         ] &= help "Access the Azure blob storage" &= program "azurify" &= summary "Azurify v1.0"  main :: IO () main = do@@ -93,18 +105,15 @@     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)-                                                  )+            res <- Az.createBlob (B8.pack account) azureKey (B8.pack container) $+                       Az.BlockBlobSettings (B8.pack name) contents $+                         Az.BlobSettings+                            (B8.pack `fmap` contType)+                            (B8.pack `fmap` contEnc)+                            (B8.pack `fmap` contLang)+                            Nothing+                            (B8.pack `fmap` contCache)+                            []             case res of                 Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err                 Nothing -> return ()@@ -126,11 +135,13 @@             case res of                 Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err                 _ -> return ()+#ifndef NO_XML         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+#endif         CreateContainer account container access -> do             let acl = case access of {                 Just "blobpublic" -> Az.BlobPublic;@@ -143,6 +154,7 @@             case res of                 Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err                 Nothing -> return ()+#ifndef NO_XML         DeleteContainer account container force -> do             if force == (Just True) then do                 res <- Az.listContainer (B8.pack account) azureKey (B8.pack container)@@ -154,5 +166,4 @@                     case res of                         Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err                         Nothing -> return ()--+#endif