azurify 0.3.0.0 → 0.4.0.0
raw patch · 5 files changed
+97/−36 lines, 5 filesdep +HTTPdep +filepathdep +unix-compatnew-uploader
Dependencies added: HTTP, filepath, unix-compat
Files
- Azure.hs +73/−26
- Azure/BlobDataTypes.hs +5/−0
- azurify.cabal +9/−3
- azurify.hs +8/−4
- readme.md +2/−3
Azure.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-} {-| Azurify is an incomplete yet sort-of-functional library and command line client to access the Azure Blob Storage API @@ -36,7 +38,9 @@ import Network.HTTP.Conduit import Network.HTTP.Types.Header import Network.HTTP.Types.Status+import Network.HTTP.Base (urlEncodeVars, urlDecode) import System.Locale+import System.IO (openBinaryFile, IOMode(..)) import Data.List import Data.Time import Data.Char (isSpace)@@ -57,6 +61,8 @@ import Data.Digest.Pure.SHA (hmacSha256, bytestringDigest) import qualified Data.ByteString.Base64 as B64 +default (Int)+ maybeResponseError :: Response t -> Maybe (Int, t) maybeResponseError rsp = let status = (responseStatus rsp) in if statusCode status >= 300 || statusCode status < 200@@ -136,39 +142,77 @@ -> IO (Maybe (Int, L.ByteString)) -- ^ Nothing when successful, HTTP error code and content otherwise createBlob account authKey containerName blobSettings = case blobSettings of- BlockBlobSettings name contents common ->- createBlockBlob name contents common- PageBlobSettings name contentLength common ->- createPageBlob name contentLength common+ BlockBlobSettings name contents settings ->+ blockBlobApi name contents settings []+ PageBlobSettings name contentLength settings ->+ createPageBlob name contentLength settings++ FileBlobSettings name fp settings -> do+ h <- openBinaryFile fp ReadMode+ let doBlock i = do+ contents <- B.hGetSome h (4 * 1048576) -- 4 MB is max size+ if B.null contents then return $ Right (i - 1)+ else do+ mrsp <- createBlockBlob name settings contents (toB64 i)+ case mrsp of+ Nothing -> doBlock (i + 1)+ Just rsp -> return $ Left rsp+ result <- doBlock 1+ case result of+ Left err -> return $ Just err+ Right lastBlockId -> do+ putStrLn $ show lastBlockId ++ " blocks uploaded. Committing..."+ createBlobApi [] name (blockListBody lastBlockId) settings [("comp", "blocklist")]+ 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") ]+ toB64 = B64.encode . B8.pack . padZeroes . show+ -- http://gauravmantri.com/2013/05/18/windows-azure-blob-storage-dealing-with-the-specified-blob-or-block-content-is-invalid-error/+ padZeroes s | length s > maxSize = error "azurify: too big for this hack!"+ | otherwise = concatMap (const "0") [1 .. maxSize - length s] ++ s+ where maxSize = 5 - createPageBlob :: B.ByteString -> Integer -> CommonBlobSettings -> IO (Maybe (Int, L.ByteString))- createPageBlob name contentLength conf = do+ blockListBody :: Int -> B.ByteString+ blockListBody lastId = "<?xml version=\"1.0\" encoding=\"utf-8\"?><BlockList>"+ <> commits lastId+ <> "</BlockList>"+ commits :: Int -> B.ByteString+ commits 0 = ""+ commits i = commits (i - 1) <> "<Uncommitted>" <> toB64 i <> "</Uncommitted>"++ createBlockBlob name settings contents blockId =+ blockBlobApi name contents settings [+ ("comp", "block"), ("blockid", blockId)+ ]++ blockBlobApi = createBlobApi [("x-ms-blob-type", "BlockBlob")]++ createBlobApi :: [Header]+ -> B.ByteString -> B.ByteString -> CommonBlobSettings+ -> [(B.ByteString, B.ByteString)] -- ^ params+ -> IO (Maybe (Int, L.ByteString))+ createBlobApi headers name content conf params = do let resource = "/" <> containerName <> "/" <> name- rsp <- doRequest account authKey resource [] "PUT" "" hdrs+ rsp <- doRequest account authKey resource params "PUT" content hdrs return $ maybeResponseError rsp- where hdrs = map (second fromJust) $ filter (\(_,a) -> isJust a)+ where+ hdrs = blobHeaders conf headers++ blobHeaders conf extra = (+ 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) ]+ ) ++ extra + createPageBlob :: B.ByteString -> Integer -> CommonBlobSettings -> IO (Maybe (Int, L.ByteString))+ createPageBlob name contentLength conf = createBlobApi+ [ ("x-ms-blob-type", "PageBlob")+ , ("x-ms-blob-content-length", B8.pack $ show $ contentLength)+ ] name "" conf []+ -- |Delete a blob from a container deleteBlob :: B.ByteString -- ^ The account name -> B.ByteString -- ^ The authorsation key@@ -208,7 +252,8 @@ 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 url = B8.unpack ("http://" <> account <> ".blob.core.windows.net" <> resource <> encodeParams params)+ initReq <- parseUrl url let headers = ("x-ms-version", "2011-08-18") : ("x-ms-date", now) : extraHeaders ++ requestHeaders initReq@@ -226,9 +271,11 @@ encodeParams :: [(B.ByteString, B.ByteString)] -> B.ByteString encodeParams [] = ""-encodeParams ((k1,v1):ps) = "?" <> k1 <> "=" <> v1 <> encodeRest ps- where encodeRest = B.concat . map (\(k,v) -> "&" <> k <> "=" <> v)+encodeParams vars = ("?" <>) $ B8.pack $ urlEncodeVars $ map (\(a,b) -> (B8.unpack a, B8.unpack b)) vars +liftToString :: (String -> String) -> B8.ByteString -> B8.ByteString+liftToString f = B8.pack . f . B8.unpack+ canonicalizeHeaders :: [Header] -> B.ByteString canonicalizeHeaders headers = B.intercalate "\n" unfoldHeaders where headerStrs = map (\(a, b) -> strip $ foldedCase a <> ":" <> strip b) headers@@ -238,7 +285,7 @@ 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,_) (k2,_) -> compare k1 k2) params+ where canonParams = strip $ B.intercalate "\n" $ map (\(k,v) -> liftToString urlDecode k <> ":" <> liftToString urlDecode v) $ sortBy (\(k1,_) (k2,_) -> compare k1 k2) params strip :: B.ByteString -> B.ByteString strip = f . f
Azure/BlobDataTypes.hs view
@@ -3,6 +3,7 @@ import qualified Data.ByteString as B import Data.Text (Text) import Data.Default+import System.FilePath (FilePath) 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@@ -23,6 +24,10 @@ data BlobSettings = BlockBlobSettings { blockBlobName :: B.ByteString , blockBlobContents :: B.ByteString+ , blockBlobSettings :: CommonBlobSettings+ }+ | FileBlobSettings { blockBlobName :: B.ByteString+ , blockBlobFile :: FilePath , blockBlobSettings :: CommonBlobSettings } | PageBlobSettings { pageBlobName :: B.ByteString
azurify.cabal view
@@ -1,5 +1,5 @@ name: azurify-version: 0.3.0.0+version: 0.4.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/azure@@ -59,7 +59,10 @@ base64-bytestring >= 0.1.2.0, case-insensitive >= 0.4.0.1, utf8-string >= 0.3.7,- old-locale >= 1.0.0.4+ old-locale >= 1.0.0.4,+ filepath,+ unix-compat,+ HTTP if !flag(no-hxt) build-depends:@@ -96,7 +99,10 @@ case-insensitive >= 0.4.0.1, utf8-string >= 0.3.7, cmdargs >= 0.10,- directory >= 1.1.0.2+ directory >= 1.1.0.2,+ filepath,+ unix-compat,+ HTTP if !flag(no-hxt) build-depends:
azurify.hs view
@@ -9,6 +9,7 @@ import qualified Data.ByteString.Lazy as L import System.Console.CmdArgs import System.Directory(getCurrentDirectory)+import System.PosixCompat.Files (getFileStatus, fileSize) data Commands = UploadBlob { uploadBlobPath :: String , uploadBlobStorageName :: String@@ -116,10 +117,13 @@ m <- cmdArgsRun mode case m of UploadBlob path account container name contType contEnc contLang contCache azureKey -> do- contents <- B.readFile path- res <- Az.createBlob (B8.pack account) (B8.pack azureKey) (B8.pack container) $- Az.BlockBlobSettings (B8.pack name) contents $- Az.BlobSettings+ size <- fileSize `fmap` getFileStatus path+ settings <- if size < 1028 * 1028 * 64+ then do contents <- B.readFile path+ return $ Az.BlockBlobSettings (B8.pack name) contents+ else return $ Az.FileBlobSettings (B8.pack name) path+ res <- Az.createBlob (B8.pack account) (B8.pack azureKey) (B8.pack container)+ $ settings $ Az.BlobSettings (B8.pack `fmap` contType) (B8.pack `fmap` contEnc) (B8.pack `fmap` contLang)
readme.md view
@@ -10,14 +10,13 @@ - Creating and deleting containers - Listing the contents of a container - Downloading blobs-- Uploading a new block blob *if it's no larger than 64MB*+- Uploading a new block blob+- Uploading page blobs - 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