From 849b4be3ff2b8051c619aaa5c34d19a606221347 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Fri, 28 Jun 2024 22:12:58 +0530
Subject: [PATCH 01/16] Blob storage boilerplate

---
 azure-blob-storage/CHANGELOG.md             |  5 ++
 azure-blob-storage/LICENSE                  | 21 ++++++
 azure-blob-storage/app/Main.hs              |  8 +++
 azure-blob-storage/azure-blob-storage.cabal | 80 +++++++++++++++++++++
 azure-blob-storage/src/Azure/Types.hs       | 33 +++++++++
 azure-blob-storage/test/Main.hs             |  4 ++
 6 files changed, 151 insertions(+)
 create mode 100644 azure-blob-storage/CHANGELOG.md
 create mode 100644 azure-blob-storage/LICENSE
 create mode 100644 azure-blob-storage/app/Main.hs
 create mode 100644 azure-blob-storage/azure-blob-storage.cabal
 create mode 100644 azure-blob-storage/src/Azure/Types.hs
 create mode 100644 azure-blob-storage/test/Main.hs

diff --git a/azure-blob-storage/CHANGELOG.md b/azure-blob-storage/CHANGELOG.md
new file mode 100644
index 0000000..94fa3bc
--- /dev/null
+++ b/azure-blob-storage/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for azure-blob-storage
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/azure-blob-storage/LICENSE b/azure-blob-storage/LICENSE
new file mode 100644
index 0000000..1f229d7
--- /dev/null
+++ b/azure-blob-storage/LICENSE
@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2024 Holmusk
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/azure-blob-storage/app/Main.hs b/azure-blob-storage/app/Main.hs
new file mode 100644
index 0000000..4a4d28e
--- /dev/null
+++ b/azure-blob-storage/app/Main.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import qualified Blob (someFunc)
+
+main :: IO ()
+main = do
+    putStrLn "Hello, Haskell!"
+    Blob.someFunc
diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
new file mode 100644
index 0000000..eccb338
--- /dev/null
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -0,0 +1,80 @@
+cabal-version:      3.0
+name:               azure-blob-storage
+version:            0.1.0.0
+license:            MIT
+license-file:       LICENSE
+synopsis:           Boilerplace/startkit for azure in Haskell (using servant)
+description:        This provides from useful functionalities for starting out with Azure in Haskell.
+                    This includes authentication, Key vault, Blob storage and email communication related APIs.
+author:             Holmusk
+maintainer:         tech@holmusk.com
+category:           Azure
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+tested-with:        GHC == 9.0.2
+                    GHC == 9.2.8
+                    GHC == 9.4.8
+                    GHC == 9.6.3
+                    GHC == 9.8.2
+
+common common-options
+    ghc-options:    -Wall
+                    -Wincomplete-uni-patterns
+                    -Wincomplete-record-updates
+                    -Wcompat
+                    -Widentities
+                    -Wredundant-constraints
+                    -fhide-source-paths
+                    -Wpartial-fields
+                    -Wunrecognised-pragmas
+                    -Wmissing-deriving-strategies
+                    -Wunticked-promoted-constructors
+                    -Winvalid-haddock
+                    -Woperator-whitespace
+                    -Wredundant-bang-patterns
+                    -Wunused-packages
+    build-depends:  base >= 4.7 && <5
+    default-language:   GHC2021
+    default-extensions: DataKinds
+                        DerivingStrategies
+                        DerivingVia
+                        LambdaCase
+                        NoImportQualifiedPost
+                        NoGeneralisedNewtypeDeriving
+                        OverloadedStrings
+                        OverloadedLabels
+                        RecordWildCards
+                        TypeFamilies
+                        ViewPatterns
+    if os(linux)
+        ghc-options: -optl-fuse-ld=gold
+        ld-options:  -fuse-ld=gold
+
+library
+    import:           common-options
+    exposed-modules:  Azure.Types
+    build-depends:    aeson
+                    , azure-auth
+                    , bytestring
+                    , http-client
+                    , http-client-tls
+                    , http-types
+                    , servant
+                    , servant-client
+                    , text
+                    , time
+                    , unliftio
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+test-suite azure-blob-storage-test
+    import:           common-options
+    default-language: Haskell2010
+    -- other-modules:
+    -- other-extensions:
+    type:             exitcode-stdio-1.0
+    hs-source-dirs:   test
+    main-is:          Main.hs
+    build-depends:
+        base ^>=4.7 && <5,
+        azure-blob-storage
diff --git a/azure-blob-storage/src/Azure/Types.hs b/azure-blob-storage/src/Azure/Types.hs
new file mode 100644
index 0000000..2834527
--- /dev/null
+++ b/azure-blob-storage/src/Azure/Types.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+-- Introduce blob storage functions that run in IO
+module Azure.Types
+    ( BlobName (..)
+    , ContainerName (..)
+    , AccountName (..)
+    ) where
+
+import Data.ByteString.Lazy (ByteString)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Servant.API (ToHttpApiData)
+
+newtype AccountName = AccountName
+    { unAccountName :: Text
+    }
+    deriving stock (Eq, Show, Generic)
+    deriving (ToHttpApiData) via Text
+
+newtype ContainerName = ContainerName
+    { unContainerName :: Text
+    }
+    deriving stock (Eq, Show, Generic)
+    deriving (ToHttpApiData) via Text
+
+newtype BlobName = BlobName
+    { unBlobName :: Text
+    }
+    deriving stock (Eq, Show, Generic)
+    deriving (ToHttpApiData) via Text
diff --git a/azure-blob-storage/test/Main.hs b/azure-blob-storage/test/Main.hs
new file mode 100644
index 0000000..3e2059e
--- /dev/null
+++ b/azure-blob-storage/test/Main.hs
@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented."

From f7fea99ffed4477dfda35b50fc5e243918dac4e6 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Mon, 29 Jul 2024 11:35:09 +0530
Subject: [PATCH 02/16] Blob storage API + format codebase

---
 Makefile                                      |  6 ++
 azure-auth/Azure/Auth.hs                      | 42 +++++----
 azure-auth/Azure/Utils.hs                     |  2 +-
 azure-blob-storage/azure-blob-storage.cabal   | 21 +----
 .../src/Azure/{ => Blob}/Types.hs             | 30 +++++--
 azure-blob-storage/src/Azure/Clients.hs       | 89 +++++++++++++++++++
 azure-blob-storage/test/Main.hs               |  4 -
 azure-key-vault/Azure/Secret.hs               |  2 +-
 cabal.project                                 |  1 +
 fourmolu.yaml                                 | 18 +++-
 10 files changed, 167 insertions(+), 48 deletions(-)
 create mode 100644 Makefile
 rename azure-blob-storage/src/Azure/{ => Blob}/Types.hs (51%)
 create mode 100644 azure-blob-storage/src/Azure/Clients.hs
 delete mode 100644 azure-blob-storage/test/Main.hs

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..ff41316
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,6 @@
+SRC=$(shell find azure-auth/ azure-key-vault/ azure-blob-storage/ -type f -name '*.hs')
+
+.PHONY: format
+format: $(SRC)
+    # we use fourmolu v16
+	fourmolu --mode inplace $^
diff --git a/azure-auth/Azure/Auth.hs b/azure-auth/Azure/Auth.hs
index 3dda1e6..935bd19 100644
--- a/azure-auth/Azure/Auth.hs
+++ b/azure-auth/Azure/Auth.hs
@@ -10,24 +10,23 @@ module Azure.Auth
     , withManagedIdentityEither
     ) where
 
-import Control.Monad.IO.Class (MonadIO)
+import Control.Exception (Exception)
 import Data.Data (Proxy (..))
 import Data.Text (Text)
+import Data.Typeable (Typeable)
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import Servant.API (Get, Header', JSON, Optional, QueryParam', Required, Strict, (:>))
 import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
 import UnliftIO (MonadIO (..), throwIO)
 import UnliftIO.Environment (lookupEnv)
-import Data.Typeable (Typeable)
-import Control.Exception (Exception)
 
-import Azure.Utils (isExpired)
 import Azure.Types (AccessToken (..), Token, readToken, updateToken)
+import Azure.Utils (isExpired)
 
 import qualified Data.Text as Text
 
 {- | IMDS is a REST API that's available at a well-known, non-routable IP address ( 169.254. 169.254 ).
-It is a local-only link can only be accessed from within the VM. 
+It is a local-only link can only be accessed from within the VM.
 Communication between the VM and IMDS never leaves the host.
 -}
 imdsHost :: String
@@ -50,7 +49,6 @@ TODO: Implement other auth flows such as @withAzureCli@ and @withEnvironment@ an
         1. EnvironmentCredential
         2. Managed Identity (Only this is implemented at the moment)
         3. Azure CLI
-
 -}
 defaultAzureCredential ::
     MonadIO m =>
@@ -63,10 +61,11 @@ defaultAzureCredential ::
     m AccessToken
 defaultAzureCredential = withManagedIdentity
 
--- | Fetches an Access token for autheticating different azure services
--- All errors are thrown in IO.
---
--- For version where errors are returned in a @Left@ branch, use @withManagedIdentityEither@
+{- | Fetches an Access token for autheticating different azure services
+All errors are thrown in IO.
+
+For version where errors are returned in a @Left@ branch, use @withManagedIdentityEither@
+-}
 withManagedIdentity ::
     MonadIO m =>
     -- | ClientId
@@ -113,8 +112,11 @@ withManagedIdentityEither clientId resourceUri tokenStore = do
                 -- In case there is no existing token, we fetch a new one
                 Nothing -> do
                     newToken <- callAzureIMDSEndpoint getAzureIMDSClient resourceUri clientId (Text.pack <$> identityHeader)
-                    updateToken tokenStore (Just newToken)
-                    pure $ Right newToken
+                    case newToken of
+                        Left err -> pure . Left . TokenClientMismatch . Text.pack $ show err
+                        Right tok -> do
+                            updateToken tokenStore (Just tok)
+                            pure $ Right tok
                 Just oldToken@AccessToken{atExpiresOn} -> do
                     -- we do have a token but we should check for it's validity
                     isTokenExpired <- isExpired atExpiresOn
@@ -122,13 +124,17 @@ withManagedIdentityEither clientId resourceUri tokenStore = do
                         then do
                             -- get a new token and write to the env
                             newToken <- callAzureIMDSEndpoint getAzureIMDSClient resourceUri clientId (Text.pack <$> identityHeader)
-                            updateToken tokenStore (Just newToken)
-                            pure $ Right newToken
+                            case newToken of
+                                Left err -> pure . Left . TokenClientMismatch . Text.pack $ show err
+                                Right tok -> do
+                                    updateToken tokenStore (Just tok)
+                                    pure $ Right tok
                         else pure $ Right oldToken
 
 -- | An exception that can occur when generating an @AccessToken@
 data AccessTokenException
     = TokenEndpointNotAvailable Text
+    | TokenClientMismatch Text -- TODO: The type is misleading. This is a generic error from servant client
     deriving stock (Show, Typeable)
 
 instance Exception AccessTokenException
@@ -160,7 +166,7 @@ callAzureIMDSEndpoint ::
     Text ->
     Maybe Text ->
     Maybe Text ->
-    m AccessToken
+    m (Either Text AccessToken)
 callAzureIMDSEndpoint action resourceUri clientId identityHeader = do
     manager <- liftIO $ newManager defaultManagerSettings
     res <-
@@ -168,8 +174,8 @@ callAzureIMDSEndpoint action resourceUri clientId identityHeader = do
             runClientM
                 (action imdsApiVersion resourceUri clientId identityHeader True)
                 (mkClientEnv manager $ BaseUrl Http imdsHost 80 "")
-    case res of
+    pure $ case res of
         Left err ->
-            throwIO err
+            Left . Text.pack $ show err
         Right response ->
-            pure response
+            Right response
diff --git a/azure-auth/Azure/Utils.hs b/azure-auth/Azure/Utils.hs
index 3747719..978b969 100644
--- a/azure-auth/Azure/Utils.hs
+++ b/azure-auth/Azure/Utils.hs
@@ -6,8 +6,8 @@ import UnliftIO (MonadIO (..))
 
 import Azure.Types (ExpiresOn)
 
-import qualified Text.Read as Text
 import qualified Data.Text as Text
+import qualified Text.Read as Text
 
 {- | Check if an azure access token expiration time
 is past or < 20 seconds from current time
diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index eccb338..89e820a 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -52,29 +52,14 @@ common common-options
 
 library
     import:           common-options
-    exposed-modules:  Azure.Types
-    build-depends:    aeson
-                    , azure-auth
+    exposed-modules:  Azure.Blob.Types
+                      Azure.Clients
+    build-depends:    azure-auth
                     , bytestring
-                    , http-client
                     , http-client-tls
-                    , http-types
                     , servant
                     , servant-client
                     , text
-                    , time
                     , unliftio
     hs-source-dirs:   src
     default-language: Haskell2010
-
-test-suite azure-blob-storage-test
-    import:           common-options
-    default-language: Haskell2010
-    -- other-modules:
-    -- other-extensions:
-    type:             exitcode-stdio-1.0
-    hs-source-dirs:   test
-    main-is:          Main.hs
-    build-depends:
-        base ^>=4.7 && <5,
-        azure-blob-storage
diff --git a/azure-blob-storage/src/Azure/Types.hs b/azure-blob-storage/src/Azure/Blob/Types.hs
similarity index 51%
rename from azure-blob-storage/src/Azure/Types.hs
rename to azure-blob-storage/src/Azure/Blob/Types.hs
index 2834527..34a14d9 100644
--- a/azure-blob-storage/src/Azure/Types.hs
+++ b/azure-blob-storage/src/Azure/Blob/Types.hs
@@ -1,19 +1,20 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
 
--- Introduce blob storage functions that run in IO
-module Azure.Types
+module Azure.Blob.Types
     ( BlobName (..)
     , ContainerName (..)
     , AccountName (..)
+    , PutBlob (..)
+    , BlobType (..)
     ) where
 
-import Data.ByteString.Lazy (ByteString)
+import Data.ByteString (ByteString)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Servant.API (ToHttpApiData)
 
+import qualified Azure.Types as Auth
+
 newtype AccountName = AccountName
     { unAccountName :: Text
     }
@@ -31,3 +32,22 @@ newtype BlobName = BlobName
     }
     deriving stock (Eq, Show, Generic)
     deriving (ToHttpApiData) via Text
