-- Copyright (c) 2019  Herbert Valerio Riedel <hvr@gnu.org>
--
--  This file is free software: you may copy, redistribute and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation, either version 2 of the License, or (at your
--  option) any later version.
--
--  This file 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
--  General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program (see `LICENSE`).  If not, see
--  <https://www.gnu.org/licenses/old-licenses/gpl-2.0.html>.

{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

-- internal module
module LDAPv3.AttributeDescription
    ( AttributeDescription(..)
    , p'AttributeDescription
    , ts'AttributeDescription
    , r'AttributeDescription

    , Option
    , p'Option
    , ts'Option

    , KeyString
    , p'KeyString
    , ts'KeyString

    , MatchingRuleId(..)
    , p'MatchingRuleId
    , ts'MatchingRuleId
    , r'MatchingRuleId

    , OID(..)
    , p'OID
    , ts'OID
    , r'OID

    , p'DescrOrOID

    ) where

import           Common                 hiding (Option, many, option, some, (<|>))
import           Data.ASN1
import           LDAPv3.StringRepr.Class

import qualified Data.ByteString.Char8  as BSC
import qualified Data.ByteString.Short  as SBS
import           Data.Char              (isDigit, toLower)
import           Data.List
import           Data.Set               (Set)
import qualified Data.Set               as Set
import qualified Data.String            as S
import           Data.Text.Lazy.Builder as B
import qualified Data.Text.Short        as TS
import           Text.Parsec            as P

{- | Attribute Descriptions  (<https://tools.ietf.org/html/rfc4511#section-4.1.4 RFC4511 Section 4.1.4>)

> AttributeDescription ::= LDAPString
>                         -- Constrained to <attributedescription>
>                         -- [RFC4512]

@attributedescription@'s syntax is defined in ABNF (<https://tools.ietf.org/search/rfc4234 RFC4234>) notation as

> attributedescription = attributetype options
> attributetype = oid
> options = *( SEMI option )
> option = 1*keychar
> oid = descr / numericoid
>
> descr = keystring
> numericoid = number 1*( DOT number )
> keystring = leadkeychar *keychar
> leadkeychar = ALPHA
> keychar = ALPHA / DIGIT / HYPHEN
> ALPHA   = %x41-5A / %x61-7A   ; "A"-"Z" / "a"-"z"
> number  = DIGIT / ( LDIGIT 1*DIGIT )
> DIGIT   = %x30 / LDIGIT       ; "0"-"9"
> LDIGIT  = %x31-39             ; "1"-"9"
> HYPHEN  = %x2D                ; hyphen ("-")

See also <https://tools.ietf.org/search/rfc4512#section-2.5 RFC4512 Section 2.5> for the definition of @attributedescription@.

-}
data AttributeDescription = AttributeDescription (Either KeyString OID) (Set Option)
  deriving (AttributeDescription -> AttributeDescription -> Bool
(AttributeDescription -> AttributeDescription -> Bool)
-> (AttributeDescription -> AttributeDescription -> Bool)
-> Eq AttributeDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeDescription -> AttributeDescription -> Bool
$c/= :: AttributeDescription -> AttributeDescription -> Bool
== :: AttributeDescription -> AttributeDescription -> Bool
$c== :: AttributeDescription -> AttributeDescription -> Bool
Eq,Eq AttributeDescription
Eq AttributeDescription =>
(AttributeDescription -> AttributeDescription -> Ordering)
-> (AttributeDescription -> AttributeDescription -> Bool)
-> (AttributeDescription -> AttributeDescription -> Bool)
-> (AttributeDescription -> AttributeDescription -> Bool)
-> (AttributeDescription -> AttributeDescription -> Bool)
-> (AttributeDescription
    -> AttributeDescription -> AttributeDescription)
-> (AttributeDescription
    -> AttributeDescription -> AttributeDescription)
-> Ord AttributeDescription
AttributeDescription -> AttributeDescription -> Bool
AttributeDescription -> AttributeDescription -> Ordering
AttributeDescription
-> AttributeDescription -> AttributeDescription
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 :: AttributeDescription
-> AttributeDescription -> AttributeDescription
$cmin :: AttributeDescription
-> AttributeDescription -> AttributeDescription
max :: AttributeDescription
-> AttributeDescription -> AttributeDescription
$cmax :: AttributeDescription
-> AttributeDescription -> AttributeDescription
>= :: AttributeDescription -> AttributeDescription -> Bool
$c>= :: AttributeDescription -> AttributeDescription -> Bool
> :: AttributeDescription -> AttributeDescription -> Bool
$c> :: AttributeDescription -> AttributeDescription -> Bool
<= :: AttributeDescription -> AttributeDescription -> Bool
$c<= :: AttributeDescription -> AttributeDescription -> Bool
< :: AttributeDescription -> AttributeDescription -> Bool
$c< :: AttributeDescription -> AttributeDescription -> Bool
compare :: AttributeDescription -> AttributeDescription -> Ordering
$ccompare :: AttributeDescription -> AttributeDescription -> Ordering
$cp1Ord :: Eq AttributeDescription
Ord,Int -> AttributeDescription -> ShowS
[AttributeDescription] -> ShowS
AttributeDescription -> String
(Int -> AttributeDescription -> ShowS)
-> (AttributeDescription -> String)
-> ([AttributeDescription] -> ShowS)
-> Show AttributeDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeDescription] -> ShowS
$cshowList :: [AttributeDescription] -> ShowS
show :: AttributeDescription -> String
$cshow :: AttributeDescription -> String
showsPrec :: Int -> AttributeDescription -> ShowS
$cshowsPrec :: Int -> AttributeDescription -> ShowS
Show,(forall x. AttributeDescription -> Rep AttributeDescription x)
-> (forall x. Rep AttributeDescription x -> AttributeDescription)
-> Generic AttributeDescription
forall x. Rep AttributeDescription x -> AttributeDescription
forall x. AttributeDescription -> Rep AttributeDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeDescription x -> AttributeDescription
$cfrom :: forall x. AttributeDescription -> Rep AttributeDescription x
Generic)

instance NFData AttributeDescription where
  rnf :: AttributeDescription -> ()
rnf (AttributeDescription k :: Either KeyString OID
k o :: Set Option
o) = (Either KeyString OID, Set Option) -> ()
forall a. NFData a => a -> ()
rnf (Either KeyString OID
k,Set Option
o)

instance ASN1 AttributeDescription where
  asn1defTag :: Proxy AttributeDescription -> Tag
asn1defTag _ = Proxy OCTET_STRING -> Tag
forall t. ASN1 t => Proxy t -> Tag
asn1defTag (Proxy OCTET_STRING
forall k (t :: k). Proxy t
Proxy :: Proxy OCTET_STRING)
  asn1decode :: ASN1Decode AttributeDescription
asn1decode = String
-> Parser AttributeDescription -> ASN1Decode AttributeDescription
forall t. String -> Parser t -> ASN1Decode t
asn1decodeParsec "AttributeDescription" Parser AttributeDescription
forall s.
Stream s Identity Char =>
Parsec s () AttributeDescription
p'AttributeDescription
  asn1encode :: AttributeDescription -> ASN1Encode Word64
asn1encode = ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (ShortText -> ASN1Encode Word64)
-> (AttributeDescription -> ShortText)
-> AttributeDescription
-> ASN1Encode Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeDescription -> ShortText
ts'AttributeDescription

instance StringRepr AttributeDescription where
  asParsec :: Parsec s () AttributeDescription
asParsec    = Parsec s () AttributeDescription
forall s.
Stream s Identity Char =>
Parsec s () AttributeDescription
p'AttributeDescription
  renderShortText :: AttributeDescription -> ShortText
renderShortText = AttributeDescription -> ShortText
ts'AttributeDescription

instance S.IsString AttributeDescription where
  fromString :: String -> AttributeDescription
fromString = String
-> ParsecT String () Identity AttributeDescription
-> String
-> AttributeDescription
forall s x.
Stream s Identity Char =>
String -> ParsecT s () Identity x -> s -> x
_fromString "AttributeDescription" ParsecT String () Identity AttributeDescription
forall s.
Stream s Identity Char =>
Parsec s () AttributeDescription
p'AttributeDescription

_fromString :: Stream s Identity Char => [Char] -> ParsecT s () Identity x -> s -> x
_fromString :: String -> ParsecT s () Identity x -> s -> x
_fromString l :: String
l p :: ParsecT s () Identity x
p = (ParseError -> x) -> (x -> x) -> Either ParseError x -> x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ParseError -> x
forall a. HasCallStack => String -> a
error ("invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ " string literal")) x -> x
forall a. a -> a
id (Either ParseError x -> x) -> (s -> Either ParseError x) -> s -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT s () Identity x -> String -> s -> Either ParseError x
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT s () Identity x
p ParsecT s () Identity x
-> ParsecT s () Identity () -> ParsecT s () Identity x
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) ""

-- attributedescription = attributetype options
-- attributetype = oid
p'AttributeDescription :: Stream s Identity Char => Parsec s () AttributeDescription
p'AttributeDescription :: Parsec s () AttributeDescription
p'AttributeDescription = Either KeyString OID -> Set Option -> AttributeDescription
AttributeDescription (Either KeyString OID -> Set Option -> AttributeDescription)
-> ParsecT s () Identity (Either KeyString OID)
-> ParsecT s () Identity (Set Option -> AttributeDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity (Either KeyString OID)
forall s.
Stream s Identity Char =>
Parsec s () (Either KeyString OID)
p'DescrOrOID ParsecT s () Identity (Set Option -> AttributeDescription)
-> ParsecT s () Identity (Set Option)
-> Parsec s () AttributeDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Option] -> Set Option
forall a. Ord a => [a] -> Set a
Set.fromList ([Option] -> Set Option)
-> ParsecT s () Identity [Option]
-> ParsecT s () Identity (Set Option)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity [Option]
p'options)
  where
    -- options = *( SEMI option )
    p'options :: ParsecT s () Identity [Option]
p'options = ParsecT s () Identity Option -> ParsecT s () Identity [Option]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT s () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char ';' ParsecT s () Identity Char
-> ParsecT s () Identity Option -> ParsecT s () Identity Option
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s () Identity Option
forall s. Stream s Identity Char => Parsec s () Option
p'Option)

r'AttributeDescription :: AttributeDescription -> Builder
r'AttributeDescription :: AttributeDescription -> Builder
r'AttributeDescription = ShortText -> Builder
b'ShortText (ShortText -> Builder)
-> (AttributeDescription -> ShortText)
-> AttributeDescription
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeDescription -> ShortText
ts'AttributeDescription

ts'AttributeDescription :: AttributeDescription -> ShortText
ts'AttributeDescription :: AttributeDescription -> ShortText
ts'AttributeDescription (AttributeDescription key :: Either KeyString OID
key opts :: Set Option
opts)
  | Set Option -> Bool
