google-cloud-storage 0.1.0.0 → 1.1.0.0

raw patch · 6 files changed

+455/−146 lines, 6 filesdep +http-conduitdep +http-typesdep +tastydep ~google-cloud-commonsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: http-conduit, http-types, tasty, tasty-hunit

Dependency ranges changed: google-cloud-common

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +79/−0
• Setup.hs +1/−0
• google-cloud-storage.cabal +10/−2
• src/Google/Cloud/Storage/Bucket.hs +294/−143
• test/Spec.hs +66/−1

@@ -8,4 +8,9 @@  ## Unreleased +## 1.1.0.0 - 2025-09-11++- Synchronized version bump for v1.1.0.0 release.+- Improved upload and download object with resumable link.+ ## 0.1.0.0 - YYYY-MM-DD

@@ -3,3 +3,82 @@ Haskell idiomatic client for [Google Cloud Platform](https://cloud.google.com/) Storage service.  Full docs are available at https://github.com/tusharad/google-cloud-haskell++## Installation++- Cabal: add to your `.cabal`+  - `build-depends: google-cloud-storage == 1.1.0.0`+- Stack: add to your `package.yaml`+  - `dependencies: - google-cloud-storage == 1.1.0.0`++This package depends on `google-cloud-common` for authentication and HTTP helpers.++## Authentication++Authentication is handled by `google-cloud-common` and follows this order:++1. Use `GOOGLE_APPLICATION_CREDENTIALS` to load a Service Account JSON and+   exchange a signed JWT for an access token.+2. Otherwise, use the Compute metadata server (suitable for GCE/GKE).++## Examples++Minimal examples using `Google.Cloud.Storage.Bucket`:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Lazy.Char8 as BSL+import Google.Cloud.Storage.Bucket++-- List buckets in a project+listBucketsExample :: IO ()+listBucketsExample = do+  let projectId = "my-gcp-project"+  eRes <- listBuckets projectId+  case eRes of+    Left err -> putStrLn ("Error: " <> err)+    Right buckets -> print buckets++-- Create a bucket+createBucketExample :: IO ()+createBucketExample = do+  let newBucket = CreateBucketData+        { name = "my-unique-bucket-name"+        , location = Location "us-central1"+        , storageClass = STANDARD+        , projectId = "my-gcp-project"+        }+  eRes <- createBucket newBucket+  case eRes of+    Left err -> putStrLn ("Create error: " <> err)+    Right _  -> putStrLn "Bucket created"++-- Upload and download objects+objectOpsExample :: IO ()+objectOpsExample = do+  let bucket = "my-bucket"+      object = "my-object.txt"+  _ <- uploadObject bucket object (BSL.pack "Hello, world!")+  eBody <- downloadObject bucket object+  case eBody of+    Left err -> putStrLn ("Download error: " <> err)+    Right body -> BSL.putStrLn body++-- Copy and delete an object+copyDeleteExample :: IO ()+copyDeleteExample = do+  let req = CopyObjectRequest+        { sourceBucketName = "my-bucket"+        , sourceObjectName = "my-object.txt"+        , destinationBucketName = "another-bucket"+        , destinationObject = "copied-object.txt"+        }+  _ <- copyObject req+  _ <- deleteObject "my-bucket" "my-object.txt"+  pure ()+```++## License++MIT © Contributors

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,12 +1,14 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           google-cloud-storage-version:        0.1.0.0+version:        1.1.0.0+synopsis:       GCP Client for Haskell description:    GCP Storage bucket client for Haskell.+category:       Web homepage:       https://github.com/tusharad/google-cloud-haskell#readme bug-reports:    https://github.com/tusharad/google-cloud-haskell/issues author:         tushar@@ -36,6 +38,8 @@     , base >=4.7 && <5     , bytestring >=0.9.1.4     , google-cloud-common+    , http-conduit+    , http-types     , text >=1.2 && <3   default-language: Haskell2010 @@ -53,5 +57,9 @@     , bytestring >=0.9.1.4     , google-cloud-common     , google-cloud-storage+    , http-conduit+    , http-types+    , tasty >=1.4+    , tasty-hunit >=0.10     , text >=1.2 && <3   default-language: Haskell2010

@@ -4,15 +4,17 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} --- | This module provides functions for interacting with Google Cloud Storage buckets and objects.--- It includes functionality for listing, creating, updating, and deleting buckets, as well as--- copying, deleting, downloading, and uploading objects.+{- | This module provides functions for interacting with Google Cloud Storage buckets and objects.+It includes functionality for listing, creating, updating, and deleting buckets, as well as+copying, deleting, downloading, and uploading objects.+-} module Google.Cloud.Storage.Bucket   ( Buckets (..)   , Location (..)   , StorageClass (..)   , CreateBucketData (..)   , CopyObjectRequest (..)+  , CopyObjectResp (..)   , listBuckets   , createBucket   , updateBucketStorageClass@@ -29,69 +31,100 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import GHC.Generics (Generic)-import Google.Cloud.Common.Core +import Google.Cloud.Common.Core+import Network.HTTP.Simple+import Network.HTTP.Types (status200, status308)  -- | Represents a list of buckets in a Google Cloud Storage project. data Buckets = Buckets-  { kind :: String  -- ^ The kind of item this is. For buckets, this is always "storage#buckets".-  , items :: [Bucket]  -- ^ The list of buckets.+  { kind :: String+  -- ^ The kind of item this is. For buckets, this is always "storage#buckets".+  , items :: [Bucket]+  -- ^ The list of buckets.   }   deriving (Show, Generic, FromJSON, ToJSON)  -- | Represents a single bucket in Google Cloud Storage. data Bucket = Bucket-  { kind :: String  -- ^ The kind of item this is. For buckets, this is always "storage#bucket".-  , selfLink :: String  -- ^ The URL of this bucket.-  , id :: String  -- ^ The ID of the bucket.-  , name :: String  -- ^ The name of the bucket.-  , projectNumber :: String  -- ^ The project number of the project the bucket belongs to.-  , generation :: String  -- ^ The generation of this bucket.-  , metageneration :: String  -- ^ The metadata generation of this bucket.-  , location :: String  -- ^ The location of the bucket.-  , storageClass :: String  -- ^ The storage class of the bucket.-  , etag :: String  -- ^ The entity tag for this bucket.-  , timeCreated :: String  -- ^ The creation time of the bucket.-  , updated :: String  -- ^ The last modification time of the bucket.-  , softDeletePolicy :: SoftDeletePolicy  -- ^ The soft delete policy of the bucket.-  , iamConfiguration :: IAMConfiguration  -- ^ The IAM configuration of the bucket.-  , locationType :: String  -- ^ The type of location (e.g., region).-  , satisfiesPZI :: Bool  -- ^ Whether the bucket satisfies the PZI (Per-Zone Isolation) requirement.-  , hierarchicalNamespace :: Maybe HierarchicalNamespace  -- ^ The hierarchical namespace configuration.+  { kind :: String+  -- ^ The kind of item this is. For buckets, this is always "storage#bucket".+  , selfLink :: String+  -- ^ The URL of this bucket.+  , id :: String+  -- ^ The ID of the bucket.+  , name :: String+  -- ^ The name of the bucket.+  , projectNumber :: String+  -- ^ The project number of the project the bucket belongs to.+  , generation :: String+  -- ^ The generation of this bucket.+  , metageneration :: String+  -- ^ The metadata generation of this bucket.+  , location :: String+  -- ^ The location of the bucket.+  , storageClass :: String+  -- ^ The storage class of the bucket.+  , etag :: String+  -- ^ The entity tag for this bucket.+  , timeCreated :: String+  -- ^ The creation time of the bucket.+  , updated :: String+  -- ^ The last modification time of the bucket.+  , softDeletePolicy :: SoftDeletePolicy+  -- ^ The soft delete policy of the bucket.+  , iamConfiguration :: IAMConfiguration+  -- ^ The IAM configuration of the bucket.+  , locationType :: String+  -- ^ The type of location (e.g., region).+  , satisfiesPZI :: Maybe Bool+  -- ^ Whether the bucket satisfies the PZI (Per-Zone Isolation) requirement.+  , hierarchicalNamespace :: Maybe HierarchicalNamespace+  -- ^ The hierarchical namespace configuration.   }   deriving (Show, Generic, FromJSON, ToJSON)  -- | Represents the soft delete policy of a bucket. data SoftDeletePolicy = SoftDeletePolicy-  { retentionDurationSeconds :: String  -- ^ The duration in seconds that soft-deleted objects are retained.-  , effectiveTime :: String  -- ^ The time from which the policy was enforced.+  { retentionDurationSeconds :: String+  -- ^ The duration in seconds that soft-deleted objects are retained.+  , effectiveTime :: String+  -- ^ The time from which the policy was enforced.   }   deriving (Show, Generic, FromJSON, ToJSON)  -- | Represents the IAM configuration of a bucket. data IAMConfiguration = IAMConfiguration-  { bucketPolicyOnly :: BucketPolicyOnly  -- ^ The Bucket Policy Only configuration.-  , uniformBucketLevelAccess :: UniformBucketLevelAccess  -- ^ The Uniform Bucket-Level Access configuration.-  , publicAccessPrevention :: String  -- ^ The public access prevention status.+  { bucketPolicyOnly :: BucketPolicyOnly+  -- ^ The Bucket Policy Only configuration.+  , uniformBucketLevelAccess :: UniformBucketLevelAccess+  -- ^ The Uniform Bucket-Level Access configuration.+  , publicAccessPrevention :: String+  -- ^ The public access prevention status.   }   deriving (Show, Generic, FromJSON, ToJSON)  -- | Represents the Bucket Policy Only configuration. data BucketPolicyOnly = BucketPolicyOnly-  { enabled :: Bool  -- ^ Whether Bucket Policy Only is enabled.-  , lockedTime :: Maybe String  -- ^ The time when the configuration was locked, if applicable.+  { enabled :: Bool+  -- ^ Whether Bucket Policy Only is enabled.+  , lockedTime :: Maybe String+  -- ^ The time when the configuration was locked, if applicable.   }   deriving (Show, Generic, FromJSON, ToJSON)  -- | Represents the Uniform Bucket-Level Access configuration. data UniformBucketLevelAccess = UniformBucketLevelAccess-  { enabled :: Bool  -- ^ Whether Uniform Bucket-Level Access is enabled.-  , lockedTime :: Maybe String  -- ^ The time when the configuration was locked, if applicable.+  { enabled :: Bool+  -- ^ Whether Uniform Bucket-Level Access is enabled.+  , lockedTime :: Maybe String+  -- ^ The time when the configuration was locked, if applicable.   }   deriving (Show, Generic, FromJSON, ToJSON)  -- | Represents the hierarchical namespace configuration of a bucket. newtype HierarchicalNamespace = HierarchicalNamespace-  { enabled :: Bool  -- ^ Whether hierarchical namespace is enabled.+  { enabled :: Bool+  -- ^ Whether hierarchical namespace is enabled.   }   deriving (Show, Generic, FromJSON, ToJSON) @@ -104,44 +137,62 @@  -- | Represents the storage class of a bucket or object. data StorageClass-  = STANDARD  -- ^ Standard storage class, for frequently accessed data.-  | NEARLINE  -- ^ Nearline storage class, for infrequently accessed data.-  | COLDLINE  -- ^ Coldline storage class, for rarely accessed data.-  | ARCHIVE   -- ^ Archive storage class, for long-term data archiving.+  = -- | Standard storage class, for frequently accessed data.+    STANDARD+  | -- | Nearline storage class, for infrequently accessed data.+    NEARLINE+  | -- | Coldline storage class, for rarely accessed data.+    COLDLINE+  | -- | Archive storage class, for long-term data archiving.+    ARCHIVE   deriving (Eq, Show)  -- | Data required to create a new bucket. data CreateBucketData = CreateBucketData-  { name :: String  -- ^ The name of the bucket to create.-  , location :: Location  -- ^ The location where the bucket will be created.-  , storageClass :: StorageClass  -- ^ The storage class for the bucket.-  , projectId :: String  -- ^ The ID of the project in which to create the bucket.+  { name :: String+  -- ^ The name of the bucket to create.+  , location :: Location+  -- ^ The location where the bucket will be created.+  , storageClass :: StorageClass+  -- ^ The storage class for the bucket.+  , projectId :: String+  -- ^ The ID of the project in which to create the bucket.   }   deriving (Show)  -- | Request data for copying an object. data CopyObjectRequest = CopyObjectRequest-  { sourceBucketName :: String  -- ^ The name of the source bucket.-  , sourceObjectName :: String  -- ^ The name of the source object.-  , destinationBucketName :: String  -- ^ The name of the destination bucket.-  , destinationObject :: String  -- ^ The name of the destination object.+  { sourceBucketName :: String+  -- ^ The name of the source bucket.+  , sourceObjectName :: String+  -- ^ The name of the source object.+  , destinationBucketName :: String+  -- ^ The name of the destination bucket.+  , destinationObject :: String+  -- ^ The name of the destination object.   }   deriving (Show, Generic)  -- | Response data for copying an object. data CopyObjectResp = CopyObjectResp-  { kind :: String  -- ^ The kind of item this is.-  , totalBytesRewritten :: String  -- ^ The total number of bytes rewritten.-  , objectSize :: String  -- ^ The size of the object.-  , done :: Bool  -- ^ Whether the copy operation is complete.-  , rewriteToken :: Maybe String  -- ^ Token for continuing the rewrite operation, if not done.+  { kind :: String+  -- ^ The kind of item this is.+  , totalBytesRewritten :: String+  -- ^ The total number of bytes rewritten.+  , objectSize :: String+  -- ^ The size of the object.+  , done :: Bool+  -- ^ Whether the copy operation is complete.+  , rewriteToken :: Maybe String+  -- ^ Token for continuing the rewrite operation, if not done.   }   deriving (Show, Eq, Generic, FromJSON) --- | Lists all buckets in a given project.------ @listBuckets projectId@ makes a request to list all buckets in the specified @projectId@.--- It returns either an error message or a 'Buckets' object containing the list of buckets.+{- | Lists all buckets in a given project.++@listBuckets projectId@ makes a request to list all buckets in the specified @projectId@.+It returns either an error message or a 'Buckets' object containing the list of buckets.+-} listBuckets :: String -> IO (Either String Buckets) listBuckets projectId =   doRequestJSON@@ -154,10 +205,11 @@       , mbReqPath = Nothing       } --- | Creates a new bucket in Google Cloud Storage.------ @createBucket createBucketData@ creates a new bucket with the specified name, location,--- storage class, and project ID. It returns either an error message or a unit value indicating success.+{- | Creates a new bucket in Google Cloud Storage.++@createBucket createBucketData@ creates a new bucket with the specified name, location,+storage class, and project ID. It returns either an error message or a unit value indicating success.+-} createBucket :: CreateBucketData -> IO (Either String ()) createBucket CreateBucketData {..} =   doRequestJSON@@ -170,15 +222,16 @@       , mbQueryParams = Just [("project", Just (BS.pack projectId))]       } --- | Updates the storage class of an existing bucket.------ @updateBucketStorageClass bucketName newStorageClass@ updates the storage class of the--- specified bucket to @newStorageClass@. It returns either an error message or a unit value--- indicating success.--- -- Example:------ >>> updateBucketStorageClass "my-bucket" COLDLINE--- Right ()+{- | Updates the storage class of an existing bucket.++@updateBucketStorageClass bucketName newStorageClass@ updates the storage class of the+specified bucket to @newStorageClass@. It returns either an error message or a unit value+indicating success.+-- Example:++>>> updateBucketStorageClass "my-bucket" COLDLINE+Right ()+-} updateBucketStorageClass :: String -> StorageClass -> IO (Either String ()) updateBucketStorageClass bucketName newStorageClass =   doRequestJSON@@ -191,14 +244,15 @@       , mbQueryParams = Just [("fields", Just "storageClass")]       } --- | Fetches the metadata of a specific bucket.------ @fetchBucket bucketName@ retrieves the metadata for the bucket with the given name.--- It returns either an error message or the 'Bucket' object.--- Example:------ >>> fetchBucket "my-bucket"--- Right (Bucket {name = "my-bucket", ...})+{- | Fetches the metadata of a specific bucket.++@fetchBucket bucketName@ retrieves the metadata for the bucket with the given name.+It returns either an error message or the 'Bucket' object.+Example:++>>> fetchBucket "my-bucket"+Right (Bucket {name = "my-bucket", ...})+-} fetchBucket :: String -> IO (Either String Bucket) fetchBucket bucketName =   doRequestJSON@@ -211,17 +265,18 @@       , mbQueryParams = Nothing       } --- | Copies an object from one bucket to another.------ @copyObject copyObjectRequest@ copies the specified source object to the destination bucket--- and object name. For large objects, this function handles the copy in multiple requests--- using rewrite tokens. It returns either an error message or a 'CopyObjectResp' indicating--- the status of the copy operation.--- Example:------ >>> let request = CopyObjectRequest "source-bucket" "source-object" "destination-bucket" "destination-object"--- >>> copyObject request--- Right (CopyObjectResp {kind = "storage#object", totalBytesRewritten = "12345", objectSize = "12345", done = True, rewriteToken = Nothing})+{- | Copies an object from one bucket to another.++@copyObject copyObjectRequest@ copies the specified source object to the destination bucket+and object name. For large objects, this function handles the copy in multiple requests+using rewrite tokens. It returns either an error message or a 'CopyObjectResp' indicating+the status of the copy operation.+Example:++>>> let request = CopyObjectRequest "source-bucket" "source-object" "destination-bucket" "destination-object"+>>> copyObject request+Right (CopyObjectResp {kind = "storage#object", totalBytesRewritten = "12345", objectSize = "12345", done = True, rewriteToken = Nothing})+-} copyObject :: CopyObjectRequest -> IO (Either String CopyObjectResp) copyObject CopyObjectRequest {..} = do   go Nothing@@ -258,14 +313,15 @@             else do               go (Just (rewriteToken resp)) --- | Deletes an object from a bucket.------ @deleteObject bucketName objectName@ deletes the specified object from the given bucket.--- It returns either an error message or a unit value indicating success.--- Example:------ >>> deleteObject "my-bucket" "my-object"--- Right ()+{- | Deletes an object from a bucket.++@deleteObject bucketName objectName@ deletes the specified object from the given bucket.+It returns either an error message or a unit value indicating success.+Example:++>>> deleteObject "my-bucket" "my-object"+Right ()+-} deleteObject :: String -> String -> IO (Either String ()) deleteObject bucketName objectName =   doRequestJSON@@ -278,15 +334,16 @@       , mbQueryParams = Nothing       } --- | Deletes a bucket.------ @deleteBucket bucketName@ deletes the specified bucket. Note that the bucket must be empty--- before it can be deleted. It returns either an error message or a unit value indicating success.------ Example:------ >>> deleteBucket "my-bucket"--- Right ()+{- | Deletes a bucket.++@deleteBucket bucketName@ deletes the specified bucket. Note that the bucket must be empty+before it can be deleted. It returns either an error message or a unit value indicating success.++Example:++>>> deleteBucket "my-bucket"+Right ()+-} deleteBucket :: String -> IO (Either String ()) deleteBucket bucketName =   doRequestJSON@@ -299,35 +356,49 @@       , mbQueryParams = Nothing       } --- | Downloads an object from a bucket to a local file.------ @downloadObject bucketName objectName saveLocation@ returns the specified object in--- lazy bytestring format. It returns either an error message or content indicating success.--- Note: This function downloads the entire object at once; for large objects, consider--- implementing streaming or slicing (planned for future versions).--- Example:------ >>> downloadObject "my-bucket" "my-object"--- Right (bytestring content)+{- | Downloads an object from a bucket to a local file.++@downloadObject bucketName objectName saveLocation@ returns the specified object in+lazy bytestring format. It returns either an error message or content indicating success.+Note: This function downloads the entire object at once; for large objects, consider+implementing streaming or slicing (planned for future versions).+Example:++>>> downloadObject "my-bucket" "my-object"+Right (bytestring content)+-} downloadObject :: String -> String -> IO (Either String BSL.ByteString)-downloadObject bucketName objectName = do-  let reqOpts =-        RequestOptions-          { reqMethod = GET-          , reqUrl = googleStorageUrl-          , mbQueryParams = Just [("alt", Just "media")]-          , mbReqBody = Nothing-          , mbReqHeaders = Nothing-          , mbReqPath = Just $ "/" <> bucketName <> "/o/" <> objectName-          }-  res <- doRequest reqOpts-  case res of-    Left err -> return (Left err)-    Right resp -> do-      let body = resp-      return $ Right body+downloadObject bucketName objectName = go 0 mempty+  where+    chunkSize :: Int+    chunkSize = 1024 * 1024 -- 1 MB per chunk (tune as needed)+    go :: Int -> BSL.ByteString -> IO (Either String BSL.ByteString)+    go offset acc = do+      let rangeHeader =+            ( "Range"+            , BS.pack $+                "bytes=" <> show offset <> "-" <> show (offset + chunkSize - 1)+            )+          reqOpts =+            RequestOptions+              { reqMethod = GET+              , reqUrl = googleStorageUrl+              , mbReqPath = Just $ "/" <> bucketName <> "/o/" <> objectName+              , mbReqHeaders = Just [rangeHeader]+              , mbQueryParams = Just [("alt", Just "media")]+              , mbReqBody = Nothing+              }+      eBody <- doRequest reqOpts+      case eBody of+        Left err -> pure $ Left err+        Right body -> do+          let len = fromIntegral (BSL.length body)+          if len < chunkSize+            then pure $ Right (acc `BSL.append` body) -- last chunk+            else do+              print ("donwloded so far: " :: String, offset + chunkSize)+              go (offset + chunkSize) (acc `BSL.append` body) --- | Uploads an object to a bucket. -- -- @uploadObject bucketName objectName objectContent@ uploads the given content to the specified -- object in the bucket. It returns either an error message or a unit value indicating success.@@ -338,23 +409,103 @@ -- >>> uploadObject "my-bucket" "my-object" (BSL.pack "object content") -- Right () uploadObject :: String -> String -> BSL.ByteString -> IO (Either String ())-uploadObject bucketName objectName objectContent = do-  doRequestJSON-    RequestOptions-      { reqMethod = POST-      , reqUrl = "https://storage.googleapis.com/upload/storage/v1/b"-      , mbReqPath = Just $ "/" <> bucketName <> "/o"-      , mbReqBody = Just objectContent -      , mbReqHeaders = Nothing-      , mbQueryParams = Just [("uploadType", Just "media"),("name", Just $ BS.pack objectName)]-      }+uploadObject = resumableUploadObject +{- | Initiates a resumable upload session.++Returns the resumable session URL (from the Location header) which can be+used to upload chunks of the object.+-}+initResumableUpload :: String -> String -> IO (Either String String)+initResumableUpload bucketName objectName = do+  eResp <-+    doRequestRaw+      RequestOptions+        { reqMethod = POST+        , reqUrl = "https://storage.googleapis.com/upload/storage/v1/b"+        , mbReqPath = Just ("/" <> bucketName <> "/o")+        , mbReqBody = Nothing+        , mbReqHeaders = Just [("Content-Type", "application/json")]+        , mbQueryParams =+            Just+              [ ("uploadType", Just "resumable")+              , ("name", BS.pack <$> Just objectName)+              ]+        }+  case eResp of+    Left err -> pure $ Left err+    Right resp -> case getResponseHeader "location" resp of+      [] -> pure $ Left "Missing resumable upload URL in response"+      (loc : _) -> pure $ Right (BS.unpack loc)++{- | Uploads a file using a resumable upload session in chunks.++This function splits the objectContent into chunks and uploads sequentially.+-}+resumableUploadObject :: String -> String -> BSL.ByteString -> IO (Either String ())+resumableUploadObject bucketName objectName objectContent = do+  eSessionUrl <- initResumableUpload bucketName objectName+  case eSessionUrl of+    Left err -> pure $ Left err+    Right sessionUrl -> uploadChunks sessionUrl 0 (BSL.toStrict objectContent)+  where+    chunkSize :: Int+    chunkSize = 1024 * 1024 -- 1MB per chunk (tune as needed)+    uploadChunks :: String -> Int -> BS.ByteString -> IO (Either String ())+    uploadChunks sessionUrl offset bs+      | BS.null bs = pure $ Right ()+      | otherwise = do+          let (chunk, rest) = BS.splitAt chunkSize bs+              totalSize = offset + BS.length chunk + BS.length rest+              endByte = offset + BS.length chunk - 1+              isLast = BS.null rest+              contentRange =+                if isLast+                  then+                    "bytes "+                      <> show offset+                      <> "-"+                      <> show endByte+                      <> "/"+                      <> show totalSize+                  else "bytes " <> show offset <> "-" <> show endByte <> "/*"++              headers =+                [ ("Content-Length", BS.pack (show (BS.length chunk)))+                , ("Content-Range", BS.pack contentRange)+                ]++          eResp <-+            doRequestRaw+              RequestOptions+                { reqMethod = PUT+                , reqUrl = sessionUrl+                , mbReqPath = Nothing+                , mbReqBody = Just (BSL.fromStrict chunk)+                , mbReqHeaders = Just headers+                , mbQueryParams = Nothing+                }++          case eResp of+            Left err -> pure $ Left err+            Right resp -> do+              let status = getResponseStatus resp+              if status == status200+                then pure $ Right () -- Finished+                else+                  if status == status308+                    then uploadChunks sessionUrl (offset + BS.length chunk) rest -- Continue+                    else pure $ Left $ "Unexpected status: " <> show status+ -- Helper types and functions (not exported, so no Haddock documentation needed)  data CreateBucketRequest = CreateBucketRequest-  { name :: String -- ^ Name of the bucket -  , location :: String  -- ^ Location of bucket e.g us-central1-a-  , storageClass :: StorageClass -- ^ Storage Class+  { name :: String+  -- ^ Name of the bucket+  , location :: String+  -- ^ Location of bucket e.g us-central1-a+  , storageClass :: StorageClass+  -- ^ Storage Class   }   deriving (Show) 

@@ -1,2 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Data.Aeson (eitherDecode)+import qualified Data.ByteString.Lazy.Char8 as BSL+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, testCase)++import Google.Cloud.Storage.Bucket+  ( Buckets (..)+  , CopyObjectResp (..)+  , Location (..)+  , StorageClass (..)+  , googleStorageUrl+  )+import qualified Google.Cloud.Storage.Bucket as CopyObject (CopyObjectResp (..))+ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = defaultMain tests++tests :: TestTree+tests =+  testGroup+    "google-cloud-storage"+    [ testCase "googleStorageUrl is JSON API buckets endpoint" $ do+        assertEqual+          "Expected JSON API base for buckets"+          "https://storage.googleapis.com/storage/v1/b"+          googleStorageUrl+    , testCase "Location Show instance renders wrapped string" $ do+        assertEqual "Show Location" "us-central1" (show (Location "us-central1"))+    , testCase "StorageClass Show values match API names" $ do+        assertEqual "STANDARD" "STANDARD" (show STANDARD)+        assertEqual "NEARLINE" "NEARLINE" (show NEARLINE)+        assertEqual "COLDLINE" "COLDLINE" (show COLDLINE)+        assertEqual "ARCHIVE" "ARCHIVE" (show ARCHIVE)+    , testCase "Decode CopyObjectResp from JSON (objects.rewrite)" $ do+        let json =+              BSL.pack+                "{\n"+                <> "  \"kind\": \"storage#rewriteResponse\",\n"+                <> "  \"totalBytesRewritten\": \"12345\",\n"+                <> "  \"objectSize\": \"12345\",\n"+                <> "  \"done\": true,\n"+                <> "  \"rewriteToken\": null\n"+                <> "}"+        case eitherDecode json of+          Left err -> assertBool ("Failed to decode: " <> err) False+          Right resp -> do+            let expected =+                  CopyObjectResp+                    { CopyObject.kind = "storage#rewriteResponse"+                    , totalBytesRewritten = "12345"+                    , objectSize = "12345"+                    , done = True+                    , rewriteToken = Nothing+                    }+            assertEqual "CopyObjectResp" expected resp+    , testCase "Decode Buckets with empty items" $ do+        let json = BSL.pack "{\n  \"kind\": \"storage#buckets\",\n  \"items\": []\n}"+        case eitherDecode json of+          Left err -> assertBool ("Failed to decode: " <> err) False+          Right (Buckets kindVal itemsVal) -> do+            assertEqual "Buckets.kind" "storage#buckets" kindVal+            assertEqual "Buckets.items length" 0 (length itemsVal)+    ]