[Haskell-cafe] Haskell TLS and monad-control?

[Viktor Dukhovni]

[ 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.