-- |
-- Module      : Text.LDAP.Data
-- Copyright   : 2014 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
module Text.LDAP.Data
       (
         -- * DN AST
         Attribute
       , AttrType (..), attrOid
       , AttrValue (..)

       , Component (..), component

       , DN, consDN, unconsDN

       , List1

       , LdifAttrValue (..)

       , -- * Weaken constraint but popular list type
         DN', toDN', Component'

       , -- * Low-level Charset check interfaces
         Bound, exact, boundsElems, inBounds, elem', notElem', inSBounds

       , ordW8
       , quotation, specialChars

       , ldifSafeBounds
       , ldifSafeInitBounds
       ) where

import Prelude hiding (reverse)
import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Char (ord)
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.Set (fromList, member)
import Data.List.NonEmpty (NonEmpty ((:|)), reverse, toList)


-- | Not empty list type
type List1 = NonEmpty

-- | Type to express value bound
type Bound a = (a, a)

-- | Bound value to express exact value
exact :: a -> Bound a
exact :: a -> Bound a
exact a
a = (a
a, a
a)

{-# SPECIALIZE bexpand :: (Char, Char) -> [Char] #-}
bexpand :: Enum a => (a, a) -> [a]
bexpand :: (a, a) -> [a]
bexpand (a
x, a
y) = [a
x .. a
y]

-- | Element list in value bounds
{-# SPECIALIZE boundsElems :: [(Char, Char)] -> [Char] #-}
boundsElems :: Enum a => [(a, a)] -> [a]
boundsElems :: [(a, a)] -> [a]
boundsElems =  ([(a, a)] -> ((a, a) -> [a]) -> [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a, a) -> [a]
forall a. Enum a => (a, a) -> [a]
bexpand)

{-# SPECIALIZE widerFirst :: [(Char, Char)] -> [(Char, Char)] #-}
widerFirst :: (Enum a, Ord a) => [(a, a)] -> [(a, a)]
widerFirst :: [(a, a)] -> [(a, a)]
widerFirst =  ((a, a) -> (a, a) -> Ordering) -> [(a, a)] -> [(a, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, a) -> (a, a) -> Ordering) -> (a, a) -> (a, a) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a, a) -> (a, a) -> Ordering) -> (a, a) -> (a, a) -> Ordering)
-> ((a, a) -> (a, a) -> Ordering) -> (a, a) -> (a, a) -> Ordering
forall a b. (a -> b) -> a -> b
$ ((a, a) -> Int) -> (a, a) -> (a, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((a, a) -> Int) -> (a, a) -> (a, a) -> Ordering)
-> ((a, a) -> Int) -> (a, a) -> (a, a) -> Ordering
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ((a, a) -> [a]) -> (a, a) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> [a]
forall a. Enum a => (a, a) -> [a]
bexpand)

-- | Test element in value bounds.
{-# SPECIALIZE inBounds :: Char -> [(Char, Char)] -> Bool #-}
inBounds :: (Enum a, Ord a) => a -> [(a, a)] -> Bool
inBounds :: a -> [(a, a)] -> Bool
inBounds a
a = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([(a, a)] -> [Bool]) -> [(a, a)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, a) -> Bool) -> [(a, a)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
x, a
y) -> (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y)) ([(a, a)] -> [Bool])
-> ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> [(a, a)]
forall a. (Enum a, Ord a) => [(a, a)] -> [(a, a)]
widerFirst

