-- 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.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)