Nicities

Holmusk · Aug 4, 2024 · d30d752 · d30d752
1 parent c0bea6a
commit d30d752
Show file tree

Hide file tree

Showing 8 changed files with 36 additions and 35 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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"