build signature utility

Holmusk · Aug 3, 2024 · 9cebcb8 · 9cebcb8
1 parent ccbf0ad
commit 9cebcb8
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 1 deletion.
diff --git 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
@@ -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
@@ -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 ->