forall a. Set a -> Bool
Set.null Set Option
opts = ShortText
k
  | Bool
otherwise = ShortText -> [ShortText] -> ShortText
TS.intercalate ";" (ShortText
kShortText -> [ShortText] -> [ShortText]
forall a. a -> [a] -> [a]
:[ ShortText
o | Option o :: ShortText
o <- Set Option -> [Option]
forall a. Set a -> [a]
Set.toList Set Option
opts])
  where
    k :: ShortText
k = Either KeyString OID -> ShortText
ts'DescrOrOID Either KeyString OID
key

{- | Case-insensitive attribute description option

> option = 1*keychar
> keychar = ALPHA / DIGIT / HYPHEN
> ALPHA   = %x41-5A / %x61-7A   ; "A"-"Z" / "a"-"z"
> DIGIT   = %x30 / LDIGIT       ; "0"-"9"
> HYPHEN  = %x2D                ; hyphen ("-")

-}
newtype Option = Option ShortText
  deriving (Option -> ()
(Option -> ()) -> NFData Option
forall a. (a -> ()) -> NFData a
rnf :: Option -> ()
$crnf :: Option -> ()
NFData)

instance Eq Option where
  Option x :: ShortText
x == :: Option -> Option -> Bool
== Option y :: ShortText
y = ShortText
x ShortText -> ShortText -> Bool
`eqCI` ShortText
y

