module Galley.API.MLS.Keys (getMLSRemovalKey, SomeKeyPair (..)) where
import Control.Error.Util (hush)
import Control.Lens (view)
import Data.Proxy
import Galley.Env
import Imports hiding (getFirst)
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Keys
data SomeKeyPair where
SomeKeyPair :: forall ss. (IsSignatureScheme ss) => Proxy ss -> KeyPair ss -> SomeKeyPair
getMLSRemovalKey ::
(Member (Input Env) r) =>
SignatureSchemeTag ->
Sem r (Maybe SomeKeyPair)
getMLSRemovalKey :: forall (r :: EffectRow).
Member (Input Env) r =>
SignatureSchemeTag -> Sem r (Maybe SomeKeyPair)
getMLSRemovalKey SignatureSchemeTag
ss = (Either () SomeKeyPair -> Maybe SomeKeyPair)
-> Sem r (Either () SomeKeyPair) -> Sem r (Maybe SomeKeyPair)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either () SomeKeyPair -> Maybe SomeKeyPair
forall a b. Either a b -> Maybe b
hush (Sem r (Either () SomeKeyPair) -> Sem r (Maybe SomeKeyPair))
-> (Sem (Error () : r) SomeKeyPair
-> Sem r (Either () SomeKeyPair))
-> Sem (Error () : r) SomeKeyPair
-> Sem r (Maybe SomeKeyPair)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @() (Sem (Error () : r) SomeKeyPair -> Sem r (Maybe SomeKeyPair))
-> Sem (Error () : r) SomeKeyPair -> Sem r (Maybe SomeKeyPair)
forall a b. (a -> b) -> a -> b
$ do
MLSKeysByPurpose MLSPrivateKeys
keysByPurpose <- ()
-> Maybe (MLSKeysByPurpose MLSPrivateKeys)
-> Sem (Error () : r) (MLSKeysByPurpose MLSPrivateKeys)
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note () (Maybe (MLSKeysByPurpose MLSPrivateKeys)
-> Sem (Error () : r) (MLSKeysByPurpose MLSPrivateKeys))
-> Sem (Error () : r) (Maybe (MLSKeysByPurpose MLSPrivateKeys))
-> Sem (Error () : r) (MLSKeysByPurpose MLSPrivateKeys)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Env -> Maybe (MLSKeysByPurpose MLSPrivateKeys))
-> Sem (Error () : r) (Maybe (MLSKeysByPurpose MLSPrivateKeys))
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs (Getting
(Maybe (MLSKeysByPurpose MLSPrivateKeys))
Env
(Maybe (MLSKeysByPurpose MLSPrivateKeys))
-> Env -> Maybe (MLSKeysByPurpose MLSPrivateKeys)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(Maybe (MLSKeysByPurpose MLSPrivateKeys))
Env
(Maybe (MLSKeysByPurpose MLSPrivateKeys))
Lens' Env (Maybe (MLSKeysByPurpose MLSPrivateKeys))
mlsKeys)
let keys :: MLSPrivateKeys
keys = MLSKeysByPurpose MLSPrivateKeys
keysByPurpose.removal
case SignatureSchemeTag
ss of
SignatureSchemeTag
Ed25519 -> SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a. a -> Sem (Error () : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeKeyPair -> Sem (Error () : r) SomeKeyPair)
-> SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a b. (a -> b) -> a -> b
$ Proxy 'Ed25519 -> KeyPair 'Ed25519 -> SomeKeyPair
forall (ss :: SignatureSchemeTag).
IsSignatureScheme ss =>
Proxy ss -> KeyPair ss -> SomeKeyPair
SomeKeyPair (forall {k} (t :: k). Proxy t
forall (t :: SignatureSchemeTag). Proxy t
Proxy @Ed25519) (MLSPrivateKeys -> KeyPair 'Ed25519
mlsKeyPair_ed25519 MLSPrivateKeys
keys)
SignatureSchemeTag
Ecdsa_secp256r1_sha256 ->
SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a. a -> Sem (Error () : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeKeyPair -> Sem (Error () : r) SomeKeyPair)
-> SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a b. (a -> b) -> a -> b
$
Proxy 'Ecdsa_secp256r1_sha256
-> KeyPair 'Ecdsa_secp256r1_sha256 -> SomeKeyPair
forall (ss :: SignatureSchemeTag).
IsSignatureScheme ss =>
Proxy ss -> KeyPair ss -> SomeKeyPair
SomeKeyPair
(forall {k} (t :: k). Proxy t
forall (t :: SignatureSchemeTag). Proxy t
Proxy @Ecdsa_secp256r1_sha256)
(MLSPrivateKeys -> KeyPair 'Ecdsa_secp256r1_sha256
mlsKeyPair_ecdsa_secp256r1_sha256 MLSPrivateKeys
keys)
SignatureSchemeTag
Ecdsa_secp384r1_sha384 ->
SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a. a -> Sem (Error () : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeKeyPair -> Sem (Error () : r) SomeKeyPair)
-> SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a b. (a -> b) -> a -> b
$
Proxy 'Ecdsa_secp384r1_sha384
-> KeyPair 'Ecdsa_secp384r1_sha384 -> SomeKeyPair
forall (ss :: SignatureSchemeTag).
IsSignatureScheme ss =>
Proxy ss -> KeyPair ss -> SomeKeyPair
SomeKeyPair
(forall {k} (t :: k). Proxy t
forall (t :: SignatureSchemeTag). Proxy t
Proxy @Ecdsa_secp384r1_sha384)
(MLSPrivateKeys -> KeyPair 'Ecdsa_secp384r1_sha384
mlsKeyPair_ecdsa_secp384r1_sha384 MLSPrivateKeys
keys)
SignatureSchemeTag
Ecdsa_secp521r1_sha512 ->
SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a. a -> Sem (Error () : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeKeyPair -> Sem (Error () : r) SomeKeyPair)
-> SomeKeyPair -> Sem (Error () : r) SomeKeyPair
forall a b. (a -> b) -> a -> b
$
Proxy 'Ecdsa_secp521r1_sha512
-> KeyPair 'Ecdsa_secp521r1_sha512 -> SomeKeyPair
forall (ss :: SignatureSchemeTag).
IsSignatureScheme ss =>
Proxy ss -> KeyPair ss -> SomeKeyPair
SomeKeyPair
(forall {k} (t :: k). Proxy t
forall (t :: SignatureSchemeTag). Proxy t
Proxy @Ecdsa_secp521r1_sha512)
(MLSPrivateKeys -> KeyPair 'Ecdsa_secp521r1_sha512
mlsKeyPair_ecdsa_secp521r1_sha512 MLSPrivateKeys
keys)