-- 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 Wire.API.MLS.AuthenticatedContent
  ( AuthenticatedContent (..),
    TaggedSender (..),
    authContentRef,
    publicMessageRef,
    mkSignedPublicMessage,
  )
where

import Crypto.Random.Types
import Imports
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Context
import Wire.API.MLS.Epoch
import Wire.API.MLS.Group
import Wire.API.MLS.LeafNode
import Wire.API.MLS.Message
import Wire.API.MLS.Proposal
import Wire.API.MLS.ProtocolVersion
import Wire.API.MLS.Serialisation

-- | Needed to compute proposal refs.
-- https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-7
data AuthenticatedContent = AuthenticatedContent
  { AuthenticatedContent -> WireFormatTag
wireFormat :: WireFormatTag,
    AuthenticatedContent -> RawMLS FramedContent
content :: RawMLS FramedContent,
    AuthenticatedContent -> RawMLS FramedContentAuthData
authData :: RawMLS FramedContentAuthData
  }
  deriving (AuthenticatedContent -> AuthenticatedContent -> Bool
(AuthenticatedContent -> AuthenticatedContent -> Bool)
-> (AuthenticatedContent -> AuthenticatedContent -> Bool)
-> Eq AuthenticatedContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthenticatedContent -> AuthenticatedContent -> Bool
== :: AuthenticatedContent -> AuthenticatedContent -> Bool
$c/= :: AuthenticatedContent -> AuthenticatedContent -> Bool
/= :: AuthenticatedContent -> AuthenticatedContent -> Bool
Eq, Int -> AuthenticatedContent -> ShowS
[AuthenticatedContent] -> ShowS
AuthenticatedContent -> String
(Int -> AuthenticatedContent -> ShowS)
-> (AuthenticatedContent -> String)
-> ([AuthenticatedContent] -> ShowS)
-> Show AuthenticatedContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthenticatedContent -> ShowS
showsPrec :: Int -> AuthenticatedContent -> ShowS
$cshow :: AuthenticatedContent -> String
show :: AuthenticatedContent -> String
$cshowList :: [AuthenticatedContent] -> ShowS
showList :: [AuthenticatedContent] -> ShowS
Show)

instance SerialiseMLS AuthenticatedContent where
  serialiseMLS :: AuthenticatedContent -> Put
serialiseMLS AuthenticatedContent
ac = do
    WireFormatTag -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS AuthenticatedContent
ac.wireFormat
    RawMLS FramedContent -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS AuthenticatedContent
ac.content
    RawMLS FramedContentAuthData -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS AuthenticatedContent
ac.authData

msgAuthContent :: PublicMessage -> AuthenticatedContent
msgAuthContent :: PublicMessage -> AuthenticatedContent
msgAuthContent PublicMessage
msg =
  AuthenticatedContent
    { $sel:wireFormat:AuthenticatedContent :: WireFormatTag
wireFormat = WireFormatTag
WireFormatPublicTag,
      $sel:content:AuthenticatedContent :: RawMLS FramedContent
content = PublicMessage
msg.content,
      $sel:authData:AuthenticatedContent :: RawMLS FramedContentAuthData
authData = PublicMessage
msg.authData
    }

-- | Compute the proposal ref given a ciphersuite and the raw proposal data.
authContentRef :: CipherSuiteTag -> AuthenticatedContent -> ProposalRef
authContentRef :: CipherSuiteTag -> AuthenticatedContent -> ProposalRef
authContentRef CipherSuiteTag
cs = ByteString -> ProposalRef
ProposalRef (ByteString -> ProposalRef)
-> (AuthenticatedContent -> ByteString)
-> AuthenticatedContent
-> ProposalRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CipherSuiteTag
-> ByteString -> RawMLS AuthenticatedContent -> ByteString
forall a. CipherSuiteTag -> ByteString -> RawMLS a -> ByteString
csHash CipherSuiteTag
cs ByteString
proposalContext (RawMLS AuthenticatedContent -> ByteString)
-> (AuthenticatedContent -> RawMLS AuthenticatedContent)
-> AuthenticatedContent
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthenticatedContent -> RawMLS AuthenticatedContent
forall a. SerialiseMLS a => a -> RawMLS a
mkRawMLS

publicMessageRef :: CipherSuiteTag -> PublicMessage -> ProposalRef
publicMessageRef :: CipherSuiteTag -> PublicMessage -> ProposalRef
publicMessageRef CipherSuiteTag
cs = CipherSuiteTag -> AuthenticatedContent -> ProposalRef
authContentRef CipherSuiteTag
cs (AuthenticatedContent -> ProposalRef)
-> (PublicMessage -> AuthenticatedContent)
-> PublicMessage
-> ProposalRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicMessage -> AuthenticatedContent
msgAuthContent

