Add format paramter to mls public key endpoint

changelog.d/1-api-changes/jwk

@@ -0,0 +1 @@
+The `mls/public-key` endpoint now takes a `format` query parameter which can be either `raw` (default, for raw base64-encoded keys) or `jwk` (for JWK keys)

integration/test/API/Galley.hs

@@ -228,6 +228,11 @@ getMLSPublicKeys user = do
   req <- baseRequest user Galley Versioned "/mls/public-keys"
   submit "GET" req
 
+getMLSPublicKeysJWK :: (HasCallStack, MakesValue user) => user -> App Response
+getMLSPublicKeysJWK user = do
+  req <- baseRequest user Galley Versioned "/mls/public-keys"
+  submit "GET" $ addQueryParams [("format", "jwk")] req
+
 postMLSMessage :: (HasCallStack) => ClientIdentity -> ByteString -> App Response
 postMLSMessage cid msg = do
   req <- baseRequest cid Galley Versioned "/mls/messages"

integration/test/Test/MLS/Keys.hs

@@ -1,16 +1,42 @@
 module Test.MLS.Keys where
 
 import API.Galley
+import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.ByteString.Char8 as B8
 import SetupHelpers
 import Testlib.Prelude
 
-testPublicKeys :: (HasCallStack) => App ()
-testPublicKeys = do
+testRawPublicKeys :: (HasCallStack) => App ()
+testRawPublicKeys = do
   u <- randomUserId OwnDomain
   keys <- getMLSPublicKeys u >>= getJSON 200
 
+  do
+    pubkeyS <- keys %. "removal.ed25519" & asString
+    pubkey <- assertOne . toList . B64.decode $ B8.pack pubkeyS
+    B8.length pubkey `shouldMatchInt` 32
+
+  do
+    pubkeyS <- keys %. "removal.ecdsa_secp256r1_sha256" & asString
+    pubkey <- assertOne . toList . B64.decode $ B8.pack pubkeyS
+    B8.length pubkey `shouldMatchInt` 65
+
+  do
+    pubkeyS <- keys %. "removal.ecdsa_secp384r1_sha384" & asString
+    pubkey <- assertOne . toList . B64.decode $ B8.pack pubkeyS
+    B8.length pubkey `shouldMatchInt` 97
+
+  do
+    pubkeyS <- keys %. "removal.ecdsa_secp521r1_sha512" & asString
+    pubkey <- assertOne . toList . B64.decode $ B8.pack pubkeyS
+    B8.length pubkey `shouldMatchInt` 133
+
+testJWKPublicKeys :: (HasCallStack) => App ()
+testJWKPublicKeys = do
+  u <- randomUserId OwnDomain
+  keys <- getMLSPublicKeysJWK u >>= getJSON 200
+
   do
     keys %. "removal.ed25519.crv" `shouldMatch` "Ed25519"
     keys %. "removal.ed25519.kty" `shouldMatch` "OKP"

libs/wire-api/src/Wire/API/MLS/Keys.hs

@@ -17,16 +17,20 @@
 
 module Wire.API.MLS.Keys where
 
+import Control.Lens ((?~))
 import Crypto.ECC (Curve_P256R1, Curve_P384R1, Curve_P521R1)
 import Crypto.PubKey.ECDSA qualified as ECDSA
 import Data.Aeson (FromJSON (..), ToJSON (..))
+import Data.Aeson qualified as A
 import Data.Bifunctor
 import Data.ByteArray qualified as BA
+import Data.Default
 import Data.Json.Util
 import Data.OpenApi qualified as S
 import Data.Proxy
 import Data.Schema hiding (HasField)
 import Imports hiding (First, getFirst)
+import Web.HttpApiData
 import Wire.API.MLS.CipherSuite
 
 data MLSKeysByPurpose a = MLSKeysByPurpose
@@ -47,7 +51,7 @@ data MLSKeys a = MLSKeys
     ecdsa_secp384r1_sha384 :: a,
     ecdsa_secp521r1_sha512 :: a
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Functor, Foldable, Traversable)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeys a)
 
 instance (ToSchema a) => ToSchema (MLSKeys a) where
@@ -70,6 +74,7 @@ type MLSPublicKeys = MLSKeys MLSPublicKey
 
 newtype MLSPublicKey = MLSPublicKey {unwrapMLSPublicKey :: ByteString}
   deriving (Eq, Show)
+  deriving (ToJSON) via Schema MLSPublicKey
 
 instance ToSchema MLSPublicKey where
   schema = named "MLSPublicKey" $ MLSPublicKey <$> unwrapMLSPublicKey .= base64Schema
@@ -83,13 +88,38 @@ mlsKeysToPublic (MLSPrivateKeys (_, ed) (_, ec256) (_, ec384) (_, ec521)) =
       ecdsa_secp521r1_sha512 = MLSPublicKey $ ECDSA.encodePublic (Proxy @Curve_P521R1) ec521
     }
 
+data MLSPublicKeyFormat = MLSPublicKeyFormatRaw | MLSPublicKeyFormatJWK
+  deriving (Eq, Ord, Show)
+
+instance Default MLSPublicKeyFormat where
+  def = MLSPublicKeyFormatRaw
+
+instance FromHttpApiData MLSPublicKeyFormat where
+  parseQueryParam "raw" = pure MLSPublicKeyFormatRaw
+  parseQueryParam "jwk" = pure MLSPublicKeyFormatJWK
+  parseQueryParam _ = Left "invalid MLSPublicKeyFormat"
+
+instance ToHttpApiData MLSPublicKeyFormat where
+  toQueryParam MLSPublicKeyFormatRaw = "raw"
+  toQueryParam MLSPublicKeyFormatJWK = "jwk"
+
+instance S.ToParamSchema MLSPublicKeyFormat where
+  toParamSchema _ =
+    mempty
+      & S.type_ ?~ S.OpenApiString
+      & S.enum_
+        ?~ map
+          (toJSON . toQueryParam)
+          [MLSPublicKeyFormatRaw, MLSPublicKeyFormatJWK]
+
 data JWK = JWK
   { keyType :: String,
     curve :: String,
     pubX :: ByteString,
     pubY :: Maybe ByteString
   }
   deriving (Show, Ord, Eq)
