Add key vault lib

.github/workflows/haskell-ci.yml

@@ -145,6 +145,7 @@ jobs:
         run: |
           touch cabal.project
           echo "packages: $GITHUB_WORKSPACE/source/./azure-auth" >> cabal.project
+          echo "packages: $GITHUB_WORKSPACE/source/./azure-key-vault" >> cabal.project
           cat cabal.project
       - name: sdist
         run: |
@@ -158,15 +159,20 @@ jobs:
         run: |
           PKGDIR_azure_auth="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/azure-auth-[0-9.]*')"
           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"
           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 "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
           cat >> cabal.project <<EOF
           EOF
-          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(azure-auth)$/; }' >> cabal.project.local
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(azure-auth|azure-key-vault)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local
       - name: dump install plan
@@ -196,6 +202,8 @@ jobs:
         run: |
           cd ${PKGDIR_azure_auth} || false
           ${CABAL} -vnormal check
+          cd ${PKGDIR_azure_key_vault} || false
+          ${CABAL} -vnormal check
       - name: haddock
         run: |
           $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

azure-key-vault/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.

azure-key-vault/LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2024 Nitin Prakash
+
+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.

azure-key-vault/app/Main.hs

@@ -0,0 +1,5 @@
+module Main where
+
+main :: IO ()
+main = do
+    putStrLn "Hello, Haskell!"

azure-key-vault/azure-key-vault.cabal

@@ -0,0 +1,79 @@
+cabal-version:      3.0
+name:               azure-key-vault
+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:  Secret
+    -- other-modules:
+    -- other-extensions:
+    build-depends:    aeson
+                    , azure-auth
+                    , http-client-tls
+                    , servant
+                    , servant-client
+                    , text
+                    , unliftio
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+test-suite azure-key-vault-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.17.2.1,
+        azure-key-vault

azure-key-vault/src/Secret.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Secret
+    ( KeyVaultResponse (..)
+    , GetSecretFromVaultApi
+    , getSecretFromVault
+    , callKeyVaultClient
+    ) where
+
+import Data.Aeson (FromJSON (..), withObject, (.:))
+import Data.Data (Proxy (..))
+import Data.Text (Text)
+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 Auth (defaultAzureCredential)
+import Types (AccessToken (..), Token)
+
+import qualified Data.Text as Text
+
+newtype KeyVaultResponse = KeyVaultResponse
+    { unKeyValueReponse :: Text
+    }
+    deriving stock (Eq, Show, Generic)
+
+instance FromJSON KeyVaultResponse where
+    parseJSON = withObject "KeyVaultResponse" $ \o -> do
+        unKeyValueReponse <- o .: "value"
+        pure KeyVaultResponse{..}
+
+{-
+Path: GET {vaultBaseUrl}/secrets/{secret-name}/{secret-version}?api-version=7.4
+
+secret-version: optional. The latest version will be used by default.
+TODO: consider specifying secret-version in the future.
+-}
+type GetSecretFromVaultApi =
+    "secrets"
+        :> Capture "secret-name" Text
+        :> QueryParam' '[Required, Strict] "api-version" Float
+        :> Header' '[Required, Strict] "Authorization" Text
+        :> Get '[JSON] KeyVaultResponse
+
+getSecretFromVault :: Text -> Float -> Text -> ClientM KeyVaultResponse
+getSecretFromVault = client (Proxy @GetSecretFromVaultApi)
+
+callKeyVaultClient ::
+    MonadIO m =>
+    (Text -> Float -> Text -> ClientM KeyVaultResponse) ->
+    Text ->
+    Text ->
+    Token ->
+    m KeyVaultResponse
+callKeyVaultClient action secretName vaultHost tokenStore = do
+    manager <- liftIO newTlsManager
+    authHeader <- defaultAzureCredential Nothing "https://vault.azure.net" tokenStore
+    res <-
+        liftIO $
+            runClientM
+                (action secretName 7.4 ("Bearer " <> atAccessToken authHeader))
+                (mkClientEnv manager $ BaseUrl Https (Text.unpack vaultHost) 443 "")
+    case res of
+        Left err -> do
+            throwIO err
+        Right response -> do
+            liftIO $ putStrLn $ "Successfully performed request: " <> show response
+            pure response

azure-key-vault/test/Main.hs

@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented."

cabal.project

@@ -1,2 +1,3 @@
 packages:
   ./azure-auth
+  ./azure-key-vault

stack.yaml

@@ -2,4 +2,4 @@ resolver: lts-21.25 # based on ghc-9.4.8
 
 packages:
 - ./azure-auth
-  
+- ./azure-key-vault