{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Xmpp.Sasl.StringPrep where

import Text.StringPrep
import qualified Data.Set as Set
import Data.Text(Text, singleton)

nonAsciiSpaces :: Set.Set Char
nonAsciiSpaces :: Set Char
nonAsciiSpaces = forall a. Ord a => [a] -> Set a
Set.fromList [ Char
'\x00A0', Char
'\x1680', Char
'\x2000', Char
'\x2001', Char
'\x2002'
                              , Char
'\x2003', Char
'\x2004', Char
'\x2005', Char
'\x2006', Char
'\x2007'
                              , Char
'\x2008', Char
'\x2009', Char
'\x200A', Char
'\x200B', Char
'\x202F'
                              , Char
'\x205F', Char
'\x3000'
                              ]

toSpace :: Char -> Text
toSpace :: Char -> Text
toSpace Char
x = if Char
x forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
nonAsciiSpaces then Text
" " else Char -> Text
singleton Char
x

saslPrepQuery :: StringPrepProfile
saslPrepQuery :: StringPrepProfile
saslPrepQuery = [Char -> Text] -> Bool -> [Prohibited] -> Bool -> StringPrepProfile
Profile
    [Char -> Text
b1, Char -> Text
toSpace]
    Bool
True
    [Prohibited
c12, Prohibited
c21, Prohibited
c22, Prohibited
c3, Prohibited
c4, Prohibited
c5, Prohibited
c6, Prohibited
c7, Prohibited
c8, Prohibited
c9]
    Bool
True

saslPrepStore :: StringPrepProfile
saslPrepStore :: StringPrepProfile
saslPrepStore = [Char -> Text] -> Bool -> [Prohibited] -> Bool -> StringPrepProfile
Profile
    [Char -> Text
b1, Char -> Text
toSpace]
    Bool
True
    [Prohibited
a1, Prohibited
c12, Prohibited
c21, Prohibited
c22, Prohibited
c3, Prohibited
c4, Prohibited
c5, Prohibited
c6, Prohibited
c7, Prohibited
c8, Prohibited
c9]
    Bool
True

normalizePassword :: Text -> Maybe Text
normalizePassword :: Text -> Maybe Text
normalizePassword = StringPrepProfile -> Text -> Maybe Text
runStringPrep StringPrepProfile
saslPrepStore

normalizeUsername :: Text -> Maybe Text
normalizeUsername :: Text -> Maybe Text
normalizeUsername = StringPrepProfile -> Text -> Maybe Text
runStringPrep StringPrepProfile
saslPrepQuery