Haskell TLS and monad-control?

[ Knowledge of DANE entirely optional, if some of the below is Greek to you, just skip the bits that are unfamiliar. ] I have the beginning of a DANE verification module for hs-tls as an alternative to Data.X509.Validation. So far it just handles the easy case of checking just the leaf certificate against DANE-EE(3) certificate usage TLSA records, the rest is more complex, but follows naturally enough. Having verified the certificate a la DANE, I'd like to be able to return more detail to the caller than just success/failure. This part seems difficult to do cleanly. The TLS client state is encapsulated in a State monad which keeps track of the shared (SMTP) protocol state across a source/conduit/sink triple: type SmtpM = StateT ProtoState IO source :: Source SmtpM ByteString proto :: Conduit ByteString SmtpM ByteString sink :: Sink ByteString SmtpM () When the peer supports STARTTLS, I perform a TLS handshake, and make use of a TLS-enabled source/sink pair. This works well enough, but I also need to capture TLS-handshake metadata in the protocol state: * The peer's validated certificate chain. * The DNS name matched in the peer certificate. * Which TLSA record matched the peer's chain * ... A plausible interface is for the DANE version of the X509 verification code to expose one or more optional callbacks that will invoke a function of the caller's choice that will be passed the desired metadata. It would then be up to that function to squirrel this data away for later use. If this callback were to be invoked in the context of the application state monad, I'd just call "modify" in the callback and examine the results post-handshake as needed. However, life is not so simple. The TLS handshake is performed via Network.TLS.handshake, which internally calls the certificate verification code via: processCertificate :: ClientParams -> Context -> Handshake -> IO (RecvState IO) processCertificate cparams ctx (Certificates certs) = do -- run certificate recv hook ctxWithHooks ctx (\hooks -> hookRecvCertificates hooks $ certs) -- then run certificate validation usage <- catchException (wrapCertificateChecks <$> checkCert) rejectOnException case usage of CertificateUsageAccept -> return () CertificateUsageReject reason -> certificateRejected reason return $ RecvStateHandshake (processServerKeyExchange ctx) where shared = clientShared cparams checkCert = (onServerCertificate $ clientHooks cparams) (sharedCAStore shared) (sharedValidationCache shared) (clientServerIdentification cparams) certs processCertificate _ ctx p = processServerKeyExchange ctx p which lives in the base IO monad, and even if I pass in the current state to the `checkCert` hook, there is no opportunity to return the modified state into a context where "restoreM" can make appropriate updates in the caller. The best I can do is provide the hook with a suitable mutable object (likely an MVar). Interestingly enough, the outer Network.TLS.handshake function appears to be more flexible: handshake :: MonadIO m => Context -> m () Which makes possible calls of the form: res <- liftBaseWith $ \runInIO -> do Sys.timeout tmout $ Sys.tryIOError $ runInIO $ TLS.handshake ctx case res of Just x | Right st <- x -> restoreM st; ... success ... | Left e <- x -> ... I/O Error ... _ -> ... timeout ... which turn out futile, since `handshake` immediately switches to doing all the work in the IO monad, and so the underlying internals are not compatible with MonadControl. This prevents back-propagation of state changes via the various callbacks in TLS.ClientParams.clientHooks. -- | Handshake for a new TLS connection -- This is to be called at the beginning of a connection, and during renegotiation handshake :: MonadIO m => Context -> m () handshake ctx = liftIO $ handleException $ withRWLock ctx (ctxDoHandshake ctx $ ctx) where handleException f = catchException f $ \exception -> do let tlserror = maybe (Error_Misc $ show exception) id $ fromException exception setEstablished ctx False sendPacket ctx (errorToAlert tlserror) handshakeFailed tlserror So my question is whether it makes sense to rework the TLS modules to live in a more abstract monad (as in the handshake function) and only work in the base IO monad briefly, when performing actual I/O operations? Thus, perhaps instead: processCertificate :: MonadIO m => ClientParams -> Context -> Handshake -> m (RecvState m) ... Doing this throughout the TLS stack looks a lot of work, so the question is perhaps whether such an effort would be justified? Or is it too late to retrofit monad control over large existing code bases, with the monad control pattern mostly suitable just for de novo work? -- Viktor.
participants (1)
-
Viktor Dukhovni