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

View File

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

View File

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