-- | Test element using ordered set.
{-# SPECIALIZE elem' :: Char -> [Char] -> Bool #-}
elem' :: Ord a => a -> [a] -> Bool
elem' :: a -> [a] -> Bool
elem' a
a = (a
a a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`member`) (Set a -> Bool) -> ([a] -> Set a) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
fromList

-- | Test not element using ordered set.
{-# SPECIALIZE notElem' :: Char -> [Char] -> Bool #-}
notElem' :: Ord a => a -> [a] -> Bool
notElem' :: a -> [a] -> Bool
notElem' a
a = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a a -> [a] -> Bool
forall a. Ord a => a -> [a] -> Bool
`elem'`)

-- | Test element in value bounds using ordered set.
{-# SPECIALIZE inSBounds :: Char -> [(Char, Char)] -> Bool #-}
inSBounds :: (Enum a, Ord a) => a -> [(a, a)] -> Bool
inSBounds :: a -> [(a, a)] -> Bool
inSBounds a
a = (a
a a -> [a] -> Bool
forall a. Ord a => a -> [a] -> Bool
`elem'`) ([a] -> Bool) -> ([(a, a)] -> [a]) -> [(a, a)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> [a]
forall a. Enum a => [(a, a)] -> [a]
boundsElems

infix 4 `inBounds`, `elem'`, `notElem'`, `inSBounds`

-- | Type of dn attribute type
data AttrType
  = AttrType ByteString
  | AttrOid  (List1 ByteString)
  deriving (AttrType -> AttrType -> Bool
(AttrType -> AttrType -> Bool)
-> (AttrType -> AttrType -> Bool) -> Eq AttrType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrType -> AttrType -> Bool
$c/= :: AttrType -> AttrType -> Bool
== :: AttrType -> AttrType -> Bool
$c== :: AttrType -> AttrType -> Bool
Eq, Eq AttrType
Eq AttrType
-> (AttrType -> AttrType -> Ordering)
-> (AttrType -> AttrType -> Bool)
-> (AttrType -> AttrType -> Bool)
-> (AttrType -> AttrType -> Bool)
-> (AttrType -> AttrType -> Bool)
-> (AttrType -> AttrType -> AttrType)
-> (AttrType -> AttrType -> AttrType)
-> Ord AttrType
AttrType -> AttrType -> Bool
AttrType -> AttrType -> Ordering
AttrType -> AttrType -> AttrType
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
min :: AttrType -> AttrType -> AttrType
$cmin :: AttrType -> AttrType -> AttrType
max :: AttrType -> AttrType -> AttrType
$cmax :: AttrType -> AttrType -> AttrType
>= :: AttrType -> AttrType -> Bool
$c>= :: AttrType -> AttrType -> Bool
> :: AttrType -> AttrType -> Bool
$c> :: AttrType -> AttrType -> Bool
<= :: AttrType -> AttrType -> Bool
$c<= :: AttrType -> AttrType -> Bool
< :: AttrType -> AttrType -> Bool
$c< :: AttrType -> AttrType -> Bool
compare :: AttrType -> AttrType -> Ordering
$ccompare :: AttrType -> AttrType -> Ordering
$cp1Ord :: Eq AttrType
Ord, Int -> AttrType -> ShowS
[AttrType] -> ShowS
AttrType -> String
(Int -> AttrType -> ShowS)
-> (AttrType -> String) -> ([AttrType] -> ShowS) -> Show AttrType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrType] -> ShowS
$cshowList :: [AttrType] -> ShowS
show :: AttrType -> String
$cshow :: AttrType -> String
showsPrec :: Int -> AttrType -> ShowS
$cshowsPrec :: Int -> AttrType -> ShowS
Show)

-- | Construct OID attribute type
attrOid :: ByteString -> [ByteString] -> AttrType
attrOid :: ByteString -> [ByteString] -> AttrType
attrOid ByteString
hd [ByteString]
tl = List1 ByteString -> AttrType
AttrOid (List1 ByteString -> AttrType) -> List1 ByteString -> AttrType
forall a b. (a -> b) -> a -> b
$ ByteString
hd ByteString -> [ByteString] -> List1 ByteString
forall a. a -> [a] -> NonEmpty a
:| [ByteString]
tl

-- | Type of dn attribute value
newtype AttrValue = AttrValue ByteString
                  deriving (AttrValue -> AttrValue -> Bool
(AttrValue -> AttrValue -> Bool)
-> (AttrValue -> AttrValue -> Bool) -> Eq AttrValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrValue -> AttrValue -> Bool
$c/= :: AttrValue -> AttrValue -> Bool
== :: AttrValue -> AttrValue -> Bool
$c== :: AttrValue -> AttrValue -> Bool
Eq, Eq AttrValue
Eq AttrValue
-> (AttrValue -> AttrValue -> Ordering)
-> (AttrValue -> AttrValue -> Bool)
-> (AttrValue -> AttrValue -> Bool)
-> (AttrValue -> AttrValue -> Bool)
-> (AttrValue -> AttrValue -> Bool)
-> (AttrValue -> AttrValue -> AttrValue)
-> (AttrValue -> AttrValue -> AttrValue)
-> Ord AttrValue
AttrValue -> AttrValue -> Bool
AttrValue -> AttrValue -> Ordering
AttrValue -> AttrValue -> AttrValue
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
min :: AttrValue -> AttrValue -> AttrValue
$cmin :: AttrValue -> AttrValue -> AttrValue
max :: AttrValue -> AttrValue -> AttrValue
$cmax :: AttrValue -> AttrValue -> AttrValue
>= :: AttrValue -> AttrValue -> Bool
$c>= :: AttrValue -> AttrValue -> Bool
> :: AttrValue -> AttrValue -> Bool
$c> :: AttrValue -> AttrValue -> Bool
<= :: AttrValue -> AttrValue -> Bool
$c<= :: AttrValue -> AttrValue -> Bool
< :: AttrValue -> AttrValue -> Bool
$c< :: AttrValue -> AttrValue -> Bool
compare :: AttrValue -> AttrValue -> Ordering
$ccompare :: AttrValue -> AttrValue -> Ordering
$cp1Ord :: Eq AttrValue
Ord, Int -> AttrValue -> ShowS
[AttrValue] -> ShowS
AttrValue -> String
(Int -> AttrValue -> ShowS)
-> (AttrValue -> String)
-> ([AttrValue] -> ShowS)
-> Show AttrValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrValue] -> ShowS
$cshowList :: [AttrValue] -> ShowS
show :: AttrValue -> String
$cshow :: AttrValue -> String
showsPrec :: Int -> AttrValue -> ShowS
$cshowsPrec :: Int -> AttrValue -> ShowS
Show)

-- | Type of dn attribute
type Attribute = (AttrType, AttrValue)

-- | Type of dn component (rdn)
data Component
  = S Attribute
  | L (List1 Attribute)
  deriving (Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Eq, Eq Component
Eq Component
-> (Component -> Component -> Ordering)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Bool)
-> (Component -> Component -> Component)
-> (Component -> Component -> Component)
-> Ord Component
Component -> Component -> Bool
Component -> Component -> Ordering
Component -> Component -> Component
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
min :: Component -> Component -> Component
$cmin :: Component -> Component -> Component
max :: Component -> Component -> Component
$cmax :: Component -> Component -> Component
>= :: Component -> Component -> Bool
$c>= :: Component -> Component -> Bool
> :: Component -> Component -> Bool
$c> :: Component -> Component -> Bool
<= :: Component -> Component -> Bool
$c<= :: Component -> Component -> Bool
< :: Component -> Component -> Bool
$c< :: Component -> Component -> Bool
compare :: Component -> Component -> Ordering
$ccompare :: Component -> Component -> Ordering
$cp1Ord :: Eq Component
Ord, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show)