+
+data BlobType
+    = BlockBlob
+    | PageBlob
+    | AppendBlob
+    deriving stock (Eq, Show, Generic)
+
+{- | Adds a blob to a container.
+
+You should have appropriate (Write) permissions in order to perform this operation.
+-}
+data PutBlob = PutBlob
+    { accountName :: !AccountName
+    , containerName :: !ContainerName
+    , blobName :: !BlobName
+    , tokenStore :: !Auth.Token
+    , body :: !ByteString -- TODO: Add chunked upload
+    }
+    deriving stock (Eq, Generic)
diff --git a/azure-blob-storage/src/Azure/Clients.hs b/azure-blob-storage/src/Azure/Clients.hs
new file mode 100644
index 0000000..408e708
--- /dev/null
+++ b/azure-blob-storage/src/Azure/Clients.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Azure.Clients
+    ( putBlobObjectEither
+    , putBlobObject
+    ) where
+
+import Azure.Auth (defaultAzureCredential)
+import Azure.Blob.Types (AccountName (..), BlobName (..), BlobType (..), ContainerName (..), PutBlob (..))
+import Data.ByteString (ByteString)
+import Data.Data (Proxy (..))
+import Data.Text (Text)
+import Network.HTTP.Client.TLS (newTlsManager)
+import Servant.API
+import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
+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
+caught in a @Left@ branch, see @putBlobObjectEither@
+-}
+putBlobObject ::
+    MonadIO m =>
+    PutBlob ->
+    m ()
+putBlobObject putBlobReq = do
+    res <- liftIO $ putBlobObjectEither putBlobReq
+    case res of
+        Left err ->
+            throwString $ show err
+        Right _ ->
+            pure ()
+
+-- | Upload a blob to a Blob container
+putBlobObjectEither ::
+    MonadIO m =>
+    PutBlob ->
+    m (Either Text ())
+putBlobObjectEither putBlobreq = do
+    res <-
+        liftIO $
+            callPutBlobClient putBlobObjectApi putBlobreq
+    pure $
+        case res of
+            Right _ -> Right ()
+            Left err -> Left err
+
+-- | The following method works for all @BlobType@
+type PutBlobApi =
+    Capture "container-name" ContainerName
+        :> Capture "blob-name" BlobName
+        :> Header' '[Required, Strict] "Authorization" Text
+        :> Header' '[Required, Strict] "x-ms-version" Text
+        :> Header' '[Required, Strict] "x-ms-blob-type" Text
+        :> ReqBody '[OctetStream] ByteString
+        :> PutNoContent
+
+putBlobObjectApi :: ContainerName -> BlobName -> Text -> Text -> Text -> ByteString -> ClientM NoContent
+putBlobObjectApi = client (Proxy @PutBlobApi)
+
+callPutBlobClient ::
+    (ContainerName -> BlobName -> Text -> Text -> Text -> ByteString -> ClientM NoContent) ->
+    PutBlob ->
+    IO (Either Text ())
+callPutBlobClient action PutBlob{accountName, containerName, blobName, tokenStore, body} = do
+    Auth.AccessToken{atAccessToken} <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
+    manager <- liftIO newTlsManager
+    res <-
+        liftIO $
+            runClientM
+                (action containerName blobName ("Bearer " <> atAccessToken) "2020-04-08" (Text.pack $ show BlockBlob) body)
+                (mkClientEnv manager $ BaseUrl Https mkHostUrl 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/test/Main.hs b/azure-blob-storage/test/Main.hs
deleted file mode 100644
index 3e2059e..0000000
--- a/azure-blob-storage/test/Main.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module Main (main) where
-
-main :: IO ()
-main = putStrLn "Test suite not yet implemented."
diff --git a/azure-key-vault/Azure/Secret.hs b/azure-key-vault/Azure/Secret.hs
index 76266fe..148bb0a 100644
--- a/azure-key-vault/Azure/Secret.hs
+++ b/azure-key-vault/Azure/Secret.hs
@@ -12,11 +12,11 @@ module Azure.Secret
 import Data.Aeson (FromJSON (..), withObject, (.:))
 import Data.Data (Proxy (..))
 import Data.Text (Text)
+import GHC.Generics (Generic)
 import Network.HTTP.Client.TLS (newTlsManager)
 import Servant.API (Capture, Get, Header', JSON, QueryParam', Required, Strict, (:>))
 import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
 import UnliftIO (MonadIO (..), throwIO)
-import GHC.Generics (Generic)
 
 import Azure.Auth (defaultAzureCredential)
 import Azure.Types (AccessToken (..), Token)
diff --git a/cabal.project b/cabal.project
index 0008caf..3ac2529 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,3 +1,4 @@
 packages:
   ./azure-auth
   ./azure-key-vault
+  ./azure-blob-storage
diff --git a/fourmolu.yaml b/fourmolu.yaml
index dfccfe9..6a913d0 100644
--- a/fourmolu.yaml
+++ b/fourmolu.yaml
@@ -10,7 +10,23 @@ import-export-style: leading
 let-style: auto
 in-style: right-align
 fixities:
-  - infixl 5 .= # both in tomland (fixyty 5) and aeson (fixity 8)
+  - infixr 9 .
+  - infixl 8 .:, .:?, .=
+  - infixr 8 ?~, .~, ^?
+  - infixr 6 <>
+  - infixl 5 .=
+  - infixr 5 ++
+  - infixl 4 <$>, <$, $>, <*>, <*, *>, <**>, <<$>>, <&>
+  - infix  4 ==, /=
+  - infixr 4 :>
+  - infixl 3 <|>
+  - infixr 3 &&
+  - infixl 2 :>
+  - infixr 2 ||
+  - infixl 1 &, >>, >>=, :-
+  - infix  1 =?
+  - infixr 1 =<<, >=>, <=<
+  - infixr 0 $, $!
 unicode: never
 column-limit: none # Disclaimer: enabling column-limit breaks idempotence in a few cases.
 function-arrows: trailing

From 5e58c3744f6ac47bd2f26151070c9a7ba8c7372d Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 11:11:43 +0530
Subject: [PATCH 03/16] APIs to fetch blob object (no streaming)

---
 README.md                                     |   4 +-
 azure-blob-storage/azure-blob-storage.cabal   |   4 +-
 azure-blob-storage/src/Azure/GetBlob.hs       | 113 ++++++++++++++++++
 .../src/Azure/{Clients.hs => PutBlob.hs}      |   2 +-
 4 files changed, 119 insertions(+), 4 deletions(-)
 create mode 100644 azure-blob-storage/src/Azure/GetBlob.hs
 rename azure-blob-storage/src/Azure/{Clients.hs => PutBlob.hs} (99%)

diff --git a/README.md b/README.md
index a563fa8..3500b0f 100644
--- a/README.md
+++ b/README.md
@@ -14,10 +14,10 @@ started. Covered areas:
 
 To build the entire project, run:
 ```
-stack build
+cabal build all
 ```
 
 In order to build individual components of the library, `cd` into the package and run:
 ```
-cabal build
+cabal build -O0
 ```
diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 89e820a..be1ee4f 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -53,10 +53,12 @@ common common-options
 library
     import:           common-options
     exposed-modules:  Azure.Blob.Types
-                      Azure.Clients
+                      Azure.GetBlob
+                      Azure.PutBlob
     build-depends:    azure-auth
                     , bytestring
                     , http-client-tls
+                    , http-media
                     , servant
                     , servant-client
                     , text
diff --git a/azure-blob-storage/src/Azure/GetBlob.hs b/azure-blob-storage/src/Azure/GetBlob.hs
new file mode 100644
index 0000000..5f4223b
--- /dev/null
+++ b/azure-blob-storage/src/Azure/GetBlob.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Azure.GetBlob
+    ( getBlobObject
+    , getBlobObjectEither
+    ) where
+
+import Azure.Blob.Types (AccountName (..), BlobName (..), ContainerName (..))
+import Data.ByteString (ByteString, fromStrict, toStrict)
+import Data.Data (Proxy (..))
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Text (Text)
+import Network.HTTP.Client.TLS (newTlsManager)
+import Network.HTTP.Media (MediaType)
+import Servant.API
+import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
+import UnliftIO (MonadIO (..), throwString)
+
+import Azure.Auth (defaultAzureCredential)
+import qualified Azure.Types as Auth
+import qualified Data.Text as Text
+import GHC.Generics (Generic)
+import qualified Network.HTTP.Media as M
+
+blobStorageResourceUrl :: Text
+blobStorageResourceUrl = "https://storage.azure.com/"
+
+getBlobObject ::
+    MonadIO m =>
+    GetBlob ->
+    m ByteString
+getBlobObject getBlobReq = do
+    res <- liftIO $ getBlobObjectEither getBlobReq
+    case res of
+        Left err ->
+            throwString $ show err
+        Right r ->
+            pure r
+
+getBlobObjectEither ::
+    MonadIO m =>
+    GetBlob ->
+    m (Either Text ByteString)
+getBlobObjectEither getBlobReq = do
+    res <-
+        liftIO $
+            callGetBlobClient getBlobObjectApi getBlobReq
+    pure $
+        case res of
+            Right r -> Right r
+            Left err -> Left err
+
+data GetBlob = GetBlob
+    { accountName :: !AccountName
+    , containerName :: !ContainerName
+    , blobName :: !BlobName
+    , tokenStore :: !Auth.Token
+    }
+    deriving stock (Eq, Generic)
+
+-- | Phantom type to encapsulate the data type in servant client types
+data Blob
+
+type GetBlobApi =
+    Capture "container-name" ContainerName
+        :> Capture "blob-name" BlobName
+        :> Header' '[Required, Strict] "Authorization" Text
+        :> Header' '[Required, Strict] "x-ms-version" Text
+        :> Get '[Blob] ByteString
+
+instance Accept Blob where
+    contentTypes :: Proxy Blob -> NonEmpty MediaType
+    contentTypes _ =
+        ("text" M.// "plain" M./: ("charset", "utf-8"))
+            :| [ "application" M.// "octet-stream"
+               , "text" M.// "csv"
+               , "application" M.// "x-dbt"
+               ]
+
+instance MimeRender Blob ByteString where
+    mimeRender _ = fromStrict
+
+instance MimeUnrender Blob ByteString where
+    mimeUnrender _ = Right . toStrict
+
+getBlobObjectApi :: ContainerName -> BlobName -> Text -> Text -> ClientM ByteString
+getBlobObjectApi = client (Proxy @GetBlobApi)
+
+callGetBlobClient ::
+    (ContainerName -> BlobName -> Text -> Text -> ClientM ByteString) ->
+    GetBlob ->
+    IO (Either Text ByteString)
+callGetBlobClient action GetBlob{accountName, containerName, blobName, tokenStore} = do
+    Auth.AccessToken{atAccessToken} <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
+    manager <- liftIO newTlsManager
+    res <-
+        liftIO $
+            runClientM
+                (action containerName blobName ("Bearer " <> atAccessToken) "2020-04-08")
+                (mkClientEnv manager $ BaseUrl Https mkHostUrl 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/Clients.hs b/azure-blob-storage/src/Azure/PutBlob.hs
similarity index 99%
rename from azure-blob-storage/src/Azure/Clients.hs
rename to azure-blob-storage/src/Azure/PutBlob.hs
index 408e708..3069a1d 100644
--- a/azure-blob-storage/src/Azure/Clients.hs
+++ b/azure-blob-storage/src/Azure/PutBlob.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Azure.Clients
+module Azure.PutBlob
     ( putBlobObjectEither
     , putBlobObject
     ) where

From 664f623e9f0a4a0659922410c6e85f815c5c1abd Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 11:13:19 +0530
Subject: [PATCH 04/16] format

---
 azure-blob-storage/src/Azure/GetBlob.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/azure-blob-storage/src/Azure/GetBlob.hs b/azure-blob-storage/src/Azure/GetBlob.hs
index 5f4223b..ab8056d 100644
--- a/azure-blob-storage/src/Azure/GetBlob.hs
+++ b/azure-blob-storage/src/Azure/GetBlob.hs
@@ -11,21 +11,21 @@ module Azure.GetBlob
     , getBlobObjectEither
     ) where
 
+import Azure.Auth (defaultAzureCredential)
 import Azure.Blob.Types (AccountName (..), BlobName (..), ContainerName (..))
 import Data.ByteString (ByteString, fromStrict, toStrict)
 import Data.Data (Proxy (..))
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Text (Text)
+import GHC.Generics (Generic)
 import Network.HTTP.Client.TLS (newTlsManager)
 import Network.HTTP.Media (MediaType)
 import Servant.API
 import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
 import UnliftIO (MonadIO (..), throwString)
 
-import Azure.Auth (defaultAzureCredential)
 import qualified Azure.Types as Auth
 import qualified Data.Text as Text
-import GHC.Generics (Generic)
 import qualified Network.HTTP.Media as M
 
 blobStorageResourceUrl :: Text

From 44e22ff343b03399727738cd88cf2815a8f0b592 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 11:25:54 +0530
Subject: [PATCH 05/16] API to delete blob

---
 azure-blob-storage/azure-blob-storage.cabal |  1 +
 azure-blob-storage/src/Azure/DeleteBlob.hs  | 91 +++++++++++++++++++++
 2 files changed, 92 insertions(+)
 create mode 100644 azure-blob-storage/src/Azure/DeleteBlob.hs

diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index be1ee4f..647b525 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -54,6 +54,7 @@ library
     import:           common-options
     exposed-modules:  Azure.Blob.Types
                       Azure.GetBlob
+                      Azure.DeleteBlob
                       Azure.PutBlob
     build-depends:    azure-auth
                     , bytestring
diff --git a/azure-blob-storage/src/Azure/DeleteBlob.hs b/azure-blob-storage/src/Azure/DeleteBlob.hs
new file mode 100644
index 0000000..bbdaeae
--- /dev/null
+++ b/azure-blob-storage/src/Azure/DeleteBlob.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Azure.DeleteBlob
+    ( deleteBlobObject
+    , deleteBlobObjectEither
+    ) where
+
+import Azure.Auth (defaultAzureCredential)
+import Azure.Blob.Types (AccountName (..), BlobName (..), ContainerName (..))
+import Data.Data (Proxy (..))
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Network.HTTP.Client.TLS (newTlsManager)
+import Servant.API
+import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
+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 ->
+    m ()
+deleteBlobObject getBlobReq = do
+    res <- liftIO $ deleteBlobObjectEither getBlobReq
+    case res of
+        Left err ->
+            throwString $ show err
+        Right _ ->
+            pure ()
+
+deleteBlobObjectEither ::
+    MonadIO m =>
+    DeleteBlob ->
+    m (Either Text ())
+deleteBlobObjectEither getBlobReq = do
+    res <-
+        liftIO $
+            callDeleteBlobClient deleteBlobObjectApi getBlobReq
+    pure $
+        case res of
+            Right _ -> Right ()
+            Left err -> Left err
+
+data DeleteBlob = DeleteBlob
+    { accountName :: !AccountName
+    , containerName :: !ContainerName
+    , blobName :: !BlobName
+    , tokenStore :: !Auth.Token
+    }
+    deriving stock (Eq, Generic)
+
+type DeleteBlobApi =
+    Capture "container-name" ContainerName
+        :> Capture "blob-name" BlobName
+        :> Header' '[Required, Strict] "Authorization" Text
+        :> Header' '[Required, Strict] "x-ms-version" Text
+        :> DeleteNoContent
+
+deleteBlobObjectApi :: ContainerName -> BlobName -> Text -> Text -> ClientM NoContent
+deleteBlobObjectApi = client (Proxy @DeleteBlobApi)
+
+callDeleteBlobClient ::
+    (ContainerName -> BlobName -> Text -> Text -> ClientM NoContent) ->
+    DeleteBlob ->
+    IO (Either Text ())
+callDeleteBlobClient action DeleteBlob{accountName, containerName, blobName, tokenStore} = do
+    Auth.AccessToken{atAccessToken} <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
+    manager <- liftIO newTlsManager
+    res <-
+        liftIO $
+            runClientM
+                (action containerName blobName ("Bearer " <> atAccessToken) "2020-04-08")
+                (mkClientEnv manager $ BaseUrl Https mkHostUrl 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"

From 76d0147caf4f17ba337bfbca9da96293c9507d91 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 11:29:10 +0530
Subject: [PATCH 06/16] redundant language ext

---
 azure-blob-storage/src/Azure/DeleteBlob.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/azure-blob-storage/src/Azure/DeleteBlob.hs b/azure-blob-storage/src/Azure/DeleteBlob.hs
index bbdaeae..d755210 100644
--- a/azure-blob-storage/src/Azure/DeleteBlob.hs
+++ b/azure-blob-storage/src/Azure/DeleteBlob.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}

From 106401514d1bc8fa345b0e56f012568618a55773 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 13:41:00 +0530
Subject: [PATCH 07/16] User delegation API

---
 azure-blob-storage/azure-blob-storage.cabal   |  6 ++
 azure-blob-storage/src/Azure/Blob/Types.hs    | 87 +++++++++++++++++++
 .../src/Azure/SharedAccessSignature.hs        |  1 +
 .../src/Azure/UserDelegationKey.hs            | 75 ++++++++++++++++
 4 files changed, 169 insertions(+)
 create mode 100644 azure-blob-storage/src/Azure/SharedAccessSignature.hs
 create mode 100644 azure-blob-storage/src/Azure/UserDelegationKey.hs

diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 647b525..7019c49 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -56,13 +56,19 @@ library
                       Azure.GetBlob
                       Azure.DeleteBlob
                       Azure.PutBlob
+                      Azure.UserDelegationKey
+                      Azure.SharedAccessSignature
     build-depends:    azure-auth
+                    , aeson
                     , bytestring
                     , http-client-tls
                     , http-media
                     , servant
                     , servant-client
+                    , servant-xml ^>= 1.0.3
+                    , xmlbf
                     , text
                     , unliftio
+                    , unordered-containers
     hs-source-dirs:   src
     default-language: Haskell2010
diff --git a/azure-blob-storage/src/Azure/Blob/Types.hs b/azure-blob-storage/src/Azure/Blob/Types.hs
index 34a14d9..317741c 100644
--- a/azure-blob-storage/src/Azure/Blob/Types.hs
+++ b/azure-blob-storage/src/Azure/Blob/Types.hs
@@ -6,12 +6,18 @@ module Azure.Blob.Types
     , AccountName (..)
     , PutBlob (..)
     , BlobType (..)
+    , UserDelegationRequest (..)
+    , UserDelegationResponse (..)
     ) where
 
+import Data.Aeson (ToJSON (..), object, (.=))
 import Data.ByteString (ByteString)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Servant.API (ToHttpApiData)
+import Xmlbf (FromXml (..), ToXml (..), element, pElement, pText, text)
+
+import qualified Data.HashMap.Strict as HashMap
 
 import qualified Azure.Types as Auth
 
@@ -51,3 +57,84 @@ data PutBlob = PutBlob
     , body :: !ByteString -- TODO: Add chunked upload
     }
     deriving stock (Eq, Generic)
