ldap-client-0.2.0: Pure Haskell LDAP Client Library

Safe HaskellSafe
LanguageHaskell2010

Ldap.Asn1.Type

Synopsis

Documentation

data LdapMessage op Source #

Message envelope. (Section 4.1.1.)

Instances

Eq op => Eq (LdapMessage op) Source # 

Methods

(==) :: LdapMessage op -> LdapMessage op -> Bool #

(/=) :: LdapMessage op -> LdapMessage op -> Bool #

Show op => Show (LdapMessage op) Source # 
ToAsn1 op => ToAsn1 (LdapMessage op) Source #
LDAPMessage ::= SEQUENCE {
     messageID       MessageID,
     protocolOp      CHOICE {
          bindRequest           BindRequest,
          bindResponse          BindResponse,
          unbindRequest         UnbindRequest,
          searchRequest         SearchRequest,
          searchResEntry        SearchResultEntry,
          searchResDone         SearchResultDone,
          searchResRef          SearchResultReference,
          addRequest            AddRequest,
          addResponse           AddResponse,
          ... },
     controls       [0] Controls OPTIONAL }

Methods

toAsn1 :: LdapMessage op -> Endo [ASN1] Source #

FromAsn1 op => FromAsn1 (LdapMessage op) Source #
LDAPMessage ::= SEQUENCE {
     messageID       MessageID,
     protocolOp      CHOICE {
          bindRequest           BindRequest,
          bindResponse          BindResponse,
          unbindRequest         UnbindRequest,
          searchRequest         SearchRequest,
          searchResEntry        SearchResultEntry,
          searchResDone         SearchResultDone,
          searchResRef          SearchResultReference,
          addRequest            AddRequest,
          addResponse           AddResponse,
          ... },
     controls       [0] Controls OPTIONAL }

Methods

fromAsn1 :: Parser [ASN1] (LdapMessage op)

newtype Id Source #

Every message being processed has a unique non-zero integer ID. (Section 4.1.1.1.)

Constructors

Id 

Fields

Instances

Eq Id Source # 

Methods

(==) :: Id -> Id -> Bool #

(/=) :: Id -> Id -> Bool #

Ord Id Source # 

Methods

compare :: Id -> Id -> Ordering #

(<) :: Id -> Id -> Bool #

(<=) :: Id -> Id -> Bool #

(>) :: Id -> Id -> Bool #

(>=) :: Id -> Id -> Bool #

max :: Id -> Id -> Id #

min :: Id -> Id -> Id #

Show Id Source # 

Methods

showsPrec :: Int -> Id -> ShowS #

show :: Id -> String #

showList :: [Id] -> ShowS #

ToAsn1 Id Source #
MessageID ::= INTEGER (0 ..  maxInt)

Methods

toAsn1 :: Id -> Endo [ASN1] Source #

FromAsn1 Id Source #
MessageID ::= INTEGER (0 ..  maxInt)

Methods

fromAsn1 :: Parser [ASN1] Id

data ProtocolClientOp Source #

Client requests. The RFC doesn't make a difference between ProtocolClientOp and ProtocolServerOp but it's useful to distinguish between them in Haskell.

Instances

Eq ProtocolClientOp Source # 
Show ProtocolClientOp Source # 
ToAsn1 ProtocolClientOp Source #
BindRequest ::= [APPLICATION 0] SEQUENCE {
     version                 INTEGER (1 ..  127),
     name                    LDAPDN,
     authentication          AuthenticationChoice }
UnbindRequest ::= [APPLICATION 2] NULL
SearchRequest ::= [APPLICATION 3] SEQUENCE {
     baseObject      LDAPDN,
     scope           ENUMERATED {
          baseObject              (0),
          singleLevel             (1),
          wholeSubtree            (2),
          ...  },
     derefAliases    ENUMERATED {
          neverDerefAliases       (0),
          derefInSearching        (1),
          derefFindingBaseObj     (2),
          derefAlways             (3) },
     sizeLimit       INTEGER (0 ..  maxInt),
     timeLimit       INTEGER (0 ..  maxInt),
     typesOnly       BOOLEAN,
     filter          Filter,
     attributes      AttributeSelection }
