{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2020 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/>.

-- | Scim attribute names. these are case-insensitive
module Web.Scim.AttrName where

import Data.Aeson.Types (FromJSONKey, ToJSONKey)
import Data.Attoparsec.ByteString.Char8
import Data.Hashable
import Data.String (IsString, fromString)
import Data.Text (Text, cons, toCaseFold)
import Data.Text.Encoding (decodeUtf8)
import Prelude hiding (takeWhile)

-- | An attribute (e.g. username).
--
-- ATTRNAME  = ALPHA *(nameChar)
-- NOTE: We use the FromJSONKey instance of Text. The default instances parses
-- a list of key values instead of a map
newtype AttrName
  = AttrName Text
  deriving (Int -> AttrName -> ShowS
[AttrName] -> ShowS
AttrName -> String
(Int -> AttrName -> ShowS)
-> (AttrName -> String) -> ([AttrName] -> ShowS) -> Show AttrName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrName] -> ShowS
$cshowList :: [AttrName] -> ShowS
show :: AttrName -> String
$cshow :: AttrName -> String
showsPrec :: Int -> AttrName -> ShowS
$cshowsPrec :: Int -> AttrName -> ShowS
Show, FromJSONKeyFunction [AttrName]
FromJSONKeyFunction AttrName
FromJSONKeyFunction AttrName
-> FromJSONKeyFunction [AttrName] -> FromJSONKey AttrName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [AttrName]
$cfromJSONKeyList :: FromJSONKeyFunction [AttrName]
fromJSONKey :: FromJSONKeyFunction AttrName
$cfromJSONKey :: FromJSONKeyFunction AttrName
FromJSONKey, ToJSONKeyFunction [AttrName]
ToJSONKeyFunction AttrName
ToJSONKeyFunction AttrName
-> ToJSONKeyFunction [AttrName] -> ToJSONKey AttrName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [AttrName]
$ctoJSONKeyList :: ToJSONKeyFunction [AttrName]
toJSONKey :: ToJSONKeyFunction AttrName
$ctoJSONKey :: ToJSONKeyFunction AttrName
ToJSONKey)

instance Eq AttrName where
  AttrName Text
a == :: AttrName -> AttrName -> Bool
== AttrName Text
b = Text -> Text
toCaseFold Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
toCaseFold Text
b

instance Ord AttrName where
  compare :: AttrName -> AttrName -> Ordering
compare (AttrName Text
a) (AttrName Text
b) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text
toCaseFold Text
a) (Text -> Text
toCaseFold Text
b)

instance Hashable AttrName where
  hashWithSalt :: Int -> AttrName -> Int
hashWithSalt Int
x (AttrName Text
a) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
x (Text -> Text
toCaseFold Text
a)

instance IsString AttrName where
  fromString :: String -> AttrName
fromString = Text -> AttrName
AttrName (Text -> AttrName) -> (String -> Text) -> String -> AttrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Attribute name parser.
pAttrName :: Parser AttrName
pAttrName :: Parser AttrName
pAttrName =
  (\Char
c ByteString
str -> Text -> AttrName
AttrName (Char -> Text -> Text
cons Char
c (ByteString -> Text
decodeUtf8 ByteString
str)))
    (Char -> ByteString -> AttrName)
-> Parser ByteString Char
-> Parser ByteString (ByteString -> AttrName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
letter_ascii
    Parser ByteString (ByteString -> AttrName)
-> Parser ByteString ByteString -> Parser AttrName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAlpha_ascii Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')

-- | Attribute name renderer.
rAttrName :: AttrName -> Text
rAttrName :: AttrName -> Text
rAttrName (AttrName Text
x) = Text
x