From e9ff0c17c3b777a0796d6fc85eee7a1ee7c1d15f Mon Sep 17 00:00:00 2001 From: Matvey Aksenov Date: Sat, 4 Apr 2015 07:57:16 +0000 Subject: [PATCH] Haddock markup fixes --- src/Ldap/Asn1/FromAsn1.hs | 40 ++++++++++++++++- src/Ldap/Asn1/ToAsn1.hs | 90 +++++++++++++++++++++++++++++++++------ src/Ldap/Client.hs | 43 ++++++++++--------- src/Ldap/Client/Bind.hs | 2 - src/Ldap/Client/Search.hs | 1 + 5 files changed, 142 insertions(+), 34 deletions(-) diff --git a/src/Ldap/Asn1/FromAsn1.hs b/src/Ldap/Asn1/FromAsn1.hs index 65a69d6..5a3637a 100644 --- a/src/Ldap/Asn1/FromAsn1.hs +++ b/src/Ldap/Asn1/FromAsn1.hs @@ -29,6 +29,7 @@ class FromAsn1 a where fromAsn1 :: Parser [ASN1] a {- | +@ LDAPMessage ::= SEQUENCE { messageID MessageID, protocolOp CHOICE { @@ -43,6 +44,7 @@ LDAPMessage ::= SEQUENCE { addResponse AddResponse, ... }, controls [0] Controls OPTIONAL } +@ -} instance FromAsn1 op => FromAsn1 (LdapMessage op) where fromAsn1 = do @@ -53,7 +55,9 @@ instance FromAsn1 op => FromAsn1 (LdapMessage op) where return (LdapMessage i op Nothing) {- | +@ MessageID ::= INTEGER (0 .. maxInt) +@ -} instance FromAsn1 Id where fromAsn1 = do @@ -61,7 +65,9 @@ instance FromAsn1 Id where return (Id (fromIntegral i)) {- | +@ LDAPString ::= OCTET STRING -- UTF-8 encoded, +@ -} instance FromAsn1 LdapString where fromAsn1 = do @@ -71,7 +77,9 @@ instance FromAsn1 LdapString where Left _ -> empty {- | -LDAPOID ::= OCTET STRING -- Constrained to +@ +LDAPOID ::= OCTET STRING -- Constrained to \ +@ -} instance FromAsn1 LdapOid where fromAsn1 = do @@ -79,19 +87,25 @@ instance FromAsn1 LdapOid where return (LdapOid s) {- | +@ LDAPDN ::= LDAPString +@ -} instance FromAsn1 LdapDn where fromAsn1 = fmap LdapDn fromAsn1 {- | +@ AttributeDescription ::= LDAPString +@ -} instance FromAsn1 AttributeDescription where fromAsn1 = fmap AttributeDescription fromAsn1 {- | +@ AttributeValue ::= OCTET STRING +@ -} instance FromAsn1 AttributeValue where fromAsn1 = do @@ -99,9 +113,11 @@ instance FromAsn1 AttributeValue where return (AttributeValue s) {- | +@ PartialAttribute ::= SEQUENCE { type AttributeDescription, vals SET OF value AttributeValue } +@ -} instance FromAsn1 PartialAttribute where fromAsn1 = do @@ -114,6 +130,7 @@ instance FromAsn1 PartialAttribute where return (PartialAttribute d vs) {- | +@ LDAPResult ::= SEQUENCE { resultCode ENUMERATED { success (0), @@ -166,6 +183,7 @@ LDAPResult ::= SEQUENCE { matchedDN LDAPDN, diagnosticMessage LDAPString, referral [3] Referral OPTIONAL } +@ -} instance FromAsn1 LdapResult where fromAsn1 = do @@ -223,7 +241,9 @@ instance FromAsn1 LdapResult where return (LdapResult resultCode matchedDn diagnosticMessage referral) {- | +@ Referral ::= SEQUENCE SIZE (1..MAX) OF uri URI +@ -} instance FromAsn1 ReferralUris where fromAsn1 = do @@ -233,29 +253,45 @@ instance FromAsn1 ReferralUris where return (ReferralUris xs) {- | +@ URI ::= LDAPString +@ -} instance FromAsn1 Uri where fromAsn1 = fmap Uri fromAsn1 {- | +@ BindResponse ::= [APPLICATION 1] SEQUENCE { COMPONENTS OF LDAPResult, serverSaslCreds [7] OCTET STRING OPTIONAL } +@ +@ SearchResultEntry ::= [APPLICATION 4] SEQUENCE { objectName LDAPDN, attributes PartialAttributeList } +@ +@ SearchResultDone ::= [APPLICATION 5] LDAPResult +@ +@ ModifyResponse ::= [APPLICATION 7] LDAPResult +@ +@ AddResponse ::= [APPLICATION 9] LDAPResult +@ +@ DelResponse ::= [APPLICATION 11] LDAPResult +@ +@ CompareResponse ::= [APPLICATION 15] LDAPResult +@ -} instance FromAsn1 ProtocolServerOp where fromAsn1 = asum @@ -289,7 +325,9 @@ instance FromAsn1 ProtocolServerOp where return res {- | +@ PartialAttributeList ::= SEQUENCE OF partialAttribute PartialAttribute +@ -} instance FromAsn1 PartialAttributeList where fromAsn1 = do diff --git a/src/Ldap/Asn1/ToAsn1.hs b/src/Ldap/Asn1/ToAsn1.hs index e8c819f..0a9f670 100644 --- a/src/Ldap/Asn1/ToAsn1.hs +++ b/src/Ldap/Asn1/ToAsn1.hs @@ -1,11 +1,12 @@ module Ldap.Asn1.ToAsn1 - ( ToAsn1(..) + ( ToAsn1(toAsn1) ) where import Data.ASN1.Types (ASN1, ASN1Class, ASN1Tag, ASN1ConstructionType) import qualified Data.ASN1.Types as Asn1 import Data.ByteString (ByteString) import Data.Foldable (fold, foldMap) +import Data.List.NonEmpty (NonEmpty) import Data.Maybe (Maybe, maybe) import Data.Monoid (Endo(Endo), (<>), mempty) import qualified Data.Text.Encoding as Text @@ -18,6 +19,7 @@ class ToAsn1 a where toAsn1 :: a -> Endo [ASN1] {- | +@ LDAPMessage ::= SEQUENCE { messageID MessageID, protocolOp CHOICE { @@ -32,101 +34,130 @@ LDAPMessage ::= SEQUENCE { addResponse AddResponse, ... }, controls [0] Controls OPTIONAL } +@ -} instance ToAsn1 op => ToAsn1 (LdapMessage op) where toAsn1 (LdapMessage i op mc) = sequence (toAsn1 i <> toAsn1 op <> maybe mempty (context 0 . toAsn1) mc) {- | +@ MessageID ::= INTEGER (0 .. maxInt) +@ -} instance ToAsn1 Id where toAsn1 (Id i) = single (Asn1.IntVal (fromIntegral i)) {- | +@ LDAPString ::= OCTET STRING -- UTF-8 encoded +@ -} instance ToAsn1 LdapString where toAsn1 (LdapString s) = single (Asn1.OctetString (Text.encodeUtf8 s)) {- | -LDAPOID ::= OCTET STRING -- Constrained to +@ +LDAPOID ::= OCTET STRING -- Constrained to \ +@ -} instance ToAsn1 LdapOid where toAsn1 (LdapOid s) = single (Asn1.OctetString s) {- | -LDAPDN ::= LDAPString -- Constrained to +@ +LDAPDN ::= LDAPString -- Constrained to \ +@ -} instance ToAsn1 LdapDn where toAsn1 (LdapDn s) = toAsn1 s {- | -RelativeLDAPDN ::= LDAPString -- Constrained to +@ +RelativeLDAPDN ::= LDAPString -- Constrained to \ +@ -} instance ToAsn1 RelativeLdapDn where toAsn1 (RelativeLdapDn s) = toAsn1 s {- | +@ AttributeDescription ::= LDAPString +@ -} instance ToAsn1 AttributeDescription where toAsn1 (AttributeDescription s) = toAsn1 s {- | +@ AttributeValue ::= OCTET STRING +@ -} instance ToAsn1 AttributeValue where toAsn1 (AttributeValue s) = single (Asn1.OctetString s) {- | +@ AttributeValueAssertion ::= SEQUENCE { attributeDesc AttributeDescription, assertionValue AssertionValue } +@ -} instance ToAsn1 AttributeValueAssertion where toAsn1 (AttributeValueAssertion d v) = toAsn1 d <> toAsn1 v {- | +@ AssertionValue ::= OCTET STRING +@ -} instance ToAsn1 AssertionValue where toAsn1 (AssertionValue s) = single (Asn1.OctetString s) {- | +@ PartialAttribute ::= SEQUENCE { type AttributeDescription, vals SET OF value AttributeValue } +@ -} instance ToAsn1 PartialAttribute where - toAsn1 (PartialAttribute d xs) = sequence (toAsn1 d <> set (foldMap toAsn1 xs)) + toAsn1 (PartialAttribute d xs) = sequence (toAsn1 d <> set (toAsn1 xs)) {- | +@ Attribute ::= PartialAttribute(WITH COMPONENTS { ..., vals (SIZE(1..MAX))}) +@ -} instance ToAsn1 Attribute where - toAsn1 (Attribute d xs) = sequence (toAsn1 d <> set (foldMap toAsn1 xs)) + toAsn1 (Attribute d xs) = sequence (toAsn1 d <> set (toAsn1 xs)) {- | +@ MatchingRuleId ::= LDAPString +@ -} instance ToAsn1 MatchingRuleId where toAsn1 (MatchingRuleId s) = toAsn1 s {- | +@ Controls ::= SEQUENCE OF control Control +@ -} instance ToAsn1 Controls where - toAsn1 (Controls cs) = sequence (foldMap toAsn1 cs) + toAsn1 (Controls cs) = sequence (toAsn1 cs) {- | +@ Control ::= SEQUENCE { controlType LDAPOID, criticality BOOLEAN DEFAULT FALSE, controlValue OCTET STRING OPTIONAL } +@ -} instance ToAsn1 Control where toAsn1 (Control t c v) = @@ -137,13 +168,18 @@ instance ToAsn1 Control where ]) {- | +@ BindRequest ::= [APPLICATION 0] SEQUENCE { version INTEGER (1 .. 127), name LDAPDN, authentication AuthenticationChoice } +@ +@ UnbindRequest ::= [APPLICATION 2] NULL +@ +@ SearchRequest ::= [APPLICATION 3] SEQUENCE { baseObject LDAPDN, scope ENUMERATED { @@ -161,7 +197,9 @@ SearchRequest ::= [APPLICATION 3] SEQUENCE { typesOnly BOOLEAN, filter Filter, attributes AttributeSelection } +@ +@ ModifyRequest ::= [APPLICATION 6] SEQUENCE { object LDAPDN, changes SEQUENCE OF change SEQUENCE { @@ -171,27 +209,37 @@ ModifyRequest ::= [APPLICATION 6] SEQUENCE { 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 } - +@ -} instance ToAsn1 ProtocolClientOp where toAsn1 (BindRequest v n a) = @@ -249,20 +297,25 @@ instance ToAsn1 ProtocolClientOp where ]) {- | +@ AuthenticationChoice ::= CHOICE { simple [0] OCTET STRING, ... } +@ -} instance ToAsn1 AuthenticationChoice where toAsn1 (Simple s) = other Asn1.Context 0 s {- | +@ AttributeSelection ::= SEQUENCE OF selector LDAPString +@ -} instance ToAsn1 AttributeSelection where - toAsn1 (AttributeSelection as) = sequence (foldMap toAsn1 as) + toAsn1 (AttributeSelection as) = sequence (toAsn1 as) {- | +@ Filter ::= CHOICE { and [0] SET SIZE (1..MAX) OF filter Filter, or [1] SET SIZE (1..MAX) OF filter Filter, @@ -275,11 +328,12 @@ Filter ::= CHOICE { approxMatch [8] AttributeValueAssertion, extensibleMatch [9] MatchingRuleAssertion, ... } +@ -} instance ToAsn1 Filter where toAsn1 f = case f of - And xs -> context 0 (foldMap toAsn1 xs) - Or xs -> context 1 (foldMap toAsn1 xs) + And xs -> context 0 (toAsn1 xs) + Or xs -> context 1 (toAsn1 xs) Not x -> context 2 (toAsn1 x) EqualityMatch x -> context 3 (toAsn1 x) Substrings x -> context 4 (toAsn1 x) @@ -291,6 +345,7 @@ instance ToAsn1 Filter where ExtensibleMatch x -> context 9 (toAsn1 x) {- | +@ SubstringFilter ::= SEQUENCE { type AttributeDescription, substrings SEQUENCE SIZE (1..MAX) OF substring CHOICE { @@ -298,6 +353,7 @@ SubstringFilter ::= SEQUENCE { any [1] AssertionValue, final [2] AssertionValue } -- can occur at most once } +@ -} instance ToAsn1 SubstringFilter where toAsn1 (SubstringFilter ad ss) = @@ -307,11 +363,13 @@ instance ToAsn1 SubstringFilter where Final (AssertionValue v) -> other Asn1.Context 2 v) ss) {- | +@ MatchingRuleAssertion ::= SEQUENCE { matchingRule [1] MatchingRuleId OPTIONAL, type [2] AttributeDescription OPTIONAL, matchValue [3] AssertionValue, dnAttributes [4] BOOLEAN DEFAULT FALSE } +@ -} instance ToAsn1 MatchingRuleAssertion where toAsn1 (MatchingRuleAssertion mmr mad av b) = sequence (fold @@ -322,10 +380,18 @@ instance ToAsn1 MatchingRuleAssertion where ]) {- | +@ AttributeList ::= SEQUENCE OF attribute Attribute +@ -} instance ToAsn1 AttributeList where - toAsn1 (AttributeList xs) = sequence (foldMap toAsn1 xs) + toAsn1 (AttributeList xs) = sequence (toAsn1 xs) + +instance ToAsn1 a => ToAsn1 [a] where + toAsn1 = foldMap toAsn1 + +instance ToAsn1 a => ToAsn1 (NonEmpty a) where + toAsn1 = foldMap toAsn1 sequence :: Endo [ASN1] -> Endo [ASN1] sequence = construction Asn1.Sequence diff --git a/src/Ldap/Client.hs b/src/Ldap/Client.hs index 3df7b19..2b70537 100644 --- a/src/Ldap/Client.hs +++ b/src/Ldap/Client.hs @@ -3,21 +3,20 @@ {-# LANGUAGE NamedFieldPuns #-} module Ldap.Client ( Host(..) - , PortNumber , Ldap , LdapError(..) , ResponseError(..) , Type.ResultCode(..) , Async , with - -- * Bind Operation - , Dn(..) - , Password(..) + -- * Bind , bind - -- * Search Operation - , Attr(..) + -- * Search , search + , SearchEntry(..) + -- ** Search modifiers , Search + , Mod , scope , Type.Scope(..) , size @@ -25,26 +24,31 @@ module Ldap.Client , typesOnly , derefAliases , Filter(..) - , SearchEntry(..) - -- * Modify Operation - , Operation(..) + -- * Modify , modify - -- * Add Operation - , AttrList + , Operation(..) + -- * Add , add - -- * Delete Operation + -- * Delete , delete - -- * ModifyDn Operation - , RelativeDn(..) + -- * ModifyDn , modifyDn - -- * Compare Operation + -- * Compare , compare - -- * Extended Operation - , Oid(..) + -- * Extended , extended - -- * Waiting for Operation Completion + -- * Waiting for completion , wait - , waitSTM + -- * Miscellanous + , Dn(..) + , RelativeDn(..) + , Oid(..) + , Password(..) + , AttrList + , Attr(..) + -- * Re-exports + , NonEmpty + , PortNumber ) where #if __GLASGOW_HASKELL__ < 710 @@ -79,6 +83,7 @@ import Ldap.Client.Bind (bind, unbindAsync) import Ldap.Client.Search ( search , Search + , Mod , scope , size , time diff --git a/src/Ldap/Client/Bind.hs b/src/Ldap/Client/Bind.hs index 748b63f..933cbd7 100644 --- a/src/Ldap/Client/Bind.hs +++ b/src/Ldap/Client/Bind.hs @@ -15,8 +15,6 @@ import qualified Ldap.Asn1.Type as Type import Ldap.Client.Internal --- | Throws 'BindError' on failure. Don't worry, the nearest 'with' --- will catch it, so it won't destroy your program. bind :: Ldap -> Dn -> Password -> IO () bind l username password = raise =<< bindEither l username password diff --git a/src/Ldap/Client/Search.hs b/src/Ldap/Client/Search.hs index 4f756bb..4353cb4 100644 --- a/src/Ldap/Client/Search.hs +++ b/src/Ldap/Client/Search.hs @@ -6,6 +6,7 @@ module Ldap.Client.Search , searchAsync , searchAsyncSTM , Search + , Mod , Type.Scope(..) , scope , size