instance Ord Option where
  Option x :: ShortText
x compare :: Option -> Option -> Ordering
`compare` Option y :: ShortText
y = ShortText
x ShortText -> ShortText -> Ordering
`cmpCI` ShortText
y

instance Show Option where
  showsPrec :: Int -> Option -> ShowS
showsPrec p :: Int
p (Option s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s
  show :: Option -> String
show (Option s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s

instance StringRepr Option where
  asParsec :: Parsec s () Option
asParsec    = Parsec s () Option
forall s. Stream s Identity Char => Parsec s () Option
p'Option
  renderShortText :: Option -> ShortText
renderShortText = Option -> ShortText
ts'Option

instance S.IsString Option where
  fromString :: String -> Option
fromString = String -> ParsecT String () Identity Option -> String -> Option
forall s x.
Stream s Identity Char =>
String -> ParsecT s () Identity x -> s -> x
_fromString "Option" ParsecT String () Identity Option
forall s. Stream s Identity Char => Parsec s () Option
p'Option

-- option = 1*keychar
p'Option :: Stream s Identity Char => Parsec s () Option
p'Option :: Parsec s () Option
p'Option = ShortText -> Option
Option (ShortText -> Option) -> (String -> ShortText) -> String -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
TS.fromString (String -> Option)
-> ParsecT s () Identity String -> Parsec s () Option
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity Char -> ParsecT s () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s () Identity Char
forall s. Stream s Identity Char => Parsec s () Char
p'keychar

ts'Option :: Option -> ShortText
ts'Option :: Option -> ShortText
ts'Option (Option s :: ShortText
s) = ShortText
s

-- oid = descr / numericoid
-- descr = keystring
p'DescrOrOID :: Stream s Identity Char => Parsec s () (Either KeyString OID)
p'DescrOrOID :: Parsec s () (Either KeyString OID)
p'DescrOrOID = ((KeyString -> Either KeyString OID
forall a b. a -> Either a b
Left (KeyString -> Either KeyString OID)
-> ParsecT s () Identity KeyString
-> Parsec s () (Either KeyString OID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity KeyString
forall s. Stream s Identity Char => Parsec s () KeyString
p'KeyString) Parsec s () (Either KeyString OID)
-> Parsec s () (Either KeyString OID)
-> Parsec s () (Either KeyString OID)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (OID -> Either KeyString OID
forall a b. b -> Either a b
Right (OID -> Either KeyString OID)
-> ParsecT s () Identity OID -> Parsec s () (Either KeyString OID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity OID
forall s. Stream s Identity Char => Parsec s () OID
p'OID)) Parsec s () (Either KeyString OID)
-> String -> Parsec s () (Either KeyString OID)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "oid"

ts'DescrOrOID :: Either KeyString OID -> ShortText
ts'DescrOrOID :: Either KeyString OID -> ShortText
ts'DescrOrOID = \case
  Left (KeyString s :: ShortText
s) -> ShortText
s
  Right oid :: OID
oid          -> String -> ShortText
TS.fromString (OID -> String
s'OID OID
oid)

{- | Numeric Object Identifier (OID)

> numericoid = number 1*( DOT number )
> number  = DIGIT / ( LDIGIT 1*DIGIT )
> DIGIT   = %x30 / LDIGIT       ; "0"-"9"
> LDIGIT  = %x31-39             ; "1"-"9"

-}
newtype OID = OID (NonEmpty Natural)
  deriving (OID -> OID -> Bool
(OID -> OID -> Bool) -> (OID -> OID -> Bool) -> Eq OID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OID -> OID -> Bool
$c/= :: OID -> OID -> Bool
== :: OID -> OID -> Bool
$c== :: OID -> OID -> Bool
Eq,Eq OID
Eq OID =>
(OID -> OID -> Ordering)
-> (OID -> OID -> Bool)
-> (OID -> OID -> Bool)
-> (OID -> OID -> Bool)
-> (OID -> OID -> Bool)
-> (OID -> OID -> OID)
-> (OID -> OID -> OID)
-> Ord OID
OID -> OID -> Bool
OID -> OID -> Ordering
OID -> OID -> OID
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 :: OID -> OID -> OID
$cmin :: OID -> OID -> OID
max :: OID -> OID -> OID
$cmax :: OID -> OID -> OID
>= :: OID -> OID -> Bool
$c>= :: OID -> OID -> Bool
> :: OID -> OID -> Bool
$c> :: OID -> OID -> Bool
<= :: OID -> OID -> Bool
$c<= :: OID -> OID -> Bool
< :: OID -> OID -> Bool
$c< :: OID -> OID -> Bool
compare :: OID -> OID -> Ordering
$ccompare :: OID -> OID -> Ordering
$cp1Ord :: Eq OID
Ord,Int -> OID -> ShowS
[OID] -> ShowS
OID -> String
(Int -> OID -> ShowS)
-> (OID -> String) -> ([OID] -> ShowS) -> Show OID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OID] -> ShowS
$cshowList :: [OID] -> ShowS
show :: OID -> String
$cshow :: OID -> String
showsPrec :: Int -> OID -> ShowS
$cshowsPrec :: Int -> OID -> ShowS
Show,OID -> ()
(OID -> ()) -> NFData OID
forall a. (a -> ()) -> NFData a
rnf :: OID -> ()
$crnf :: OID -> ()
NFData)

instance Newtype OID (NonEmpty Natural)

instance ASN1 OID where
  asn1defTag :: Proxy OID -> Tag
asn1defTag _ = Proxy OCTET_STRING -> Tag
forall t. ASN1 t => Proxy t -> Tag
asn1defTag (Proxy OCTET_STRING
forall k (t :: k). Proxy t
Proxy :: Proxy OCTET_STRING)
  asn1encode :: OID -> ASN1Encode Word64
asn1encode oid :: OID
oid = OCTET_STRING -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (String -> OCTET_STRING
BSC.pack (OID -> String
s'OID OID
oid))
  asn1decode :: ASN1Decode OID
asn1decode = String -> Parser OID -> ASN1Decode OID
forall t. String -> Parser t -> ASN1Decode t
asn1decodeParsec "OID" Parser OID
forall s. Stream s Identity Char => Parsec s () OID
p'OID

instance StringRepr OID where
  asBuilder :: OID -> Builder
asBuilder = OID -> Builder
r'OID
  renderShortText :: OID -> ShortText
renderShortText = OID -> ShortText
ts'OID
  asParsec :: Parsec s () OID
asParsec = Parsec s () OID
forall s. Stream s Identity Char => Parsec s () OID
p'OID

r'OID :: OID -> Builder
r'OID :: OID -> Builder
r'OID = String -> Builder
B.fromString (String -> Builder) -> (OID -> String) -> OID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> String
s'OID

ts'OID :: OID -> ShortText
ts'OID :: OID -> ShortText
ts'OID = String -> ShortText
TS.fromString (String -> ShortText) -> (OID -> String) -> OID -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OID -> String
s'OID

s'OID :: OID -> String
s'OID :: OID -> String
s'OID (OID (x :: Natural
x:|xs :: [Natural]
xs)) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "." ((Natural -> String) -> [Natural] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Natural -> String
forall a. Show a => a -> String
show (Natural
xNatural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
:[Natural]
xs))


p'OID :: Stream s Identity Char => Parsec s () OID
p'OID :: Parsec s () OID
p'OID = Parsec s () OID
forall u. ParsecT s u Identity OID
p'numericoid
  where
    -- numericoid = number 1*( DOT number )
    p'numericoid :: ParsecT s u Identity OID
p'numericoid = NonEmpty Natural -> OID
OID (NonEmpty Natural -> OID)
-> ParsecT s u Identity (NonEmpty Natural)
-> ParsecT s u Identity OID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT s u Identity Natural
forall u. ParsecT s u Identity Natural
p'number ParsecT s u Identity Natural
-> ParsecT s u Identity Char
-> ParsecT s u Identity (NonEmpty Natural)
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m (NonEmpty a)
`sepBy1'` Char -> ParsecT s u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char '.')

    -- number  = DIGIT / ( LDIGIT 1*DIGIT )
    -- DIGIT   = %x30 / LDIGIT       ; "0"-"9"
    -- LDIGIT  = %x31-39             ; "1"-"9"
    p'number :: ParsecT s u Identity Natural