ModifyRequest ::= [APPLICATION 6] SEQUENCE {
     object          LDAPDN,
     changes         SEQUENCE OF change SEQUENCE {
          operation       ENUMERATED {
               add     (0),
               delete  (1),
               replace (2),
               ...  },
          modification    PartialAttribute } }
AddRequest ::= [APPLICATION 8] SEQUENCE {
     entry           LDAPDN,
     attributes      AttributeList }
DelRequest ::= [APPLICATION 10] LDAPDN
ModifyDNRequest ::= [APPLICATION 12] SEQUENCE {
     entry           LDAPDN,
     newrdn          RelativeLDAPDN,
     deleteoldrdn    BOOLEAN,
     newSuperior     [0] LDAPDN OPTIONAL }
CompareRequest ::= [APPLICATION 14] SEQUENCE {
     entry           LDAPDN,
     ava             AttributeValueAssertion }
ExtendedRequest ::= [APPLICATION 23] SEQUENCE {
     requestName      [0] LDAPOID,
     requestValue     [1] OCTET STRING OPTIONAL }

data ProtocolServerOp Source #

Server responses. The RFC doesn't make a difference between ProtocolClientOp and ProtocolServerOp but it's useful to distinguish between them in Haskell.

Instances

Eq ProtocolServerOp Source # 
Show ProtocolServerOp Source # 
FromAsn1 ProtocolServerOp Source #
BindResponse ::= [APPLICATION 1] SEQUENCE {
     COMPONENTS OF LDAPResult,
     serverSaslCreds    [7] OCTET STRING OPTIONAL }
SearchResultEntry ::= [APPLICATION 4] SEQUENCE {
     objectName      LDAPDN,
     attributes      PartialAttributeList }
SearchResultReference ::= [APPLICATION 19] SEQUENCE
                          SIZE (1..MAX) OF uri URI
SearchResultDone ::= [APPLICATION 5] LDAPResult
ModifyResponse ::= [APPLICATION 7] LDAPResult
AddResponse ::= [APPLICATION 9] LDAPResult
DelResponse ::= [APPLICATION 11] LDAPResult
ModifyDNResponse ::= [APPLICATION 13] LDAPResult
CompareResponse ::= [APPLICATION 15] LDAPResult
ExtendedResponse ::= [APPLICATION 24] SEQUENCE {
     COMPONENTS OF LDAPResult,
     responseName     [10] LDAPOID OPTIONAL,
     responseValue    [11] OCTET STRING OPTIONAL }
IntermediateResponse ::= [APPLICATION 25] SEQUENCE {
     responseName     [0] LDAPOID OPTIONAL,
     responseValue    [1] OCTET STRING OPTIONAL }

Methods

fromAsn1 :: Parser [ASN1] ProtocolServerOp

data AuthenticationChoice Source #

Not really a choice until SASL is supported.

Instances

Eq AuthenticationChoice Source # 
Show AuthenticationChoice Source # 
ToAsn1 AuthenticationChoice Source #
AuthenticationChoice ::= CHOICE {
     simple                  [0] OCTET STRING,
     sasl                    [3] SaslCredentials,
     ...  }


SaslCredentials ::= SEQUENCE {
     mechanism               LDAPString,
     credentials             OCTET STRING OPTIONAL }

data SaslMechanism Source #

SASL Mechanism, for now only SASL EXTERNAL is supported

Constructors

External 

data Scope Source #

Scope of the search to be performed.

Constructors

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.

Instances

Eq Scope Source # 

Methods

(==) :: Scope -> Scope -> Bool #

(/=) :: Scope -> Scope -> Bool #

Show Scope Source # 

Methods

showsPrec :: Int -> Scope -> ShowS #

show :: Scope -> String #

showList :: [Scope] -> ShowS #

data DerefAliases Source #

An indicator as to whether or not alias entries (as defined in [RFC4512]) are to be dereferenced during stages of the Search operation.

Constructors

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.

data Filter Source #

Conditions that must be fulfilled in order for the Search to match a given entry.

Constructors

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 

