[ 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
* 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)
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
| 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)
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
Thus, perhaps instead:
processCertificate :: MonadIO m
-> 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?
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
Only members subscribed via the mailman list are allowed to post.
|Free forum by Nabble||Edit this page|