p'number = do
      Char
ldigit <- ParsecT s u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      if Char
ldigit Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '0'
         then Natural -> ParsecT s u Identity Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
         else String -> Natural
forall a. Read a => String -> a
read (String -> Natural) -> ShowS -> String -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
ldigitChar -> ShowS
forall a. a -> [a] -> [a]
:) (String -> Natural)
-> ParsecT s u Identity String -> ParsecT s u Identity Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u Identity Char -> ParsecT s u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

{- | Case-insensitive string used to denote OID short names

> keystring = leadkeychar *keychar
> leadkeychar = ALPHA
> keychar = ALPHA / DIGIT / HYPHEN
> ALPHA   = %x41-5A / %x61-7A   ; "A"-"Z" / "a"-"z"
> DIGIT   = %x30 / LDIGIT       ; "0"-"9"
> HYPHEN  = %x2D                ; hyphen ("-")

-}
newtype KeyString = KeyString ShortText
  deriving (KeyString -> ()
(KeyString -> ()) -> NFData KeyString
forall a. (a -> ()) -> NFData a
rnf :: KeyString -> ()
$crnf :: KeyString -> ()
NFData)

instance Eq KeyString where
  KeyString x :: ShortText
x == :: KeyString -> KeyString -> Bool
== KeyString y :: ShortText
y = ShortText
x ShortText -> ShortText -> Bool
`eqCI` ShortText
y

