use x509 and x509-validation.

extra/Network/TLS/Extra/Certificate.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings, CPP #-}
 -- |
 -- Module      : Network.TLS.Extra.Certificate
 -- License     : BSD-style
@@ -11,23 +10,20 @@ module Network.TLS.Extra.Certificate
     ) where
 
 import Control.Applicative ((<$>))
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
 import Data.X509
 import Data.X509.Validation
 import Data.X509.CertificateStore
-
 import Network.TLS (CertificateUsage(..), CertificateRejectReason(..))
 
-import Data.Time.Calendar
-import Data.List (find)
-import Data.Maybe (fromMaybe)
-
 -- | Returns 'CertificateUsageAccept' if all the checks pass, or the first
 --   failure.
-certificateChecks :: Checks -> CertificateChain -> IO CertificateUsage
+certificateChecks :: Checks -> CertificateStore -> CertificateChain -> IO CertificateUsage
 certificateChecks checks store cc = do
     reasons <- validate checks store cc
     return $ case reasons of
-                [] -> CertificateUsageAccept
-                _  -> CertificateUsageReject
+                []  -> CertificateUsageAccept
+                x:_ -> CertificateUsageReject (toRejectReason x)
+  where toRejectReason Expired   = CertificateRejectExpired
+        toRejectReason InFuture  = CertificateRejectExpired
+        toRejectReason UnknownCA = CertificateRejectUnknownCA
+        toRejectReason x         = CertificateRejectOther (show x)

extra/Network/TLS/Extra/File.hs

@@ -17,9 +17,8 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.Either
 import Data.PEM (PEM(..), pemParseBS)
-import Data.Certificate.X509
-import qualified Data.Certificate.KeyRSA as KeyRSA
-import Network.TLS
+import Data.X509.File
+import Data.X509
 
 -- | read one X509 certificate from a file.
 --
@@ -29,29 +28,20 @@ import Network.TLS
 -- If no valid PEM encoded certificate is found in the file
 -- this function will raise an error.
 fileReadCertificate :: FilePath -> IO SignedCertificate
-fileReadCertificate filepath = do
-    certs <- rights . parseCerts . pemParseBS <$> B.readFile filepath
-    case certs of
-        []    -> error "no valid certificate found"
-        (x:_) -> return x
-    where parseCerts (Right pems) = map (decodeCertificate . L.fromChunks . (:[]) . pemContent)
+fileReadCertificate filepath = headError <$> readSignedObject filepath
+  where headError []    = error ("read certificate: not found in " ++ show filepath)
+        headError (x:_) = x
+{-
                                   $ filter (flip elem ["CERTIFICATE", "TRUSTED CERTIFICATE"] . pemName) pems
-          parseCerts (Left err) = error ("cannot parse PEM file " ++ show err)
+-}
 
 -- | read one private key from a file.
 --
--- the private key must be in the usual PEM format and at the moment only
--- RSA PRIVATE KEY are supported.
+-- the private key must be in the usual PEM format
 --
 -- If no valid PEM encoded private key is found in the file
 -- this function will raise an error.
-fileReadPrivateKey :: FilePath -> IO PrivateKey
-fileReadPrivateKey filepath = do
-    pk <- rights . parseKey . pemParseBS <$> B.readFile filepath
-    case pk of
-        []    -> error "no valid RSA key found"
-        (x:_) -> return x
-
-    where parseKey (Right pems) = map (fmap (PrivRSA . snd) . KeyRSA.decodePrivate . L.fromChunks . (:[]) . pemContent)
-                                $ filter ((== "RSA PRIVATE KEY") . pemName) pems
-          parseKey (Left err) = error ("Cannot parse PEM file " ++ show err)
+fileReadPrivateKey :: FilePath -> IO PrivKey
+fileReadPrivateKey filepath = headError <$> readKeyFile filepath
+  where headError []    = error ("read private key: no key found in " ++ show filepath)
+        headError (x:_) = x

extra/tls-extra.cabal

@@ -28,7 +28,7 @@ Library
                    , vector
                    , cipher-rc4
                    , cipher-aes >= 0.1 && < 0.2
-                   , x509 >= 1.4.2 && < 1.5.0
+                   , x509 >= 1.4.3 && < 1.5.0
                    , x509-store >= 1.4.0 && < 1.5.0
                    , x509-validation >= 1.4.2 && < 1.5.0
                    , crypto-pubkey >= 0.1.4