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
[LdapMessage op] -> ShowS
LdapMessage op -> String
(Int -> LdapMessage op -> ShowS)
-> (LdapMessage op -> String)
-> ([LdapMessage op] -> ShowS)
-> Show (LdapMessage op)
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
$cshowsPrec :: forall op. Show op => Int -> LdapMessage op -> ShowS
showsPrec :: Int -> LdapMessage op -> ShowS
$cshow :: forall op. Show op => LdapMessage op -> String
show :: LdapMessage op -> String
$cshowList :: forall op. Show op => [LdapMessage op] -> ShowS
showList :: [LdapMessage op] -> ShowS
Show, LdapMessage op -> LdapMessage op -> Bool
(LdapMessage op -> LdapMessage op -> Bool)
-> (LdapMessage op -> LdapMessage op -> Bool)
-> Eq (LdapMessage op)
forall op. Eq op => LdapMessage op -> LdapMessage op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: 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
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Id -> ShowS
showsPrec :: Int -> Id -> ShowS
$cshow :: Id -> String
show :: Id -> String
$cshowList :: [Id] -> ShowS
showList :: [Id] -> ShowS
Show, Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
/= :: Id -> Id -> Bool
Eq, Eq Id
Eq Id =>
(Id -> Id -> Ordering)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Id)
-> (Id -> Id -> Id)
-> Ord 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
$ccompare :: Id -> Id -> Ordering
compare :: Id -> Id -> Ordering
$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
>= :: Id -> Id -> Bool
$cmax :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
min :: Id -> Id -> Id
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
(Int -> ProtocolClientOp -> ShowS)
-> (ProtocolClientOp -> String)
-> ([ProtocolClientOp] -> ShowS)
-> Show ProtocolClientOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolClientOp -> ShowS
showsPrec :: Int -> ProtocolClientOp -> ShowS
$cshow :: ProtocolClientOp -> String
show :: ProtocolClientOp -> String
$cshowList :: [ProtocolClientOp] -> ShowS
showList :: [ProtocolClientOp] -> ShowS
Show, ProtocolClientOp -> ProtocolClientOp -> Bool
(ProtocolClientOp -> ProtocolClientOp -> Bool)
-> (ProtocolClientOp -> ProtocolClientOp -> Bool)
-> Eq ProtocolClientOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolClientOp -> ProtocolClientOp -> Bool
== :: ProtocolClientOp -> ProtocolClientOp -> Bool
$c/= :: ProtocolClientOp -> ProtocolClientOp -> Bool
/= :: 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
(Int -> ProtocolServerOp -> ShowS)
-> (ProtocolServerOp -> String)
-> ([ProtocolServerOp] -> ShowS)
-> Show ProtocolServerOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolServerOp -> ShowS
showsPrec :: Int -> ProtocolServerOp -> ShowS
$cshow :: ProtocolServerOp -> String
show :: ProtocolServerOp -> String
$cshowList :: [ProtocolServerOp] -> ShowS
showList :: [ProtocolServerOp] -> ShowS
Show, ProtocolServerOp -> ProtocolServerOp -> Bool
(ProtocolServerOp -> ProtocolServerOp -> Bool)
-> (ProtocolServerOp -> ProtocolServerOp -> Bool)
-> Eq ProtocolServerOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProtocolServerOp -> ProtocolServerOp -> Bool
== :: ProtocolServerOp -> ProtocolServerOp -> Bool
$c/= :: ProtocolServerOp -> ProtocolServerOp -> Bool
/= :: 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
(Int -> AuthenticationChoice -> ShowS)
-> (AuthenticationChoice -> String)
-> ([AuthenticationChoice] -> ShowS)
-> Show AuthenticationChoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthenticationChoice -> ShowS
showsPrec :: Int -> AuthenticationChoice -> ShowS
$cshow :: AuthenticationChoice -> String
show :: AuthenticationChoice -> String
$cshowList :: [AuthenticationChoice] -> ShowS
showList :: [AuthenticationChoice] -> ShowS
Show, AuthenticationChoice -> AuthenticationChoice -> Bool
(AuthenticationChoice -> AuthenticationChoice -> Bool)
-> (AuthenticationChoice -> AuthenticationChoice -> Bool)
-> Eq AuthenticationChoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthenticationChoice -> AuthenticationChoice -> Bool
== :: AuthenticationChoice -> AuthenticationChoice -> Bool
$c/= :: AuthenticationChoice -> AuthenticationChoice -> Bool
/= :: AuthenticationChoice -> AuthenticationChoice -> Bool
Eq)

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

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

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

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

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

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

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

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

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

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

newtype AttributeDescription = AttributeDescription LdapString
    deriving (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
$cshowsPrec :: Int -> AttributeDescription -> ShowS
showsPrec :: Int -> AttributeDescription -> ShowS
$cshow :: AttributeDescription -> String
show :: AttributeDescription -> String
$cshowList :: [AttributeDescription] -> ShowS
showList :: [AttributeDescription] -> ShowS
Show, AttributeDescription -> AttributeDescription -> Bool
(AttributeDescription -> AttributeDescription -> Bool)
-> (AttributeDescription -> AttributeDescription -> Bool)
-> Eq AttributeDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttributeDescription -> AttributeDescription -> Bool
== :: AttributeDescription -> AttributeDescription -> Bool
$c/= :: AttributeDescription -> AttributeDescription -> Bool
/= :: AttributeDescription -> AttributeDescription -> Bool
Eq)

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

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

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

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

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

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

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

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