tls-extra 0.4.4 → 0.4.5

raw patch · 3 files changed

+24/−21 lines, 3 filesdep +pemdep ~certificate

Dependencies added: pem

Dependency ranges changed: certificate

Files

• Examples/Stunnel.hs +18/−16
• Network/TLS/Extra/Certificate.hs +3/−3
• tls-extra.cabal +3/−2

@@ -9,14 +9,16 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L +import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import Control.Concurrent.MVar import Control.Exception (finally, try, throw, catch, SomeException) import Control.Monad (when, forever)  import Data.Char (isDigit)+import Data.Either -import Data.Certificate.PEM+import Data.PEM (pemParseBS, PEM(..)) import Data.Certificate.X509 import qualified Data.Certificate.KeyRSA as KeyRSA @@ -105,24 +107,24 @@  readCertificate :: FilePath -> IO X509 readCertificate filepath = do-	content <- B.readFile filepath-	let certdata = case parsePEMCert content of-		Nothing -> error ("no valid certificate section")-		Just x  -> x-	let cert = case decodeCertificate $ L.fromChunks [certdata] of-		Left err -> error ("cannot decode certificate: " ++ err)-		Right x  -> x-	return cert+    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)+                                  $ filter (flip elem ["CERTIFICATE", "TRUSTED CERTIFICATE"] . pemName) pems+          parseCerts (Left err) = error "cannot parse PEM file"  readPrivateKey :: FilePath -> IO PrivateKey readPrivateKey filepath = do-	content <- B.readFile filepath-	let pkdata = case parsePEMKeyRSA content of-		Nothing -> error ("no valid RSA key section")-		Just x  -> L.fromChunks [x]-	case KeyRSA.decodePrivate pkdata of-		Left err     -> error ("cannot decode key: " ++ err)-		Right (_,pk) -> return $ PrivRSA pk+    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"  data Stunnel = 	  Client

@@ -16,6 +16,7 @@ 	, certificateFingerprint 	) where +import Control.Applicative ((<$>)) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Certificate.X509@@ -44,9 +45,8 @@ -- | Returns 'CertificateUsageAccept' if all the checks pass, or the first  --   failure. certificateChecks :: [ [X509] -> IO TLSCertificateUsage ] -> [X509] -> IO TLSCertificateUsage-certificateChecks checks x509s = do-	r <- mapM (\c -> c x509s) checks-	return $ fromMaybe CertificateUsageAccept $ find (CertificateUsageAccept /=) r+certificateChecks checks x509s =+    fromMaybe CertificateUsageAccept . find (CertificateUsageAccept /=) <$> mapM ($ x509s) checks  #if defined(NOCERTVERIFY) 

@@ -1,5 +1,5 @@ Name:                tls-extra-Version:             0.4.4+Version:             0.4.5 Description:    a set of extra definitions, default values and helpers for tls. License:             BSD3@@ -36,7 +36,7 @@                    , vector                    , crypto-api >= 0.5                    , cryptocipher >= 0.3.0-                   , certificate >= 1.1.1 && < 1.2.0+                   , certificate >= 1.2.0 && < 1.3.0                    , text >= 0.5 && < 1.0                    , time   Exposed-modules:   Network.TLS.Extra@@ -55,6 +55,7 @@     Build-Depends:   network                    , cmdargs                    , cprng-aes >= 0.2.3+                   , pem >= 0.1.0     Buildable:       True   else     Buildable:       False