+
+{- | The fields are supposed to be ISO format strings
+TODO: make these UTCTime formats
+-}
+data UserDelegationRequest = UserDelegationRequest
+    { udrStartTime :: Text
+    , udrExpiryTime :: Text
+    }
+    deriving stock (Eq, Show, Generic)
+
+instance ToJSON UserDelegationRequest where
+    toJSON UserDelegationRequest{..} =
+        object
+            [ "Start" .= udrStartTime
+            , "Expiry" .= udrExpiryTime
+            ]
+
+instance ToXml UserDelegationRequest where
+    toXml UserDelegationRequest{..} =
+        element "KeyInfo" HashMap.empty $
+            element "Start" HashMap.empty (text udrStartTime)
+                <> element "Expiry" HashMap.empty (text udrExpiryTime)
+
+data UserDelegationResponse = UserDelegationResponse
+    { udrSignedKeyOid :: Text
+    , udrSignedKeyStart :: Text
+    , udrSignedKeyExpiry :: Text
+    , udrSignedKeyService :: Text
+    , udrSignedKeyVersion :: Text
+    , udrSignedKeyTid :: Text
+    -- ^ This the tenantID in which the service principle is defined
+    , udrValue :: Text
+    -- ^ User delegation key.
+    -- Note that this cannot be used to grant access to blob resource directly.
+    }
+    deriving stock (Eq, Show, Generic)
+
+instance FromXml UserDelegationResponse where
+    fromXml = pElement "UserDelegationKey" $ do
+        udrSignedKeyOid <- pElement "SignedOid" pText
+        udrSignedKeyTid <- pElement "SignedTid" pText
+        udrSignedKeyStart <- pElement "SignedStart" pText
+        udrSignedKeyExpiry <- pElement "SignedExpiry" pText
+        udrSignedKeyService <- pElement "SignedService" pText
+        udrSignedKeyVersion <- pElement "SignedVersion" pText
+        udrValue <- pElement "Value" pText
+        pure UserDelegationResponse{..}
+
+data SasPermissions
+    = SasRead
+    | SasAdd
+    | SasCreate
+    deriving stock (Eq, Show, Generic, Enum, Bounded)
+
+{-# INLINE sasPermissionsToText #-}
+
+-- | Reference: https://learn.microsoft.com/en-us/rest/api/storageservices/create-user-delegation-sas#specify-permissions
+sasPermissionsToText :: SasPermissions -> Text
+sasPermissionsToText = \case
+    SasRead -> "r"
+    SasAdd -> "a"
+    SasCreate -> "c"
+
+data SasResource
+    = SasBlob
+    | SasBlobVersion
+    | SasBlobSnapshot
+    | SasContainer
+    | SasDirectory
+    deriving stock (Eq, Show, Generic, Enum, Bounded)
+
+{-# INLINE sasResourceToText #-}
+
+-- | Reference: https://learn.microsoft.com/en-us/rest/api/storageservices/create-user-delegation-sas#specify-the-signed-resource-field
+sasResourceToText :: SasResource -> Text
+sasResourceToText = \case
+    SasBlob -> "b"
+    SasBlobVersion -> "bv"
+    SasBlobSnapshot -> "bs"
+    SasContainer -> "c"
+    SasDirectory -> "d"
diff --git a/azure-blob-storage/src/Azure/SharedAccessSignature.hs b/azure-blob-storage/src/Azure/SharedAccessSignature.hs
new file mode 100644
index 0000000..a69a17b
--- /dev/null
+++ b/azure-blob-storage/src/Azure/SharedAccessSignature.hs
@@ -0,0 +1 @@
+module Azure.SharedAccessSignature () where
diff --git a/azure-blob-storage/src/Azure/UserDelegationKey.hs b/azure-blob-storage/src/Azure/UserDelegationKey.hs
new file mode 100644
index 0000000..b624c1e
--- /dev/null
+++ b/azure-blob-storage/src/Azure/UserDelegationKey.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Azure.UserDelegationKey
+    ( callGetUserDelegationKeyApi
+    , getUserDelegationKeyApi
+    ) where
+
+import Azure.Auth (defaultAzureCredential)
+import Azure.Blob.Types
+    ( AccountName (..)
+    , UserDelegationRequest (..)
+    , UserDelegationResponse (..)
+    )
+import Data.Data (Proxy (..))
+import Data.Text (Text)
+import Network.HTTP.Client.TLS (newTlsManager)
+import Servant.API
+import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
+import Servant.XML (XML)
+import UnliftIO (MonadIO (..))
+
+import qualified Azure.Types as Auth
+import qualified Data.Text as Text
+
+blobStorageResourceUrl :: Text
+blobStorageResourceUrl = "https://storage.azure.com/"
+
+-- These type aliases always hold static values.
+-- Refer to azure docs: https://learn.microsoft.com/en-us/rest/api/storageservices/get-user-delegation-key#request
+-- for the request URI syntax
+type Comp = Text
+type Restype = Text
+
+-- Client for generating user delegation key.
+-- This is used to generate SAS tokens for pre-signed URLs
+-- in conjuntion with azure managed identity.
+type GetUserDelegationKeyApi =
+    QueryParam' '[Required, Strict] "restype" Restype
+        :> QueryParam' '[Required, Strict] "comp" Comp
+        :> Header' '[Required, Strict] "Authorization" Text
+        :> Header' '[Required, Strict] "x-ms-version" Text
+        :> ReqBody '[XML] UserDelegationRequest
+        :> Post '[XML] UserDelegationResponse
+
+getUserDelegationKeyApi :: Restype -> Comp -> Text -> Text -> UserDelegationRequest -> ClientM UserDelegationResponse
+getUserDelegationKeyApi = client (Proxy @GetUserDelegationKeyApi)
+
+callGetUserDelegationKeyApi ::
+    (Restype -> Comp -> Text -> Text -> UserDelegationRequest -> ClientM UserDelegationResponse) ->
+    AccountName ->
+    Auth.Token ->
+    UserDelegationRequest ->
+    IO (Either Text UserDelegationResponse)
+callGetUserDelegationKeyApi action accountName tokenStore req = do
+    manager <- liftIO newTlsManager
+    Auth.AccessToken{atAccessToken} <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
+    res <-
+        liftIO $
+            runClientM
+                (action showResType showComp ("Bearer " <> atAccessToken) "2022-11-02" req)
+                (mkClientEnv manager $ BaseUrl Https mkHostUrl 443 "")
+    pure $ case res of
+        -- TODO: this should actually log the error
+        Left err ->
+            Left . Text.pack $ show err
+        Right resp ->
+            Right resp
+  where
+    showComp = "userdelegationkey"
+    showResType = "service"
+    mkHostUrl = Text.unpack (unAccountName accountName) <> ".blob.core.windows.net"

From ccbf0adbf7a957b77a3dd062407f360fd453cba3 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 14:07:48 +0530
Subject: [PATCH 08/16] Shared Access Signature

---
 azure-blob-storage/azure-blob-storage.cabal   |   1 +
 azure-blob-storage/src/Azure/Blob/Types.hs    |  17 +++
 .../src/Azure/SharedAccessSignature.hs        | 144 +++++++++++++++++-
 .../src/Azure/UserDelegationKey.hs            |   9 +-
 4 files changed, 163 insertions(+), 8 deletions(-)

diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 7019c49..70a67e7 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -68,6 +68,7 @@ library
                     , servant-xml ^>= 1.0.3
                     , xmlbf
                     , text
+                    , time
                     , unliftio
                     , unordered-containers
     hs-source-dirs:   src
diff --git a/azure-blob-storage/src/Azure/Blob/Types.hs b/azure-blob-storage/src/Azure/Blob/Types.hs
index 317741c..fc9d653 100644
--- a/azure-blob-storage/src/Azure/Blob/Types.hs
+++ b/azure-blob-storage/src/Azure/Blob/Types.hs
@@ -8,6 +8,12 @@ module Azure.Blob.Types
     , BlobType (..)
     , UserDelegationRequest (..)
     , UserDelegationResponse (..)
+    , SasTokenExpiry (..)
+    , Url (..)
+    , SasPermissions (..)
+    , sasPermissionsToText
+    , SasResource (..)
+    , sasResourceToText
     ) where
 
 import Data.Aeson (ToJSON (..), object, (.=))
@@ -105,6 +111,17 @@ instance FromXml UserDelegationResponse where
         udrValue <- pElement "Value" pText
         pure UserDelegationResponse{..}
 
+-- | Newtype for an url that can be fetched directly
+newtype Url = Url
+    { unUrl :: Text
+    }
+    deriving stock (Eq, Show, Generic)
+
+-- | For an azure action to be turned into a signed url
+newtype SasTokenExpiry = SasTokenExpiry
+    { unSasTokenExpiry :: Int
+    }
+
 data SasPermissions
     = SasRead
     | SasAdd
diff --git a/azure-blob-storage/src/Azure/SharedAccessSignature.hs b/azure-blob-storage/src/Azure/SharedAccessSignature.hs
index a69a17b..1286c5f 100644
--- a/azure-blob-storage/src/Azure/SharedAccessSignature.hs
+++ b/azure-blob-storage/src/Azure/SharedAccessSignature.hs
@@ -1 +1,143 @@
-module Azure.SharedAccessSignature () where
+module Azure.SharedAccessSignature
+    ( generateSas
+    ) where
+
+import Azure.Auth (defaultAzureCredential)
+import Azure.Blob.Types
+    ( AccountName (..)
+    , BlobName (..)
+    , ContainerName (..)
+    , SasPermissions (..)
+    , SasResource (..)
+    , SasTokenExpiry (..)
+    , Url (..)
+    , UserDelegationRequest (..)
+    , UserDelegationResponse (..)
+    , sasPermissionsToText
+    , sasResourceToText
+    )
+import Azure.UserDelegationKey (callGetUserDelegationKeyApi, getUserDelegationKeyApi)
+import Data.Text (Text)
+import Data.Time (UTCTime (..), addUTCTime, formatTime, getCurrentTime)
+import Data.Time.Format (defaultTimeLocale)
+import UnliftIO (MonadIO (..))
+
+import qualified Azure.Types as Auth
+import qualified Data.Text as Text
+
+blobStorageResourceUrl :: Text
+blobStorageResourceUrl = "https://storage.azure.com/"
+
+generateSas ::
+    MonadIO m =>
+    AccountName ->
+    ContainerName ->
+    BlobName ->
+    SasTokenExpiry ->
+    Auth.Token ->
+    m (Either Text Url)
+generateSas accountName containerName blobName (SasTokenExpiry expiry) tokenStore = do
+    accessToken <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
+    now <- liftIO getCurrentTime
+    let isoStartTime = formatToAzureTime now
+        isoExpiryTime = formatToAzureTime (addUTCTime (fromIntegral expiry) now)
+    userDelgationKey <-
+        liftIO $
+            callGetUserDelegationKeyApi getUserDelegationKeyApi accountName accessToken (UserDelegationRequest isoStartTime isoExpiryTime)
+    pure $ case userDelgationKey of
+        Left err -> Left err
+        Right UserDelegationResponse{..} -> do
+            let canonicalizedResource =
+                    "/blob/"
+                        <> unAccountName accountName
+                        <> "/"
+                        <> unContainerName containerName
+                        <> "/"
+                        <> unBlobName blobName
+                -- Source: https://learn.microsoft.com/en-us/rest/api/storageservices/create-user-delegation-sas#version-2020-12-06-and-later
+                stringToSign =
+                    sasPermissionsToText SasRead -- signedPermissions
+                        <> "\n"
+                        <> isoStartTime -- signedStart
+                        <> "\n"
+                        <> isoExpiryTime -- signedExpiry
+                        <> "\n"
+                        <> canonicalizedResource -- canonicalizedResource
+                        <> "\n"
+                        <> udrSignedKeyOid -- signedKeyObjectId
+                        <> "\n"
+                        <> udrSignedKeyTid -- signedKeyTenantId
+                        <> "\n"
+                        <> udrSignedKeyStart -- signedKeyStart
+                        <> "\n"
+                        <> udrSignedKeyExpiry -- signedKeyExpiry
+                        <> "\n"
+                        <> udrSignedKeyService -- signedKeyService
+                        <> "\n"
+                        <> udrSignedKeyVersion -- signedKeyVersion
+                        <> "\n"
+                        <> "" -- signedAuthorizedUserObjectId
+                        <> "\n"
+                        <> "" -- signedUnauthorizedUserObjectId
+                        <> "\n"
+                        <> "" -- signedCorrelationId
+                        <> "\n"
+                        <> "" -- signedIP
+                        <> "\n"
+                        <> "https" -- signedProtocol
+                        <> "\n"
+                        <> "2022-11-02" -- signedVersion
+                        <> "\n"
+                        <> sasResourceToText SasBlob -- signedResource
+                        <> "\n"
+                        <> "" -- signedSnapshotTime
+                        <> "\n"
+                        <> "" -- signedEncryptionScope
+                        <> "\n"
+                        <> "" -- rscc
+                        <> "\n"
+                        <> "" -- rscd
+                        <> "\n"
+                        <> "" -- rsce
+                        <> "\n"
+                        <> "" -- rscl
+                        <> "\n"
+                        <> "" -- rsct
+            let sig = buildSignature stringToSign udrValue
+            Right
+                . Url
+                $ "https://"
+                    <> unAccountName accountName
+                    <> ".blob.core.windows.net/"
+                    <> unContainerName containerName
+                    <> "/"
+                    <> unBlobName blobName
+                    <> "?sp="
+                    <> sasPermissionsToText SasRead
+                    <> "&st="
+                    <> isoStartTime
+                    <> "&se="
+                    <> isoExpiryTime
+                    <> "&skoid="
+                    <> udrSignedKeyOid
+                    <> "&sktid="
+                    <> udrSignedKeyTid
+                    <> "&skt="
+                    <> udrSignedKeyStart
+                    <> "&ske="
+                    <> udrSignedKeyExpiry
+                    <> "&sks="
+                    <> udrSignedKeyService
+                    <> "&skv="
+                    <> udrSignedKeyVersion
+                    <> "&sv=2022-11-02"
+                    <> "&spr=https"
+                    <> "&sr="
+                    <> sasResourceToText SasBlob
+                    <> "&sig="
+                    <> decodeUtf8 (urlEncode True $ encodeUtf8 sig)
+  where
+    -- Date time formatting rules for azure:
+    -- https://learn.microsoft.com/en-us/rest/api/storageservices/formatting-datetime-values
+    formatToAzureTime :: UTCTime -> Text
+    formatToAzureTime time = Text.pack $ formatTime defaultTimeLocale "%FT%TZ" time
diff --git a/azure-blob-storage/src/Azure/UserDelegationKey.hs b/azure-blob-storage/src/Azure/UserDelegationKey.hs
index b624c1e..b787a8a 100644
--- a/azure-blob-storage/src/Azure/UserDelegationKey.hs
+++ b/azure-blob-storage/src/Azure/UserDelegationKey.hs
@@ -9,7 +9,6 @@ module Azure.UserDelegationKey
     , getUserDelegationKeyApi
     ) where
 
