haskell/ldap-client
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: haskell:master
Branches Tags
haskell:master
haskell:uni2work
haskell:f/travis
haskell:old-master
haskell:feature/reproducible-tests
haskell:be-pages
haskell:gh-pages
haskell:0.4.0
haskell:0.3.0
haskell:0.2.0
haskell:0.1.0
..
compare: haskell:f/travis
Branches Tags
haskell:uni2work
haskell:master
haskell:f/travis
haskell:old-master
haskell:feature/reproducible-tests
haskell:be-pages
haskell:gh-pages
haskell:0.4.0
haskell:0.3.0
haskell:0.2.0
haskell:0.1.0

2 Commits
master ... f/travis

Author SHA1 Message Date
Matvey Aksenov
d3cfa28c22 travis please 2017-02-23 20:48:01 +00:00
Matvey Aksenov
87a9b3b26e travis please 2017-02-23 20:38:20 +00:00
22 changed files with 229 additions and 339 deletions
Show Stats Expand all files Collapse all files

9
.github_changelog_generator
View File

@ -1,9 +0,0 @@
user=alasconnect
project=ldap-client
output=CHANGELOG.md
release-branch=master
since-tag=0.2.0
header=# LDAP Client Changelog
exclude-labels=documentation

1
.gitignore vendored
View File

@ -1,5 +1,4 @@
dist/ dist/
dist-newstyle/
.cabal-sandbox/ .cabal-sandbox/
cabal.sandbox.config cabal.sandbox.config
node_modules node_modules

31
.travis.yml
View File

@ -1,20 +1,27 @@
language: haskell language: c
sudo: false sudo: false
git:
depth: 5
cache:
directories:
- "$HOME/.cabal/store"
matrix: matrix:
include: include:
- ghc: 8.0.1 - env: CABALVER=1.16 GHCVER=7.6.3
- ghc: 8.2.2 addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
- ghc: 8.4.4 - env: CABALVER=1.18 GHCVER=7.8.4
- ghc: 8.6.5 addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.3 RUN_TESTS=--run-tests
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3],sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1 RUN_TESTS=--run-tests
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1],sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head RUN_TESTS=--run-tests
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
allow_failures:
- env: CABALVER=1.16 GHCVER=7.6.3 # weird spec problems
- env: CABALVER=1.18 GHCVER=7.8.4 # weird spec problems
- env: CABALVER=head GHCVER=head RUN_TESTS=--run-tests
before_install:
- export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
install: install:
- cabal update - cabal update

6
CHANGELOG.markdown Normal file
View File

