{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

-- 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.User.Client.Prekey
  ( PrekeyId (..),
    Prekey (..),
    clientIdFromPrekey,
    LastPrekey,
    lastPrekey,
    unpackLastPrekey,
    fakeLastPrekey,
    lastPrekeyId,
    PrekeyBundle (..),
    ClientPrekey (..),
  )
where

import Crypto.Hash (SHA256, hash)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Bits
import Data.ByteArray (convert)
import Data.ByteString qualified as BS
import Data.Id
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text.Encoding (encodeUtf8)
import Imports
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))

newtype PrekeyId = PrekeyId {PrekeyId -> Word16
keyId :: Word16}
  deriving stock (PrekeyId -> PrekeyId -> Bool
(PrekeyId -> PrekeyId -> Bool)
-> (PrekeyId -> PrekeyId -> Bool) -> Eq PrekeyId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrekeyId -> PrekeyId -> Bool
== :: PrekeyId -> PrekeyId -> Bool
$c/= :: PrekeyId -> PrekeyId -> Bool
/= :: PrekeyId -> PrekeyId -> Bool
Eq, Eq PrekeyId
Eq PrekeyId =>
(PrekeyId -> PrekeyId -> Ordering)
-> (PrekeyId -> PrekeyId -> Bool)
-> (PrekeyId -> PrekeyId -> Bool)
-> (PrekeyId -> PrekeyId -> Bool)
-> (PrekeyId -> PrekeyId -> Bool)
-> (PrekeyId -> PrekeyId -> PrekeyId)
-> (PrekeyId -> PrekeyId -> PrekeyId)
-> Ord PrekeyId
PrekeyId -> PrekeyId -> Bool
PrekeyId -> PrekeyId -> Ordering
PrekeyId -> PrekeyId -> PrekeyId
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 :: PrekeyId -> PrekeyId -> Ordering
compare :: PrekeyId -> PrekeyId -> Ordering
$c< :: PrekeyId -> PrekeyId -> Bool
< :: PrekeyId -> PrekeyId -> Bool
$c<= :: PrekeyId -> PrekeyId -> Bool
<= :: PrekeyId -> PrekeyId -> Bool
$c> :: PrekeyId -> PrekeyId -> Bool
> :: PrekeyId -> PrekeyId -> Bool
$c>= :: PrekeyId -> PrekeyId -> Bool
>= :: PrekeyId -> PrekeyId -> Bool
$cmax :: PrekeyId -> PrekeyId -> PrekeyId
max :: PrekeyId -> PrekeyId -> PrekeyId
$cmin :: PrekeyId -> PrekeyId -> PrekeyId
min :: PrekeyId -> PrekeyId -> PrekeyId
Ord, Int -> PrekeyId -> ShowS
[PrekeyId] -> ShowS
PrekeyId -> String
(Int -> PrekeyId -> ShowS)
-> (PrekeyId -> String) -> ([PrekeyId] -> ShowS) -> Show PrekeyId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrekeyId -> ShowS
showsPrec :: Int -> PrekeyId -> ShowS
$cshow :: PrekeyId -> String
show :: PrekeyId -> String
$cshowList :: [PrekeyId] -> ShowS
showList :: [PrekeyId] -> ShowS
Show, (forall x. PrekeyId -> Rep PrekeyId x)
-> (forall x. Rep PrekeyId x -> PrekeyId) -> Generic PrekeyId
forall x. Rep PrekeyId x -> PrekeyId
forall x. PrekeyId -> Rep PrekeyId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrekeyId -> Rep PrekeyId x
from :: forall x. PrekeyId -> Rep PrekeyId x
$cto :: forall x. Rep PrekeyId x -> PrekeyId
to :: forall x. Rep PrekeyId x -> PrekeyId
Generic)
  deriving newtype ([PrekeyId] -> Value
[PrekeyId] -> Encoding
PrekeyId -> Value
PrekeyId -> Encoding
(PrekeyId -> Value)
-> (PrekeyId -> Encoding)
-> ([PrekeyId] -> Value)
-> ([PrekeyId] -> Encoding)
-> ToJSON PrekeyId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PrekeyId -> Value
toJSON :: PrekeyId -> Value
$ctoEncoding :: PrekeyId -> Encoding
toEncoding :: PrekeyId -> Encoding
$ctoJSONList :: [PrekeyId] -> Value
toJSONList :: [PrekeyId] -> Value
$ctoEncodingList :: [PrekeyId] -> Encoding
toEncodingList :: [PrekeyId] -> Encoding
ToJSON, Value -> Parser [PrekeyId]
Value -> Parser PrekeyId
(Value -> Parser PrekeyId)
-> (Value -> Parser [PrekeyId]) -> FromJSON PrekeyId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PrekeyId
parseJSON :: Value -> Parser PrekeyId
$cparseJSONList :: Value -> Parser [PrekeyId]
parseJSONList :: Value -> Parser [PrekeyId]
FromJSON, Gen PrekeyId
Gen PrekeyId -> (PrekeyId -> [PrekeyId]) -> Arbitrary PrekeyId
PrekeyId -> [PrekeyId]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PrekeyId
arbitrary :: Gen PrekeyId
$cshrink :: PrekeyId -> [PrekeyId]
shrink :: PrekeyId -> [PrekeyId]
Arbitrary, Typeable PrekeyId
Typeable PrekeyId =>
(Proxy PrekeyId -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PrekeyId
Proxy PrekeyId -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PrekeyId -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PrekeyId -> Declare (Definitions Schema) NamedSchema
S.ToSchema, ValueSchema NamedSwaggerDoc PrekeyId
ValueSchema NamedSwaggerDoc PrekeyId -> ToSchema PrekeyId
forall a. ValueSchema NamedSwaggerDoc a -> ToSchema a
$cschema :: ValueSchema NamedSwaggerDoc PrekeyId
schema :: ValueSchema NamedSwaggerDoc PrekeyId
ToSchema)

--------------------------------------------------------------------------------
-- Prekey

data Prekey = Prekey
  { Prekey -> PrekeyId
prekeyId :: PrekeyId,
    Prekey -> Text
prekeyKey :: Text
  }
  deriving stock (Prekey -> Prekey -> Bool
(Prekey -> Prekey -> Bool)
-> (Prekey -> Prekey -> Bool) -> Eq Prekey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prekey -> Prekey -> Bool
== :: Prekey -> Prekey -> Bool
$c/= :: Prekey -> Prekey -> Bool
/= :: Prekey -> Prekey -> Bool
Eq, Int -> Prekey -> ShowS
[Prekey] -> ShowS
Prekey -> String
(Int -> Prekey -> ShowS)
-> (Prekey -> String) -> ([Prekey] -> ShowS) -> Show Prekey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prekey -> ShowS
showsPrec :: Int -> Prekey -> ShowS
$cshow :: Prekey -> String
show :: Prekey -> String
$cshowList :: [Prekey] -> ShowS
showList :: [Prekey] -> ShowS
Show, (forall x. Prekey -> Rep Prekey x)
-> (forall x. Rep Prekey x -> Prekey) -> Generic Prekey
forall x. Rep Prekey x -> Prekey
forall x. Prekey -> Rep Prekey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prekey -> Rep Prekey x
from :: forall x. Prekey -> Rep Prekey x
$cto :: forall x. Rep Prekey x -> Prekey
to :: forall x. Rep Prekey x -> Prekey
Generic)
  deriving (Gen Prekey
Gen Prekey -> (Prekey -> [Prekey]) -> Arbitrary Prekey
Prekey -> [Prekey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Prekey
arbitrary :: Gen Prekey
$cshrink :: Prekey -> [Prekey]
shrink :: Prekey -> [Prekey]
Arbitrary) via (GenericUniform Prekey)
  deriving (Value -> Parser [Prekey]
Value -> Parser Prekey
(Value -> Parser Prekey)
-> (Value -> Parser [Prekey]) -> FromJSON Prekey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Prekey
parseJSON :: Value -> Parser Prekey
$cparseJSONList :: Value -> Parser [Prekey]
parseJSONList :: Value -> Parser [Prekey]
FromJSON, [Prekey] -> Value
[Prekey] -> Encoding
Prekey -> Value
Prekey -> Encoding
(Prekey -> Value)
-> (Prekey -> Encoding)
-> ([Prekey] -> Value)
-> ([Prekey] -> Encoding)
-> ToJSON Prekey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Prekey -> Value
toJSON :: Prekey -> Value
$ctoEncoding :: Prekey -> Encoding
toEncoding :: Prekey -> Encoding
$ctoJSONList :: [Prekey] -> Value
toJSONList :: [Prekey] -> Value
$ctoEncodingList :: [Prekey] -> Encoding
toEncodingList :: [Prekey] -> Encoding
ToJSON, Typeable Prekey
Typeable Prekey =>
(Proxy Prekey -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Prekey
Proxy Prekey -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy Prekey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy Prekey -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema Prekey

instance ToSchema Prekey where
  schema :: ValueSchema NamedSwaggerDoc Prekey
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] Prekey Prekey
-> ValueSchema NamedSwaggerDoc Prekey
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"Prekey" (SchemaP SwaggerDoc Object [Pair] Prekey Prekey
 -> ValueSchema NamedSwaggerDoc Prekey)
-> SchemaP SwaggerDoc Object [Pair] Prekey Prekey
-> ValueSchema NamedSwaggerDoc Prekey
forall a b. (a -> b) -> a -> b
$
      PrekeyId -> Text -> Prekey
Prekey
        (PrekeyId -> Text -> Prekey)
-> SchemaP SwaggerDoc Object [Pair] Prekey PrekeyId
-> SchemaP SwaggerDoc Object [Pair] Prekey (Text -> Prekey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Prekey -> PrekeyId
prekeyId (Prekey -> PrekeyId)
-> SchemaP SwaggerDoc Object [Pair] PrekeyId PrekeyId
-> SchemaP SwaggerDoc Object [Pair] Prekey PrekeyId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc PrekeyId
-> SchemaP SwaggerDoc Object [Pair] PrekeyId PrekeyId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"id" ValueSchema NamedSwaggerDoc PrekeyId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP SwaggerDoc Object [Pair] Prekey (Text -> Prekey)
-> SchemaP SwaggerDoc Object [Pair] Prekey Text
-> SchemaP SwaggerDoc Object [Pair] Prekey Prekey
forall a b.
SchemaP SwaggerDoc Object [Pair] Prekey (a -> b)
-> SchemaP SwaggerDoc Object [Pair] Prekey a
-> SchemaP SwaggerDoc Object [Pair] Prekey b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Prekey -> Text
prekeyKey (Prekey -> Text)
-> SchemaP SwaggerDoc Object [Pair] Text Text
-> SchemaP SwaggerDoc Object [Pair] Prekey Text
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value Text Text
-> SchemaP SwaggerDoc Object [Pair] Text Text
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"key" SchemaP NamedSwaggerDoc Value Value Text Text
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema

-- | Construct a new client ID from a prekey.
--
-- This works by taking the SHA256 hash of the prekey, truncating it to its
-- first 8 bytes, and interpreting the resulting bytestring as a big endian
-- Word64.
clientIdFromPrekey :: Prekey -> ClientId
clientIdFromPrekey :: Prekey -> ClientId
clientIdFromPrekey =
  Word64 -> ClientId
ClientId
    (Word64 -> ClientId) -> (Prekey -> Word64) -> Prekey -> ClientId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word8 -> Word64) -> Word64 -> [Word8] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Word64
w Word8
d -> (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d) Word64
0
    ([Word8] -> Word64) -> (Prekey -> [Word8]) -> Prekey -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
    (ByteString -> [Word8])
-> (Prekey -> ByteString) -> Prekey -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
8
    (ByteString -> ByteString)
-> (Prekey -> ByteString) -> Prekey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert
    (Digest SHA256 -> ByteString)
-> (Prekey -> Digest SHA256) -> Prekey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @ByteString @SHA256
    (ByteString -> Digest SHA256)
-> (Prekey -> ByteString) -> Prekey -> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
    (Text -> ByteString) -> (Prekey -> Text) -> Prekey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prekey -> Text
prekeyKey

--------------------------------------------------------------------------------
-- LastPrekey

newtype LastPrekey = LastPrekey
  {LastPrekey -> Prekey
unpackLastPrekey :: Prekey}
  deriving stock (LastPrekey -> LastPrekey -> Bool
(LastPrekey -> LastPrekey -> Bool)
-> (LastPrekey -> LastPrekey -> Bool) -> Eq LastPrekey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LastPrekey -> LastPrekey -> Bool
== :: LastPrekey -> LastPrekey -> Bool
$c/= :: LastPrekey -> LastPrekey -> Bool
/= :: LastPrekey -> LastPrekey -> Bool
Eq, Int -> LastPrekey -> ShowS
[LastPrekey] -> ShowS
LastPrekey -> String
(Int -> LastPrekey -> ShowS)
-> (LastPrekey -> String)
-> ([LastPrekey] -> ShowS)
-> Show LastPrekey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LastPrekey -> ShowS
showsPrec :: Int -> LastPrekey -> ShowS
$cshow :: LastPrekey -> String
show :: LastPrekey -> String
$cshowList :: [LastPrekey] -> ShowS
showList :: [LastPrekey] -> ShowS
Show, (forall x. LastPrekey -> Rep LastPrekey x)
-> (forall x. Rep LastPrekey x -> LastPrekey) -> Generic LastPrekey
forall x. Rep LastPrekey x -> LastPrekey
forall x. LastPrekey -> Rep LastPrekey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LastPrekey -> Rep LastPrekey x
from :: forall x. LastPrekey -> Rep LastPrekey x
$cto :: forall x. Rep LastPrekey x -> LastPrekey
to :: forall x. Rep LastPrekey x -> LastPrekey
Generic)
  deriving (Value -> Parser [LastPrekey]
Value -> Parser LastPrekey
(Value -> Parser LastPrekey)
-> (Value -> Parser [LastPrekey]) -> FromJSON LastPrekey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser LastPrekey
parseJSON :: Value -> Parser LastPrekey
$cparseJSONList :: Value -> Parser [LastPrekey]
parseJSONList :: Value -> Parser [LastPrekey]
FromJSON, [LastPrekey] -> Value
[LastPrekey] -> Encoding
LastPrekey -> Value
LastPrekey -> Encoding
(LastPrekey -> Value)
-> (LastPrekey -> Encoding)
-> ([LastPrekey] -> Value)
-> ([LastPrekey] -> Encoding)
-> ToJSON LastPrekey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: LastPrekey -> Value
toJSON :: LastPrekey -> Value
$ctoEncoding :: LastPrekey -> Encoding
toEncoding :: LastPrekey -> Encoding
$ctoJSONList :: [LastPrekey] -> Value
toJSONList :: [LastPrekey] -> Value
$ctoEncodingList :: [LastPrekey] -> Encoding
toEncodingList :: [LastPrekey] -> Encoding
ToJSON, Typeable LastPrekey
Typeable LastPrekey =>
(Proxy LastPrekey -> Declare (Definitions Schema) NamedSchema)
-> ToSchema LastPrekey
Proxy LastPrekey -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy LastPrekey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy LastPrekey -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema LastPrekey

instance ToSchema LastPrekey where
  schema :: ValueSchema NamedSwaggerDoc LastPrekey
schema = Prekey -> LastPrekey
LastPrekey (Prekey -> LastPrekey)
-> SchemaP NamedSwaggerDoc Value Value LastPrekey Prekey
-> ValueSchema NamedSwaggerDoc LastPrekey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LastPrekey -> Prekey
unpackLastPrekey (LastPrekey -> Prekey)
-> ValueSchema NamedSwaggerDoc Prekey
-> SchemaP NamedSwaggerDoc Value Value LastPrekey Prekey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= ValueSchema NamedSwaggerDoc Prekey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema SchemaP NamedSwaggerDoc Value Value LastPrekey Prekey
-> (Prekey -> Parser Prekey)
-> SchemaP NamedSwaggerDoc Value Value LastPrekey Prekey
forall doc v w a b b'.
SchemaP doc v w a b -> (b -> Parser b') -> SchemaP doc v w a b'
`withParser` Prekey -> Parser Prekey
forall {f :: * -> *}.
(Alternative f, MonadFail f) =>
Prekey -> f Prekey
check
    where
      check :: Prekey -> f Prekey
check Prekey
x =
        Prekey
x
          Prekey -> f () -> f Prekey
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Prekey -> PrekeyId
prekeyId Prekey
x PrekeyId -> PrekeyId -> Bool
forall a. Eq a => a -> a -> Bool
== PrekeyId
lastPrekeyId)
            f Prekey -> f Prekey -> f Prekey
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> f Prekey
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid last prekey ID"

instance Arbitrary LastPrekey where
  arbitrary :: Gen LastPrekey
arbitrary = Text -> LastPrekey
lastPrekey (Text -> LastPrekey) -> Gen Text -> Gen LastPrekey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary

lastPrekeyId :: PrekeyId
lastPrekeyId :: PrekeyId
lastPrekeyId = Word16 -> PrekeyId
PrekeyId Word16
forall a. Bounded a => a
maxBound

lastPrekey :: Text -> LastPrekey
lastPrekey :: Text -> LastPrekey
lastPrekey = Prekey -> LastPrekey
LastPrekey (Prekey -> LastPrekey) -> (Text -> Prekey) -> Text -> LastPrekey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrekeyId -> Text -> Prekey
Prekey PrekeyId
lastPrekeyId

-- for tests only
-- This fake last prekey has the wrong prekeyId
fakeLastPrekey :: LastPrekey
fakeLastPrekey :: LastPrekey
fakeLastPrekey = Prekey -> LastPrekey
LastPrekey (Prekey -> LastPrekey) -> Prekey -> LastPrekey
forall a b. (a -> b) -> a -> b
$ PrekeyId -> Text -> Prekey
Prekey (Word16 -> PrekeyId
PrekeyId Word16
7) Text
"pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY="

--------------------------------------------------------------------------------
-- PrekeyBundle

data PrekeyBundle = PrekeyBundle
  { PrekeyBundle -> UserId
prekeyUser :: UserId,
    PrekeyBundle -> [ClientPrekey]
prekeyClients :: [ClientPrekey]
  }
  deriving stock (PrekeyBundle -> PrekeyBundle -> Bool
(PrekeyBundle -> PrekeyBundle -> Bool)
-> (PrekeyBundle -> PrekeyBundle -> Bool) -> Eq PrekeyBundle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrekeyBundle -> PrekeyBundle -> Bool
== :: PrekeyBundle -> PrekeyBundle -> Bool
$c/= :: PrekeyBundle -> PrekeyBundle -> Bool
/= :: PrekeyBundle -> PrekeyBundle -> Bool
Eq, Int -> PrekeyBundle -> ShowS
[PrekeyBundle] -> ShowS
PrekeyBundle -> String
(Int -> PrekeyBundle -> ShowS)
-> (PrekeyBundle -> String)
-> ([PrekeyBundle] -> ShowS)
-> Show PrekeyBundle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrekeyBundle -> ShowS
showsPrec :: Int -> PrekeyBundle -> ShowS
$cshow :: PrekeyBundle -> String
show :: PrekeyBundle -> String
$cshowList :: [PrekeyBundle] -> ShowS
showList :: [PrekeyBundle] -> ShowS
Show, (forall x. PrekeyBundle -> Rep PrekeyBundle x)
-> (forall x. Rep PrekeyBundle x -> PrekeyBundle)
-> Generic PrekeyBundle
forall x. Rep PrekeyBundle x -> PrekeyBundle
forall x. PrekeyBundle -> Rep PrekeyBundle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PrekeyBundle -> Rep PrekeyBundle x
from :: forall x. PrekeyBundle -> Rep PrekeyBundle x
$cto :: forall x. Rep PrekeyBundle x -> PrekeyBundle
to :: forall x. Rep PrekeyBundle x -> PrekeyBundle
Generic)
  deriving (Gen PrekeyBundle
Gen PrekeyBundle
-> (PrekeyBundle -> [PrekeyBundle]) -> Arbitrary PrekeyBundle
PrekeyBundle -> [PrekeyBundle]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PrekeyBundle
arbitrary :: Gen PrekeyBundle
$cshrink :: PrekeyBundle -> [PrekeyBundle]
shrink :: PrekeyBundle -> [PrekeyBundle]
Arbitrary) via (GenericUniform PrekeyBundle)
  deriving (Value -> Parser [PrekeyBundle]
Value -> Parser PrekeyBundle
(Value -> Parser PrekeyBundle)
-> (Value -> Parser [PrekeyBundle]) -> FromJSON PrekeyBundle
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PrekeyBundle
parseJSON :: Value -> Parser PrekeyBundle
$cparseJSONList :: Value -> Parser [PrekeyBundle]
parseJSONList :: Value -> Parser [PrekeyBundle]
FromJSON, [PrekeyBundle] -> Value
[PrekeyBundle] -> Encoding
PrekeyBundle -> Value
PrekeyBundle -> Encoding
(PrekeyBundle -> Value)
-> (PrekeyBundle -> Encoding)
-> ([PrekeyBundle] -> Value)
-> ([PrekeyBundle] -> Encoding)
-> ToJSON PrekeyBundle
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PrekeyBundle -> Value
toJSON :: PrekeyBundle -> Value
$ctoEncoding :: PrekeyBundle -> Encoding
toEncoding :: PrekeyBundle -> Encoding
$ctoJSONList :: [PrekeyBundle] -> Value
toJSONList :: [PrekeyBundle] -> Value
$ctoEncodingList :: [PrekeyBundle] -> Encoding
toEncodingList :: [PrekeyBundle] -> Encoding
ToJSON, Typeable PrekeyBundle
Typeable PrekeyBundle =>
(Proxy PrekeyBundle -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PrekeyBundle
Proxy PrekeyBundle -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PrekeyBundle -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PrekeyBundle -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema PrekeyBundle

instance ToSchema PrekeyBundle where
  schema :: ValueSchema NamedSwaggerDoc PrekeyBundle
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle PrekeyBundle
-> ValueSchema NamedSwaggerDoc PrekeyBundle
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"PrekeyBundle" (SchemaP SwaggerDoc Object [Pair] PrekeyBundle PrekeyBundle
 -> ValueSchema NamedSwaggerDoc PrekeyBundle)
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle PrekeyBundle
-> ValueSchema NamedSwaggerDoc PrekeyBundle
forall a b. (a -> b) -> a -> b
$
      UserId -> [ClientPrekey] -> PrekeyBundle
PrekeyBundle
        (UserId -> [ClientPrekey] -> PrekeyBundle)
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle UserId
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PrekeyBundle
     ([ClientPrekey] -> PrekeyBundle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrekeyBundle -> UserId
prekeyUser (PrekeyBundle -> UserId)
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle UserId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value UserId UserId
-> SchemaP SwaggerDoc Object [Pair] UserId UserId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"user" SchemaP NamedSwaggerDoc Value Value UserId UserId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc
  Object
  [Pair]
  PrekeyBundle
  ([ClientPrekey] -> PrekeyBundle)
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle [ClientPrekey]
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle PrekeyBundle
forall a b.
SchemaP SwaggerDoc Object [Pair] PrekeyBundle (a -> b)
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle a
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrekeyBundle -> [ClientPrekey]
prekeyClients (PrekeyBundle -> [ClientPrekey])
-> SchemaP SwaggerDoc Object [Pair] [ClientPrekey] [ClientPrekey]
-> SchemaP SwaggerDoc Object [Pair] PrekeyBundle [ClientPrekey]
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP SwaggerDoc Value Value [ClientPrekey] [ClientPrekey]
-> SchemaP SwaggerDoc Object [Pair] [ClientPrekey] [ClientPrekey]
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"clients" (ValueSchema NamedSwaggerDoc ClientPrekey
-> SchemaP SwaggerDoc Value Value [ClientPrekey] [ClientPrekey]
forall ndoc doc a.
(HasArray ndoc doc, HasName ndoc) =>
ValueSchema ndoc a -> ValueSchema doc [a]
array ValueSchema NamedSwaggerDoc ClientPrekey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)

--------------------------------------------------------------------------------
-- ClientPrekey

data ClientPrekey = ClientPrekey
  { ClientPrekey -> ClientId
prekeyClient :: ClientId,
    ClientPrekey -> Prekey
prekeyData :: Prekey
  }
  deriving stock (ClientPrekey -> ClientPrekey -> Bool
(ClientPrekey -> ClientPrekey -> Bool)
-> (ClientPrekey -> ClientPrekey -> Bool) -> Eq ClientPrekey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientPrekey -> ClientPrekey -> Bool
== :: ClientPrekey -> ClientPrekey -> Bool
$c/= :: ClientPrekey -> ClientPrekey -> Bool
/= :: ClientPrekey -> ClientPrekey -> Bool
Eq, Int -> ClientPrekey -> ShowS
[ClientPrekey] -> ShowS
ClientPrekey -> String
(Int -> ClientPrekey -> ShowS)
-> (ClientPrekey -> String)
-> ([ClientPrekey] -> ShowS)
-> Show ClientPrekey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientPrekey -> ShowS
showsPrec :: Int -> ClientPrekey -> ShowS
$cshow :: ClientPrekey -> String
show :: ClientPrekey -> String
$cshowList :: [ClientPrekey] -> ShowS
showList :: [ClientPrekey] -> ShowS
Show, (forall x. ClientPrekey -> Rep ClientPrekey x)
-> (forall x. Rep ClientPrekey x -> ClientPrekey)
-> Generic ClientPrekey
forall x. Rep ClientPrekey x -> ClientPrekey
forall x. ClientPrekey -> Rep ClientPrekey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientPrekey -> Rep ClientPrekey x
from :: forall x. ClientPrekey -> Rep ClientPrekey x
$cto :: forall x. Rep ClientPrekey x -> ClientPrekey
to :: forall x. Rep ClientPrekey x -> ClientPrekey
Generic)
  deriving (Gen ClientPrekey
Gen ClientPrekey
-> (ClientPrekey -> [ClientPrekey]) -> Arbitrary ClientPrekey
ClientPrekey -> [ClientPrekey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen ClientPrekey
arbitrary :: Gen ClientPrekey
$cshrink :: ClientPrekey -> [ClientPrekey]
shrink :: ClientPrekey -> [ClientPrekey]
Arbitrary) via (GenericUniform ClientPrekey)
  deriving (Value -> Parser [ClientPrekey]
Value -> Parser ClientPrekey
(Value -> Parser ClientPrekey)
-> (Value -> Parser [ClientPrekey]) -> FromJSON ClientPrekey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ClientPrekey
parseJSON :: Value -> Parser ClientPrekey
$cparseJSONList :: Value -> Parser [ClientPrekey]
parseJSONList :: Value -> Parser [ClientPrekey]
FromJSON, [ClientPrekey] -> Value
[ClientPrekey] -> Encoding
ClientPrekey -> Value
ClientPrekey -> Encoding
(ClientPrekey -> Value)
-> (ClientPrekey -> Encoding)
-> ([ClientPrekey] -> Value)
-> ([ClientPrekey] -> Encoding)
-> ToJSON ClientPrekey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ClientPrekey -> Value
toJSON :: ClientPrekey -> Value
$ctoEncoding :: ClientPrekey -> Encoding
toEncoding :: ClientPrekey -> Encoding
$ctoJSONList :: [ClientPrekey] -> Value
toJSONList :: [ClientPrekey] -> Value
$ctoEncodingList :: [ClientPrekey] -> Encoding
toEncodingList :: [ClientPrekey] -> Encoding
ToJSON, Typeable ClientPrekey
Typeable ClientPrekey =>
(Proxy ClientPrekey -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ClientPrekey
Proxy ClientPrekey -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy ClientPrekey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy ClientPrekey -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema ClientPrekey

instance ToSchema ClientPrekey where
  schema :: ValueSchema NamedSwaggerDoc ClientPrekey
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey ClientPrekey
-> ValueSchema NamedSwaggerDoc ClientPrekey
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"ClientPrekey" (SchemaP SwaggerDoc Object [Pair] ClientPrekey ClientPrekey
 -> ValueSchema NamedSwaggerDoc ClientPrekey)
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey ClientPrekey
-> ValueSchema NamedSwaggerDoc ClientPrekey
forall a b. (a -> b) -> a -> b
$
      ClientId -> Prekey -> ClientPrekey
ClientPrekey
        (ClientId -> Prekey -> ClientPrekey)
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey ClientId
-> SchemaP
     SwaggerDoc Object [Pair] ClientPrekey (Prekey -> ClientPrekey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientPrekey -> ClientId
prekeyClient (ClientPrekey -> ClientId)
-> SchemaP SwaggerDoc Object [Pair] ClientId ClientId
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey ClientId
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> SchemaP NamedSwaggerDoc Value Value ClientId ClientId
-> SchemaP SwaggerDoc Object [Pair] ClientId ClientId
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"client" SchemaP NamedSwaggerDoc Value Value ClientId ClientId
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema
        SchemaP
  SwaggerDoc Object [Pair] ClientPrekey (Prekey -> ClientPrekey)
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey Prekey
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey ClientPrekey
forall a b.
SchemaP SwaggerDoc Object [Pair] ClientPrekey (a -> b)
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey a
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ClientPrekey -> Prekey
prekeyData (ClientPrekey -> Prekey)
-> SchemaP SwaggerDoc Object [Pair] Prekey Prekey
-> SchemaP SwaggerDoc Object [Pair] ClientPrekey Prekey
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= Text
-> ValueSchema NamedSwaggerDoc Prekey
-> SchemaP SwaggerDoc Object [Pair] Prekey Prekey
forall doc' doc a b.
HasField doc' doc =>
Text
-> SchemaP doc' Value Value a b -> SchemaP doc Object [Pair] a b
field Text
"prekey" ValueSchema NamedSwaggerDoc Prekey
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema