-- 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.GroupInfo
  ( GroupContext (..),
    GroupInfo (..),
    GroupInfoData (..),
  )
where

import Data.Binary.Get
import Data.Binary.Put
import Data.ByteString.Lazy qualified as LBS
import Data.OpenApi qualified as S
import GHC.Records
import Imports
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Epoch
import Wire.API.MLS.Extension
import Wire.API.MLS.Group
import Wire.API.MLS.ProtocolVersion
import Wire.API.MLS.Serialisation
import Wire.Arbitrary

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-8.1-2
data GroupContext = GroupContext
  { GroupContext -> ProtocolVersion
protocolVersion :: ProtocolVersion,
    GroupContext -> CipherSuite
cipherSuite :: CipherSuite,
    GroupContext -> GroupId
groupId :: GroupId,
    GroupContext -> Epoch
epoch :: Epoch,
    GroupContext -> ByteString
treeHash :: ByteString,
    GroupContext -> ByteString
confirmedTranscriptHash :: ByteString,
    GroupContext -> [Extension]
extensions :: [Extension]
  }
  deriving stock (GroupContext -> GroupContext -> Bool
(GroupContext -> GroupContext -> Bool)
-> (GroupContext -> GroupContext -> Bool) -> Eq GroupContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupContext -> GroupContext -> Bool
== :: GroupContext -> GroupContext -> Bool
$c/= :: GroupContext -> GroupContext -> Bool
/= :: GroupContext -> GroupContext -> Bool
Eq, Int -> GroupContext -> ShowS
[GroupContext] -> ShowS
GroupContext -> String
(Int -> GroupContext -> ShowS)
-> (GroupContext -> String)
-> ([GroupContext] -> ShowS)
-> Show GroupContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupContext -> ShowS
showsPrec :: Int -> GroupContext -> ShowS
$cshow :: GroupContext -> String
show :: GroupContext -> String
$cshowList :: [GroupContext] -> ShowS
showList :: [GroupContext] -> ShowS
Show, (forall x. GroupContext -> Rep GroupContext x)
-> (forall x. Rep GroupContext x -> GroupContext)
-> Generic GroupContext
forall x. Rep GroupContext x -> GroupContext
forall x. GroupContext -> Rep GroupContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupContext -> Rep GroupContext x
from :: forall x. GroupContext -> Rep GroupContext x
$cto :: forall x. Rep GroupContext x -> GroupContext
to :: forall x. Rep GroupContext x -> GroupContext
Generic)
  deriving (Gen GroupContext
Gen GroupContext
-> (GroupContext -> [GroupContext]) -> Arbitrary GroupContext
GroupContext -> [GroupContext]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GroupContext
arbitrary :: Gen GroupContext
$cshrink :: GroupContext -> [GroupContext]
shrink :: GroupContext -> [GroupContext]
Arbitrary) via (GenericUniform GroupContext)

instance ParseMLS GroupContext where
  parseMLS :: Get GroupContext
parseMLS =
    ProtocolVersion
-> CipherSuite
-> GroupId
-> Epoch
-> ByteString
-> ByteString
-> [Extension]
-> GroupContext
GroupContext
      (ProtocolVersion
 -> CipherSuite
 -> GroupId
 -> Epoch
 -> ByteString
 -> ByteString
 -> [Extension]
 -> GroupContext)
