module Ldap.Asn1.Type where

import Data.ByteString (ByteString)
import Data.Int (Int8, Int32)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)


-- | Message envelope. (Section 4.1.1.)
data LdapMessage op = LdapMessage
  { forall op. LdapMessage op -> Id
ldapMessageId       :: !Id
  , forall op. LdapMessage op -> op
ldapMessageOp       :: !op
  , forall op. LdapMessage op -> Maybe Controls
ldapMessageControls :: !(Maybe Controls)
  } deriving (Int -> LdapMessage op -> ShowS
forall op. Show op => Int -> LdapMessage op -> ShowS
forall op. Show op => [LdapMessage op] -> ShowS
forall op. Show op => LdapMessage op -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdapMessage op] -> ShowS
$cshowList :: forall op. Show op => [LdapMessage op] -> ShowS
show :: LdapMessage op -> String
$cshow :: forall op. Show op => LdapMessage op -> String
showsPrec :: Int -> LdapMessage op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> LdapMessage op -> ShowS
Show, LdapMessage op -> LdapMessage op -> Bool
forall op. Eq op => LdapMessage op -> LdapMessage op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdapMessage op -> LdapMessage op -> Bool
$c/= :: forall op. Eq op => LdapMessage op -> LdapMessage op -> Bool
== :: LdapMessage op -> LdapMessage op -> Bool
$c== :: forall op. Eq op => LdapMessage op -> LdapMessage op -> Bool
Eq)

-- | Every message being processed has a unique non-zero integer ID. (Section 4.1.1.1.)
newtype Id = Id { Id -> Int32
unId :: Int32 }
    deriving (Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show, Id -> Id -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
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 :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
Ord)

-- | Client requests.  The RFC doesn't make a difference between 'ProtocolClientOp'
-- and 'ProtocolServerOp' but it's useful to distinguish between them in Haskell.
data ProtocolClientOp =
    BindRequest !Int8 !LdapDn !AuthenticationChoice
  | UnbindRequest
  | SearchRequest !LdapDn !Scope !DerefAliases !Int32 !Int32 !Bool !Filter !AttributeSelection
  | ModifyRequest !LdapDn ![(Operation, PartialAttribute)]
  | AddRequest !LdapDn !AttributeList
  | DeleteRequest !LdapDn
  | ModifyDnRequest !LdapDn !RelativeLdapDn !Bool !(Maybe LdapDn)
  | CompareRequest !LdapDn !AttributeValueAssertion
  | ExtendedRequest !LdapOid !(Maybe ByteString)
    deriving (Int -> ProtocolClientOp -> ShowS
[ProtocolClientOp] -> ShowS
ProtocolClientOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolClientOp] -> ShowS
$cshowList :: [ProtocolClientOp] -> ShowS
show :: ProtocolClientOp -> String
$cshow :: ProtocolClientOp -> String
showsPrec :: Int -> ProtocolClientOp -> ShowS
$cshowsPrec :: Int -> ProtocolClientOp -> ShowS
Show, ProtocolClientOp -> ProtocolClientOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolClientOp -> ProtocolClientOp -> Bool
$c/= :: ProtocolClientOp -> ProtocolClientOp -> Bool
== :: ProtocolClientOp -> ProtocolClientOp -> Bool
$c== :: ProtocolClientOp -> ProtocolClientOp -> Bool
Eq)