@ -0,0 +1,6 @@
next
====
* Added the `SecureWithTLSSettings` constructor to the `Host` datatype for the
cases where the user needs more control over TLS connection settings.
(https://github.com/supki/ldap-client/issues/5, https://github.com/supki/ldap-client/pull/6)

18
CHANGELOG.md
View File

@ -1,18 +0,0 @@
# LDAP Client Changelog
## [0.4.0](https://github.com/alasconnect/ldap-client/tree/0.4.0) (2019-11-07)
[Full Changelog](https://github.com/alasconnect/ldap-client/compare/0.3.0...0.4.0)
**Merged pull requests:**
- Poolable [\#1](https://github.com/alasconnect/ldap-client/pull/1) ([dminuoso](https://github.com/dminuoso))
## [0.3.0](https://github.com/alasconnect/ldap-client/tree/0.3.0) (2019-11-06)
[Full Changelog](https://github.com/alasconnect/ldap-client/compare/0.2.0...0.3.0)
\* *This Changelog was automatically generated by [github_changelog_generator](https://github.com/github-changelog-generator/github-changelog-generator)*

36
README.md → README.markdown
View File

@ -1,27 +1,27 @@
ldap-client ldap-client
=========== ===========
[![Hackage](https://budueba.com/hackage/ldap-client)](https://hackage.haskell.org/package/ldap-client) [![Hackage](https://budueba.com/hackage/ldap-client)](https://hackage.haskell.org/package/ldap-client)
[![Build Status](https://travis-ci.org/alasconnect/ldap-client.svg?branch=master)](https://travis-ci.org/alasconnect/ldap-client) [![Build Status](https://travis-ci.org/supki/ldap-client.svg?branch=master)](https://travis-ci.org/supki/ldap-client)
This library implements (the parts of) [RFC 4511][rfc4511] This library implements (the parts of) [RFC 4511][rfc4511]
| Feature | RFC Section | Support Feature | RFC Section | Support
|:---------------------------- |:---------------:|:-----------: :--------------------------- |:---------------:|:-----------:
| Bind Operation | [4.2][4.2] | ✔ Bind Operation | [4.2][4.2] | ✔
| Unbind Operation | [4.3][4.3] | ✔ Unbind Operation | [4.3][4.3] | ✔
| Unsolicited Notification | [4.4][4.4] | ✔ Unsolicited Notification | [4.4][4.4] | ✔
| Notice of Disconnection | [4.4.1][4.4.1] | ✔ Notice of Disconnection | [4.4.1][4.4.1] | ✔
| Search Operation | [4.5][4.5] | ✔\* Search Operation | [4.5][4.5] | ✔\*
| Modify Operation | [4.6][4.6] | ✔ Modify Operation | [4.6][4.6] | ✔
| Add Operation | [4.7][4.7] | ✔ Add Operation | [4.7][4.7] | ✔
| Delete Operation | [4.8][4.8] | ✔ Delete Operation | [4.8][4.8] | ✔
| Modify DN Operation | [4.9][4.9] | ✔ Modify DN Operation | [4.9][4.9] | ✔
| Compare Operation | [4.10][4.10] | ✔ Compare Operation | [4.10][4.10] | ✔
| Abandon Operation | [4.11][4.11] | ✘ Abandon Operation | [4.11][4.11] | ✘
| Extended Operation | [4.12][4.12] | ✔ Extended Operation | [4.12][4.12] | ✔
| IntermediateResponse Message | [4.13][4.13] | ✔ IntermediateResponse Message | [4.13][4.13] | ✔
| StartTLS Operation | [4.14][4.14] | ✔† StartTLS Operation | [4.14][4.14] | ✔†
| LDAP over TLS | - | ✔ LDAP over TLS | - | ✔
\* The `:dn` thing is unsupported in Extensible matches \* The `:dn` thing is unsupported in Extensible matches
† Only serves as an example of Extended Operation. It's useless for all practical purposes as it does not actually enable TLS. In other words, use LDAP over TLS instead. † Only serves as an example of Extended Operation. It's useless for all practical purposes as it does not actually enable TLS. In other words, use LDAP over TLS instead.

4
example/login.hs
View File

@ -31,7 +31,7 @@ import qualified System.IO as IO -- base
data Conf = Conf data Conf = Conf
{ host :: String { host :: String
, port :: Int , port :: PortNumber
, dn :: Dn , dn :: Dn
, password :: Password , password :: Password
, base :: Dn , base :: Dn
@ -55,7 +55,7 @@ main = do
login :: Conf -> IO (Either LdapError ()) login :: Conf -> IO (Either LdapError ())
login conf = login conf =
Ldap.with (Ldap.Tls (host conf) Ldap.defaultTlsSettings) (port conf) $ \l -> do Ldap.with (Ldap.Secure (host conf)) (port conf) $ \l -> do
Ldap.bind l (dn conf) (password conf) Ldap.bind l (dn conf) (password conf)
fix $ \loop -> do fix $ \loop -> do
uid <- prompt "Username: " uid <- prompt "Username: "

26
ldap-client.cabal
View File

@ -1,30 +1,29 @@
name: ldap-client name: ldap-client
version: 0.4.0 version: 0.1.0
synopsis: Pure Haskell LDAP Client Library synopsis: Pure Haskell LDAP Client Library
description: description:
Pure Haskell LDAP client library implementing (the parts of) RFC 4511. Pure Haskell LDAP client library implementing (the parts of) RFC 4511.
homepage: https://github.com/alasconnect/ldap-client homepage: https://supki.github.io/ldap-client
license: BSD2 license: BSD2
license-file: LICENSE license-file: LICENSE
author: Matvey Aksenov, AlasConnect LLC author: Matvey Aksenov
maintainer: matvey.aksenov@gmail.com, software@alasconnect.com maintainer: matvey.aksenov@gmail.com
copyright: 2015 Matvey Aksenov, 2019 AlasConnect LLC copyright: 2015 Matvey Aksenov
category: Network category: Network
build-type: Simple build-type: Simple
cabal-version: >= 1.10 cabal-version: >= 1.10
tested-with: tested-with:
GHC == 8.0.1 GHC == 7.6.3
, GHC == 8.2.2 , GHC == 7.8.4
, GHC == 8.4.4 , GHC == 7.10.1
, GHC == 8.6.5
extra-source-files: extra-source-files:
README.md README.markdown
CHANGELOG.md CHANGELOG.markdown
source-repository head source-repository head
type: git type: git
location: git@github.com:alasconnect/ldap-client location: git@github.com:supki/ldap-client
tag: 0.4.0 tag: 0.1.0
library library
ghc-options: ghc-options:
@ -57,7 +56,6 @@ library
, bytestring , bytestring
, connection >= 0.2 , connection >= 0.2
, containers , containers
, fail
, network >= 2.6 , network >= 2.6
, semigroups >= 0.16 , semigroups >= 0.16
, stm , stm

2
package.nix
View File

@ -4,7 +4,7 @@
}: }:
mkDerivation { mkDerivation {
pname = "ldap-client"; pname = "ldap-client";
version = "0.4.0"; version = "0.1.0";
src = ./.; src = ./.;
buildDepends = [ buildDepends = [
asn1-encoding asn1-types async base bytestring connection asn1-encoding asn1-types async base bytestring connection

8
src/Ldap/Asn1/FromAsn1.hs
View File

@ -11,9 +11,6 @@ import Control.Applicative (Alternative(..), liftA2, optional)
import Control.Applicative (Applicative(..), Alternative(..), liftA2, optional) import Control.Applicative (Applicative(..), Alternative(..), liftA2, optional)
#endif #endif
import Control.Monad (MonadPlus(..), (>=>), guard) import Control.Monad (MonadPlus(..), (>=>), guard)
#if __GLASGOW_HASKELL__ >= 86
import Control.Monad.Fail (MonadFail, fail)
#endif
import Data.ASN1.Types (ASN1) import Data.ASN1.Types (ASN1)
import qualified Data.ASN1.Types as Asn1 import qualified Data.ASN1.Types as Asn1
import Data.Foldable (asum) import Data.Foldable (asum)
@ -419,11 +416,6 @@ instance MonadPlus (Parser s) where
Parser ma `mplus` Parser mb = Parser ma `mplus` Parser mb =
Parser (\s -> ma s `mplus` mb s) Parser (\s -> ma s `mplus` mb s)
#if __GLASGOW_HASKELL__ >= 86
instance MonadFail (Parser s) where
fail _ = mzero
#endif
parse :: Parser s a -> s -> Maybe (s, a) parse :: Parser s a -> s -> Maybe (s, a)
parse = unParser parse = unParser

4
src/Ldap/Asn1/ToAsn1.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
-- | This module contains convertions from LDAP types to ASN.1. -- | This module contains convertions from LDAP types to ASN.1.
-- --
-- Various hacks are employed because "asn1-encoding" only encodes to DER, but -- Various hacks are employed because "asn1-encoding" only encodes to DER, but
@ -16,6 +15,7 @@ import Data.Foldable (fold, foldMap)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (maybe) import Data.Maybe (maybe)
import Data.Monoid (Endo(Endo), (<>), mempty) import Data.Monoid (Endo(Endo), (<>), mempty)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding as Text
import Prelude (Integer, (.), fromIntegral) import Prelude (Integer, (.), fromIntegral)
@ -323,7 +323,7 @@ instance ToAsn1 AuthenticationChoice where
toAsn1 (Simple s) = other Asn1.Context 0 s toAsn1 (Simple s) = other Asn1.Context 0 s
toAsn1 (Sasl External c) = toAsn1 (Sasl External c) =
context 3 (fold context 3 (fold
[ toAsn1 (LdapString "EXTERNAL") [ toAsn1 (LdapString (Text.pack "EXTERNAL"))
, maybe mempty (toAsn1 . LdapString) c , maybe mempty (toAsn1 . LdapString) c
]) ])
{- | {- |

24
src/Ldap/Asn1/Type.hs
View File

@ -37,7 +37,7 @@ data ProtocolServerOp =
BindResponse !LdapResult !(Maybe ByteString) BindResponse !LdapResult !(Maybe ByteString)
| SearchResultEntry !LdapDn !PartialAttributeList | SearchResultEntry !LdapDn !PartialAttributeList
| SearchResultReference !(NonEmpty Uri) | SearchResultReference !(NonEmpty Uri)
| SearchResultDone !LdapResult | SearchResultDone !(LdapResult)
| ModifyResponse !LdapResult | ModifyResponse !LdapResult
| AddResponse !LdapResult | AddResponse !LdapResult
| DeleteResponse !LdapResult | DeleteResponse !LdapResult
@ -49,7 +49,7 @@ data ProtocolServerOp =
-- | Not really a choice until SASL is supported. -- | Not really a choice until SASL is supported.
data AuthenticationChoice = data AuthenticationChoice =
Simple !ByteString Simple ByteString
| Sasl !SaslMechanism !(Maybe Text) | Sasl !SaslMechanism !(Maybe Text)
deriving (Show, Eq) deriving (Show, Eq)
@ -77,16 +77,16 @@ data DerefAliases =
-- | Conditions that must be fulfilled in order for the Search to match a given entry. -- | Conditions that must be fulfilled in order for the Search to match a given entry.
data Filter = data Filter =
And !(NonEmpty Filter) -- ^ All filters evaluate to @TRUE@ And !(NonEmpty Filter) -- ^ All filters evaluate to @TRUE@
| Or !(NonEmpty Filter) -- ^ Any filter evaluates to @TRUE@ | Or !(NonEmpty Filter) -- ^ Any filter evaluates to @TRUE@
| Not !Filter -- ^ Filter evaluates to @FALSE@ | Not Filter -- ^ Filter evaluates to @FALSE@
| EqualityMatch !AttributeValueAssertion -- ^ @EQUALITY@ rule returns @TRUE@ | EqualityMatch AttributeValueAssertion -- ^ @EQUALITY@ rule returns @TRUE@
| Substrings !SubstringFilter -- ^ @SUBSTR@ rule returns @TRUE@ | Substrings SubstringFilter -- ^ @SUBSTR@ rule returns @TRUE@
| GreaterOrEqual !AttributeValueAssertion -- ^ @ORDERING@ rule returns @FALSE@ | GreaterOrEqual AttributeValueAssertion -- ^ @ORDERING@ rule returns @FALSE@
| LessOrEqual !AttributeValueAssertion -- ^ @ORDERING@ or @EQUALITY@ rule returns @TRUE@ | LessOrEqual AttributeValueAssertion -- ^ @ORDERING@ or @EQUALITY@ rule returns @TRUE@
| Present !AttributeDescription -- ^ Attribute is present in the entry | Present AttributeDescription -- ^ Attribute is present in the entry
| ApproxMatch !AttributeValueAssertion -- ^ Same as 'EqualityMatch' for most servers | ApproxMatch AttributeValueAssertion -- ^ Same as 'EqualityMatch' for most servers
| ExtensibleMatch !MatchingRuleAssertion | ExtensibleMatch MatchingRuleAssertion
deriving (Show, Eq) deriving (Show, Eq)
data SubstringFilter = SubstringFilter !AttributeDescription !(NonEmpty Substring) data SubstringFilter = SubstringFilter !AttributeDescription !(NonEmpty Substring)

307
src/Ldap/Client.hs
View File

@ -2,8 +2,6 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | This module is intended to be imported qualified -- | This module is intended to be imported qualified
-- --
-- @ -- @
@ -11,17 +9,9 @@
-- @ -- @
module Ldap.Client module Ldap.Client
( with ( with
, with'
, runsIn
, runsInEither
, open
, close
, Host(..) , Host(..)
, defaultTlsSettings
, insecureTlsSettings
, PortNumber , PortNumber
, Ldap , Ldap
, LdapH
, LdapError(..) , LdapError(..)
, ResponseError(..) , ResponseError(..)
, Type.ResultCode(..) , Type.ResultCode(..)
@ -74,9 +64,8 @@ import qualified Control.Concurrent.Async as Async
import Control.Concurrent.STM (atomically, throwSTM) import Control.Concurrent.STM (atomically, throwSTM)
import Control.Concurrent.STM.TMVar (putTMVar) import Control.Concurrent.STM.TMVar (putTMVar)
import Control.Concurrent.STM.TQueue (TQueue, newTQueueIO, writeTQueue, readTQueue) import Control.Concurrent.STM.TQueue (TQueue, newTQueueIO, writeTQueue, readTQueue)
import Control.Exception (Exception, bracket, throwIO, SomeException, fromException, throw, Handler(..)) import Control.Exception (Exception, Handler(..), bracket, throwIO, catch, catches)
import Control.Monad (forever) import Control.Monad (forever)
import Data.Void (Void)
import qualified Data.ASN1.BinaryEncoding as Asn1 import qualified Data.ASN1.BinaryEncoding as Asn1
import qualified Data.ASN1.Encoding as Asn1 import qualified Data.ASN1.Encoding as Asn1
import qualified Data.ASN1.Error as Asn1 import qualified Data.ASN1.Error as Asn1
@ -87,6 +76,7 @@ import Data.Function (fix)
import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Monoid (Endo(appEndo)) import Data.Monoid (Endo(appEndo))
import Data.String (fromString)
import Data.Text (Text) import Data.Text (Text)
#if __GLASGOW_HASKELL__ < 710 #if __GLASGOW_HASKELL__ < 710
import Data.Traversable (traverse) import Data.Traversable (traverse)
@ -118,219 +108,162 @@ import Ldap.Client.Modify (Operation(..), modify, RelativeDn(..), modi
import Ldap.Client.Add (add) import Ldap.Client.Add (add)
import Ldap.Client.Delete (delete) import Ldap.Client.Delete (delete)
import Ldap.Client.Compare (compare) import Ldap.Client.Compare (compare)
import Ldap.Client.Extended (Oid(..), extended, noticeOfDisconnectionOid) import Ldap.Client.Extended (Oid(..), extended)
{-# ANN module ("HLint: ignore Use first" :: String) #-} {-# ANN module ("HLint: ignore Use first" :: String) #-}
newLdap :: IO Ldap
newLdap = Ldap
<$> newTQueueIO
-- | Various failures that can happen when working with LDAP. -- | Various failures that can happen when working with LDAP.
data LdapError data LdapError =
= IOError !IOError -- ^ Network failure. IOError IOError -- ^ Network failure.
| ParseError !Asn1.ASN1Error -- ^ Invalid ASN.1 data received from the server. | ParseError Asn1.ASN1Error -- ^ Invalid ASN.1 data received from the server.
| ResponseError !ResponseError -- ^ An LDAP operation failed. | ResponseError ResponseError -- ^ An LDAP operation failed.
| DisconnectError !Disconnect -- ^ Notice of Disconnection has been received. | DisconnectError Disconnect -- ^ Notice of Disconnection has been received.
deriving (Show, Eq) deriving (Show, Eq)
instance Exception LdapError newtype WrappedIOError = WrappedIOError IOError
deriving (Show, Eq, Typeable)
data Disconnect = Disconnect !Type.ResultCode !Dn !Text instance Exception WrappedIOError
data Disconnect = Disconnect Type.ResultCode Dn Text
deriving (Show, Eq, Typeable) deriving (Show, Eq, Typeable)
instance Exception Disconnect instance Exception Disconnect
newtype LdapH = LdapH Ldap
-- | Provide a 'LdapH' to a function needing an 'Ldap' handle.
runsIn :: (Ldap -> IO a)
-> LdapH
-> IO a
runsIn act (LdapH ldap) = do
actor <- Async.async (act ldap)
r <- Async.waitEitherCatch (workers ldap) actor
case r of
Left (Right _a) -> error "Unreachable"
Left (Left e) -> throwIO =<< catchesHandler workerErr e
Right (Right r') -> pure r'
Right (Left e) -> throwIO =<< catchesHandler respErr e
-- | Provide a 'LdapH' to a function needing an 'Ldap' handle
runsInEither :: (Ldap -> IO a)
-> LdapH
-> IO (Either LdapError a)
runsInEither act (LdapH ldap) = do
actor <- Async.async (act ldap)
r <- Async.waitEitherCatch (workers ldap) actor
case r of
Left (Right _a) -> error "Unreachable"
Left (Left e) -> do Left <$> catchesHandler workerErr e
Right (Right r') -> pure (Right r')
Right (Left e) -> do Left <$> catchesHandler respErr e
workerErr :: [Handler LdapError]
workerErr = [ Handler (\(ex :: IOError) -> pure (IOError ex))
, Handler (\(ex :: Asn1.ASN1Error) -> pure (ParseError ex))
, Handler (\(ex :: Disconnect) -> pure (DisconnectError ex))
]
respErr :: [Handler LdapError]
respErr = [ Handler (\(ex :: ResponseError) -> pure (ResponseError ex))
]
catchesHandler :: [Handler a] -> SomeException -> IO a
catchesHandler handlers e = foldr tryHandler (throw e) handlers
where tryHandler (Handler handler) res
= case fromException e of
Just e' -> handler e'
Nothing -> res
-- | The entrypoint into LDAP. -- | The entrypoint into LDAP.
with' :: Host -> PortNumber -> (Ldap -> IO a) -> IO a --
with' host port act = bracket (open host port) close (runsIn act) -- It catches all LDAP-related exceptions.
with :: Host -> PortNumber -> (Ldap -> IO a) -> IO (Either LdapError a) with :: Host -> PortNumber -> (Ldap -> IO a) -> IO (Either LdapError a)
with host port act = bracket (open host port) close (runsInEither act) with host port f = do
-- | Creates an LDAP handle. This action is useful for creating your own resource
-- management, such as with 'resource-pool'. The handle must be manually closed
-- with 'close'.
open :: Host -> PortNumber -> IO (LdapH)
open host port = do
context <- Conn.initConnectionContext context <- Conn.initConnectionContext
conn <- Conn.connectTo context params bracket (Conn.connectTo context params) Conn.connectionClose (\conn ->
reqQ <- newTQueueIO bracket newLdap unbindAsync (\l -> do
inQ <- newTQueueIO inq <- newTQueueIO
outQ <- newTQueueIO outq <- newTQueueIO
as <- traverse Async.async
-- The input worker that reads data off the network. [ input inq conn
(inW :: Async.Async Void) <- Async.async (input inQ conn) , output outq conn
, dispatch l inq outq
-- The output worker that sends data onto the network. , f l
(outW :: Async.Async Void) <- Async.async (output outQ conn) ]
fmap (Right . snd) (Async.waitAnyCancel as)))
-- The dispatch worker that sends data between the three queues. `catches`
(dispW :: Async.Async Void) <- Async.async (dispatch reqQ inQ outQ) [ Handler (\(WrappedIOError e) -> return (Left (IOError e)))
, Handler (return . Left . ParseError)
-- We use this to propagate exceptions between the workers. The `workers` Async is just a tool to , Handler (return . Left . ResponseError)
-- exchange exceptions between the entire worker group and another thread. ]
workers <- Async.async (snd <$> Async.waitAnyCancel [inW, outW, dispW])
pure (LdapH (Ldap reqQ workers conn))
where where
params = Conn.ConnectionParams params = Conn.ConnectionParams
{ Conn.connectionHostname = { Conn.connectionHostname =
case host of case host of
Plain h -> h Plain h -> h
Tls h _ -> h Secure h -> h
SecureWithTLSSettings h _ -> h
Insecure h -> h
, Conn.connectionPort = port , Conn.connectionPort = port
, Conn.connectionUseSecure = , Conn.connectionUseSecure =
case host of case host of
Plain _ -> Nothing Plain _ -> Nothing
Tls _ settings -> pure settings Secure _ -> Just Conn.TLSSettingsSimple
{ Conn.settingDisableCertificateValidation = False
, Conn.settingDisableSession = False
, Conn.settingUseServerName = False
}
SecureWithTLSSettings _ settings -> Just settings
Insecure _ -> Just Conn.TLSSettingsSimple
{ Conn.settingDisableCertificateValidation = True
, Conn.settingDisableSession = False
, Conn.settingUseServerName = False
}
, Conn.connectionUseSocks = Nothing , Conn.connectionUseSocks = Nothing
} }
-- | Closes an LDAP connection.
-- This is to be used in together with 'open'.
close :: LdapH -> IO ()
close (LdapH ldap) = do
unbindAsync ldap
Conn.connectionClose (conn ldap)
Async.cancel (workers ldap)
defaultTlsSettings :: Conn.TLSSettings
defaultTlsSettings = Conn.TLSSettingsSimple
{ Conn.settingDisableCertificateValidation = False
, Conn.settingDisableSession = False
, Conn.settingUseServerName = False
}
insecureTlsSettings :: Conn.TLSSettings
insecureTlsSettings = Conn.TLSSettingsSimple
{ Conn.settingDisableCertificateValidation = True
, Conn.settingDisableSession = False
, Conn.settingUseServerName = False
}
-- | Reads Asn1 BER encoded chunks off a connection into a TQueue.
input :: FromAsn1 a => TQueue a -> Connection -> IO b input :: FromAsn1 a => TQueue a -> Connection -> IO b
input inq conn = loop [] input inq conn = wrap . flip fix [] $ \loop chunks -> do
where chunk <- Conn.connectionGet conn 8192
loop chunks = do case ByteString.length chunk of
chunk <- Conn.connectionGet conn 8192 0 -> throwIO (IO.mkIOError IO.eofErrorType "Ldap.Client.input" Nothing Nothing)
case ByteString.length chunk of _ -> do
0 -> throwIO (IO.mkIOError IO.eofErrorType "Ldap.Client.input" Nothing Nothing) let chunks' = chunk : chunks
_ -> do case Asn1.decodeASN1 Asn1.DER (ByteString.Lazy.fromChunks (reverse chunks')) of
let chunks' = chunk : chunks Left Asn1.ParsingPartial
case Asn1.decodeASN1 Asn1.BER (ByteString.Lazy.fromChunks (reverse chunks')) of -> loop chunks'
Left Asn1.ParsingPartial Left e -> throwIO e
-> loop chunks' Right asn1 -> do
Left e -> throwIO e flip fix asn1 $ \loop' asn1' ->
Right asn1 -> do case parseAsn1 asn1' of
flip fix asn1 $ \loop' asn1' -> Nothing -> return ()
case parseAsn1 asn1' of Just (asn1'', a) -> do
Nothing -> return () atomically (writeTQueue inq a)
Just (asn1'', a) -> do loop' asn1''
atomically (writeTQueue inq a) loop []
loop' asn1''
loop []
-- | Transmits Asn1 DER encoded data from a TQueue into a Connection.
output :: ToAsn1 a => TQueue a -> Connection -> IO b output :: ToAsn1 a => TQueue a -> Connection -> IO b
output out conn = forever $ do output out conn = wrap . forever $ do
msg <- atomically (readTQueue out) msg <- atomically (readTQueue out)
Conn.connectionPut conn (encode (toAsn1 msg)) Conn.connectionPut conn (encode (toAsn1 msg))
where where
encode x = Asn1.encodeASN1' Asn1.DER (appEndo x []) encode x = Asn1.encodeASN1' Asn1.DER (appEndo x [])
dispatch dispatch
:: TQueue ClientMessage :: Ldap
-> TQueue (Type.LdapMessage Type.ProtocolServerOp) -> TQueue (Type.LdapMessage Type.ProtocolServerOp)
-> TQueue (Type.LdapMessage Request) -> TQueue (Type.LdapMessage Request)
-> IO a -> IO a
dispatch reqq inq outq = loop (Map.empty, 1) dispatch Ldap { client } inq outq =
where flip fix (Map.empty, 1) $ \loop (!req, !counter) ->
saveUp mid op res = return (Map.adjust (\(stack, var) -> (op : stack, var)) mid res) loop =<< atomically (asum
[ do New new var <- readTQueue client
writeTQueue outq (Type.LdapMessage (Type.Id counter) new Nothing)
return (Map.insert (Type.Id counter) ([], var) req, counter + 1)
, do Type.LdapMessage mid op _
<- readTQueue inq
res <- case op of
Type.BindResponse {} -> done mid op req
Type.SearchResultEntry {} -> saveUp mid op req
Type.SearchResultReference {} -> return req
Type.SearchResultDone {} -> done mid op req
Type.ModifyResponse {} -> done mid op req
Type.AddResponse {} -> done mid op req
Type.DeleteResponse {} -> done mid op req
Type.ModifyDnResponse {} -> done mid op req
Type.CompareResponse {} -> done mid op req
Type.ExtendedResponse {} -> probablyDisconnect mid op req
Type.IntermediateResponse {} -> saveUp mid op req
return (res, counter)
])
where
saveUp mid op res =
return (Map.adjust (\(stack, var) -> (op : stack, var)) mid res)
loop (!req, !counter) = done mid op req =
loop =<< atomically (asum case Map.lookup mid req of
[ do New new var <- readTQueue reqq Nothing -> return req
writeTQueue outq (Type.LdapMessage (Type.Id counter) new Nothing) Just (stack, var) -> do
return (Map.insert (Type.Id counter) ([], var) req, counter + 1) putTMVar var (op :| stack)
, do Type.LdapMessage mid op _ return (Map.delete mid req)
<- readTQueue inq
res <- case op of
Type.BindResponse {} -> done mid op req
Type.SearchResultEntry {} -> saveUp mid op req
Type.SearchResultReference {} -> return req
Type.SearchResultDone {} -> done mid op req
Type.ModifyResponse {} -> done mid op req
Type.AddResponse {} -> done mid op req
Type.DeleteResponse {} -> done mid op req
Type.ModifyDnResponse {} -> done mid op req
Type.CompareResponse {} -> done mid op req
Type.ExtendedResponse {} -> probablyDisconnect mid op req
Type.IntermediateResponse {} -> saveUp mid op req
return (res, counter)
])
done mid op req = probablyDisconnect (Type.Id 0)
case Map.lookup mid req of (Type.ExtendedResponse
Nothing -> return req (Type.LdapResult code
Just (stack, var) -> do (Type.LdapDn (Type.LdapString dn))
putTMVar var (op :| stack) (Type.LdapString reason)
return (Map.delete mid req) _)
moid _)
req =
case moid of
Just (Type.LdapOid oid)
| oid == noticeOfDisconnection -> throwSTM (Disconnect code (Dn dn) reason)
_ -> return req
probablyDisconnect mid op req = done mid op req
probablyDisconnect (Type.Id 0) noticeOfDisconnection :: Text
(Type.ExtendedResponse noticeOfDisconnection = fromString "1.3.6.1.4.1.1466.20036"
(Type.LdapResult code
(Type.LdapDn (Type.LdapString dn)) wrap :: IO a -> IO a
(Type.LdapString reason) wrap m = m `catch` (throwIO . WrappedIOError)
_)
moid _)
req =
case moid of
Just (Type.LdapOid oid)
| Oid oid == noticeOfDisconnectionOid -> throwSTM (Disconnect code (Dn dn) reason)
_ -> return req
probablyDisconnect mid op req = done mid op req

2
src/Ldap/Client/Add.hs
View File

@ -31,7 +31,7 @@ import Ldap.Client.Internal
-- | Perform the Add operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Add operation synchronously. Raises 'ResponseError' on failures.
add :: Ldap -> Dn -> AttrList NonEmpty -> IO () add :: Ldap -> Dn -> AttrList NonEmpty -> IO ()
add l dn as = add l dn as =
eitherToIO =<< addEither l dn as raise =<< addEither l dn as
-- | Perform the Add operation synchronously. Returns @Left e@ where -- | Perform the Add operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.

4
src/Ldap/Client/Bind.hs
View File

@ -42,7 +42,7 @@ newtype Password = Password ByteString
-- | Perform the Bind operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Bind operation synchronously. Raises 'ResponseError' on failures.
bind :: Ldap -> Dn -> Password -> IO () bind :: Ldap -> Dn -> Password -> IO ()
bind l username password = bind l username password =
eitherToIO =<< bindEither l username password raise =<< bindEither l username password
-- | Perform the Bind operation synchronously. Returns @Left e@ where -- | Perform the Bind operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.
@ -82,7 +82,7 @@ bindResult req res = Left (ResponseInvalid req res)
-- | Perform a SASL EXTERNAL Bind operation synchronously. Raises 'ResponseError' on failures. -- | Perform a SASL EXTERNAL Bind operation synchronously. Raises 'ResponseError' on failures.
externalBind :: Ldap -> Dn -> Maybe Text -> IO () externalBind :: Ldap -> Dn -> Maybe Text -> IO ()
externalBind l username mCredentials = externalBind l username mCredentials =
eitherToIO =<< externalBindEither l username mCredentials raise =<< externalBindEither l username mCredentials
-- | Perform a SASL EXTERNAL Bind operation synchronously. Returns @Left e@ where -- | Perform a SASL EXTERNAL Bind operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.

2
src/Ldap/Client/Compare.hs
View File

@ -33,7 +33,7 @@ import qualified Ldap.Asn1.Type as Type
-- | Perform the Compare operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Compare operation synchronously. Raises 'ResponseError' on failures.
compare :: Ldap -> Dn -> Attr -> AttrValue -> IO Bool compare :: Ldap -> Dn -> Attr -> AttrValue -> IO Bool
compare l dn k v = compare l dn k v =
eitherToIO =<< compareEither l dn k v raise =<< compareEither l dn k v
-- | Perform the Compare operation synchronously. Returns @Left e@ where -- | Perform the Compare operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.

2
src/Ldap/Client/Delete.hs
View File

@ -31,7 +31,7 @@ import Ldap.Client.Internal
-- | Perform the Delete operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Delete operation synchronously. Raises 'ResponseError' on failures.
delete :: Ldap -> Dn -> IO () delete :: Ldap -> Dn -> IO ()
delete l dn = delete l dn =
eitherToIO =<< deleteEither l dn raise =<< deleteEither l dn
-- | Perform the Delete operation synchronously. Returns @Left e@ where -- | Perform the Delete operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.

25
src/Ldap/Client/Extended.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
-- | <https://tools.ietf.org/html/rfc4511#section-4.12 Extended> operation. -- | <https://tools.ietf.org/html/rfc4511#section-4.12 Extended> operation.
-- --
-- This operation comes in four flavours: -- This operation comes in four flavours:
@ -19,14 +18,11 @@ module Ldap.Client.Extended
, extendedEither , extendedEither
, extendedAsync , extendedAsync
, extendedAsyncSTM , extendedAsyncSTM
-- * StartTLS Operation -- ** StartTLS Operation
, startTls , startTls
, startTlsEither , startTlsEither
, startTlsAsync , startTlsAsync
, startTlsAsyncSTM , startTlsAsyncSTM
-- * OIDs
, noticeOfDisconnectionOid
, startTlsOid
, Async , Async
, wait , wait
, waitSTM , waitSTM
@ -36,7 +32,7 @@ import Control.Monad ((<=<))
import Control.Monad.STM (STM, atomically) import Control.Monad.STM (STM, atomically)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty (NonEmpty((:|)))
import Data.String (IsString(fromString)) import Data.String (fromString)
import Data.Text (Text) import Data.Text (Text)
import qualified Ldap.Asn1.Type as Type import qualified Ldap.Asn1.Type as Type
@ -47,14 +43,10 @@ import Ldap.Client.Internal
newtype Oid = Oid Text newtype Oid = Oid Text
deriving (Show, Eq) deriving (Show, Eq)
instance IsString Oid where
fromString =
Oid . fromString
-- | Perform the Extended operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Extended operation synchronously. Raises 'ResponseError' on failures.
extended :: Ldap -> Oid -> Maybe ByteString -> IO () extended :: Ldap -> Oid -> Maybe ByteString -> IO ()
extended l oid mv = extended l oid mv =
eitherToIO =<< extendedEither l oid mv raise =<< extendedEither l oid mv
-- | Perform the Extended operation synchronously. Returns @Left e@ where -- | Perform the Extended operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.
@ -92,7 +84,7 @@ extendedResult req res = Left (ResponseInvalid req res)
-- | An example of @Extended Operation@, cf. 'extended'. -- | An example of @Extended Operation@, cf. 'extended'.
startTls :: Ldap -> IO () startTls :: Ldap -> IO ()
startTls = startTls =
eitherToIO <=< startTlsEither raise <=< startTlsEither
-- | An example of @Extended Operation@, cf. 'extendedEither'. -- | An example of @Extended Operation@, cf. 'extendedEither'.
startTlsEither :: Ldap -> IO (Either ResponseError ()) startTlsEither :: Ldap -> IO (Either ResponseError ())
@ -107,10 +99,5 @@ startTlsAsync =
-- | An example of @Extended Operation@, cf. 'extendedAsyncSTM'. -- | An example of @Extended Operation@, cf. 'extendedAsyncSTM'.
startTlsAsyncSTM :: Ldap -> STM (Async ()) startTlsAsyncSTM :: Ldap -> STM (Async ())
startTlsAsyncSTM l = startTlsAsyncSTM l =
extendedAsyncSTM l startTlsOid Nothing extendedAsyncSTM l (Oid (fromString "1.3.6.1.4.1.1466.20037"))
Nothing
noticeOfDisconnectionOid :: Oid
noticeOfDisconnectionOid = "1.3.6.1.4.1.1466.20036"
startTlsOid :: Oid
startTlsOid = "1.3.6.1.4.1.1466.20037"

41
src/Ldap/Client/Internal.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
module Ldap.Client.Internal module Ldap.Client.Internal
@ -16,7 +15,7 @@ module Ldap.Client.Internal
, Response , Response
, ResponseError(..) , ResponseError(..)
, Request , Request
, eitherToIO , raise
, sendRequest , sendRequest
, Dn(..) , Dn(..)
, Attr(..) , Attr(..)
@ -27,7 +26,6 @@ module Ldap.Client.Internal
, unbindAsyncSTM , unbindAsyncSTM
) where ) where
import qualified Control.Concurrent.Async as Async (Async)
import Control.Concurrent.STM (STM, atomically) import Control.Concurrent.STM (STM, atomically)
import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVar, readTMVar) import Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVar, readTMVar)
import Control.Concurrent.STM.TQueue (TQueue, writeTQueue) import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)
@ -37,37 +35,33 @@ import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text) import Data.Text (Text)
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
#if __GLASGOW_HASKELL__ >= 84
import Network.Socket (PortNumber)
#else
import Network (PortNumber) import Network (PortNumber)
#endif import Network.Connection (TLSSettings)
import Network.Connection (TLSSettings, Connection)
import Data.Void (Void)
import qualified Ldap.Asn1.Type as Type import qualified Ldap.Asn1.Type as Type
-- | LDAP host. -- | LDAP host.
data Host = data Host =
Plain String -- ^ Plain LDAP. Plain String -- ^ Plain LDAP.
| Tls String TLSSettings -- ^ LDAP over TLS. | Insecure String -- ^ LDAP over TLS without the certificate validity check.
| Secure String -- ^ LDAP over TLS.
| SecureWithTLSSettings String TLSSettings
-- ^ LDAP over TLS with the ability to specify detailed TLS settings.
deriving (Show) deriving (Show)
-- | An LDAP connection handle -- | A token. All functions that interact with the Directory require one.
data Ldap = Ldap data Ldap = Ldap
{ reqQ :: !(TQueue ClientMessage) -- ^ Request queue for client messages to be send. { client :: TQueue ClientMessage
, workers :: !(Async.Async Void) -- ^ Workers group for communicating with the server. } deriving (Eq)
, conn :: !Connection -- ^ Network connection to the server.
}
data ClientMessage = New !Request !(TMVar (NonEmpty Type.ProtocolServerOp)) data ClientMessage = New Request (TMVar (NonEmpty Type.ProtocolServerOp))
type Request = Type.ProtocolClientOp type Request = Type.ProtocolClientOp
type InMessage = Type.ProtocolServerOp type InMessage = Type.ProtocolServerOp
type Response = NonEmpty InMessage type Response = NonEmpty InMessage
-- | Asynchronous LDAP operation. Use 'wait' or 'waitSTM' to wait for its completion. -- | Asynchronous LDAP operation. Use 'wait' or 'waitSTM' to wait for its completion.
newtype Async a = Async (STM (Either ResponseError a)) data Async a = Async (STM (Either ResponseError a))
instance Functor Async where instance Functor Async where
fmap f (Async stm) = Async (fmap (fmap f) stm) fmap f (Async stm) = Async (fmap (fmap f) stm)
@ -78,8 +72,8 @@ newtype Dn = Dn Text
-- | Response indicates a failed operation. -- | Response indicates a failed operation.
data ResponseError = data ResponseError =
ResponseInvalid !Request !Response -- ^ LDAP server did not follow the protocol, so @ldap-client@ couldn't make sense of the response. 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. | ResponseErrorCode Request Type.ResultCode Dn Text -- ^ The response contains a result code indicating failure and an error message.
deriving (Show, Eq, Typeable) deriving (Show, Eq, Typeable)
instance Exception ResponseError instance Exception ResponseError
@ -120,10 +114,11 @@ sendRequest l p msg =
return (Async (fmap p (readTMVar var))) return (Async (fmap p (readTMVar var)))
writeRequest :: Ldap -> TMVar Response -> Request -> STM () writeRequest :: Ldap -> TMVar Response -> Request -> STM ()
writeRequest Ldap { reqQ } var msg = writeTQueue reqQ (New msg var) writeRequest Ldap { client } var msg = writeTQueue client (New msg var)
raise :: Exception e => Either e a -> IO a
raise = either throwIO return
eitherToIO :: Exception e => Either e a -> IO a
eitherToIO = either throwIO pure
-- | Terminate the connection to the Directory. -- | Terminate the connection to the Directory.
-- --

10
src/Ldap/Client/Modify.hs
View File

@ -40,15 +40,15 @@ import Ldap.Client.Internal
-- | Type of modification being performed. -- | Type of modification being performed.
data Operation = data Operation =
Delete !Attr ![AttrValue] -- ^ Delete values from the attribute. Deletes the attribute if the list is empty or all current values are listed. Delete Attr [AttrValue] -- ^ Delete values from the attribute. Deletes the attribute if the list is empty or all current values are listed.
| Add !Attr ![AttrValue] -- ^ Add values to the attribute, creating it if necessary. | Add Attr [AttrValue] -- ^ Add values to the attribute, creating it if necessary.
| Replace !Attr ![AttrValue] -- ^ Replace all existing values of the attribute with the new list. Deletes the attribute if the list is empty. | Replace Attr [AttrValue] -- ^ Replace all existing values of the attribute with the new list. Deletes the attribute if the list is empty.
deriving (Show, Eq) deriving (Show, Eq)
-- | Perform the Modify operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Modify operation synchronously. Raises 'ResponseError' on failures.
modify :: Ldap -> Dn -> [Operation] -> IO () modify :: Ldap -> Dn -> [Operation] -> IO ()
modify l dn as = modify l dn as =
eitherToIO =<< modifyEither l dn as raise =<< modifyEither l dn as
-- | Perform the Modify operation synchronously. Returns @Left e@ where -- | Perform the Modify operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.
@ -98,7 +98,7 @@ newtype RelativeDn = RelativeDn Text
-- | Perform the Modify DN operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Modify DN operation synchronously. Raises 'ResponseError' on failures.
modifyDn :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO () modifyDn :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO ()
modifyDn l dn rdn del new = modifyDn l dn rdn del new =
eitherToIO =<< modifyDnEither l dn rdn del new raise =<< modifyDnEither l dn rdn del new
-- | Perform the Modify DN operation synchronously. Returns @Left e@ where -- | Perform the Modify DN operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.

4
src/Ldap/Client/Search.hs
View File

@ -52,7 +52,7 @@ import Ldap.Client.Internal
-- | Perform the Search operation synchronously. Raises 'ResponseError' on failures. -- | Perform the Search operation synchronously. Raises 'ResponseError' on failures.
search :: Ldap -> Dn -> Mod Search -> Filter -> [Attr] -> IO [SearchEntry] search :: Ldap -> Dn -> Mod Search -> Filter -> [Attr] -> IO [SearchEntry]
search l base opts flt attributes = search l base opts flt attributes =
eitherToIO =<< searchEither l base opts flt attributes raise =<< searchEither l base opts flt attributes
-- | Perform the Search operation synchronously. Returns @Left e@ where -- | Perform the Search operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures. -- @e@ is a 'ResponseError' on failures.
@ -215,7 +215,7 @@ data Filter =
| !Attr :~= !AttrValue -- ^ Attribute's value approximately matches the assertion | !Attr :~= !AttrValue -- ^ Attribute's value approximately matches the assertion
| !Attr :=* !(Maybe AttrValue, [AttrValue], Maybe AttrValue) | !Attr :=* !(Maybe AttrValue, [AttrValue], Maybe AttrValue)
-- ^ Glob match -- ^ Glob match
| !(Maybe Attr, Maybe Attr, Bool) ::= !AttrValue | (Maybe Attr, Maybe Attr, Bool) ::= AttrValue
-- ^ Extensible match -- ^ Extensible match
-- | Entry found during the Search. -- | Entry found during the Search.

2
test/SpecHelper.hs
View File

@ -53,7 +53,7 @@ locally f =
(\_ -> Ldap.with localhost port f) (\_ -> Ldap.with localhost port f)
localhost :: Host localhost :: Host
localhost = Tls "localhost" insecureTlsSettings localhost = Insecure "localhost"
port :: Num a => a port :: Num a => a
port = 24620 port = 24620