-- | Construct dn component (rdn)
component :: Attribute -> [Attribute] -> Component
component :: Attribute -> [Attribute] -> Component
component =  Attribute -> [Attribute] -> Component
d  where
  d :: Attribute -> [Attribute] -> Component
d Attribute
x  []        =  Attribute -> Component
S   Attribute
x
  d Attribute
x  xs :: [Attribute]
xs@(Attribute
_:[Attribute]
_)  =  List1 Attribute -> Component
L (List1 Attribute -> Component) -> List1 Attribute -> Component
forall a b. (a -> b) -> a -> b
$ Attribute
x Attribute -> [Attribute] -> List1 Attribute
forall a. a -> [a] -> NonEmpty a
:| [Attribute]
xs

-- | Type of dn
type DN = List1 Component

-- | Construct dn
consDN :: Component -> [Component] -> DN
consDN :: Component -> [Component] -> DN
consDN Component
h [Component]
tl = DN -> DN
forall a. NonEmpty a -> NonEmpty a
reverse (DN -> DN) -> DN -> DN
forall a b. (a -> b) -> a -> b
$ Component
h Component -> [Component] -> DN
forall a. a -> [a] -> NonEmpty a
:| [Component]
tl

-- | Deconstruct dn
unconsDN :: DN -> (Component, [Component])
unconsDN :: DN -> (Component, [Component])
unconsDN DN
dn = (Component
h, [Component]
tl)  where (Component
h :| [Component]
tl) = DN -> DN
forall a. NonEmpty a -> NonEmpty a
reverse DN
dn

-- | Type of dn component (rdn), simple list type
type Component' = [Attribute]

-- | Type of dn, simple list type
type DN' = [Component']

-- | From 'DN' to 'DN''
toDN' :: DN -> DN'
toDN' :: DN -> DN'
toDN' =  (Component -> [Attribute]) -> [Component] -> DN'
forall a b. (a -> b) -> [a] -> [b]
map Component -> [Attribute]
comp' ([Component] -> DN') -> (DN -> [Component]) -> DN -> DN'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DN -> [Component]
forall a. NonEmpty a -> [a]
toList  where
  comp' :: Component -> [Attribute]
comp' (S Attribute
a)  = [Attribute
a]
  comp' (L List1 Attribute
as) = List1 Attribute -> [Attribute]
forall a. NonEmpty a -> [a]
toList List1 Attribute
as

-- | Word8 value of Char
ordW8 :: Char -> Word8
ordW8 :: Char -> Word8
ordW8 =  Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

-- | Quotation word8 code of dn
quotation :: Word8
quotation :: Word8
quotation =  Char -> Word8
ordW8 Char
'"'

-- | Secial word8 codes of dn
specialChars :: [Word8]
specialChars :: [Word8]
specialChars =  (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ordW8 [Char
',', Char
'=', Char
'+', Char
'<', Char
'>', Char
'#', Char
';']


-- LDIF
-- | Type of LDIF attribute value
data LdifAttrValue
  = LAttrValRaw    ByteString
  | LAttrValBase64 ByteString
  deriving (LdifAttrValue -> LdifAttrValue -> Bool
(LdifAttrValue -> LdifAttrValue -> Bool)
-> (LdifAttrValue -> LdifAttrValue -> Bool) -> Eq LdifAttrValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdifAttrValue -> LdifAttrValue -> Bool
$c/= :: LdifAttrValue -> LdifAttrValue -> Bool
== :: LdifAttrValue -> LdifAttrValue -> Bool
$c== :: LdifAttrValue -> LdifAttrValue -> Bool
Eq, Eq LdifAttrValue
Eq LdifAttrValue
-> (LdifAttrValue -> LdifAttrValue -> Ordering)
-> (LdifAttrValue -> LdifAttrValue -> Bool)
-> (LdifAttrValue -> LdifAttrValue -> Bool)
-> (LdifAttrValue -> LdifAttrValue -> Bool)
-> (LdifAttrValue -> LdifAttrValue -> Bool)
-> (LdifAttrValue -> LdifAttrValue -> LdifAttrValue)
-> (LdifAttrValue -> LdifAttrValue -> LdifAttrValue)
-> Ord LdifAttrValue
LdifAttrValue -> LdifAttrValue -> Bool
LdifAttrValue -> LdifAttrValue -> Ordering
LdifAttrValue -> LdifAttrValue -> LdifAttrValue
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
min :: LdifAttrValue -> LdifAttrValue -> LdifAttrValue
$cmin :: LdifAttrValue -> LdifAttrValue -> LdifAttrValue
max :: LdifAttrValue -> LdifAttrValue -> LdifAttrValue
$cmax :: LdifAttrValue -> LdifAttrValue -> LdifAttrValue
>= :: LdifAttrValue -> LdifAttrValue -> Bool
$c>= :: LdifAttrValue -> LdifAttrValue -> Bool
> :: LdifAttrValue -> LdifAttrValue -> Bool
$c> :: LdifAttrValue -> LdifAttrValue -> Bool
<= :: LdifAttrValue -> LdifAttrValue -> Bool
$c<= :: LdifAttrValue -> LdifAttrValue -> Bool
< :: LdifAttrValue -> LdifAttrValue -> Bool
$c< :: LdifAttrValue -> LdifAttrValue -> Bool
compare :: LdifAttrValue -> LdifAttrValue -> Ordering
$ccompare :: LdifAttrValue -> LdifAttrValue -> Ordering
$cp1Ord :: Eq LdifAttrValue
Ord, Int -> LdifAttrValue -> ShowS
[LdifAttrValue] -> ShowS
LdifAttrValue -> String
(Int -> LdifAttrValue -> ShowS)
-> (LdifAttrValue -> String)
-> ([LdifAttrValue] -> ShowS)
-> Show LdifAttrValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdifAttrValue] -> ShowS
$cshowList :: [LdifAttrValue] -> ShowS
show :: LdifAttrValue -> String
$cshow :: LdifAttrValue -> String
showsPrec :: Int -> LdifAttrValue -> ShowS
$cshowsPrec :: Int -> LdifAttrValue -> ShowS
Show)

-- | Char bounds LDIF safe string
ldifSafeBounds :: [Bound Char]
ldifSafeBounds :: [Bound Char]
ldifSafeBounds =
  [ (Char
'\x01', Char
'\x09')
  , (Char
'\x0B', Char
'\x0C')
  , (Char
'\x0E', Char
'\x7F')
  ]

-- | Char bounds LDIF safe string first char
ldifSafeInitBounds :: [Bound Char]
ldifSafeInitBounds :: [Bound Char]
ldifSafeInitBounds =
  [ (Char
'\x01', Char
'\x09')
  , (Char
'\x0B', Char
'\x0C')
  , (Char
'\x0E', Char
'\x1F')
  , (Char
'\x21', Char
'\x39')
  , Char -> Bound Char
forall a. a -> Bound a
exact Char
'\x3B'
  , (Char
'\x3D', Char
'\x7F')
  ]