-- |
-- Module      : Data.X509
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Read/Write X509 Certificate, CRL and their signed equivalents.
--
-- Follows RFC5280 / RFC6818
--
module Data.X509
    (
    -- * Types
      SignedCertificate
    , SignedCRL
    , Certificate(..)
    , PubKey(..)
    , PubKeyEC(..)
    , SerializedPoint(..)
    , PrivKey(..)
    , PrivKeyEC(..)
    , pubkeyToAlg
    , privkeyToAlg
    , module Data.X509.AlgorithmIdentifier
    , module Data.X509.Ext
    , module Data.X509.ExtensionRaw

    -- * Certificate Revocation List (CRL)
    , module Data.X509.CRL

    -- * Naming
    , DistinguishedName(..)
    , DnElement(..)
    , ASN1CharacterString(..)
    , getDnElement

    -- * Certificate Chain
    , module Data.X509.CertificateChain

    -- * Signed types and marshalling
    , Signed(..)
    , SignedExact
    , getSigned
    , getSignedData
    , objectToSignedExact
    , objectToSignedExactF
    , encodeSignedObject
    , decodeSignedObject

    -- * Parametrized Signed accessor
    , getCertificate
    , getCRL
    , decodeSignedCertificate
    , decodeSignedCRL

    -- * Hash distinguished names related function
    , hashDN
    , hashDN_old
    ) where

import Control.Arrow (second)

import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import qualified Data.ByteString as B
import qualified Data.ByteArray as BA

import Data.X509.Cert
import Data.X509.Ext
import Data.X509.ExtensionRaw
import Data.X509.CRL
import Data.X509.CertificateChain
import Data.X509.DistinguishedName
import Data.X509.Signed
import Data.X509.PublicKey
import Data.X509.PrivateKey
import Data.X509.AlgorithmIdentifier

import Crypto.Hash

-- | A Signed Certificate
type SignedCertificate = SignedExact Certificate

-- | A Signed CRL
type SignedCRL         = SignedExact CRL

-- | Get the Certificate associated to a SignedCertificate
getCertificate :: SignedCertificate -> Certificate
getCertificate :: SignedCertificate -> Certificate
getCertificate = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned

-- | Get the CRL associated to a SignedCRL
getCRL :: SignedCRL -> CRL
getCRL :: SignedCRL -> CRL
getCRL = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
signedObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
getSigned

-- | Try to decode a bytestring to a SignedCertificate
decodeSignedCertificate :: B.ByteString -> Either String SignedCertificate
decodeSignedCertificate :: ByteString -> Either String SignedCertificate
decodeSignedCertificate = forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
decodeSignedObject

-- | Try to decode a bytestring to a SignedCRL
decodeSignedCRL :: B.ByteString -> Either String SignedCRL
decodeSignedCRL :: ByteString -> Either String SignedCRL
decodeSignedCRL = forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
decodeSignedObject

-- | Make an OpenSSL style hash of distinguished name
--
-- OpenSSL algorithm is odd, and has been replicated here somewhat.
-- only lower the case of ascii character.
hashDN :: DistinguishedName -> B.ByteString
hashDN :: DistinguishedName -> ByteString
hashDN = forall a. Digest a -> ByteString
shorten forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. ASN1Object a => a -> ASN1S
toASN1 [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistinguishedName -> DistinguishedNameInner
DistinguishedNameInner forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistinguishedName -> DistinguishedName
dnLowerUTF8
    where dnLowerUTF8 :: DistinguishedName -> DistinguishedName
dnLowerUTF8 (DistinguishedName [(OID, ASN1CharacterString)]
l) = [(OID, ASN1CharacterString)] -> DistinguishedName
DistinguishedName forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ASN1CharacterString -> ASN1CharacterString
toLowerUTF8) [(OID, ASN1CharacterString)]
l
          toLowerUTF8 :: ASN1CharacterString -> ASN1CharacterString
toLowerUTF8 (ASN1CharacterString ASN1StringEncoding
_ ByteString
s) = ASN1StringEncoding -> ByteString -> ASN1CharacterString
ASN1CharacterString ASN1StringEncoding
UTF8 ((Word8 -> Word8) -> ByteString -> ByteString
B.map Word8 -> Word8
asciiToLower ByteString
s)
          asciiToLower :: Word8 -> Word8
asciiToLower Word8
c
            | Word8
c forall a. Ord a => a -> a -> Bool
>= Word8
w8A Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
w8Z = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum Char
'A' forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Char
'a')
            | Bool
otherwise            = Word8
c
          w8A :: Word8
w8A = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Char
'A'
          w8Z :: Word8
w8Z = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Char
'Z'

-- | Create an openssl style old hash of distinguished name
hashDN_old :: DistinguishedName -> B.ByteString
hashDN_old :: DistinguishedName -> ByteString
hashDN_old = forall a. Digest a -> ByteString
shorten forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith MD5
MD5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. ASN1Object a => a -> ASN1S
toASN1 []

shorten :: Digest a -> B.ByteString
shorten :: forall a. Digest a -> ByteString
shorten Digest a
b = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
i [Int
3,Int
2,Int
1,Int
0]
    where i :: Int -> Word8
i Int
n = forall a. ByteArrayAccess a => a -> Int -> Word8
BA.index Digest a
b Int
n