├── .appveror.yml ├── .gitignore ├── .haskell-ci ├── .travis.yml ├── README.md ├── stack.yaml ├── x509-store ├── Data │ └── X509 │ │ ├── CertificateStore.hs │ │ ├── File.hs │ │ └── Memory.hs ├── LICENSE ├── Setup.hs ├── Tests │ └── Tests.hs └── x509-store.cabal ├── x509-system ├── LICENSE ├── Setup.hs ├── System │ ├── X509.hs │ └── X509 │ │ ├── MacOS.hs │ │ ├── Unix.hs │ │ └── Win32.hs └── x509-system.cabal ├── x509-util ├── LICENSE ├── Setup.hs ├── certs │ ├── www.facebook.com.pem │ ├── www.github.com.pem │ └── www.twitter.com.pem ├── crls │ ├── GIAG2.pem │ └── rfc5280_CRL.pem ├── src │ └── Certificate.hs ├── tests │ └── Generate.hs └── x509-util.cabal ├── x509-validation ├── Data │ └── X509 │ │ ├── Validation.hs │ │ └── Validation │ │ ├── Cache.hs │ │ ├── Fingerprint.hs │ │ ├── Signature.hs │ │ └── Types.hs ├── LICENSE ├── Setup.hs ├── Tests │ ├── Certificate.hs │ └── Tests.hs └── x509-validation.cabal └── x509 ├── ChangeLog.md ├── Data ├── X509.hs └── X509 │ ├── AlgorithmIdentifier.hs │ ├── CRL.hs │ ├── Cert.hs │ ├── CertificateChain.hs │ ├── DistinguishedName.hs │ ├── EC.hs │ ├── Ext.hs │ ├── ExtensionRaw.hs │ ├── Internal.hs │ ├── OID.hs │ ├── PrivateKey.hs │ ├── PublicKey.hs │ └── Signed.hs ├── LICENSE ├── Setup.hs ├── Tests └── Tests.hs └── x509.cabal /.appveror.yml: -------------------------------------------------------------------------------- 1 | # ~*~ auto-generated by haskell-ci with config : aa407cb8ef21ea4f031224d579f94e1283708b31d6ac399b28a0fe0224a0c5dc ~*~ 2 | 3 | version: "{build}" 4 | clone_folder: C:\project 5 | build: off 6 | cache: 7 | - "C:\\SR -> .appveyor.yml" 8 | 9 | environment: 10 | global: 11 | STACK_ROOT: "C:\\SR" 12 | matrix: 13 | - { BUILD: "ghc-8.6", STACKCMD: "stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps", STACKCFG: "{ resolver: lts-13.26, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [], flags: {} }", STACKURL: "https://www.stackage.org/stack/windows-x86_64" } 14 | 15 | matrix: 16 | fast_finish: true 17 | 18 | install: 19 | - set PATH=C:\Program Files\Git\mingw64\bin;%PATH% 20 | - curl -ostack.zip -L %STACKURL% 21 | - 7z x stack.zip stack.exe 22 | - refreshenv 23 | test_script: 24 | - echo %STACKCFG% > stack.yaml 25 | - stack setup > nul 26 | - echo "" | %STACKCMD% 27 | 28 | 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | .stack-work/ 3 | *.hi 4 | *.o 5 | -------------------------------------------------------------------------------- /.haskell-ci: -------------------------------------------------------------------------------- 1 | # compiler supported and their equivalent LTS 2 | compiler: ghc-8.0 lts-9.21 3 | compiler: ghc-8.2 lts-11.22 4 | compiler: ghc-8.4 lts-12.9 5 | compiler: ghc-8.6 lts-13.26 6 | compiler: ghc-8.8 nightly-2019-09-29 7 | 8 | # gitdep: name location commit 9 | 10 | # options 11 | # option: alias x=y z=v 12 | option: cryptonitedeps extradep=cryptonite-0.25 extradep=basement-0.0.6 extradep=foundation-0.0.19 extradep=memory-0.14.14 13 | 14 | # builds 15 | # recognized simple options: nohaddock allow-newer allowed-failure 16 | # kvs options: flag=pkg:flagname extradep=package-version gitdep=name 17 | build: ghc-8.0 cryptonitedeps 18 | build: ghc-8.2 19 | build: ghc-8.4 tests=no benchs=no 20 | build: ghc-8.6 os=linux,osx,windows 21 | build: ghc-8.8 extradep=asn1-encoding-0.9.6@sha256:784e936495b1408a7831ff000bef25993b910ca9f008f69e1590da80a9d40f7b,1988 extradep=asn1-parse-0.9.5@sha256:77c0126d63070df2d82cb4cfa4febb26c4e280f6d854bc778c2fa4d80ce692b8,976 22 | 23 | 24 | # packages 25 | package: x509/ 26 | package: x509-store/ 27 | package: x509-system/ 28 | package: x509-validation/ 29 | package: x509-util/ 30 | 31 | # extra builds 32 | hlint: allowed-failure 33 | weeder: allowed-failure 34 | coverall: false 35 | 36 | # travis extra 37 | # travis-apt-addon: packagename 38 | # travis-tests: post-script 39 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # ~*~ auto-generated by haskell-ci with config : aa407cb8ef21ea4f031224d579f94e1283708b31d6ac399b28a0fe0224a0c5dc ~*~ 2 | 3 | # Use new container infrastructure to enable caching 4 | sudo: false 5 | 6 | # Caching so the next build will be fast too. 7 | cache: 8 | directories: 9 | - $HOME/.ghc 10 | - $HOME/.stack 11 | - $HOME/.local 12 | 13 | matrix: 14 | include: 15 | - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 16 | - { env: BUILD=stack RESOLVER=ghc-8.2, compiler: ghc-8.2, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 17 | - { env: BUILD=stack RESOLVER=ghc-8.4, compiler: ghc-8.4, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 18 | - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 19 | - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx } 20 | - { env: BUILD=stack RESOLVER=ghc-8.8, compiler: ghc-8.8, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 21 | - { env: BUILD=hlint, compiler: hlint, language: generic } 22 | - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 23 | allow_failures: 24 | - { env: BUILD=hlint, compiler: hlint, language: generic } 25 | - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } } 26 | 27 | install: 28 | - export PATH=$HOME/.local/bin::$HOME/.cabal/bin:$PATH 29 | - mkdir -p ~/.local/bin 30 | - | 31 | case "$BUILD" in 32 | stack|weeder) 33 | if [ `uname` = "Darwin" ] 34 | then 35 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 36 | else 37 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 38 | fi 39 | ;; 40 | cabal) 41 | ;; 42 | esac 43 | 44 | script: 45 | - | 46 | set -ex 47 | if [ "x${RUNTEST}" = "xfalse" ]; then exit 0; fi 48 | case "$BUILD" in 49 | stack) 50 | # create the build stack.yaml 51 | case "$RESOLVER" in 52 | ghc-8.0) 53 | echo "{ resolver: lts-9.21, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [ cryptonite-0.25, basement-0.0.6, foundation-0.0.19, memory-0.14.14 ], flags: {} }" > stack.yaml 54 | stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps 55 | ;; 56 | ghc-8.2) 57 | echo "{ resolver: lts-11.22, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [], flags: {} }" > stack.yaml 58 | stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps 59 | ;; 60 | ghc-8.4) 61 | echo "{ resolver: lts-12.9, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [], flags: {} }" > stack.yaml 62 | stack --no-terminal build --install-ghc --coverage --no-test --no-bench --haddock --no-haddock-deps 63 | ;; 64 | ghc-8.6) 65 | echo "{ resolver: lts-13.26, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [], flags: {} }" > stack.yaml 66 | stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps 67 | ;; 68 | ghc-8.8) 69 | echo "{ resolver: nightly-2019-09-29, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [ \"asn1-encoding-0.9.6@sha256:784e936495b1408a7831ff000bef25993b910ca9f008f69e1590da80a9d40f7b,1988\", \"asn1-parse-0.9.5@sha256:77c0126d63070df2d82cb4cfa4febb26c4e280f6d854bc778c2fa4d80ce692b8,976\" ], flags: {} }" > stack.yaml 70 | stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps 71 | ;; 72 | esac 73 | ;; 74 | hlint) 75 | curl -sL https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh | sh -s . --cpp-define=__GLASGOW_HASKELL__=800 --cpp-define=x86_64_HOST_ARCH=1 --cpp-define=mingw32_HOST_OS=1 76 | ;; 77 | weeder) 78 | stack --no-terminal build --install-ghc 79 | curl -sL https://raw.github.com/ndmitchell/weeder/master/misc/travis.sh | sh -s . 80 | ;; 81 | esac 82 | set +ex 83 | 84 | 85 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | certificate handling for haskell 2 | ================================ 3 | 4 | [![Build Status](https://travis-ci.org/vincenthz/hs-certificate.png?branch=master)](https://travis-ci.org/vincenthz/hs-certificate) 5 | [![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) 6 | [![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) 7 | 8 | This repository contains various certificates related PKIX X509 packages. 9 | 10 | * x509: pure X509 support 11 | * x509-system: system support for MacOs, Windows and Unix to get access to system wide x509 certificate installation 12 | * x509-store: X509 collection 13 | * x509-validation: X509 validation of Certificate Hierarchy, key validation, permission 14 | * x509-util: executable for debugging and query related to system 15 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # ~*~ auto-generated by haskell-ci with config : aa407cb8ef21ea4f031224d579f94e1283708b31d6ac399b28a0fe0224a0c5dc ~*~ 2 | { resolver: nightly-2022-01-15, packages: [ x509/, x509-store/, x509-system/, x509-validation/, x509-util/ ], extra-deps: [ "asn1-encoding-0.9.6@sha256:784e936495b1408a7831ff000bef25993b910ca9f008f69e1590da80a9d40f7b,1988", "asn1-parse-0.9.5@sha256:77c0126d63070df2d82cb4cfa4febb26c4e280f6d854bc778c2fa4d80ce692b8,976" ], flags: {} } 3 | 4 | -------------------------------------------------------------------------------- /x509-store/Data/X509/CertificateStore.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Data.X509.CertificateStore 3 | ( CertificateStore 4 | , makeCertificateStore 5 | , readCertificateStore 6 | , readCertificates 7 | -- * Queries 8 | , findCertificate 9 | , listCertificates 10 | ) where 11 | 12 | import Data.Char (isDigit, isHexDigit) 13 | import Data.Either (rights) 14 | import Data.List (foldl', isPrefixOf) 15 | #if MIN_VERSION_base(4,9,0) 16 | import Data.Semigroup 17 | #else 18 | import Data.Monoid 19 | #endif 20 | import Data.PEM (pemParseBS, pemContent) 21 | import Data.X509 22 | import qualified Data.Map as M 23 | import Control.Applicative ((<$>)) 24 | import Control.Monad (mplus, filterM) 25 | import System.Directory (getDirectoryContents, doesFileExist, doesDirectoryExist) 26 | import System.FilePath (()) 27 | import qualified Control.Exception as E 28 | import qualified Data.ByteString as B 29 | 30 | 31 | -- | A Collection of certificate or store of certificates. 32 | data CertificateStore = CertificateStore (M.Map DistinguishedName SignedCertificate) 33 | | CertificateStores [CertificateStore] 34 | 35 | #if MIN_VERSION_base(4,9,0) 36 | instance Semigroup CertificateStore where 37 | (<>) = append 38 | #endif 39 | 40 | instance Monoid CertificateStore where 41 | mempty = CertificateStore M.empty 42 | #if !(MIN_VERSION_base(4,11,0)) 43 | mappend = append 44 | #endif 45 | 46 | append :: CertificateStore -> CertificateStore -> CertificateStore 47 | append s1@(CertificateStore _) s2@(CertificateStore _) = CertificateStores [s1,s2] 48 | append (CertificateStores l) s2@(CertificateStore _) = CertificateStores (l ++ [s2]) 49 | append s1@(CertificateStore _) (CertificateStores l) = CertificateStores ([s1] ++ l) 50 | append (CertificateStores l1) (CertificateStores l2) = CertificateStores (l1 ++ l2) 51 | 52 | -- | Create a certificate store out of a list of X509 certificate 53 | makeCertificateStore :: [SignedCertificate] -> CertificateStore 54 | makeCertificateStore = CertificateStore . foldl' accumulate M.empty 55 | where accumulate m x509 = M.insert (certSubjectDN $ getCertificate x509) x509 m 56 | 57 | -- | Find a certificate using the subject distinguished name 58 | findCertificate :: DistinguishedName -> CertificateStore -> Maybe SignedCertificate 59 | findCertificate dn store = lookupIn store 60 | where lookupIn (CertificateStore m) = M.lookup dn m 61 | lookupIn (CertificateStores l) = foldl mplus Nothing $ map lookupIn l 62 | 63 | -- | List all certificates in a store 64 | listCertificates :: CertificateStore -> [SignedCertificate] 65 | listCertificates (CertificateStore store) = map snd $ M.toList store 66 | listCertificates (CertificateStores l) = concatMap listCertificates l 67 | 68 | -- | Create certificate store by reading certificates from file or directory 69 | -- 70 | -- This function can be used to read multiple certificates from either 71 | -- single file (multiple PEM formatted certificates concanated) or 72 | -- directory (one certificate per file, file names are hashes from 73 | -- certificate). 74 | readCertificateStore :: FilePath -> IO (Maybe CertificateStore) 75 | readCertificateStore path = do 76 | isDir <- doesDirectoryExist path 77 | isFile <- doesFileExist path 78 | wrapStore <$> (if isDir then makeDirStore else if isFile then makeFileStore else return []) 79 | where 80 | wrapStore :: [SignedCertificate] -> Maybe CertificateStore 81 | wrapStore [] = Nothing 82 | wrapStore l = Just $ makeCertificateStore l 83 | 84 | makeFileStore = readCertificates path 85 | makeDirStore = do 86 | certFiles <- listDirectoryCerts path 87 | concat <$> mapM readCertificates certFiles 88 | 89 | -- Try to read certificate from the content of a file. 90 | -- 91 | -- The file may contains multiple certificates 92 | readCertificates :: FilePath -> IO [SignedCertificate] 93 | readCertificates file = E.catch (either (const []) (rights . map getCert) . pemParseBS <$> B.readFile file) skipIOError 94 | where 95 | getCert = decodeSignedCertificate . pemContent 96 | skipIOError :: E.IOException -> IO [SignedCertificate] 97 | skipIOError _ = return [] 98 | 99 | -- List all the path susceptible to contains a certificate in a directory 100 | -- 101 | -- if the parameter is not a directory, hilarity follows. 102 | listDirectoryCerts :: FilePath -> IO [FilePath] 103 | listDirectoryCerts path = 104 | getDirContents >>= filterM doesFileExist 105 | where 106 | isHashedFile s = length s == 10 107 | && isDigit (s !! 9) 108 | && (s !! 8) == '.' 109 | && all isHexDigit (take 8 s) 110 | isCert x = (not $ isPrefixOf "." x) && (not $ isHashedFile x) 111 | 112 | getDirContents = E.catch (map (path ) . filter isCert <$> getDirectoryContents path) emptyPaths 113 | where emptyPaths :: E.IOException -> IO [FilePath] 114 | emptyPaths _ = return [] 115 | -------------------------------------------------------------------------------- /x509-store/Data/X509/File.hs: -------------------------------------------------------------------------------- 1 | module Data.X509.File 2 | ( readSignedObject 3 | , readKeyFile 4 | , PEMError (..) 5 | ) where 6 | 7 | import Control.Applicative 8 | import Control.Exception (Exception (..), throw) 9 | import Data.ASN1.Types 10 | import Data.ASN1.BinaryEncoding 11 | import Data.ASN1.Encoding 12 | import Data.Maybe 13 | import qualified Data.X509 as X509 14 | import Data.X509.Memory (pemToKey) 15 | import Data.PEM (pemParseLBS, pemContent, pemName, PEM) 16 | import qualified Data.ByteString.Lazy as L 17 | 18 | newtype PEMError = PEMError {displayPEMError :: String} 19 | deriving Show 20 | 21 | instance Exception PEMError where 22 | displayException = displayPEMError 23 | 24 | readPEMs :: FilePath -> IO [PEM] 25 | readPEMs filepath = do 26 | content <- L.readFile filepath 27 | either (throw . PEMError) pure $ pemParseLBS content 28 | 29 | -- | return all the signed objects in a file. 30 | -- 31 | -- (only one type at a time). 32 | readSignedObject :: (ASN1Object a, Eq a, Show a) 33 | => FilePath 34 | -> IO [X509.SignedExact a] 35 | readSignedObject filepath = decodePEMs <$> readPEMs filepath 36 | where decodePEMs pems = 37 | [ obj | pem <- pems, Right obj <- [X509.decodeSignedObject $ pemContent pem] ] 38 | 39 | -- | return all the private keys that were successfully read from a file. 40 | readKeyFile :: FilePath -> IO [X509.PrivKey] 41 | readKeyFile path = catMaybes . foldl pemToKey [] <$> readPEMs path 42 | -------------------------------------------------------------------------------- /x509-store/Data/X509/Memory.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Memory 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- 9 | module Data.X509.Memory 10 | ( readKeyFileFromMemory 11 | , readSignedObjectFromMemory 12 | , pemToKey 13 | ) where 14 | 15 | import Data.ASN1.Types 16 | import Data.ASN1.BinaryEncoding 17 | import Data.ASN1.BitArray 18 | import Data.ASN1.Encoding 19 | import Data.ASN1.Stream 20 | import Data.Maybe 21 | import qualified Data.X509 as X509 22 | import Data.X509.EC as X509 23 | import Data.PEM (pemParseBS, pemContent, pemName, PEM) 24 | import qualified Data.ByteString as B 25 | import Crypto.Number.Basic (numBytes) 26 | import Crypto.Number.Serialize (os2ip) 27 | import qualified Crypto.PubKey.DSA as DSA 28 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 29 | import qualified Crypto.PubKey.RSA as RSA 30 | 31 | readKeyFileFromMemory :: B.ByteString -> [X509.PrivKey] 32 | readKeyFileFromMemory = either (const []) (catMaybes . foldl pemToKey []) . pemParseBS 33 | 34 | readSignedObjectFromMemory :: (ASN1Object a, Eq a, Show a) 35 | => B.ByteString 36 | -> [X509.SignedExact a] 37 | readSignedObjectFromMemory = either (const []) (foldl pemToSigned []) . pemParseBS 38 | where pemToSigned acc pem = 39 | case X509.decodeSignedObject $ pemContent pem of 40 | Left _ -> acc 41 | Right obj -> obj : acc 42 | 43 | pemToKey :: [Maybe X509.PrivKey] -> PEM -> [Maybe X509.PrivKey] 44 | pemToKey acc pem = 45 | case decodeASN1' BER (pemContent pem) of 46 | Left _ -> acc 47 | Right asn1 -> 48 | case pemName pem of 49 | "PRIVATE KEY" -> 50 | tryRSA asn1 : tryNewcurve asn1 : tryECDSA asn1 : tryDSA asn1 : acc 51 | "RSA PRIVATE KEY" -> 52 | tryRSA asn1 : acc 53 | "DSA PRIVATE KEY" -> 54 | tryDSA asn1 : acc 55 | "EC PRIVATE KEY" -> 56 | tryECDSA asn1 : acc 57 | "X25519 PRIVATE KEY" -> 58 | tryNewcurve asn1 : acc 59 | "X448 PRIVATE KEY" -> 60 | tryNewcurve asn1 : acc 61 | "ED25519 PRIVATE KEY" -> 62 | tryNewcurve asn1 : acc 63 | "ED448 PRIVATE KEY" -> 64 | tryNewcurve asn1 : acc 65 | _ -> acc 66 | where 67 | tryRSA asn1 = case rsaFromASN1 asn1 of 68 | Left _ -> Nothing 69 | Right (k,_) -> Just $ X509.PrivKeyRSA k 70 | tryDSA asn1 = case dsaFromASN1 asn1 of 71 | Left _ -> Nothing 72 | Right (k,_) -> Just $ X509.PrivKeyDSA $ DSA.toPrivateKey k 73 | tryECDSA asn1 = case ecdsaFromASN1 [] asn1 of 74 | Left _ -> Nothing 75 | Right (k,_) -> Just $ X509.PrivKeyEC k 76 | tryNewcurve asn1 = case fromASN1 asn1 of 77 | Right (k@(X509.PrivKeyX25519 _),_) -> Just k 78 | Right (k@(X509.PrivKeyX448 _),_) -> Just k 79 | Right (k@(X509.PrivKeyEd25519 _),_) -> Just k 80 | Right (k@(X509.PrivKeyEd448 _),_) -> Just k 81 | _ -> Nothing 82 | 83 | dsaFromASN1 :: [ASN1] -> Either String (DSA.KeyPair, [ASN1]) 84 | dsaFromASN1 (Start Sequence : IntVal n : xs) 85 | | n /= 0 = Left "fromASN1: DSA.KeyPair: unknown format" 86 | | otherwise = 87 | case xs of 88 | IntVal p : IntVal q : IntVal g : IntVal pub : IntVal priv : End Sequence : xs2 -> 89 | let params = DSA.Params { DSA.params_p = p, DSA.params_g = g, DSA.params_q = q } 90 | in Right (DSA.KeyPair params pub priv, xs2) 91 | (Start Sequence 92 | : OID [1, 2, 840, 10040, 4, 1] 93 | : Start Sequence 94 | : IntVal p 95 | : IntVal q 96 | : IntVal g 97 | : End Sequence 98 | : End Sequence 99 | : OctetString bs 100 | : End Sequence 101 | : xs2) -> 102 | let params = DSA.Params { DSA.params_p = p, DSA.params_g = g, DSA.params_q = q } 103 | in case decodeASN1' BER bs of 104 | Right [IntVal priv] -> 105 | let pub = DSA.calculatePublic params priv 106 | in Right (DSA.KeyPair params pub priv, xs2) 107 | Right _ -> Left "dsaFromASN1: DSA.PrivateKey: unexpected format" 108 | Left e -> Left $ "dsaFromASN1: DSA.PrivateKey: " ++ show e 109 | _ -> 110 | Left "dsaFromASN1: DSA.KeyPair: invalid format (version=0)" 111 | dsaFromASN1 _ = Left "dsaFromASN1: DSA.KeyPair: unexpected format" 112 | 113 | ecdsaFromASN1 :: [ASN1] -> [ASN1] -> Either String (X509.PrivKeyEC, [ASN1]) 114 | ecdsaFromASN1 curveOid1 (Start Sequence 115 | : IntVal 1 116 | : OctetString ds 117 | : xs) = do 118 | let (curveOid2, ys) = containerWithTag 0 xs 119 | privKey <- getPrivKeyEC (os2ip ds) (curveOid2 ++ curveOid1) 120 | case containerWithTag 1 ys of 121 | (_, End Sequence : zs) -> return (privKey, zs) 122 | _ -> Left "ecdsaFromASN1: unexpected EC format" 123 | ecdsaFromASN1 curveOid1 (Start Sequence 124 | : IntVal 0 125 | : Start Sequence 126 | : OID [1, 2, 840, 10045, 2, 1] 127 | : xs) = 128 | let strError = Left . ("ecdsaFromASN1: ECDSA.PrivateKey: " ++) . show 129 | (curveOid2, ys) = getConstructedEnd 0 xs 130 | in case ys of 131 | (OctetString bs 132 | : zs) -> do 133 | let curveOids = curveOid2 ++ curveOid1 134 | inner = either strError (ecdsaFromASN1 curveOids) (decodeASN1' BER bs) 135 | either Left (\(k, _) -> Right (k, zs)) inner 136 | _ -> Left "ecdsaFromASN1: unexpected format" 137 | ecdsaFromASN1 _ _ = 138 | Left "ecdsaFromASN1: unexpected format" 139 | 140 | getPrivKeyEC :: ECDSA.PrivateNumber -> [ASN1] -> Either String X509.PrivKeyEC 141 | getPrivKeyEC _ [] = Left "ecdsaFromASN1: curve is missing" 142 | getPrivKeyEC d (OID curveOid : _) = 143 | case X509.lookupCurveNameByOID curveOid of 144 | Just name -> Right X509.PrivKeyEC_Named { X509.privkeyEC_name = name 145 | , X509.privkeyEC_priv = d 146 | } 147 | Nothing -> Left ("ecdsaFromASN1: unknown curve " ++ show curveOid) 148 | getPrivKeyEC d (Null : xs) = getPrivKeyEC d xs 149 | getPrivKeyEC d (Start Sequence 150 | : IntVal 1 151 | : Start Sequence 152 | : OID [1, 2, 840, 10045, 1, 1] 153 | : IntVal prime 154 | : End Sequence 155 | : Start Sequence 156 | : OctetString a 157 | : OctetString b 158 | : BitString seed 159 | : End Sequence 160 | : OctetString generator 161 | : IntVal order 162 | : IntVal cofactor 163 | : End Sequence 164 | : _) = 165 | Right X509.PrivKeyEC_Prime 166 | { X509.privkeyEC_priv = d 167 | , X509.privkeyEC_a = os2ip a 168 | , X509.privkeyEC_b = os2ip b 169 | , X509.privkeyEC_prime = prime 170 | , X509.privkeyEC_generator = X509.SerializedPoint generator 171 | , X509.privkeyEC_order = order 172 | , X509.privkeyEC_cofactor = cofactor 173 | , X509.privkeyEC_seed = os2ip $ bitArrayGetData seed 174 | } 175 | getPrivKeyEC _ _ = Left "ecdsaFromASN1: unexpected curve format" 176 | 177 | containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1]) 178 | containerWithTag etag (Start (Container _ atag) : xs) 179 | | etag == atag = getConstructedEnd 0 xs 180 | containerWithTag _ xs = ([], xs) 181 | 182 | rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1]) 183 | rsaFromASN1 (Start Sequence 184 | : IntVal 0 185 | : IntVal n 186 | : IntVal e 187 | : IntVal d 188 | : IntVal p1 189 | : IntVal p2 190 | : IntVal pexp1 191 | : IntVal pexp2 192 | : IntVal pcoef 193 | : End Sequence 194 | : xs) = Right (privKey, xs) 195 | where 196 | pubKey = RSA.PublicKey { RSA.public_size = numBytes n 197 | , RSA.public_n = n 198 | , RSA.public_e = e 199 | } 200 | privKey = RSA.PrivateKey { RSA.private_pub = pubKey 201 | , RSA.private_d = d 202 | , RSA.private_p = p1 203 | , RSA.private_q = p2 204 | , RSA.private_dP = pexp1 205 | , RSA.private_dQ = pexp2 206 | , RSA.private_qinv = pcoef 207 | } 208 | 209 | rsaFromASN1 ( Start Sequence 210 | : IntVal 0 211 | : Start Sequence 212 | : OID [1, 2, 840, 113549, 1, 1, 1] 213 | : Null 214 | : End Sequence 215 | : OctetString bs 216 | : xs) = 217 | let inner = either strError rsaFromASN1 $ decodeASN1' BER bs 218 | strError = Left . ("rsaFromASN1: RSA.PrivateKey: " ++) . show 219 | in either Left (\(k, _) -> Right (k, xs)) inner 220 | rsaFromASN1 _ = 221 | Left "rsaFromASN1: unexpected format" 222 | -------------------------------------------------------------------------------- /x509-store/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010-2013 Vincent Hanquez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /x509-store/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /x509-store/x509-store.cabal: -------------------------------------------------------------------------------- 1 | Name: x509-store 2 | version: 1.6.9 3 | Description: X.509 collection accessing and storing methods for certificate, crl, exception list 4 | License: BSD3 5 | License-file: LICENSE 6 | Copyright: Vincent Hanquez 7 | Author: Vincent Hanquez 8 | Maintainer: Vincent Hanquez 9 | Synopsis: X.509 collection accessing and storing methods 10 | Build-Type: Simple 11 | Category: Data 12 | stability: experimental 13 | Homepage: http://github.com/vincenthz/hs-certificate 14 | Cabal-Version: >= 1.10 15 | 16 | Library 17 | Default-Language: Haskell2010 18 | Build-Depends: base >= 3 && < 5 19 | , bytestring 20 | , mtl 21 | , containers 22 | , directory 23 | , filepath 24 | , pem >= 0.1 && < 0.3 25 | , asn1-types >= 0.3 && < 0.4 26 | , asn1-encoding >= 0.9 && < 0.10 27 | , cryptonite 28 | , x509 >= 1.7.2 29 | Exposed-modules: Data.X509.CertificateStore 30 | Data.X509.File 31 | Data.X509.Memory 32 | ghc-options: -Wall 33 | 34 | Test-Suite test-x509-store 35 | Default-Language: Haskell2010 36 | type: exitcode-stdio-1.0 37 | hs-source-dirs: Tests 38 | Main-is: Tests.hs 39 | Build-Depends: base >= 3 && < 5 40 | , bytestring 41 | , tasty 42 | , tasty-hunit 43 | , x509 44 | , x509-store 45 | ghc-options: -Wall 46 | 47 | source-repository head 48 | type: git 49 | location: git://github.com/vincenthz/hs-certificate 50 | subdir: x509-store 51 | -------------------------------------------------------------------------------- /x509-system/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010-2013 Vincent Hanquez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /x509-system/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /x509-system/System/X509.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | -- | 3 | -- Module : System.X509 4 | -- License : BSD-style 5 | -- Maintainer : Vincent Hanquez 6 | -- Stability : experimental 7 | -- Portability : good 8 | -- 9 | module System.X509 10 | ( getSystemCertificateStore 11 | ) where 12 | 13 | #if defined(WINDOWS) 14 | import System.X509.Win32 15 | #elif defined(MACOSX) 16 | import System.X509.MacOS 17 | #else 18 | import System.X509.Unix 19 | #endif 20 | -------------------------------------------------------------------------------- /x509-system/System/X509/MacOS.hs: -------------------------------------------------------------------------------- 1 | module System.X509.MacOS 2 | ( getSystemCertificateStore 3 | ) where 4 | 5 | import Data.PEM (pemParseLBS, PEM(..)) 6 | import System.Process 7 | import qualified Data.ByteString.Lazy as LBS 8 | import Control.Applicative 9 | import Data.Either 10 | 11 | import Data.X509 12 | import Data.X509.CertificateStore 13 | 14 | rootCAKeyChain :: FilePath 15 | rootCAKeyChain = "/System/Library/Keychains/SystemRootCertificates.keychain" 16 | 17 | systemKeyChain :: FilePath 18 | systemKeyChain = "/Library/Keychains/System.keychain" 19 | 20 | listInKeyChains :: [FilePath] -> IO [SignedCertificate] 21 | listInKeyChains keyChains = do 22 | (_, Just hout, _, ph) <- createProcess (proc "security" ("find-certificate" : "-pa" : keyChains)) { std_out = CreatePipe } 23 | pems <- either error id . pemParseLBS <$> LBS.hGetContents hout 24 | let targets = rights $ map (decodeSignedCertificate . pemContent) $ filter ((=="CERTIFICATE") . pemName) pems 25 | _ <- targets `seq` waitForProcess ph 26 | return targets 27 | 28 | getSystemCertificateStore :: IO CertificateStore 29 | getSystemCertificateStore = makeCertificateStore <$> listInKeyChains [rootCAKeyChain, systemKeyChain] 30 | -------------------------------------------------------------------------------- /x509-system/System/X509/Unix.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : System.X509 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unix only 7 | -- 8 | -- this module is portable to unix system where there is usually 9 | -- a /etc/ssl/certs with system X509 certificates. 10 | -- 11 | -- the path can be dynamically override using the environment variable 12 | -- defined by envPathOverride in the module, which by 13 | -- default is SYSTEM_CERTIFICATE_PATH 14 | -- 15 | module System.X509.Unix 16 | ( getSystemCertificateStore 17 | ) where 18 | 19 | import System.Environment (getEnv) 20 | import Data.X509.CertificateStore 21 | 22 | import Control.Applicative ((<$>)) 23 | import qualified Control.Exception as E 24 | 25 | import Data.Maybe (catMaybes) 26 | import Data.Monoid (mconcat) 27 | 28 | defaultSystemPaths :: [FilePath] 29 | defaultSystemPaths = 30 | [ "/etc/ssl/certs/" -- linux 31 | , "/system/etc/security/cacerts/" -- android 32 | , "/usr/local/share/certs/" -- freebsd 33 | , "/etc/ssl/cert.pem" -- openbsd 34 | ] 35 | 36 | envPathOverride :: String 37 | envPathOverride = "SYSTEM_CERTIFICATE_PATH" 38 | 39 | getSystemCertificateStore :: IO CertificateStore 40 | getSystemCertificateStore = mconcat . catMaybes <$> (getSystemPaths >>= mapM readCertificateStore) 41 | 42 | getSystemPaths :: IO [FilePath] 43 | getSystemPaths = E.catch ((:[]) <$> getEnv envPathOverride) inDefault 44 | where 45 | inDefault :: E.IOException -> IO [FilePath] 46 | inDefault _ = return defaultSystemPaths 47 | -------------------------------------------------------------------------------- /x509-system/System/X509/Win32.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ForeignFunctionInterface #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | {-# LANGUAGE CPP #-} 4 | module System.X509.Win32 5 | ( getSystemCertificateStore 6 | ) where 7 | 8 | import Foreign.Ptr 9 | import Foreign.Storable 10 | import Data.Word 11 | 12 | import Control.Monad (when) 13 | import Control.Applicative 14 | import Control.Exception (catch) 15 | 16 | import qualified Data.ByteString.Internal as B 17 | 18 | import Data.X509 19 | import Data.X509.CertificateStore 20 | import Data.ASN1.Error 21 | 22 | import System.Win32.Types 23 | 24 | type HCertStore = Ptr Word8 25 | type PCCERT_Context = Ptr Word8 26 | 27 | foreign import stdcall unsafe "CertOpenSystemStoreW" 28 | c_CertOpenSystemStore :: Ptr Word8 -> LPCTSTR -> IO HCertStore 29 | foreign import stdcall unsafe "CertCloseStore" 30 | c_CertCloseStore :: HCertStore -> DWORD -> IO () 31 | 32 | foreign import stdcall unsafe "CertEnumCertificatesInStore" 33 | c_CertEnumCertificatesInStore :: HCertStore -> PCCERT_Context -> IO PCCERT_Context 34 | 35 | certOpenSystemStore :: IO HCertStore 36 | certOpenSystemStore = withTString "ROOT" $ \cstr -> 37 | c_CertOpenSystemStore nullPtr cstr 38 | 39 | certFromContext :: PCCERT_Context -> IO (Either String SignedCertificate) 40 | certFromContext cctx = do 41 | ty <- peek (castPtr cctx :: Ptr DWORD) 42 | p <- peek (castPtr (cctx `plusPtr` pbCertEncodedPos) :: Ptr (Ptr BYTE)) 43 | len <- peek (castPtr (cctx `plusPtr` cbCertEncodedPos) :: Ptr DWORD) 44 | process ty p len 45 | where process 1 p len = do 46 | b <- B.create (fromIntegral len) $ \dst -> B.memcpy dst p (fromIntegral len) 47 | return $ decodeSignedObject b 48 | process ty _ _ = 49 | return $ Left ("windows certificate store: not supported type: " ++ show ty) 50 | pbCertEncodedPos = alignment (undefined :: Ptr (Ptr BYTE)) 51 | cbCertEncodedPos = pbCertEncodedPos + sizeOf (undefined :: Ptr (Ptr BYTE)) 52 | 53 | getSystemCertificateStore :: IO CertificateStore 54 | getSystemCertificateStore = do 55 | store <- certOpenSystemStore 56 | when (store == nullPtr) $ error "no store" 57 | certs <- loop store nullPtr 58 | c_CertCloseStore store 0 59 | return (makeCertificateStore certs) 60 | where loop st ptr = do 61 | r <- c_CertEnumCertificatesInStore st ptr 62 | if r == nullPtr 63 | then return [] 64 | else do 65 | ecert <- certFromContext r 66 | case ecert of 67 | Left _ -> loop st r 68 | Right cert -> (cert :) <$> (loop st r) 69 | `catch` \(_ :: ASN1Error) -> loop st r 70 | -------------------------------------------------------------------------------- /x509-system/x509-system.cabal: -------------------------------------------------------------------------------- 1 | Name: x509-system 2 | version: 1.6.7 3 | Synopsis: Handle per-operating-system X.509 accessors and storage 4 | Description: System X.509 handling for accessing operating system dependents store and other storage methods 5 | License: BSD3 6 | License-file: LICENSE 7 | Copyright: Vincent Hanquez 8 | Author: Vincent Hanquez 9 | Maintainer: Vincent Hanquez 10 | Build-Type: Simple 11 | Category: Data 12 | stability: experimental 13 | Homepage: http://github.com/vincenthz/hs-certificate 14 | Cabal-Version: >= 1.10 15 | 16 | Library 17 | Default-Language: Haskell2010 18 | Build-Depends: base >= 3 && < 5 19 | , bytestring 20 | , mtl 21 | , containers 22 | , directory 23 | , filepath 24 | , process 25 | , pem >= 0.1 && < 0.3 26 | , x509 >= 1.6 27 | , x509-store >= 1.6.2 28 | Exposed-modules: System.X509 29 | System.X509.Unix 30 | System.X509.MacOS 31 | ghc-options: -Wall 32 | if os(windows) 33 | cpp-options: -DWINDOWS 34 | Build-Depends: Win32, asn1-encoding 35 | extra-libraries: Crypt32 36 | Exposed-modules: System.X509.Win32 37 | if os(OSX) 38 | cpp-options: -DMACOSX 39 | 40 | source-repository head 41 | type: git 42 | location: git://github.com/vincenthz/hs-certificate 43 | subdir: x509-system 44 | -------------------------------------------------------------------------------- /x509-util/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010-2013 Vincent Hanquez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /x509-util/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /x509-util/certs/www.facebook.com.pem: -------------------------------------------------------------------------------- 1 | connecting to www.facebook.com on port 443 ... 2 | ###### Certificate 1 ###### 3 | -----BEGIN CERTIFICATE----- 4 | MIIDyDCCAzGgAwIBAgIQAX933rO8uyNdRMzH26YucjANBgkqhkiG9w0BAQUFADCB 5 | ujEfMB0GA1UEChMWVmVyaVNpZ24gVHJ1c3QgTmV0d29yazEXMBUGA1UECxMOVmVy 6 | aVNpZ24sIEluYy4xMzAxBgNVBAsTKlZlcmlTaWduIEludGVybmF0aW9uYWwgU2Vy 7 | dmVyIENBIC0gQ2xhc3MgMzFJMEcGA1UECxNAd3d3LnZlcmlzaWduLmNvbS9DUFMg 8 | SW5jb3JwLmJ5IFJlZi4gTElBQklMSVRZIExURC4oYyk5NyBWZXJpU2lnbjAeFw0x 9 | MjA2MjEwMDAwMDBaFw0xMzEyMzEyMzU5NTlaMGgxCzAJBgNVBAYTAlVTMRMwEQYD 10 | VQQIEwpDYWxpZm9ybmlhMRIwEAYDVQQHEwlQYWxvIEFsdG8xFzAVBgNVBAoTDkZh 11 | Y2Vib29rLCBJbmMuMRcwFQYDVQQDFA4qLmZhY2Vib29rLmNvbTCBnzANBgkqhkiG 12 | 9w0BAQEFAAOBjQAwgYkCgYEArpSxceLezMFpPgUQYyQBAuBomug8Obaz50uX1I17 13 | I2iRALC0lu5i8ObTVrz0qg9QZDQC9dF2aqlyg1p1ZHI/ObvvUpDe2bzb+dPVXfrS 14 | OqA9xgTFTSnPHUs729GoCc+uR7RMfq4XxRCb7iSpz0qNkRuw/QQVrkw/QwqhKlV+ 15 | KuECAwEAAaOCAR4wggEaMAkGA1UdEwQCMAAwRAYDVR0gBD0wOzA5BgtghkgBhvhF 16 | AQcXAzAqMCgGCCsGAQUFBwIBFhxodHRwczovL3d3dy52ZXJpc2lnbi5jb20vcnBh 17 | MDwGA1UdHwQ1MDMwMaAvoC2GK2h0dHA6Ly9TVlJJbnRsLWNybC52ZXJpc2lnbi5j 18 | b20vU1ZSSW50bC5jcmwwHQYDVR0lBBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMAsG 19 | A1UdDwQEAwIFoDA0BggrBgEFBQcBAQQoMCYwJAYIKwYBBQUHMAGGGGh0dHA6Ly9v 20 | Y3NwLnZlcmlzaWduLmNvbTAnBgNVHREEIDAegg4qLmZhY2Vib29rLmNvbYIMZmFj 21 | ZWJvb2suY29tMA0GCSqGSIb3DQEBBQUAA4GBAFtsK3X47TCqUarTarpZXlVRQZUf 22 | gaU7RHkQrB92/3j8J4Fha1jzEir8HIcBBCXp7UPfGnumSYBgZ+JoivA9tYx99O4D 23 | MJpq/CR8yxNNwz5UxrwdUTOlMqcyc7HXnK3Ajn4agxFtNFIzQLAwVCeiF0KCfJiR 24 | Zpjufq+MO91xcAgX 25 | -----END CERTIFICATE----- 26 | 27 | ###### Certificate 2 ###### 28 | -----BEGIN CERTIFICATE----- 29 | MIIDgzCCAuygAwIBAgIQRvzrurTQLw+SYJgjP5MHjzANBgkqhkiG9w0BAQUFADBf 30 | MQswCQYDVQQGEwJVUzEXMBUGA1UEChMOVmVyaVNpZ24sIEluYy4xNzA1BgNVBAsT 31 | LkNsYXNzIDMgUHVibGljIFByaW1hcnkgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkw 32 | HhcNOTcwNDE3MDAwMDAwWhcNMTYxMDI0MjM1OTU5WjCBujEfMB0GA1UEChMWVmVy 33 | aVNpZ24gVHJ1c3QgTmV0d29yazEXMBUGA1UECxMOVmVyaVNpZ24sIEluYy4xMzAx 34 | BgNVBAsTKlZlcmlTaWduIEludGVybmF0aW9uYWwgU2VydmVyIENBIC0gQ2xhc3Mg 35 | MzFJMEcGA1UECxNAd3d3LnZlcmlzaWduLmNvbS9DUFMgSW5jb3JwLmJ5IFJlZi4g 36 | TElBQklMSVRZIExURC4oYyk5NyBWZXJpU2lnbjCBnzANBgkqhkiG9w0BAQEFAAOB 37 | jQAwgYkCgYEA2IKA6NYZAn0fhRg5JaJlK+G/1AXTvOY2O6rwTGxbtueqPHNFVbLx 38 | veqXQu2aNAoV1Klc9UAl3dkHwTKydWzEyruj/lYncUOqY/UwPpMo5frxCTvzt01O 39 | OfdcSVq4wR3Tsor+cDCVQsv+K1GLWjw6+SJPkLICp1OcTzTnqwSye28CAwEAAaOB 40 | 4zCB4DAPBgNVHRMECDAGAQH/AgEAMEQGA1UdIAQ9MDswOQYLYIZIAYb4RQEHAQEw 41 | KjAoBggrBgEFBQcCARYcaHR0cHM6Ly93d3cudmVyaXNpZ24uY29tL0NQUzA0BgNV 42 | HSUELTArBggrBgEFBQcDAQYIKwYBBQUHAwIGCWCGSAGG+EIEAQYKYIZIAYb4RQEI 43 | ATALBgNVHQ8EBAMCAQYwEQYJYIZIAYb4QgEBBAQDAgEGMDEGA1UdHwQqMCgwJqAk 44 | oCKGIGh0dHA6Ly9jcmwudmVyaXNpZ24uY29tL3BjYTMuY3JsMA0GCSqGSIb3DQEB 45 | BQUAA4GBAECOSZeWinPdjk3vPmG3yqBirfQOCrt1PeJu2CzHv/S5jDabyqLQnHJG 46 | OfamggNlEcS8vy2m9dk7CrWY+rN4uR7yK0xi1f2yeh3fM/1z+aXYLYwq6tH8sCi2 47 | 6UlIE0uDihtIeyT3ON5vQVS4q1drBt/HotSp9vE2YoCI8ot11oBx 48 | -----END CERTIFICATE----- 49 | 50 | -------------------------------------------------------------------------------- /x509-util/certs/www.github.com.pem: -------------------------------------------------------------------------------- 1 | connecting to www.github.com on port 443 ... 2 | ###### Certificate 1 ###### 3 | -----BEGIN CERTIFICATE----- 4 | MIIHKjCCBhKgAwIBAgIQDnd2il0H8OV5WcoqnVCCtTANBgkqhkiG9w0BAQUFADBp 5 | MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3 6 | d3cuZGlnaWNlcnQuY29tMSgwJgYDVQQDEx9EaWdpQ2VydCBIaWdoIEFzc3VyYW5j 7 | ZSBFViBDQS0xMB4XDTExMDUyNzAwMDAwMFoXDTEzMDcyOTEyMDAwMFowgcoxHTAb 8 | BgNVBA8MFFByaXZhdGUgT3JnYW5pemF0aW9uMRMwEQYLKwYBBAGCNzwCAQMTAlVT 9 | MRswGQYLKwYBBAGCNzwCAQITCkNhbGlmb3JuaWExETAPBgNVBAUTCEMzMjY4MTAy 10 | MQswCQYDVQQGEwJVUzETMBEGA1UECBMKQ2FsaWZvcm5pYTEWMBQGA1UEBxMNU2Fu 11 | IEZyYW5jaXNjbzEVMBMGA1UEChMMR2l0SHViLCBJbmMuMRMwEQYDVQQDEwpnaXRo 12 | dWIuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA7dOJw11wcgnz 13 | M08acnTZtlqVULtoYZ/3+x8Z4doEMa8VfBp/+XOvHeVDK1YJAEVpSujEW9/Cd1JR 14 | GVvRK9k5ZTagMhkcQXP7MrI9n5jsglsLN2Q5LLcQg3LN8OokS/rZlC7DhRU5qTr2 15 | iNr0J4mmlU+EojdOfCV4OsmDbQIXlXh9R6hVg+4TyBkaszzxX/47AuGF+xFmqwld 16 | n0xD8MckXilyKM7UdWhPJHIprjko/N+NT02Dc3QMbxGbp91i3v/i6xfm/wy/wC0x 17 | O9ZZovLdh0pIe20zERRNNJ8yOPbIGZ3xtj3FRu9RC4rGM+1IYcQdFxu9fLZn6TnP 18 | pVKACvTqzQIDAQABo4IDajCCA2YwHwYDVR0jBBgwFoAUTFjLJfBBT1L0KMiBQ5um 19 | qKDmkuUwHQYDVR0OBBYEFIfRjxlu5IdvU4x3kQdQ36O/VUcgMCUGA1UdEQQeMByC 20 | CmdpdGh1Yi5jb22CDnd3dy5naXRodWIuY29tMIGBBggrBgEFBQcBAQR1MHMwJAYI 21 | KwYBBQUHMAGGGGh0dHA6Ly9vY3NwLmRpZ2ljZXJ0LmNvbTBLBggrBgEFBQcwAoY/ 22 | aHR0cDovL3d3dy5kaWdpY2VydC5jb20vQ0FDZXJ0cy9EaWdpQ2VydEhpZ2hBc3N1 23 | cmFuY2VFVkNBLTEuY3J0MAwGA1UdEwEB/wQCMAAwYQYDVR0fBFowWDAqoCigJoYk 24 | aHR0cDovL2NybDMuZGlnaWNlcnQuY29tL2V2MjAwOWEuY3JsMCqgKKAmhiRodHRw 25 | Oi8vY3JsNC5kaWdpY2VydC5jb20vZXYyMDA5YS5jcmwwggHEBgNVHSAEggG7MIIB 26 | tzCCAbMGCWCGSAGG/WwCATCCAaQwOgYIKwYBBQUHAgEWLmh0dHA6Ly93d3cuZGln 27 | aWNlcnQuY29tL3NzbC1jcHMtcmVwb3NpdG9yeS5odG0wggFkBggrBgEFBQcCAjCC 28 | AVYeggFSAEEAbgB5ACAAdQBzAGUAIABvAGYAIAB0AGgAaQBzACAAQwBlAHIAdABp 29 | AGYAaQBjAGEAdABlACAAYwBvAG4AcwB0AGkAdAB1AHQAZQBzACAAYQBjAGMAZQBw 30 | AHQAYQBuAGMAZQAgAG8AZgAgAHQAaABlACAARABpAGcAaQBDAGUAcgB0ACAAQwBQ 31 | AC8AQwBQAFMAIABhAG4AZAAgAHQAaABlACAAUgBlAGwAeQBpAG4AZwAgAFAAYQBy 32 | AHQAeQAgAEEAZwByAGUAZQBtAGUAbgB0ACAAdwBoAGkAYwBoACAAbABpAG0AaQB0 33 | ACAAbABpAGEAYgBpAGwAaQB0AHkAIABhAG4AZAAgAGEAcgBlACAAaQBuAGMAbwBy 34 | AHAAbwByAGEAdABlAGQAIABoAGUAcgBlAGkAbgAgAGIAeQAgAHIAZQBmAGUAcgBl 35 | AG4AYwBlAC4wHQYDVR0lBBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMBEGCWCGSAGG 36 | +EIBAQQEAwIGwDAOBgNVHQ8BAf8EBAMCBaAwDQYJKoZIhvcNAQEFBQADggEBABRS 37 | cR+GnW01Poa7ZhqLhZi5AEzLQrVG/AbnRDnI6FLYERQjs3KW6RSUni8AKPfVBEVA 38 | AMb0V0JC3gmJlxENFFxrvQv3GKNfZwLzCThjv8ESnTC6jqVUdFlTZ6EbUFsm2v0T 39 | flkXv0nvlH5FpP06STLwav+JjalhqaqblkbIHOAYHOb7gvQKq1KmyuhUItnbKj1a 40 | InuA6gcF1PnH8FNZX7t3ft6TcEFOI8t4eXnELurXZioY99HFfOISeIKNHeyCngGi 41 | 5QK+eKG5WVjFTG9PpTG0SVtemB4uOPYZxDmiSvt5BbjyWeUmEnCtwOh1Ix8Y0Qvg 42 | n2Xkw9dJh1tybLEvrG8= 43 | -----END CERTIFICATE----- 44 | 45 | ###### Certificate 2 ###### 46 | -----BEGIN CERTIFICATE----- 47 | MIIG4zCCBcugAwIBAgIQCLuwJUcTS8mxENfBohJZxTANBgkqhkiG9w0BAQUFADBs 48 | MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3 49 | d3cuZGlnaWNlcnQuY29tMSswKQYDVQQDEyJEaWdpQ2VydCBIaWdoIEFzc3VyYW5j 50 | ZSBFViBSb290IENBMB4XDTA2MTExMDAwMDAwMFoXDTIxMTExMDAwMDAwMFowaTEL 51 | MAkGA1UEBhMCVVMxFTATBgNVBAoTDERpZ2lDZXJ0IEluYzEZMBcGA1UECxMQd3d3 52 | LmRpZ2ljZXJ0LmNvbTEoMCYGA1UEAxMfRGlnaUNlcnQgSGlnaCBBc3N1cmFuY2Ug 53 | RVYgQ0EtMTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAPOWYth1bhn/ 54 | PzR8SU8xfg0ETpmB4rOFVZEwscCvcLssqOcYqj9495BoUoYBiJfiOwZlkKq9ZXbC 55 | 7L4QWzd4g2B1Rca9dKq2n6Q6AVAXxDlpufFP74LByvNK28yeUE9NQKM6kOeGZrzw 56 | PnYoTNF1gJ5qNRQ1A57bDIzCKK1Qss72kaPDpQpYSfZ1RGy6+c7pqzoC4E3zrOJ6 57 | 4GAiBTyC01Li85xH+DvYskuTVkq/cKs+6WjIHY9YHSpNXic9rQpZL1oRIEDZaARo 58 | LfTAhAsKG3jf7RpY3PtBWm1r8u0c7lwytlzs16YDMqbo3rcoJ1mIgP97rYlY1R4U 59 | pPKwcNSgPqcCAwEAAaOCA4IwggN+MA4GA1UdDwEB/wQEAwIBhjA7BgNVHSUENDAy 60 | BggrBgEFBQcDAQYIKwYBBQUHAwIGCCsGAQUFBwMDBggrBgEFBQcDBAYIKwYBBQUH 61 | AwgwggHEBgNVHSAEggG7MIIBtzCCAbMGCWCGSAGG/WwCATCCAaQwOgYIKwYBBQUH 62 | AgEWLmh0dHA6Ly93d3cuZGlnaWNlcnQuY29tL3NzbC1jcHMtcmVwb3NpdG9yeS5o 63 | dG0wggFkBggrBgEFBQcCAjCCAVYeggFSAEEAbgB5ACAAdQBzAGUAIABvAGYAIAB0 64 | AGgAaQBzACAAQwBlAHIAdABpAGYAaQBjAGEAdABlACAAYwBvAG4AcwB0AGkAdAB1 65 | AHQAZQBzACAAYQBjAGMAZQBwAHQAYQBuAGMAZQAgAG8AZgAgAHQAaABlACAARABp 66 | AGcAaQBDAGUAcgB0ACAARQBWACAAQwBQAFMAIABhAG4AZAAgAHQAaABlACAAUgBl 67 | AGwAeQBpAG4AZwAgAFAAYQByAHQAeQAgAEEAZwByAGUAZQBtAGUAbgB0ACAAdwBo 68 | AGkAYwBoACAAbABpAG0AaQB0ACAAbABpAGEAYgBpAGwAaQB0AHkAIABhAG4AZAAg 69 | AGEAcgBlACAAaQBuAGMAbwByAHAAbwByAGEAdABlAGQAIABoAGUAcgBlAGkAbgAg 70 | AGIAeQAgAHIAZQBmAGUAcgBlAG4AYwBlAC4wDwYDVR0TAQH/BAUwAwEB/zCBgwYI 71 | KwYBBQUHAQEEdzB1MCQGCCsGAQUFBzABhhhodHRwOi8vb2NzcC5kaWdpY2VydC5j 72 | b20wTQYIKwYBBQUHMAKGQWh0dHA6Ly93d3cuZGlnaWNlcnQuY29tL0NBQ2VydHMv 73 | RGlnaUNlcnRIaWdoQXNzdXJhbmNlRVZSb290Q0EuY3J0MIGPBgNVHR8EgYcwgYQw 74 | QKA+oDyGOmh0dHA6Ly9jcmwzLmRpZ2ljZXJ0LmNvbS9EaWdpQ2VydEhpZ2hBc3N1 75 | cmFuY2VFVlJvb3RDQS5jcmwwQKA+oDyGOmh0dHA6Ly9jcmw0LmRpZ2ljZXJ0LmNv 76 | bS9EaWdpQ2VydEhpZ2hBc3N1cmFuY2VFVlJvb3RDQS5jcmwwHQYDVR0OBBYEFExY 77 | yyXwQU9S9CjIgUObpqig5pLlMB8GA1UdIwQYMBaAFLE+w2kD+L9HAdSYJhoIAu9j 78 | ZCvDMA0GCSqGSIb3DQEBBQUAA4IBAQBQHkOw900pllu7p9MKtbXV0Ceq+a/HJdGV 79 | 1S9aU71CB354ScoL60xV4uovf0mtx//RLT6coGQrUZ6RJii7h7t1fLyh/WZoLkxK 80 | Fsz+Bs8x6oBu5L3oA3L2JbVBg2HQlwonHbP3KzKEj1vnzD/iLGeGlPSyK2xSO2cq 81 | jViVABRGJKwL+smOxyaA39Hhl+P4u2jGnL2+CFQ7EDJ8gR8rKJWoQQrG0DBmtOny 82 | ogBpIAfKgkwez6eYuAzuzRYcvhpj1MCZ9mey8I4XLVjCgKpdlsezKO3w2o62RxuP 83 | ThXxl0wLS6+B1EaUYixDpzwlSBlj8lyqFYl2hIVzkX0oPAmDgrz3 84 | -----END CERTIFICATE----- 85 | 86 | -------------------------------------------------------------------------------- /x509-util/certs/www.twitter.com.pem: -------------------------------------------------------------------------------- 1 | connecting to www.twitter.com on port 443 ... 2 | ###### Certificate 1 ###### 3 | -----BEGIN CERTIFICATE----- 4 | MIIGfDCCBWSgAwIBAgIQHiLHN6ORXj+rZcS1pByuRjANBgkqhkiG9w0BAQUFADCB 5 | ujELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQL 6 | ExZWZXJpU2lnbiBUcnVzdCBOZXR3b3JrMTswOQYDVQQLEzJUZXJtcyBvZiB1c2Ug 7 | YXQgaHR0cHM6Ly93d3cudmVyaXNpZ24uY29tL3JwYSAoYykwNjE0MDIGA1UEAxMr 8 | VmVyaVNpZ24gQ2xhc3MgMyBFeHRlbmRlZCBWYWxpZGF0aW9uIFNTTCBDQTAeFw0x 9 | MjA0MTAwMDAwMDBaFw0xNDA1MTAyMzU5NTlaMIIBFzETMBEGCysGAQQBgjc8AgED 10 | EwJVUzEZMBcGCysGAQQBgjc8AgECEwhEZWxhd2FyZTEdMBsGA1UEDxMUUHJpdmF0 11 | ZSBPcmdhbml6YXRpb24xEDAOBgNVBAUTBzQzMzc0NDYxCzAJBgNVBAYTAlVTMQ4w 12 | DAYDVQQRFAU5NDEwNzETMBEGA1UECBMKQ2FsaWZvcm5pYTEWMBQGA1UEBxQNU2Fu 13 | IEZyYW5jaXNjbzEhMB8GA1UECRQYNzk1IEZvbHNvbSBTdCwgU3VpdGUgNjAwMRYw 14 | FAYDVQQKFA1Ud2l0dGVyLCBJbmMuMRkwFwYDVQQLFBBUd2l0dGVyIFNlY3VyaXR5 15 | MRQwEgYDVQQDFAt0d2l0dGVyLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC 16 | AQoCggEBAL7pd7TChZF0U21aCfxUIzdUHm4siWxcQ678xRerDI2hXmThiUyVKnHS 17 | CeSB+gDBXG4qoRHSEcwq7J1YhFscsKz6o4ktsWLqVowGSWNbW92ZbtjOGkTD3xdp 18 | O8Fqfgcs5Lq1yK517nrbtEp6OXEWcoWv15voP4wV7Z9HjCP6v5N1MmrPN187wDMH 19 | W1meJqxQ/7LiULgVQMVV/U6qLOhUeNpl/06CqxScU1bfnbep5SohUG+z6d8CUaPX 20 | 55EhGtAPzXNJAHDSkiNgSKkPr1USJ9YiXusqmjcPChRfkT77kROjWnxgV+oucF+T 21 | ja+Ist8acKy2sgCidhUyuXCWG44bIf8CAwEAAaOCAhwwggIYMCcGA1UdEQQgMB6C 22 | D3d3dy50d2l0dGVyLmNvbYILdHdpdHRlci5jb20wCQYDVR0TBAIwADAdBgNVHQ4E 23 | FgQUtXiQRnmvbuddQEjER8bw4CjBMYQwCwYDVR0PBAQDAgWgMEIGA1UdHwQ7MDkw 24 | N6A1oDOGMWh0dHA6Ly9FVlNlY3VyZS1jcmwudmVyaXNpZ24uY29tL0VWU2VjdXJl 25 | MjAwNi5jcmwwRAYDVR0gBD0wOzA5BgtghkgBhvhFAQcXBjAqMCgGCCsGAQUFBwIB 26 | FhxodHRwczovL3d3dy52ZXJpc2lnbi5jb20vcnBhMB0GA1UdJQQWMBQGCCsGAQUF 27 | BwMBBggrBgEFBQcDAjAfBgNVHSMEGDAWgBT8ilC6nrklWntVhU+VAGOP6VhrQzB8 28 | BggrBgEFBQcBAQRwMG4wLQYIKwYBBQUHMAGGIWh0dHA6Ly9FVlNlY3VyZS1vY3Nw 29 | LnZlcmlzaWduLmNvbTA9BggrBgEFBQcwAoYxaHR0cDovL0VWU2VjdXJlLWFpYS52 30 | ZXJpc2lnbi5jb20vRVZTZWN1cmUyMDA2LmNlcjBuBggrBgEFBQcBDARiMGChXqBc 31 | MFowWDBWFglpbWFnZS9naWYwITAfMAcGBSsOAwIaBBRLa7kolgYMu9BSOJsprEsH 32 | iyEFGDAmFiRodHRwOi8vbG9nby52ZXJpc2lnbi5jb20vdnNsb2dvMS5naWYwDQYJ 33 | KoZIhvcNAQEFBQADggEBAAqg81oADEdE+/Clm4Q43avFTkpuHkpYbu0bDvSVhoMS 34 | n12b0CAtIgY7Sg+kI0/T0PaaDDxy6lEm8YAu/NLNvgXhIEYKxZQ7sUrKrfY+avdM 35 | PumYGkWeQ0xEf0ZLbGCfp9DA+cwxGgZaxT0HdhLhSZOvlw3F3vWezUuriUYacRL6 36 | AW1EzC3uU2zj6T0z2v75Xa8u6AwY6YqAoMJCyR12bc7sGkRoD0ak27DdvP56qh5N 37 | 0tjHHMI1d6IJs0TAO26/SVI7YlQXEstKHk9iJzappwZ/0HZJsepX7jIxvlxyKKGb 38 | 8MQGjSCwx8bY2PbYaLe0rkk2IjH0aMUlHW77DpNAK40= 39 | -----END CERTIFICATE----- 40 | 41 | ###### Certificate 2 ###### 42 | -----BEGIN CERTIFICATE----- 43 | MIIF5DCCBMygAwIBAgIQW3dZxheE4V7HJ8AylSkoazANBgkqhkiG9w0BAQUFADCB 44 | yjELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQL 45 | ExZWZXJpU2lnbiBUcnVzdCBOZXR3b3JrMTowOAYDVQQLEzEoYykgMjAwNiBWZXJp 46 | U2lnbiwgSW5jLiAtIEZvciBhdXRob3JpemVkIHVzZSBvbmx5MUUwQwYDVQQDEzxW 47 | ZXJpU2lnbiBDbGFzcyAzIFB1YmxpYyBQcmltYXJ5IENlcnRpZmljYXRpb24gQXV0 48 | aG9yaXR5IC0gRzUwHhcNMDYxMTA4MDAwMDAwWhcNMTYxMTA3MjM1OTU5WjCBujEL 49 | MAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQLExZW 50 | ZXJpU2lnbiBUcnVzdCBOZXR3b3JrMTswOQYDVQQLEzJUZXJtcyBvZiB1c2UgYXQg 51 | aHR0cHM6Ly93d3cudmVyaXNpZ24uY29tL3JwYSAoYykwNjE0MDIGA1UEAxMrVmVy 52 | aVNpZ24gQ2xhc3MgMyBFeHRlbmRlZCBWYWxpZGF0aW9uIFNTTCBDQTCCASIwDQYJ 53 | KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJjboFXrnP0XeeOabhQdsVuYI4cWbod2 54 | nLU4O7WgerQHYwkZ5iqISKnnnbYwWgiXDOyq5BZpcmIjmvt6VCiYxQwtt9citsj5 55 | OBfH3doxRpqUFI6e7nigtyLUSVSXTeV0W5K87Gws3+fBthsaVWtmCAN/Ra+aM/EQ 56 | wGyZSpIkMQht3QI+YXZ4eLbtfjeubPOJ4bfh3BXMt1afgKCxBX9ONxX/ty8ejwY4 57 | P1C3aSijtWZfNhpSSENmUt+ikk/TGGC+4+peGXEFv54cbGhyJW+ze3PJbb0S/5tB 58 | Ml706H7FC6NMZNFOvCYIZfsZl1h44TO/7Wg+sSdFb8Di7Jdp91zT91ECAwEAAaOC 59 | AdIwggHOMB0GA1UdDgQWBBT8ilC6nrklWntVhU+VAGOP6VhrQzASBgNVHRMBAf8E 60 | CDAGAQH/AgEAMD0GA1UdIAQ2MDQwMgYEVR0gADAqMCgGCCsGAQUFBwIBFhxodHRw 61 | czovL3d3dy52ZXJpc2lnbi5jb20vY3BzMD0GA1UdHwQ2MDQwMqAwoC6GLGh0dHA6 62 | Ly9FVlNlY3VyZS1jcmwudmVyaXNpZ24uY29tL3BjYTMtZzUuY3JsMA4GA1UdDwEB 63 | /wQEAwIBBjARBglghkgBhvhCAQEEBAMCAQYwbQYIKwYBBQUHAQwEYTBfoV2gWzBZ 64 | MFcwVRYJaW1hZ2UvZ2lmMCEwHzAHBgUrDgMCGgQUj+XTGoasjY5rw8+AatRIGCx7 65 | GS4wJRYjaHR0cDovL2xvZ28udmVyaXNpZ24uY29tL3ZzbG9nby5naWYwKQYDVR0R 66 | BCIwIKQeMBwxGjAYBgNVBAMTEUNsYXNzM0NBMjA0OC0xLTQ3MD0GCCsGAQUFBwEB 67 | BDEwLzAtBggrBgEFBQcwAYYhaHR0cDovL0VWU2VjdXJlLW9jc3AudmVyaXNpZ24u 68 | Y29tMB8GA1UdIwQYMBaAFH/TZafC3ey78DAJ80M5+gKvMzEzMA0GCSqGSIb3DQEB 69 | BQUAA4IBAQCWovp/5j3t1CvOtxU/wHIDX4u6FpAl98KD2Md1NGNoElMMU4l7yVYJ 70 | p8M2RE4O0GJis4b66KGbNGeNUyIXPv2s7mcuQ+JdfzOE8qJwwG6Cl8A0/SXGI3/t 71 | 5rDFV0OEst4t8dD2SB8UcVeyrDHhlyQjyRNddOVG7wl8nuGZMQoIeRuPcZ8XZsg4 72 | z+6Ml7YGuXNG5NOUweVgtSV1LdlpMezNlsOjdv3odESsErlNv1HoudRETifLriDR 73 | fip8tmNHnna6l9AW5wtsbfdDbzMLKTB3+p359U64drPNGLT5IO892+bKrZvQTtKH 74 | qQ2mRHNQ3XBb7a1+Srwi1agm5MKFIA3Z 75 | -----END CERTIFICATE----- 76 | 77 | -------------------------------------------------------------------------------- /x509-util/crls/GIAG2.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN X509 CRL----- 2 | MIIBxDCBrQIBATANBgkqhkiG9w0BAQsFADBJMQswCQYDVQQGEwJVUzETMBEGA1UE 3 | ChMKR29vZ2xlIEluYzElMCMGA1UEAxMcR29vZ2xlIEludGVybmV0IEF1dGhvcml0 4 | eSBHMhcNMTgxMjMxMDEwMDAyWhcNMTkwMTEwMDEwMDAyWqAwMC4wHwYDVR0jBBgw 5 | FoAUSt0GFhu89mi1dvWBtrtiGrpagS8wCwYDVR0UBAQCAghsMA0GCSqGSIb3DQEB 6 | CwUAA4IBAQBQaYwesg1HAyZGi4p+x/Q/J8RqFupLulwNTPau0429Cty4SIZn3M/0 7 | mppkO6gMagDnagFedznNvg62tOfXfdmC9r5Nps1UiCUBsB0l8cUNin0w5yYPloz3 8 | KQVvPKmE4jn/GWqhfpCdbluUNXCN6t2KJiMdgZZveB1aQAaVjZ+kmk62iRlZshIR 9 | r+uOghqPzXksu6eL1BZtpEFGcLpxCeeUhz+LcTlDEuk7/E/xTWR65fWl84w6QK8D 10 | x28V1JCTe/2vnfbTrXtDHreeupt6R8XB1yB+CrwLkzVKsQjJ9lSsLtOmRHDxW9fW 11 | jZw4nQyTkqqjrzfHJxw4a1JDgwtGfxMA 12 | -----END X509 CRL----- 13 | -------------------------------------------------------------------------------- /x509-util/crls/rfc5280_CRL.pem: -------------------------------------------------------------------------------- 1 | -----BEGIN X509 CRL----- 2 | MIIBYDCBygIBATANBgkqhkiG9w0BAQUFADBDMRMwEQYKCZImiZPyLGQBGRYDY29t 3 | MRcwFQYKCZImiZPyLGQBGRYHZXhhbXBsZTETMBEGA1UEAxMKRXhhbXBsZSBDQRcN 4 | MDUwMjA1MTIwMDAwWhcNMDUwMjA2MTIwMDAwWjAiMCACARIXDTA0MTExOTE1NTcw 5 | M1owDDAKBgNVHRUEAwoBAaAvMC0wHwYDVR0jBBgwFoAUCGivhTPIOUp6+IKTjnBq 6 | SiCELDIwCgYDVR0UBAMCAQwwDQYJKoZIhvcNAQEFBQADgYEAItwYffcIzsx10NBq 7 | m60Q9HYjtIFutW2+DvsVFGzIF20f7pAXom9g5L2qjFXejoRvkvifEBInr0rUL4Xi 8 | NkR9qqNMJTgV/wD9Pn7uPSYS69jnK2LiK8NGgO94gtEVxtCccmrLznrtZ5mLbnCB 9 | fUNCdMGmr8FVF6IzTNYGmCuk/C4= 10 | -----END X509 CRL----- 11 | -------------------------------------------------------------------------------- /x509-util/src/Certificate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} 2 | 3 | import Data.Either 4 | import qualified Data.ByteArray as BA 5 | import qualified Data.ByteString as B 6 | import Data.X509 7 | import qualified Data.X509 as X509 8 | import qualified Data.X509.EC as X509 9 | import Data.List (find) 10 | import Data.PEM (pemParseBS, pemContent, pemName) 11 | import System.Console.GetOpt 12 | import System.Environment 13 | import Control.Monad 14 | import Control.Applicative ((<$>)) 15 | import Data.Maybe 16 | import System.Exit 17 | import System.X509 18 | import Data.X509.CertificateStore 19 | import Data.X509.Validation 20 | import Data.Hourglass 21 | 22 | -- for signing/verifying certificate 23 | import Crypto.Hash 24 | import qualified Crypto.PubKey.RSA as RSA 25 | import qualified Crypto.PubKey.RSA.PKCS15 as RSA 26 | import qualified Crypto.PubKey.DSA as DSA 27 | import qualified Crypto.PubKey.ECC.Types as ECC 28 | 29 | import Data.ASN1.Encoding 30 | import Data.ASN1.BinaryEncoding 31 | import Data.ASN1.Types 32 | import Data.ASN1.BitArray 33 | import Data.X509.Memory 34 | import Text.Printf 35 | import Numeric 36 | 37 | formatValidity (start,end) = p start ++ " to " ++ p end 38 | where p t = timePrint ("YYYY-MM-DD H:MI:S" :: String) t 39 | 40 | hexdump :: BA.ByteArrayAccess ba => ba -> String 41 | hexdump bs = concatMap hex $ BA.unpack bs 42 | where hex n 43 | | n > 0xf = showHex n "" 44 | | otherwise = "0" ++ showHex n "" 45 | 46 | hexdump' = hexdump 47 | 48 | tryUnserializePoint :: Maybe ECC.Curve 49 | -> SerializedPoint 50 | -> Either B.ByteString (Integer, Integer) 51 | tryUnserializePoint mcurve pt@(SerializedPoint bs) = 52 | case mcurve >>= flip X509.unserializePoint pt of 53 | Nothing -> Left bs 54 | Just (ECC.Point x y) -> Right (x, y) 55 | Just ECC.PointO -> error "unserializePoint returned PointO" 56 | 57 | showDN (X509.DistinguishedName dn) = mapM_ toStr dn 58 | where toStr (oid, cs@(ASN1CharacterString e t)) = 59 | putStrLn (" " ++ key ++ ": " ++ value) 60 | where key = show oid 61 | value = case asn1CharacterToString cs of 62 | Nothing -> show e ++ " " ++ show t ++ " (decoding to string failed)" 63 | Just s -> show s ++ " (encoding : " ++ show e ++ ")" 64 | 65 | showExts es@(Extensions Nothing) = do 66 | return () 67 | showExts es@(Extensions (Just exts)) = do 68 | mapM_ showExt exts 69 | putStrLn "known extensions decoded: " 70 | showKnownExtension "basic-constraint" (X509.extensionGetE es :: Maybe (Either String X509.ExtBasicConstraints)) 71 | showKnownExtension "key-usage" (X509.extensionGetE es :: Maybe (Either String X509.ExtKeyUsage)) 72 | showKnownExtension "extended-key-usage" (X509.extensionGetE es :: Maybe (Either String X509.ExtExtendedKeyUsage)) 73 | showKnownExtension "subject-key-id" (X509.extensionGetE es :: Maybe (Either String X509.ExtSubjectKeyId)) 74 | showKnownExtension "subject-alt-name" (X509.extensionGetE es :: Maybe (Either String X509.ExtSubjectAltName)) 75 | showKnownExtension "authority-key-id" (X509.extensionGetE es :: Maybe (Either String X509.ExtAuthorityKeyId)) 76 | where 77 | showExt er = do 78 | putStrLn (" OID: " ++ show (extRawOID er) ++ " critical: " ++ show (extRawCritical er)) 79 | either (\e -> putStrLn $ "ASN1 decoding failed: " ++ e) (showASN1 8) $ tryExtRawASN1 er 80 | showKnownExtension _ Nothing = return () 81 | showKnownExtension n (Just (Left e)) = putStrLn (" " ++ n ++ ": ERROR: " ++ show e) 82 | showKnownExtension _ (Just (Right e)) = putStrLn (" " ++ show e) 83 | 84 | showCertSmall :: SignedCertificate -> IO () 85 | showCertSmall signedCert = do 86 | putStrLn "subject: " 87 | showDN $ X509.certSubjectDN cert 88 | putStrLn ("valid: " ++ formatValidity (X509.certValidity cert)) 89 | case X509.certPubKey cert of 90 | X509.PubKeyRSA pubkey -> printf "public key: RSA (%d bits)\n" (RSA.public_size pubkey * 8) 91 | X509.PubKeyDSA pubkey -> printf "public key: DSA\n" 92 | X509.PubKeyEC (PubKeyEC_Named name _) -> printf "public key: ECDSA (curve %s)\n" (show name) 93 | X509.PubKeyEC _ -> printf "public key: ECDSA (explicit curve)\n" 94 | X509.PubKeyX25519 _ -> printf "public key: ECDH (curve25519)\n" 95 | X509.PubKeyX448 _ -> printf "public key: ECDH (curve448)\n" 96 | X509.PubKeyEd25519 _ -> printf "public key: EdDSA (edwards25519)\n" 97 | X509.PubKeyEd448 _ -> printf "public key: EdDSA (edwards448)\n" 98 | X509.PubKeyUnknown oid ws -> printf "public key: unknown: %s\n" (show oid) 99 | pk -> printf "public key: %s\n" (show pk) 100 | where 101 | signed = X509.getSigned signedCert 102 | --sigalg = X509.signedAlg signed 103 | --sigbits = X509.signedSignature signed 104 | cert = X509.signedObject signed 105 | 106 | showCert :: SignedCertificate -> IO () 107 | showCert signedCert = do 108 | putStrLn ("version: " ++ show (X509.certVersion cert)) 109 | putStrLn ("serial: " ++ show (X509.certSerial cert)) 110 | putStrLn ("sigalg: " ++ show (X509.certSignatureAlg cert)) 111 | putStrLn "issuer:" 112 | showDN $ X509.certIssuerDN cert 113 | putStrLn "subject:" 114 | showDN $ X509.certSubjectDN cert 115 | putStrLn ("valid: " ++ formatValidity (X509.certValidity cert)) 116 | case X509.certPubKey cert of 117 | X509.PubKeyRSA pubkey -> do 118 | putStrLn "public key RSA:" 119 | printf " len : %d bits\n" (RSA.public_size pubkey * 8) 120 | printf " modulus: %x\n" (RSA.public_n pubkey) 121 | printf " e : %x\n" (RSA.public_e pubkey) 122 | X509.PubKeyDSA pubkey -> do 123 | let params = DSA.public_params pubkey 124 | putStrLn "public key DSA:" 125 | printf " pub : %x\n" (DSA.public_y pubkey) 126 | printf " p : %d\n" (DSA.params_p params) 127 | printf " q : %x\n" (DSA.params_q params) 128 | printf " g : %x\n" (DSA.params_g params) 129 | X509.PubKeyEC pubkey@PubKeyEC_Named{} -> do 130 | let curveName = pubkeyEC_name pubkey 131 | let curve = ECC.getCurveByName curveName 132 | putStrLn "public key ECDSA:" 133 | printf " curve : %s\n" (show curveName) 134 | case tryUnserializePoint (Just curve) (pubkeyEC_pub pubkey) of 135 | Right (x, y) -> do printf " point : %x\n" x 136 | printf " %x\n" y 137 | Left xy -> printf " point : %s\n" (hexdump xy) 138 | X509.PubKeyEC pubkey@PubKeyEC_Prime{} -> do 139 | let mcurve = X509.ecPubKeyCurve pubkey 140 | putStrLn "public key ECDSA:" 141 | case tryUnserializePoint mcurve (pubkeyEC_pub pubkey) of 142 | Right (x, y) -> do printf " point : %x\n" x 143 | printf " %x\n" y 144 | Left xy -> printf " point : %s\n" (hexdump xy) 145 | printf " a : %x\n" (pubkeyEC_a pubkey) 146 | printf " b : %x\n" (pubkeyEC_b pubkey) 147 | printf " p : %x\n" (pubkeyEC_prime pubkey) 148 | case tryUnserializePoint mcurve (pubkeyEC_generator pubkey) of 149 | Right (x, y) -> do printf " g : %x\n" x 150 | printf " %x\n" y 151 | Left xy -> printf " g : %s\n" (hexdump xy) 152 | printf " n : %x\n" (pubkeyEC_order pubkey) 153 | printf " h : %x\n" (pubkeyEC_cofactor pubkey) 154 | printf " seed : %x\n" (pubkeyEC_seed pubkey) 155 | X509.PubKeyX25519 pubkey -> showPubHexdump "X25519" pubkey 156 | X509.PubKeyX448 pubkey -> showPubHexdump "X448" pubkey 157 | X509.PubKeyEd25519 pubkey -> showPubHexdump "Ed25519" pubkey 158 | X509.PubKeyEd448 pubkey -> showPubHexdump "Ed448" pubkey 159 | X509.PubKeyUnknown oid ws -> do 160 | printf "public key unknown: %s\n" (show oid) 161 | printf " raw bytes: %s\n" (show ws) 162 | pk -> 163 | printf "public key: %s\n" (show pk) 164 | case X509.certExtensions cert of 165 | (Extensions Nothing) -> return () 166 | (Extensions (Just es)) -> putStrLn "extensions:" >> showExts (X509.certExtensions cert) 167 | putStrLn ("sigAlg: " ++ show sigalg) 168 | putStrLn ("sig: " ++ show sigbits) 169 | where 170 | signed = X509.getSigned signedCert 171 | sigalg = X509.signedAlg signed 172 | sigbits = X509.signedSignature signed 173 | cert = X509.signedObject signed 174 | 175 | showPubHexdump :: BA.ByteArrayAccess public => String -> public -> IO () 176 | showPubHexdump alg pubkey = do 177 | printf "public key %s:\n" alg 178 | printf " pub : %s\n" (hexdump pubkey) 179 | 180 | showRSAKey :: RSA.PrivateKey -> String 181 | showRSAKey privkey = unlines 182 | [ "len-modulus: " ++ (show $ RSA.public_size pubkey) 183 | , "modulus: " ++ (show $ RSA.public_n pubkey) 184 | , "public exponent: " ++ (show $ RSA.public_e pubkey) 185 | , "private exponent: " ++ (show $ RSA.private_d privkey) 186 | , "p1: " ++ (show $ RSA.private_p privkey) 187 | , "p2: " ++ (show $ RSA.private_q privkey) 188 | , "exp1: " ++ (show $ RSA.private_dP privkey) 189 | , "exp2: " ++ (show $ RSA.private_dQ privkey) 190 | , "coefficient: " ++ (show $ RSA.private_qinv privkey) 191 | ] 192 | where pubkey = RSA.private_pub privkey 193 | 194 | showDSAKey :: DSA.PrivateKey -> String 195 | showDSAKey (DSA.PrivateKey params privnum) = unlines 196 | [ "priv " ++ (printf "%x" $ privnum) 197 | , "p: " ++ (printf "%x" $ DSA.params_p params) 198 | , "q: " ++ (printf "%x" $ DSA.params_q params) 199 | , "g: " ++ (printf "%x" $ DSA.params_g params) 200 | ] 201 | 202 | showECKey :: PrivKeyEC -> String 203 | showECKey privkey@PrivKeyEC_Named{} = unlines 204 | [ "priv: " ++ (printf "%x" $ privkeyEC_priv privkey) 205 | , "curve: " ++ (show $ privkeyEC_name privkey) 206 | ] 207 | showECKey privkey@PrivKeyEC_Prime{} = unlines $ 208 | [ "priv: " ++ (printf "%x" $ privkeyEC_priv privkey) 209 | , "a: " ++ (printf "%x" $ privkeyEC_a privkey) 210 | , "b: " ++ (printf "%x" $ privkeyEC_b privkey) 211 | , "prime: " ++ (printf "%x" $ privkeyEC_prime privkey) 212 | ] ++ showGenerator ++ 213 | [ "order: " ++ (printf "%x" $ privkeyEC_order privkey) 214 | , "cofactor: " ++ (printf "%x" $ privkeyEC_cofactor privkey) 215 | , "seed: " ++ (printf "%x" $ privkeyEC_seed privkey) 216 | ] 217 | where 218 | showGenerator = do 219 | case tryUnserializePoint mcurve (privkeyEC_generator privkey) of 220 | Right (x, y) -> [ "generator:" ++ (printf "%x" x) 221 | , " " ++ (printf "%x" y) 222 | ] 223 | Left xy -> [ "generator:" ++ (show $ hexdump xy) 224 | ] 225 | mcurve = X509.ecPrivKeyCurve privkey 226 | 227 | showPrivHexdump :: BA.ByteArrayAccess secret => secret -> String 228 | showPrivHexdump privkey = unlines 229 | [ "priv: " ++ hexdump privkey 230 | ] 231 | 232 | showASN1 :: Int -> [ASN1] -> IO () 233 | showASN1 at = prettyPrint at 234 | where 235 | indent n = putStr (replicate n ' ') 236 | 237 | prettyPrint n [] = return () 238 | prettyPrint n (x@(Start _) : xs) = indent n >> p x >> putStrLn "" >> prettyPrint (n+1) xs 239 | prettyPrint n (x@(End _) : xs) = indent (n-1) >> p x >> putStrLn "" >> prettyPrint (n-1) xs 240 | prettyPrint n (x : xs) = indent n >> p x >> putStrLn "" >> prettyPrint n xs 241 | 242 | p (Boolean b) = putStr ("bool: " ++ show b) 243 | p (IntVal i) = putStr ("int: " ++ showHex i "") 244 | p (BitString bits) = putStr ("bitstring: " ++ (hexdump $ bitArrayGetData bits)) 245 | p (OctetString bs) = putStr ("octetstring: " ++ hexdump bs) 246 | p (Null) = putStr "null" 247 | p (OID is) = putStr ("OID: " ++ show is) 248 | p (Real d) = putStr "real" 249 | p (Enumerated _) = putStr "enum" 250 | p (Start Sequence) = putStr "{" 251 | p (End Sequence) = putStr "}" 252 | p (Start Set) = putStr "[" 253 | p (End Set) = putStr "]" 254 | p (Start (Container x y)) = putStr ("< " ++ show x ++ " " ++ show y) 255 | p (End (Container x y)) = putStr ("> " ++ show x ++ " " ++ show y) 256 | p (ASN1String cs) = putCS cs 257 | p (ASN1Time TimeUTC time tz) = putStr ("utctime: " ++ show time) 258 | p (ASN1Time TimeGeneralized time tz) = putStr ("generalizedtime: " ++ show time) 259 | p (Other tc tn x) = putStr ("other(" ++ show tc ++ "," ++ show tn ++ ")") 260 | 261 | putCS (ASN1CharacterString UTF8 t) = putStr ("utf8string:" ++ show t) 262 | putCS (ASN1CharacterString Numeric bs) = putStr "numericstring:" 263 | putCS (ASN1CharacterString Printable t) = putStr ("printablestring: " ++ show t) 264 | putCS (ASN1CharacterString T61 bs) = putStr ("t61string:" ++ show bs) 265 | putCS (ASN1CharacterString VideoTex bs) = putStr "videotexstring:" 266 | putCS (ASN1CharacterString IA5 bs) = putStr ("ia5string:" ++ show bs) 267 | putCS (ASN1CharacterString Graphic bs) = putStr "graphicstring:" 268 | putCS (ASN1CharacterString Visible bs) = putStr "visiblestring:" 269 | putCS (ASN1CharacterString General bs) = putStr "generalstring:" 270 | putCS (ASN1CharacterString UTF32 t) = putStr ("universalstring:" ++ show t) 271 | putCS (ASN1CharacterString Character bs) = putStr "characterstring:" 272 | putCS (ASN1CharacterString BMP t) = putStr ("bmpstring: " ++ show t) 273 | 274 | data X509Opts = 275 | DumpedRaw 276 | | DumpedText 277 | | ShowHash 278 | | Validate 279 | | ValidationHost String 280 | | Help 281 | deriving (Show,Eq) 282 | 283 | readPEMFile file = do 284 | content <- B.readFile file 285 | return $ either error id $ pemParseBS content 286 | 287 | readSignedObject file = do 288 | content <- B.readFile file 289 | return $ either error (map (X509.decodeSignedObject . pemContent)) $ pemParseBS content 290 | 291 | doCertMain opts files = do 292 | when (Help `elem` opts) $ do 293 | putStrLn $ usageInfo "usage: x509-util cert [options] " optionsCert 294 | exitSuccess 295 | objs <- readSignedObject (head files) 296 | forM_ objs $ \o -> 297 | case o of 298 | Left err -> error ("decoding Certificate failed: " ++ show err) 299 | Right signed -> do 300 | showCert signed 301 | when (ShowHash `elem` opts) $ hashCert signed 302 | when (Validate `elem` opts) $ do 303 | let cc = CertificateChain (rights objs) 304 | store <- getSystemCertificateStore 305 | failed <- validate HashSHA1 defaultHooks validationChecks store (exceptionValidationCache []) 306 | (maybe ("", "") (\f -> (f,"")) fqhn) cc 307 | if failed /= [] 308 | then putStrLn ("validation failed: " ++ show failed) 309 | else putStrLn "validation success" 310 | where 311 | hashCert signedCert = do 312 | putStrLn ("subject(MD5) old: " ++ hexdump' (X509.hashDN_old subject)) 313 | putStrLn ("issuer(MD5) old: " ++ hexdump' (X509.hashDN_old issuer)) 314 | putStrLn ("subject(SHA1): " ++ hexdump' (X509.hashDN subject)) 315 | putStrLn ("issuer(SHA1): " ++ hexdump' (X509.hashDN issuer)) 316 | where 317 | subject = X509.certSubjectDN cert 318 | issuer = X509.certIssuerDN cert 319 | cert = X509.signedObject $ X509.getSigned signedCert 320 | validationChecks = defaultChecks { checkExhaustive = True, checkFQHN = isJust fqhn } 321 | fqhn = foldl accHost Nothing opts 322 | accHost Nothing (ValidationHost h) = Just h 323 | accHost a _ = a 324 | 325 | doCRLMain opts files = do 326 | readSignedObject (head files) >>= \objs -> forM_ objs $ \o -> 327 | case o of 328 | Left err -> error ("decoding CRL failed: " ++ show err) 329 | Right signed -> do 330 | putStrLn $ show $ getCRL signed 331 | 332 | doASN1Main files = do 333 | pem <- readPEMFile (head files) 334 | forM_ pem $ \p -> 335 | case decodeASN1' BER $ pemContent p of 336 | Left err -> error ("decoding ASN1 failed: " ++ show err) 337 | Right asn1 -> showASN1 0 asn1 338 | 339 | doKeyMain files = do 340 | pems <- readPEMFile (head files) 341 | forM_ pems $ \pem -> do 342 | let content = either (error . show) id $ decodeASN1' BER (pemContent pem) 343 | privkey = catMaybes $ pemToKey [] pem 344 | case privkey of 345 | [X509.PrivKeyRSA k] -> 346 | putStrLn "RSA KEY" >> putStrLn (showRSAKey k) 347 | [X509.PrivKeyDSA k] -> 348 | putStrLn "DSA KEY" >> putStrLn (showDSAKey k) 349 | [X509.PrivKeyEC k] -> 350 | putStrLn "EC KEY" >> putStrLn (showECKey k) 351 | [X509.PrivKeyX25519 k] -> 352 | putStrLn "X25519 KEY" >> putStrLn (showPrivHexdump k) 353 | [X509.PrivKeyX448 k] -> 354 | putStrLn "X448 KEY" >> putStrLn (showPrivHexdump k) 355 | [X509.PrivKeyEd25519 k] -> 356 | putStrLn "Ed25519 KEY" >> putStrLn (showPrivHexdump k) 357 | [X509.PrivKeyEd448 k] -> 358 | putStrLn "Ed448 KEY" >> putStrLn (showPrivHexdump k) 359 | _ -> error "private key unknown" 360 | 361 | doSystemMain _ = do 362 | store <- getSystemCertificateStore 363 | let certs = listCertificates store 364 | mapM_ showCertSmall certs 365 | putStrLn $ replicate 72 '=' 366 | putStrLn $ show (length certs) ++ " certificates loaded" 367 | 368 | optionsCert = 369 | [ Option [] ["hash"] (NoArg ShowHash) "output certificate hash" 370 | , Option ['v'] ["validate"] (NoArg Validate) "validate certificate" 371 | , Option [] ["validation-host"] (ReqArg ValidationHost "host") "validation host use for validation" 372 | , Option ['h'] ["help"] (NoArg Help) "show help" 373 | ] 374 | 375 | certMain = getoptMain optionsCert $ \o n -> doCertMain o n 376 | crlMain = getoptMain [] $ \o n -> doCRLMain o n 377 | keyMain = getoptMain [] $ \o n -> doKeyMain n 378 | asn1Main = getoptMain [] $ \o n -> doASN1Main n 379 | 380 | systemMain = getoptMain [] $ \o n -> doSystemMain n 381 | 382 | 383 | getoptMain :: [OptDescr a] -> ([a] -> [String] -> IO ()) -> [String] -> IO () 384 | getoptMain opts f as = 385 | case getOpt Permute opts as of 386 | (o,n,[]) -> f o n 387 | (_,_,err) -> error (show err) 388 | 389 | usage = do 390 | putStrLn "usage: x509-util " 391 | putStrLn " key : process private key" 392 | putStrLn " cert: process X509 certificate" 393 | putStrLn " crl : process CRL certificate" 394 | putStrLn " asn1: show file asn1" 395 | putStrLn " system: show system certificates" 396 | 397 | main = do 398 | args <- getArgs 399 | case args of 400 | [] -> usage 401 | "x509":as -> certMain as 402 | "cert":as -> certMain as 403 | "key":as -> keyMain as 404 | "crl":as -> crlMain as 405 | "asn1":as -> asn1Main as 406 | "system":as -> systemMain as 407 | _ -> usage 408 | -------------------------------------------------------------------------------- /x509-util/tests/Generate.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Process 4 | 5 | data KeyType = RSA | DSA | ECDSA 6 | deriving (Show,Eq) 7 | 8 | data OpenSSLKey = OpenSSLKey KeyType String Int 9 | deriving (Show,Eq) 10 | 11 | data OpenSSLCSR = OpenSSLCSR 12 | { csrPrivateKey :: OpenSSLKey 13 | , csrFile :: String 14 | , csrInfo :: OpenSSLCSRInfo 15 | } deriving (Show,Eq) 16 | 17 | data OpenSSLCSRInfo = OpenSSLCSRInfo 18 | { csrCountryName :: String 19 | , csrState :: String 20 | , csrLocality :: String 21 | , csrOrganizationName :: String 22 | , csrOrganizationUName :: String 23 | , csrCommonName :: String 24 | , csrEmailAddress :: String 25 | } deriving (Show,Eq) 26 | 27 | createKey (OpenSSLKey keyType keyName keyBits) = 28 | case keyType of 29 | RSA -> readProcess "openssl" ["genrsa","-out",keyName,show keyBits] "" 30 | DSA -> readProcess "openssl" ["dsaparam","-genkey", show keyBits,"-out",keyName] "" 31 | ECDSA -> undefined 32 | 33 | createPub (OpenSSLKey keyType keyName _) pubName = 34 | case keyType of 35 | RSA -> readProcess "openssl" [ "rsa", "-in", keyName, "-pubout", "-out", pubName ] "" 36 | DSA -> readProcess "openssl" [ "dsa", "-in", keyName, "-pubout", "-out", pubName ] "" 37 | _ -> undefined 38 | 39 | createCSR (OpenSSLCSR (OpenSSLKey _ keyName _) csrFile csrInfo) = 40 | readProcess "openssl" ["req", "-new", "-key", keyName, "-out", csrFile] input 41 | where input = unlines 42 | [ csrCountryName csrInfo 43 | , csrState csrInfo 44 | , csrLocality csrInfo 45 | , csrOrganizationName csrInfo 46 | , csrOrganizationUName csrInfo 47 | , csrCommonName csrInfo 48 | , csrEmailAddress csrInfo 49 | , "" 50 | , "" 51 | ] 52 | 53 | createCert csrFile (OpenSSLKey _ keyName _) certFile = 54 | readProcess "openssl" [ "x509", "-req", "-days", "365", "-in", csrFile, "-signkey", keyName, "-out", certFile ] "" 55 | 56 | defaultCSRInfo = OpenSSLCSRInfo "AU" "" "Somewhere" "MyOrganization" "MyOrganizationUname" "my.common.name" "postmaster@common.name" 57 | 58 | main = do 59 | let rsaKey = OpenSSLKey RSA "rsa.priv" 1024 60 | dsaKey = OpenSSLKey DSA "dsa.priv" 1024 61 | createKey rsaKey 62 | createKey dsaKey 63 | 64 | createPub rsaKey "rsa.pub" 65 | createPub dsaKey "dsa.pub" 66 | 67 | createCSR (OpenSSLCSR dsaKey "cert.csr" defaultCSRInfo) 68 | 69 | createCert "cert.csr" dsaKey "cert.dsa.x509" 70 | createCert "cert.csr" rsaKey "cert.rsa.x509" 71 | -------------------------------------------------------------------------------- /x509-util/x509-util.cabal: -------------------------------------------------------------------------------- 1 | Name: x509-util 2 | version: 1.6.6 3 | Description: utility to parse, show, validate, sign and produce X509 certificates and chain. 4 | License: BSD3 5 | License-file: LICENSE 6 | Copyright: Vincent Hanquez 7 | Author: Vincent Hanquez 8 | Maintainer: Vincent Hanquez 9 | Synopsis: Utility for X509 certificate and chain 10 | Build-Type: Simple 11 | Category: Data 12 | stability: experimental 13 | Homepage: http://github.com/vincenthz/hs-certificate 14 | Cabal-Version: >= 1.10 15 | 16 | Executable x509-util 17 | Default-Language: Haskell2010 18 | Main-Is: Certificate.hs 19 | hs-source-dirs: src 20 | Buildable: True 21 | Build-depends: base >= 3 && < 5 22 | , bytestring 23 | , x509 >= 1.7.1 24 | , x509-store 25 | , x509-system 26 | , x509-validation >= 1.6.3 27 | , asn1-types >= 0.3 28 | , asn1-encoding 29 | , pem 30 | , directory 31 | , hourglass 32 | , memory 33 | , cryptonite 34 | 35 | source-repository head 36 | type: git 37 | location: git://github.com/vincenthz/hs-certificate 38 | subdir: x509-util 39 | -------------------------------------------------------------------------------- /x509-validation/Data/X509/Validation/Cache.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Validation.Cache 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- X.509 Validation cache 9 | -- 10 | -- Define all the types necessary for the validation cache, 11 | -- and some simples instances of cache mechanism 12 | module Data.X509.Validation.Cache 13 | ( 14 | -- * Cache for validation 15 | ValidationCacheResult(..) 16 | , ValidationCacheQueryCallback 17 | , ValidationCacheAddCallback 18 | , ValidationCache(..) 19 | -- * Simple instances of cache mechanism 20 | , exceptionValidationCache 21 | , tofuValidationCache 22 | ) where 23 | 24 | import Control.Concurrent 25 | import Data.Default.Class 26 | import Data.X509 27 | import Data.X509.Validation.Types 28 | import Data.X509.Validation.Fingerprint 29 | 30 | -- | The result of a cache query 31 | data ValidationCacheResult = 32 | ValidationCachePass -- ^ cache allow this fingerprint to go through 33 | | ValidationCacheDenied String -- ^ cache denied this fingerprint for further validation 34 | | ValidationCacheUnknown -- ^ unknown fingerprint in cache 35 | deriving (Show,Eq) 36 | 37 | -- | Validation cache query callback type 38 | type ValidationCacheQueryCallback = ServiceID -- ^ connection's identification 39 | -> Fingerprint -- ^ fingerprint of the leaf certificate 40 | -> Certificate -- ^ leaf certificate 41 | -> IO ValidationCacheResult -- ^ return if the operation is succesful or not 42 | 43 | -- | Validation cache callback type 44 | type ValidationCacheAddCallback = ServiceID -- ^ connection's identification 45 | -> Fingerprint -- ^ fingerprint of the leaf certificate 46 | -> Certificate -- ^ leaf certificate 47 | -> IO () 48 | 49 | -- | All the callbacks needed for querying and adding to the cache. 50 | data ValidationCache = ValidationCache 51 | { cacheQuery :: ValidationCacheQueryCallback -- ^ cache querying callback 52 | , cacheAdd :: ValidationCacheAddCallback -- ^ cache adding callback 53 | } 54 | 55 | instance Default ValidationCache where 56 | def = exceptionValidationCache [] 57 | 58 | -- | create a simple constant cache that list exceptions to the certification 59 | -- validation. Typically this is use to allow self-signed certificates for 60 | -- specific use, with out-of-bounds user checks. 61 | -- 62 | -- No fingerprints will be added after the instance is created. 63 | -- 64 | -- The underlying structure for the check is kept as a list, as 65 | -- usually the exception list will be short, but when the list go above 66 | -- a dozen exceptions it's recommended to use another cache mechanism with 67 | -- a faster lookup mechanism (hashtable, map, etc). 68 | -- 69 | -- Note that only one fingerprint is allowed per ServiceID, for other use, 70 | -- another cache mechanism need to be use. 71 | exceptionValidationCache :: [(ServiceID, Fingerprint)] -> ValidationCache 72 | exceptionValidationCache fingerprints = 73 | ValidationCache (queryListCallback fingerprints) 74 | (\_ _ _ -> return ()) 75 | 76 | -- | Trust on first use (TOFU) cache with an optional list of exceptions 77 | -- 78 | -- this is similar to the exceptionCache, except that after 79 | -- each succesfull validation it does add the fingerprint 80 | -- to the database. This prevent any further modification of the 81 | -- fingerprint for the remaining 82 | tofuValidationCache :: [(ServiceID, Fingerprint)] -- ^ a list of exceptions 83 | -> IO ValidationCache 84 | tofuValidationCache fingerprints = do 85 | l <- newMVar fingerprints 86 | return $ ValidationCache (\s f c -> readMVar l >>= \list -> (queryListCallback list) s f c) 87 | (\s f _ -> modifyMVar_ l (\list -> return ((s,f) : list))) 88 | 89 | -- | a cache query function working on list. 90 | -- don't use when the list grows a lot. 91 | queryListCallback :: [(ServiceID, Fingerprint)] -> ValidationCacheQueryCallback 92 | queryListCallback list = query 93 | where query serviceID fingerprint _ = return $ 94 | case lookup serviceID list of 95 | Nothing -> ValidationCacheUnknown 96 | Just f | fingerprint == f -> ValidationCachePass 97 | | otherwise -> ValidationCacheDenied (show serviceID ++ " expected " ++ show f ++ " but got: " ++ show fingerprint) 98 | 99 | -------------------------------------------------------------------------------- /x509-validation/Data/X509/Validation/Fingerprint.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Validation.Fingerprint 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 9 | module Data.X509.Validation.Fingerprint 10 | ( Fingerprint(..) 11 | , getFingerprint 12 | ) where 13 | 14 | import Crypto.Hash 15 | import Data.X509 16 | import Data.ASN1.Types 17 | import Data.ByteArray (convert, ByteArrayAccess) 18 | import Data.ByteString (ByteString) 19 | 20 | -- | Fingerprint of a certificate 21 | newtype Fingerprint = Fingerprint ByteString 22 | deriving (Show,Eq,ByteArrayAccess) 23 | 24 | -- | Get the fingerprint of the whole signed object 25 | -- using the hashing algorithm specified 26 | getFingerprint :: (Show a, Eq a, ASN1Object a) 27 | => SignedExact a -- ^ object to fingerprint 28 | -> HashALG -- ^ algorithm to compute the fingerprint 29 | -> Fingerprint -- ^ fingerprint in binary form 30 | getFingerprint sobj halg = Fingerprint $ mkHash halg $ encodeSignedObject sobj 31 | where 32 | mkHash HashMD2 = convert . hashWith MD2 33 | mkHash HashMD5 = convert . hashWith MD5 34 | mkHash HashSHA1 = convert . hashWith SHA1 35 | mkHash HashSHA224 = convert . hashWith SHA224 36 | mkHash HashSHA256 = convert . hashWith SHA256 37 | mkHash HashSHA384 = convert . hashWith SHA384 38 | mkHash HashSHA512 = convert . hashWith SHA512 39 | -------------------------------------------------------------------------------- /x509-validation/Data/X509/Validation/Signature.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Validation.Signature 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- X.509 Certificate and CRL signature verification 9 | -- 10 | module Data.X509.Validation.Signature 11 | ( verifySignedSignature 12 | , verifySignature 13 | , SignatureVerification(..) 14 | , SignatureFailure(..) 15 | ) where 16 | 17 | import Crypto.Error (CryptoFailable(..)) 18 | import qualified Crypto.PubKey.RSA.PKCS15 as RSA 19 | import qualified Crypto.PubKey.RSA.PSS as PSS 20 | import qualified Crypto.PubKey.DSA as DSA 21 | import qualified Crypto.PubKey.ECC.Types as ECC 22 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 23 | import qualified Crypto.PubKey.Ed25519 as Ed25519 24 | import qualified Crypto.PubKey.Ed448 as Ed448 25 | import Crypto.Hash 26 | 27 | import Data.ByteString (ByteString) 28 | import Data.X509 29 | import Data.X509.EC 30 | import Data.ASN1.Types 31 | import Data.ASN1.Encoding 32 | import Data.ASN1.BinaryEncoding 33 | 34 | -- | A set of possible return from signature verification. 35 | -- 36 | -- When SignatureFailed is return, the signature shouldn't be 37 | -- accepted. 38 | -- 39 | -- Other values are only useful to differentiate the failure 40 | -- reason, but are all equivalent to failure. 41 | -- 42 | data SignatureVerification = 43 | SignaturePass -- ^ verification succeeded 44 | | SignatureFailed SignatureFailure -- ^ verification failed 45 | deriving (Show,Eq) 46 | 47 | -- | Various failure possible during signature checking 48 | data SignatureFailure = 49 | SignatureInvalid -- ^ signature doesn't verify 50 | | SignaturePubkeyMismatch -- ^ algorithm and public key mismatch, cannot proceed 51 | | SignatureUnimplemented -- ^ unimplemented signature algorithm 52 | deriving (Show,Eq) 53 | 54 | -- | Verify a Signed object against a specified public key 55 | verifySignedSignature :: (Show a, Eq a, ASN1Object a) 56 | => SignedExact a 57 | -> PubKey 58 | -> SignatureVerification 59 | verifySignedSignature signedObj pubKey = 60 | verifySignature (signedAlg signed) 61 | pubKey 62 | (getSignedData signedObj) 63 | (signedSignature signed) 64 | where signed = getSigned signedObj 65 | 66 | -- | verify signature using parameter 67 | verifySignature :: SignatureALG -- ^ Signature algorithm used 68 | -> PubKey -- ^ Public key to use for verify 69 | -> ByteString -- ^ Certificate data that need to be verified 70 | -> ByteString -- ^ Signature to verify 71 | -> SignatureVerification 72 | verifySignature (SignatureALG_Unknown _) _ _ _ = SignatureFailed SignatureUnimplemented 73 | verifySignature (SignatureALG hashALG PubKeyALG_RSAPSS) pubkey cdata signature = case verifyF pubkey of 74 | Nothing -> SignatureFailed SignatureUnimplemented 75 | Just f -> if f cdata signature 76 | then SignaturePass 77 | else SignatureFailed SignatureInvalid 78 | where 79 | verifyF (PubKeyRSA key) 80 | | hashALG == HashSHA256 = Just $ PSS.verify (PSS.defaultPSSParams SHA256) key 81 | | hashALG == HashSHA384 = Just $ PSS.verify (PSS.defaultPSSParams SHA384) key 82 | | hashALG == HashSHA512 = Just $ PSS.verify (PSS.defaultPSSParams SHA512) key 83 | | hashALG == HashSHA224 = Just $ PSS.verify (PSS.defaultPSSParams SHA224) key 84 | | otherwise = Nothing 85 | verifyF _ = Nothing 86 | verifySignature (SignatureALG hashALG pubkeyALG) pubkey cdata signature 87 | | pubkeyToAlg pubkey == pubkeyALG = case verifyF pubkey of 88 | Nothing -> SignatureFailed SignatureUnimplemented 89 | Just f -> if f cdata signature 90 | then SignaturePass 91 | else SignatureFailed SignatureInvalid 92 | | otherwise = SignatureFailed SignaturePubkeyMismatch 93 | where 94 | verifyF (PubKeyRSA key) = Just $ rsaVerify hashALG key 95 | verifyF (PubKeyDSA key) 96 | | hashALG == HashSHA1 = Just $ dsaVerify SHA1 key 97 | | hashALG == HashSHA224 = Just $ dsaVerify SHA224 key 98 | | hashALG == HashSHA256 = Just $ dsaVerify SHA256 key 99 | | otherwise = Nothing 100 | verifyF (PubKeyEC key) = verifyECDSA hashALG key 101 | verifyF _ = Nothing 102 | 103 | dsaToSignature :: ByteString -> Maybe DSA.Signature 104 | dsaToSignature b = 105 | case decodeASN1' BER b of 106 | Left _ -> Nothing 107 | Right asn1 -> 108 | case asn1 of 109 | Start Sequence:IntVal r:IntVal s:End Sequence:_ -> 110 | Just $ DSA.Signature { DSA.sign_r = r, DSA.sign_s = s } 111 | _ -> 112 | Nothing 113 | 114 | dsaVerify hsh key b a = 115 | case dsaToSignature a of 116 | Nothing -> False 117 | Just dsaSig -> DSA.verify hsh key dsaSig b 118 | 119 | rsaVerify HashMD2 = RSA.verify (Just MD2) 120 | rsaVerify HashMD5 = RSA.verify (Just MD5) 121 | rsaVerify HashSHA1 = RSA.verify (Just SHA1) 122 | rsaVerify HashSHA224 = RSA.verify (Just SHA224) 123 | rsaVerify HashSHA256 = RSA.verify (Just SHA256) 124 | rsaVerify HashSHA384 = RSA.verify (Just SHA384) 125 | rsaVerify HashSHA512 = RSA.verify (Just SHA512) 126 | 127 | verifySignature (SignatureALG_IntrinsicHash pubkeyALG) pubkey cdata signature 128 | | pubkeyToAlg pubkey == pubkeyALG = doVerify pubkey 129 | | otherwise = SignatureFailed SignaturePubkeyMismatch 130 | where 131 | doVerify (PubKeyEd25519 key) = eddsa Ed25519.verify Ed25519.signature key 132 | doVerify (PubKeyEd448 key) = eddsa Ed448.verify Ed448.signature key 133 | doVerify _ = SignatureFailed SignatureUnimplemented 134 | 135 | eddsa verify toSig key = 136 | case toSig signature of 137 | CryptoPassed sig 138 | | verify key cdata sig -> SignaturePass 139 | | otherwise -> SignatureFailed SignatureInvalid 140 | CryptoFailed _ -> SignatureFailed SignatureInvalid 141 | 142 | verifyECDSA :: HashALG -> PubKeyEC -> Maybe (ByteString -> ByteString -> Bool) 143 | verifyECDSA hashALG key = 144 | ecPubKeyCurveName key >>= verifyCurve (pubkeyEC_pub key) 145 | where 146 | verifyCurve pub curveName = Just $ \msg sigBS -> 147 | case decodeASN1' BER sigBS of 148 | Left _ -> False 149 | Right [Start Sequence,IntVal r,IntVal s,End Sequence] -> 150 | let curve = ECC.getCurveByName curveName 151 | in case unserializePoint curve pub of 152 | Nothing -> False 153 | Just p -> let pubkey = ECDSA.PublicKey curve p 154 | in (ecdsaVerify hashALG) pubkey (ECDSA.Signature r s) msg 155 | Right _ -> False 156 | 157 | ecdsaVerify HashMD2 = ECDSA.verify MD2 158 | ecdsaVerify HashMD5 = ECDSA.verify MD5 159 | ecdsaVerify HashSHA1 = ECDSA.verify SHA1 160 | ecdsaVerify HashSHA224 = ECDSA.verify SHA224 161 | ecdsaVerify HashSHA256 = ECDSA.verify SHA256 162 | ecdsaVerify HashSHA384 = ECDSA.verify SHA384 163 | ecdsaVerify HashSHA512 = ECDSA.verify SHA512 164 | -------------------------------------------------------------------------------- /x509-validation/Data/X509/Validation/Types.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Validation.Types 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- X.509 Validation types 9 | module Data.X509.Validation.Types 10 | ( ServiceID 11 | , HostName 12 | ) where 13 | 14 | import Data.ByteString (ByteString) 15 | 16 | type HostName = String 17 | 18 | -- | identification of the connection consisting of the 19 | -- fully qualified host name (e.g. www.example.com) and 20 | -- an optional suffix. 21 | -- 22 | -- The suffix is not used by the validation process, but 23 | -- is used by the optional cache to identity certificate per service 24 | -- on a specific host. For example, one might have a different 25 | -- certificate on 2 differents ports (443 and 995) for the same host. 26 | -- 27 | -- for TCP connection, it's recommended to use: :port, or :service for the suffix. 28 | -- 29 | type ServiceID = (HostName, ByteString) 30 | -------------------------------------------------------------------------------- /x509-validation/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010-2013 Vincent Hanquez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /x509-validation/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /x509-validation/Tests/Certificate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | -- | Types and functions used to build test certificates. 3 | module Certificate 4 | ( 5 | -- * Hash algorithms 6 | hashMD2 7 | , hashMD5 8 | , hashSHA1 9 | , hashSHA224 10 | , hashSHA256 11 | , hashSHA384 12 | , hashSHA512 13 | -- * Key and signature utilities 14 | , Alg(..) 15 | , Keys 16 | , generateKeys 17 | -- * Certificate utilities 18 | , Pair(..) 19 | , mkDn 20 | , mkExtension 21 | , leafStdExts 22 | -- * Certificate creation functions 23 | , Auth(..) 24 | , mkCertificate 25 | , mkCA 26 | , mkLeaf 27 | ) where 28 | 29 | import Control.Applicative 30 | 31 | import Crypto.Hash.Algorithms 32 | import Crypto.Number.Serialize 33 | 34 | import qualified Crypto.PubKey.DSA as DSA 35 | import qualified Crypto.PubKey.ECC.ECDSA as ECDSA 36 | import qualified Crypto.PubKey.ECC.Generate as ECC 37 | import qualified Crypto.PubKey.ECC.Types as ECC 38 | import qualified Crypto.PubKey.Ed25519 as Ed25519 39 | import qualified Crypto.PubKey.Ed448 as Ed448 40 | import qualified Crypto.PubKey.RSA as RSA 41 | import qualified Crypto.PubKey.RSA.PKCS15 as RSA 42 | import qualified Crypto.PubKey.RSA.PSS as PSS 43 | 44 | import qualified Data.ByteString as B 45 | 46 | import Data.ASN1.BinaryEncoding (DER(..)) 47 | import Data.ASN1.Encoding 48 | import Data.ASN1.Types 49 | import Data.ByteArray (convert) 50 | import Data.Maybe (catMaybes) 51 | import Data.String (fromString) 52 | import Data.X509 53 | 54 | import Data.Hourglass 55 | 56 | 57 | -- Crypto utilities -- 58 | 59 | -- | Hash algorithms supported in certificates. 60 | -- 61 | -- This relates the typed hash algorithm @hash@ to the 'HashALG' value. 62 | data GHash hash = GHash { getHashALG :: HashALG, getHashAlgorithm :: hash } 63 | 64 | hashMD2 :: GHash MD2 65 | hashMD5 :: GHash MD5 66 | hashSHA1 :: GHash SHA1 67 | hashSHA224 :: GHash SHA224 68 | hashSHA256 :: GHash SHA256 69 | hashSHA384 :: GHash SHA384 70 | hashSHA512 :: GHash SHA512 71 | 72 | hashMD2 = GHash HashMD2 MD2 73 | hashMD5 = GHash HashMD5 MD5 74 | hashSHA1 = GHash HashSHA1 SHA1 75 | hashSHA224 = GHash HashSHA224 SHA224 76 | hashSHA256 = GHash HashSHA256 SHA256 77 | hashSHA384 = GHash HashSHA384 SHA384 78 | hashSHA512 = GHash HashSHA512 SHA512 79 | 80 | -- | Signature and hash algorithms instantiated with parameters. 81 | data Alg pub priv where 82 | AlgRSA :: (HashAlgorithm hash, RSA.HashAlgorithmASN1 hash) 83 | => Int 84 | -> GHash hash 85 | -> Alg RSA.PublicKey RSA.PrivateKey 86 | 87 | AlgRSAPSS :: HashAlgorithm hash 88 | => Int 89 | -> PSS.PSSParams hash B.ByteString B.ByteString 90 | -> GHash hash 91 | -> Alg RSA.PublicKey RSA.PrivateKey 92 | 93 | AlgDSA :: HashAlgorithm hash 94 | => DSA.Params 95 | -> GHash hash 96 | -> Alg DSA.PublicKey DSA.PrivateKey 97 | 98 | AlgEC :: HashAlgorithm hash 99 | => ECC.CurveName 100 | -> GHash hash 101 | -> Alg ECDSA.PublicKey ECDSA.PrivateKey 102 | 103 | AlgEd25519 :: Alg Ed25519.PublicKey Ed25519.SecretKey 104 | 105 | AlgEd448 :: Alg Ed448.PublicKey Ed448.SecretKey 106 | 107 | -- | Types of public and private keys used by a signature algorithm. 108 | type Keys pub priv = (Alg pub priv, pub, priv) 109 | 110 | -- | Generates random keys for a signature algorithm. 111 | generateKeys :: Alg pub priv -> IO (Keys pub priv) 112 | generateKeys alg@(AlgRSA bits _) = generateRSAKeys alg bits 113 | generateKeys alg@(AlgRSAPSS bits _ _) = generateRSAKeys alg bits 114 | generateKeys alg@(AlgDSA params _) = do 115 | x <- DSA.generatePrivate params 116 | let y = DSA.calculatePublic params x 117 | return (alg, DSA.PublicKey params y, DSA.PrivateKey params x) 118 | generateKeys alg@(AlgEC name _) = do 119 | let curve = ECC.getCurveByName name 120 | (pub, priv) <- ECC.generate curve 121 | return (alg, pub, priv) 122 | generateKeys alg@AlgEd25519 = do 123 | secret <- Ed25519.generateSecretKey 124 | return (alg, Ed25519.toPublic secret, secret) 125 | generateKeys alg@AlgEd448 = do 126 | secret <- Ed448.generateSecretKey 127 | return (alg, Ed448.toPublic secret, secret) 128 | 129 | generateRSAKeys :: Alg RSA.PublicKey RSA.PrivateKey 130 | -> Int 131 | -> IO (Alg RSA.PublicKey RSA.PrivateKey, RSA.PublicKey, RSA.PrivateKey) 132 | generateRSAKeys alg bits = addAlg <$> RSA.generate size e 133 | where 134 | addAlg (pub, priv) = (alg, pub, priv) 135 | size = bits `div` 8 136 | e = 3 137 | 138 | getPubKey :: Alg pub priv -> pub -> PubKey 139 | getPubKey (AlgRSA _ _) key = PubKeyRSA key 140 | getPubKey (AlgRSAPSS _ _ _) key = PubKeyRSA key 141 | getPubKey (AlgDSA _ _) key = PubKeyDSA key 142 | getPubKey (AlgEC name _) key = PubKeyEC (PubKeyEC_Named name pub) 143 | where 144 | ECC.Point x y = ECDSA.public_q key 145 | pub = SerializedPoint bs 146 | bs = B.cons 4 (i2ospOf_ bytes x `B.append` i2ospOf_ bytes y) 147 | bits = ECC.curveSizeBits (ECC.getCurveByName name) 148 | bytes = (bits + 7) `div` 8 149 | getPubKey AlgEd25519 key = PubKeyEd25519 key 150 | getPubKey AlgEd448 key = PubKeyEd448 key 151 | 152 | getSignatureALG :: Alg pub priv -> SignatureALG 153 | getSignatureALG (AlgRSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSA 154 | getSignatureALG (AlgRSAPSS _ _ hash) = SignatureALG (getHashALG hash) PubKeyALG_RSAPSS 155 | getSignatureALG (AlgDSA _ hash) = SignatureALG (getHashALG hash) PubKeyALG_DSA 156 | getSignatureALG (AlgEC _ hash) = SignatureALG (getHashALG hash) PubKeyALG_EC 157 | getSignatureALG AlgEd25519 = SignatureALG_IntrinsicHash PubKeyALG_Ed25519 158 | getSignatureALG AlgEd448 = SignatureALG_IntrinsicHash PubKeyALG_Ed448 159 | 160 | doSign :: Alg pub priv -> priv -> B.ByteString -> IO B.ByteString 161 | doSign (AlgRSA _ hash) key msg = do 162 | result <- RSA.signSafer (Just $ getHashAlgorithm hash) key msg 163 | case result of 164 | Left err -> error ("doSign(AlgRSA): " ++ show err) 165 | Right sigBits -> return sigBits 166 | doSign (AlgRSAPSS _ params _) key msg = do 167 | result <- PSS.signSafer params key msg 168 | case result of 169 | Left err -> error ("doSign(AlgRSAPSS): " ++ show err) 170 | Right sigBits -> return sigBits 171 | doSign (AlgDSA _ hash) key msg = do 172 | sig <- DSA.sign key (getHashAlgorithm hash) msg 173 | return $ encodeASN1' DER 174 | [ Start Sequence 175 | , IntVal (DSA.sign_r sig) 176 | , IntVal (DSA.sign_s sig) 177 | , End Sequence 178 | ] 179 | doSign (AlgEC _ hash) key msg = do 180 | sig <- ECDSA.sign key (getHashAlgorithm hash) msg 181 | return $ encodeASN1' DER 182 | [ Start Sequence 183 | , IntVal (ECDSA.sign_r sig) 184 | , IntVal (ECDSA.sign_s sig) 185 | , End Sequence 186 | ] 187 | doSign AlgEd25519 key msg = 188 | return $ convert $ Ed25519.sign key (Ed25519.toPublic key) msg 189 | doSign AlgEd448 key msg = 190 | return $ convert $ Ed448.sign key (Ed448.toPublic key) msg 191 | 192 | 193 | -- Certificate utilities -- 194 | 195 | -- | Holds together a certificate and its private key for convenience. 196 | -- 197 | -- Contains also the crypto algorithm that both are issued from. This is 198 | -- useful when signing another certificate. 199 | data Pair pub priv = Pair 200 | { pairAlg :: Alg pub priv 201 | , pairSignedCert :: SignedCertificate 202 | , pairKey :: priv 203 | } 204 | 205 | -- | Builds a DN with a single component. 206 | mkDn :: String -> DistinguishedName 207 | mkDn cn = DistinguishedName [(getObjectID DnCommonName, fromString cn)] 208 | 209 | -- | Used to build a certificate extension. 210 | mkExtension :: Extension a => Bool -> a -> ExtensionRaw 211 | mkExtension crit ext = ExtensionRaw (extOID ext) crit (extEncodeBs ext) 212 | 213 | -- | Default extensions in leaf certificates. 214 | leafStdExts :: [ExtensionRaw] 215 | leafStdExts = [ku, eku] 216 | where 217 | ku = mkExtension False $ ExtKeyUsage 218 | [ KeyUsage_digitalSignature , KeyUsage_keyEncipherment ] 219 | eku = mkExtension False $ ExtExtendedKeyUsage 220 | [ KeyUsagePurpose_ServerAuth , KeyUsagePurpose_ClientAuth ] 221 | 222 | 223 | -- Authority signing a certificate -- 224 | -- 225 | -- When the certificate is self-signed, issuer and subject are the same. So 226 | -- they have identical signature algorithms. The purpose of the GADT is to 227 | -- hold this constraint only in the self-signed case. 228 | 229 | -- | Authority signing a certificate, itself or another certificate. 230 | data Auth pubI privI pubS privS where 231 | Self :: (pubI ~ pubS, privI ~ privS) => Auth pubI privI pubS privS 232 | CA :: Pair pubI privI -> Auth pubI privI pubS privS 233 | 234 | foldAuth :: a 235 | -> (Pair pubI privI -> a) 236 | -> Auth pubI privI pubS privS 237 | -> a 238 | foldAuth x _ Self = x -- no constraint used 239 | foldAuth _ f (CA p) = f p 240 | 241 | foldAuthPriv :: privS 242 | -> (Pair pubI privI -> privI) 243 | -> Auth pubI privI pubS privS 244 | -> privI 245 | foldAuthPriv x _ Self = x -- uses constraint privI ~ privS 246 | foldAuthPriv _ f (CA p) = f p 247 | 248 | foldAuthPubPriv :: k pubS privS 249 | -> (Pair pubI privI -> k pubI privI) 250 | -> Auth pubI privI pubS privS 251 | -> k pubI privI 252 | foldAuthPubPriv x _ Self = x -- uses both constraints 253 | foldAuthPubPriv _ f (CA p) = f p 254 | 255 | 256 | -- Certificate creation functions -- 257 | 258 | -- | Builds a certificate using the supplied keys and signs it with an 259 | -- authority (itself or another certificate). 260 | mkCertificate :: Int -- ^ Certificate version 261 | -> Integer -- ^ Serial number 262 | -> DistinguishedName -- ^ Subject DN 263 | -> (DateTime, DateTime) -- ^ Certificate validity period 264 | -> [ExtensionRaw] -- ^ Extensions to include 265 | -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate 266 | -> Keys pubS privS -- ^ Keys for the new certificate 267 | -> IO (Pair pubS privS) -- ^ The new certificate/key pair 268 | mkCertificate version serial dn validity exts auth (algS, pubKey, privKey) = do 269 | signedCert <- objectToSignedExactF signatureFunction cert 270 | return Pair { pairAlg = algS 271 | , pairSignedCert = signedCert 272 | , pairKey = privKey 273 | } 274 | 275 | where 276 | pairCert = signedObject . getSigned . pairSignedCert 277 | 278 | cert = Certificate 279 | { certVersion = version 280 | , certSerial = serial 281 | , certSignatureAlg = signAlgI 282 | , certIssuerDN = issuerDN 283 | , certValidity = validity 284 | , certSubjectDN = dn 285 | , certPubKey = getPubKey algS pubKey 286 | , certExtensions = extensions 287 | } 288 | 289 | signingKey = foldAuthPriv privKey pairKey auth 290 | algI = foldAuthPubPriv algS pairAlg auth 291 | 292 | signAlgI = getSignatureALG algI 293 | issuerDN = foldAuth dn (certSubjectDN . pairCert) auth 294 | extensions = Extensions (if null exts then Nothing else Just exts) 295 | 296 | signatureFunction objRaw = do 297 | sigBits <- doSign algI signingKey objRaw 298 | return (sigBits, signAlgI) 299 | 300 | -- | Builds a CA certificate using the supplied keys and signs it with an 301 | -- authority (itself or another certificate). 302 | mkCA :: Integer -- ^ Serial number 303 | -> String -- ^ Common name 304 | -> (DateTime, DateTime) -- ^ CA validity period 305 | -> Maybe ExtBasicConstraints -- ^ CA basic constraints 306 | -> Maybe ExtKeyUsage -- ^ CA key usage 307 | -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate 308 | -> Keys pubS privS -- ^ Keys for the new certificate 309 | -> IO (Pair pubS privS) -- ^ The new CA certificate/key pair 310 | mkCA serial cn validity bc ku = 311 | let exts = catMaybes [ mkExtension True <$> bc, mkExtension False <$> ku ] 312 | in mkCertificate 2 serial (mkDn cn) validity exts 313 | 314 | -- | Builds a leaf certificate using the supplied keys and signs it with an 315 | -- authority (itself or another certificate). 316 | mkLeaf :: String -- ^ Common name 317 | -> (DateTime, DateTime) -- ^ Certificate validity period 318 | -> Auth pubI privI pubS privS -- ^ Authority signing the new certificate 319 | -> Keys pubS privS -- ^ Keys for the new certificate 320 | -> IO (Pair pubS privS) -- ^ The new leaf certificate/key pair 321 | mkLeaf cn validity = mkCertificate 2 100 (mkDn cn) validity leafStdExts 322 | -------------------------------------------------------------------------------- /x509-validation/x509-validation.cabal: -------------------------------------------------------------------------------- 1 | Name: x509-validation 2 | version: 1.6.12 3 | Description: X.509 Certificate and CRL validation. please see README 4 | License: BSD3 5 | License-file: LICENSE 6 | Copyright: Vincent Hanquez 7 | Author: Vincent Hanquez 8 | Maintainer: Vincent Hanquez 9 | Synopsis: X.509 Certificate and CRL validation 10 | Build-Type: Simple 11 | Category: Data 12 | stability: experimental 13 | Homepage: http://github.com/vincenthz/hs-certificate 14 | Cabal-Version: >= 1.10 15 | 16 | Library 17 | Default-Language: Haskell2010 18 | Build-Depends: base >= 3 && < 5 19 | , bytestring 20 | , memory 21 | , mtl 22 | , containers 23 | , hourglass 24 | , data-default-class 25 | , pem >= 0.1 26 | , asn1-types >= 0.3 && < 0.4 27 | , asn1-encoding >= 0.9 && < 0.10 28 | , x509 >= 1.7.5 29 | , x509-store >= 1.6 30 | , cryptonite >= 0.24 31 | Exposed-modules: Data.X509.Validation 32 | Other-modules: Data.X509.Validation.Signature 33 | Data.X509.Validation.Fingerprint 34 | Data.X509.Validation.Cache 35 | Data.X509.Validation.Types 36 | ghc-options: -Wall 37 | 38 | Test-Suite test-x509-validation 39 | Default-Language: Haskell2010 40 | type: exitcode-stdio-1.0 41 | hs-source-dirs: Tests 42 | Main-is: Tests.hs 43 | Other-modules: Certificate 44 | Build-Depends: base >= 3 && < 5 45 | , bytestring 46 | , memory 47 | , data-default-class 48 | , tasty 49 | , tasty-hunit 50 | , hourglass 51 | , asn1-types 52 | , asn1-encoding 53 | , x509 >= 1.7.1 54 | , x509-store 55 | , x509-validation 56 | , cryptonite 57 | ghc-options: -Wall 58 | 59 | source-repository head 60 | type: git 61 | location: git://github.com/vincenthz/hs-certificate 62 | subdir: x509-validation 63 | -------------------------------------------------------------------------------- /x509/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # ChangeLog for x509 2 | 3 | ## 2022-05-31 v1.7.7 4 | 5 | - Bump requirements to GHC 7.8 and transformers 0.4 series [#130](https://github.com/haskell-tls/hs-certificate/pull/130) 6 | 7 | -------------------------------------------------------------------------------- /x509/Data/X509.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- Read/Write X509 Certificate, CRL and their signed equivalents. 9 | -- 10 | -- Follows RFC5280 / RFC6818 11 | -- 12 | module Data.X509 13 | ( 14 | -- * Types 15 | SignedCertificate 16 | , SignedCRL 17 | , Certificate(..) 18 | , PubKey(..) 19 | , PubKeyEC(..) 20 | , SerializedPoint(..) 21 | , PrivKey(..) 22 | , PrivKeyEC(..) 23 | , pubkeyToAlg 24 | , privkeyToAlg 25 | , module Data.X509.AlgorithmIdentifier 26 | , module Data.X509.Ext 27 | , module Data.X509.ExtensionRaw 28 | 29 | -- * Certificate Revocation List (CRL) 30 | , module Data.X509.CRL 31 | 32 | -- * Naming 33 | , DistinguishedName(..) 34 | , DnElement(..) 35 | , ASN1CharacterString(..) 36 | , getDnElement 37 | 38 | -- * Certificate Chain 39 | , module Data.X509.CertificateChain 40 | 41 | -- * Signed types and marshalling 42 | , Signed(..) 43 | , SignedExact 44 | , getSigned 45 | , getSignedData 46 | , objectToSignedExact 47 | , objectToSignedExactF 48 | , encodeSignedObject 49 | , decodeSignedObject 50 | 51 | -- * Parametrized Signed accessor 52 | , getCertificate 53 | , getCRL 54 | , decodeSignedCertificate 55 | , decodeSignedCRL 56 | 57 | -- * Hash distinguished names related function 58 | , hashDN 59 | , hashDN_old 60 | ) where 61 | 62 | import Control.Arrow (second) 63 | 64 | import Data.ASN1.Types 65 | import Data.ASN1.Encoding 66 | import Data.ASN1.BinaryEncoding 67 | import qualified Data.ByteString as B 68 | import qualified Data.ByteArray as BA 69 | 70 | import Data.X509.Cert 71 | import Data.X509.Ext 72 | import Data.X509.ExtensionRaw 73 | import Data.X509.CRL 74 | import Data.X509.CertificateChain 75 | import Data.X509.DistinguishedName 76 | import Data.X509.Signed 77 | import Data.X509.PublicKey 78 | import Data.X509.PrivateKey 79 | import Data.X509.AlgorithmIdentifier 80 | 81 | import Crypto.Hash 82 | 83 | -- | A Signed Certificate 84 | type SignedCertificate = SignedExact Certificate 85 | 86 | -- | A Signed CRL 87 | type SignedCRL = SignedExact CRL 88 | 89 | -- | Get the Certificate associated to a SignedCertificate 90 | getCertificate :: SignedCertificate -> Certificate 91 | getCertificate = signedObject . getSigned 92 | 93 | -- | Get the CRL associated to a SignedCRL 94 | getCRL :: SignedCRL -> CRL 95 | getCRL = signedObject . getSigned 96 | 97 | -- | Try to decode a bytestring to a SignedCertificate 98 | decodeSignedCertificate :: B.ByteString -> Either String SignedCertificate 99 | decodeSignedCertificate = decodeSignedObject 100 | 101 | -- | Try to decode a bytestring to a SignedCRL 102 | decodeSignedCRL :: B.ByteString -> Either String SignedCRL 103 | decodeSignedCRL = decodeSignedObject 104 | 105 | -- | Make an OpenSSL style hash of distinguished name 106 | -- 107 | -- OpenSSL algorithm is odd, and has been replicated here somewhat. 108 | -- only lower the case of ascii character. 109 | hashDN :: DistinguishedName -> B.ByteString 110 | hashDN = shorten . hashWith SHA1 . encodeASN1' DER . flip toASN1 [] . DistinguishedNameInner . dnLowerUTF8 111 | where dnLowerUTF8 (DistinguishedName l) = DistinguishedName $ map (second toLowerUTF8) l 112 | toLowerUTF8 (ASN1CharacterString _ s) = ASN1CharacterString UTF8 (B.map asciiToLower s) 113 | asciiToLower c 114 | | c >= w8A && c <= w8Z = fromIntegral (fromIntegral c - fromEnum 'A' + fromEnum 'a') 115 | | otherwise = c 116 | w8A = fromIntegral $ fromEnum 'A' 117 | w8Z = fromIntegral $ fromEnum 'Z' 118 | 119 | -- | Create an openssl style old hash of distinguished name 120 | hashDN_old :: DistinguishedName -> B.ByteString 121 | hashDN_old = shorten . hashWith MD5 . encodeASN1' DER . flip toASN1 [] 122 | 123 | shorten :: Digest a -> B.ByteString 124 | shorten b = B.pack $ map i [3,2,1,0] 125 | where i n = BA.index b n 126 | -------------------------------------------------------------------------------- /x509/Data/X509/AlgorithmIdentifier.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.AlgorithmIdentifier 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | module Data.X509.AlgorithmIdentifier 9 | ( HashALG(..) 10 | , PubKeyALG(..) 11 | , SignatureALG(..) 12 | ) where 13 | 14 | import Data.ASN1.Types 15 | import Data.List (find) 16 | 17 | -- | Hash Algorithm 18 | data HashALG = 19 | HashMD2 20 | | HashMD5 21 | | HashSHA1 22 | | HashSHA224 23 | | HashSHA256 24 | | HashSHA384 25 | | HashSHA512 26 | deriving (Show,Eq) 27 | 28 | -- | Public Key Algorithm 29 | data PubKeyALG = 30 | PubKeyALG_RSA -- ^ RSA Public Key algorithm 31 | | PubKeyALG_RSAPSS -- ^ RSA PSS Key algorithm (RFC 3447) 32 | | PubKeyALG_DSA -- ^ DSA Public Key algorithm 33 | | PubKeyALG_EC -- ^ ECDSA & ECDH Public Key algorithm 34 | | PubKeyALG_X25519 -- ^ ECDH 25519 key agreement 35 | | PubKeyALG_X448 -- ^ ECDH 448 key agreement 36 | | PubKeyALG_Ed25519 -- ^ EdDSA 25519 signature algorithm 37 | | PubKeyALG_Ed448 -- ^ EdDSA 448 signature algorithm 38 | | PubKeyALG_DH -- ^ Diffie Hellman Public Key algorithm 39 | | PubKeyALG_Unknown OID -- ^ Unknown Public Key algorithm 40 | deriving (Show,Eq) 41 | 42 | -- | Signature Algorithm, often composed of a public key algorithm and a hash 43 | -- algorithm. For some signature algorithms the hash algorithm is intrinsic to 44 | -- the public key algorithm and is not needed in the data type. 45 | data SignatureALG = 46 | SignatureALG HashALG PubKeyALG 47 | | SignatureALG_IntrinsicHash PubKeyALG 48 | | SignatureALG_Unknown OID 49 | deriving (Show,Eq) 50 | 51 | instance OIDable PubKeyALG where 52 | getObjectID PubKeyALG_RSA = [1,2,840,113549,1,1,1] 53 | getObjectID PubKeyALG_RSAPSS = [1,2,840,113549,1,1,10] 54 | getObjectID PubKeyALG_DSA = [1,2,840,10040,4,1] 55 | getObjectID PubKeyALG_EC = [1,2,840,10045,2,1] 56 | getObjectID PubKeyALG_X25519 = [1,3,101,110] 57 | getObjectID PubKeyALG_X448 = [1,3,101,111] 58 | getObjectID PubKeyALG_Ed25519 = [1,3,101,112] 59 | getObjectID PubKeyALG_Ed448 = [1,3,101,113] 60 | getObjectID PubKeyALG_DH = [1,2,840,10046,2,1] 61 | getObjectID (PubKeyALG_Unknown oid) = oid 62 | 63 | sig_table :: [ (OID, SignatureALG) ] 64 | sig_table = 65 | [ ([1,2,840,113549,1,1,5], SignatureALG HashSHA1 PubKeyALG_RSA) 66 | , ([1,2,840,113549,1,1,4], SignatureALG HashMD5 PubKeyALG_RSA) 67 | , ([1,2,840,113549,1,1,2], SignatureALG HashMD2 PubKeyALG_RSA) 68 | , ([1,2,840,113549,1,1,11], SignatureALG HashSHA256 PubKeyALG_RSA) 69 | , ([1,2,840,113549,1,1,12], SignatureALG HashSHA384 PubKeyALG_RSA) 70 | , ([1,2,840,113549,1,1,13], SignatureALG HashSHA512 PubKeyALG_RSA) 71 | , ([1,2,840,113549,1,1,14], SignatureALG HashSHA224 PubKeyALG_RSA) 72 | , ([1,2,840,10040,4,3], SignatureALG HashSHA1 PubKeyALG_DSA) 73 | , ([1,2,840,10045,4,1], SignatureALG HashSHA1 PubKeyALG_EC) 74 | , ([1,2,840,10045,4,3,1], SignatureALG HashSHA224 PubKeyALG_EC) 75 | , ([1,2,840,10045,4,3,2], SignatureALG HashSHA256 PubKeyALG_EC) 76 | , ([1,2,840,10045,4,3,3], SignatureALG HashSHA384 PubKeyALG_EC) 77 | , ([1,2,840,10045,4,3,4], SignatureALG HashSHA512 PubKeyALG_EC) 78 | , ([2,16,840,1,101,3,4,2,1], SignatureALG HashSHA256 PubKeyALG_RSAPSS) 79 | , ([2,16,840,1,101,3,4,2,2], SignatureALG HashSHA384 PubKeyALG_RSAPSS) 80 | , ([2,16,840,1,101,3,4,2,3], SignatureALG HashSHA512 PubKeyALG_RSAPSS) 81 | , ([2,16,840,1,101,3,4,2,4], SignatureALG HashSHA224 PubKeyALG_RSAPSS) 82 | , ([2,16,840,1,101,3,4,3,1], SignatureALG HashSHA224 PubKeyALG_DSA) 83 | , ([2,16,840,1,101,3,4,3,2], SignatureALG HashSHA256 PubKeyALG_DSA) 84 | , ([1,3,101,112], SignatureALG_IntrinsicHash PubKeyALG_Ed25519) 85 | , ([1,3,101,113], SignatureALG_IntrinsicHash PubKeyALG_Ed448) 86 | ] 87 | 88 | oidSig :: OID -> SignatureALG 89 | oidSig oid = maybe (SignatureALG_Unknown oid) id $ lookup oid sig_table 90 | 91 | sigOID :: SignatureALG -> OID 92 | sigOID (SignatureALG_Unknown oid) = oid 93 | sigOID sig = maybe (error ("unknown OID for " ++ show sig)) fst $ find ((==) sig . snd) sig_table 94 | 95 | -- | PSS salt length. Always assume ``-sigopt rsa_pss_saltlen:-1`` 96 | saltLen :: HashALG -> Integer 97 | saltLen HashSHA256 = 32 98 | saltLen HashSHA384 = 48 99 | saltLen HashSHA512 = 64 100 | saltLen HashSHA224 = 28 101 | saltLen _ = error "toASN1: X509.SignatureAlg.HashAlg: Unknown hash" 102 | 103 | instance ASN1Object SignatureALG where 104 | fromASN1 (Start Sequence:OID oid:Null:End Sequence:xs) = 105 | case oidSig oid of 106 | SignatureALG_IntrinsicHash _ -> 107 | Left "fromASN1: X509.SignatureALG: EdDSA requires absent parameter" 108 | signatureAlg -> Right (signatureAlg, xs) 109 | fromASN1 (Start Sequence:OID oid:End Sequence:xs) = 110 | Right (oidSig oid, xs) 111 | fromASN1 (Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start _:Start Sequence:OID hash1:End Sequence:End _:Start _:Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID _hash2:End Sequence:End Sequence:End _:Start _: IntVal _iv: End _: End Sequence : End Sequence:xs) = 112 | Right (oidSig hash1, xs) 113 | fromASN1 (Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start _:Start Sequence:OID hash1:Null:End Sequence:End _:Start _:Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID _hash2:Null:End Sequence:End Sequence:End _:Start _: IntVal _iv: End _: End Sequence : End Sequence:xs) = 114 | Right (oidSig hash1, xs) 115 | fromASN1 _ = 116 | Left "fromASN1: X509.SignatureALG: unknown format" 117 | toASN1 (SignatureALG_Unknown oid) = \xs -> Start Sequence:OID oid:Null:End Sequence:xs 118 | toASN1 signatureAlg@(SignatureALG hashAlg PubKeyALG_RSAPSS) = \xs -> Start Sequence:OID [1,2,840,113549,1,1,10]:Start Sequence:Start (Container Context 0):Start Sequence:OID (sigOID signatureAlg):End Sequence:End (Container Context 0):Start (Container Context 1): Start Sequence:OID [1,2,840,113549,1,1,8]:Start Sequence:OID (sigOID signatureAlg):End Sequence:End Sequence:End (Container Context 1):Start (Container Context 2):IntVal (saltLen hashAlg):End (Container Context 2):End Sequence:End Sequence:xs 119 | toASN1 signatureAlg@(SignatureALG_IntrinsicHash _) = \xs -> Start Sequence:OID (sigOID signatureAlg):End Sequence:xs 120 | toASN1 signatureAlg = \xs -> Start Sequence:OID (sigOID signatureAlg):Null:End Sequence:xs 121 | -------------------------------------------------------------------------------- /x509/Data/X509/CRL.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.CRL 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- Read and Write X509 Certificate Revocation List (CRL). 9 | -- 10 | -- follows RFC5280 / RFC6818. 11 | -- 12 | {-# LANGUAGE FlexibleContexts #-} 13 | 14 | module Data.X509.CRL 15 | ( CRL(..) 16 | , RevokedCertificate(..) 17 | ) where 18 | 19 | import Control.Applicative 20 | 21 | import Data.Hourglass (DateTime, TimezoneOffset(..)) 22 | import Data.ASN1.Types 23 | 24 | import Data.X509.DistinguishedName 25 | import Data.X509.AlgorithmIdentifier 26 | import Data.X509.ExtensionRaw 27 | import Data.X509.Internal 28 | 29 | -- | Describe a Certificate revocation list 30 | data CRL = CRL 31 | { crlVersion :: Integer 32 | , crlSignatureAlg :: SignatureALG 33 | , crlIssuer :: DistinguishedName 34 | , crlThisUpdate :: DateTime 35 | , crlNextUpdate :: Maybe DateTime 36 | , crlRevokedCertificates :: [RevokedCertificate] 37 | , crlExtensions :: Extensions 38 | } deriving (Show,Eq) 39 | 40 | -- | Describe a revoked certificate identifiable by serial number. 41 | data RevokedCertificate = RevokedCertificate 42 | { revokedSerialNumber :: Integer 43 | , revokedDate :: DateTime 44 | , revokedExtensions :: Extensions 45 | } deriving (Show,Eq) 46 | 47 | instance ASN1Object CRL where 48 | toASN1 crl = encodeCRL crl 49 | fromASN1 = runParseASN1State parseCRL 50 | 51 | instance ASN1Object RevokedCertificate where 52 | fromASN1 = runParseASN1State $ 53 | onNextContainer Sequence $ 54 | RevokedCertificate 55 | <$> parseSerialNumber 56 | <*> (getNext >>= toTime) 57 | <*> getObject 58 | where toTime (ASN1Time _ t _) = pure t 59 | toTime _ = throwParseError "bad revocation date" 60 | toASN1 (RevokedCertificate serial time crlEntryExtensions) = \xs -> 61 | [ Start Sequence ] ++ 62 | [ IntVal serial ] ++ 63 | [ ASN1Time TimeGeneralized time (Just (TimezoneOffset 0)) ] ++ 64 | toASN1 crlEntryExtensions [] ++ 65 | [ End Sequence ] ++ 66 | xs 67 | 68 | parseSerialNumber :: ParseASN1 Integer 69 | parseSerialNumber = do 70 | n <- getNext 71 | case n of 72 | IntVal v -> return v 73 | _ -> throwParseError ("missing serial" ++ show n) 74 | 75 | parseCRL :: ParseASN1 CRL 76 | parseCRL = do 77 | CRL <$> (getNext >>= getVersion) 78 | <*> getObject 79 | <*> getObject 80 | <*> (getNext >>= getThisUpdate) 81 | <*> getNextUpdate 82 | <*> parseRevokedCertificates 83 | <*> parseCRLExtensions 84 | where getVersion (IntVal v) = return $ fromIntegral v 85 | getVersion _ = throwParseError "unexpected type for version" 86 | 87 | getThisUpdate (ASN1Time _ t1 _) = return t1 88 | getThisUpdate _ = throwParseError "bad this update format, expecting time" 89 | 90 | getNextUpdate = getNextMaybe timeOrNothing 91 | 92 | timeOrNothing (ASN1Time _ tnext _) = Just tnext 93 | timeOrNothing _ = Nothing 94 | 95 | parseRevokedCertificates :: ParseASN1 [RevokedCertificate] 96 | parseRevokedCertificates = 97 | fmap (maybe [] id) $ onNextContainerMaybe Sequence $ getMany getObject 98 | 99 | parseCRLExtensions :: ParseASN1 Extensions 100 | parseCRLExtensions = 101 | fmap adapt $ onNextContainerMaybe (Container Context 0) $ getObject 102 | where adapt (Just e) = e 103 | adapt Nothing = Extensions Nothing 104 | 105 | encodeCRL :: CRL -> ASN1S 106 | encodeCRL crl xs = 107 | [IntVal $ crlVersion crl] ++ 108 | toASN1 (crlSignatureAlg crl) [] ++ 109 | toASN1 (crlIssuer crl) [] ++ 110 | [ASN1Time TimeGeneralized (crlThisUpdate crl) (Just (TimezoneOffset 0))] ++ 111 | (maybe [] (\t -> [ASN1Time TimeGeneralized t (Just (TimezoneOffset 0))]) (crlNextUpdate crl)) ++ 112 | maybeRevoked (crlRevokedCertificates crl) ++ 113 | maybeCrlExts (crlExtensions crl) ++ 114 | xs 115 | where 116 | maybeRevoked [] = [] 117 | maybeRevoked xs' = asn1Container Sequence $ concatMap (\e -> toASN1 e []) xs' 118 | maybeCrlExts (Extensions Nothing) = [] 119 | maybeCrlExts exts = asn1Container (Container Context 0) $ toASN1 exts [] 120 | -------------------------------------------------------------------------------- /x509/Data/X509/Cert.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Cert 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- X.509 Certificate types and functions 9 | -- 10 | {-# LANGUAGE FlexibleContexts #-} 11 | 12 | module Data.X509.Cert (Certificate(..)) where 13 | 14 | import Data.ASN1.Types 15 | import Control.Applicative ((<$>), (<*>)) 16 | import Data.X509.Internal 17 | import Data.X509.PublicKey 18 | import Data.X509.AlgorithmIdentifier 19 | import Data.X509.DistinguishedName 20 | import Data.X509.ExtensionRaw 21 | import Data.Hourglass 22 | 23 | data CertKeyUsage = 24 | CertKeyUsageDigitalSignature 25 | | CertKeyUsageNonRepudiation 26 | | CertKeyUsageKeyEncipherment 27 | | CertKeyUsageDataEncipherment 28 | | CertKeyUsageKeyAgreement 29 | | CertKeyUsageKeyCertSign 30 | | CertKeyUsageCRLSign 31 | | CertKeyUsageEncipherOnly 32 | | CertKeyUsageDecipherOnly 33 | deriving (Show, Eq) 34 | 35 | -- | X.509 Certificate type. 36 | -- 37 | -- This type doesn't include the signature, it's describe in the RFC 38 | -- as tbsCertificate. 39 | data Certificate = Certificate 40 | { certVersion :: Int -- ^ Version 41 | , certSerial :: Integer -- ^ Serial number 42 | , certSignatureAlg :: SignatureALG -- ^ Signature algorithm 43 | , certIssuerDN :: DistinguishedName -- ^ Issuer DN 44 | , certValidity :: (DateTime, DateTime) -- ^ Validity period (UTC) 45 | , certSubjectDN :: DistinguishedName -- ^ Subject DN 46 | , certPubKey :: PubKey -- ^ Public key 47 | , certExtensions :: Extensions -- ^ Extensions 48 | } deriving (Show,Eq) 49 | 50 | instance ASN1Object Certificate where 51 | toASN1 certificate = \xs -> encodeCertificateHeader certificate ++ xs 52 | fromASN1 s = runParseASN1State parseCertificate s 53 | 54 | parseCertHeaderVersion :: ParseASN1 Int 55 | parseCertHeaderVersion = 56 | maybe 0 id <$> onNextContainerMaybe (Container Context 0) (getNext >>= getVer) 57 | where getVer (IntVal v) = return $ fromIntegral v 58 | getVer _ = throwParseError "unexpected type for version" 59 | 60 | parseCertHeaderSerial :: ParseASN1 Integer 61 | parseCertHeaderSerial = do 62 | n <- getNext 63 | case n of 64 | IntVal v -> return v 65 | _ -> throwParseError ("missing serial" ++ show n) 66 | 67 | parseCertHeaderValidity :: ParseASN1 (DateTime, DateTime) 68 | parseCertHeaderValidity = getNextContainer Sequence >>= toTimeBound 69 | where toTimeBound [ ASN1Time _ t1 _, ASN1Time _ t2 _ ] = return (t1,t2) 70 | toTimeBound _ = throwParseError "bad validity format" 71 | 72 | {- | parse header structure of a x509 certificate. the structure is the following: 73 | Version 74 | Serial Number 75 | Algorithm ID 76 | Issuer 77 | Validity 78 | Not Before 79 | Not After 80 | Subject 81 | Subject Public Key Info 82 | Public Key Algorithm 83 | Subject Public Key 84 | Issuer Unique Identifier (Optional) (>= 2) 85 | Subject Unique Identifier (Optional) (>= 2) 86 | Extensions (Optional) (>= v3) 87 | -} 88 | 89 | parseExtensions :: ParseASN1 Extensions 90 | parseExtensions = fmap adapt $ onNextContainerMaybe (Container Context 3) $ getObject 91 | where adapt (Just e) = e 92 | adapt Nothing = Extensions Nothing 93 | 94 | parseCertificate :: ParseASN1 Certificate 95 | parseCertificate = 96 | Certificate <$> parseCertHeaderVersion 97 | <*> parseCertHeaderSerial 98 | <*> getObject 99 | <*> getObject 100 | <*> parseCertHeaderValidity 101 | <*> getObject 102 | <*> getObject 103 | <*> parseExtensions 104 | 105 | encodeCertificateHeader :: Certificate -> [ASN1] 106 | encodeCertificateHeader cert = 107 | eVer ++ eSerial ++ eAlgId ++ eIssuer ++ eValidity ++ eSubject ++ epkinfo ++ eexts 108 | where eVer = asn1Container (Container Context 0) [IntVal (fromIntegral $ certVersion cert)] 109 | eSerial = [IntVal $ certSerial cert] 110 | eAlgId = toASN1 (certSignatureAlg cert) [] 111 | eIssuer = toASN1 (certIssuerDN cert) [] 112 | (t1, t2) = certValidity cert 113 | eValidity = asn1Container Sequence [ASN1Time (timeType t1) t1 (Just (TimezoneOffset 0)) 114 | ,ASN1Time (timeType t2) t2 (Just (TimezoneOffset 0))] 115 | eSubject = toASN1 (certSubjectDN cert) [] 116 | epkinfo = toASN1 (certPubKey cert) [] 117 | eexts = case certExtensions cert of 118 | Extensions Nothing -> [] 119 | exts -> asn1Container (Container Context 3) $ toASN1 exts [] 120 | timeType t = 121 | if t >= timeConvert (Date 2050 January 1) 122 | then TimeGeneralized 123 | else TimeUTC 124 | -------------------------------------------------------------------------------- /x509/Data/X509/CertificateChain.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.CertificateChain 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | module Data.X509.CertificateChain 9 | ( CertificateChain(..) 10 | , CertificateChainRaw(..) 11 | -- * marshall between CertificateChain and CertificateChainRaw 12 | , decodeCertificateChain 13 | , encodeCertificateChain 14 | ) where 15 | 16 | import Data.X509.Cert (Certificate) 17 | import Data.X509.Signed (SignedExact, decodeSignedObject, encodeSignedObject) 18 | import Data.ByteString (ByteString) 19 | 20 | -- | A chain of X.509 certificates in exact form. 21 | newtype CertificateChain = CertificateChain [SignedExact Certificate] 22 | deriving (Show,Eq) 23 | 24 | -- | Represent a chain of X.509 certificates in bytestring form. 25 | newtype CertificateChainRaw = CertificateChainRaw [ByteString] 26 | deriving (Show,Eq) 27 | 28 | -- | Decode a CertificateChainRaw into a CertificateChain if every 29 | -- raw certificate are decoded correctly, otherwise return the index of the 30 | -- failed certificate and the error associated. 31 | decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain 32 | decodeCertificateChain (CertificateChainRaw l) = 33 | either Left (Right . CertificateChain) $ loop 0 l 34 | where loop _ [] = Right [] 35 | loop i (r:rs) = case decodeSignedObject r of 36 | Left err -> Left (i, err) 37 | Right o -> either Left (Right . (o :)) $ loop (i+1) rs 38 | 39 | -- | Convert a CertificateChain into a CertificateChainRaw 40 | encodeCertificateChain :: CertificateChain -> CertificateChainRaw 41 | encodeCertificateChain (CertificateChain chain) = 42 | CertificateChainRaw $ map encodeSignedObject chain 43 | -------------------------------------------------------------------------------- /x509/Data/X509/DistinguishedName.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.DistinguishedName 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- X.509 Distinguished names types and functions 9 | 10 | {-# LANGUAGE CPP #-} 11 | module Data.X509.DistinguishedName 12 | ( DistinguishedName(..) 13 | , DistinguishedNameInner(..) 14 | , ASN1CharacterString(..) 15 | -- Distinguished Name Elements 16 | , DnElement(..) 17 | , getDnElement 18 | ) where 19 | 20 | import Control.Applicative 21 | #if MIN_VERSION_base(4,9,0) 22 | import Data.Semigroup 23 | #else 24 | import Data.Monoid 25 | #endif 26 | import Data.ASN1.Types 27 | import Data.X509.Internal 28 | 29 | -- | A list of OID and strings. 30 | newtype DistinguishedName = DistinguishedName { getDistinguishedElements :: [(OID, ASN1CharacterString)] } 31 | deriving (Show,Eq,Ord) 32 | 33 | -- | Elements commonly available in a 'DistinguishedName' structure 34 | data DnElement = 35 | DnCommonName -- ^ CN 36 | | DnCountry -- ^ Country 37 | | DnOrganization -- ^ O 38 | | DnOrganizationUnit -- ^ OU 39 | | DnEmailAddress -- ^ Email Address (legacy) 40 | deriving (Show,Eq) 41 | 42 | instance OIDable DnElement where 43 | getObjectID DnCommonName = [2,5,4,3] 44 | getObjectID DnCountry = [2,5,4,6] 45 | getObjectID DnOrganization = [2,5,4,10] 46 | getObjectID DnOrganizationUnit = [2,5,4,11] 47 | getObjectID DnEmailAddress = [1,2,840,113549,1,9,1] 48 | 49 | -- | Try to get a specific element in a 'DistinguishedName' structure 50 | getDnElement :: DnElement -> DistinguishedName -> Maybe ASN1CharacterString 51 | getDnElement element (DistinguishedName els) = lookup (getObjectID element) els 52 | 53 | -- | Only use to encode a DistinguishedName without including it in a 54 | -- Sequence 55 | newtype DistinguishedNameInner = DistinguishedNameInner DistinguishedName 56 | deriving (Show,Eq) 57 | 58 | #if MIN_VERSION_base(4,9,0) 59 | instance Semigroup DistinguishedName where 60 | DistinguishedName l1 <> DistinguishedName l2 = DistinguishedName (l1++l2) 61 | #endif 62 | 63 | instance Monoid DistinguishedName where 64 | mempty = DistinguishedName [] 65 | #if !(MIN_VERSION_base(4,11,0)) 66 | mappend (DistinguishedName l1) (DistinguishedName l2) = DistinguishedName (l1++l2) 67 | #endif 68 | 69 | instance ASN1Object DistinguishedName where 70 | toASN1 dn = \xs -> encodeDN dn ++ xs 71 | fromASN1 = runParseASN1State parseDN 72 | 73 | -- FIXME parseDNInner in fromASN1 is probably wrong as we don't have a container 74 | -- and thus hasNext should be replaced by a isFinished clause. 75 | instance ASN1Object DistinguishedNameInner where 76 | toASN1 (DistinguishedNameInner dn) = \xs -> encodeDNinner dn ++ xs 77 | fromASN1 = runParseASN1State (DistinguishedNameInner . DistinguishedName <$> parseDNInner) 78 | 79 | parseDN :: ParseASN1 DistinguishedName 80 | parseDN = DistinguishedName <$> onNextContainer Sequence parseDNInner 81 | 82 | parseDNInner :: ParseASN1 [(OID, ASN1CharacterString)] 83 | parseDNInner = concat `fmap` getMany parseOneDN 84 | 85 | parseOneDN :: ParseASN1 [(OID, ASN1CharacterString)] 86 | parseOneDN = onNextContainer Set $ getMany $ do 87 | s <- getNextContainer Sequence 88 | case s of 89 | [OID oid, ASN1String cs] -> return (oid, cs) 90 | _ -> throwParseError ("expecting [OID,String] got " ++ show s) 91 | 92 | encodeDNinner :: DistinguishedName -> [ASN1] 93 | encodeDNinner (DistinguishedName dn) = concatMap dnSet dn 94 | where dnSet (oid, cs) = asn1Container Set $ asn1Container Sequence [OID oid, ASN1String cs] 95 | 96 | encodeDN :: DistinguishedName -> [ASN1] 97 | encodeDN dn = asn1Container Sequence $ encodeDNinner dn 98 | -------------------------------------------------------------------------------- /x509/Data/X509/EC.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.EC 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- Utilities related to Elliptic Curve certificates and keys. 9 | -- 10 | module Data.X509.EC 11 | ( 12 | unserializePoint 13 | , ecPubKeyCurve 14 | , ecPubKeyCurveName 15 | , ecPrivKeyCurve 16 | , ecPrivKeyCurveName 17 | , lookupCurveNameByOID 18 | ) where 19 | 20 | import Data.ASN1.OID 21 | import Data.List (find) 22 | 23 | import Data.X509.OID 24 | import Data.X509.PublicKey 25 | import Data.X509.PrivateKey 26 | 27 | import qualified Crypto.PubKey.ECC.Prim as ECC 28 | import qualified Crypto.PubKey.ECC.Types as ECC 29 | import Crypto.Number.Serialize (os2ip) 30 | 31 | import qualified Data.ByteString as B 32 | 33 | -- | Read an EC point from a serialized format and make sure the point is 34 | -- valid for the specified curve. 35 | unserializePoint :: ECC.Curve -> SerializedPoint -> Maybe ECC.Point 36 | unserializePoint curve (SerializedPoint bs) = 37 | case B.uncons bs of 38 | Nothing -> Nothing 39 | Just (ptFormat, input) -> 40 | case ptFormat of 41 | 4 -> if B.length input /= 2 * bytes 42 | then Nothing 43 | else 44 | let (x, y) = B.splitAt bytes input 45 | p = ECC.Point (os2ip x) (os2ip y) 46 | in if ECC.isPointValid curve p 47 | then Just p 48 | else Nothing 49 | -- 2 and 3 for compressed format. 50 | _ -> Nothing 51 | where bits = ECC.curveSizeBits curve 52 | bytes = (bits + 7) `div` 8 53 | 54 | -- | Return the curve associated to an EC Public Key. This does not check 55 | -- if a curve in explicit format is valid: if the input is not trusted one 56 | -- should consider 'ecPubKeyCurveName' instead. 57 | ecPubKeyCurve :: PubKeyEC -> Maybe ECC.Curve 58 | ecPubKeyCurve (PubKeyEC_Named name _) = Just $ ECC.getCurveByName name 59 | ecPubKeyCurve pub@PubKeyEC_Prime{} = 60 | fmap buildCurve $ 61 | unserializePoint (buildCurve undefined) (pubkeyEC_generator pub) 62 | where 63 | prime = pubkeyEC_prime pub 64 | buildCurve g = 65 | let cc = ECC.CurveCommon 66 | { ECC.ecc_a = pubkeyEC_a pub 67 | , ECC.ecc_b = pubkeyEC_b pub 68 | , ECC.ecc_g = g 69 | , ECC.ecc_n = pubkeyEC_order pub 70 | , ECC.ecc_h = pubkeyEC_cofactor pub 71 | } 72 | in ECC.CurveFP (ECC.CurvePrime prime cc) 73 | 74 | -- | Return the name of a standard curve associated to an EC Public Key 75 | ecPubKeyCurveName :: PubKeyEC -> Maybe ECC.CurveName 76 | ecPubKeyCurveName (PubKeyEC_Named name _) = Just name 77 | ecPubKeyCurveName pub@PubKeyEC_Prime{} = 78 | find matchPrimeCurve $ enumFrom $ toEnum 0 79 | where 80 | matchPrimeCurve c = 81 | case ECC.getCurveByName c of 82 | ECC.CurveFP (ECC.CurvePrime p cc) -> 83 | ECC.ecc_a cc == pubkeyEC_a pub && 84 | ECC.ecc_b cc == pubkeyEC_b pub && 85 | ECC.ecc_n cc == pubkeyEC_order pub && 86 | p == pubkeyEC_prime pub 87 | _ -> False 88 | 89 | -- | Return the EC curve associated to an EC Private Key. This does not check 90 | -- if a curve in explicit format is valid: if the input is not trusted one 91 | -- should consider 'ecPrivKeyCurveName' instead. 92 | ecPrivKeyCurve :: PrivKeyEC -> Maybe ECC.Curve 93 | ecPrivKeyCurve (PrivKeyEC_Named name _) = Just $ ECC.getCurveByName name 94 | ecPrivKeyCurve priv@PrivKeyEC_Prime{} = 95 | fmap buildCurve $ 96 | unserializePoint (buildCurve undefined) (privkeyEC_generator priv) 97 | where 98 | prime = privkeyEC_prime priv 99 | buildCurve g = 100 | let cc = ECC.CurveCommon 101 | { ECC.ecc_a = privkeyEC_a priv 102 | , ECC.ecc_b = privkeyEC_b priv 103 | , ECC.ecc_g = g 104 | , ECC.ecc_n = privkeyEC_order priv 105 | , ECC.ecc_h = privkeyEC_cofactor priv 106 | } 107 | in ECC.CurveFP (ECC.CurvePrime prime cc) 108 | 109 | -- | Return the name of a standard curve associated to an EC Private Key 110 | ecPrivKeyCurveName :: PrivKeyEC -> Maybe ECC.CurveName 111 | ecPrivKeyCurveName (PrivKeyEC_Named name _) = Just name 112 | ecPrivKeyCurveName priv@PrivKeyEC_Prime{} = 113 | find matchPrimeCurve $ enumFrom $ toEnum 0 114 | where 115 | matchPrimeCurve c = 116 | case ECC.getCurveByName c of 117 | ECC.CurveFP (ECC.CurvePrime p cc) -> 118 | ECC.ecc_a cc == privkeyEC_a priv && 119 | ECC.ecc_b cc == privkeyEC_b priv && 120 | ECC.ecc_n cc == privkeyEC_order priv && 121 | p == privkeyEC_prime priv 122 | _ -> False 123 | 124 | -- | Return the curve name associated to an OID 125 | lookupCurveNameByOID :: OID -> Maybe ECC.CurveName 126 | lookupCurveNameByOID = lookupByOID curvesOIDTable 127 | -------------------------------------------------------------------------------- /x509/Data/X509/Ext.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Ext 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- extension processing module. 9 | -- 10 | {-# LANGUAGE FlexibleContexts #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | module Data.X509.Ext 13 | ( Extension(..) 14 | -- * Common extension usually found in x509v3 15 | , ExtBasicConstraints(..) 16 | , ExtKeyUsage(..) 17 | , ExtKeyUsageFlag(..) 18 | , ExtExtendedKeyUsage(..) 19 | , ExtKeyUsagePurpose(..) 20 | , ExtSubjectKeyId(..) 21 | , ExtSubjectAltName(..) 22 | , ExtAuthorityKeyId(..) 23 | , ExtCrlDistributionPoints(..) 24 | , ExtNetscapeComment(..) 25 | , AltName(..) 26 | , DistributionPoint(..) 27 | , ReasonFlag(..) 28 | -- * Accessor turning extension into a specific one 29 | , extensionGet 30 | , extensionGetE 31 | , extensionDecode 32 | , extensionEncode 33 | ) where 34 | 35 | import qualified Data.ByteString as B 36 | import qualified Data.ByteString.Char8 as BC 37 | import Data.ASN1.Types 38 | import Data.ASN1.Parse 39 | import Data.ASN1.Encoding 40 | import Data.ASN1.BinaryEncoding 41 | import Data.ASN1.BitArray 42 | import Data.Proxy 43 | import Data.List (find) 44 | import Data.X509.ExtensionRaw 45 | import Data.X509.DistinguishedName 46 | import Control.Applicative 47 | import Control.Monad 48 | 49 | -- | key usage flag that is found in the key usage extension field. 50 | data ExtKeyUsageFlag = 51 | KeyUsage_digitalSignature -- (0) 52 | | KeyUsage_nonRepudiation -- (1) recent X.509 ver have renamed this bit to contentCommitment 53 | | KeyUsage_keyEncipherment -- (2) 54 | | KeyUsage_dataEncipherment -- (3) 55 | | KeyUsage_keyAgreement -- (4) 56 | | KeyUsage_keyCertSign -- (5) 57 | | KeyUsage_cRLSign -- (6) 58 | | KeyUsage_encipherOnly -- (7) 59 | | KeyUsage_decipherOnly -- (8) 60 | deriving (Show,Eq,Ord,Enum) 61 | 62 | {- 63 | -- RFC 5280 64 | oidDistributionPoints, oidPolicies, oidPoliciesMapping :: OID 65 | oidPolicies = [2,5,29,32] 66 | oidPoliciesMapping = [2,5,29,33] 67 | -} 68 | 69 | -- | Extension class. 70 | -- 71 | -- each extension have a unique OID associated, and a way 72 | -- to encode and decode an ASN1 stream. 73 | -- 74 | -- Errata: turns out, the content is not necessarily ASN1, 75 | -- it could be data that is only parsable by the extension 76 | -- e.g. raw ascii string. Add method to parse and encode with 77 | -- ByteString 78 | class Extension a where 79 | extOID :: a -> OID 80 | extHasNestedASN1 :: Proxy a -> Bool 81 | extEncode :: a -> [ASN1] 82 | extDecode :: [ASN1] -> Either String a 83 | 84 | extDecodeBs :: B.ByteString -> Either String a 85 | extDecodeBs = (either (Left . show) Right . decodeASN1' BER) >=> extDecode 86 | 87 | extEncodeBs :: a -> B.ByteString 88 | extEncodeBs = encodeASN1' DER . extEncode 89 | 90 | 91 | -- | Get a specific extension from a lists of raw extensions 92 | extensionGet :: Extension a => Extensions -> Maybe a 93 | extensionGet (Extensions Nothing) = Nothing 94 | extensionGet (Extensions (Just l)) = findExt l 95 | where findExt [] = Nothing 96 | findExt (x:xs) = case extensionDecode x of 97 | Just (Right e) -> Just e 98 | _ -> findExt xs 99 | 100 | -- | Get a specific extension from a lists of raw extensions 101 | extensionGetE :: Extension a => Extensions -> Maybe (Either String a) 102 | extensionGetE (Extensions Nothing) = Nothing 103 | extensionGetE (Extensions (Just l)) = findExt l 104 | where findExt [] = Nothing 105 | findExt (x:xs) = case extensionDecode x of 106 | Just r -> Just r 107 | _ -> findExt xs 108 | 109 | -- | Try to decode an ExtensionRaw. 110 | -- 111 | -- If this function return: 112 | -- * Nothing, the OID doesn't match 113 | -- * Just Left, the OID matched, but the extension couldn't be decoded 114 | -- * Just Right, the OID matched, and the extension has been succesfully decoded 115 | extensionDecode :: forall a . Extension a => ExtensionRaw -> Maybe (Either String a) 116 | extensionDecode er@(ExtensionRaw oid _ content) 117 | | extOID (undefined :: a) /= oid = Nothing 118 | | extHasNestedASN1 (Proxy :: Proxy a) = Just (tryExtRawASN1 er >>= extDecode) 119 | | otherwise = Just (extDecodeBs content) 120 | 121 | -- | Encode an Extension to extensionRaw 122 | extensionEncode :: forall a . Extension a => Bool -> a -> ExtensionRaw 123 | extensionEncode critical ext 124 | | extHasNestedASN1 (Proxy :: Proxy a) = ExtensionRaw (extOID ext) critical (encodeASN1' DER $ extEncode ext) 125 | | otherwise = ExtensionRaw (extOID ext) critical (extEncodeBs ext) 126 | 127 | -- | Basic Constraints 128 | data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer) 129 | deriving (Show,Eq) 130 | 131 | instance Extension ExtBasicConstraints where 132 | extOID = const [2,5,29,19] 133 | extHasNestedASN1 = const True 134 | extEncode (ExtBasicConstraints b Nothing) = [Start Sequence,Boolean b,End Sequence] 135 | extEncode (ExtBasicConstraints b (Just i)) = [Start Sequence,Boolean b,IntVal i,End Sequence] 136 | 137 | extDecode [Start Sequence,Boolean b,IntVal v,End Sequence] 138 | | v >= 0 = Right (ExtBasicConstraints b (Just v)) 139 | | otherwise = Left "invalid pathlen" 140 | extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b Nothing) 141 | extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False Nothing) 142 | extDecode _ = Left "unknown sequence" 143 | 144 | -- | Describe key usage 145 | data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag] 146 | deriving (Show,Eq) 147 | 148 | instance Extension ExtKeyUsage where 149 | extOID = const [2,5,29,15] 150 | extHasNestedASN1 = const True 151 | extEncode (ExtKeyUsage flags) = [BitString $ flagsToBits flags] 152 | extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits 153 | extDecode _ = Left "unknown sequence" 154 | 155 | -- | Key usage purposes for the ExtendedKeyUsage extension 156 | data ExtKeyUsagePurpose = 157 | KeyUsagePurpose_ServerAuth 158 | | KeyUsagePurpose_ClientAuth 159 | | KeyUsagePurpose_CodeSigning 160 | | KeyUsagePurpose_EmailProtection 161 | | KeyUsagePurpose_TimeStamping 162 | | KeyUsagePurpose_OCSPSigning 163 | | KeyUsagePurpose_Unknown OID 164 | deriving (Show,Eq,Ord) 165 | 166 | extKeyUsagePurposedOID :: [(OID, ExtKeyUsagePurpose)] 167 | extKeyUsagePurposedOID = 168 | [(keyUsagePurposePrefix 1, KeyUsagePurpose_ServerAuth) 169 | ,(keyUsagePurposePrefix 2, KeyUsagePurpose_ClientAuth) 170 | ,(keyUsagePurposePrefix 3, KeyUsagePurpose_CodeSigning) 171 | ,(keyUsagePurposePrefix 4, KeyUsagePurpose_EmailProtection) 172 | ,(keyUsagePurposePrefix 8, KeyUsagePurpose_TimeStamping) 173 | ,(keyUsagePurposePrefix 9, KeyUsagePurpose_OCSPSigning)] 174 | where keyUsagePurposePrefix r = [1,3,6,1,5,5,7,3,r] 175 | 176 | -- | Extended key usage extension 177 | data ExtExtendedKeyUsage = ExtExtendedKeyUsage [ExtKeyUsagePurpose] 178 | deriving (Show,Eq) 179 | 180 | instance Extension ExtExtendedKeyUsage where 181 | extOID = const [2,5,29,37] 182 | extHasNestedASN1 = const True 183 | extEncode (ExtExtendedKeyUsage purposes) = 184 | [Start Sequence] ++ map (OID . lookupRev) purposes ++ [End Sequence] 185 | where lookupRev (KeyUsagePurpose_Unknown oid) = oid 186 | lookupRev kup = maybe (error "unknown key usage purpose") fst $ find ((==) kup . snd) extKeyUsagePurposedOID 187 | extDecode l = ExtExtendedKeyUsage `fmap` (flip runParseASN1 l $ onNextContainer Sequence $ getMany $ do 188 | n <- getNext 189 | case n of 190 | OID o -> return $ maybe (KeyUsagePurpose_Unknown o) id $ lookup o extKeyUsagePurposedOID 191 | _ -> error "invalid content in extended key usage") 192 | 193 | -- | Provide a way to identify a public key by a short hash. 194 | data ExtSubjectKeyId = ExtSubjectKeyId B.ByteString 195 | deriving (Show,Eq) 196 | 197 | instance Extension ExtSubjectKeyId where 198 | extOID = const [2,5,29,14] 199 | extHasNestedASN1 = const True 200 | extEncode (ExtSubjectKeyId o) = [OctetString o] 201 | extDecode [OctetString o] = Right $ ExtSubjectKeyId o 202 | extDecode _ = Left "unknown sequence" 203 | 204 | -- | Different naming scheme use by the extension. 205 | -- 206 | -- Not all name types are available, missing: 207 | -- otherName 208 | -- x400Address 209 | -- directoryName 210 | -- ediPartyName 211 | -- registeredID 212 | -- 213 | data AltName = 214 | AltNameRFC822 String 215 | | AltNameDNS String 216 | | AltNameURI String 217 | | AltNameIP B.ByteString 218 | | AltNameXMPP String 219 | | AltNameDNSSRV String 220 | deriving (Show,Eq,Ord) 221 | 222 | -- | Provide a way to supply alternate name that can be 223 | -- used for matching host name. 224 | data ExtSubjectAltName = ExtSubjectAltName [AltName] 225 | deriving (Show,Eq,Ord) 226 | 227 | instance Extension ExtSubjectAltName where 228 | extOID = const [2,5,29,17] 229 | extHasNestedASN1 = const True 230 | extEncode (ExtSubjectAltName names) = encodeGeneralNames names 231 | extDecode l = runParseASN1 (ExtSubjectAltName <$> parseGeneralNames) l 232 | 233 | -- | Provide a mean to identify the public key corresponding to the private key 234 | -- used to signed a certificate. 235 | data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString 236 | deriving (Show,Eq) 237 | 238 | instance Extension ExtAuthorityKeyId where 239 | extOID _ = [2,5,29,35] 240 | extHasNestedASN1 = const True 241 | extEncode (ExtAuthorityKeyId keyid) = 242 | [Start Sequence,Other Context 0 keyid,End Sequence] 243 | extDecode [Start Sequence,Other Context 0 keyid,End Sequence] = 244 | Right $ ExtAuthorityKeyId keyid 245 | extDecode _ = Left "unknown sequence" 246 | 247 | -- | Identify how CRL information is obtained 248 | data ExtCrlDistributionPoints = ExtCrlDistributionPoints [DistributionPoint] 249 | deriving (Show,Eq) 250 | 251 | -- | Reason flag for the CRL 252 | data ReasonFlag = 253 | Reason_Unused 254 | | Reason_KeyCompromise 255 | | Reason_CACompromise 256 | | Reason_AffiliationChanged 257 | | Reason_Superseded 258 | | Reason_CessationOfOperation 259 | | Reason_CertificateHold 260 | | Reason_PrivilegeWithdrawn 261 | | Reason_AACompromise 262 | deriving (Show,Eq,Ord,Enum) 263 | 264 | -- | Distribution point as either some GeneralNames or a DN 265 | data DistributionPoint = 266 | DistributionPointFullName [AltName] 267 | | DistributionNameRelative DistinguishedName 268 | deriving (Show,Eq) 269 | 270 | instance Extension ExtCrlDistributionPoints where 271 | extOID _ = [2,5,29,31] 272 | extHasNestedASN1 = const True 273 | extEncode = error "extEncode ExtCrlDistributionPoints unimplemented" 274 | extDecode = error "extDecode ExtCrlDistributionPoints unimplemented" 275 | --extEncode (ExtCrlDistributionPoints ) 276 | 277 | parseGeneralNames :: ParseASN1 [AltName] 278 | parseGeneralNames = onNextContainer Sequence $ getMany getAddr 279 | where 280 | getAddr = do 281 | m <- onNextContainerMaybe (Container Context 0) getComposedAddr 282 | case m of 283 | Nothing -> getSimpleAddr 284 | Just r -> return r 285 | getComposedAddr = do 286 | n <- getNext 287 | case n of 288 | OID [1,3,6,1,5,5,7,8,5] -> do -- xmpp addr 289 | c <- getNextContainerMaybe (Container Context 0) 290 | case c of 291 | Just [ASN1String cs] -> 292 | case asn1CharacterToString cs of 293 | Nothing -> throwParseError ("GeneralNames: invalid string for XMPP Addr") 294 | Just s -> return $ AltNameXMPP s 295 | _ -> throwParseError ("GeneralNames: expecting string for XMPP Addr got: " ++ show c) 296 | OID [1,3,6,1,5,5,7,8,7] -> do -- DNSSRV addr 297 | c <- getNextContainerMaybe (Container Context 0) 298 | case c of 299 | Just [ASN1String cs] -> 300 | case asn1CharacterToString cs of 301 | Nothing -> throwParseError ("GeneralNames: invalid string for DNSSrv Addr") 302 | Just s -> return $ AltNameDNSSRV s 303 | _ -> throwParseError ("GeneralNames: expecting string for DNSSRV Addr got: " ++ show c) 304 | OID unknown -> throwParseError ("GeneralNames: unknown OID " ++ show unknown) 305 | _ -> throwParseError ("GeneralNames: expecting OID but got " ++ show n) 306 | 307 | getSimpleAddr = do 308 | n <- getNext 309 | case n of 310 | (Other Context 1 b) -> return $ AltNameRFC822 $ BC.unpack b 311 | (Other Context 2 b) -> return $ AltNameDNS $ BC.unpack b 312 | (Other Context 6 b) -> return $ AltNameURI $ BC.unpack b 313 | (Other Context 7 b) -> return $ AltNameIP b 314 | _ -> throwParseError ("GeneralNames: not coping with unknown stream " ++ show n) 315 | 316 | encodeGeneralNames :: [AltName] -> [ASN1] 317 | encodeGeneralNames names = 318 | [Start Sequence] 319 | ++ concatMap encodeAltName names 320 | ++ [End Sequence] 321 | where encodeAltName (AltNameRFC822 n) = [Other Context 1 $ BC.pack n] 322 | encodeAltName (AltNameDNS n) = [Other Context 2 $ BC.pack n] 323 | encodeAltName (AltNameURI n) = [Other Context 6 $ BC.pack n] 324 | encodeAltName (AltNameIP n) = [Other Context 7 $ n] 325 | encodeAltName (AltNameXMPP n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5] 326 | ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0) 327 | ,End (Container Context 0)] 328 | encodeAltName (AltNameDNSSRV n) = [Start (Container Context 0),OID[1,3,6,1,5,5,7,8,5] 329 | ,Start (Container Context 0), ASN1String $ asn1CharacterString UTF8 n, End (Container Context 0) 330 | ,End (Container Context 0)] 331 | 332 | bitsToFlags :: Enum a => BitArray -> [a] 333 | bitsToFlags bits = concat $ flip map [0..(bitArrayLength bits-1)] $ \i -> do 334 | let isSet = bitArrayGetBit bits i 335 | if isSet then [toEnum $ fromIntegral i] else [] 336 | 337 | flagsToBits :: Enum a => [a] -> BitArray 338 | flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags 339 | where bitArrayEmpty = toBitArray (B.pack [0,0]) 7 340 | 341 | data ExtNetscapeComment = ExtNetscapeComment B.ByteString 342 | deriving (Show,Eq) 343 | 344 | instance Extension ExtNetscapeComment where 345 | extOID _ = [2,16,840,1,113730,1,13] 346 | extHasNestedASN1 = const False 347 | extEncode = error "Extension: Netscape Comment do not contain nested ASN1" 348 | extDecode = error "Extension: Netscape Comment do not contain nested ASN1" 349 | extEncodeBs (ExtNetscapeComment b) = b 350 | extDecodeBs = Right . ExtNetscapeComment 351 | -------------------------------------------------------------------------------- /x509/Data/X509/ExtensionRaw.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.ExtensionRaw 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- extension marshalling 9 | -- 10 | module Data.X509.ExtensionRaw 11 | ( ExtensionRaw(..) 12 | , tryExtRawASN1 13 | , extRawASN1 14 | , Extensions(..) 15 | ) where 16 | 17 | import Control.Applicative 18 | import Data.ASN1.Types 19 | import Data.ASN1.Encoding 20 | import Data.ASN1.BinaryEncoding 21 | import Data.X509.Internal 22 | import qualified Data.ByteString as B 23 | 24 | -- | An undecoded extension 25 | data ExtensionRaw = ExtensionRaw 26 | { extRawOID :: OID -- ^ OID of this extension 27 | , extRawCritical :: Bool -- ^ if this extension is critical 28 | , extRawContent :: B.ByteString -- ^ undecoded content 29 | } deriving (Show,Eq) 30 | 31 | tryExtRawASN1 :: ExtensionRaw -> Either String [ASN1] 32 | tryExtRawASN1 (ExtensionRaw oid _ content) = 33 | case decodeASN1' BER content of 34 | Left err -> Left $ "fromASN1: X509.ExtensionRaw: OID=" ++ show oid ++ ": cannot decode data: " ++ show err 35 | Right r -> Right r 36 | 37 | extRawASN1 :: ExtensionRaw -> [ASN1] 38 | extRawASN1 extRaw = either error id $ tryExtRawASN1 extRaw 39 | {-# DEPRECATED extRawASN1 "use tryExtRawASN1 instead" #-} 40 | 41 | -- | a Set of 'ExtensionRaw' 42 | newtype Extensions = Extensions (Maybe [ExtensionRaw]) 43 | deriving (Show,Eq) 44 | 45 | instance ASN1Object Extensions where 46 | toASN1 (Extensions Nothing) = \xs -> xs 47 | toASN1 (Extensions (Just exts)) = \xs -> 48 | asn1Container Sequence (concatMap encodeExt exts) ++ xs 49 | fromASN1 s = runParseASN1State (Extensions <$> parseExtensions) s 50 | where parseExtensions = onNextContainerMaybe Sequence (getMany getObject) 51 | 52 | instance ASN1Object ExtensionRaw where 53 | toASN1 extraw = \xs -> encodeExt extraw ++ xs 54 | fromASN1 (Start Sequence:OID oid:xs) = 55 | case xs of 56 | Boolean b:OctetString obj:End Sequence:xs2 -> Right (ExtensionRaw oid b obj, xs2) 57 | OctetString obj:End Sequence:xs2 -> Right (ExtensionRaw oid False obj, xs2) 58 | _ -> Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show xs) 59 | fromASN1 l = 60 | Left ("fromASN1: X509.ExtensionRaw: unknown format:" ++ show l) 61 | 62 | encodeExt :: ExtensionRaw -> [ASN1] 63 | encodeExt (ExtensionRaw oid critical content) = 64 | asn1Container Sequence ([OID oid] ++ (if critical then [Boolean True] else []) ++ [OctetString content]) 65 | -------------------------------------------------------------------------------- /x509/Data/X509/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Internal 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | module Data.X509.Internal 9 | ( module Data.ASN1.Parse 10 | , asn1Container 11 | , OID 12 | -- * error handling 13 | , ErrT 14 | , runErrT 15 | ) where 16 | 17 | import Data.ASN1.Types 18 | import Data.ASN1.Parse 19 | import Control.Monad.Trans.Except 20 | 21 | runErrT :: ExceptT e m a -> m (Either e a) 22 | runErrT = runExceptT 23 | type ErrT = ExceptT 24 | 25 | -- | create a container around the stream of ASN1 26 | asn1Container :: ASN1ConstructionType -> [ASN1] -> [ASN1] 27 | asn1Container ty l = [Start ty] ++ l ++ [End ty] 28 | -------------------------------------------------------------------------------- /x509/Data/X509/OID.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.OID 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | module Data.X509.OID 9 | ( OIDTable 10 | , lookupByOID 11 | , lookupOID 12 | , curvesOIDTable 13 | ) where 14 | 15 | import Control.Applicative 16 | import Crypto.PubKey.ECC.Types 17 | import Data.ASN1.OID 18 | import Data.List (find) 19 | 20 | type OIDTable a = [(a,OID)] 21 | 22 | lookupByOID :: OIDTable a -> OID -> Maybe a 23 | lookupByOID table oid = fst <$> find ((==) oid . snd) table 24 | 25 | lookupOID :: Eq a => OIDTable a -> a -> Maybe OID 26 | lookupOID table a = lookup a table 27 | 28 | curvesOIDTable :: OIDTable CurveName 29 | curvesOIDTable = 30 | [ (SEC_p112r1, [1,3,132,0,6]) 31 | , (SEC_p112r2, [1,3,132,0,7]) 32 | , (SEC_p128r1, [1,3,132,0,28]) 33 | , (SEC_p128r2, [1,3,132,0,29]) 34 | , (SEC_p160k1, [1,3,132,0,9]) 35 | , (SEC_p160r1, [1,3,132,0,8]) 36 | , (SEC_p160r2, [1,3,132,0,30]) 37 | , (SEC_p192k1, [1,3,132,0,31]) 38 | , (SEC_p192r1, [1,2,840,10045,3,1,1]) 39 | , (SEC_p224k1, [1,3,132,0,32]) 40 | , (SEC_p224r1, [1,3,132,0,33]) 41 | , (SEC_p256k1, [1,3,132,0,10]) 42 | , (SEC_p256r1, [1,2,840,10045,3,1,7]) 43 | , (SEC_p384r1, [1,3,132,0,34]) 44 | , (SEC_p521r1, [1,3,132,0,35]) 45 | , (SEC_t113r1, [1,3,132,0,4]) 46 | , (SEC_t113r2, [1,3,132,0,5]) 47 | , (SEC_t131r1, [1,3,132,0,22]) 48 | , (SEC_t131r2, [1,3,132,0,23]) 49 | , (SEC_t163k1, [1,3,132,0,1]) 50 | , (SEC_t163r1, [1,3,132,0,2]) 51 | , (SEC_t163r2, [1,3,132,0,15]) 52 | , (SEC_t193r1, [1,3,132,0,24]) 53 | , (SEC_t193r2, [1,3,132,0,25]) 54 | , (SEC_t233k1, [1,3,132,0,26]) 55 | , (SEC_t233r1, [1,3,132,0,27]) 56 | , (SEC_t239k1, [1,3,132,0,3]) 57 | , (SEC_t283k1, [1,3,132,0,16]) 58 | , (SEC_t283r1, [1,3,132,0,17]) 59 | , (SEC_t409k1, [1,3,132,0,36]) 60 | , (SEC_t409r1, [1,3,132,0,37]) 61 | , (SEC_t571k1, [1,3,132,0,38]) 62 | , (SEC_t571r1, [1,3,132,0,39]) 63 | ] 64 | -------------------------------------------------------------------------------- /x509/Data/X509/PrivateKey.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.PublicKey 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- Private key handling in X.509 infrastructure 9 | -- 10 | module Data.X509.PrivateKey 11 | ( PrivKey(..) 12 | , PrivKeyEC(..) 13 | , privkeyToAlg 14 | ) where 15 | 16 | import Control.Applicative ((<$>), pure) 17 | import Data.Maybe (fromMaybe) 18 | import Data.Word (Word) 19 | 20 | import Data.ByteArray (ByteArrayAccess, convert) 21 | import qualified Data.ByteString as B 22 | 23 | import Data.ASN1.Types 24 | import Data.ASN1.Encoding 25 | import Data.ASN1.BinaryEncoding 26 | import Data.ASN1.BitArray 27 | import Data.ASN1.Stream (getConstructedEnd) 28 | 29 | import Data.X509.AlgorithmIdentifier 30 | import Data.X509.PublicKey (SerializedPoint(..)) 31 | import Data.X509.OID (lookupByOID, lookupOID, curvesOIDTable) 32 | 33 | import Crypto.Error (CryptoFailable(..)) 34 | import Crypto.Number.Serialize (i2osp, os2ip) 35 | import qualified Crypto.PubKey.RSA as RSA 36 | import qualified Crypto.PubKey.DSA as DSA 37 | import qualified Crypto.PubKey.ECC.Types as ECC 38 | import qualified Crypto.PubKey.Curve25519 as X25519 39 | import qualified Crypto.PubKey.Curve448 as X448 40 | import qualified Crypto.PubKey.Ed25519 as Ed25519 41 | import qualified Crypto.PubKey.Ed448 as Ed448 42 | 43 | -- | Elliptic Curve Private Key 44 | -- 45 | -- TODO: missing support for binary curve. 46 | data PrivKeyEC = 47 | PrivKeyEC_Prime 48 | { privkeyEC_priv :: Integer 49 | , privkeyEC_a :: Integer 50 | , privkeyEC_b :: Integer 51 | , privkeyEC_prime :: Integer 52 | , privkeyEC_generator :: SerializedPoint 53 | , privkeyEC_order :: Integer 54 | , privkeyEC_cofactor :: Integer 55 | , privkeyEC_seed :: Integer 56 | } 57 | | PrivKeyEC_Named 58 | { privkeyEC_name :: ECC.CurveName 59 | , privkeyEC_priv :: Integer 60 | } 61 | deriving (Show,Eq) 62 | 63 | -- | Private key types known and used in X.509 64 | data PrivKey = 65 | PrivKeyRSA RSA.PrivateKey -- ^ RSA private key 66 | | PrivKeyDSA DSA.PrivateKey -- ^ DSA private key 67 | | PrivKeyEC PrivKeyEC -- ^ EC private key 68 | | PrivKeyX25519 X25519.SecretKey -- ^ X25519 private key 69 | | PrivKeyX448 X448.SecretKey -- ^ X448 private key 70 | | PrivKeyEd25519 Ed25519.SecretKey -- ^ Ed25519 private key 71 | | PrivKeyEd448 Ed448.SecretKey -- ^ Ed448 private key 72 | deriving (Show,Eq) 73 | 74 | instance ASN1Object PrivKey where 75 | fromASN1 = privkeyFromASN1 76 | toASN1 = privkeyToASN1 77 | 78 | privkeyFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1]) 79 | privkeyFromASN1 asn1 = 80 | (mapFst PrivKeyRSA <$> rsaFromASN1 asn1) 81 | (mapFst PrivKeyDSA <$> dsaFromASN1 asn1) 82 | (mapFst PrivKeyEC <$> ecdsaFromASN1 asn1) 83 | newcurveFromASN1 asn1 84 | where 85 | mapFst f (a, b) = (f a, b) 86 | 87 | Left _ b = b 88 | a _ = a 89 | 90 | rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1]) 91 | rsaFromASN1 (Start Sequence : IntVal 0 : IntVal n : IntVal e : IntVal d 92 | : IntVal p : IntVal q : IntVal dP : IntVal dQ : IntVal qinv 93 | : End Sequence : as) = pure (key, as) 94 | where 95 | key = RSA.PrivateKey (RSA.PublicKey (go n 1) n e) d p q dP dQ qinv 96 | go m i 97 | | 2 ^ (i * 8) > m = i 98 | | otherwise = go m (i + 1) 99 | rsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence 100 | : OID [1, 2, 840, 113549, 1, 1, 1] : Null : End Sequence 101 | : OctetString bytes : End Sequence : as) = do 102 | asn1 <- mapLeft failure (decodeASN1' BER bytes) 103 | fmap (const as) <$> rsaFromASN1 asn1 104 | where 105 | failure = ("rsaFromASN1: " ++) . show 106 | rsaFromASN1 _ = Left "rsaFromASN1: unexpected format" 107 | 108 | dsaFromASN1 :: [ASN1] -> Either String (DSA.PrivateKey, [ASN1]) 109 | dsaFromASN1 (Start Sequence : IntVal 0 : IntVal p : IntVal q : IntVal g 110 | : IntVal _ : IntVal x : End Sequence : as) = 111 | pure (DSA.PrivateKey (DSA.Params p g q) x, as) 112 | dsaFromASN1 (Start Sequence : IntVal 0 : Start Sequence 113 | : OID [1, 2, 840, 10040, 4, 1] : Start Sequence : IntVal p : IntVal q 114 | : IntVal g : End Sequence : End Sequence : OctetString bytes 115 | : End Sequence : as) = case decodeASN1' BER bytes of 116 | Right [IntVal x] -> pure (DSA.PrivateKey (DSA.Params p g q) x, as) 117 | Right _ -> Left "DSA.PrivateKey.fromASN1: unexpected format" 118 | Left e -> Left $ "DSA.PrivateKey.fromASN1: " ++ show e 119 | dsaFromASN1 _ = Left "DSA.PrivateKey.fromASN1: unexpected format" 120 | 121 | ecdsaFromASN1 :: [ASN1] -> Either String (PrivKeyEC, [ASN1]) 122 | ecdsaFromASN1 = go [] 123 | where 124 | failing = ("ECDSA.PrivateKey.fromASN1: " ++) 125 | 126 | go acc (Start Sequence : IntVal 1 : OctetString bytes : rest) = do 127 | key <- subgo (oid ++ acc) 128 | case rest'' of 129 | End Sequence : rest''' -> pure (key, rest''') 130 | _ -> Left $ failing "unexpected EC format" 131 | where 132 | d = os2ip bytes 133 | (oid, rest') = spanTag 0 rest 134 | (_, rest'') = spanTag 1 rest' 135 | subgo (OID oid_ : _) = maybe failure success mcurve 136 | where 137 | failure = Left $ failing $ "unknown curve " ++ show oid_ 138 | success = Right . flip PrivKeyEC_Named d 139 | mcurve = lookupByOID curvesOIDTable oid_ 140 | subgo (Start Sequence : IntVal 1 : Start Sequence 141 | : OID [1, 2, 840, 10045, 1, 1] : IntVal p : End Sequence 142 | : Start Sequence : OctetString a : OctetString b : BitString s 143 | : End Sequence : OctetString g : IntVal o : IntVal c 144 | : End Sequence : _) = 145 | pure $ PrivKeyEC_Prime d a' b' p g' o c s' 146 | where 147 | a' = os2ip a 148 | b' = os2ip b 149 | g' = SerializedPoint g 150 | s' = os2ip $ bitArrayGetData s 151 | subgo (Null : rest_) = subgo rest_ 152 | subgo [] = Left $ failing "curve is missing" 153 | subgo _ = Left $ failing "unexpected curve format" 154 | go acc (Start Sequence : IntVal 0 : Start Sequence 155 | : OID [1, 2, 840, 10045, 2, 1] : rest) = case rest' of 156 | (OctetString bytes : rest'') -> do 157 | asn1 <- mapLeft (failing . show) (decodeASN1' BER bytes) 158 | fmap (const rest'') <$> go (oid ++ acc) asn1 159 | _ -> Left $ failing "unexpected EC format" 160 | where 161 | (oid, rest') = spanEnd 0 rest 162 | go _ _ = Left $ failing "unexpected EC format" 163 | 164 | spanEnd :: Word -> [ASN1] -> ([ASN1], [ASN1]) 165 | spanEnd = loop id 166 | where 167 | loop dlist n (a@(Start _) : as) = loop (dlist . (a :)) (n + 1) as 168 | loop dlist 0 (End _ : as) = (dlist [], as) 169 | loop dlist n (a@(End _) : as) = loop (dlist . (a :)) (n - 1) as 170 | loop dlist n (a : as) = loop (dlist . (a :)) n as 171 | loop dlist _ [] = (dlist [], []) 172 | 173 | spanTag :: Int -> [ASN1] -> ([ASN1], [ASN1]) 174 | spanTag a (Start (Container _ b) : as) | a == b = spanEnd 0 as 175 | spanTag _ as = ([], as) 176 | 177 | newcurveFromASN1 :: [ASN1] -> Either String (PrivKey, [ASN1]) 178 | newcurveFromASN1 ( Start Sequence 179 | : IntVal v 180 | : Start Sequence 181 | : OID oid 182 | : End Sequence 183 | : OctetString bs 184 | : xs) 185 | | isValidVersion v = do 186 | let (_, ys) = containerWithTag 0 xs 187 | case primitiveWithTag 1 ys of 188 | (_, End Sequence : zs) -> 189 | case getP oid of 190 | Just (name, parse) -> do 191 | let err s = Left (name ++ ".SecretKey.fromASN1: " ++ s) 192 | case decodeASN1' BER bs of 193 | Right [OctetString key] -> 194 | case parse key of 195 | CryptoPassed s -> Right (s, zs) 196 | CryptoFailed e -> err ("invalid secret key: " ++ show e) 197 | Right _ -> err "unexpected inner format" 198 | Left e -> err (show e) 199 | Nothing -> Left ("newcurveFromASN1: unexpected OID " ++ show oid) 200 | _ -> Left "newcurveFromASN1: unexpected end format" 201 | | otherwise = Left ("newcurveFromASN1: unexpected version: " ++ show v) 202 | where 203 | getP [1,3,101,110] = Just ("X25519", fmap PrivKeyX25519 . X25519.secretKey) 204 | getP [1,3,101,111] = Just ("X448", fmap PrivKeyX448 . X448.secretKey) 205 | getP [1,3,101,112] = Just ("Ed25519", fmap PrivKeyEd25519 . Ed25519.secretKey) 206 | getP [1,3,101,113] = Just ("Ed448", fmap PrivKeyEd448 . Ed448.secretKey) 207 | getP _ = Nothing 208 | isValidVersion version = version >= 0 && version <= 1 209 | newcurveFromASN1 _ = 210 | Left "newcurveFromASN1: unexpected format" 211 | 212 | containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1]) 213 | containerWithTag etag (Start (Container _ atag) : xs) 214 | | etag == atag = getConstructedEnd 0 xs 215 | containerWithTag _ xs = ([], xs) 216 | 217 | primitiveWithTag :: ASN1Tag -> [ASN1] -> (Maybe B.ByteString, [ASN1]) 218 | primitiveWithTag etag (Other _ atag bs : xs) 219 | | etag == atag = (Just bs, xs) 220 | primitiveWithTag _ xs = (Nothing, xs) 221 | 222 | privkeyToASN1 :: PrivKey -> ASN1S 223 | privkeyToASN1 (PrivKeyRSA rsa) = rsaToASN1 rsa 224 | privkeyToASN1 (PrivKeyDSA dsa) = dsaToASN1 dsa 225 | privkeyToASN1 (PrivKeyEC ecdsa) = ecdsaToASN1 ecdsa 226 | privkeyToASN1 (PrivKeyX25519 k) = newcurveToASN1 [1,3,101,110] k 227 | privkeyToASN1 (PrivKeyX448 k) = newcurveToASN1 [1,3,101,111] k 228 | privkeyToASN1 (PrivKeyEd25519 k) = newcurveToASN1 [1,3,101,112] k 229 | privkeyToASN1 (PrivKeyEd448 k) = newcurveToASN1 [1,3,101,113] k 230 | 231 | rsaToASN1 :: RSA.PrivateKey -> ASN1S 232 | rsaToASN1 key = (++) 233 | [ Start Sequence, IntVal 0, IntVal n, IntVal e, IntVal d, IntVal p 234 | , IntVal q, IntVal dP, IntVal dQ, IntVal qinv, End Sequence 235 | ] 236 | where 237 | RSA.PrivateKey (RSA.PublicKey _ n e) d p q dP dQ qinv = key 238 | 239 | dsaToASN1 :: DSA.PrivateKey -> ASN1S 240 | dsaToASN1 (DSA.PrivateKey params@(DSA.Params p g q) y) = (++) 241 | [ Start Sequence, IntVal 0, IntVal p, IntVal q, IntVal g, IntVal x 242 | , IntVal y, End Sequence 243 | ] 244 | where 245 | x = DSA.calculatePublic params y 246 | 247 | ecdsaToASN1 :: PrivKeyEC -> ASN1S 248 | ecdsaToASN1 (PrivKeyEC_Named curveName d) = (++) 249 | [ Start Sequence, IntVal 1, OctetString (i2osp d) 250 | , Start (Container Context 0), OID oid, End (Container Context 0) 251 | , End Sequence 252 | ] 253 | where 254 | err = error . ("ECDSA.PrivateKey.toASN1: " ++) 255 | oid = fromMaybe (err $ "missing named curve " ++ show curveName) 256 | (lookupOID curvesOIDTable curveName) 257 | ecdsaToASN1 (PrivKeyEC_Prime d a b p g o c s) = (++) 258 | [ Start Sequence, IntVal 1, OctetString (i2osp d) 259 | , Start (Container Context 0), Start Sequence, IntVal 1 260 | , Start Sequence, OID [1, 2, 840, 10045, 1, 1], IntVal p, End Sequence 261 | , Start Sequence, OctetString a', OctetString b', BitString s' 262 | , End Sequence, OctetString g' , IntVal o, IntVal c, End Sequence 263 | , End (Container Context 0), End Sequence 264 | ] 265 | where 266 | a' = i2osp a 267 | b' = i2osp b 268 | SerializedPoint g' = g 269 | s' = BitArray (8 * fromIntegral (B.length bytes)) bytes 270 | where 271 | bytes = i2osp s 272 | 273 | newcurveToASN1 :: ByteArrayAccess key => OID -> key -> ASN1S 274 | newcurveToASN1 oid key = (++) 275 | [ Start Sequence, IntVal 0, Start Sequence, OID oid, End Sequence 276 | , OctetString (encodeASN1' DER [OctetString $ convert key]) 277 | , End Sequence 278 | ] 279 | 280 | mapLeft :: (a0 -> a1) -> Either a0 b -> Either a1 b 281 | mapLeft f (Left x) = Left (f x) 282 | mapLeft _ (Right x) = Right x 283 | 284 | -- | Convert a Private key to the Public Key Algorithm type 285 | privkeyToAlg :: PrivKey -> PubKeyALG 286 | privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA 287 | privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA 288 | privkeyToAlg (PrivKeyEC _) = PubKeyALG_EC 289 | privkeyToAlg (PrivKeyX25519 _) = PubKeyALG_X25519 290 | privkeyToAlg (PrivKeyX448 _) = PubKeyALG_X448 291 | privkeyToAlg (PrivKeyEd25519 _) = PubKeyALG_Ed25519 292 | privkeyToAlg (PrivKeyEd448 _) = PubKeyALG_Ed448 293 | -------------------------------------------------------------------------------- /x509/Data/X509/PublicKey.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.PublicKey 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- Public key handling in X.509 infrastructure 9 | -- 10 | module Data.X509.PublicKey 11 | ( PubKey(..) 12 | , PubKeyEC(..) 13 | , SerializedPoint(..) 14 | , pubkeyToAlg 15 | ) where 16 | 17 | import Data.ASN1.Types 18 | import Data.ASN1.Encoding 19 | import Data.ASN1.BinaryEncoding 20 | import Data.ASN1.BitArray 21 | 22 | import Data.Bits 23 | import Data.ByteArray (convert) 24 | import Data.ByteString (ByteString) 25 | 26 | import Data.X509.Internal 27 | import Data.X509.OID 28 | import Data.X509.AlgorithmIdentifier 29 | 30 | import Crypto.Error (CryptoFailable(..)) 31 | import qualified Crypto.PubKey.RSA.Types as RSA 32 | import qualified Crypto.PubKey.DSA as DSA 33 | import qualified Crypto.PubKey.ECC.Types as ECC 34 | import qualified Crypto.PubKey.Curve25519 as X25519 35 | import qualified Crypto.PubKey.Curve448 as X448 36 | import qualified Crypto.PubKey.Ed25519 as Ed25519 37 | import qualified Crypto.PubKey.Ed448 as Ed448 38 | import Crypto.Number.Basic (numBytes) 39 | import Crypto.Number.Serialize (os2ip) 40 | import Data.Word 41 | 42 | import qualified Data.ByteString as B 43 | 44 | -- | Serialized Elliptic Curve Point 45 | newtype SerializedPoint = SerializedPoint ByteString 46 | deriving (Show,Eq) 47 | 48 | -- | Elliptic Curve Public Key 49 | -- 50 | -- TODO: missing support for binary curve. 51 | data PubKeyEC = 52 | PubKeyEC_Prime 53 | { pubkeyEC_pub :: SerializedPoint 54 | , pubkeyEC_a :: Integer 55 | , pubkeyEC_b :: Integer 56 | , pubkeyEC_prime :: Integer 57 | , pubkeyEC_generator :: SerializedPoint 58 | , pubkeyEC_order :: Integer 59 | , pubkeyEC_cofactor :: Integer 60 | , pubkeyEC_seed :: Integer 61 | } 62 | | PubKeyEC_Named 63 | { pubkeyEC_name :: ECC.CurveName 64 | , pubkeyEC_pub :: SerializedPoint 65 | } 66 | deriving (Show,Eq) 67 | 68 | -- | Public key types known and used in X.509 69 | data PubKey = 70 | PubKeyRSA RSA.PublicKey -- ^ RSA public key 71 | | PubKeyDSA DSA.PublicKey -- ^ DSA public key 72 | | PubKeyDH (Integer,Integer,Integer,Maybe Integer,([Word8], Integer)) 73 | -- ^ DH format with (p,g,q,j,(seed,pgenCounter)) 74 | | PubKeyEC PubKeyEC -- ^ EC public key 75 | | PubKeyX25519 X25519.PublicKey -- ^ X25519 public key 76 | | PubKeyX448 X448.PublicKey -- ^ X448 public key 77 | | PubKeyEd25519 Ed25519.PublicKey -- ^ Ed25519 public key 78 | | PubKeyEd448 Ed448.PublicKey -- ^ Ed448 public key 79 | | PubKeyUnknown OID B.ByteString -- ^ unrecognized format 80 | deriving (Show,Eq) 81 | 82 | -- Public key are in the format: 83 | -- 84 | -- Start Sequence 85 | -- OID (Public key algorithm) 86 | -- [public key specific format] 87 | -- BitString 88 | -- End Sequence 89 | instance ASN1Object PubKey where 90 | fromASN1 (Start Sequence:Start Sequence:OID pkalg:xs) 91 | | pkalg == getObjectID PubKeyALG_RSA = 92 | case removeNull xs of 93 | End Sequence:BitString bits:End Sequence:xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . rsaPubFromASN1) 94 | _ -> Left ("fromASN1: X509.PubKey: unknown RSA format: " ++ show xs) 95 | | pkalg == getObjectID PubKeyALG_DSA = 96 | case xs of 97 | Start Sequence:IntVal p:IntVal q:IntVal g:End Sequence:End Sequence:BitString bits:End Sequence:xs2 -> 98 | decodeASN1Err "DSA" bits xs2 (\l -> case l of 99 | [IntVal dsapub] -> 100 | let pubkey = DSA.PublicKey { DSA.public_params = DSA.Params { DSA.params_p = p 101 | , DSA.params_q = q 102 | , DSA.params_g = g 103 | } 104 | , DSA.public_y = dsapub } 105 | in Right (PubKeyDSA pubkey, []) 106 | _ -> Left "fromASN1: X509.PubKey: unknown DSA format" 107 | ) 108 | _ -> Left "fromASN1: X509.PubKey: unknown DSA format" 109 | | pkalg == getObjectID PubKeyALG_EC = 110 | case xs of 111 | OID curveOid:End Sequence:BitString bits:End Sequence:xs2 -> 112 | case lookupByOID curvesOIDTable curveOid of 113 | Just curveName -> Right (PubKeyEC $ PubKeyEC_Named curveName (bitArrayToPoint bits), xs2) 114 | Nothing -> Left ("fromASN1: X509.Pubkey: EC unknown curve " ++ show curveOid) 115 | Start Sequence 116 | :IntVal 1 117 | :Start Sequence 118 | :OID [1,2,840,10045,1,1] 119 | :IntVal prime 120 | :End Sequence 121 | :Start Sequence 122 | :OctetString a 123 | :OctetString b 124 | :BitString seed 125 | :End Sequence 126 | :OctetString generator 127 | :IntVal order 128 | :IntVal cofactor 129 | :End Sequence 130 | :End Sequence 131 | :BitString pub 132 | :End Sequence 133 | :xs2 -> 134 | Right (PubKeyEC $ PubKeyEC_Prime 135 | { pubkeyEC_pub = bitArrayToPoint pub 136 | , pubkeyEC_a = os2ip a 137 | , pubkeyEC_b = os2ip b 138 | , pubkeyEC_prime = prime 139 | , pubkeyEC_generator = SerializedPoint generator 140 | , pubkeyEC_order = order 141 | , pubkeyEC_cofactor = cofactor 142 | , pubkeyEC_seed = os2ip $ bitArrayGetData seed 143 | }, xs2) 144 | _ -> 145 | Left $ "fromASN1: X509.PubKey: unknown EC format: " ++ show xs 146 | | pkalg == getObjectID PubKeyALG_X25519 = 147 | case xs of 148 | End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "X25519" PubKeyX25519 bits xs2 X25519.publicKey 149 | _ -> Left ("fromASN1: X509.PubKey: unknown X25519 format: " ++ show xs) 150 | | pkalg == getObjectID PubKeyALG_X448 = 151 | case xs of 152 | End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "X448" PubKeyX448 bits xs2 X448.publicKey 153 | _ -> Left ("fromASN1: X509.PubKey: unknown X448 format: " ++ show xs) 154 | | pkalg == getObjectID PubKeyALG_Ed25519 = 155 | case xs of 156 | End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "Ed25519" PubKeyEd25519 bits xs2 Ed25519.publicKey 157 | _ -> Left ("fromASN1: X509.PubKey: unknown Ed25519 format: " ++ show xs) 158 | | pkalg == getObjectID PubKeyALG_Ed448 = 159 | case xs of 160 | End Sequence:BitString bits:End Sequence:xs2 -> decodeCF "Ed448" PubKeyEd448 bits xs2 Ed448.publicKey 161 | _ -> Left ("fromASN1: X509.PubKey: unknown Ed448 format: " ++ show xs) 162 | | otherwise = Left $ "fromASN1: unknown public key OID: " ++ show pkalg 163 | where decodeASN1Err format bits xs2 f = 164 | case decodeASN1' BER (bitArrayGetData bits) of 165 | Left err -> Left ("fromASN1: X509.PubKey " ++ format ++ " bitarray cannot be parsed: " ++ show err) 166 | Right s -> case f s of 167 | Left err -> Left err 168 | Right (r, xsinner) -> Right (r, xsinner ++ xs2) 169 | toPubKeyRSA = either Left (\(rsaKey, r) -> Right (PubKeyRSA rsaKey, r)) 170 | 171 | bitArrayToPoint = SerializedPoint . bitArrayGetData 172 | 173 | removeNull (Null:r) = r 174 | removeNull l = l 175 | 176 | decodeCF format c bits xs2 f = case f (bitArrayGetData bits) of 177 | CryptoPassed pk -> Right (c pk, xs2) 178 | CryptoFailed err -> Left ("fromASN1: X509.PubKey " ++ format ++ " bitarray contains an invalid public key: " ++ show err) 179 | 180 | fromASN1 l = Left ("fromASN1: X509.PubKey: unknown format:" ++ show l) 181 | toASN1 a = \xs -> encodePK a ++ xs 182 | 183 | -- | Convert a Public key to the Public Key Algorithm type 184 | pubkeyToAlg :: PubKey -> PubKeyALG 185 | pubkeyToAlg (PubKeyRSA _) = PubKeyALG_RSA 186 | pubkeyToAlg (PubKeyDSA _) = PubKeyALG_DSA 187 | pubkeyToAlg (PubKeyDH _) = PubKeyALG_DH 188 | pubkeyToAlg (PubKeyEC _) = PubKeyALG_EC 189 | pubkeyToAlg (PubKeyX25519 _) = PubKeyALG_X25519 190 | pubkeyToAlg (PubKeyX448 _) = PubKeyALG_X448 191 | pubkeyToAlg (PubKeyEd25519 _) = PubKeyALG_Ed25519 192 | pubkeyToAlg (PubKeyEd448 _) = PubKeyALG_Ed448 193 | pubkeyToAlg (PubKeyUnknown oid _) = PubKeyALG_Unknown oid 194 | 195 | encodePK :: PubKey -> [ASN1] 196 | encodePK key = asn1Container Sequence (encodeInner key) 197 | where 198 | pkalg = OID $ getObjectID $ pubkeyToAlg key 199 | encodeInner (PubKeyRSA pubkey) = 200 | asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0] 201 | where bits = encodeASN1' DER $ rsaPubToASN1 pubkey [] 202 | encodeInner (PubKeyDSA pubkey) = 203 | asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0] 204 | where 205 | dsaseq = asn1Container Sequence [IntVal (DSA.params_p params) 206 | ,IntVal (DSA.params_q params) 207 | ,IntVal (DSA.params_g params)] 208 | params = DSA.public_params pubkey 209 | bits = encodeASN1' DER [IntVal $ DSA.public_y pubkey] 210 | encodeInner (PubKeyEC (PubKeyEC_Named curveName (SerializedPoint bits))) = 211 | asn1Container Sequence [pkalg,OID eOid] ++ [BitString $ toBitArray bits 0] 212 | where 213 | eOid = case lookupOID curvesOIDTable curveName of 214 | Just oid -> oid 215 | _ -> error ("undefined curve OID: " ++ show curveName) 216 | encodeInner (PubKeyEC (PubKeyEC_Prime {})) = 217 | error "encodeInner: unimplemented public key EC_Prime" 218 | encodeInner (PubKeyX25519 pubkey) = 219 | asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] 220 | encodeInner (PubKeyX448 pubkey) = 221 | asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] 222 | encodeInner (PubKeyEd25519 pubkey) = 223 | asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] 224 | encodeInner (PubKeyEd448 pubkey) = 225 | asn1Container Sequence [pkalg] ++ [BitString $ toBitArray (convert pubkey) 0] 226 | encodeInner (PubKeyDH _) = error "encodeInner: unimplemented public key DH" 227 | encodeInner (PubKeyUnknown _ l) = 228 | asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray l 0] 229 | 230 | rsaPubToASN1 :: RSA.PublicKey -> [ASN1] -> [ASN1] 231 | rsaPubToASN1 pubkey xs = 232 | Start Sequence : IntVal (RSA.public_n pubkey) : IntVal (RSA.public_e pubkey) : End Sequence : xs 233 | 234 | rsaPubFromASN1 :: [ASN1] -> Either String (RSA.PublicKey, [ASN1]) 235 | rsaPubFromASN1 (Start Sequence:IntVal smodulus:IntVal pubexp:End Sequence:xs) = 236 | Right (pub, xs) 237 | where 238 | pub = RSA.PublicKey { RSA.public_size = numBytes modulus 239 | , RSA.public_n = modulus 240 | , RSA.public_e = pubexp 241 | } 242 | -- some bad implementation will not serialize ASN.1 integer properly, leading 243 | -- to negative modulus. if that's the case, we correct it. 244 | modulus = toPositive smodulus 245 | 246 | rsaPubFromASN1 ( Start Sequence 247 | : IntVal ver 248 | : Start Sequence 249 | : OID oid 250 | : Null 251 | : End Sequence 252 | : OctetString bs 253 | : xs 254 | ) 255 | | ver /= 0 = Left "rsaPubFromASN1: Invalid version, expecting 0" 256 | | oid /= [1,2,840,113549,1,1,1] = 257 | Left "rsaPubFromASN1: invalid OID" 258 | | otherwise = 259 | let inner = either strError rsaPubFromASN1 $ decodeASN1' BER bs 260 | strError = Left . ("fromASN1: RSA.PublicKey: " ++) . show 261 | in either Left (\(k, _) -> Right (k, xs)) inner 262 | rsaPubFromASN1 _ = 263 | Left "fromASN1: RSA.PublicKey: unexpected format" 264 | 265 | -- some bad implementation will not serialize ASN.1 integer properly, leading 266 | -- to negative modulus. 267 | toPositive :: Integer -> Integer 268 | toPositive int 269 | | int < 0 = uintOfBytes $ bytesOfInt int 270 | | otherwise = int 271 | where 272 | uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 273 | bytesOfInt :: Integer -> [Word8] 274 | bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints 275 | where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n) 276 | plusOne [] = [1] 277 | plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs 278 | bytesOfUInt x = reverse (list x) 279 | where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8) 280 | -------------------------------------------------------------------------------- /x509/Data/X509/Signed.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.X509.Signed 3 | -- License : BSD-style 4 | -- Maintainer : Vincent Hanquez 5 | -- Stability : experimental 6 | -- Portability : unknown 7 | -- 8 | -- Exposes helpers for X509 certificate and revocation list, signed structures. 9 | -- 10 | -- Signed structures are of the form: 11 | -- Sequence { 12 | -- object a 13 | -- signatureAlgorithm AlgorithmIdentifier 14 | -- signatureValue BitString 15 | -- } 16 | -- 17 | -- Unfortunately as lots of signed objects published have been signed on an 18 | -- arbitrary BER ASN1 encoding (instead of using the unique DER encoding) or in 19 | -- a non-valid DER implementation, we need to keep the raw data being signed, 20 | -- as we can't recompute the bytestring used to sign for non compliant cases. 21 | -- 22 | -- Signed represent the pure data type for compliant cases, and SignedExact 23 | -- the real world situation of having to deal with compliant and non-compliant cases. 24 | -- 25 | module Data.X509.Signed 26 | ( 27 | -- * Types 28 | Signed(..) 29 | , SignedExact 30 | -- * SignedExact to Signed 31 | , getSigned 32 | , getSignedData 33 | -- * Marshalling function 34 | , encodeSignedObject 35 | , decodeSignedObject 36 | -- * Object to Signed and SignedExact 37 | , objectToSignedExact 38 | , objectToSignedExactF 39 | , objectToSigned 40 | , signedToExact 41 | ) where 42 | 43 | import Control.Arrow (first) 44 | import Data.ByteString (ByteString) 45 | import qualified Data.ByteString as B 46 | import Data.X509.AlgorithmIdentifier 47 | import Data.ASN1.Types 48 | import Data.ASN1.Encoding 49 | import Data.ASN1.BinaryEncoding 50 | import Data.ASN1.Stream 51 | import Data.ASN1.BitArray 52 | import qualified Data.ASN1.BinaryEncoding.Raw as Raw (toByteString) 53 | 54 | -- | Represent a signed object using a traditional X509 structure. 55 | -- 56 | -- When dealing with external certificate, use the SignedExact structure 57 | -- not this one. 58 | data (Show a, Eq a, ASN1Object a) => Signed a = Signed 59 | { signedObject :: a -- ^ Object to sign 60 | , signedAlg :: SignatureALG -- ^ Signature Algorithm used 61 | , signedSignature :: B.ByteString -- ^ Signature as bytes 62 | } deriving (Show, Eq) 63 | 64 | -- | Represent the signed object plus the raw data that we need to 65 | -- keep around for non compliant case to be able to verify signature. 66 | data (Show a, Eq a, ASN1Object a) => SignedExact a = SignedExact 67 | { getSigned :: Signed a -- ^ get the decoded Signed data 68 | , exactObjectRaw :: B.ByteString -- ^ The raw representation of the object a 69 | -- TODO: in later version, replace with offset in exactRaw 70 | , encodeSignedObject :: B.ByteString -- ^ The raw representation of the whole signed structure 71 | } deriving (Show, Eq) 72 | 73 | -- | Get the signed data for the signature 74 | getSignedData :: (Show a, Eq a, ASN1Object a) 75 | => SignedExact a 76 | -> B.ByteString 77 | getSignedData = exactObjectRaw 78 | 79 | -- | make a 'SignedExact' copy of a 'Signed' object 80 | -- 81 | -- As the signature is already generated, expect the 82 | -- encoded object to have been made on a compliant DER ASN1 implementation. 83 | -- 84 | -- It's better to use 'objectToSignedExact' instead of this. 85 | signedToExact :: (Show a, Eq a, ASN1Object a) 86 | => Signed a 87 | -> SignedExact a 88 | signedToExact signed = sExact 89 | where (sExact, ()) = objectToSignedExact fakeSigFunction (signedObject signed) 90 | fakeSigFunction _ = (signedSignature signed, signedAlg signed, ()) 91 | 92 | -- | Transform an object into a 'SignedExact' object 93 | objectToSignedExact :: (Show a, Eq a, ASN1Object a) 94 | => (ByteString -> (ByteString, SignatureALG, r)) -- ^ signature function 95 | -> a -- ^ object to sign 96 | -> (SignedExact a, r) 97 | objectToSignedExact signatureFunction object = (signedExact, val) 98 | where 99 | (val, signedExact) = objectToSignedExactF (wrap . signatureFunction) object 100 | wrap (b, s, r) = (r, (b, s)) 101 | 102 | -- | A generalization of 'objectToSignedExact' where the signature function 103 | -- runs in an arbitrary functor. This allows for example to sign using an 104 | -- algorithm needing random values. 105 | objectToSignedExactF :: (Functor f, Show a, Eq a, ASN1Object a) 106 | => (ByteString -> f (ByteString, SignatureALG)) -- ^ signature function 107 | -> a -- ^ object to sign 108 | -> f (SignedExact a) 109 | objectToSignedExactF signatureFunction object = fmap buildSignedExact (signatureFunction objRaw) 110 | where buildSignedExact (sigBits,sigAlg) = 111 | let signed = Signed { signedObject = object 112 | , signedAlg = sigAlg 113 | , signedSignature = sigBits 114 | } 115 | signedRaw = encodeASN1' DER signedASN1 116 | signedASN1 = Start Sequence 117 | : objASN1 118 | (toASN1 sigAlg 119 | (BitString (toBitArray sigBits 0) 120 | : End Sequence 121 | : [])) 122 | in SignedExact signed objRaw signedRaw 123 | objASN1 = \xs -> Start Sequence : toASN1 object (End Sequence : xs) 124 | objRaw = encodeASN1' DER (objASN1 []) 125 | 126 | -- | Transform an object into a 'Signed' object. 127 | -- 128 | -- It's recommended to use the SignedExact object instead of Signed. 129 | objectToSigned :: (Show a, Eq a, ASN1Object a) 130 | => (ByteString 131 | -> (ByteString, SignatureALG, r)) 132 | -> a 133 | -> (Signed a, r) 134 | objectToSigned signatureFunction object = first getSigned $ objectToSignedExact signatureFunction object 135 | 136 | -- | Try to parse a bytestring that use the typical X509 signed structure format 137 | decodeSignedObject :: (Show a, Eq a, ASN1Object a) 138 | => ByteString 139 | -> Either String (SignedExact a) 140 | decodeSignedObject b = either (Left . show) parseSigned $ decodeASN1Repr' BER b 141 | where -- the following implementation is very inefficient. 142 | -- uses reverse and containing, move to a better solution eventually 143 | parseSigned l = onContainer (fst $ getConstructedEndRepr l) $ \l2 -> 144 | let (objRepr,rem1) = getConstructedEndRepr l2 145 | (sigAlgSeq,rem2) = getConstructedEndRepr rem1 146 | (sigSeq,_) = getConstructedEndRepr rem2 147 | obj = onContainer objRepr (either Left Right . fromASN1 . map fst) 148 | in case (obj, map fst sigSeq) of 149 | (Right (o,[]), [BitString signature]) -> 150 | let rawObj = Raw.toByteString $ concatMap snd objRepr 151 | in case fromASN1 $ map fst sigAlgSeq of 152 | Left s -> Left ("signed object error sigalg: " ++ s) 153 | Right (sigAlg,_) -> 154 | let signed = Signed 155 | { signedObject = o 156 | , signedAlg = sigAlg 157 | , signedSignature = bitArrayGetData signature 158 | } 159 | in Right $ SignedExact 160 | { getSigned = signed 161 | , exactObjectRaw = rawObj 162 | , encodeSignedObject = b 163 | } 164 | (Right (_,remObj), _) -> 165 | Left $ ("signed object error: remaining stream in object: " ++ show remObj) 166 | (Left err, _) -> Left $ ("signed object error: " ++ show err) 167 | onContainer ((Start _, _) : l) f = 168 | case reverse l of 169 | ((End _, _) : l2) -> f $ reverse l2 170 | _ -> f [] 171 | onContainer _ f = f [] 172 | -------------------------------------------------------------------------------- /x509/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010-2013 Vincent Hanquez 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /x509/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /x509/Tests/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | module Main where 3 | 4 | import Test.Tasty 5 | import Test.Tasty.QuickCheck 6 | 7 | import qualified Data.ByteString as B 8 | 9 | import Control.Applicative 10 | import Control.Monad 11 | 12 | import Data.List (nub, sort) 13 | import Data.ASN1.Types 14 | import Data.X509 15 | import Crypto.Error (throwCryptoError) 16 | import qualified Crypto.PubKey.Curve25519 as X25519 17 | import qualified Crypto.PubKey.Curve448 as X448 18 | import qualified Crypto.PubKey.Ed25519 as Ed25519 19 | import qualified Crypto.PubKey.Ed448 as Ed448 20 | import qualified Crypto.PubKey.RSA as RSA 21 | import qualified Crypto.PubKey.DSA as DSA 22 | 23 | import Data.Hourglass 24 | 25 | instance Arbitrary RSA.PublicKey where 26 | arbitrary = do 27 | bytes <- elements [64,128,256] 28 | e <- elements [0x3,0x10001] 29 | n <- choose (2^(8*(bytes-1)),2^(8*bytes)) 30 | return $ RSA.PublicKey { RSA.public_size = bytes 31 | , RSA.public_n = n 32 | , RSA.public_e = e 33 | } 34 | 35 | instance Arbitrary DSA.Params where 36 | arbitrary = DSA.Params <$> arbitrary <*> arbitrary <*> arbitrary 37 | 38 | instance Arbitrary DSA.PublicKey where 39 | arbitrary = DSA.PublicKey <$> arbitrary <*> arbitrary 40 | 41 | instance Arbitrary X25519.PublicKey where 42 | arbitrary = X25519.toPublic <$> arbitrary 43 | 44 | instance Arbitrary X448.PublicKey where 45 | arbitrary = X448.toPublic <$> arbitrary 46 | 47 | instance Arbitrary Ed25519.PublicKey where 48 | arbitrary = Ed25519.toPublic <$> arbitrary 49 | 50 | instance Arbitrary Ed448.PublicKey where 51 | arbitrary = Ed448.toPublic <$> arbitrary 52 | 53 | instance Arbitrary PubKey where 54 | arbitrary = oneof 55 | [ PubKeyRSA <$> arbitrary 56 | , PubKeyDSA <$> arbitrary 57 | --, PubKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary) 58 | , PubKeyX25519 <$> arbitrary 59 | , PubKeyX448 <$> arbitrary 60 | , PubKeyEd25519 <$> arbitrary 61 | , PubKeyEd448 <$> arbitrary 62 | ] 63 | 64 | instance Arbitrary RSA.PrivateKey where 65 | arbitrary = RSA.PrivateKey <$> arbitrary 66 | <*> arbitrary 67 | <*> arbitrary 68 | <*> arbitrary 69 | <*> arbitrary 70 | <*> arbitrary 71 | <*> arbitrary 72 | 73 | instance Arbitrary DSA.PrivateKey where 74 | arbitrary = DSA.PrivateKey <$> arbitrary <*> arbitrary 75 | 76 | instance Arbitrary X25519.SecretKey where 77 | arbitrary = throwCryptoError . X25519.secretKey <$> arbitraryBS 32 32 78 | 79 | instance Arbitrary X448.SecretKey where 80 | arbitrary = throwCryptoError . X448.secretKey <$> arbitraryBS 56 56 81 | 82 | instance Arbitrary Ed25519.SecretKey where 83 | arbitrary = throwCryptoError . Ed25519.secretKey <$> arbitraryBS 32 32 84 | 85 | instance Arbitrary Ed448.SecretKey where 86 | arbitrary = throwCryptoError . Ed448.secretKey <$> arbitraryBS 57 57 87 | 88 | instance Arbitrary PrivKey where 89 | arbitrary = oneof 90 | [ PrivKeyRSA <$> arbitrary 91 | , PrivKeyDSA <$> arbitrary 92 | --, PrivKeyECDSA ECDSA_Hash_SHA384 <$> (B.pack <$> replicateM 384 arbitrary) 93 | , PrivKeyX25519 <$> arbitrary 94 | , PrivKeyX448 <$> arbitrary 95 | , PrivKeyEd25519 <$> arbitrary 96 | , PrivKeyEd448 <$> arbitrary 97 | ] 98 | 99 | instance Arbitrary HashALG where 100 | arbitrary = elements [HashMD2,HashMD5,HashSHA1,HashSHA224,HashSHA256,HashSHA384,HashSHA512] 101 | 102 | instance Arbitrary PubKeyALG where 103 | arbitrary = elements [PubKeyALG_RSA,PubKeyALG_DSA,PubKeyALG_EC,PubKeyALG_DH] 104 | 105 | instance Arbitrary SignatureALG where 106 | -- unfortunately as the encoding of this is a single OID as opposed to two OID, 107 | -- the testing need to limit itself to Signature ALG that has been defined in the OID database. 108 | -- arbitrary = SignatureALG <$> arbitrary <*> arbitrary 109 | arbitrary = elements 110 | [ SignatureALG HashSHA1 PubKeyALG_RSA 111 | , SignatureALG HashMD5 PubKeyALG_RSA 112 | , SignatureALG HashMD2 PubKeyALG_RSA 113 | , SignatureALG HashSHA256 PubKeyALG_RSA 114 | , SignatureALG HashSHA384 PubKeyALG_RSA 115 | , SignatureALG HashSHA512 PubKeyALG_RSA 116 | , SignatureALG HashSHA224 PubKeyALG_RSA 117 | , SignatureALG HashSHA1 PubKeyALG_DSA 118 | , SignatureALG HashSHA224 PubKeyALG_DSA 119 | , SignatureALG HashSHA256 PubKeyALG_DSA 120 | , SignatureALG HashSHA224 PubKeyALG_EC 121 | , SignatureALG HashSHA256 PubKeyALG_EC 122 | , SignatureALG HashSHA384 PubKeyALG_EC 123 | , SignatureALG HashSHA512 PubKeyALG_EC 124 | , SignatureALG_IntrinsicHash PubKeyALG_Ed25519 125 | , SignatureALG_IntrinsicHash PubKeyALG_Ed448 126 | ] 127 | 128 | arbitraryBS r1 r2 = choose (r1,r2) >>= \l -> (B.pack <$> replicateM l arbitrary) 129 | 130 | instance Arbitrary ASN1StringEncoding where 131 | arbitrary = elements [IA5,UTF8] 132 | 133 | instance Arbitrary ASN1CharacterString where 134 | arbitrary = ASN1CharacterString <$> arbitrary <*> arbitraryBS 2 36 135 | 136 | instance Arbitrary DistinguishedName where 137 | arbitrary = DistinguishedName <$> (choose (1,5) >>= \l -> replicateM l arbitraryDE) 138 | where arbitraryDE = (,) <$> arbitrary <*> arbitrary 139 | 140 | instance Arbitrary DateTime where 141 | arbitrary = timeConvert <$> (arbitrary :: Gen Elapsed) 142 | instance Arbitrary Elapsed where 143 | arbitrary = Elapsed . Seconds <$> (choose (1, 100000000)) 144 | 145 | instance Arbitrary Extensions where 146 | arbitrary = Extensions <$> oneof 147 | [ pure Nothing 148 | , Just <$> (listOf1 $ oneof 149 | [ extensionEncode <$> arbitrary <*> (arbitrary :: Gen ExtKeyUsage) 150 | ] 151 | ) 152 | ] 153 | 154 | instance Arbitrary ExtKeyUsageFlag where 155 | arbitrary = elements $ enumFrom KeyUsage_digitalSignature 156 | instance Arbitrary ExtKeyUsage where 157 | arbitrary = ExtKeyUsage . sort . nub <$> listOf1 arbitrary 158 | 159 | instance Arbitrary ExtKeyUsagePurpose where 160 | arbitrary = elements [ KeyUsagePurpose_ServerAuth 161 | , KeyUsagePurpose_ClientAuth 162 | , KeyUsagePurpose_CodeSigning 163 | , KeyUsagePurpose_EmailProtection 164 | , KeyUsagePurpose_TimeStamping 165 | , KeyUsagePurpose_OCSPSigning ] 166 | instance Arbitrary ExtExtendedKeyUsage where 167 | arbitrary = ExtExtendedKeyUsage . nub <$> listOf1 arbitrary 168 | 169 | instance Arbitrary Certificate where 170 | arbitrary = Certificate <$> pure 2 171 | <*> arbitrary 172 | <*> arbitrary 173 | <*> arbitrary 174 | <*> arbitrary 175 | <*> arbitrary 176 | <*> arbitrary 177 | <*> arbitrary 178 | 179 | instance Arbitrary RevokedCertificate where 180 | arbitrary = RevokedCertificate <$> arbitrary 181 | <*> arbitrary 182 | <*> arbitrary 183 | 184 | instance Arbitrary CRL where 185 | arbitrary = CRL <$> pure 1 186 | <*> arbitrary 187 | <*> arbitrary 188 | <*> arbitrary 189 | <*> arbitrary 190 | <*> arbitrary 191 | <*> arbitrary 192 | 193 | property_unmarshall_marshall_id :: (Show o, Arbitrary o, ASN1Object o, Eq o) => o -> Bool 194 | property_unmarshall_marshall_id o = 195 | case got of 196 | Right (gotObject, []) 197 | | gotObject == o -> True 198 | | otherwise -> error ("object is different: " ++ show gotObject ++ " expecting " ++ show o) 199 | Right (gotObject, l) -> error ("state remaining: " ++ show l ++ " marshalled: " ++ show oMarshalled ++ " parsed: " ++ show gotObject) 200 | Left e -> error ("parsing failed: " ++ show e ++ " object: " ++ show o ++ " marshalled as: " ++ show oMarshalled) 201 | where got = fromASN1 oMarshalled 202 | oMarshalled = toASN1 o [] 203 | 204 | property_extension_id :: (Show e, Eq e, Extension e) => e -> Bool 205 | property_extension_id e = case extDecode (extEncode e) of 206 | Left err -> error err 207 | Right v | v == e -> True 208 | | otherwise -> error ("expected " ++ show e ++ " got: " ++ show v) 209 | 210 | main = defaultMain $ testGroup "X509" 211 | [ testGroup "marshall" 212 | [ testProperty "pubkey" (property_unmarshall_marshall_id :: PubKey -> Bool) 213 | , testProperty "privkey" (property_unmarshall_marshall_id :: PrivKey -> Bool) 214 | , testProperty "signature alg" (property_unmarshall_marshall_id :: SignatureALG -> Bool) 215 | , testGroup "extension" 216 | [ testProperty "key-usage" (property_extension_id :: ExtKeyUsage -> Bool) 217 | , testProperty "extended-key-usage" (property_extension_id :: ExtExtendedKeyUsage -> Bool) 218 | ] 219 | , testProperty "extensions" (property_unmarshall_marshall_id :: Extensions -> Bool) 220 | , testProperty "certificate" (property_unmarshall_marshall_id :: Certificate -> Bool) 221 | , testProperty "crl" (property_unmarshall_marshall_id :: CRL -> Bool) 222 | ] 223 | ] 224 | -------------------------------------------------------------------------------- /x509/x509.cabal: -------------------------------------------------------------------------------- 1 | Name: x509 2 | version: 1.7.6 3 | Description: X509 reader and writer. please see README 4 | License: BSD3 5 | License-file: LICENSE 6 | Copyright: Vincent Hanquez 7 | Author: Vincent Hanquez 8 | Maintainer: Vincent Hanquez 9 | Synopsis: X509 reader and writer 10 | Build-Type: Simple 11 | Category: Data 12 | stability: experimental 13 | Homepage: http://github.com/vincenthz/hs-certificate 14 | Cabal-Version: >= 1.10 15 | 16 | Library 17 | Default-Language: Haskell2010 18 | Build-Depends: base >= 4.7 && < 5 19 | , bytestring 20 | , memory 21 | , transformers >= 0.4 22 | , containers 23 | , hourglass 24 | , pem >= 0.1 25 | , asn1-types >= 0.3.1 && < 0.4 26 | , asn1-encoding >= 0.9 && < 0.10 27 | , asn1-parse >= 0.9.3 && < 0.10 28 | , cryptonite >= 0.24 29 | Exposed-modules: Data.X509 30 | Data.X509.EC 31 | Other-modules: Data.X509.Internal 32 | Data.X509.CertificateChain 33 | Data.X509.AlgorithmIdentifier 34 | Data.X509.DistinguishedName 35 | Data.X509.Cert 36 | Data.X509.PublicKey 37 | Data.X509.PrivateKey 38 | Data.X509.Ext 39 | Data.X509.ExtensionRaw 40 | Data.X509.CRL 41 | Data.X509.OID 42 | Data.X509.Signed 43 | ghc-options: -Wall 44 | 45 | Test-Suite test-x509 46 | Default-Language: Haskell2010 47 | type: exitcode-stdio-1.0 48 | hs-source-dirs: Tests 49 | Main-is: Tests.hs 50 | Build-Depends: base >= 3 && < 5 51 | , bytestring 52 | , mtl 53 | , tasty 54 | , tasty-quickcheck 55 | , hourglass 56 | , asn1-types 57 | , x509 58 | , cryptonite 59 | ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures 60 | 61 | source-repository head 62 | type: git 63 | location: git://github.com/vincenthz/hs-certificate 64 | subdir: x509 65 | --------------------------------------------------------------------------------