Refactoring.
This commit is contained in:
parent
f2d0a73aa8
commit
b92564e783
@ -1,3 +1,4 @@
|
|||||||
|
{-# 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
|
||||||
@ -15,7 +16,6 @@ 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 (Text.pack "EXTERNAL"))
|
[ toAsn1 (LdapString "EXTERNAL")
|
||||||
, maybe mempty (toAsn1 . LdapString) c
|
, maybe mempty (toAsn1 . LdapString) c
|
||||||
])
|
])
|
||||||
{- |
|
{- |
|
||||||
|
|||||||
@ -78,7 +78,6 @@ 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)
|
||||||
@ -110,7 +109,7 @@ 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)
|
import Ldap.Client.Extended (Oid(..), extended, noticeOfDisconnectionOid)
|
||||||
|
|
||||||
{-# ANN module ("HLint: ignore Use first" :: String) #-}
|
{-# ANN module ("HLint: ignore Use first" :: String) #-}
|
||||||
|
|
||||||
@ -262,12 +261,9 @@ dispatch Ldap { client } inq outq =
|
|||||||
req =
|
req =
|
||||||
case moid of
|
case moid of
|
||||||
Just (Type.LdapOid oid)
|
Just (Type.LdapOid oid)
|
||||||
| oid == noticeOfDisconnection -> throwSTM (Disconnect code (Dn dn) reason)
|
| Oid oid == noticeOfDisconnectionOid -> throwSTM (Disconnect code (Dn dn) reason)
|
||||||
_ -> return req
|
_ -> return req
|
||||||
probablyDisconnect mid op req = done mid op req
|
probablyDisconnect mid op req = done mid op req
|
||||||
|
|
||||||
noticeOfDisconnection :: Text
|
|
||||||
noticeOfDisconnection = fromString "1.3.6.1.4.1.1466.20036"
|
|
||||||
|
|
||||||
wrap :: IO a -> IO a
|
wrap :: IO a -> IO a
|
||||||
wrap m = m `catch` (throwIO . WrappedIOError)
|
wrap m = m `catch` (throwIO . WrappedIOError)
|
||||||
|
|||||||
@ -1,3 +1,4 @@
|
|||||||
|
{-# 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:
|
||||||
@ -18,11 +19,14 @@ 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
|
||||||
@ -32,7 +36,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 (fromString)
|
import Data.String (IsString(fromString))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
import qualified Ldap.Asn1.Type as Type
|
import qualified Ldap.Asn1.Type as Type
|
||||||
@ -43,6 +47,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 =
|
||||||
@ -99,5 +107,10 @@ 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 (Oid (fromString "1.3.6.1.4.1.1466.20037"))
|
extendedAsyncSTM l startTlsOid Nothing
|
||||||
Nothing
|
|
||||||
|
noticeOfDisconnectionOid :: Oid
|
||||||
|
noticeOfDisconnectionOid = "1.3.6.1.4.1.1466.20036"
|
||||||
|
|
||||||
|
startTlsOid :: Oid
|
||||||
|
startTlsOid = "1.3.6.1.4.1.1466.20037"
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user