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

-- This is a duplicate of `Galley.Types.Conversations.One2One`
-- and is needed because we do not have access to galley code in the integration tests
module Testlib.One2One (generateRemoteAndConvIdWithDomain) where

import Control.Error (atMay)
import qualified Crypto.Hash as Crypto
import Data.Bits
import Data.ByteArray (convert)
import Data.ByteString
import qualified Data.ByteString as B
import Data.ByteString.Conversion
import qualified Data.ByteString.Lazy as L
import Data.UUID as UUID
import SetupHelpers (randomUser)
import Testlib.Prelude

generateRemoteAndConvIdWithDomain :: (MakesValue domain, MakesValue a) => domain -> Bool -> a -> App (Value, Value)
generateRemoteAndConvIdWithDomain :: forall domain a.
(MakesValue domain, MakesValue a) =>
domain -> Bool -> a -> App (Value, Value)
generateRemoteAndConvIdWithDomain domain
remoteDomain Bool
shouldBeLocal a
lUserId = do
  (String
localDomain, String
localUser) <- a -> App (String, String)
forall a. (HasCallStack, MakesValue a) => a -> App (String, String)
objQid a
lUserId
  String
otherUsr <- domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser domain
remoteDomain CreateUser
forall a. Default a => a
def App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId
  String
otherDomain <- domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString domain
remoteDomain
  let (UUID
cId, String
cDomain) =
        (UUID, String) -> (UUID, String) -> (UUID, String)
one2OneConvId
          (UUID -> Maybe UUID -> UUID
forall a. a -> Maybe a -> a
fromMaybe (String -> UUID
forall a. HasCallStack => String -> a
error String
"invalid UUID") (String -> Maybe UUID
UUID.fromString String
localUser), String
localDomain)
          (UUID -> Maybe UUID -> UUID
forall a. a -> Maybe a -> a
fromMaybe (String -> UUID
forall a. HasCallStack => String -> a
error String
"invalid UUID") (String -> Maybe UUID
UUID.fromString String
otherUsr), String
otherDomain)
      isLocal :: Bool
isLocal = String
localDomain String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
cDomain
  if Bool
shouldBeLocal Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
isLocal
    then
      (Value, Value) -> App (Value, Value)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ((Value, Value) -> App (Value, Value))
-> (Value, Value) -> App (Value, Value)
forall a b. (a -> b) -> a -> b
$ ( [Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (String
otherUsr), String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
otherDomain],
            [Pair] -> Value
object [String
"id" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (UUID -> String
UUID.toString UUID
cId), String
"domain" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
cDomain]
          )
    else domain -> Bool -> a -> App (Value, Value)
forall domain a.
(MakesValue domain, MakesValue a) =>
domain -> Bool -> a -> App (Value, Value)
generateRemoteAndConvIdWithDomain domain
remoteDomain Bool
shouldBeLocal a
lUserId

one2OneConvId :: (UUID, String) -> (UUID, String) -> (UUID, String)
one2OneConvId :: (UUID, String) -> (UUID, String) -> (UUID, String)
one2OneConvId a :: (UUID, String)
a@(UUID
a1, String
dom1) b :: (UUID, String)
b@(UUID
a2, String
dom2) = case (String, UUID) -> (String, UUID) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String
dom1, UUID
a1) (String
dom2, UUID
a2) of
  Ordering
GT -> (UUID, String) -> (UUID, String) -> (UUID, String)
one2OneConvId (UUID, String)
b (UUID, String)
a
  Ordering
_ ->
    let c :: ByteString
c =
          [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
            [ ByteString -> ByteString
L.toStrict (UUID -> ByteString
UUID.toByteString UUID
namespace),
              (UUID, String) -> ByteString
quidToByteString (UUID, String)
a,
              (UUID, String) -> ByteString
quidToByteString (UUID, String)
b
            ]
        x :: ByteString
x = ByteString -> ByteString
hash ByteString
c
        result :: UUID
result =
          UuidV5 -> UUID
toUuidV5
            (UuidV5 -> UUID) -> (ByteString -> UuidV5) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> UuidV5
mkV5
            (UUID -> UuidV5) -> (ByteString -> UUID) -> ByteString -> UuidV5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Maybe UUID -> UUID
forall a. a -> Maybe a -> a
fromMaybe UUID
nil
            (Maybe UUID -> UUID)
-> (ByteString -> Maybe UUID) -> ByteString -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe UUID
UUID.fromByteString
            (ByteString -> Maybe UUID)
-> (ByteString -> ByteString) -> ByteString -> Maybe UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
            (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
16
            (ByteString -> UUID) -> ByteString -> UUID
forall a b. (a -> b) -> a -> b
$ ByteString
x
        domain :: String
domain
          | Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe Word8
0 ([Word8] -> Int -> Maybe Word8
forall a. [a] -> Int -> Maybe a
atMay (ByteString -> [Word8]
B.unpack ByteString
x) Int
16) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = String
dom1
          | Bool
otherwise = String
dom2
     in (UUID
result, String
domain)
  where
    hash :: ByteString -> ByteString
    hash :: ByteString -> ByteString
hash = Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest SHA256 -> ByteString)
-> (ByteString -> Digest SHA256) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash @ByteString @Crypto.SHA256

    namespace :: UUID
    namespace :: UUID
namespace = Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords Word32
0x9a51edb8 Word32
0x060c0d9a Word32
0x0c2950a8 Word32
0x5d152982

    quidToByteString :: (UUID, String) -> ByteString
    quidToByteString :: (UUID, String) -> ByteString
quidToByteString (UUID
uid, String
domain) = UUID -> ByteString
toASCIIBytes UUID
uid ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' String
domain

newtype UuidV5 = UuidV5 {UuidV5 -> UUID
toUuidV5 :: UUID}
  deriving (UuidV5 -> UuidV5 -> Bool
(UuidV5 -> UuidV5 -> Bool)
-> (UuidV5 -> UuidV5 -> Bool) -> Eq UuidV5
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UuidV5 -> UuidV5 -> Bool
== :: UuidV5 -> UuidV5 -> Bool
$c/= :: UuidV5 -> UuidV5 -> Bool
/= :: UuidV5 -> UuidV5 -> Bool
Eq, Eq UuidV5
Eq UuidV5 =>
(UuidV5 -> UuidV5 -> Ordering)
-> (UuidV5 -> UuidV5 -> Bool)
-> (UuidV5 -> UuidV5 -> Bool)
-> (UuidV5 -> UuidV5 -> Bool)
-> (UuidV5 -> UuidV5 -> Bool)
-> (UuidV5 -> UuidV5 -> UuidV5)
-> (UuidV5 -> UuidV5 -> UuidV5)
-> Ord UuidV5
UuidV5 -> UuidV5 -> Bool
UuidV5 -> UuidV5 -> Ordering
UuidV5 -> UuidV5 -> UuidV5
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 :: UuidV5 -> UuidV5 -> Ordering
compare :: UuidV5 -> UuidV5 -> Ordering
$c< :: UuidV5 -> UuidV5 -> Bool
< :: UuidV5 -> UuidV5 -> Bool
$c<= :: UuidV5 -> UuidV5 -> Bool
<= :: UuidV5 -> UuidV5 -> Bool
$c> :: UuidV5 -> UuidV5 -> Bool
> :: UuidV5 -> UuidV5 -> Bool
$c>= :: UuidV5 -> UuidV5 -> Bool
>= :: UuidV5 -> UuidV5 -> Bool
$cmax :: UuidV5 -> UuidV5 -> UuidV5
max :: UuidV5 -> UuidV5 -> UuidV5
$cmin :: UuidV5 -> UuidV5 -> UuidV5
min :: UuidV5 -> UuidV5 -> UuidV5
Ord, Int -> UuidV5 -> ShowS
[UuidV5] -> ShowS
UuidV5 -> String
(Int -> UuidV5 -> ShowS)
-> (UuidV5 -> String) -> ([UuidV5] -> ShowS) -> Show UuidV5
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UuidV5 -> ShowS
showsPrec :: Int -> UuidV5 -> ShowS
$cshow :: UuidV5 -> String
show :: UuidV5 -> String
$cshowList :: [UuidV5] -> ShowS
showList :: [UuidV5] -> ShowS
Show)

mkV5 :: UUID -> UuidV5
mkV5 :: UUID -> UuidV5
mkV5 UUID
u = UUID -> UuidV5
UuidV5
  (UUID -> UuidV5) -> UUID -> UuidV5
forall a b. (a -> b) -> a -> b
$ case UUID -> (Word32, Word32, Word32, Word32)
toWords UUID
u of
    (Word32
x0, Word32
x1, Word32
x2, Word32
x3) ->
      Word32 -> Word32 -> Word32 -> Word32 -> UUID
fromWords
        Word32
x0
        (Word32 -> Word32 -> Word32
retainVersion Word32
5 Word32
x1)
        (Word32 -> Word32 -> Word32
retainVariant Word32
2 Word32
x2)
        Word32
x3
  where
    retainVersion :: Word32 -> Word32 -> Word32
    retainVersion :: Word32 -> Word32 -> Word32
retainVersion Word32
v Word32
x = (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFFFF0FFF) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
12)

    retainVariant :: Word32 -> Word32 -> Word32
    retainVariant :: Word32 -> Word32 -> Word32
retainVariant Word32
v Word32
x = (Word32
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x3FFFFFFF) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word32
v Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
30)