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.
|
||||
--
|
||||
-- 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.Maybe (maybe)
|
||||
import Data.Monoid (Endo(Endo), (<>), mempty)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Encoding as Text
|
||||
import Prelude (Integer, (.), fromIntegral)
|
||||
|
||||
@ -323,7 +323,7 @@ instance ToAsn1 AuthenticationChoice where
|
||||
toAsn1 (Simple s) = other Asn1.Context 0 s
|
||||
toAsn1 (Sasl External c) =
|
||||
context 3 (fold
|
||||
[ toAsn1 (LdapString (Text.pack "EXTERNAL"))
|
||||
[ toAsn1 (LdapString "EXTERNAL")
|
||||
, maybe mempty (toAsn1 . LdapString) c
|
||||
])
|
||||
{- |
|
||||
|
||||
@ -78,7 +78,6 @@ import Data.Function (fix)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
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)
|
||||
@ -110,7 +109,7 @@ import Ldap.Client.Modify (Operation(..), modify, RelativeDn(..), modi
|
||||
import Ldap.Client.Add (add)
|
||||
import Ldap.Client.Delete (delete)
|
||||
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) #-}
|
||||
|
||||
@ -262,12 +261,9 @@ dispatch Ldap { client } inq outq =
|
||||
req =
|
||||
case moid of
|
||||
Just (Type.LdapOid oid)
|
||||
| oid == noticeOfDisconnection -> throwSTM (Disconnect code (Dn dn) reason)
|
||||
| Oid oid == noticeOfDisconnectionOid -> throwSTM (Disconnect code (Dn dn) reason)
|
||||
_ -> return 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 m = m `catch` (throwIO . WrappedIOError)
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- | <https://tools.ietf.org/html/rfc4511#section-4.12 Extended> operation.
|
||||
--
|
||||
-- This operation comes in four flavours:
|
||||
@ -18,11 +19,14 @@ module Ldap.Client.Extended
|
||||
, extendedEither
|
||||
, extendedAsync
|
||||
, extendedAsyncSTM
|
||||
-- ** StartTLS Operation
|
||||
-- * StartTLS Operation
|
||||
, startTls
|
||||
, startTlsEither
|
||||
, startTlsAsync
|
||||
, startTlsAsyncSTM
|
||||
-- * OIDs
|
||||
, noticeOfDisconnectionOid
|
||||
, startTlsOid
|
||||
, Async
|
||||
, wait
|
||||
, waitSTM
|
||||
@ -32,7 +36,7 @@ import Control.Monad ((<=<))
|
||||
import Control.Monad.STM (STM, atomically)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import Data.String (fromString)
|
||||
import Data.String (IsString(fromString))
|
||||
import Data.Text (Text)
|
||||
|
||||
import qualified Ldap.Asn1.Type as Type
|
||||
@ -43,6 +47,10 @@ import Ldap.Client.Internal
|
||||
newtype Oid = Oid Text
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance IsString Oid where
|
||||
fromString =
|
||||
Oid . fromString
|
||||
|
||||
-- | Perform the Extended operation synchronously. Raises 'ResponseError' on failures.
|
||||
extended :: Ldap -> Oid -> Maybe ByteString -> IO ()
|
||||
extended l oid mv =
|
||||
@ -99,5 +107,10 @@ startTlsAsync =
|
||||
-- | An example of @Extended Operation@, cf. 'extendedAsyncSTM'.
|
||||
startTlsAsyncSTM :: Ldap -> STM (Async ())
|
||||
startTlsAsyncSTM l =
|
||||
extendedAsyncSTM l (Oid (fromString "1.3.6.1.4.1.1466.20037"))
|
||||
Nothing
|
||||
extendedAsyncSTM l startTlsOid 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