-- | Sender, plus with a membership tag in the case of a member sender.
data TaggedSender
  = TaggedSenderMember LeafIndex ByteString
  | TaggedSenderExternal Word32
  | TaggedSenderNewMemberProposal
  | TaggedSenderNewMemberCommit

taggedSenderToSender :: TaggedSender -> Sender
taggedSenderToSender :: TaggedSender -> Sender
taggedSenderToSender (TaggedSenderMember LeafIndex
i ByteString
_) = LeafIndex -> Sender
SenderMember LeafIndex
i
taggedSenderToSender (TaggedSenderExternal LeafIndex
n) = LeafIndex -> Sender
SenderExternal LeafIndex
n
taggedSenderToSender TaggedSender
TaggedSenderNewMemberProposal = Sender
SenderNewMemberProposal
taggedSenderToSender TaggedSender
TaggedSenderNewMemberCommit = Sender
SenderNewMemberCommit

taggedSenderMembershipTag :: TaggedSender -> Maybe ByteString
taggedSenderMembershipTag :: TaggedSender -> Maybe ByteString
taggedSenderMembershipTag (TaggedSenderMember LeafIndex
_ ByteString
t) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
t
taggedSenderMembershipTag TaggedSender
_ = Maybe ByteString
forall a. Maybe a
Nothing

-- | Craft a message with the backend itself as a sender. Return the message and its ref.
mkSignedPublicMessage ::
  forall ss m.
  (IsSignatureScheme ss, MonadRandom m) =>
  KeyPair ss ->
  GroupId ->
  Epoch ->
  TaggedSender ->
  FramedContentData ->
  m PublicMessage
mkSignedPublicMessage :: forall (ss :: SignatureSchemeTag) (m :: * -> *).
(IsSignatureScheme ss, MonadRandom m) =>
KeyPair ss
-> GroupId
-> Epoch
-> TaggedSender
-> FramedContentData
-> m PublicMessage
mkSignedPublicMessage KeyPair ss
kp GroupId
gid Epoch
epoch TaggedSender
sender FramedContentData
payload = do
  let framedContent :: RawMLS FramedContent
framedContent =
        FramedContent -> RawMLS FramedContent
forall a. SerialiseMLS a => a -> RawMLS a
mkRawMLS
          FramedContent
            { $sel:groupId:FramedContent :: GroupId
groupId = GroupId
gid,
              $sel:epoch:FramedContent :: Epoch
epoch = Epoch
epoch,
              $sel:sender:FramedContent :: Sender
sender = TaggedSender -> Sender
taggedSenderToSender TaggedSender
sender,
              $sel:content:FramedContent :: FramedContentData
content = FramedContentData
payload,
              $sel:authenticatedData:FramedContent :: ByteString
authenticatedData = ByteString
forall a. Monoid a => a
mempty
            }
      tbs :: FramedContentTBS
tbs =
        FramedContentTBS
          { $sel:protocolVersion:FramedContentTBS :: ProtocolVersion
protocolVersion = ProtocolVersion
defaultProtocolVersion,
            $sel:wireFormat:FramedContentTBS :: WireFormatTag
wireFormat = WireFormatTag
WireFormatPublicTag,
            $sel:content:FramedContentTBS :: RawMLS FramedContent
content = RawMLS FramedContent
framedContent,
            $sel:groupContext:FramedContentTBS :: Maybe (RawMLS GroupContext)
groupContext = Maybe (RawMLS GroupContext)
forall a. Maybe a
Nothing
          }
  ByteString
sig <- forall (ss :: SignatureSchemeTag) a (m :: * -> *).
(IsSignatureScheme ss, MonadRandom m) =>
ByteString -> KeyPair ss -> RawMLS a -> m ByteString
signWithLabel @ss ByteString
"FramedContentTBS" KeyPair ss
kp (FramedContentTBS -> RawMLS FramedContentTBS
forall a. SerialiseMLS a => a -> RawMLS a
mkRawMLS FramedContentTBS
tbs)
  PublicMessage -> m PublicMessage
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    PublicMessage
      { $sel:content:PublicMessage :: RawMLS FramedContent
content = RawMLS FramedContent
framedContent,
        $sel:authData:PublicMessage :: RawMLS FramedContentAuthData
authData = FramedContentAuthData -> RawMLS FramedContentAuthData
forall a. SerialiseMLS a => a -> RawMLS a
mkRawMLS (ByteString -> Maybe ByteString -> FramedContentAuthData
FramedContentAuthData ByteString
sig Maybe ByteString
forall a. Maybe a
Nothing),
        $sel:membershipTag:PublicMessage :: Maybe ByteString
membershipTag = TaggedSender -> Maybe ByteString
taggedSenderMembershipTag TaggedSender
sender
      }