-> Get ProtocolVersion
-> Get
     (CipherSuite
      -> GroupId
      -> Epoch
      -> ByteString
      -> ByteString
      -> [Extension]
      -> GroupContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ProtocolVersion
forall a. ParseMLS a => Get a
parseMLS
      Get
  (CipherSuite
   -> GroupId
   -> Epoch
   -> ByteString
   -> ByteString
   -> [Extension]
   -> GroupContext)
-> Get CipherSuite
-> Get
     (GroupId
      -> Epoch
      -> ByteString
      -> ByteString
      -> [Extension]
      -> GroupContext)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get CipherSuite
forall a. ParseMLS a => Get a
parseMLS
      Get
  (GroupId
   -> Epoch
   -> ByteString
   -> ByteString
   -> [Extension]
   -> GroupContext)
-> Get GroupId
-> Get
     (Epoch -> ByteString -> ByteString -> [Extension] -> GroupContext)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get GroupId
forall a. ParseMLS a => Get a
parseMLS
      Get
  (Epoch -> ByteString -> ByteString -> [Extension] -> GroupContext)
-> Get Epoch
-> Get (ByteString -> ByteString -> [Extension] -> GroupContext)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Epoch
forall a. ParseMLS a => Get a
parseMLS
      Get (ByteString -> ByteString -> [Extension] -> GroupContext)
-> Get ByteString
-> Get (ByteString -> [Extension] -> GroupContext)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Get (ByteString -> [Extension] -> GroupContext)
-> Get ByteString -> Get ([Extension] -> GroupContext)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Get ([Extension] -> GroupContext)
-> Get [Extension] -> Get GroupContext
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w a. (Binary w, Integral w) => Get a -> Get [a]
parseMLSVector @VarInt Get Extension
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS GroupContext where
  serialiseMLS :: GroupContext -> Put
serialiseMLS GroupContext
gc = do
    ProtocolVersion -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupContext
gc.protocolVersion
    CipherSuite -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupContext
gc.cipherSuite
    GroupId -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupContext
gc.groupId
    Epoch -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupContext
gc.epoch
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt GroupContext
gc.treeHash
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt GroupContext
gc.confirmedTranscriptHash
    forall w a. (Binary w, Integral w) => (a -> Put) -> [a] -> Put
serialiseMLSVector @VarInt Extension -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupContext
gc.extensions

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-12.4.3-7
data GroupInfoTBS = GroupInfoTBS
  { GroupInfoTBS -> GroupContext
groupContext :: GroupContext,
    GroupInfoTBS -> [Extension]
extensions :: [Extension],
    GroupInfoTBS -> ByteString
confirmationTag :: ByteString,
    GroupInfoTBS -> Word32
signer :: Word32
  }
  deriving stock (GroupInfoTBS -> GroupInfoTBS -> Bool
(GroupInfoTBS -> GroupInfoTBS -> Bool)
-> (GroupInfoTBS -> GroupInfoTBS -> Bool) -> Eq GroupInfoTBS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupInfoTBS -> GroupInfoTBS -> Bool
== :: GroupInfoTBS -> GroupInfoTBS -> Bool
$c/= :: GroupInfoTBS -> GroupInfoTBS -> Bool
/= :: GroupInfoTBS -> GroupInfoTBS -> Bool
Eq, Int -> GroupInfoTBS -> ShowS
[GroupInfoTBS] -> ShowS
GroupInfoTBS -> String
(Int -> GroupInfoTBS -> ShowS)
-> (GroupInfoTBS -> String)
-> ([GroupInfoTBS] -> ShowS)
-> Show GroupInfoTBS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupInfoTBS -> ShowS
showsPrec :: Int -> GroupInfoTBS -> ShowS
$cshow :: GroupInfoTBS -> String
show :: GroupInfoTBS -> String
$cshowList :: [GroupInfoTBS] -> ShowS
showList :: [GroupInfoTBS] -> ShowS
Show, (forall x. GroupInfoTBS -> Rep GroupInfoTBS x)
-> (forall x. Rep GroupInfoTBS x -> GroupInfoTBS)
-> Generic GroupInfoTBS
forall x. Rep GroupInfoTBS x -> GroupInfoTBS
forall x. GroupInfoTBS -> Rep GroupInfoTBS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupInfoTBS -> Rep GroupInfoTBS x
from :: forall x. GroupInfoTBS -> Rep GroupInfoTBS x
$cto :: forall x. Rep GroupInfoTBS x -> GroupInfoTBS
to :: forall x. Rep GroupInfoTBS x -> GroupInfoTBS
Generic)
  deriving (Gen GroupInfoTBS
Gen GroupInfoTBS
-> (GroupInfoTBS -> [GroupInfoTBS]) -> Arbitrary GroupInfoTBS
GroupInfoTBS -> [GroupInfoTBS]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GroupInfoTBS
arbitrary :: Gen GroupInfoTBS
$cshrink :: GroupInfoTBS -> [GroupInfoTBS]
shrink :: GroupInfoTBS -> [GroupInfoTBS]
Arbitrary) via (GenericUniform GroupInfoTBS)

instance ParseMLS GroupInfoTBS where
  parseMLS :: Get GroupInfoTBS
parseMLS =
    GroupContext -> [Extension] -> ByteString -> Word32 -> GroupInfoTBS
GroupInfoTBS
      (GroupContext
 -> [Extension] -> ByteString -> Word32 -> GroupInfoTBS)
-> Get GroupContext
-> Get ([Extension] -> ByteString -> Word32 -> GroupInfoTBS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GroupContext
forall a. ParseMLS a => Get a
parseMLS
      Get ([Extension] -> ByteString -> Word32 -> GroupInfoTBS)
-> Get [Extension] -> Get (ByteString -> Word32 -> GroupInfoTBS)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w a. (Binary w, Integral w) => Get a -> Get [a]
parseMLSVector @VarInt Get Extension
forall a. ParseMLS a => Get a
parseMLS
      Get (ByteString -> Word32 -> GroupInfoTBS)
-> Get ByteString -> Get (Word32 -> GroupInfoTBS)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt
      Get (Word32 -> GroupInfoTBS) -> Get Word32 -> Get GroupInfoTBS
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
forall a. ParseMLS a => Get a
parseMLS

instance SerialiseMLS GroupInfoTBS where
  serialiseMLS :: GroupInfoTBS -> Put
serialiseMLS GroupInfoTBS
tbs = do
    GroupContext -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupInfoTBS
tbs.groupContext
    forall w a. (Binary w, Integral w) => (a -> Put) -> [a] -> Put
serialiseMLSVector @VarInt Extension -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupInfoTBS
tbs.extensions
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt GroupInfoTBS
tbs.confirmationTag
    Word32 -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupInfoTBS
tbs.signer

-- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-12.4.3-2
data GroupInfo = GroupInfo
  { GroupInfo -> GroupInfoTBS
tbs :: GroupInfoTBS,
    GroupInfo -> ByteString
signature_ :: ByteString
  }
  deriving stock (GroupInfo -> GroupInfo -> Bool
(GroupInfo -> GroupInfo -> Bool)
-> (GroupInfo -> GroupInfo -> Bool) -> Eq GroupInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupInfo -> GroupInfo -> Bool
== :: GroupInfo -> GroupInfo -> Bool
$c/= :: GroupInfo -> GroupInfo -> Bool
/= :: GroupInfo -> GroupInfo -> Bool
Eq, Int -> GroupInfo -> ShowS
[GroupInfo] -> ShowS
GroupInfo -> String
(Int -> GroupInfo -> ShowS)
-> (GroupInfo -> String)
-> ([GroupInfo] -> ShowS)
-> Show GroupInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupInfo -> ShowS
showsPrec :: Int -> GroupInfo -> ShowS
$cshow :: GroupInfo -> String
show :: GroupInfo -> String
$cshowList :: [GroupInfo] -> ShowS
showList :: [GroupInfo] -> ShowS
Show, (forall x. GroupInfo -> Rep GroupInfo x)
-> (forall x. Rep GroupInfo x -> GroupInfo) -> Generic GroupInfo
forall x. Rep GroupInfo x -> GroupInfo
forall x. GroupInfo -> Rep GroupInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GroupInfo -> Rep GroupInfo x
from :: forall x. GroupInfo -> Rep GroupInfo x
$cto :: forall x. Rep GroupInfo x -> GroupInfo
to :: forall x. Rep GroupInfo x -> GroupInfo
Generic)
  deriving (Gen GroupInfo
Gen GroupInfo -> (GroupInfo -> [GroupInfo]) -> Arbitrary GroupInfo
GroupInfo -> [GroupInfo]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GroupInfo
arbitrary :: Gen GroupInfo
$cshrink :: GroupInfo -> [GroupInfo]
shrink :: GroupInfo -> [GroupInfo]
Arbitrary) via (GenericUniform GroupInfo)

instance ParseMLS GroupInfo where
  parseMLS :: Get GroupInfo
parseMLS =
    GroupInfoTBS -> ByteString -> GroupInfo
GroupInfo
      (GroupInfoTBS -> ByteString -> GroupInfo)
-> Get GroupInfoTBS -> Get (ByteString -> GroupInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get GroupInfoTBS
forall a. ParseMLS a => Get a
parseMLS
      Get (ByteString -> GroupInfo) -> Get ByteString -> Get GroupInfo
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall w. (Binary w, Integral w) => Get ByteString
parseMLSBytes @VarInt

instance SerialiseMLS GroupInfo where
  serialiseMLS :: GroupInfo -> Put
serialiseMLS GroupInfo
gi = do
    GroupInfoTBS -> Put
forall a. SerialiseMLS a => a -> Put
serialiseMLS GroupInfo
gi.tbs
    forall w. (Binary w, Integral w) => ByteString -> Put
serialiseMLSBytes @VarInt GroupInfo
gi.signature_

instance HasField "groupContext" GroupInfo GroupContext where
  getField :: GroupInfo -> GroupContext
getField = (.tbs.groupContext)

instance HasField "extensions" GroupInfo [Extension] where
  getField :: GroupInfo -> [Extension]
getField = (.tbs.extensions)

instance HasField "confirmationTag" GroupInfo ByteString where
  getField :: GroupInfo -> ByteString
getField = (.tbs.confirmationTag)

instance HasField "signer" GroupInfo Word32 where
  getField :: GroupInfo -> Word32
getField = (.tbs.signer)

newtype GroupInfoData = GroupInfoData {GroupInfoData -> ByteString
unGroupInfoData :: ByteString}
  deriving stock (GroupInfoData -> GroupInfoData -> Bool
(GroupInfoData -> GroupInfoData -> Bool)
-> (GroupInfoData -> GroupInfoData -> Bool) -> Eq GroupInfoData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupInfoData -> GroupInfoData -> Bool
== :: GroupInfoData -> GroupInfoData -> Bool
$c/= :: GroupInfoData -> GroupInfoData -> Bool
/= :: GroupInfoData -> GroupInfoData -> Bool
Eq, Eq GroupInfoData
Eq GroupInfoData =>
(GroupInfoData -> GroupInfoData -> Ordering)
-> (GroupInfoData -> GroupInfoData -> Bool)
-> (GroupInfoData -> GroupInfoData -> Bool)
-> (GroupInfoData -> GroupInfoData -> Bool)
-> (GroupInfoData -> GroupInfoData -> Bool)
-> (GroupInfoData -> GroupInfoData -> GroupInfoData)
-> (GroupInfoData -> GroupInfoData -> GroupInfoData)
-> Ord GroupInfoData
GroupInfoData -> GroupInfoData -> Bool
GroupInfoData -> GroupInfoData -> Ordering
GroupInfoData -> GroupInfoData -> GroupInfoData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GroupInfoData -> GroupInfoData -> Ordering
compare :: GroupInfoData -> GroupInfoData -> Ordering
$c< :: GroupInfoData -> GroupInfoData -> Bool
< :: GroupInfoData -> GroupInfoData -> Bool
$c<= :: GroupInfoData -> GroupInfoData -> Bool
<= :: GroupInfoData -> GroupInfoData -> Bool
$c> :: GroupInfoData -> GroupInfoData -> Bool
> :: GroupInfoData -> GroupInfoData -> Bool
$c>= :: GroupInfoData -> GroupInfoData -> Bool
>= :: GroupInfoData -> GroupInfoData -> Bool
$cmax :: GroupInfoData -> GroupInfoData -> GroupInfoData
max :: GroupInfoData -> GroupInfoData -> GroupInfoData
$cmin :: GroupInfoData -> GroupInfoData -> GroupInfoData
min :: GroupInfoData -> GroupInfoData -> GroupInfoData
Ord, Int -> GroupInfoData -> ShowS
[GroupInfoData] -> ShowS
GroupInfoData -> String
(Int -> GroupInfoData -> ShowS)
-> (GroupInfoData -> String)
-> ([GroupInfoData] -> ShowS)
-> Show GroupInfoData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupInfoData -> ShowS
showsPrec :: Int -> GroupInfoData -> ShowS
$cshow :: GroupInfoData -> String
show :: GroupInfoData -> String
$cshowList :: [GroupInfoData] -> ShowS
showList :: [GroupInfoData] -> ShowS
Show)
  deriving newtype (Gen GroupInfoData
Gen GroupInfoData
-> (GroupInfoData -> [GroupInfoData]) -> Arbitrary GroupInfoData
GroupInfoData -> [GroupInfoData]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GroupInfoData
arbitrary :: Gen GroupInfoData
$cshrink :: GroupInfoData -> [GroupInfoData]
shrink :: GroupInfoData -> [GroupInfoData]
Arbitrary)

instance ParseMLS GroupInfoData where
  parseMLS :: Get GroupInfoData
parseMLS = ByteString -> GroupInfoData
GroupInfoData (ByteString -> GroupInfoData)
-> (ByteString -> ByteString) -> ByteString -> GroupInfoData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> GroupInfoData)
-> Get ByteString -> Get GroupInfoData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
getRemainingLazyByteString

instance SerialiseMLS GroupInfoData where
  serialiseMLS :: GroupInfoData -> Put
serialiseMLS (GroupInfoData ByteString
bs) = ByteString -> Put
putByteString ByteString
bs

instance S.ToSchema GroupInfoData where
  declareNamedSchema :: Proxy GroupInfoData -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy GroupInfoData
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> NamedSchema
mlsSwagger Text
"GroupInfoData")