use x509 and x509-validation.
This commit is contained in:
parent
b1478dd618
commit
026aba87e5
3 changed files with 20 additions and 34 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue