diff --git a/Network/XMPP/Session.hs b/Network/XMPP/Session.hs index 9da1ada..e6374cd 100644 --- a/Network/XMPP/Session.hs +++ b/Network/XMPP/Session.hs @@ -221,7 +221,7 @@ defaultState c t h s i = State { stateClientHandlers = h -- details on how they operate. connect :: MonadIO m => Session s m -> HostName -> PortNumber -> - Maybe (Maybe ([X509], Bool), ([X509] -> Bool), Maybe [String]) -> + Maybe (Maybe [X509], ([X509] -> Bool)) -> Maybe (UserName, Password, Maybe Resource) -> (ConnectResult -> StateT s m ()) -> StateT s m () @@ -229,8 +229,8 @@ connect s h p t a c = openStreams s h p connect' where connect' r = case r of OpenStreamSuccess _ _ -> case t of -- TODO: Check for TLS support? - Just (certificate, certificateValidator, paths) -> - tlsSecureStreams s certificate certificateValidator paths connect'' + Just (certificate, certificateValidator) -> + tlsSecureStreams s certificate certificateValidator connect'' Nothing -> connect'' (SecureWithTLSSuccess 1.0 "") -- TODO OpenStreamFailure -> c ConnectOpenStreamFailure connect'' r = case r of @@ -257,25 +257,29 @@ openStreams s h p c = CMS.get >>= -- Tries to secure the connection with TLS. -- -- If the list of certificates is provided, they will be presented to the --- server; the boolean value controls whether the client will show its --- certificates before the server has authed. +-- server. -- -- The third parameter is an optional custom validation function for the server -- certificates. Note that Pontarius XMPP will perform its own validation -- according to the RFC 6120, including comparing the domain name specified in -- the certificate against the connected server, as well as checking the --- integrity, the certificate authority, and CRL and\/or OCSP repositories of --- the certificate chain. The fourth parameter is a list of directories that --- contains trusted certificate authorities. +-- integrity, and the certificate authorities. +-- +-- Note: The current implementation of `certificate' looks for trusted +-- certificates in the /etc/ssl/certs directory. +-- +-- Note: The current implementation of `certificate' does not support parsing +-- X509 extensions. Because of this, we will defer checking CRLs and/or OCSP +-- services as well as checking for the basicConstraints cA boolean for the +-- time-being. -tlsSecureStreams :: MonadIO m => Session s m -> Maybe ([X509], Bool) -> - ([X509] -> Bool) -> Maybe [String] -> - (SecureWithTLSResult -> StateT s m ()) -> StateT s m () +tlsSecureStreams :: MonadIO m => Session s m -> Maybe [X509] -> + ([X509] -> Bool) -> (SecureWithTLSResult -> StateT s m ()) -> StateT s m () -tlsSecureStreams s c a p c_ = CMS.get >>= +tlsSecureStreams s c a c_ = CMS.get >>= (\ state -> lift $ liftIO $ writeChan (sessionChannel s) - (IEC (CESecureWithTLS c a p c_))) + (IEC (CESecureWithTLS c a c_))) -- | @@ -439,7 +443,7 @@ processEvent e = get >>= \ state -> put $ state { stateShouldExit = True } return $ Just e - IEC (CESecureWithTLS certificate verifyCertificate paths callback) -> do + IEC (CESecureWithTLS certificate verifyCertificate callback) -> do -- CEB.assert (not $ isTLSSecured (stateStreamState state)) (return ()) let Connected _ handle = stateConnectionState state lift $ liftIO $ send "" (Left handle) diff --git a/Network/XMPP/Types.hs b/Network/XMPP/Types.hs index 42ed090..5a397e9 100644 --- a/Network/XMPP/Types.hs +++ b/Network/XMPP/Types.hs @@ -393,7 +393,7 @@ data AuthenticationState = NoAuthentication | AuthenticatingPreChallenge1 String data ClientEvent s m = CEOpenStream N.HostName PortNumber (OpenStreamResult -> StateT s m ()) | - CESecureWithTLS (Maybe ([X509], Bool)) ([X509] -> Bool) (Maybe [String]) + CESecureWithTLS (Maybe [X509]) ([X509] -> Bool) (SecureWithTLSResult -> StateT s m ()) | CEAuthenticate UserName Password (Maybe Resource) (AuthenticateResult -> StateT s m ()) | @@ -404,7 +404,7 @@ data ClientEvent s m = CEOpenStream N.HostName PortNumber instance Show (ClientEvent s m) where show (CEOpenStream h p _) = "CEOpenStream " ++ h ++ " " ++ (show p) - show (CESecureWithTLS c _ _ _) = "CESecureWithTLS " ++ (show c) + show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ (show c) show (CEAuthenticate u p r _) = "CEAuthenticate " ++ u ++ " " ++ p ++ " " ++ (show r) show (CEIQ s _ _ _) = "CEIQ"