-- | Server responses.  The RFC doesn't make a difference between 'ProtocolClientOp'
-- and 'ProtocolServerOp' but it's useful to distinguish between them in Haskell.
data ProtocolServerOp =
    BindResponse !LdapResult !(Maybe ByteString)
  | SearchResultEntry !LdapDn !PartialAttributeList
  | SearchResultReference !(NonEmpty Uri)
  | SearchResultDone !LdapResult
  | ModifyResponse !LdapResult
  | AddResponse !LdapResult
  | DeleteResponse !LdapResult
  | ModifyDnResponse !LdapResult
  | CompareResponse !LdapResult
  | ExtendedResponse !LdapResult !(Maybe LdapOid) !(Maybe ByteString)
  | IntermediateResponse !(Maybe LdapOid) !(Maybe ByteString)
    deriving (Int -> ProtocolServerOp -> ShowS
[ProtocolServerOp] -> ShowS
ProtocolServerOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolServerOp] -> ShowS
$cshowList :: [ProtocolServerOp] -> ShowS
show :: ProtocolServerOp -> String
$cshow :: ProtocolServerOp -> String
showsPrec :: Int -> ProtocolServerOp -> ShowS
$cshowsPrec :: Int -> ProtocolServerOp -> ShowS
Show, ProtocolServerOp -> ProtocolServerOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolServerOp -> ProtocolServerOp -> Bool
$c/= :: ProtocolServerOp -> ProtocolServerOp -> Bool
== :: ProtocolServerOp -> ProtocolServerOp -> Bool
$c== :: ProtocolServerOp -> ProtocolServerOp -> Bool
Eq)

-- | Not really a choice until SASL is supported.
data AuthenticationChoice =
    Simple !ByteString
  | Sasl !SaslMechanism !(Maybe Text)
    deriving (Int -> AuthenticationChoice -> ShowS
[AuthenticationChoice] -> ShowS
AuthenticationChoice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationChoice] -> ShowS
$cshowList :: [AuthenticationChoice] -> ShowS
show :: AuthenticationChoice -> String
$cshow :: AuthenticationChoice -> String
showsPrec :: Int -> AuthenticationChoice -> ShowS
$cshowsPrec :: Int -> AuthenticationChoice -> ShowS
Show, AuthenticationChoice -> AuthenticationChoice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthenticationChoice -> AuthenticationChoice -> Bool
$c/= :: AuthenticationChoice -> AuthenticationChoice -> Bool
== :: AuthenticationChoice -> AuthenticationChoice -> Bool
$c== :: AuthenticationChoice -> AuthenticationChoice -> Bool
Eq)

-- | SASL Mechanism, for now only SASL EXTERNAL is supported
data SaslMechanism =
    External
    deriving (Int -> SaslMechanism -> ShowS
[SaslMechanism] -> ShowS
SaslMechanism -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaslMechanism] -> ShowS
$cshowList :: [SaslMechanism] -> ShowS
show :: SaslMechanism -> String
$cshow :: SaslMechanism -> String
showsPrec :: Int -> SaslMechanism -> ShowS
$cshowsPrec :: Int -> SaslMechanism -> ShowS
Show, SaslMechanism -> SaslMechanism -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaslMechanism -> SaslMechanism -> Bool
$c/= :: SaslMechanism -> SaslMechanism -> Bool
== :: SaslMechanism -> SaslMechanism -> Bool
$c== :: SaslMechanism -> SaslMechanism -> Bool
Eq)

-- | Scope of the search to be performed.
data Scope =
    BaseObject   -- ^ Constrained to the entry named by baseObject.
  | SingleLevel  -- ^ Constrained to the immediate subordinates of the entry named by baseObject.
  | WholeSubtree -- ^ Constrained to the entry named by baseObject and to all its subordinates.
    deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq)

-- | An indicator as to whether or not alias entries (as defined in
-- [RFC4512]) are to be dereferenced during stages of the Search
-- operation.
data DerefAliases =
    NeverDerefAliases      -- ^ Do not dereference aliases in searching or in locating the base object of the Search.
  | DerefInSearching       -- ^ While searching subordinates of the base object, dereference any alias within the search scope.
  | DerefFindingBaseObject -- ^ Dereference aliases in locating the base object of the Search.
  | DerefAlways            -- ^ Dereference aliases both in searching and in locating the base object of the Search.
    deriving (Int -> DerefAliases -> ShowS
[DerefAliases] -> ShowS
DerefAliases -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerefAliases] -> ShowS
$cshowList :: [DerefAliases] -> ShowS
show :: DerefAliases -> String
$cshow :: DerefAliases -> String
showsPrec :: Int -> DerefAliases -> ShowS
$cshowsPrec :: Int -> DerefAliases -> ShowS
Show, DerefAliases -> DerefAliases -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerefAliases -> DerefAliases -> Bool
$c/= :: DerefAliases -> DerefAliases -> Bool
== :: DerefAliases -> DerefAliases -> Bool
$c== :: DerefAliases -> DerefAliases -> Bool
Eq)

