haskell amqp x509 client auth

Question

I've been trying to figure out how to use x509 client auth with Network.AMQP. It seems like I need to create an AMQP.ConnectionOpts with (amongst others) the coTLSSettings parameter as follows:

import qualified Network.AMQP as AMQP
import Network.Connection
let opts = AMQP.ConnectionOpts {
    ..
  , coTLSSettings = Just $ AMQP.TLSCustom $ ...
}

At this point (the ellipsis), having read some of the Network.Connection documentation (and being rather out of my depth) it's starting to look very complicated. And I'm left wondering whether I'm going down the right path here.

So, my question(s): how do I implement x509 client auth easily? If the answer to that is "you can't," does anyone know where I can find an example of x509 client auth using the Network.Connection module?

Answer 1

We need to do two (for my test environment three) things.

1. read the client credentials
2. set a cipher suite as defaultParamsClient sets an empty cipher suite (I don't know why.).
3. (for my test environment) read the CA root certificate, so we can validate the server certificate presented to us. If you are not in a test environment, then this certificate should be installed in the system certificate store and should be found be default. In this case you could drop the CertificateStore handling from the programm.

The function mkMyTLSSettings in the following program replaces the mentioned parts from the result of defaultParamsClient. In the function used as onCertificateRequest you could consume the argument and hand out different credentials depending on the argument values. The needed values themself are read in main to get rid of IO.

For the following program, I modified bits I found in this answer.

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Data.Default.Class
import Network.AMQP
import Network.Socket.Internal (PortNumber)
import Network.TLS
import Network.TLS.Extra.Cipher (ciphersuite_default)
import Data.X509.CertificateStore (CertificateStore (..), readCertificateStore)
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Network.Connection as C
import qualified Data.ByteString.Lazy.Char8 as BL

mkMyTLSSettings :: CertificateStore -> Credential -> C.TLSSettings
mkMyTLSSettings castore creds =
  let defaultParams = defaultParamsClient "127.0.0.1" BS.empty
      newClientShared = (clientShared defaultParams) { sharedCAStore = castore }
      newClientSupported = (clientSupported defaultParams) { supportedCiphers = ciphersuite_default }
      newClientHooks = (clientHooks defaultParams) { onCertificateRequest = \_ -> return (Just creds) }
  in C.TLSSettings $ defaultParams { clientShared = newClientShared
                                   , clientSupported = newClientSupported
                                   , clientHooks = newClientHooks
                                   }

myTLSSettings :: CertificateStore -> Credential -> TLSSettings
myTLSSettings castore creds = TLSCustom $ mkMyTLSSettings castore creds

myTLSConnectionOpts :: TLSSettings -> ConnectionOpts
myTLSConnectionOpts opts = ConnectionOpts
  [("127.0.0.1", 5671 :: PortNumber)]
  "/"
  [plain "guest" "guest"]
  (Just 131072)
  Nothing
  (Just 1)
  (Just opts)

testConnectionOpts :: ConnectionOpts -> IO ()
testConnectionOpts opts = do 
   conn <- openConnection'' opts
   chan <- openChannel conn
   declareQueue chan newQueue {queueName = "hello"}
   putStrLn "Trying to register callback"
   consumeMsgs chan "hello" Ack myCallback
   publishMsg chan "" "hello" newMsg {msgBody = (BL.pack "hello world"), msgDeliveryMode = Just Persistent}
   getLine
   closeConnection conn
   putStrLn "connection closed"

main :: IO ()
main = do
  testConnectionOpts defaultConnectionOpts
  putStrLn "trying with tls"
  castore <- maybe (error "couldn't read CA root Certificate") id <$> (readCertificateStore "/pathto/rootCA.pem")
  creds <- either error id <$> credentialLoadX509 "/pathto/client.pem" "/pathto/client.key"
  let opts = myTLSSettings castore creds
  testConnectionOpts (myTLSConnectionOpts opts)

myCallback :: (Message, Envelope) -> IO ()
myCallback (msg, env) = do
  putStrLn $ "received message: " ++ (BL.unpack $ msgBody msg)
  ackEnv env

As a gist.

The first communication in this program I did to make sure that rabbitmq was setup properly and I really only encountered TLS errors. If you delete line 20 and 23 you can test wether you configured your rabbitmq correctly. The connection attempt in this case should fail, as we don't present a client certificate.

I created a toy CA for testing and issued a certificate for use with the rabbitmq server and one for the client. So I had a file rootCA.pem which stored the CA root certificate and files like rabbitmq.key and rabbitmq.pem which where used to setup TLS with rabbitmq. Also client.pem and client.key for the client. I configured rabbitmq to only serve clients which present a trustworthy certificate, by setting fail_if_no_peer_cert to true and setting the {verify, verify_peer} options.

On my first tries I got the kinds of errors with LeafNotV3 which means I created my rabbitmq.pem wrong on my first try. It was a X509.v1 certificate, which are not accepted by Network.TLS by default. I needed to make sure to create a X509.v3 certificate, which is done, by enabling certain extensions while issuing the certificate rabbitmq.pem, see here. I needed to add the option -req to that command line cited there to make it work.