Endpoint for deleting key packages

changelog.d/1-api-changes/delete-keypackages

@@ -0,0 +1 @@
+Add new endpoint `DELETE /mls/key-packages/self/:client`

integration/integration.cabal

@@ -92,6 +92,7 @@ library
     Test.Brig
     Test.Demo
     Test.MLS
+    Test.MLS.KeyPackage
     Testlib.App
     Testlib.Assertions
     Testlib.Cannon

integration/test/API/Brig.hs

@@ -168,3 +168,13 @@ claimKeyPackages u v = do
     baseRequest u Brig Versioned $
       "/mls/key-packages/claim/" <> targetDom <> "/" <> targetUid
   submit "POST" req
+
+countKeyPackages :: ClientIdentity -> App Response
+countKeyPackages cid = do
+  baseRequest cid Brig Versioned ("/mls/key-packages/self/" <> cid.client <> "/count")
+    >>= submit "GET"
+
+deleteKeyPackages :: ClientIdentity -> [String] -> App Response
+deleteKeyPackages cid kps = do
+  req <- baseRequest cid Brig Versioned ("/mls/key-packages/self/" <> cid.client)
+  submit "DELETE" $ req & addJSONObject ["key_packages" .= kps]

integration/test/MLS/Util.hs

@@ -16,7 +16,6 @@ import qualified Data.ByteString.Char8 as B8
 import Data.Default
 import Data.Foldable
 import Data.Function
-import Data.Hex
 import qualified Data.Map as Map
 import Data.Maybe
 import qualified Data.Set as Set
@@ -155,7 +154,7 @@ uploadNewKeyPackage cid = do
 generateKeyPackage :: HasCallStack => ClientIdentity -> App (ByteString, String)
 generateKeyPackage cid = do
   kp <- mlscli cid ["key-package", "create"] Nothing
-  ref <- B8.unpack . hex <$> mlscli cid ["key-package", "ref", "-"] (Just kp)
+  ref <- B8.unpack . Base64.encode <$> mlscli cid ["key-package", "ref", "-"] (Just kp)
   fp <- keyPackageFile cid ref
   liftIO $ BS.writeFile fp kp
   pure (kp, ref)
@@ -218,8 +217,13 @@ resetClientGroup cid gid = do
 
 keyPackageFile :: HasCallStack => ClientIdentity -> String -> App FilePath
 keyPackageFile cid ref = do
+  let ref' = map urlSafe ref
   bd <- getBaseDir
-  pure $ bd </> cid2Str cid </> ref
+  pure $ bd </> cid2Str cid </> ref'
+  where
+    urlSafe '+' = '-'
+    urlSafe '/' = '_'
+    urlSafe c = c
 
 unbundleKeyPackages :: Value -> App [(ClientIdentity, ByteString)]
 unbundleKeyPackages bundle = do

integration/test/Test/MLS/KeyPackage.hs

@@ -0,0 +1,21 @@
+module Test.MLS.KeyPackage where
+
+import API.Brig
+import MLS.Util
+import SetupHelpers
+import Testlib.Prelude
+
+testDeleteKeyPackages :: App ()
+testDeleteKeyPackages = do
+  alice <- randomUser ownDomain def
+  alice1 <- createMLSClient alice
+  kps <- replicateM 3 (uploadNewKeyPackage alice1)
+
+  -- add an extra non-existing key package to the delete request
+  let kps' = "4B701F521EBE82CEC4AD5CB67FDD8E1C43FC4868DE32D03933CE4993160B75E8" : kps
+
+  bindResponse (deleteKeyPackages alice1 kps') $ \resp -> do
+    resp.status `shouldMatchInt` 201
+  bindResponse (countKeyPackages alice1) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "count" `shouldMatchInt` 0

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

@@ -21,6 +21,7 @@ module Wire.API.MLS.KeyPackage
     KeyPackageBundleEntry (..),
     KeyPackageCount (..),
     KeyPackageData (..),
+    DeleteKeyPackages (..),
     KeyPackage (..),
     keyPackageIdentity,
     kpRef,
@@ -38,6 +39,7 @@ import qualified Data.ByteString.Lazy as LBS
 import Data.Id
 import Data.Json.Util
 import Data.Qualified
+import Data.Range
 import Data.Schema
 import qualified Data.Swagger as S
 import GHC.Records
@@ -117,6 +119,20 @@ instance ToSchema KeyPackageCount where
     object "OwnKeyPackages" $
       KeyPackageCount <$> unKeyPackageCount .= field "count" schema
 
+newtype DeleteKeyPackages = DeleteKeyPackages
+  {unDeleteKeyPackages :: [KeyPackageRef]}
+  deriving newtype (Eq, Ord, Show)
+  deriving (FromJSON, ToJSON, S.ToSchema) via Schema DeleteKeyPackages
+
+instance ToSchema DeleteKeyPackages where
+  schema =
+    object "DeleteKeyPackages" $
+      DeleteKeyPackages
+        <$> unDeleteKeyPackages
+          .= field
+            "key_packages"
+            (untypedRangedSchema 1 1000 (array schema))
+
 newtype KeyPackageRef = KeyPackageRef {unKeyPackageRef :: ByteString}
   deriving stock (Eq, Ord, Show)
   deriving (FromHttpApiData, ToHttpApiData, S.ToParamSchema) via Base64ByteString

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

@@ -1186,6 +1186,15 @@ type MLSKeyPackageAPI =
                       :> Summary "Return the number of unused key packages for the given client"
                       :> MultiVerb1 'GET '[JSON] (Respond 200 "Number of key packages" KeyPackageCount)
                   )
