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