diff --git a/example/login.hs b/example/login.hs index 7cbdf29..de25c11 100644 --- a/example/login.hs +++ b/example/login.hs @@ -60,7 +60,7 @@ login conf = fix $ \loop -> do uid <- prompt "Username: " us <- Ldap.search l (base conf) - (scope WholeSubtree <> typesOnly True) + (typesOnly True) (And [ Attr "objectClass" := "Person" , Attr "uid" := Text.encodeUtf8 uid ]) diff --git a/src/Ldap/Asn1/Type.hs b/src/Ldap/Asn1/Type.hs index beecafe..b8f954e 100644 --- a/src/Ldap/Asn1/Type.hs +++ b/src/Ldap/Asn1/Type.hs @@ -47,45 +47,51 @@ data ProtocolServerOp = | IntermediateResponse !(Maybe LdapOid) !(Maybe ByteString) deriving (Show, Eq) +-- | Not really a choice until SASL is supported. newtype AuthenticationChoice = Simple ByteString deriving (Show, Eq) +-- | Scope of the search to be performed. data Scope = - BaseObject - | SingleLevel - | WholeSubtree + 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 (Show, 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 - | DerefInSearching - | DerefFindingBaseObject - | DerefAlways + 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 (Show, Eq) +-- | Conditions that must be fulfilled in order for the Search to match a given entry. data Filter = - And (NonEmpty Filter) - | Or (NonEmpty Filter) - | Not Filter - | EqualityMatch AttributeValueAssertion - | Substrings SubstringFilter - | GreaterOrEqual AttributeValueAssertion - | LessOrEqual AttributeValueAssertion - | Present AttributeDescription - | ApproxMatch AttributeValueAssertion + 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 (Show, Eq) -data SubstringFilter = SubstringFilter AttributeDescription (NonEmpty Substring) +data SubstringFilter = SubstringFilter !AttributeDescription !(NonEmpty Substring) deriving (Show, Eq) data Substring = - Initial AssertionValue - | Any AssertionValue - | Final AssertionValue + Initial !AssertionValue + | Any !AssertionValue + | Final !AssertionValue deriving (Show, Eq) -data MatchingRuleAssertion = MatchingRuleAssertion (Maybe MatchingRuleId) (Maybe AttributeDescription) AssertionValue Bool +data MatchingRuleAssertion = MatchingRuleAssertion !(Maybe MatchingRuleId) !(Maybe AttributeDescription) !AssertionValue !Bool deriving (Show, Eq) -- | Matching rules are defined in Section 4.1.3 of [RFC4512]. A matching @@ -107,12 +113,13 @@ newtype PartialAttributeList = PartialAttributeList [PartialAttribute] newtype Controls = Controls [Control] deriving (Show, Eq) -data Control = Control LdapOid Bool (Maybe ByteString) +data Control = Control !LdapOid !Bool !(Maybe ByteString) deriving (Show, Eq) -data LdapResult = LdapResult ResultCode LdapDn LdapString (Maybe ReferralUris) +data LdapResult = LdapResult !ResultCode !LdapDn !LdapString !(Maybe ReferralUris) deriving (Show, Eq) +-- | LDAP operation's result. data ResultCode = Success | OperationError @@ -161,16 +168,16 @@ newtype AttributeDescription = AttributeDescription LdapString newtype AttributeValue = AttributeValue ByteString deriving (Show, Eq) -data AttributeValueAssertion = AttributeValueAssertion AttributeDescription AssertionValue +data AttributeValueAssertion = AttributeValueAssertion !AttributeDescription !AssertionValue deriving (Show, Eq) newtype AssertionValue = AssertionValue ByteString deriving (Show, Eq) -data Attribute = Attribute AttributeDescription (NonEmpty AttributeValue) +data Attribute = Attribute !AttributeDescription !(NonEmpty AttributeValue) deriving (Show, Eq) -data PartialAttribute = PartialAttribute AttributeDescription [AttributeValue] +data PartialAttribute = PartialAttribute !AttributeDescription ![AttributeValue] deriving (Show, Eq) diff --git a/src/Ldap/Client.hs b/src/Ldap/Client.hs index 06796db..9c03ad8 100644 --- a/src/Ldap/Client.hs +++ b/src/Ldap/Client.hs @@ -2,6 +2,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} +-- | Pure Haskell LDAP client library. module Ldap.Client ( Host(..) , Ldap @@ -11,6 +12,7 @@ module Ldap.Client , Async , with -- * Bind + , Password(..) , bind -- * Search , search @@ -18,11 +20,12 @@ module Ldap.Client -- ** Search modifiers , Search , Mod - , scope , Type.Scope(..) + , scope , size , time , typesOnly + , Type.DerefAliases(..) , derefAliases , Filter(..) -- * Modify @@ -33,21 +36,20 @@ module Ldap.Client -- * Delete , delete -- * ModifyDn + , RelativeDn(..) , modifyDn -- * Compare , compare -- * Extended + , Oid(..) , extended -- * Waiting for completion , wait -- * Miscellanous , Dn(..) - , RelativeDn(..) - , Oid(..) - , Password(..) - , AttrList , Attr(..) , AttrValue + , AttrList -- * Re-exports , NonEmpty , PortNumber @@ -74,6 +76,9 @@ import qualified Data.Map.Strict as Map import Data.Monoid (Endo(appEndo)) import Data.String (fromString) import Data.Text (Text) +#if __GLASGOW_HASKELL__ < 710 +import Data.Traversable (traverse) +#endif import Data.Typeable (Typeable) import Network.Connection (Connection) import qualified Network.Connection as Conn @@ -84,7 +89,7 @@ import Ldap.Asn1.ToAsn1 (ToAsn1(toAsn1)) import Ldap.Asn1.FromAsn1 (FromAsn1, parseAsn1) import qualified Ldap.Asn1.Type as Type import Ldap.Client.Internal -import Ldap.Client.Bind (bind) +import Ldap.Client.Bind (Password(..), bind) import Ldap.Client.Search ( search , Search @@ -97,11 +102,11 @@ import Ldap.Client.Search , Filter(..) , SearchEntry(..) ) -import Ldap.Client.Modify (Operation(..), modify, modifyDn) +import Ldap.Client.Modify (Operation(..), modify, RelativeDn(..), modifyDn) import Ldap.Client.Add (add) import Ldap.Client.Delete (delete) import Ldap.Client.Compare (compare) -import Ldap.Client.Extended (extended) +import Ldap.Client.Extended (Oid(..), extended) {-# ANN module "HLint: ignore Use first" #-} @@ -110,11 +115,12 @@ newLdap :: IO Ldap newLdap = Ldap <$> newTQueueIO +-- | Various failures that can happen when working with LDAP. data LdapError = - IOError IOError - | ParseError Asn1.ASN1Error - | ResponseError ResponseError - | DisconnectError Disconnect + IOError IOError -- ^ Network failure. + | ParseError Asn1.ASN1Error -- ^ Invalid ASN.1 data received from the server. + | ResponseError ResponseError -- ^ An LDAP operation failed. + | DisconnectError Disconnect -- ^ Notice of Disconnection has been received. deriving (Show, Eq) newtype WrappedIOError = WrappedIOError IOError @@ -128,6 +134,8 @@ data Disconnect = Disconnect Type.ResultCode Dn Text instance Exception Disconnect -- | The entrypoint into LDAP. +-- +-- It catches all LDAP-related exceptions. with :: Host -> PortNumber -> (Ldap -> IO a) -> IO (Either LdapError a) with host port f = do context <- Conn.initConnectionContext @@ -135,11 +143,13 @@ with host port f = do bracket newLdap unbindAsync (\l -> do inq <- newTQueueIO outq <- newTQueueIO - Async.withAsync (input inq conn) $ \i -> - Async.withAsync (output outq conn) $ \o -> - Async.withAsync (dispatch l inq outq) $ \d -> - Async.withAsync (f l) $ \u -> - fmap (Right . snd) (Async.waitAnyCancel [i, o, d, u]))) + as <- traverse Async.async + [ input inq conn + , output outq conn + , dispatch l inq outq + , f l + ] + fmap (Right . snd) (Async.waitAnyCancel as))) `catches` [ Handler (\(WrappedIOError e) -> return (Left (IOError e))) , Handler (return . Left . ParseError) diff --git a/src/Ldap/Client/Bind.hs b/src/Ldap/Client/Bind.hs index 7f926bc..3ad766c 100644 --- a/src/Ldap/Client/Bind.hs +++ b/src/Ldap/Client/Bind.hs @@ -12,19 +12,25 @@ -- -- Of those, the first one ('bind') is probably the most useful for the typical usecase. module Ldap.Client.Bind - ( bind + ( Password(..) + , bind , bindEither , bindAsync , bindAsyncSTM ) where import Control.Monad.STM (STM, atomically) +import Data.ByteString (ByteString) import Data.List.NonEmpty (NonEmpty((:|))) import qualified Ldap.Asn1.Type as Type import Ldap.Client.Internal +-- | User's password. +newtype Password = Password ByteString + deriving (Show, Eq) + -- | Perform the Bind operation synchronously. Raises 'ResponseError' on failures. bind :: Ldap -> Dn -> Password -> IO () bind l username password = diff --git a/src/Ldap/Client/Extended.hs b/src/Ldap/Client/Extended.hs index e1a0d61..6ee1255 100644 --- a/src/Ldap/Client/Extended.hs +++ b/src/Ldap/Client/Extended.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} -- | operation. -- -- This operation comes in four flavours: @@ -13,10 +12,13 @@ -- -- Of those, the first one ('extended') is probably the most useful for the typical usecase. module Ldap.Client.Extended - ( extended + ( -- * Extended Operation + Oid(..) + , extended , extendedEither , extendedAsync , extendedAsyncSTM + -- ** StartTLS Operation , startTls , startTlsEither , startTlsAsync @@ -27,11 +29,17 @@ import Control.Monad ((<=<)) import Control.Monad.STM (STM, atomically) import Data.ByteString (ByteString) import Data.List.NonEmpty (NonEmpty((:|))) +import Data.String (fromString) +import Data.Text (Text) import qualified Ldap.Asn1.Type as Type import Ldap.Client.Internal +-- | Globally unique LDAP object identifier. +newtype Oid = Oid Text + deriving (Show, Eq) + -- | Perform the Extended operation synchronously. Raises 'ResponseError' on failures. extended :: Ldap -> Oid -> Maybe ByteString -> IO () extended l oid mv = @@ -62,25 +70,31 @@ extendedRequest (Oid oid) = Type.ExtendedRequest (Type.LdapOid oid) extendedResult :: Request -> Response -> Either ResponseError () -extendedResult req (Type.ExtendedResponse (Type.LdapResult code (Type.LdapDn (Type.LdapString dn)) - (Type.LdapString msg) _) _ _ :| []) +extendedResult req (Type.ExtendedResponse + (Type.LdapResult code (Type.LdapDn (Type.LdapString dn)) + (Type.LdapString msg) _) _ _ :| []) | Type.Success <- code = Right () | otherwise = Left (ResponseErrorCode req code (Dn dn) msg) extendedResult req res = Left (ResponseInvalid req res) +-- | An example of @Extended Operation@, cf. 'extended'. startTls :: Ldap -> IO () startTls = raise <=< startTlsEither +-- | An example of @Extended Operation@, cf. 'extendedEither'. startTlsEither :: Ldap -> IO (Either ResponseError ()) startTlsEither = wait <=< startTlsAsync +-- | An example of @Extended Operation@, cf. 'extendedAsync'. startTlsAsync :: Ldap -> IO (Async ()) startTlsAsync = atomically . startTlsAsyncSTM +-- | An example of @Extended Operation@, cf. 'extendedAsyncSTM'. startTlsAsyncSTM :: Ldap -> STM (Async ()) startTlsAsyncSTM l = - extendedAsyncSTM l (Oid "1.3.6.1.4.1.1466.20037") Nothing + extendedAsyncSTM l (Oid (fromString "1.3.6.1.4.1.1466.20037")) + Nothing diff --git a/src/Ldap/Client/Internal.hs b/src/Ldap/Client/Internal.hs index 8913a76..15e3a91 100644 --- a/src/Ldap/Client/Internal.hs +++ b/src/Ldap/Client/Internal.hs @@ -7,13 +7,10 @@ module Ldap.Client.Internal , ClientMessage(..) , Type.ResultCode(..) , Async - , Oid(..) , AttrList -- * Waiting for Request Completion , wait , waitSTM - , unbindAsync - , unbindAsyncSTM -- * Misc , Response , ResponseError(..) @@ -21,11 +18,12 @@ module Ldap.Client.Internal , raise , sendRequest , Dn(..) - , RelativeDn(..) - , Password(..) , Attr(..) , AttrValue , unAttr + -- * Unbind operation + , unbindAsync + , unbindAsyncSTM ) where import Control.Concurrent.STM (STM, atomically) @@ -42,12 +40,15 @@ import Network (PortNumber) import qualified Ldap.Asn1.Type as Type +-- | LDAP host. data Host = - Plain String - | Secure String - | Insecure String + Plain String -- ^ Plain LDAP. Do not use! + | Insecure String -- ^ LDAP over TLS without the certificate validity check. + -- Only use for testing! + | Secure String -- ^ LDAP over TLS. Use! deriving (Show, Eq, Ord) +-- | A token. All functions that interact with the Directory require one. data Ldap = Ldap { client :: TQueue ClientMessage } deriving (Eq) @@ -57,35 +58,33 @@ type Request = Type.ProtocolClientOp type InMessage = Type.ProtocolServerOp type Response = NonEmpty InMessage +-- | Asynchronous LDAP operation. Use 'wait' or 'waitSTM' to wait for its completion. data Async a = Async (STM (Either ResponseError a)) instance Functor Async where fmap f (Async stm) = Async (fmap (fmap f) stm) +-- | Unique identifier of an LDAP entry. newtype Dn = Dn Text deriving (Show, Eq) -newtype RelativeDn = RelativeDn Text - deriving (Show, Eq) - -newtype Oid = Oid Text - deriving (Show, Eq) - -newtype Password = Password ByteString - deriving (Show, Eq) - +-- | Response indicates a failed operation. data ResponseError = - ResponseInvalid Request Response - | ResponseErrorCode Request Type.ResultCode Dn Text + ResponseInvalid Request Response -- ^ LDAP server did not follow the protocol, so @ldap-client@ couldn't make sense of the response. + | ResponseErrorCode Request Type.ResultCode Dn Text -- ^ The response contains a result code indicating failure and an error message. deriving (Show, Eq, Typeable) instance Exception ResponseError +-- | Attribute name. newtype Attr = Attr Text deriving (Show, Eq) +-- | Attribute value. type AttrValue = ByteString +-- | List of attributes and their values. @f@ is the structure these +-- values are in, e.g. 'NonEmpty'. type AttrList f = [(Attr, f AttrValue)] -- 'Attr' unwrapper. This is a separate function not to turn 'Attr''s @@ -93,9 +92,16 @@ type AttrList f = [(Attr, f AttrValue)] unAttr :: Attr -> Text unAttr (Attr a) = a +-- | Wait for operation completion. wait :: Async a -> IO (Either ResponseError a) wait = atomically . waitSTM +-- | Wait for operation completion inside 'STM'. +-- +-- Do not use this inside the same 'STM' transaction the operation was +-- requested in! To give LDAP the chance to respond to it that transaction +-- should commit. After that, applying 'waitSTM' to the corresponding 'Async' +-- starts to make sense. waitSTM :: Async a -> STM (Either ResponseError a) waitSTM (Async stm) = stm @@ -112,7 +118,9 @@ raise :: Exception e => Either e a -> IO a raise = either throwIO return --- | Note that 'unbindAsync' does not return an 'Async', +-- | Terminate the connection to the Directory. +-- +-- Note that 'unbindAsync' does not return an 'Async', -- because LDAP server never responds to @UnbindRequest@s, hence -- a call to 'wait' on a hypothetical 'Async' would have resulted -- in an exception anyway. @@ -120,7 +128,9 @@ unbindAsync :: Ldap -> IO () unbindAsync = atomically . unbindAsyncSTM --- | Note that 'unbindAsyncSTM' does not return an 'Async', +-- | Terminate the connection to the Directory. +-- +-- Note that 'unbindAsyncSTM' does not return an 'Async', -- because LDAP server never responds to @UnbindRequest@s, hence -- a call to 'wait' on a hypothetical 'Async' would have resulted -- in an exception anyway. diff --git a/src/Ldap/Client/Modify.hs b/src/Ldap/Client/Modify.hs index ad49730..4a587dd 100644 --- a/src/Ldap/Client/Modify.hs +++ b/src/Ldap/Client/Modify.hs @@ -20,6 +20,7 @@ module Ldap.Client.Modify , modifyEither , modifyAsync , modifyAsyncSTM + , RelativeDn(..) , modifyDn , modifyDnEither , modifyDnAsync @@ -28,6 +29,7 @@ module Ldap.Client.Modify import Control.Monad.STM (STM, atomically) import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Text (Text) import qualified Ldap.Asn1.Type as Type import Ldap.Client.Internal @@ -86,6 +88,10 @@ modifyResult req (Type.ModifyResponse (Type.LdapResult code (Type.LdapDn (Type.L modifyResult req res = Left (ResponseInvalid req res) +-- | A component of 'Dn'. +newtype RelativeDn = RelativeDn Text + deriving (Show, Eq) + -- | Perform the Modify DN operation synchronously. Raises 'ResponseError' on failures. modifyDn :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO () modifyDn l dn rdn del new = diff --git a/src/Ldap/Client/Search.hs b/src/Ldap/Client/Search.hs index 37cefa8..d4d074e 100644 --- a/src/Ldap/Client/Search.hs +++ b/src/Ldap/Client/Search.hs @@ -25,6 +25,7 @@ module Ldap.Client.Search , size , time , typesOnly + , Type.DerefAliases(..) , derefAliases , Filter(..) , SearchEntry(..) @@ -148,38 +149,48 @@ searchResult req (Type.SearchResultDone (Type.LdapResult code (Type.LdapDn (Type j (Type.AttributeValue x) = x searchResult req res = Left (ResponseInvalid req res) +-- | Search options. Use 'Mod' to change some of those. data Search = Search - { _scope :: Type.Scope - , _derefAliases :: Type.DerefAliases - , _size :: Int32 - , _time :: Int32 - , _typesOnly :: Bool + { _scope :: !Type.Scope + , _derefAliases :: !Type.DerefAliases + , _size :: !Int32 + , _time :: !Int32 + , _typesOnly :: !Bool } deriving (Show, Eq) defaultSearch :: Search defaultSearch = Search - { _scope = Type.BaseObject + { _scope = Type.WholeSubtree , _size = 0 , _time = 0 , _typesOnly = False , _derefAliases = Type.NeverDerefAliases } +-- | Scope of the search (default: 'WholeSubtree'). scope :: Type.Scope -> Mod Search scope x = Mod (\y -> y { _scope = x }) +-- | Maximum number of entries to be returned as a result of the Search. +-- No limit if the value is @0@ (default: @0@). size :: Int32 -> Mod Search size x = Mod (\y -> y { _size = x }) +-- | Maximum time (in seconds) allowed for the Search. No limit if the value +-- is @0@ (default: @0@). time :: Int32 -> Mod Search time x = Mod (\y -> y { _time = x }) +-- | Whether Search results are to contain just attribute descriptions, or +-- both attribute descriptions and values (default: 'False'). typesOnly :: Bool -> Mod Search typesOnly x = Mod (\y -> y { _typesOnly = x }) +-- | Alias dereference policy (default: 'NeverDerefAliases'). derefAliases :: Type.DerefAliases -> Mod Search derefAliases x = Mod (\y -> y { _derefAliases = x }) +-- | Search modifier. Combine using 'Semigroup' and/or 'Monoid' instance. newtype Mod a = Mod (a -> a) instance Semigroup (Mod a) where @@ -189,17 +200,21 @@ instance Monoid (Mod a) where mempty = Mod id mappend = (<>) +-- | Conditions that must be fulfilled in order for the Search to match a given entry. data Filter = - Not Filter - | And (NonEmpty Filter) - | Or (NonEmpty Filter) - | Present Attr - | Attr := AttrValue - | Attr :>= AttrValue - | Attr :<= AttrValue - | Attr :~= AttrValue - | Attr :=* (Maybe AttrValue, [AttrValue], Maybe AttrValue) + Not !Filter -- ^ Filter does not match the entry + | And !(NonEmpty Filter) -- ^ All filters match the entry + | Or !(NonEmpty Filter) -- ^ Any filter matches the entry + | Present !Attr -- ^ Attribute is present in the entry + | !Attr := !AttrValue -- ^ Attribute's value is equal to the assertion + | !Attr :>= !AttrValue -- ^ Attribute's value is equal to or greater than the assertion + | !Attr :<= !AttrValue -- ^ Attribute's value is equal to or less than the assertion + | !Attr :~= !AttrValue -- ^ Attribute's value approximately matches the assertion + | !Attr :=* !(Maybe AttrValue, [AttrValue], Maybe AttrValue) + -- ^ Glob match | (Maybe Attr, Maybe Attr, Bool) ::= AttrValue + -- ^ Extensible match -data SearchEntry = SearchEntry Dn (AttrList []) +-- | Entry found during the Search. +data SearchEntry = SearchEntry !Dn !(AttrList []) deriving (Show, Eq) diff --git a/test/Ldap/Client/AddSpec.hs b/test/Ldap/Client/AddSpec.hs index 3ecbbef..7d5b3d0 100644 --- a/test/Ldap/Client/AddSpec.hs +++ b/test/Ldap/Client/AddSpec.hs @@ -2,10 +2,9 @@ module Ldap.Client.AddSpec (spec) where import qualified Data.List.NonEmpty as NonEmpty -import Data.Monoid ((<>)) import Test.Hspec -import Ldap.Client (Dn(..), Filter(..), Scope(..), Attr(..)) +import Ldap.Client (Dn(..), Filter(..), Attr(..)) import qualified Ldap.Client as Ldap import SpecHelper (locally , dns , vulpix) @@ -13,10 +12,7 @@ import SpecHelper (locally , dns , vulpix) spec :: Spec spec = do - let go l f = Ldap.search l (Dn "o=localhost") - (Ldap.scope WholeSubtree <> Ldap.typesOnly True) - f - [] + let go l f = Ldap.search l (Dn "o=localhost") (Ldap.typesOnly True) f [] it "adds an entry" $ do res <- locally $ \l -> do diff --git a/test/Ldap/Client/BindSpec.hs b/test/Ldap/Client/BindSpec.hs index d1f1328..264a490 100644 --- a/test/Ldap/Client/BindSpec.hs +++ b/test/Ldap/Client/BindSpec.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Ldap.Client.BindSpec (spec) where +#if __GLASGOW_HASKELL__ < 710 +import Data.Monoid (mempty) +#endif import Test.Hspec import qualified Ldap.Asn1.Type as Ldap.Type import Ldap.Client as Ldap @@ -32,9 +36,6 @@ spec = do res <- locally $ \l -> do Ldap.bind l (Dn "cn=admin") (Password "secret") [Ldap.SearchEntry udn _] - <- Ldap.search l (Dn "o=localhost") - (scope WholeSubtree) - (Attr "cn" := "pikachu") - [] + <- Ldap.search l (Dn "o=localhost") mempty (Attr "cn" := "pikachu") [] Ldap.bind l udn (Password "i-choose-you") res `shouldBe` Right () diff --git a/test/Ldap/Client/DeleteSpec.hs b/test/Ldap/Client/DeleteSpec.hs index 0ab9bac..1a6dc46 100644 --- a/test/Ldap/Client/DeleteSpec.hs +++ b/test/Ldap/Client/DeleteSpec.hs @@ -1,10 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Ldap.Client.DeleteSpec (spec) where -import Data.Monoid ((<>)) import Test.Hspec -import Ldap.Client (Dn(..), Filter(..), Scope(..), Attr(..)) +import Ldap.Client (Dn(..), Filter(..), Attr(..)) import qualified Ldap.Client as Ldap import qualified Ldap.Asn1.Type as Ldap.Type @@ -13,10 +12,7 @@ import SpecHelper (locally, dns, pikachu, oddish) spec :: Spec spec = do - let go l f = Ldap.search l (Dn "o=localhost") - (Ldap.scope WholeSubtree <> Ldap.typesOnly True) - f - [] + let go l f = Ldap.search l (Dn "o=localhost") (Ldap.typesOnly True) f [] it "deletes an entry" $ do res <- locally $ \l -> do diff --git a/test/Ldap/Client/ModifySpec.hs b/test/Ldap/Client/ModifySpec.hs index 1185e1c..8525641 100644 --- a/test/Ldap/Client/ModifySpec.hs +++ b/test/Ldap/Client/ModifySpec.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Ldap.Client.ModifySpec (spec) where -import Data.Monoid ((<>)) import Test.Hspec import qualified Ldap.Asn1.Type as Ldap.Type import Ldap.Client as Ldap @@ -11,10 +10,7 @@ import SpecHelper (locally, charizard, pikachu, raichu) spec :: Spec spec = do - let go l f = Ldap.search l (Dn "o=localhost") - (Ldap.scope WholeSubtree <> Ldap.typesOnly True) - f - [] + let go l f = Ldap.search l (Dn "o=localhost") (Ldap.typesOnly True) f [] context "delete" $ do it "can land ‘charizard’" $ do diff --git a/test/Ldap/Client/SearchSpec.hs b/test/Ldap/Client/SearchSpec.hs index d63f978..0ab9afb 100644 --- a/test/Ldap/Client/SearchSpec.hs +++ b/test/Ldap/Client/SearchSpec.hs @@ -2,7 +2,6 @@ module Ldap.Client.SearchSpec (spec) where import qualified Data.List.NonEmpty as NonEmpty -import Data.Monoid ((<>)) import Test.Hspec import Ldap.Client as Ldap import qualified Ldap.Asn1.Type as Ldap.Type @@ -28,10 +27,7 @@ import SpecHelper spec :: Spec spec = do - let go l f = Ldap.search l (Dn "o=localhost") - (Ldap.scope WholeSubtree <> Ldap.typesOnly True) - f - [] + let go l f = Ldap.search l (Dn "o=localhost") (Ldap.typesOnly True) f [] it "cannot search as ‘pikachu’" $ do res <- locally $ \l -> do