Instances

Eq Filter Source # 

Methods

(==) :: Filter -> Filter -> Bool #

(/=) :: Filter -> Filter -> Bool #

Show Filter Source # 
ToAsn1 Filter Source #
Filter ::= CHOICE {
     and             [0] SET SIZE (1..MAX) OF filter Filter,
     or              [1] SET SIZE (1..MAX) OF filter Filter,
     not             [2] Filter,
     equalityMatch   [3] AttributeValueAssertion,
     substrings      [4] SubstringFilter,
     greaterOrEqual  [5] AttributeValueAssertion,
     lessOrEqual     [6] AttributeValueAssertion,
     present         [7] AttributeDescription,
     approxMatch     [8] AttributeValueAssertion,
     extensibleMatch [9] MatchingRuleAssertion,
     ...  }

Methods

toAsn1 :: Filter -> Endo [ASN1] Source #

data SubstringFilter Source #

Instances

Eq SubstringFilter Source # 
Show SubstringFilter Source # 
ToAsn1 SubstringFilter Source #
SubstringFilter ::= SEQUENCE {
     type           AttributeDescription,
     substrings     SEQUENCE SIZE (1..MAX) OF substring CHOICE {
          initial [0] AssertionValue,  -- can occur at most once
          any     [1] AssertionValue,
          final   [2] AssertionValue } -- can occur at most once
     }

data MatchingRuleAssertion Source #

Instances

Eq MatchingRuleAssertion Source # 
Show MatchingRuleAssertion Source # 
ToAsn1 MatchingRuleAssertion Source #
MatchingRuleAssertion ::= SEQUENCE {
     matchingRule    [1] MatchingRuleId OPTIONAL,
     type            [2] AttributeDescription OPTIONAL,
     matchValue      [3] AssertionValue,
     dnAttributes    [4] BOOLEAN DEFAULT FALSE }

newtype MatchingRuleId Source #

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 Controls Source #

Constructors

Controls [Control] 

Instances

Eq Controls Source # 
Show Controls Source # 
ToAsn1 Controls Source #
Controls ::= SEQUENCE OF control Control

Methods

toAsn1 :: Controls -> Endo [ASN1] Source #

data Control Source #

Constructors

Control !LdapOid !Bool !(Maybe ByteString) 

Instances

Eq Control Source # 

Methods

(==) :: Control -> Control -> Bool #

(/=) :: Control -> Control -> Bool #

Show Control Source # 
ToAsn1 Control Source #
Control ::= SEQUENCE {
     controlType             LDAPOID,
     criticality             BOOLEAN DEFAULT FALSE,
     controlValue            OCTET STRING OPTIONAL }

Methods

toAsn1 :: Control -> Endo [ASN1] Source #

data LdapResult Source #

Instances

Eq LdapResult Source # 
Show LdapResult Source # 
FromAsn1 LdapResult Source #
LDAPResult ::= SEQUENCE {
     resultCode         ENUMERATED {
          success                      (0),
          operationsError              (1),
          protocolError                (2),
          timeLimitExceeded            (3),
          sizeLimitExceeded            (4),
          compareFalse                 (5),
          compareTrue                  (6),
          authMethodNotSupported       (7),
          strongerAuthRequired         (8),
          -- 9 reserved --
          referral                     (10),
          adminLimitExceeded           (11),
          unavailableCriticalExtension (12),
          confidentialityRequired      (13),
          saslBindInProgress           (14),
          noSuchAttribute              (16),
          undefinedAttributeType       (17),
          inappropriateMatching        (18),
          constraintViolation          (19),
          attributeOrValueExists       (20),
          invalidAttributeSyntax       (21),
          -- 22-31 unused --
          noSuchObject                 (32),
          aliasProblem                 (33),
          invalidDNSyntax              (34),
          -- 35 reserved for undefined isLeaf --
          aliasDereferencingProblem    (36),
          -- 37-47 unused --
          inappropriateAuthentication  (48),
          invalidCredentials           (49),
          insufficientAccessRights     (50),
          busy                         (51),
          unavailable                  (52),
          unwillingToPerform           (53),
          loopDetect                   (54),
          -- 55-63 unused --
          namingViolation              (64),
          objectClassViolation         (65),
          notAllowedOnNonLeaf          (66),
          notAllowedOnRDN              (67),
          entryAlreadyExists           (68),
          objectClassModsProhibited    (69),
          -- 70 reserved for CLDAP --
          affectsMultipleDSAs          (71),
          -- 72-79 unused --
          other                        (80),
          ...  },
     matchedDN          LDAPDN,
     diagnosticMessage  LDAPString,
     referral           [3] Referral OPTIONAL }