-- | Conditions that must be fulfilled in order for the Search to match a given entry.
data Filter =
    And !(NonEmpty Filter)                  -- ^ All filters evaluate to @TRUE@
  | Or !(NonEmpty Filter)                   -- ^ Any filter evaluates to @TRUE@
  | Not !Filter                             -- ^ Filter evaluates to @FALSE@
  | EqualityMatch !AttributeValueAssertion  -- ^ @EQUALITY@ rule returns @TRUE@
  | Substrings !SubstringFilter             -- ^ @SUBSTR@ rule returns @TRUE@
  | GreaterOrEqual !AttributeValueAssertion -- ^ @ORDERING@ rule returns @FALSE@
  | LessOrEqual !AttributeValueAssertion    -- ^ @ORDERING@ or @EQUALITY@ rule returns @TRUE@
  | Present !AttributeDescription           -- ^ Attribute is present in the entry
  | ApproxMatch !AttributeValueAssertion    -- ^ Same as 'EqualityMatch' for most servers
  | ExtensibleMatch !MatchingRuleAssertion
    deriving (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show, Filter -> Filter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq)

data SubstringFilter = SubstringFilter !AttributeDescription !(NonEmpty Substring)
    deriving (Int -> SubstringFilter -> ShowS
[SubstringFilter] -> ShowS
SubstringFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubstringFilter] -> ShowS
$cshowList :: [SubstringFilter] -> ShowS
show :: SubstringFilter -> String
$cshow :: SubstringFilter -> String
showsPrec :: Int -> SubstringFilter -> ShowS
$cshowsPrec :: Int -> SubstringFilter -> ShowS
Show, SubstringFilter -> SubstringFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubstringFilter -> SubstringFilter -> Bool
$c/= :: SubstringFilter -> SubstringFilter -> Bool
== :: SubstringFilter -> SubstringFilter -> Bool
$c== :: SubstringFilter -> SubstringFilter -> Bool
Eq)

data Substring =
    Initial !AssertionValue
  | Any !AssertionValue
  | Final !AssertionValue
    deriving (Int -> Substring -> ShowS
[Substring] -> ShowS
Substring -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Substring] -> ShowS
$cshowList :: [Substring] -> ShowS
show :: Substring -> String
$cshow :: Substring -> String
showsPrec :: Int -> Substring -> ShowS
$cshowsPrec :: Int -> Substring -> ShowS
Show, Substring -> Substring -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Substring -> Substring -> Bool
$c/= :: Substring -> Substring -> Bool
== :: Substring -> Substring -> Bool
$c== :: Substring -> Substring -> Bool
Eq)

data MatchingRuleAssertion = MatchingRuleAssertion !(Maybe MatchingRuleId) !(Maybe AttributeDescription) !AssertionValue !Bool
    deriving (Int -> MatchingRuleAssertion -> ShowS
[MatchingRuleAssertion] -> ShowS
MatchingRuleAssertion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchingRuleAssertion] -> ShowS
$cshowList :: [MatchingRuleAssertion] -> ShowS
show :: MatchingRuleAssertion -> String
$cshow :: MatchingRuleAssertion -> String
showsPrec :: Int -> MatchingRuleAssertion -> ShowS
$cshowsPrec :: Int -> MatchingRuleAssertion -> ShowS
Show, MatchingRuleAssertion -> MatchingRuleAssertion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchingRuleAssertion -> MatchingRuleAssertion -> Bool
$c/= :: MatchingRuleAssertion -> MatchingRuleAssertion -> Bool
== :: MatchingRuleAssertion -> MatchingRuleAssertion -> Bool
$c== :: MatchingRuleAssertion -> MatchingRuleAssertion -> Bool
Eq)

