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