ldap-client 0.3.0 → 0.4.0

raw patch · 14 files changed

+252/−177 lines, 14 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +0/−13
• CHANGELOG.md +18/−0
• README.markdown +0/−44
• README.md +44/−0
• ldap-client.cabal +4/−4
• src/Ldap/Client.hs +163/−96
• src/Ldap/Client/Add.hs +1/−1
• src/Ldap/Client/Bind.hs +2/−2
• src/Ldap/Client/Compare.hs +1/−1
• src/Ldap/Client/Delete.hs +1/−1
• src/Ldap/Client/Extended.hs +2/−2
• src/Ldap/Client/Internal.hs +13/−10
• src/Ldap/Client/Modify.hs +2/−2
• src/Ldap/Client/Search.hs +1/−1

@@ -1,13 +0,0 @@-next-====--0.2.0-=====--  * Supported SASL authentication via the EXTERNAL mechanism. (https://github.com/supki/ldap-client/pull/9)--  * 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)--  * Switched the decoding of server's messages to BER (See https://tools.ietf.org/html/rfc4511#section-5.1) (https://github.com/supki/ldap-client/pull/11)

@@ -0,0 +1,18 @@+# 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)*

@@ -1,44 +0,0 @@-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)--This library implements (the parts of) [RFC 4511][rfc4511]--|           Feature            |   RFC Section   |   Support-|:---------------------------- |:---------------:|:-----------:-| Bind Operation               | [4.2][4.2]      | ✔-| Unbind Operation             | [4.3][4.3]      | ✔-| Unsolicited Notification     | [4.4][4.4]      | ✔-| Notice of Disconnection      | [4.4.1][4.4.1]  | ✔-| Search Operation             | [4.5][4.5]      | ✔\*-| Modify Operation             | [4.6][4.6]      | ✔-| Add Operation                | [4.7][4.7]      | ✔-| Delete Operation             | [4.8][4.8]      | ✔-| Modify DN Operation          | [4.9][4.9]      | ✔-| Compare Operation            | [4.10][4.10]    | ✔-| Abandon Operation            | [4.11][4.11]    | ✘-| Extended Operation           | [4.12][4.12]    | ✔-| IntermediateResponse Message | [4.13][4.13]    | ✔-| StartTLS Operation           | [4.14][4.14]    | ✔†-| LDAP over TLS                | -               | ✔--\* 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.--  [rfc4511]: https://tools.ietf.org/html/rfc4511-  [LDAP]: https://hackage.haskell.org/package/LDAP-  [4.2]: https://tools.ietf.org/html/rfc4511#section-4.2-  [4.3]: https://tools.ietf.org/html/rfc4511#section-4.3-  [4.4]: https://tools.ietf.org/html/rfc4511#section-4.4-  [4.4.1]: https://tools.ietf.org/html/rfc4511#section-4.4.1-  [4.5]: https://tools.ietf.org/html/rfc4511#section-4.5-  [4.6]: https://tools.ietf.org/html/rfc4511#section-4.6-  [4.7]: https://tools.ietf.org/html/rfc4511#section-4.7-  [4.8]: https://tools.ietf.org/html/rfc4511#section-4.8-  [4.9]: https://tools.ietf.org/html/rfc4511#section-4.9-  [4.10]: https://tools.ietf.org/html/rfc4511#section-4.10-  [4.11]: https://tools.ietf.org/html/rfc4511#section-4.11-  [4.12]: https://tools.ietf.org/html/rfc4511#section-4.12-  [4.13]: https://tools.ietf.org/html/rfc4511#section-4.13-  [4.14]: https://tools.ietf.org/html/rfc4511#section-4.14