+  deriving (ToJSON) via Schema JWK
 
 instance ToSchema JWK where
   schema =
@@ -134,3 +164,15 @@ mlsKeysToPublicJWK (MLSPrivateKeys (_, ed) (_, ec256) (_, ec384) (_, ec521)) =
       -- to Y.
       let size = BA.length xy `div` 2
       pure $ BA.splitAt size xy
+
+data SomeKey = SomeKey A.Value
+
+instance ToSchema SomeKey where
+  schema = mkSchema d r w
+    where
+      d = pure $ S.NamedSchema (Just "SomeKey") mempty
+      r = fmap SomeKey . parseJSON
+      w (SomeKey x) = Just (toJSON x)
+
+mkSomeKey :: (ToJSON a) => a -> SomeKey
+mkSomeKey = SomeKey . toJSON

libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs

@@ -109,24 +109,26 @@ type MLSMessagingAPI =
                :> ReqBody '[MLS] (RawMLS CommitBundle)
                :> MultiVerb1 'POST '[JSON] (Respond 201 "Commit accepted and forwarded" MLSMessageSendingStatus)
            )
-    :<|> Named
-           "mls-public-keys-v6"
-           ( Summary "Get public keys used by the backend to sign external proposals"
-               :> From 'V5
-               :> Until 'V7
-               :> CanThrow 'MLSNotEnabled
-               :> "public-keys"
-               :> ZLocalUser
-               :> MultiVerb1 'GET '[JSON] (Respond 200 "Public keys" (MLSKeysByPurpose MLSPublicKeys))
-           )
     :<|> Named
            "mls-public-keys"
            ( Summary "Get public keys used by the backend to sign external proposals"
-               :> From 'V7
+               :> Description
+                    "The format of the returned key is determined by the `format` query parameter:\n\
+                    \ - raw (default): base64-encoded raw public keys\n\
+                    \ - jwk: keys are nested objects in JWK format."
+               :> From 'V5
                :> CanThrow 'MLSNotEnabled
                :> "public-keys"
                :> ZLocalUser
-               :> MultiVerb1 'GET '[JSON] (Respond 200 "Public keys" (MLSKeysByPurpose MLSPublicKeysJWK))
+               :> QueryParam "format" MLSPublicKeyFormat
+               :> MultiVerb1
+                    'GET
+                    '[JSON]
+                    ( Respond
+                        200
+                        "Public keys"
+                        (MLSKeysByPurpose (MLSKeys SomeKey))
+                    )
            )
 
 type MLSAPI = LiftNamed ("mls" :> MLSMessagingAPI)

services/galley/src/Galley/API/MLS.hs

@@ -22,10 +22,10 @@ module Galley.API.MLS
     postMLSCommitBundleFromLocalUser,
     postMLSMessageFromLocalUser,
     getMLSPublicKeys,
-    getMLSPublicKeysJWK,
   )
 where
 
+import Data.Default
 import Data.Id
 import Data.Qualified
 import Galley.API.Error
@@ -42,17 +42,21 @@ import Wire.API.MLS.Keys
 
 getMLSPublicKeys ::
   ( Member (Input Env) r,
-    Member (ErrorS 'MLSNotEnabled) r
+    Member (ErrorS 'MLSNotEnabled) r,
+    Member (Error InternalError) r
   ) =>
   Local UserId ->
-  Sem r (MLSKeysByPurpose MLSPublicKeys)
-getMLSPublicKeys _ = mlsKeysToPublic <$$> getMLSPrivateKeys
-
-getMLSPublicKeysJWK ::
-  ( Member (Input Env) r,
-    Member (Error InternalError) r,
-    Member (ErrorS 'MLSNotEnabled) r
-  ) =>
-  Local UserId ->
-  Sem r (MLSKeysByPurpose MLSPublicKeysJWK)
-getMLSPublicKeysJWK _ = mapM (note (InternalErrorWithDescription "malformed MLS removal keys") . mlsKeysToPublicJWK) =<< getMLSPrivateKeys
+  Maybe MLSPublicKeyFormat ->
+  Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
+getMLSPublicKeys _ fmt = do
+  keys <- getMLSPrivateKeys
+  case fromMaybe def fmt of
+    MLSPublicKeyFormatRaw -> pure (fmap (fmap mkSomeKey . mlsKeysToPublic) keys)
+    MLSPublicKeyFormatJWK -> do
+      jwks <-
+        traverse
+          ( note (InternalErrorWithDescription "malformed MLS removal keys")
+              . mlsKeysToPublicJWK
+          )
+          keys
+      pure $ fmap (fmap mkSomeKey) jwks

services/galley/src/Galley/API/Public/MLS.hs

@@ -27,5 +27,4 @@ mlsAPI :: API MLSAPI GalleyEffects
 mlsAPI =
   mkNamedAPI @"mls-message" (callsFed (exposeAnnotations postMLSMessageFromLocalUser))
     <@> mkNamedAPI @"mls-commit-bundle" (callsFed (exposeAnnotations postMLSCommitBundleFromLocalUser))
-    <@> mkNamedAPI @"mls-public-keys-v6" getMLSPublicKeys
-    <@> mkNamedAPI @"mls-public-keys" getMLSPublicKeysJWK
+    <@> mkNamedAPI @"mls-public-keys" getMLSPublicKeys