instance Ord KeyString where
  KeyString x :: ShortText
x compare :: KeyString -> KeyString -> Ordering
`compare` KeyString y :: ShortText
y = ShortText
x ShortText -> ShortText -> Ordering
`cmpCI` ShortText
y

instance Show KeyString where
  showsPrec :: Int -> KeyString -> ShowS
showsPrec p :: Int
p (KeyString s :: ShortText
s) = Int -> ShortText -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p ShortText
s
  show :: KeyString -> String
show (KeyString s :: ShortText
s) = ShortText -> String
forall a. Show a => a -> String
show ShortText
s

instance S.IsString KeyString where
  fromString :: String -> KeyString
fromString = String
-> ParsecT String () Identity KeyString -> String -> KeyString
forall s x.
Stream s Identity Char =>
String -> ParsecT s () Identity x -> s -> x
_fromString "KeyString" ParsecT String () Identity KeyString
forall s. Stream s Identity Char => Parsec s () KeyString
p'KeyString

instance StringRepr KeyString where
  asParsec :: Parsec s () KeyString
asParsec = Parsec s () KeyString
forall s. Stream s Identity Char => Parsec s () KeyString
p'KeyString
  renderShortText :: KeyString -> ShortText
renderShortText = KeyString -> ShortText
ts'KeyString