@@ -0,0 +1,44 @@+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)++This library implements (the parts of) [RFC 4511][rfc4511]++|           Feature            |   RFC Section   |   Support+|:---------------------------- |:---------------:|:-----------:+| Bind Operation               | [4.2][4.2]      | ✔+| Unbind Operation             | [4.3][4.3]      | ✔+| Unsolicited Notification     | [4.4][4.4]      | ✔+| Notice of Disconnection      | [4.4.1][4.4.1]  | ✔+| Search Operation             | [4.5][4.5]      | ✔\*+| Modify Operation             | [4.6][4.6]      | ✔+| Add Operation                | [4.7][4.7]      | ✔+| Delete Operation             | [4.8][4.8]      | ✔+| Modify DN Operation          | [4.9][4.9]      | ✔+| Compare Operation            | [4.10][4.10]    | ✔+| Abandon Operation            | [4.11][4.11]    | ✘+| Extended Operation           | [4.12][4.12]    | ✔+| IntermediateResponse Message | [4.13][4.13]    | ✔+| StartTLS Operation           | [4.14][4.14]    | ✔†+| LDAP over TLS                | -               | ✔++\* 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.++  [rfc4511]: https://tools.ietf.org/html/rfc4511+  [LDAP]: https://hackage.haskell.org/package/LDAP+  [4.2]: https://tools.ietf.org/html/rfc4511#section-4.2+  [4.3]: https://tools.ietf.org/html/rfc4511#section-4.3+  [4.4]: https://tools.ietf.org/html/rfc4511#section-4.4+  [4.4.1]: https://tools.ietf.org/html/rfc4511#section-4.4.1+  [4.5]: https://tools.ietf.org/html/rfc4511#section-4.5+  [4.6]: https://tools.ietf.org/html/rfc4511#section-4.6+  [4.7]: https://tools.ietf.org/html/rfc4511#section-4.7+  [4.8]: https://tools.ietf.org/html/rfc4511#section-4.8+  [4.9]: https://tools.ietf.org/html/rfc4511#section-4.9+  [4.10]: https://tools.ietf.org/html/rfc4511#section-4.10+  [4.11]: https://tools.ietf.org/html/rfc4511#section-4.11+  [4.12]: https://tools.ietf.org/html/rfc4511#section-4.12+  [4.13]: https://tools.ietf.org/html/rfc4511#section-4.13+  [4.14]: https://tools.ietf.org/html/rfc4511#section-4.14

@@ -1,5 +1,5 @@ name:                ldap-client-version:             0.3.0+version:             0.4.0 synopsis:            Pure Haskell LDAP Client Library description:   Pure Haskell LDAP client library implementing (the parts of) RFC 4511.@@ -18,13 +18,13 @@   , GHC == 8.4.4   , GHC == 8.6.5 extra-source-files:-  README.markdown-  CHANGELOG.markdown+  README.md+  CHANGELOG.md  source-repository head   type:     git   location: git@github.com:alasconnect/ldap-client-  tag:      0.3.0+  tag:      0.4.0  library   ghc-options:

@@ -2,6 +2,8 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | This module is intended to be imported qualified -- -- @@@ -9,11 +11,17 @@ -- @ module Ldap.Client   ( with+  , with'+  , runsIn+  , runsInEither+  , open+  , close   , Host(..)   , defaultTlsSettings   , insecureTlsSettings   , PortNumber   , Ldap+  , LdapH   , LdapError(..)   , ResponseError(..)   , Type.ResultCode(..)@@ -66,8 +74,9 @@ import           Control.Concurrent.STM (atomically, throwSTM) import           Control.Concurrent.STM.TMVar (putTMVar) import           Control.Concurrent.STM.TQueue (TQueue, newTQueueIO, writeTQueue, readTQueue)-import           Control.Exception (Exception, Handler(..), bracket, throwIO, catch, catches)+import           Control.Exception (Exception, bracket, throwIO, SomeException, fromException, throw, Handler(..)) import           Control.Monad (forever)+import           Data.Void (Void) import qualified Data.ASN1.BinaryEncoding as Asn1 import qualified Data.ASN1.Encoding as Asn1 import qualified Data.ASN1.Error as Asn1@@ -114,50 +123,99 @@ {-# ANN module ("HLint: ignore Use first" :: String) #-}  -newLdap :: IO Ldap-newLdap = Ldap-  <$> newTQueueIO- -- | Various failures that can happen when working with LDAP.-data LdapError =-    IOError !IOError             -- ^ Network failure.+data LdapError+  = 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-    deriving (Show, Eq, Typeable)--instance Exception WrappedIOError+instance Exception LdapError  data Disconnect = Disconnect !Type.ResultCode !Dn !Text     deriving (Show, Eq, Typeable)  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.------ It catches all LDAP-related exceptions.+with' :: Host -> PortNumber -> (Ldap -> IO a) -> IO a+with' host port act = bracket (open host port) close (runsIn act)+ with :: Host -> PortNumber -> (Ldap -> IO a) -> IO (Either LdapError a)-with host port f = do+with host port act = bracket (open host port) close (runsInEither act)++-- | 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-  bracket (Conn.connectTo context params) Conn.connectionClose (\conn ->-    bracket newLdap unbindAsync (\l -> do-      inq  <- newTQueueIO-      outq <- newTQueueIO-      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)-  , Handler (return . Left . ResponseError)-  ]+  conn <- Conn.connectTo context params+  reqQ <- newTQueueIO+  inQ  <- newTQueueIO+  outQ <- newTQueueIO++  -- The input worker that reads data off the network.+  (inW :: Async.Async Void)   <- Async.async (input inQ conn)++  -- The output worker that sends data onto the network.+  (outW :: Async.Async Void)  <- Async.async (output outQ conn)++  -- The dispatch worker that sends data between the three queues.+  (dispW :: Async.Async Void) <- Async.async (dispatch reqQ inQ outQ)++  -- We use this to propagate exceptions between the workers. The `workers` Async is just a tool to+  -- 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   params = Conn.ConnectionParams     { Conn.connectionHostname =@@ -172,6 +230,14 @@     , 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@@ -186,84 +252,85 @@   , Conn.settingUseServerName = False   } +-- | Reads Asn1 BER encoded chunks off a connection into a TQueue. input :: FromAsn1 a => TQueue a -> Connection -> IO b-input inq conn = wrap . flip fix [] $ \loop chunks -> do-  chunk <- Conn.connectionGet conn 8192-  case ByteString.length chunk of-    0 -> throwIO (IO.mkIOError IO.eofErrorType "Ldap.Client.input" Nothing Nothing)-    _ -> do-      let chunks' = chunk : chunks-      case Asn1.decodeASN1 Asn1.BER (ByteString.Lazy.fromChunks (reverse chunks')) of-        Left  Asn1.ParsingPartial-                   -> loop chunks'-        Left  e    -> throwIO e-        Right asn1 -> do-          flip fix asn1 $ \loop' asn1' ->-            case parseAsn1 asn1' of-              Nothing -> return ()-              Just (asn1'', a) -> do-                atomically (writeTQueue inq a)-                loop' asn1''-          loop []+input inq conn = loop []+  where+    loop chunks = do+      chunk <- Conn.connectionGet conn 8192+      case ByteString.length chunk of+        0 -> throwIO (IO.mkIOError IO.eofErrorType "Ldap.Client.input" Nothing Nothing)+        _ -> do+          let chunks' = chunk : chunks+          case Asn1.decodeASN1 Asn1.BER (ByteString.Lazy.fromChunks (reverse chunks')) of+            Left  Asn1.ParsingPartial+                      -> loop chunks'+            Left  e    -> throwIO e+            Right asn1 -> do+              flip fix asn1 $ \loop' asn1' ->+                case parseAsn1 asn1' of+                  Nothing -> return ()+                  Just (asn1'', a) -> do+                    atomically (writeTQueue inq a)+                    loop' asn1''+              loop [] +-- | Transmits Asn1 DER encoded data from a TQueue into a Connection. output :: ToAsn1 a => TQueue a -> Connection -> IO b-output out conn = wrap . forever $ do+output out conn = forever $ do   msg <- atomically (readTQueue out)   Conn.connectionPut conn (encode (toAsn1 msg))  where   encode x = Asn1.encodeASN1' Asn1.DER (appEndo x [])  dispatch-  :: Ldap+  :: TQueue ClientMessage   -> TQueue (Type.LdapMessage Type.ProtocolServerOp)   -> TQueue (Type.LdapMessage Request)   -> IO a-dispatch Ldap { client } inq outq =-  flip fix (Map.empty, 1) $ \loop (!req, !counter) ->-    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)+dispatch reqq inq outq = loop (Map.empty, 1)+  where+    saveUp mid op res = return (Map.adjust (\(stack, var) -> (op : stack, var)) mid res) -  done mid op req =-    case Map.lookup mid req of-      Nothing -> return req-      Just (stack, var) -> do-        putTMVar var (op :| stack)-        return (Map.delete mid req)+    loop (!req, !counter) =+      loop =<< atomically (asum+        [ do New new var <- readTQueue reqq+             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)+        ]) -  probablyDisconnect (Type.Id 0)-                     (Type.ExtendedResponse-                       (Type.LdapResult code-                                        (Type.LdapDn (Type.LdapString dn))-                                        (Type.LdapString reason)-                                        _)-                       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+    done mid op req =+      case Map.lookup mid req of+        Nothing -> return req+        Just (stack, var) -> do+          putTMVar var (op :| stack)+          return (Map.delete mid req) -wrap :: IO a -> IO a-wrap m = m `catch` (throwIO . WrappedIOError)+    probablyDisconnect (Type.Id 0)+                      (Type.ExtendedResponse+                        (Type.LdapResult code+                                          (Type.LdapDn (Type.LdapString dn))+                                          (Type.LdapString reason)+                                          _)+                        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

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

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

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

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

@@ -54,7 +54,7 @@ -- | Perform the Extended operation synchronously. Raises 'ResponseError' on failures. extended :: Ldap -> Oid -> Maybe ByteString -> IO () extended l oid mv =-  raise =<< extendedEither l oid mv+  eitherToIO =<< extendedEither l oid mv  -- | Perform the Extended operation synchronously. Returns @Left e@ where -- @e@ is a 'ResponseError' on failures.@@ -92,7 +92,7 @@ -- | An example of @Extended Operation@, cf. 'extended'. startTls :: Ldap -> IO () startTls =-  raise <=< startTlsEither+  eitherToIO <=< startTlsEither  -- | An example of @Extended Operation@, cf. 'extendedEither'. startTlsEither :: Ldap -> IO (Either ResponseError ())

@@ -16,7 +16,7 @@   , Response   , ResponseError(..)   , Request-  , raise+  , eitherToIO   , sendRequest   , Dn(..)   , Attr(..)@@ -27,6 +27,7 @@   , unbindAsyncSTM   ) where +import qualified Control.Concurrent.Async as Async (Async) import           Control.Concurrent.STM (STM, atomically) import           Control.Concurrent.STM.TMVar (TMVar, newEmptyTMVar, readTMVar) import           Control.Concurrent.STM.TQueue (TQueue, writeTQueue)@@ -41,7 +42,8 @@ #else import           Network (PortNumber) #endif-import           Network.Connection (TLSSettings)+import           Network.Connection (TLSSettings, Connection)+import           Data.Void (Void)  import qualified Ldap.Asn1.Type as Type @@ -52,10 +54,12 @@   | Tls String TLSSettings -- ^ LDAP over TLS.     deriving (Show) --- | A token. All functions that interact with the Directory require one.-newtype Ldap = Ldap-  { client  :: TQueue ClientMessage-  } deriving (Eq)+-- | An LDAP connection handle+data Ldap = Ldap+  { reqQ    :: !(TQueue ClientMessage) -- ^ Request queue for client messages to be send.+  , workers :: !(Async.Async Void) -- ^ Workers group for communicating with the server.+  , conn    :: !Connection -- ^ Network connection to the server.+  }  data ClientMessage = New !Request !(TMVar (NonEmpty Type.ProtocolServerOp)) type Request = Type.ProtocolClientOp@@ -116,11 +120,10 @@      return (Async (fmap p (readTMVar var)))  writeRequest :: Ldap -> TMVar Response -> Request -> STM ()-writeRequest Ldap { client } var msg = writeTQueue client (New msg var)--raise :: Exception e => Either e a -> IO a-raise = either throwIO return+writeRequest Ldap { reqQ } var msg = writeTQueue reqQ (New msg var) +eitherToIO :: Exception e => Either e a -> IO a+eitherToIO = either throwIO pure  -- | Terminate the connection to the Directory. --

@@ -48,7 +48,7 @@ -- | Perform the Modify operation synchronously. Raises 'ResponseError' on failures. modify :: Ldap -> Dn -> [Operation] -> IO () modify l dn as =-  raise =<< modifyEither l dn as+  eitherToIO =<< modifyEither l dn as  -- | Perform the Modify operation synchronously. Returns @Left e@ where -- @e@ is a 'ResponseError' on failures.@@ -98,7 +98,7 @@ -- | Perform the Modify DN operation synchronously. Raises 'ResponseError' on failures. modifyDn :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO () modifyDn l dn rdn del new =-  raise =<< modifyDnEither l dn rdn del new+  eitherToIO =<< modifyDnEither l dn rdn del new  -- | Perform the Modify DN operation synchronously. Returns @Left e@ where -- @e@ is a 'ResponseError' on failures.

@@ -52,7 +52,7 @@ -- | Perform the Search operation synchronously. Raises 'ResponseError' on failures. search :: Ldap -> Dn -> Mod Search -> Filter -> [Attr] -> IO [SearchEntry] search l base opts flt attributes =-  raise =<< searchEither l base opts flt attributes+  eitherToIO =<< searchEither l base opts flt attributes  -- | Perform the Search operation synchronously. Returns @Left e@ where -- @e@ is a 'ResponseError' on failures.