-import Azure.Auth (defaultAzureCredential)
 import Azure.Blob.Types
     ( AccountName (..)
     , UserDelegationRequest (..)
@@ -26,9 +25,6 @@ import UnliftIO (MonadIO (..))
 import qualified Azure.Types as Auth
 import qualified Data.Text as Text
 
-blobStorageResourceUrl :: Text
-blobStorageResourceUrl = "https://storage.azure.com/"
-
 -- These type aliases always hold static values.
 -- Refer to azure docs: https://learn.microsoft.com/en-us/rest/api/storageservices/get-user-delegation-key#request
 -- for the request URI syntax
@@ -52,12 +48,11 @@ getUserDelegationKeyApi = client (Proxy @GetUserDelegationKeyApi)
 callGetUserDelegationKeyApi ::
     (Restype -> Comp -> Text -> Text -> UserDelegationRequest -> ClientM UserDelegationResponse) ->
     AccountName ->
-    Auth.Token ->
+    Auth.AccessToken ->
     UserDelegationRequest ->
     IO (Either Text UserDelegationResponse)
-callGetUserDelegationKeyApi action accountName tokenStore req = do
+callGetUserDelegationKeyApi action accountName Auth.AccessToken{atAccessToken} req = do
     manager <- liftIO newTlsManager
-    Auth.AccessToken{atAccessToken} <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
     res <-
         liftIO $
             runClientM

From 9cebcb83507ee351a34e2055d2897ad16beb7723 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 22:45:54 +0530
Subject: [PATCH 09/16] build signature utility

---
 azure-blob-storage/azure-blob-storage.cabal      |  3 +++
 .../src/Azure/SharedAccessSignature.hs           | 16 ++++++++++++++++
 .../src/Azure/UserDelegationKey.hs               |  1 -
 3 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 70a67e7..3e1c025 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -60,9 +60,12 @@ library
                       Azure.SharedAccessSignature
     build-depends:    azure-auth
                     , aeson
+                    , base64-bytestring
                     , bytestring
+                    , cryptohash-sha256
                     , http-client-tls
                     , http-media
+                    , http-types
                     , servant
                     , servant-client
                     , servant-xml ^>= 1.0.3
diff --git a/azure-blob-storage/src/Azure/SharedAccessSignature.hs b/azure-blob-storage/src/Azure/SharedAccessSignature.hs
index 1286c5f..4b7dcf8 100644
--- a/azure-blob-storage/src/Azure/SharedAccessSignature.hs
+++ b/azure-blob-storage/src/Azure/SharedAccessSignature.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 module Azure.SharedAccessSignature
     ( generateSas
     ) where
@@ -17,12 +20,17 @@ import Azure.Blob.Types
     , sasResourceToText
     )
 import Azure.UserDelegationKey (callGetUserDelegationKeyApi, getUserDelegationKeyApi)
