Refactoring.

This commit is contained in:
Matvey Aksenov 2017-02-27 21:19:29 +00:00
parent f2d0a73aa8
commit b92564e783
3 changed files with 21 additions and 12 deletions

View File

@ -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
])
{- |

View File

@ -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)

View File

@ -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"