Trying to make haskell warp-tls authenticate the client

Question

I'm trying to make a https server that authenticates the client but it serves curl --verbose --cacert ca.crt https://localhost:3443 successfully. I think it should reject for lack of client creds and require curl --verbose --cert client.crt --key client.key --cacert ca.crt https://localhost:3443. Here's the code:

{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}

module MockServerMain where

import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai.Handler.WarpTLS
import Servant
import Network.TLS

type MyApi = Get '[JSON] String

api :: Proxy MyApi
api = Proxy

server :: Server MyApi
server = return "Hello from Haskell!"

app :: Application
app = serve api server

main :: IO ()
main =
  let
    stngs = mkSettings "localhost.crt" "ca.crt" "localhost.key"
    warpOpts = setPort 3443 defaultSettings
   in
    runTLS stngs warpOpts app

mkSettings :: FilePath -> FilePath -> FilePath -> TLSSettings
mkSettings crtFile chainFile keyFile = do
  let
      hooks = def
              { onClientCertificate = \_ -> return CertificateUsageAccept
              }
      tlsSs = ( tlsSettingsChain crtFile [chainFile] keyFile ) 
              { tlsServerHooks = hooks
              , tlsWantClientCert = True
              } 
   in tlsSs

I suppose the obvious explanation is that I told it to always accept in the onClientCertificate hook, but the docs say I'm not expected to validate. I know that the tlsWantClientCert is having an effect because if I comment out the hooks it fails. When I only used tlsSettings rather than tlsSettingsChain, the behaviour was the same: accepting the credless curl. I know that the certs are OK because I can make nginx do what this haskell server is supposed to do and allow curls only with creds.

What am I supposed to do with the CA certificate that I want this server to check clients against? This server isn't supposed to know the CA private key.

I think this is the root of the problem: where's the constructor taking ServerParams:

data TLSSettings
    = TLSSettingsSimple
             { settingDisableCertificateValidation :: Bool                                  
             , settingDisableSession               :: Bool
             , settingUseServerName                :: Bool
             }
    | TLSSettings TLS.ClientParams
    deriving (Show)

Trying to make haskell warp-tls authenticate the client

0 Answers0