ts'KeyString :: KeyString -> ShortText
ts'KeyString :: KeyString -> ShortText
ts'KeyString (KeyString s :: ShortText
s) = ShortText
s

p'KeyString :: Stream s Identity Char => Parsec s () KeyString
p'KeyString :: Parsec s () KeyString
p'KeyString = ShortText -> KeyString
KeyString (ShortText -> KeyString)
-> (String -> ShortText) -> String -> KeyString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
TS.fromString (String -> KeyString)
-> ParsecT s () Identity String -> Parsec s () KeyString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity String
p'keystring
  where
    -- keystring = leadkeychar *keychar
    -- leadkeychar = ALPHA
    p'keystring :: ParsecT s () Identity String
p'keystring = (:) (Char -> ShowS)
-> ParsecT s () Identity Char -> ParsecT s () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity Char
forall u. ParsecT s u Identity Char
p'ALPHA ParsecT s () Identity ShowS
-> ParsecT s () Identity String -> ParsecT s () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s () Identity Char -> ParsecT s () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s () Identity Char
forall s. Stream s Identity Char => Parsec s () Char
p'keychar

    -- ALPHA   = %x41-5A / %x61-7A   ; "A"-"Z" / "a"-"z"
    p'ALPHA :: ParsecT s u Identity Char
p'ALPHA = (Char -> Bool) -> ParsecT s u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\c :: Char
c -> (Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('A','Z')) Bool -> Bool -> Bool
|| (Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('a','z'))) ParsecT s u Identity Char -> String -> ParsecT s u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> "ALPHA"


