diff --git a/changelog.d/1-api-changes/delete-keypackages b/changelog.d/1-api-changes/delete-keypackages new file mode 100644 index 0000000000..c6ce843eb5 --- /dev/null +++ b/changelog.d/1-api-changes/delete-keypackages @@ -0,0 +1 @@ +Add new endpoint `DELETE /mls/key-packages/self/:client` diff --git a/integration/integration.cabal b/integration/integration.cabal index e94b8cb81a..09be990814 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -92,6 +92,7 @@ library Test.Brig Test.Demo Test.MLS + Test.MLS.KeyPackage Testlib.App Testlib.Assertions Testlib.Cannon diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 9a1adb1f0f..6feac24994 100644 --- a/integration/test/API/Brig.hs +++ b/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] diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index 606914e3f4..1a54fb4366 100644 --- a/integration/test/MLS/Util.hs +++ b/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 diff --git a/integration/test/Test/MLS/KeyPackage.hs b/integration/test/Test/MLS/KeyPackage.hs new file mode 100644 index 0000000000..c6649c8838 --- /dev/null +++ b/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 diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index 19e9490993..1e7403738b 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 75d7ae043a..bfc3258ac1 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/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 ----------------------------------------------------- diff --git a/services/brig/src/Brig/API/MLS/KeyPackages.hs b/services/brig/src/Brig/API/MLS/KeyPackages.hs index 53bd3fe164..982cc17ea1 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages.hs +++ b/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) diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 4fcb83eaed..8f593ea272 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/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 = diff --git a/services/brig/src/Brig/Data/MLS/KeyPackage.hs b/services/brig/src/Brig/Data/MLS/KeyPackage.hs index 03a69e69ab..fc3c4183bc 100644 --- a/services/brig/src/Brig/Data/MLS/KeyPackage.hs +++ b/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