+           :<|> Named
+                  "mls-key-packages-delete"
+                  ( "self"
+                      :> ZLocalUser
+                      :> CaptureClientId "client"
+                      :> Summary "Return the number of unused key packages for the given client"
+                      :> ReqBody '[JSON] DeleteKeyPackages
+                      :> MultiVerb1 'DELETE '[JSON] (RespondEmpty 201 "OK")
+                  )
        )
 
 -- Search API -----------------------------------------------------

services/brig/src/Brig/API/MLS/KeyPackages.hs

@@ -20,6 +20,7 @@ module Brig.API.MLS.KeyPackages
     claimKeyPackages,
     claimLocalKeyPackages,
     countKeyPackages,
+    deleteKeyPackages,
   )
 where
 
@@ -137,3 +138,12 @@ countKeyPackages lusr c = do
   lift $
     KeyPackageCount . fromIntegral
       <$> wrapClient (Data.countKeyPackages lusr c)
+
+deleteKeyPackages ::
+  Local UserId ->
+  ClientId ->
+  DeleteKeyPackages ->
+  Handler r ()
+deleteKeyPackages lusr c (unDeleteKeyPackages -> refs) = do
+  assertMLSEnabled
+  lift $ wrapClient (Data.deleteKeyPackages (tUnqualified lusr) c refs)

services/brig/src/Brig/API/Public.hs

@@ -364,6 +364,7 @@ servantSitemap =
       Named @"mls-key-packages-upload" uploadKeyPackages
         :<|> Named @"mls-key-packages-claim" (callsFed (exposeAnnotations claimKeyPackages))
         :<|> Named @"mls-key-packages-count" countKeyPackages
+        :<|> Named @"mls-key-packages-delete" deleteKeyPackages
 
     userHandleAPI :: ServerT UserHandleAPI (Handler r)
     userHandleAPI =

services/brig/src/Brig/Data/MLS/KeyPackage.hs

@@ -19,6 +19,7 @@ module Brig.Data.MLS.KeyPackage
   ( insertKeyPackages,
     claimKeyPackage,
     countKeyPackages,
+    deleteKeyPackages,
   )
 where
 
@@ -66,12 +67,12 @@ claimKeyPackage u c = do
     kps <- getNonClaimedKeyPackages u c
     mk <- liftIO (pick kps)
     for mk $ \(ref, kpd) -> do
-      retry x5 $ write deleteByRef (params LocalQuorum (tUnqualified u, c, ref))
+      retry x5 $ write delete1Query (params LocalQuorum (tUnqualified u, c, ref))
       pure (ref, kpd)
   pure (ref, kpd)
   where
-    deleteByRef :: PrepQuery W (UserId, ClientId, KeyPackageRef) ()
-    deleteByRef = "DELETE FROM mls_key_packages WHERE user = ? AND client = ? AND ref = ?"
+    delete1Query :: PrepQuery W (UserId, ClientId, KeyPackageRef) ()
+    delete1Query = "DELETE FROM mls_key_packages WHERE user = ? AND client = ? AND ref = ?"
 
 -- | Fetch all unclaimed non-expired key packages for a given client and delete
 -- from the database those that have expired.
@@ -92,19 +93,12 @@ getNonClaimedKeyPackages u c = do
   let (kpsExpired, kpsNonExpired) =
         partition (hasExpired now mMaxLifetime) decodedKps
   -- delete expired key packages
-  let kpsExpired' = fmap (\(_, (ref, _)) -> ref) kpsExpired
-   in retry x5 $
-        write
-          deleteByRefs
-          (params LocalQuorum (tUnqualified u, c, kpsExpired'))
+  deleteKeyPackages (tUnqualified u) c (map (\(_, (ref, _)) -> ref) kpsExpired)
   pure $ fmap snd kpsNonExpired
   where
     lookupQuery :: PrepQuery R (UserId, ClientId) (KeyPackageRef, KeyPackageData)
     lookupQuery = "SELECT ref, data FROM mls_key_packages WHERE user = ? AND client = ?"
 
-    deleteByRefs :: PrepQuery W (UserId, ClientId, [KeyPackageRef]) ()
-    deleteByRefs = "DELETE FROM mls_key_packages WHERE user = ? AND client = ? AND ref in ?"
-
     decodeKp :: (a, KeyPackageData) -> Maybe KeyPackage
     decodeKp = hush . decodeMLS' . kpData . snd
 
@@ -129,6 +123,16 @@ countKeyPackages ::
   m Int64
 countKeyPackages u c = fromIntegral . length <$> getNonClaimedKeyPackages u c
 
+deleteKeyPackages :: MonadClient m => UserId -> ClientId -> [KeyPackageRef] -> m ()
+deleteKeyPackages u c refs =
+  retry x5 $
+    write
+      deleteQuery
+      (params LocalQuorum (u, c, refs))
+  where
+    deleteQuery :: PrepQuery W (UserId, ClientId, [KeyPackageRef]) ()
+    deleteQuery = "DELETE FROM mls_key_packages WHERE user = ? AND client = ? AND ref in ?"
+
 --------------------------------------------------------------------------------
 -- Utilities