-- keychar = ALPHA / DIGIT / HYPHEN
p'keychar :: Stream s Identity Char => Parsec s () Char
p'keychar :: Parsec s () Char
p'keychar = (Char -> Bool) -> Parsec s () Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\c :: Char
c -> (Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('A','Z')) Bool -> Bool -> Bool
|| (Char
c Char -> (Char, Char) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inside` ('a','z')) Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-')


b'ShortText :: ShortText -> Builder
b'ShortText :: ShortText -> Builder
b'ShortText = Text -> Builder
fromText (Text -> Builder) -> (ShortText -> Text) -> ShortText -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
TS.toText

{- | Matching Rule Identifier  (<https://tools.ietf.org/html/rfc4511#section-4.1.8 RFC4511 Section 4.1.8>)

> MatchingRuleId ::= LDAPString

-}
newtype MatchingRuleId = MatchingRuleId (Either KeyString OID)
  deriving ((forall x. MatchingRuleId -> Rep MatchingRuleId x)
-> (forall x. Rep MatchingRuleId x -> MatchingRuleId)
-> Generic MatchingRuleId
forall x. Rep MatchingRuleId x -> MatchingRuleId
forall x. MatchingRuleId -> Rep MatchingRuleId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatchingRuleId x -> MatchingRuleId
$cfrom :: forall x. MatchingRuleId -> Rep MatchingRuleId x
Generic,Int -> MatchingRuleId -> ShowS
[MatchingRuleId] -> ShowS
MatchingRuleId -> String
(Int -> MatchingRuleId -> ShowS)
-> (MatchingRuleId -> String)
-> ([MatchingRuleId] -> ShowS)
-> Show MatchingRuleId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchingRuleId] -> ShowS
$cshowList :: [MatchingRuleId] -> ShowS
show :: MatchingRuleId -> String
$cshow :: MatchingRuleId -> String
showsPrec :: Int -> MatchingRuleId -> ShowS
$cshowsPrec :: Int -> MatchingRuleId -> ShowS
Show,MatchingRuleId -> MatchingRuleId -> Bool
(MatchingRuleId -> MatchingRuleId -> Bool)
-> (MatchingRuleId -> MatchingRuleId -> Bool) -> Eq MatchingRuleId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchingRuleId -> MatchingRuleId -> Bool
$c/= :: MatchingRuleId -> MatchingRuleId -> Bool
== :: MatchingRuleId -> MatchingRuleId -> Bool
$c== :: MatchingRuleId -> MatchingRuleId -> Bool
Eq,Eq MatchingRuleId
Eq MatchingRuleId =>
(MatchingRuleId -> MatchingRuleId -> Ordering)
-> (MatchingRuleId -> MatchingRuleId -> Bool)
-> (MatchingRuleId -> MatchingRuleId -> Bool)
-> (MatchingRuleId -> MatchingRuleId -> Bool)
-> (MatchingRuleId -> MatchingRuleId -> Bool)
-> (MatchingRuleId -> MatchingRuleId -> MatchingRuleId)
-> (MatchingRuleId -> MatchingRuleId -> MatchingRuleId)
-> Ord MatchingRuleId
MatchingRuleId -> MatchingRuleId -> Bool
MatchingRuleId -> MatchingRuleId -> Ordering
MatchingRuleId -> MatchingRuleId -> MatchingRuleId
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 :: MatchingRuleId -> MatchingRuleId -> MatchingRuleId
$cmin :: MatchingRuleId -> MatchingRuleId -> MatchingRuleId
max :: MatchingRuleId -> MatchingRuleId -> MatchingRuleId
$cmax :: MatchingRuleId -> MatchingRuleId -> MatchingRuleId
>= :: MatchingRuleId -> MatchingRuleId -> Bool
$c>= :: MatchingRuleId -> MatchingRuleId -> Bool
> :: MatchingRuleId -> MatchingRuleId -> Bool
$c> :: MatchingRuleId -> MatchingRuleId -> Bool
<= :: MatchingRuleId -> MatchingRuleId -> Bool
$c<= :: MatchingRuleId -> MatchingRuleId -> Bool
< :: MatchingRuleId -> MatchingRuleId -> Bool
$c< :: MatchingRuleId -> MatchingRuleId -> Bool
compare :: MatchingRuleId -> MatchingRuleId -> Ordering
$ccompare :: MatchingRuleId -> MatchingRuleId -> Ordering
$cp1Ord :: Eq MatchingRuleId
Ord,MatchingRuleId -> ()
(MatchingRuleId -> ()) -> NFData MatchingRuleId
forall a. (a -> ()) -> NFData a
rnf :: MatchingRuleId -> ()
$crnf :: MatchingRuleId -> ()
NFData)

instance ASN1 MatchingRuleId where
  asn1defTag :: Proxy MatchingRuleId -> Tag
asn1defTag _ = Proxy OCTET_STRING -> Tag
forall t. ASN1 t => Proxy t -> Tag
asn1defTag (Proxy OCTET_STRING
forall k (t :: k). Proxy t
Proxy :: Proxy OCTET_STRING)
  asn1encode :: MatchingRuleId -> ASN1Encode Word64
asn1encode (MatchingRuleId v :: Either KeyString OID
v) = ShortText -> ASN1Encode Word64
forall t. ASN1 t => t -> ASN1Encode Word64
asn1encode (Either KeyString OID -> ShortText
ts'DescrOrOID Either KeyString OID
v)
  asn1decode :: ASN1Decode MatchingRuleId
asn1decode = String -> Parser MatchingRuleId -> ASN1Decode MatchingRuleId
forall t. String -> Parser t -> ASN1Decode t
asn1decodeParsec "MatchingRuleId" Parser MatchingRuleId
forall s. Stream s Identity Char => Parsec s () MatchingRuleId
p'MatchingRuleId

instance S.IsString MatchingRuleId where
  fromString :: String -> MatchingRuleId
fromString = String
-> ParsecT String () Identity MatchingRuleId
-> String
-> MatchingRuleId
forall s x.
Stream s Identity Char =>
String -> ParsecT s () Identity x -> s -> x
_fromString "MatchingRuleId" ParsecT String () Identity MatchingRuleId
forall s. Stream s Identity Char => Parsec s () MatchingRuleId
p'MatchingRuleId

instance StringRepr MatchingRuleId where
  asParsec :: Parsec s () MatchingRuleId
asParsec = Parsec s () MatchingRuleId
forall s. Stream s Identity Char => Parsec s () MatchingRuleId
p'MatchingRuleId
  renderShortText :: MatchingRuleId -> ShortText
renderShortText = MatchingRuleId -> ShortText
ts'MatchingRuleId

ts'MatchingRuleId :: MatchingRuleId -> ShortText
ts'MatchingRuleId :: MatchingRuleId -> ShortText
ts'MatchingRuleId (MatchingRuleId mrid :: Either KeyString OID
mrid) = Either KeyString OID -> ShortText
ts'DescrOrOID Either KeyString OID
mrid

r'MatchingRuleId :: MatchingRuleId -> Builder
r'MatchingRuleId :: MatchingRuleId -> Builder
r'MatchingRuleId = ShortText -> Builder
b'ShortText (ShortText -> Builder)
-> (MatchingRuleId -> ShortText) -> MatchingRuleId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchingRuleId -> ShortText
ts'MatchingRuleId

p'MatchingRuleId :: Stream s Identity Char => Parsec s () MatchingRuleId
p'MatchingRuleId :: Parsec s () MatchingRuleId
p'MatchingRuleId = Either KeyString OID -> MatchingRuleId
MatchingRuleId (Either KeyString OID -> MatchingRuleId)
-> ParsecT s () Identity (Either KeyString OID)
-> Parsec s () MatchingRuleId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s () Identity (Either KeyString OID)
forall s.
Stream s Identity Char =>
Parsec s () (Either KeyString OID)
p'DescrOrOID



eqCI :: ShortText -> ShortText -> Bool
eqCI :: ShortText -> ShortText -> Bool
eqCI x :: ShortText
x y :: ShortText
y
  | ShortText
x ShortText -> ShortText -> Bool
forall a. Eq a => a -> a -> Bool
== ShortText
y = Bool
True
  | ShortByteString -> Int
SBS.length (ShortText -> ShortByteString
TS.toShortByteString ShortText
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= ShortByteString -> Int
SBS.length (ShortText -> ShortByteString
TS.toShortByteString ShortText
y) = Bool
False
  | Bool
otherwise = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShortText -> String
TS.toString ShortText
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShortText -> String
TS.toString ShortText
y)

cmpCI :: ShortText -> ShortText -> Ordering
cmpCI :: ShortText -> ShortText -> Ordering
cmpCI x :: ShortText
x y :: ShortText
y
  | ShortText
x ShortText -> ShortText -> Bool
forall a. Eq a => a -> a -> Bool
== ShortText
y = Ordering
EQ
  | Bool
otherwise = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShortText -> String
TS.toString ShortText
x) String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShortText -> String
TS.toString ShortText
y)