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 -}