-- | Matching rules are defined in Section 4.1.3 of [RFC4512].  A matching
-- rule is identified in the protocol by the printable representation of
-- either its <numericoid> or one of its short name descriptors
-- [RFC4512], e.g., 'caseIgnoreMatch' or '2.5.13.2'. (Section 4.1.8.)
newtype MatchingRuleId = MatchingRuleId LdapString
    deriving (Int -> MatchingRuleId -> ShowS
[MatchingRuleId] -> ShowS
MatchingRuleId -> String
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
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)

newtype AttributeSelection = AttributeSelection [LdapString]
    deriving (Int -> AttributeSelection -> ShowS
[AttributeSelection] -> ShowS
AttributeSelection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeSelection] -> ShowS
$cshowList :: [AttributeSelection] -> ShowS
show :: AttributeSelection -> String
$cshow :: AttributeSelection -> String
showsPrec :: Int -> AttributeSelection -> ShowS
$cshowsPrec :: Int -> AttributeSelection -> ShowS
Show, AttributeSelection -> AttributeSelection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeSelection -> AttributeSelection -> Bool
$c/= :: AttributeSelection -> AttributeSelection -> Bool
== :: AttributeSelection -> AttributeSelection -> Bool
$c== :: AttributeSelection -> AttributeSelection -> Bool
Eq)

newtype AttributeList = AttributeList [Attribute]
    deriving (Int -> AttributeList -> ShowS
[AttributeList] -> ShowS
AttributeList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeList] -> ShowS
$cshowList :: [AttributeList] -> ShowS
show :: AttributeList -> String
$cshow :: AttributeList -> String
showsPrec :: Int -> AttributeList -> ShowS
$cshowsPrec :: Int -> AttributeList -> ShowS
Show, AttributeList -> AttributeList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeList -> AttributeList -> Bool
$c/= :: AttributeList -> AttributeList -> Bool
== :: AttributeList -> AttributeList -> Bool
$c== :: AttributeList -> AttributeList -> Bool
Eq)

newtype PartialAttributeList = PartialAttributeList [PartialAttribute]
    deriving (Int -> PartialAttributeList -> ShowS
[PartialAttributeList] -> ShowS
PartialAttributeList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialAttributeList] -> ShowS
$cshowList :: [PartialAttributeList] -> ShowS
show :: PartialAttributeList -> String
$cshow :: PartialAttributeList -> String
showsPrec :: Int -> PartialAttributeList -> ShowS
$cshowsPrec :: Int -> PartialAttributeList -> ShowS
Show, PartialAttributeList -> PartialAttributeList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialAttributeList -> PartialAttributeList -> Bool
$c/= :: PartialAttributeList -> PartialAttributeList -> Bool
== :: PartialAttributeList -> PartialAttributeList -> Bool
$c== :: PartialAttributeList -> PartialAttributeList -> Bool
Eq)

newtype Controls = Controls [Control]
    deriving (Int -> Controls -> ShowS
[Controls] -> ShowS
Controls -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Controls] -> ShowS
$cshowList :: [Controls] -> ShowS
show :: Controls -> String
$cshow :: Controls -> String
showsPrec :: Int -> Controls -> ShowS
$cshowsPrec :: Int -> Controls -> ShowS
Show, Controls -> Controls -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Controls -> Controls -> Bool
$c/= :: Controls -> Controls -> Bool
== :: Controls -> Controls -> Bool
$c== :: Controls -> Controls -> Bool
Eq)

data Control = Control !LdapOid !Bool !(Maybe ByteString)
    deriving (Int -> Control -> ShowS
[Control] -> ShowS
Control -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Control] -> ShowS
$cshowList :: [Control] -> ShowS
show :: Control -> String
$cshow :: Control -> String
showsPrec :: Int -> Control -> ShowS
$cshowsPrec :: Int -> Control -> ShowS
Show, Control -> Control -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Control -> Control -> Bool
$c/= :: Control -> Control -> Bool
== :: Control -> Control -> Bool
$c== :: Control -> Control -> Bool
Eq)

data LdapResult = LdapResult !ResultCode !LdapDn !LdapString !(Maybe ReferralUris)
    deriving (Int -> LdapResult -> ShowS
[LdapResult] -> ShowS
LdapResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdapResult] -> ShowS
$cshowList :: [LdapResult] -> ShowS
show :: LdapResult -> String
$cshow :: LdapResult -> String
showsPrec :: Int -> LdapResult -> ShowS
$cshowsPrec :: Int -> LdapResult -> ShowS
Show, LdapResult -> LdapResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdapResult -> LdapResult -> Bool
$c/= :: LdapResult -> LdapResult -> Bool
== :: LdapResult -> LdapResult -> Bool
$c== :: LdapResult -> LdapResult -> Bool
Eq)

-- | LDAP operation's result.
data ResultCode =
    Success
  | OperationError
  | ProtocolError
  | TimeLimitExceeded
  | SizeLimitExceeded
  | CompareFalse
  | CompareTrue
  | AuthMethodNotSupported
  | StrongerAuthRequired
  | Referral
  | AdminLimitExceeded
  | UnavailableCriticalExtension
  | ConfidentialityRequired
  | SaslBindInProgress
  | NoSuchAttribute
  | UndefinedAttributeType
  | InappropriateMatching
  | ConstraintViolation
  | AttributeOrValueExists
  | InvalidAttributeSyntax
  | NoSuchObject
  | AliasProblem
  | InvalidDNSyntax
  | AliasDereferencingProblem
  | InappropriateAuthentication
  | InvalidCredentials
  | InsufficientAccessRights
  | Busy
  | Unavailable
  | UnwillingToPerform
  | LoopDetect
  | NamingViolation
  | ObjectClassViolation
  | NotAllowedOnNonLeaf
  | NotAllowedOnRDN
  | EntryAlreadyExists
  | ObjectClassModsProhibited
  | AffectsMultipleDSAs
  | Other
    deriving (Int -> ResultCode -> ShowS
[ResultCode] -> ShowS
ResultCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultCode] -> ShowS
$cshowList :: [ResultCode] -> ShowS
show :: ResultCode -> String
$cshow :: ResultCode -> String
showsPrec :: Int -> ResultCode -> ShowS
$cshowsPrec :: Int -> ResultCode -> ShowS
Show, ResultCode -> ResultCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultCode -> ResultCode -> Bool
$c/= :: ResultCode -> ResultCode -> Bool
== :: ResultCode -> ResultCode -> Bool
$c== :: ResultCode -> ResultCode -> Bool
Eq)

newtype AttributeDescription = AttributeDescription LdapString
    deriving (Int -> AttributeDescription -> ShowS
[AttributeDescription] -> ShowS
AttributeDescription -> String
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, AttributeDescription -> AttributeDescription -> Bool
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)

newtype AttributeValue = AttributeValue ByteString
    deriving (Int -> AttributeValue -> ShowS
[AttributeValue] -> ShowS
AttributeValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValue] -> ShowS
$cshowList :: [AttributeValue] -> ShowS
show :: AttributeValue -> String
$cshow :: AttributeValue -> String
showsPrec :: Int -> AttributeValue -> ShowS
$cshowsPrec :: Int -> AttributeValue -> ShowS
Show, AttributeValue -> AttributeValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValue -> AttributeValue -> Bool
$c/= :: AttributeValue -> AttributeValue -> Bool
== :: AttributeValue -> AttributeValue -> Bool
$c== :: AttributeValue -> AttributeValue -> Bool
Eq)

data AttributeValueAssertion = AttributeValueAssertion !AttributeDescription !AssertionValue
    deriving (Int -> AttributeValueAssertion -> ShowS
[AttributeValueAssertion] -> ShowS
AttributeValueAssertion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeValueAssertion] -> ShowS
$cshowList :: [AttributeValueAssertion] -> ShowS
show :: AttributeValueAssertion -> String
$cshow :: AttributeValueAssertion -> String
showsPrec :: Int -> AttributeValueAssertion -> ShowS
$cshowsPrec :: Int -> AttributeValueAssertion -> ShowS
Show, AttributeValueAssertion -> AttributeValueAssertion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeValueAssertion -> AttributeValueAssertion -> Bool
$c/= :: AttributeValueAssertion -> AttributeValueAssertion -> Bool
== :: AttributeValueAssertion -> AttributeValueAssertion -> Bool
$c== :: AttributeValueAssertion -> AttributeValueAssertion -> Bool
Eq)

newtype AssertionValue = AssertionValue ByteString
    deriving (Int -> AssertionValue -> ShowS
[AssertionValue] -> ShowS
AssertionValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionValue] -> ShowS
$cshowList :: [AssertionValue] -> ShowS
show :: AssertionValue -> String
$cshow :: AssertionValue -> String
showsPrec :: Int -> AssertionValue -> ShowS
$cshowsPrec :: Int -> AssertionValue -> ShowS
Show, AssertionValue -> AssertionValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionValue -> AssertionValue -> Bool
$c/= :: AssertionValue -> AssertionValue -> Bool
== :: AssertionValue -> AssertionValue -> Bool
$c== :: AssertionValue -> AssertionValue -> Bool
Eq)

data Attribute = Attribute !AttributeDescription !(NonEmpty AttributeValue)
    deriving (Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, Attribute -> Attribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq)

data PartialAttribute = PartialAttribute !AttributeDescription ![AttributeValue]
    deriving (Int -> PartialAttribute -> ShowS
[PartialAttribute] -> ShowS
PartialAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialAttribute] -> ShowS
$cshowList :: [PartialAttribute] -> ShowS
show :: PartialAttribute -> String
$cshow :: PartialAttribute -> String
showsPrec :: Int -> PartialAttribute -> ShowS
$cshowsPrec :: Int -> PartialAttribute -> ShowS
Show, PartialAttribute -> PartialAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialAttribute -> PartialAttribute -> Bool
$c/= :: PartialAttribute -> PartialAttribute -> Bool
== :: PartialAttribute -> PartialAttribute -> Bool
$c== :: PartialAttribute -> PartialAttribute -> Bool
Eq)



-- | An LDAPDN is defined to be the representation of a Distinguished Name
-- (DN) after encoding according to the specification in [RFC4514].
newtype LdapDn = LdapDn LdapString
    deriving (Int -> LdapDn -> ShowS
[LdapDn] -> ShowS
LdapDn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdapDn] -> ShowS
$cshowList :: [LdapDn] -> ShowS
show :: LdapDn -> String
$cshow :: LdapDn -> String
showsPrec :: Int -> LdapDn -> ShowS
$cshowsPrec :: Int -> LdapDn -> ShowS
Show, LdapDn -> LdapDn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdapDn -> LdapDn -> Bool
$c/= :: LdapDn -> LdapDn -> Bool
== :: LdapDn -> LdapDn -> Bool
$c== :: LdapDn -> LdapDn -> Bool
Eq)

-- | A RelativeLDAPDN is defined to be the representation of a Relative
-- Distinguished Name (RDN) after encoding according to the
-- specification in [RFC4514].
newtype RelativeLdapDn = RelativeLdapDn LdapString
    deriving (Int -> RelativeLdapDn -> ShowS
[RelativeLdapDn] -> ShowS
RelativeLdapDn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelativeLdapDn] -> ShowS
$cshowList :: [RelativeLdapDn] -> ShowS
show :: RelativeLdapDn -> String
$cshow :: RelativeLdapDn -> String
showsPrec :: Int -> RelativeLdapDn -> ShowS
$cshowsPrec :: Int -> RelativeLdapDn -> ShowS
Show, RelativeLdapDn -> RelativeLdapDn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelativeLdapDn -> RelativeLdapDn -> Bool
$c/= :: RelativeLdapDn -> RelativeLdapDn -> Bool
== :: RelativeLdapDn -> RelativeLdapDn -> Bool
$c== :: RelativeLdapDn -> RelativeLdapDn -> Bool
Eq)

