-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Galley.API.MLS
  ( isMLSEnabled,
    assertMLSEnabled,
    postMLSMessage,
    postMLSCommitBundleFromLocalUser,
    postMLSMessageFromLocalUser,
    getMLSPublicKeys,
    formatPublicKeys,
  )
where

import Data.Default
import Galley.API.Error
import Galley.API.MLS.Enabled
import Galley.API.MLS.Message
import Galley.Env
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.MLS.Keys

getMLSPublicKeys ::
  ( Member (Input Env) r,
    Member (ErrorS 'MLSNotEnabled) r,
    Member (Error InternalError) r
  ) =>
  Maybe MLSPublicKeyFormat ->
  Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
getMLSPublicKeys :: forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r,
 Member (Error InternalError) r) =>
Maybe MLSPublicKeyFormat
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
getMLSPublicKeys Maybe MLSPublicKeyFormat
fmt = do
  MLSKeysByPurpose MLSPublicKeys
publicKeys <- MLSPrivateKeys -> MLSPublicKeys
mlsKeysToPublic (MLSPrivateKeys -> MLSPublicKeys)
-> Sem r (MLSKeysByPurpose MLSPrivateKeys)
-> Sem r (MLSKeysByPurpose MLSPublicKeys)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Sem r (MLSKeysByPurpose MLSPrivateKeys)
forall (r :: EffectRow).
(Member (Input Env) r, Member (ErrorS 'MLSNotEnabled) r) =>
Sem r (MLSKeysByPurpose MLSPrivateKeys)
getMLSPrivateKeys
  Maybe MLSPublicKeyFormat
-> MLSKeysByPurpose MLSPublicKeys
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
forall (r :: EffectRow).
Member (Error InternalError) r =>
Maybe MLSPublicKeyFormat
-> MLSKeysByPurpose MLSPublicKeys
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
formatPublicKeys Maybe MLSPublicKeyFormat
fmt MLSKeysByPurpose MLSPublicKeys
publicKeys

formatPublicKeys ::
  (Member (Error InternalError) r) =>
  Maybe MLSPublicKeyFormat ->
  MLSKeysByPurpose MLSPublicKeys ->
  Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
formatPublicKeys :: forall (r :: EffectRow).
Member (Error InternalError) r =>
Maybe MLSPublicKeyFormat
-> MLSKeysByPurpose MLSPublicKeys
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
formatPublicKeys Maybe MLSPublicKeyFormat
fmt MLSKeysByPurpose MLSPublicKeys
publicKeys =
  case MLSPublicKeyFormat
-> Maybe MLSPublicKeyFormat -> MLSPublicKeyFormat
forall a. a -> Maybe a -> a
fromMaybe MLSPublicKeyFormat
forall a. Default a => a
def Maybe MLSPublicKeyFormat
fmt of
    MLSPublicKeyFormat
MLSPublicKeyFormatRaw -> MLSKeysByPurpose (MLSKeys SomeKey)
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((MLSPublicKeys -> MLSKeys SomeKey)
-> MLSKeysByPurpose MLSPublicKeys
-> MLSKeysByPurpose (MLSKeys SomeKey)
forall a b. (a -> b) -> MLSKeysByPurpose a -> MLSKeysByPurpose b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MLSPublicKey -> SomeKey) -> MLSPublicKeys -> MLSKeys SomeKey
forall a b. (a -> b) -> MLSKeys a -> MLSKeys b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MLSPublicKey -> SomeKey
forall a. ToJSON a => a -> SomeKey
mkSomeKey) MLSKeysByPurpose MLSPublicKeys
publicKeys)
    MLSPublicKeyFormat
MLSPublicKeyFormatJWK -> do
      MLSKeysByPurpose MLSPublicKeysJWK
jwks <-
        (MLSPublicKeys -> Sem r MLSPublicKeysJWK)
-> MLSKeysByPurpose MLSPublicKeys
-> Sem r (MLSKeysByPurpose MLSPublicKeysJWK)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MLSKeysByPurpose a -> f (MLSKeysByPurpose b)
traverse
          ( InternalError -> Maybe MLSPublicKeysJWK -> Sem r MLSPublicKeysJWK
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note (LText -> InternalError
InternalErrorWithDescription LText
"malformed MLS removal keys")
              (Maybe MLSPublicKeysJWK -> Sem r MLSPublicKeysJWK)
-> (MLSPublicKeys -> Maybe MLSPublicKeysJWK)
-> MLSPublicKeys
-> Sem r MLSPublicKeysJWK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLSPublicKeys -> Maybe MLSPublicKeysJWK
mlsPublicKeysToJWK
          )
          MLSKeysByPurpose MLSPublicKeys
publicKeys
      MLSKeysByPurpose (MLSKeys SomeKey)
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MLSKeysByPurpose (MLSKeys SomeKey)
 -> Sem r (MLSKeysByPurpose (MLSKeys SomeKey)))
-> MLSKeysByPurpose (MLSKeys SomeKey)
-> Sem r (MLSKeysByPurpose (MLSKeys SomeKey))
forall a b. (a -> b) -> a -> b
$ (MLSPublicKeysJWK -> MLSKeys SomeKey)
-> MLSKeysByPurpose MLSPublicKeysJWK
-> MLSKeysByPurpose (MLSKeys SomeKey)
forall a b. (a -> b) -> MLSKeysByPurpose a -> MLSKeysByPurpose b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((JWK -> SomeKey) -> MLSPublicKeysJWK -> MLSKeys SomeKey
forall a b. (a -> b) -> MLSKeys a -> MLSKeys b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JWK -> SomeKey
forall a. ToJSON a => a -> SomeKey
mkSomeKey) MLSKeysByPurpose MLSPublicKeysJWK
jwks