-- 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 Brig.API.MLS.KeyPackages.Validation
  ( -- * Main key package validation function
    validateUploadedKeyPackage,
    validateLifetime',
    mlsProtocolError,
  )
where

import Brig.API.Error
import Brig.API.Handler
import Brig.App
import Brig.Options
import Control.Applicative
import Data.ByteString qualified as LBS
import Data.Qualified
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Imports
import Polysemy
import Wire.API.Error
import Wire.API.Error.Brig
import Wire.API.Error.Brig qualified as E
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Credential
import Wire.API.MLS.KeyPackage
import Wire.API.MLS.Lifetime
import Wire.API.MLS.Serialisation
import Wire.API.MLS.Validation
import Wire.API.MLS.Validation.Error (toText)
import Wire.ClientStore (ClientStore)
import Wire.ClientStore qualified as ClientStore
import Wire.MlsKeyPackageSubsystem qualified as Mls

validateUploadedKeyPackage ::
  (Member ClientStore r) =>
  ClientIdentity ->
  RawMLS KeyPackage ->
  Handler r (KeyPackageRef, CipherSuiteTag, KeyPackageData)
validateUploadedKeyPackage identity kp = do
  (cs, lt) <- either mlsProtocolErrorFromValidationError pure $ validateKeyPackage (Just $ RegularClient identity) kp.value

  validateLifetime lt

  -- Authenticate signature key. This is performed only upon uploading a key
  -- package for a local client.
  loc <- qualifyLocal ()
  foldQualified
    loc
    ( \_ -> do
        mkey :: Maybe LByteString <-
          lift . liftSem $
            ClientStore.lookupMLSPublicKey
              (ciUser identity)
              (ciClient identity)
              (csSignatureScheme cs)
        key :: LByteString <-
          maybe
            (mlsProtocolError "No key associated to the given identity and signature scheme")
            pure
            mkey
        when (key /= LBS.fromStrict kp.value.leafNode.signatureKey) $
          mlsProtocolError "Unrecognised signature key"
    )
    (\_ -> pure ())
    (cidQualifiedClient identity)

  let kpd = KeyPackageData kp.raw
  pure (kpRef cs kpd, cs, kpd)

validateLifetime :: Lifetime -> Handler r ()
validateLifetime lt = do
  now <- liftIO getPOSIXTime
  mMaxLifetime <- asks (.settings.keyPackageMaximumLifetime)
  either mlsProtocolError pure $
    validateLifetime' now mMaxLifetime lt

validateLifetime' :: POSIXTime -> Maybe NominalDiffTime -> Lifetime -> Either Text ()
validateLifetime' = Mls.validateKeyPackageLifetime

mlsProtocolErrorFromValidationError :: ValidationError -> Handler r a
mlsProtocolErrorFromValidationError InvalidLeafNodeSignature = throwStd (errorToWai @E.MLSInvalidLeafNodeSignature)
mlsProtocolErrorFromValidationError err = mlsProtocolError (toText err)

mlsProtocolError :: Text -> Handler r a
mlsProtocolError msg =
  throwStd . dynErrorToWai $
    (dynError @(MapError 'MLSProtocolError))
      { eMessage = msg
      }
