{-# LANGUAGE TemplateHaskell #-}

module Wire.PropertySubsystem where

import Data.Id
import Data.Text.Lazy qualified as LText
import Imports
import Network.HTTP.Types
import Network.Wai.Utilities qualified as Wai
import Polysemy
import Wire.API.Error
import Wire.API.Error.Brig qualified as E
import Wire.API.Properties
import Wire.Error

data PropertySubsystemError
  = TooManyProperties
  | PropertyKeyTooLarge
  | PropertyValueTooLarge
  | PropertyValueInvalid String
  | StoredPropertyValueInvalid
  deriving (Int -> PropertySubsystemError -> ShowS
[PropertySubsystemError] -> ShowS
PropertySubsystemError -> String
(Int -> PropertySubsystemError -> ShowS)
-> (PropertySubsystemError -> String)
-> ([PropertySubsystemError] -> ShowS)
-> Show PropertySubsystemError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertySubsystemError -> ShowS
showsPrec :: Int -> PropertySubsystemError -> ShowS
$cshow :: PropertySubsystemError -> String
show :: PropertySubsystemError -> String
$cshowList :: [PropertySubsystemError] -> ShowS
showList :: [PropertySubsystemError] -> ShowS
Show, PropertySubsystemError -> PropertySubsystemError -> Bool
(PropertySubsystemError -> PropertySubsystemError -> Bool)
-> (PropertySubsystemError -> PropertySubsystemError -> Bool)
-> Eq PropertySubsystemError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PropertySubsystemError -> PropertySubsystemError -> Bool
== :: PropertySubsystemError -> PropertySubsystemError -> Bool
$c/= :: PropertySubsystemError -> PropertySubsystemError -> Bool
/= :: PropertySubsystemError -> PropertySubsystemError -> Bool
Eq)

propertySubsystemErrorToHttpError :: PropertySubsystemError -> HttpError
propertySubsystemErrorToHttpError :: PropertySubsystemError -> HttpError
propertySubsystemErrorToHttpError =
  Error -> HttpError
StdError (Error -> HttpError)
-> (PropertySubsystemError -> Error)
-> PropertySubsystemError
-> HttpError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    PropertySubsystemError
TooManyProperties -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.TooManyProperties
    PropertySubsystemError
PropertyKeyTooLarge -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.PropertyKeyTooLarge
    PropertySubsystemError
PropertyValueTooLarge -> forall {k} (e :: k). KnownError (MapError e) => Error
forall (e :: BrigError). KnownError (MapError e) => Error
errorToWai @E.PropertyValueTooLarge
    PropertyValueInvalid String
err -> Status -> LText -> LText -> Error
Wai.mkError Status
status400 LText
"bad-request" (String -> LText
LText.pack String
err)
    PropertySubsystemError
StoredPropertyValueInvalid -> Status -> LText -> LText -> Error
Wai.mkError Status
status500 LText
"internal-server-error" LText
"Internal Server Error"

data PropertySubsystem m a where
  SetProperty :: UserId -> ConnId -> PropertyKey -> RawPropertyValue -> PropertySubsystem m ()
  DeleteProperty :: UserId -> ConnId -> PropertyKey -> PropertySubsystem m ()
  ClearProperties :: UserId -> ConnId -> PropertySubsystem m ()
  OnUserDeleted :: UserId -> PropertySubsystem m ()
  LookupProperty :: UserId -> PropertyKey -> PropertySubsystem m (Maybe RawPropertyValue)
  GetPropertyKeys :: UserId -> PropertySubsystem m [PropertyKey]
  GetAllProperties :: UserId -> PropertySubsystem m PropertyKeysAndValues

makeSem ''PropertySubsystem