+import Crypto.Hash.SHA256 (hmac)
 import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Time (UTCTime (..), addUTCTime, formatTime, getCurrentTime)
 import Data.Time.Format (defaultTimeLocale)
+import Network.HTTP.Types.URI (urlEncode)
 import UnliftIO (MonadIO (..))
 
 import qualified Azure.Types as Auth
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
 import qualified Data.Text as Text
 
 blobStorageResourceUrl :: Text
@@ -141,3 +149,11 @@ generateSas accountName containerName blobName (SasTokenExpiry expiry) tokenStor
     -- https://learn.microsoft.com/en-us/rest/api/storageservices/formatting-datetime-values
     formatToAzureTime :: UTCTime -> Text
     formatToAzureTime time = Text.pack $ formatTime defaultTimeLocale "%FT%TZ" time
+
+    buildSignature :: Text -> Text -> Text
+    buildSignature stringToSign secret =
+        let decodedSecret = B64.decodeLenient (C8.pack (Text.unpack secret))
+            encodedStringToSign = C8.pack (Text.unpack stringToSign)
+            hashedBytes = hmac decodedSecret encodedStringToSign
+            encodedSignature = B64.encode hashedBytes
+         in decodeUtf8 encodedSignature
diff --git a/azure-blob-storage/src/Azure/UserDelegationKey.hs b/azure-blob-storage/src/Azure/UserDelegationKey.hs
index b787a8a..5197ab8 100644
--- a/azure-blob-storage/src/Azure/UserDelegationKey.hs
+++ b/azure-blob-storage/src/Azure/UserDelegationKey.hs
@@ -59,7 +59,6 @@ callGetUserDelegationKeyApi action accountName Auth.AccessToken{atAccessToken} r
                 (action showResType showComp ("Bearer " <> atAccessToken) "2022-11-02" req)
                 (mkClientEnv manager $ BaseUrl Https mkHostUrl 443 "")
     pure $ case res of
-        -- TODO: this should actually log the error
         Left err ->
             Left . Text.pack $ show err
         Right resp ->

From 86bf0f75b83a947cb31dc384cf1d2e7dc70401c3 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 22:49:57 +0530
Subject: [PATCH 10/16] Regenerate haskell-ci

---
 .github/workflows/haskell-ci.yml | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
index 4af49e3..dc41834 100644
--- a/.github/workflows/haskell-ci.yml
+++ b/.github/workflows/haskell-ci.yml
@@ -146,6 +146,7 @@ jobs:
           touch cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/./azure-auth" >> cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/./azure-key-vault" >> cabal.project
+          echo "packages: $GITHUB_WORKSPACE/source/./azure-blob-storage" >> cabal.project
           cat cabal.project
       - name: sdist
         run: |
@@ -161,18 +162,23 @@ jobs:
           echo "PKGDIR_azure_auth=${PKGDIR_azure_auth}" >> "$GITHUB_ENV"
           PKGDIR_azure_key_vault="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/azure-key-vault-[0-9.]*')"
           echo "PKGDIR_azure_key_vault=${PKGDIR_azure_key_vault}" >> "$GITHUB_ENV"
+          PKGDIR_azure_blob_storage="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/azure-blob-storage-[0-9.]*')"
+          echo "PKGDIR_azure_blob_storage=${PKGDIR_azure_blob_storage}" >> "$GITHUB_ENV"
           rm -f cabal.project cabal.project.local
           touch cabal.project
           touch cabal.project.local
           echo "packages: ${PKGDIR_azure_auth}" >> cabal.project
           echo "packages: ${PKGDIR_azure_key_vault}" >> cabal.project
+          echo "packages: ${PKGDIR_azure_blob_storage}" >> cabal.project
           echo "package azure-auth" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           echo "package azure-key-vault" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
+          echo "package azure-blob-storage" >> cabal.project
+          echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           cat >> cabal.project <<EOF
           EOF
-          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(azure-auth|azure-key-vault)$/; }' >> cabal.project.local
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(azure-auth|azure-blob-storage|azure-key-vault)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local
       - name: dump install plan
@@ -195,15 +201,14 @@ jobs:
       - name: build
         run: |
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
-      - name: tests
-        run: |
-          $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
       - name: cabal check
         run: |
           cd ${PKGDIR_azure_auth} || false
           ${CABAL} -vnormal check
           cd ${PKGDIR_azure_key_vault} || false
           ${CABAL} -vnormal check
+          cd ${PKGDIR_azure_blob_storage} || false
+          ${CABAL} -vnormal check
       - name: haddock
         run: |
           $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

From 78bdf69d298f112020002e0aa23db0fc02dba620 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sat, 3 Aug 2024 23:10:43 +0530
Subject: [PATCH 11/16] drop 9.0.2

---
 .github/workflows/haskell-ci.yml            | 5 -----
 azure-auth/azure-auth.cabal                 | 3 +--
 azure-blob-storage/azure-blob-storage.cabal | 3 +--
 azure-key-vault/azure-key-vault.cabal       | 3 +--
 4 files changed, 3 insertions(+), 11 deletions(-)

diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
index dc41834..31b6797 100644
--- a/.github/workflows/haskell-ci.yml
+++ b/.github/workflows/haskell-ci.yml
@@ -48,11 +48,6 @@ jobs:
             compilerVersion: 9.2.8
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.0.2
-            compilerKind: ghc
-            compilerVersion: 9.0.2
-            setup-method: ghcup
-            allow-failure: false
       fail-fast: false
     steps:
       - name: apt
diff --git a/azure-auth/azure-auth.cabal b/azure-auth/azure-auth.cabal
index fefc1f2..a3ddf5d 100644
--- a/azure-auth/azure-auth.cabal
+++ b/azure-auth/azure-auth.cabal
@@ -10,8 +10,7 @@ maintainer:         tech@holmusk.com
 category:           Azure
 build-type:         Simple
 extra-doc-files:    CHANGELOG.md
-tested-with:        GHC == 9.0.2
-                    GHC == 9.2.8
+tested-with:        GHC == 9.2.8
                     GHC == 9.4.8
                     GHC == 9.6.3
                     GHC == 9.8.2
diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 3e1c025..81c55f2 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -11,8 +11,7 @@ maintainer:         tech@holmusk.com
 category:           Azure
 build-type:         Simple
 extra-doc-files:    CHANGELOG.md
-tested-with:        GHC == 9.0.2
-                    GHC == 9.2.8
+tested-with:        GHC == 9.2.8
                     GHC == 9.4.8
                     GHC == 9.6.3
                     GHC == 9.8.2
diff --git a/azure-key-vault/azure-key-vault.cabal b/azure-key-vault/azure-key-vault.cabal
index 01fd1f1..5580613 100644
--- a/azure-key-vault/azure-key-vault.cabal
+++ b/azure-key-vault/azure-key-vault.cabal
@@ -11,8 +11,7 @@ maintainer:         tech@holmusk.com
 category:           Azure
 build-type:         Simple
 extra-doc-files:    CHANGELOG.md
-tested-with:        GHC == 9.0.2
-                    GHC == 9.2.8
+tested-with:        GHC == 9.2.8
                     GHC == 9.4.8
                     GHC == 9.6.3
                     GHC == 9.8.2

From c0bea6ab8e84d3dd536efd26c4a5af304fa3f40a Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sun, 4 Aug 2024 13:12:43 +0530
Subject: [PATCH 12/16] restructure modules

---
 azure-blob-storage/azure-blob-storage.cabal   | 13 +++++----
 azure-blob-storage/src/Azure/Blob.hs          | 28 +++++++++++++++++++
 .../src/Azure/{ => Blob}/DeleteBlob.hs        |  2 +-
 .../src/Azure/{ => Blob}/GetBlob.hs           |  5 +++-
 .../src/Azure/{ => Blob}/PutBlob.hs           |  2 +-
 .../Azure/{ => Blob}/SharedAccessSignature.hs |  5 ++--
 .../src/Azure/{ => Blob}/UserDelegationKey.hs |  2 +-
 7 files changed, 45 insertions(+), 12 deletions(-)
 create mode 100644 azure-blob-storage/src/Azure/Blob.hs
 rename azure-blob-storage/src/Azure/{ => Blob}/DeleteBlob.hs (98%)
 rename azure-blob-storage/src/Azure/{ => Blob}/GetBlob.hs (95%)
 rename azure-blob-storage/src/Azure/{ => Blob}/PutBlob.hs (99%)
 rename azure-blob-storage/src/Azure/{ => Blob}/SharedAccessSignature.hs (96%)
 rename azure-blob-storage/src/Azure/{ => Blob}/UserDelegationKey.hs (98%)

diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 81c55f2..81b9160 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -51,12 +51,13 @@ common common-options
 
 library
     import:           common-options
-    exposed-modules:  Azure.Blob.Types
-                      Azure.GetBlob
-                      Azure.DeleteBlob
-                      Azure.PutBlob
-                      Azure.UserDelegationKey
-                      Azure.SharedAccessSignature
+    exposed-modules:  Azure.Blob
+                      Azure.Blob.GetBlob
+                      Azure.Blob.DeleteBlob
+                      Azure.Blob.Types
+                      Azure.Blob.UserDelegationKey
+                      Azure.Blob.PutBlob
+                      Azure.Blob.SharedAccessSignature
     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
new file mode 100644
index 0000000..287bac3
--- /dev/null
+++ b/azure-blob-storage/src/Azure/Blob.hs
@@ -0,0 +1,28 @@
+module Azure.Blob
+    (
+    -- ** Variants to fetch a blob object
+      getBlobObject
+    , getBlobObjectEither
+
+    -- ** Variants to upload a blob to Blob storage
+    , putBlobObject
+    , putBlobObjectEither
+
+    -- ** Variants for deleting a blob object
+    , deleteBlobObject
+    , deleteBlobObjectEither
+
+    -- ** Generating a Shared Access Signature URI
+    , generateSas
+
+    -- ** 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.SharedAccessSignature
+import Azure.Blob.Types
diff --git a/azure-blob-storage/src/Azure/DeleteBlob.hs b/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs
similarity index 98%
rename from azure-blob-storage/src/Azure/DeleteBlob.hs
rename to azure-blob-storage/src/Azure/Blob/DeleteBlob.hs
index d755210..e5abd11 100644
--- a/azure-blob-storage/src/Azure/DeleteBlob.hs
+++ b/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Azure.DeleteBlob
+module Azure.Blob.DeleteBlob
     ( deleteBlobObject
     , deleteBlobObjectEither
     ) where
diff --git a/azure-blob-storage/src/Azure/GetBlob.hs b/azure-blob-storage/src/Azure/Blob/GetBlob.hs
similarity index 95%
rename from azure-blob-storage/src/Azure/GetBlob.hs
rename to azure-blob-storage/src/Azure/Blob/GetBlob.hs
index ab8056d..5593493 100644
--- a/azure-blob-storage/src/Azure/GetBlob.hs
+++ b/azure-blob-storage/src/Azure/Blob/GetBlob.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Azure.GetBlob
+module Azure.Blob.GetBlob
     ( getBlobObject
     , getBlobObjectEither
     ) where
@@ -74,6 +74,9 @@ type GetBlobApi =
         :> Header' '[Required, Strict] "x-ms-version" Text
         :> Get '[Blob] ByteString
 
+-- TODO: this is more of a test at the moment.
+-- GET endpoint should accept any blob that is available and not just
+-- rely on certain mime types
 instance Accept Blob where
     contentTypes :: Proxy Blob -> NonEmpty MediaType
     contentTypes _ =
diff --git a/azure-blob-storage/src/Azure/PutBlob.hs b/azure-blob-storage/src/Azure/Blob/PutBlob.hs
similarity index 99%
rename from azure-blob-storage/src/Azure/PutBlob.hs
rename to azure-blob-storage/src/Azure/Blob/PutBlob.hs
index 3069a1d..32e6381 100644
--- a/azure-blob-storage/src/Azure/PutBlob.hs
+++ b/azure-blob-storage/src/Azure/Blob/PutBlob.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Azure.PutBlob
+module Azure.Blob.PutBlob
     ( putBlobObjectEither
     , putBlobObject
     ) where
diff --git a/azure-blob-storage/src/Azure/SharedAccessSignature.hs b/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs
similarity index 96%
rename from azure-blob-storage/src/Azure/SharedAccessSignature.hs
rename to azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs
index 4b7dcf8..cba27cd 100644
--- a/azure-blob-storage/src/Azure/SharedAccessSignature.hs
+++ b/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
-module Azure.SharedAccessSignature
+module Azure.Blob.SharedAccessSignature
     ( generateSas
     ) where
 
@@ -19,7 +19,7 @@ import Azure.Blob.Types
     , sasPermissionsToText
     , sasResourceToText
     )
-import Azure.UserDelegationKey (callGetUserDelegationKeyApi, getUserDelegationKeyApi)
+import Azure.Blob.UserDelegationKey (callGetUserDelegationKeyApi, getUserDelegationKeyApi)
 import Crypto.Hash.SHA256 (hmac)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
@@ -36,6 +36,7 @@ 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 =>
     AccountName ->
diff --git a/azure-blob-storage/src/Azure/UserDelegationKey.hs b/azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs
similarity index 98%
rename from azure-blob-storage/src/Azure/UserDelegationKey.hs
rename to azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs
index 5197ab8..805e63c 100644
--- a/azure-blob-storage/src/Azure/UserDelegationKey.hs
+++ b/azure-blob-storage/src/Azure/Blob/UserDelegationKey.hs
@@ -4,7 +4,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Azure.UserDelegationKey
+module Azure.Blob.UserDelegationKey
     ( callGetUserDelegationKeyApi
     , getUserDelegationKeyApi
     ) where

From d30d752badde332bf81eafb4e429dfac7f2afe77 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sun, 4 Aug 2024 18:17:23 +0530
Subject: [PATCH 13/16] Nicities

---
 azure-blob-storage/azure-blob-storage.cabal       |  7 ++++---
 azure-blob-storage/src/Azure/Blob.hs              | 15 +++++++--------
 azure-blob-storage/src/Azure/Blob/DeleteBlob.hs   |  8 ++------
 azure-blob-storage/src/Azure/Blob/GetBlob.hs      |  8 ++------
 azure-blob-storage/src/Azure/Blob/PutBlob.hs      | 10 +++-------
 .../src/Azure/Blob/SharedAccessSignature.hs       |  4 +---
 .../src/Azure/Blob/UserDelegationKey.hs           |  4 ++--
 azure-blob-storage/src/Azure/Blob/Utils.hs        | 15 +++++++++++++++
 8 files changed, 36 insertions(+), 35 deletions(-)
 create mode 100644 azure-blob-storage/src/Azure/Blob/Utils.hs

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"

From 1c3c423e72fa0065efa2f57ccbe2eaaf26b46bac Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sun, 4 Aug 2024 18:20:02 +0530
Subject: [PATCH 14/16] haskell ci dist

---
 cabal.haskell-ci | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 cabal.haskell-ci

diff --git a/cabal.haskell-ci b/cabal.haskell-ci
new file mode 100644
index 0000000..20c4040
--- /dev/null
+++ b/cabal.haskell-ci
@@ -0,0 +1 @@
+distribution: jammy

From d88eeda4ca4bb633199d1d389faa8efd37b7cf34 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sun, 18 Aug 2024 20:13:36 +0530
Subject: [PATCH 15/16] variant with either

---
 azure-blob-storage/src/Azure/Blob.hs          |  1 +
 .../src/Azure/Blob/SharedAccessSignature.hs   | 23 ++++++++++++++++---
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/azure-blob-storage/src/Azure/Blob.hs b/azure-blob-storage/src/Azure/Blob.hs
index b013f1d..da51cd1 100644
--- a/azure-blob-storage/src/Azure/Blob.hs
+++ b/azure-blob-storage/src/Azure/Blob.hs
@@ -13,6 +13,7 @@ module Azure.Blob
 
       -- ** Generating a Shared Access Signature URI
     , generateSas
+    , generateSasEither
 
       -- ** Types for dealing with Blob storage functions
     , AccountName (..)
diff --git a/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs b/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs
index 83d6009..929fd39 100644
--- a/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs
+++ b/azure-blob-storage/src/Azure/Blob/SharedAccessSignature.hs
@@ -3,6 +3,7 @@
 
 module Azure.Blob.SharedAccessSignature
     ( generateSas
+    , generateSasEither
     ) where
 
 import Azure.Auth (defaultAzureCredential)
@@ -27,15 +28,31 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Time (UTCTime (..), addUTCTime, formatTime, getCurrentTime)
 import Data.Time.Format (defaultTimeLocale)
 import Network.HTTP.Types.URI (urlEncode)
-import UnliftIO (MonadIO (..))
+import UnliftIO (MonadIO (..), throwString)
 
 import qualified Azure.Types as Auth
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C8
 import qualified Data.Text as Text
 
--- TODO: We need to add support for empty fields here. Eg: signedAuthorizedUserObjectId
 generateSas ::
+    MonadIO m =>
+    AccountName ->
+    ContainerName ->
+    BlobName ->
+    SasTokenExpiry ->
+    Auth.Token ->
+    m Url
+generateSas accountName containerName blobName expiry tokenStore = do
+    eUrl <- liftIO $ generateSasEither accountName containerName blobName expiry tokenStore
+    case eUrl of
+        Left err ->
+            throwString $ show err
+        Right url ->
+            pure url
+
+-- TODO: We need to add support for empty fields here. Eg: signedAuthorizedUserObjectId
+generateSasEither ::
     MonadIO m =>
     AccountName ->
     ContainerName ->
@@ -43,7 +60,7 @@ generateSas ::
     SasTokenExpiry ->
     Auth.Token ->
     m (Either Text Url)
-generateSas accountName containerName blobName (SasTokenExpiry expiry) tokenStore = do
+generateSasEither accountName containerName blobName (SasTokenExpiry expiry) tokenStore = do
     accessToken <- liftIO $ defaultAzureCredential Nothing blobStorageResourceUrl tokenStore
     now <- liftIO getCurrentTime
     let isoStartTime = formatToAzureTime now

From 6d45c9f0e8ca8f9ebb57bf37d07b24431307f374 Mon Sep 17 00:00:00 2001
From: Nitin Prakash <prakash.nitin63@gmail.com>
Date: Sun, 18 Aug 2024 23:01:25 +0530
Subject: [PATCH 16/16] API fixes + remove top level export

