{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- 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.Properties
  ( PropertyKeysAndValues (..),
    PropertyKey (..),
    RawPropertyValue (..),
  )
where

import Cassandra qualified as C
import Control.Lens ((?~))
import Data.Aeson (FromJSON (..), ToJSON (..), Value)
import Data.Aeson qualified as A
import Data.ByteString.Conversion
import Data.Hashable (Hashable)
import Data.OpenApi qualified as S
import Data.Text.Ascii
import Imports
import Servant
import Test.QuickCheck

newtype PropertyKeysAndValues = PropertyKeysAndValues (Map PropertyKey Value)
  deriving stock (PropertyKeysAndValues -> PropertyKeysAndValues -> Bool
(PropertyKeysAndValues -> PropertyKeysAndValues -> Bool)
-> (PropertyKeysAndValues -> PropertyKeysAndValues -> Bool)
-> Eq PropertyKeysAndValues
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyKeysAndValues -> PropertyKeysAndValues -> Bool
== :: PropertyKeysAndValues -> PropertyKeysAndValues -> Bool
$c/= :: PropertyKeysAndValues -> PropertyKeysAndValues -> Bool
/= :: PropertyKeysAndValues -> PropertyKeysAndValues -> Bool
Eq, Int -> PropertyKeysAndValues -> ShowS
[PropertyKeysAndValues] -> ShowS
PropertyKeysAndValues -> String
(Int -> PropertyKeysAndValues -> ShowS)
-> (PropertyKeysAndValues -> String)
-> ([PropertyKeysAndValues] -> ShowS)
-> Show PropertyKeysAndValues
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyKeysAndValues -> ShowS
showsPrec :: Int -> PropertyKeysAndValues -> ShowS
$cshow :: PropertyKeysAndValues -> String
show :: PropertyKeysAndValues -> String
$cshowList :: [PropertyKeysAndValues] -> ShowS
showList :: [PropertyKeysAndValues] -> ShowS
Show)
  deriving newtype ([PropertyKeysAndValues] -> Value
[PropertyKeysAndValues] -> Encoding
PropertyKeysAndValues -> Value
PropertyKeysAndValues -> Encoding
(PropertyKeysAndValues -> Value)
-> (PropertyKeysAndValues -> Encoding)
-> ([PropertyKeysAndValues] -> Value)
-> ([PropertyKeysAndValues] -> Encoding)
-> ToJSON PropertyKeysAndValues
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PropertyKeysAndValues -> Value
toJSON :: PropertyKeysAndValues -> Value
$ctoEncoding :: PropertyKeysAndValues -> Encoding
toEncoding :: PropertyKeysAndValues -> Encoding
$ctoJSONList :: [PropertyKeysAndValues] -> Value
toJSONList :: [PropertyKeysAndValues] -> Value
$ctoEncodingList :: [PropertyKeysAndValues] -> Encoding
toEncodingList :: [PropertyKeysAndValues] -> Encoding
ToJSON)

instance S.ToSchema PropertyKeysAndValues where
  declareNamedSchema :: Proxy PropertyKeysAndValues
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy PropertyKeysAndValues
_ =
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
S.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"PropertyKeysAndValues") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiObject

newtype PropertyKey = PropertyKey
  {PropertyKey -> AsciiPrintable
propertyKeyName :: AsciiPrintable}
  deriving stock (PropertyKey -> PropertyKey -> Bool
(PropertyKey -> PropertyKey -> Bool)
-> (PropertyKey -> PropertyKey -> Bool) -> Eq PropertyKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertyKey -> PropertyKey -> Bool
== :: PropertyKey -> PropertyKey -> Bool
$c/= :: PropertyKey -> PropertyKey -> Bool
/= :: PropertyKey -> PropertyKey -> Bool
Eq, Eq PropertyKey
Eq PropertyKey =>
(PropertyKey -> PropertyKey -> Ordering)
-> (PropertyKey -> PropertyKey -> Bool)
-> (PropertyKey -> PropertyKey -> Bool)
-> (PropertyKey -> PropertyKey -> Bool)
-> (PropertyKey -> PropertyKey -> Bool)
-> (PropertyKey -> PropertyKey -> PropertyKey)
-> (PropertyKey -> PropertyKey -> PropertyKey)
-> Ord PropertyKey
PropertyKey -> PropertyKey -> Bool
PropertyKey -> PropertyKey -> Ordering
PropertyKey -> PropertyKey -> PropertyKey
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 :: PropertyKey -> PropertyKey -> Ordering
compare :: PropertyKey -> PropertyKey -> Ordering
$c< :: PropertyKey -> PropertyKey -> Bool
< :: PropertyKey -> PropertyKey -> Bool
$c<= :: PropertyKey -> PropertyKey -> Bool
<= :: PropertyKey -> PropertyKey -> Bool
$c> :: PropertyKey -> PropertyKey -> Bool
> :: PropertyKey -> PropertyKey -> Bool
$c>= :: PropertyKey -> PropertyKey -> Bool
>= :: PropertyKey -> PropertyKey -> Bool
$cmax :: PropertyKey -> PropertyKey -> PropertyKey
max :: PropertyKey -> PropertyKey -> PropertyKey
$cmin :: PropertyKey -> PropertyKey -> PropertyKey
min :: PropertyKey -> PropertyKey -> PropertyKey
Ord, Int -> PropertyKey -> ShowS
[PropertyKey] -> ShowS
PropertyKey -> String
(Int -> PropertyKey -> ShowS)
-> (PropertyKey -> String)
-> ([PropertyKey] -> ShowS)
-> Show PropertyKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyKey -> ShowS
showsPrec :: Int -> PropertyKey -> ShowS
$cshow :: PropertyKey -> String
show :: PropertyKey -> String
$cshowList :: [PropertyKey] -> ShowS
showList :: [PropertyKey] -> ShowS
Show, (forall x. PropertyKey -> Rep PropertyKey x)
-> (forall x. Rep PropertyKey x -> PropertyKey)
-> Generic PropertyKey
forall x. Rep PropertyKey x -> PropertyKey
forall x. PropertyKey -> Rep PropertyKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PropertyKey -> Rep PropertyKey x
from :: forall x. PropertyKey -> Rep PropertyKey x
$cto :: forall x. Rep PropertyKey x -> PropertyKey
to :: forall x. Rep PropertyKey x -> PropertyKey
Generic)
  deriving newtype
    ( Parser PropertyKey
Parser PropertyKey -> FromByteString PropertyKey
forall a. Parser a -> FromByteString a
$cparser :: Parser PropertyKey
parser :: Parser PropertyKey
FromByteString,
      PropertyKey -> Builder
(PropertyKey -> Builder) -> ToByteString PropertyKey
forall a. (a -> Builder) -> ToByteString a
$cbuilder :: PropertyKey -> Builder
builder :: PropertyKey -> Builder
ToByteString,
      Value -> Parser [PropertyKey]
Value -> Parser PropertyKey
(Value -> Parser PropertyKey)
-> (Value -> Parser [PropertyKey]) -> FromJSON PropertyKey
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PropertyKey
parseJSON :: Value -> Parser PropertyKey
$cparseJSONList :: Value -> Parser [PropertyKey]
parseJSONList :: Value -> Parser [PropertyKey]
FromJSON,
      [PropertyKey] -> Value
[PropertyKey] -> Encoding
PropertyKey -> Value
PropertyKey -> Encoding
(PropertyKey -> Value)
-> (PropertyKey -> Encoding)
-> ([PropertyKey] -> Value)
-> ([PropertyKey] -> Encoding)
-> ToJSON PropertyKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PropertyKey -> Value
toJSON :: PropertyKey -> Value
$ctoEncoding :: PropertyKey -> Encoding
toEncoding :: PropertyKey -> Encoding
$ctoJSONList :: [PropertyKey] -> Value
toJSONList :: [PropertyKey] -> Value
$ctoEncodingList :: [PropertyKey] -> Encoding
toEncodingList :: [PropertyKey] -> Encoding
ToJSON,
      Typeable PropertyKey
Typeable PropertyKey =>
(Proxy PropertyKey -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PropertyKey
Proxy PropertyKey -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PropertyKey -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PropertyKey -> Declare (Definitions Schema) NamedSchema
S.ToSchema,
      FromJSONKeyFunction [PropertyKey]
FromJSONKeyFunction PropertyKey
FromJSONKeyFunction PropertyKey
-> FromJSONKeyFunction [PropertyKey] -> FromJSONKey PropertyKey
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction PropertyKey
fromJSONKey :: FromJSONKeyFunction PropertyKey
$cfromJSONKeyList :: FromJSONKeyFunction [PropertyKey]
fromJSONKeyList :: FromJSONKeyFunction [PropertyKey]
A.FromJSONKey,
      ToJSONKeyFunction [PropertyKey]
ToJSONKeyFunction PropertyKey
ToJSONKeyFunction PropertyKey
-> ToJSONKeyFunction [PropertyKey] -> ToJSONKey PropertyKey
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction PropertyKey
toJSONKey :: ToJSONKeyFunction PropertyKey
$ctoJSONKeyList :: ToJSONKeyFunction [PropertyKey]
toJSONKeyList :: ToJSONKeyFunction [PropertyKey]
A.ToJSONKey,
      Text -> Either Text PropertyKey
ByteString -> Either Text PropertyKey
(Text -> Either Text PropertyKey)
-> (ByteString -> Either Text PropertyKey)
-> (Text -> Either Text PropertyKey)
-> FromHttpApiData PropertyKey
forall a.
(Text -> Either Text a)
-> (ByteString -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
$cparseUrlPiece :: Text -> Either Text PropertyKey
parseUrlPiece :: Text -> Either Text PropertyKey
$cparseHeader :: ByteString -> Either Text PropertyKey
parseHeader :: ByteString -> Either Text PropertyKey
$cparseQueryParam :: Text -> Either Text PropertyKey
parseQueryParam :: Text -> Either Text PropertyKey
FromHttpApiData,
      Eq PropertyKey
Eq PropertyKey =>
(Int -> PropertyKey -> Int)
-> (PropertyKey -> Int) -> Hashable PropertyKey
Int -> PropertyKey -> Int
PropertyKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PropertyKey -> Int
hashWithSalt :: Int -> PropertyKey -> Int
$chash :: PropertyKey -> Int
hash :: PropertyKey -> Int
Hashable,
      Gen PropertyKey
Gen PropertyKey
-> (PropertyKey -> [PropertyKey]) -> Arbitrary PropertyKey
PropertyKey -> [PropertyKey]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen PropertyKey
arbitrary :: Gen PropertyKey
$cshrink :: PropertyKey -> [PropertyKey]
shrink :: PropertyKey -> [PropertyKey]
Arbitrary
    )

instance S.ToParamSchema PropertyKey where
  toParamSchema :: Proxy PropertyKey -> Schema
toParamSchema Proxy PropertyKey
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
S.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
S.OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasFormat s a => Lens' s a
Lens' Schema (Maybe Text)
S.format ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"printable"

deriving instance C.Cql PropertyKey

-- | A raw, unparsed property value.
newtype RawPropertyValue = RawPropertyValue {RawPropertyValue -> LByteString
rawPropertyBytes :: LByteString}
  deriving (RawPropertyValue -> RawPropertyValue -> Bool
(RawPropertyValue -> RawPropertyValue -> Bool)
-> (RawPropertyValue -> RawPropertyValue -> Bool)
-> Eq RawPropertyValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawPropertyValue -> RawPropertyValue -> Bool
== :: RawPropertyValue -> RawPropertyValue -> Bool
$c/= :: RawPropertyValue -> RawPropertyValue -> Bool
/= :: RawPropertyValue -> RawPropertyValue -> Bool
Eq, Int -> RawPropertyValue -> ShowS
[RawPropertyValue] -> ShowS
RawPropertyValue -> String
(Int -> RawPropertyValue -> ShowS)
-> (RawPropertyValue -> String)
-> ([RawPropertyValue] -> ShowS)
-> Show RawPropertyValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawPropertyValue -> ShowS
showsPrec :: Int -> RawPropertyValue -> ShowS
$cshow :: RawPropertyValue -> String
show :: RawPropertyValue -> String
$cshowList :: [RawPropertyValue] -> ShowS
showList :: [RawPropertyValue] -> ShowS
Show)

instance C.Cql RawPropertyValue where
  ctype :: Tagged RawPropertyValue ColumnType
ctype = ColumnType -> Tagged RawPropertyValue ColumnType
forall a b. b -> Tagged a b
C.Tagged ColumnType
C.BlobColumn
  toCql :: RawPropertyValue -> Value
toCql = Blob -> Value
forall a. Cql a => a -> Value
C.toCql (Blob -> Value)
-> (RawPropertyValue -> Blob) -> RawPropertyValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> Blob
C.Blob (LByteString -> Blob)
-> (RawPropertyValue -> LByteString) -> RawPropertyValue -> Blob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawPropertyValue -> LByteString
rawPropertyBytes
  fromCql :: Value -> Either String RawPropertyValue
fromCql (C.CqlBlob LByteString
v) = RawPropertyValue -> Either String RawPropertyValue
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LByteString -> RawPropertyValue
RawPropertyValue LByteString
v)
  fromCql Value
_ = String -> Either String RawPropertyValue
forall a b. a -> Either a b
Left String
"PropertyValue: Blob expected"

instance {-# OVERLAPPING #-} MimeUnrender JSON RawPropertyValue where
  mimeUnrender :: Proxy JSON -> LByteString -> Either String RawPropertyValue
mimeUnrender Proxy JSON
_ = RawPropertyValue -> Either String RawPropertyValue
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawPropertyValue -> Either String RawPropertyValue)
-> (LByteString -> RawPropertyValue)
-> LByteString
-> Either String RawPropertyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> RawPropertyValue
RawPropertyValue

instance {-# OVERLAPPING #-} MimeRender JSON RawPropertyValue where
  mimeRender :: Proxy JSON -> RawPropertyValue -> LByteString
mimeRender Proxy JSON
_ = RawPropertyValue -> LByteString
rawPropertyBytes

instance S.ToSchema RawPropertyValue where
  declareNamedSchema :: Proxy RawPropertyValue -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy RawPropertyValue
_ =
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> (Schema -> NamedSchema)
-> Schema
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Schema -> NamedSchema
S.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"PropertyValue") (Schema -> Declare (Definitions Schema) NamedSchema)
-> Schema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Schema
forall a. Monoid a => a
mempty Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text)) -> Schema -> Identity Schema
forall s a. HasDescription s a => Lens' s a
Lens' Schema (Maybe Text)
S.description ((Maybe Text -> Identity (Maybe Text))
 -> Schema -> Identity Schema)
-> Text -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
"An arbitrary JSON value for a property"