newtype ReferralUris = ReferralUris (NonEmpty Uri)
    deriving (Int -> ReferralUris -> ShowS
[ReferralUris] -> ShowS
ReferralUris -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferralUris] -> ShowS
$cshowList :: [ReferralUris] -> ShowS
show :: ReferralUris -> String
$cshow :: ReferralUris -> String
showsPrec :: Int -> ReferralUris -> ShowS
$cshowsPrec :: Int -> ReferralUris -> ShowS
Show, ReferralUris -> ReferralUris -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferralUris -> ReferralUris -> Bool
$c/= :: ReferralUris -> ReferralUris -> Bool
== :: ReferralUris -> ReferralUris -> Bool
$c== :: ReferralUris -> ReferralUris -> Bool
Eq)

newtype Uri = Uri LdapString
    deriving (Int -> Uri -> ShowS
[Uri] -> ShowS
Uri -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Uri] -> ShowS
$cshowList :: [Uri] -> ShowS
show :: Uri -> String
$cshow :: Uri -> String
showsPrec :: Int -> Uri -> ShowS
$cshowsPrec :: Int -> Uri -> ShowS
Show, Uri -> Uri -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Uri -> Uri -> Bool
$c/= :: Uri -> Uri -> Bool
== :: Uri -> Uri -> Bool
$c== :: Uri -> Uri -> Bool
Eq)

data Operation =
    Add
  | Delete
  | Replace
    deriving (Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operation] -> ShowS
$cshowList :: [Operation] -> ShowS
show :: Operation -> String
$cshow :: Operation -> String
showsPrec :: Int -> Operation -> ShowS
$cshowsPrec :: Int -> Operation -> ShowS
Show, Operation -> Operation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c== :: Operation -> Operation -> Bool
Eq)

-- | The LDAPString is a notational convenience to indicate that, although
-- strings of LDAPString type encode as ASN.1 OCTET STRING types, the
-- [ISO10646] character set (a superset of [Unicode]) is used, encoded
-- following the UTF-8 [RFC3629] algorithm. (Section 4.1.2.)
newtype LdapString = LdapString Text
    deriving (Int -> LdapString -> ShowS
[LdapString] -> ShowS
LdapString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdapString] -> ShowS
$cshowList :: [LdapString] -> ShowS
show :: LdapString -> String
$cshow :: LdapString -> String
showsPrec :: Int -> LdapString -> ShowS
$cshowsPrec :: Int -> LdapString -> ShowS
Show, LdapString -> LdapString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdapString -> LdapString -> Bool
$c/= :: LdapString -> LdapString -> Bool
== :: LdapString -> LdapString -> Bool
$c== :: LdapString -> LdapString -> Bool
Eq)

-- | The LDAPOID is a notational convenience to indicate that the
-- permitted value of this string is a (UTF-8 encoded) dotted-decimal
-- representation of an OBJECT IDENTIFIER.  Although an LDAPOID is
-- encoded as an OCTET STRING, values are limited to the definition of
-- \<numericoid\> given in Section 1.4 of [RFC4512].
newtype LdapOid = LdapOid Text
    deriving (Int -> LdapOid -> ShowS
[LdapOid] -> ShowS
LdapOid -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LdapOid] -> ShowS
$cshowList :: [LdapOid] -> ShowS
show :: LdapOid -> String
$cshow :: LdapOid -> String
showsPrec :: Int -> LdapOid -> ShowS
$cshowsPrec :: Int -> LdapOid -> ShowS
Show, LdapOid -> LdapOid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LdapOid -> LdapOid -> Bool
$c/= :: LdapOid -> LdapOid -> Bool
== :: LdapOid -> LdapOid -> Bool
$c== :: LdapOid -> LdapOid -> Bool
Eq)