diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal index 81b9160..6b96bb2 100644 --- a/azure-blob-storage/azure-blob-storage.cabal +++ b/azure-blob-storage/azure-blob-storage.cabal @@ -52,12 +52,13 @@ common common-options library import: common-options exposed-modules: Azure.Blob - Azure.Blob.GetBlob Azure.Blob.DeleteBlob - Azure.Blob.Types - Azure.Blob.UserDelegationKey + Azure.Blob.GetBlob Azure.Blob.PutBlob + Azure.Blob.Types Azure.Blob.SharedAccessSignature + Azure.Blob.UserDelegationKey + Azure.Blob.Utils build-depends: azure-auth , aeson , base64-bytestring diff --git a/azure-blob-storage/src/Azure/Blob.hs b/azure-blob-storage/src/Azure/Blob.hs index 287bac3..b013f1d 100644 --- a/azure-blob-storage/src/Azure/Blob.hs +++ b/azure-blob-storage/src/Azure/Blob.hs @@ -1,28 +1,27 @@ module Azure.Blob - ( - -- ** Variants to fetch a blob object + ( -- ** Variants to fetch a blob object getBlobObject , getBlobObjectEither - -- ** Variants to upload a blob to Blob storage + -- ** Variants to upload a blob to Blob storage , putBlobObject , putBlobObjectEither - -- ** Variants for deleting a blob object + -- ** Variants for deleting a blob object , deleteBlobObject , deleteBlobObjectEither - -- ** Generating a Shared Access Signature URI + -- ** Generating a Shared Access Signature URI , generateSas - -- ** Types for dealing with Blob storage functions + -- ** Types for dealing with Blob storage functions , AccountName (..) , ContainerName (..) , BlobName (..) ) where -import Azure.Blob.PutBlob -import Azure.Blob.GetBlob import Azure.Blob.DeleteBlob +import Azure.Blob.GetBlob +import Azure.Blob.PutBlob import Azure.Blob.SharedAccessSignature import Azure.Blob.Types diff --git a/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs b/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs index e5abd11..e00cc07 100644 --- a/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs +++ b/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs @@ -12,6 +12,7 @@ module Azure.Blob.DeleteBlob import Azure.Auth (defaultAzureCredential) import Azure.Blob.Types (AccountName (..), BlobName (..), ContainerName (..)) +import Azure.Blob.Utils (blobStorageResourceUrl, mkBlobHostUrl) import Data.Data (Proxy (..)) import Data.Text (Text) import GHC.Generics (Generic) @@ -23,9 +24,6 @@ import UnliftIO (MonadIO (..), throwString) import qualified Azure.Types as Auth import qualified Data.Text as Text -blobStorageResourceUrl :: Text -blobStorageResourceUrl = "https://storage.azure.com/" - deleteBlobObject :: MonadIO m => DeleteBlob -> @@ -80,11 +78,9 @@ callDeleteBlobClient action DeleteBlob{accountName, containerName, blobName, tok liftIO $ runClientM (action containerName blobName ("Bearer " <> atAccessToken) "2020-04-08") - (mkClientEnv manager $ BaseUrl Https mkHostUrl 443 "") + (mkClientEnv manager $ BaseUrl Https (mkBlobHostUrl accountName) 443 "") pure $ case res of Left err -> do Left . Text.pack $ show err Right _ -> do pure () - where - mkHostUrl = Text.unpack (unAccountName accountName) <> ".blob.core.windows.net" diff --git a/azure-blob-storage/src/Azure/Blob/GetBlob.hs b/azure-blob-storage/src/Azure/Blob/GetBlob.hs index 5593493..11abafb 100644 --- a/azure-blob-storage/src/Azure/Blob/GetBlob.hs +++ b/azure-blob-storage/src/Azure/Blob/GetBlob.hs @@ -24,13 +24,11 @@ import Servant.API import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM) import UnliftIO (MonadIO (..), throwString) +import Azure.Blob.Utils (blobStorageResourceUrl, mkBlobHostUrl) import qualified Azure.Types as Auth import qualified Data.Text as Text import qualified Network.HTTP.Media as M -blobStorageResourceUrl :: Text -blobStorageResourceUrl = "https://storage.azure.com/" - getBlobObject :: MonadIO m => GetBlob -> @@ -106,11 +104,9 @@ callGetBlobClient action GetBlob{accountName, containerName, blobName, tokenStor liftIO $ runClientM (action containerName blobName ("Bearer " <> atAccessToken) "2020-04-08") - (mkClientEnv manager $ BaseUrl Https mkHostUrl 443 "") + (mkClientEnv manager $ BaseUrl Https (mkBlobHostUrl accountName) 443 "") pure $ case res of Left err -> do Left . Text.pack $ show err Right response -> do Right response - where - mkHostUrl = Text.unpack (unAccountName accountName) <> ".blob.core.windows.net" diff --git a/azure-blob-storage/src/Azure/Blob/PutBlob.hs b/azure-blob-storage/src/Azure/Blob/PutBlob.hs index 32e6381..d0d223e 100644 --- a/azure-blob-storage/src/Azure/Blob/PutBlob.hs +++ b/azure-blob-storage/src/Azure/Blob/PutBlob.hs @@ -9,7 +9,8 @@ module Azure.Blob.PutBlob ) where import Azure.Auth (defaultAzureCredential) -import Azure.Blob.Types (AccountName (..), BlobName (..), BlobType (..), ContainerName (..), PutBlob (..)) +import Azure.Blob.Types (BlobName (..), BlobType (..), ContainerName (..), PutBlob (..)) +import Azure.Blob.Utils (blobStorageResourceUrl, mkBlobHostUrl) import Data.ByteString (ByteString) import Data.Data (Proxy (..)) import Data.Text (Text) @@ -21,9 +22,6 @@ import UnliftIO (MonadIO (..), throwString) import qualified Azure.Types as Auth import qualified Data.Text as Text -blobStorageResourceUrl :: Text -blobStorageResourceUrl = "https://storage.azure.com/" - {- | Upload a blob to a blob container. Errors will be thrown in IO. For variant where error is @@ -79,11 +77,9 @@ callPutBlobClient action PutBlob{accountName, containerName, blobName, tokenStor liftIO $ runClientM (action containerName blobName ("Bearer " <> atAccessToken) "2020-04-08" (Text.pack $ show BlockBlob) body) - (mkClientEnv manager $ BaseUrl Https mkHostUrl 443 "") + (mkClientEnv manager $ BaseUrl Https (mkBlobHostUrl accountName) 443 "") pure $ case res of Left err -> Left . Text.pack $ show err Right _ -> Right () - where - mkHostUrl = Text.unpack (unAccountName accountName) <> ".blob.core.windows.net" diff --git a/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs b/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs index cba27cd..83d6009 100644 --- a/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs +++ b/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs @@ -20,6 +20,7 @@ import Azure.Blob.Types , sasResourceToText ) import Azure.Blob.UserDelegationKey (callGetUserDelegationKeyApi, getUserDelegationKeyApi) +import Azure.Blob.Utils (blobStorageResourceUrl) import Crypto.Hash.SHA256 (hmac) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8) @@ -33,9 +34,6 @@ import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as C8 import qualified Data.Text as Text -blobStorageResourceUrl :: Text -blobStorageResourceUrl = "https://storage.azure.com/" - -- TODO: We need to add support for empty fields here. Eg: signedAuthorizedUserObjectId generateSas :: MonadIO m => diff --git a/azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs b/azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs index 805e63c..1df48d0 100644 --- a/azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs +++ b/azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs @@ -14,6 +14,7 @@ import Azure.Blob.Types , UserDelegationRequest (..) , UserDelegationResponse (..) ) +import Azure.Blob.Utils (mkBlobHostUrl) import Data.Data (Proxy (..)) import Data.Text (Text) import Network.HTTP.Client.TLS (newTlsManager) @@ -57,7 +58,7 @@ callGetUserDelegationKeyApi action accountName Auth.AccessToken{atAccessToken} r liftIO $ runClientM (action showResType showComp ("Bearer " <> atAccessToken) "2022-11-02" req) - (mkClientEnv manager $ BaseUrl Https mkHostUrl 443 "") + (mkClientEnv manager $ BaseUrl Https (mkBlobHostUrl accountName) 443 "") pure $ case res of Left err -> Left . Text.pack $ show err @@ -66,4 +67,3 @@ callGetUserDelegationKeyApi action accountName Auth.AccessToken{atAccessToken} r where showComp = "userdelegationkey" showResType = "service" - mkHostUrl = Text.unpack (unAccountName accountName) <> ".blob.core.windows.net" diff --git a/azure-blob-storage/src/Azure/Blob/Utils.hs b/azure-blob-storage/src/Azure/Blob/Utils.hs new file mode 100644 index 0000000..06ca0b9 --- /dev/null +++ b/azure-blob-storage/src/Azure/Blob/Utils.hs @@ -0,0 +1,15 @@ +module Azure.Blob.Utils + ( blobStorageResourceUrl + , mkBlobHostUrl + ) where + +import Azure.Blob.Types (AccountName (..)) +import Data.Text (Text) + +import qualified Data.Text as Text + +blobStorageResourceUrl :: Text +blobStorageResourceUrl = "https://storage.azure.com/" + +mkBlobHostUrl :: AccountName -> String +mkBlobHostUrl (AccountName accountName) = Text.unpack accountName <> ".blob.core.windows.net"