---
 azure-blob-storage/azure-blob-storage.cabal   |  3 +-
 azure-blob-storage/src/Azure/Blob.hs          | 28 ------------
 .../src/Azure/Blob/DeleteBlob.hs              | 17 ++++----
 azure-blob-storage/src/Azure/Blob/GetBlob.hs  | 43 +++++++++++--------
 azure-blob-storage/src/Azure/Blob/PutBlob.hs  | 18 +++++++-
 azure-blob-storage/src/Azure/Blob/Types.hs    | 17 --------
 6 files changed, 52 insertions(+), 74 deletions(-)
 delete mode 100644 azure-blob-storage/src/Azure/Blob.hs

diff --git a/azure-blob-storage/azure-blob-storage.cabal b/azure-blob-storage/azure-blob-storage.cabal
index 6b96bb2..c9c64c7 100644
--- a/azure-blob-storage/azure-blob-storage.cabal
+++ b/azure-blob-storage/azure-blob-storage.cabal
@@ -51,8 +51,7 @@ common common-options
 
 library
     import:           common-options
-    exposed-modules:  Azure.Blob
-                      Azure.Blob.DeleteBlob
+    exposed-modules:  Azure.Blob.DeleteBlob
                       Azure.Blob.GetBlob
                       Azure.Blob.PutBlob
                       Azure.Blob.Types
diff --git a/azure-blob-storage/src/Azure/Blob.hs b/azure-blob-storage/src/Azure/Blob.hs
deleted file mode 100644
index da51cd1..0000000
--- a/azure-blob-storage/src/Azure/Blob.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module Azure.Blob
-    ( -- ** Variants to fetch a blob object
-      getBlobObject
-    , getBlobObjectEither
-
-      -- ** Variants to upload a blob to Blob storage
-    , putBlobObject
-    , putBlobObjectEither
-
-      -- ** Variants for deleting a blob object
-    , deleteBlobObject
-    , deleteBlobObjectEither
-
-      -- ** Generating a Shared Access Signature URI
-    , generateSas
-    , generateSasEither
-
-      -- ** Types for dealing with Blob storage functions
-    , AccountName (..)
-    , ContainerName (..)
-    , BlobName (..)
-    ) where
-
-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 e00cc07..7525347 100644
--- a/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs
+++ b/azure-blob-storage/src/Azure/Blob/DeleteBlob.hs
@@ -8,6 +8,7 @@
 module Azure.Blob.DeleteBlob
     ( deleteBlobObject
     , deleteBlobObjectEither
+    , DeleteBlob (..)
     ) where
 
 import Azure.Auth (defaultAzureCredential)
@@ -24,6 +25,14 @@ import UnliftIO (MonadIO (..), throwString)
 import qualified Azure.Types as Auth
 import qualified Data.Text as Text
 
+data DeleteBlob = DeleteBlob
+    { accountName :: !AccountName
+    , containerName :: !ContainerName
+    , blobName :: !BlobName
+    , tokenStore :: !Auth.Token
+    }
+    deriving stock (Eq, Generic)
+
 deleteBlobObject ::
     MonadIO m =>
     DeleteBlob ->
@@ -49,14 +58,6 @@ deleteBlobObjectEither getBlobReq = do
             Right _ -> Right ()
             Left err -> Left err
 
-data DeleteBlob = DeleteBlob
-    { accountName :: !AccountName
-    , containerName :: !ContainerName
-    , blobName :: !BlobName
-    , tokenStore :: !Auth.Token
-    }
-    deriving stock (Eq, Generic)
-
 type DeleteBlobApi =
     Capture "container-name" ContainerName
         :> Capture "blob-name" BlobName
diff --git a/azure-blob-storage/src/Azure/Blob/GetBlob.hs b/azure-blob-storage/src/Azure/Blob/GetBlob.hs
index 11abafb..1710b81 100644
--- a/azure-blob-storage/src/Azure/Blob/GetBlob.hs
+++ b/azure-blob-storage/src/Azure/Blob/GetBlob.hs
@@ -9,10 +9,12 @@
 module Azure.Blob.GetBlob
     ( getBlobObject
     , getBlobObjectEither
+    , GetBlob (..)
     ) where
 
 import Azure.Auth (defaultAzureCredential)
 import Azure.Blob.Types (AccountName (..), BlobName (..), ContainerName (..))
+import Azure.Blob.Utils (blobStorageResourceUrl, mkBlobHostUrl)
 import Data.ByteString (ByteString, fromStrict, toStrict)
 import Data.Data (Proxy (..))
 import Data.List.NonEmpty (NonEmpty ((:|)))
@@ -24,17 +26,26 @@ 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.ByteString.Lazy as LBS
 import qualified Data.Text as Text
 import qualified Network.HTTP.Media as M
 
+data GetBlob = GetBlob
+    { accountName :: !AccountName
+    , containerName :: !ContainerName
+    , blobName :: !BlobName
+    , tokenStore :: !Auth.Token
+    }
+    deriving stock (Eq, Generic)
+
 getBlobObject ::
     MonadIO m =>
     GetBlob ->
-    m ByteString
-getBlobObject getBlobReq = do
-    res <- liftIO $ getBlobObjectEither getBlobReq
+    FilePath ->
+    m ()
+getBlobObject getBlobReq fp = do
+    res <- liftIO $ getBlobObjectEither getBlobReq fp
     case res of
         Left err ->
             throwString $ show err
@@ -44,23 +55,17 @@ getBlobObject getBlobReq = do
 getBlobObjectEither ::
     MonadIO m =>
     GetBlob ->
-    m (Either Text ByteString)
-getBlobObjectEither getBlobReq = do
+    FilePath ->
+    m (Either Text ())
+getBlobObjectEither getBlobReq fp = do
     res <-
         liftIO $
             callGetBlobClient getBlobObjectApi getBlobReq
-    pure $
-        case res of
-            Right r -> Right r
-            Left err -> Left err
-
-data GetBlob = GetBlob
-    { accountName :: !AccountName
-    , containerName :: !ContainerName
-    , blobName :: !BlobName
-    , tokenStore :: !Auth.Token
-    }
-    deriving stock (Eq, Generic)
+    case res of
+        Right bs -> do
+            liftIO $ LBS.writeFile fp (fromStrict bs)
+            pure $ Right ()
+        Left err -> pure $ Left err
 
 -- | Phantom type to encapsulate the data type in servant client types
 data Blob
@@ -82,6 +87,8 @@ instance Accept Blob where
             :| [ "application" M.// "octet-stream"
                , "text" M.// "csv"
                , "application" M.// "x-dbt"
+               , "image" M.// "jpeg"
+               , "image" M.// "png"
                ]
 
 instance MimeRender Blob ByteString where
diff --git a/azure-blob-storage/src/Azure/Blob/PutBlob.hs b/azure-blob-storage/src/Azure/Blob/PutBlob.hs
index d0d223e..12792eb 100644
--- a/azure-blob-storage/src/Azure/Blob/PutBlob.hs
+++ b/azure-blob-storage/src/Azure/Blob/PutBlob.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
@@ -6,14 +7,16 @@
 module Azure.Blob.PutBlob
     ( putBlobObjectEither
     , putBlobObject
+    , PutBlob (..)
     ) where
 
 import Azure.Auth (defaultAzureCredential)
-import Azure.Blob.Types (BlobName (..), BlobType (..), ContainerName (..), PutBlob (..))
+import Azure.Blob.Types (AccountName (..), BlobName (..), BlobType (..), ContainerName (..))
 import Azure.Blob.Utils (blobStorageResourceUrl, mkBlobHostUrl)
 import Data.ByteString (ByteString)
 import Data.Data (Proxy (..))
 import Data.Text (Text)
+import GHC.Generics (Generic)
 import Network.HTTP.Client.TLS (newTlsManager)
 import Servant.API
 import Servant.Client (BaseUrl (..), ClientM, Scheme (..), client, mkClientEnv, runClientM)
@@ -22,6 +25,19 @@ import UnliftIO (MonadIO (..), throwString)
 import qualified Azure.Types as Auth
 import qualified Data.Text as Text
 
+{- | Adds a blob to a container.
+
+You should have appropriate (Write) permissions in order to perform this operation.
+-}
+data PutBlob = PutBlob
+    { accountName :: !AccountName
+    , containerName :: !ContainerName
+    , blobName :: !BlobName
+    , tokenStore :: !Auth.Token
+    , body :: !ByteString -- TODO: Add chunked upload
+    }
+    deriving stock (Eq, Generic)
+
 {- | Upload a blob to a blob container.
 
 Errors will be thrown in IO. For variant where error is
diff --git a/azure-blob-storage/src/Azure/Blob/Types.hs b/azure-blob-storage/src/Azure/Blob/Types.hs
index fc9d653..c1f8d06 100644
--- a/azure-blob-storage/src/Azure/Blob/Types.hs
+++ b/azure-blob-storage/src/Azure/Blob/Types.hs
@@ -4,7 +4,6 @@ module Azure.Blob.Types
     ( BlobName (..)
     , ContainerName (..)
     , AccountName (..)
-    , PutBlob (..)
     , BlobType (..)
     , UserDelegationRequest (..)
     , UserDelegationResponse (..)
@@ -17,7 +16,6 @@ module Azure.Blob.Types
     ) where
 
 import Data.Aeson (ToJSON (..), object, (.=))
-import Data.ByteString (ByteString)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Servant.API (ToHttpApiData)
@@ -25,8 +23,6 @@ import Xmlbf (FromXml (..), ToXml (..), element, pElement, pText, text)
 
 import qualified Data.HashMap.Strict as HashMap
 
-import qualified Azure.Types as Auth
-
 newtype AccountName = AccountName
     { unAccountName :: Text
     }
@@ -51,19 +47,6 @@ data BlobType
     | AppendBlob
     deriving stock (Eq, Show, Generic)
 
-{- | Adds a blob to a container.
-
-You should have appropriate (Write) permissions in order to perform this operation.
--}
-data PutBlob = PutBlob
-    { accountName :: !AccountName
-    , containerName :: !ContainerName
-    , blobName :: !BlobName
-    , tokenStore :: !Auth.Token
-    , body :: !ByteString -- TODO: Add chunked upload
-    }
-    deriving stock (Eq, Generic)
-
 {- | The fields are supposed to be ISO format strings
 TODO: make these UTCTime formats
 -}