Methods

fromAsn1 :: Parser [ASN1] LdapResult

data Attribute Source #

Instances

Eq Attribute Source # 
Show Attribute Source # 
ToAsn1 Attribute Source #
Attribute ::= PartialAttribute(WITH COMPONENTS {
     ...,
     vals (SIZE(1..MAX))})

Methods

toAsn1 :: Attribute -> Endo [ASN1] Source #

data PartialAttribute Source #

Instances

Eq PartialAttribute Source # 
Show PartialAttribute Source # 
ToAsn1 PartialAttribute Source #
PartialAttribute ::= SEQUENCE {
     type       AttributeDescription,
     vals       SET OF value AttributeValue }
FromAsn1 PartialAttribute Source #
PartialAttribute ::= SEQUENCE {
     type       AttributeDescription,
     vals       SET OF value AttributeValue }

Methods

fromAsn1 :: Parser [ASN1] PartialAttribute

newtype LdapDn Source #

An LDAPDN is defined to be the representation of a Distinguished Name (DN) after encoding according to the specification in [RFC4514].

Constructors

LdapDn LdapString 

Instances

Eq LdapDn Source # 

Methods

(==) :: LdapDn -> LdapDn -> Bool #

(/=) :: LdapDn -> LdapDn -> Bool #

Show LdapDn Source # 
ToAsn1 LdapDn Source #
LDAPDN ::= LDAPString -- Constrained to <distinguishedName>

Methods

toAsn1 :: LdapDn -> Endo [ASN1] Source #

FromAsn1 LdapDn Source #
LDAPDN ::= LDAPString

Methods

fromAsn1 :: Parser [ASN1] LdapDn

newtype RelativeLdapDn Source #

A RelativeLDAPDN is defined to be the representation of a Relative Distinguished Name (RDN) after encoding according to the specification in [RFC4514].

Instances

newtype ReferralUris Source #

Constructors

ReferralUris (NonEmpty Uri) 

Instances

newtype Uri Source #

Constructors

Uri LdapString 

Instances

Eq Uri Source # 

Methods

(==) :: Uri -> Uri -> Bool #

(/=) :: Uri -> Uri -> Bool #

Show Uri Source # 

Methods

showsPrec :: Int -> Uri -> ShowS #

show :: Uri -> String #

showList :: [Uri] -> ShowS #

FromAsn1 Uri Source #
URI ::= LDAPString

Methods

fromAsn1 :: Parser [ASN1] Uri

newtype LdapString Source #

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.)

Constructors

LdapString Text 

Instances

Eq LdapString Source # 
Show LdapString Source # 
ToAsn1 LdapString Source #
LDAPString ::= OCTET STRING -- UTF-8 encoded
FromAsn1 LdapString Source #
LDAPString ::= OCTET STRING -- UTF-8 encoded,

Methods

fromAsn1 :: Parser [ASN1] LdapString

newtype LdapOid Source #

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].

Constructors

LdapOid Text 

Instances

Eq LdapOid Source # 

Methods

(==) :: LdapOid -> LdapOid -> Bool #

(/=) :: LdapOid -> LdapOid -> Bool #

Show LdapOid Source # 
ToAsn1 LdapOid Source #
LDAPOID ::= OCTET STRING -- Constrained to <numericoid>

Methods

toAsn1 :: LdapOid -> Endo [ASN1] Source #

FromAsn1 LdapOid Source #
LDAPOID ::= OCTET STRING -- Constrained to <numericoid>

Methods

fromAsn1 :: Parser [ASN1] LdapOid