    -- |
    -- Module      : Crypto.Store.X509
    -- License     : BSD-style
    -- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- Public keys, certificates and CRLs.
    --
    -- Presents an API similar to "Data.X509.Memory" and "Data.X509.File" but
    -- provides support for public-key files and allows to write objects.
    --
    -- Functions related to private keys are available from "Crypto.Store.PKCS8".
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    module Crypto.Store.X509
        ( SignedObject()
        -- * Public keys
        , readPubKeyFile
        , readPubKeyFileFromMemory
        , pemToPubKey
        , writePubKeyFile
        , writePubKeyFileToMemory
        , pubKeyToPEM
        -- * Signed objects
        , readSignedObject
        , readSignedObjectFromMemory
        , writeSignedObject
        , writeSignedObjectToMemory
        -- * Reading and writing PEM files
        , readPEMs
        , writePEMs
        ) where

    import Data.ASN1.Types
    import Data.ASN1.BinaryEncoding
    import Data.ASN1.Encoding
    import Data.Maybe
    import Data.Proxy
    import qualified Data.X509 as X509
    import qualified Data.ByteString as B
    import           Crypto.Number.Basic (numBytes)
    import qualified Crypto.PubKey.RSA as RSA

    import Crypto.Store.ASN1.Generate
    import Crypto.Store.ASN1.Parse
    import Crypto.Store.CMS.Util
    import Crypto.Store.PEM

    -- | Class of signed objects convertible to PEM.
    class (ASN1Object a, Eq a, Show a) => SignedObject a where
        signedObjectName :: proxy a -> String
        otherObjectNames :: proxy a -> [String]

    instance SignedObject X509.Certificate where
        signedObjectName :: forall (proxy :: * -> *). proxy Certificate -> String
    signedObjectName proxy Certificate
    _ = String
    "CERTIFICATE"
        otherObjectNames :: forall (proxy :: * -> *). proxy Certificate -> [String]
    otherObjectNames proxy Certificate
    _ = [String
    "X509 CERTIFICATE"]

    instance SignedObject X509.CRL where
        signedObjectName :: forall (proxy :: * -> *). proxy CRL -> String
    signedObjectName proxy CRL
    _ = String
    "X509 CRL"
        otherObjectNames :: forall (proxy :: * -> *). proxy CRL -> [String]
    otherObjectNames proxy CRL
    _ = []

    validObjectName :: SignedObject a => proxy a -> String -> Bool
    validObjectName :: forall a (proxy :: * -> *).
    SignedObject a =>
    proxy a -> String -> Bool
    validObjectName proxy a
    prx String
    name =
        String
    name String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == proxy a -> String
    forall a (proxy :: * -> *). SignedObject a => proxy a -> String
    forall (proxy :: * -> *). proxy a -> String
    signedObjectName proxy a
    prx Bool -> Bool -> Bool
    || String
    name String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` proxy a -> [String]
    forall a (proxy :: * -> *). SignedObject a => proxy a -> [String]
    forall (proxy :: * -> *). proxy a -> [String]
    otherObjectNames proxy a
    prx

    -- Reading from PEM format

    -- | Read public keys from a PEM file.
    readPubKeyFile :: FilePath -> IO [X509.PubKey]
    readPubKeyFile :: String -> IO [PubKey]
    readPubKeyFile String
    path = [PEM] -> [PubKey]
    accumulate ([PEM] -> [PubKey]) -> IO [PEM] -> IO [PubKey]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [PEM]
    readPEMs String
    path

    -- | Read public keys from a bytearray in PEM format.
    readPubKeyFileFromMemory :: B.ByteString -> [X509.PubKey]
    readPubKeyFileFromMemory :: ByteString -> [PubKey]
    readPubKeyFileFromMemory = (String -> [PubKey])
    -> ([PEM] -> [PubKey]) -> Either String [PEM] -> [PubKey]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([PubKey] -> String -> [PubKey]
    forall a b. a -> b -> a
    const []) [PEM] -> [PubKey]
    accumulate (Either String [PEM] -> [PubKey])
    -> (ByteString -> Either String [PEM]) -> ByteString -> [PubKey]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either String [PEM]
    pemParseBS

    accumulate :: [PEM] -> [X509.PubKey]
    accumulate :: [PEM] -> [PubKey]
    accumulate = [Maybe PubKey] -> [PubKey]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe PubKey] -> [PubKey])
    -> ([PEM] -> [Maybe PubKey]) -> [PEM] -> [PubKey]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PEM -> [Maybe PubKey] -> [Maybe PubKey])
    -> [Maybe PubKey] -> [PEM] -> [Maybe PubKey]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (([Maybe PubKey] -> PEM -> [Maybe PubKey])
    -> PEM -> [Maybe PubKey] -> [Maybe PubKey]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [Maybe PubKey] -> PEM -> [Maybe PubKey]
    pemToPubKey) []

    -- | Read a public key from a 'PEM' element and add it to the accumulator list.
    pemToPubKey :: [Maybe X509.PubKey] -> PEM -> [Maybe X509.PubKey]
    pemToPubKey :: [Maybe PubKey] -> PEM -> [Maybe PubKey]
    pemToPubKey [Maybe PubKey]
    acc PEM
    pem =
        case BER -> ByteString -> Either ASN1Error [ASN1]
    forall a.
    ASN1Decoding a =>
    a -> ByteString -> Either ASN1Error [ASN1]
    decodeASN1' BER
    BER (PEM -> ByteString
    pemContent PEM
    pem) of
            Left ASN1Error
    _     -> [Maybe PubKey]
    acc
            Right [ASN1]
    asn1 -> ([ASN1] -> Either String (PubKey, [ASN1]))
    -> [ASN1] -> Maybe PubKey
    forall {t} {a} {a} {a}. (t -> Either a (a, [a])) -> t -> Maybe a
    run (String -> [ASN1] -> Either String (PubKey, [ASN1])
    getParser (String -> [ASN1] -> Either String (PubKey, [ASN1]))
    -> String -> [ASN1] -> Either String (PubKey, [ASN1])
    forall a b. (a -> b) -> a -> b
    $ PEM -> String
    pemName PEM
    pem) [ASN1]
    asn1 Maybe PubKey -> [Maybe PubKey] -> [Maybe PubKey]
    forall a. a -> [a] -> [a]
    : [Maybe PubKey]
    acc

      where
        run :: (t -> Either a (a, [a])) -> t -> Maybe a
    run t -> Either a (a, [a])
    p t
    asn1 =
            case t -> Either a (a, [a])
    p t
    asn1 of
                Right (a
    pubKey, []) -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    pubKey
                Either a (a, [a])
    _                  -> Maybe a
    forall a. Maybe a
    Nothing

        getParser :: String -> [ASN1] -> Either String (PubKey, [ASN1])
    getParser String
    "PUBLIC KEY"           = [ASN1] -> Either String (PubKey, [ASN1])
    forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
    fromASN1
        getParser String
    "RSA PUBLIC KEY"       = ParseASN1 () PubKey -> [ASN1] -> Either String (PubKey, [ASN1])
    forall a. ParseASN1 () a -> [ASN1] -> Either String (a, [ASN1])
    runParseASN1State ParseASN1 () PubKey
    rsapkParser
        getParser String
    _                      = Either String (PubKey, [ASN1])
    -> [ASN1] -> Either String (PubKey, [ASN1])
    forall a b. a -> b -> a
    const (String -> Either String (PubKey, [ASN1])
    forall a b. a -> Either a b
    Left String
    forall a. HasCallStack => a
    undefined)

        rsapkParser :: ParseASN1 () PubKey
    rsapkParser = (\(RSAPublicKey PublicKey
    pub) -> PublicKey -> PubKey
    X509.PubKeyRSA PublicKey
    pub) (RSAPublicKey -> PubKey)
    -> ParseASN1 () RSAPublicKey -> ParseASN1 () PubKey
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParseASN1 () RSAPublicKey
    forall e obj. ParseASN1Object e obj => ParseASN1 e obj
    parse

    -- | Read signed objects from a PEM file (only one type at a time).
    readSignedObject :: SignedObject a => FilePath -> IO [X509.SignedExact a]
    readSignedObject :: forall a. SignedObject a => String -> IO [SignedExact a]
    readSignedObject String
    path = [PEM] -> [SignedExact a]
    forall a. SignedObject a => [PEM] -> [SignedExact a]
    accumulate' ([PEM] -> [SignedExact a]) -> IO [PEM] -> IO [SignedExact a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [PEM]
    readPEMs String
    path

    -- | Read signed objects from a bytearray in PEM format (only one type at a
    -- time).
    readSignedObjectFromMemory :: SignedObject a
                               => B.ByteString
                               -> [X509.SignedExact a]
    readSignedObjectFromMemory :: forall a. SignedObject a => ByteString -> [SignedExact a]
    readSignedObjectFromMemory = (String -> [SignedExact a])
    -> ([PEM] -> [SignedExact a])
    -> Either String [PEM]
    -> [SignedExact a]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([SignedExact a] -> String -> [SignedExact a]
    forall a b. a -> b -> a
    const []) [PEM] -> [SignedExact a]
    forall a. SignedObject a => [PEM] -> [SignedExact a]
    accumulate' (Either String [PEM] -> [SignedExact a])
    -> (ByteString -> Either String [PEM])
    -> ByteString
    -> [SignedExact a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either String [PEM]
    pemParseBS

    accumulate' :: forall a. SignedObject a => [PEM] -> [X509.SignedExact a]
    accumulate' :: forall a. SignedObject a => [PEM] -> [SignedExact a]
    accumulate' = (PEM -> [SignedExact a] -> [SignedExact a])
    -> [SignedExact a] -> [PEM] -> [SignedExact a]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr PEM -> [SignedExact a] -> [SignedExact a]
    forall {a}.
    (ASN1Object a, Eq a, Show a) =>
    PEM -> [SignedExact a] -> [SignedExact a]
    pemToSigned []
      where
        prx :: Proxy a
    prx = Proxy a
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy a

        pemToSigned :: PEM -> [SignedExact a] -> [SignedExact a]
    pemToSigned PEM
    pem [SignedExact a]
    acc
            | Proxy a -> String -> Bool
    forall a (proxy :: * -> *).
    SignedObject a =>
    proxy a -> String -> Bool
    validObjectName Proxy a
    prx (PEM -> String
    pemName PEM
    pem) =
                case ByteString -> Either String (SignedExact a)
    forall a.
    (Show a, Eq a, ASN1Object a) =>
    ByteString -> Either String (SignedExact a)
    X509.decodeSignedObject (ByteString -> Either String (SignedExact a))
    -> ByteString -> Either String (SignedExact a)
    forall a b. (a -> b) -> a -> b
    $ PEM -> ByteString
    pemContent PEM
    pem of
                    Left String
    _    -> [SignedExact a]
    acc
                    Right SignedExact a
    obj -> SignedExact a
    obj SignedExact a -> [SignedExact a] -> [SignedExact a]
    forall a. a -> [a] -> [a]
    : [SignedExact a]
    acc
            | Bool
    otherwise = [SignedExact a]
    acc

    -- Writing to PEM format

    -- | Write public keys to a PEM file.
    writePubKeyFile :: FilePath -> [X509.PubKey] -> IO ()
    writePubKeyFile :: String -> [PubKey] -> IO ()
    writePubKeyFile String
    path = String -> [PEM] -> IO ()
    writePEMs String
    path ([PEM] -> IO ()) -> ([PubKey] -> [PEM]) -> [PubKey] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PubKey -> PEM) -> [PubKey] -> [PEM]
    forall a b. (a -> b) -> [a] -> [b]
    map PubKey -> PEM
    pubKeyToPEM

    -- | Write public keys to a bytearray in PEM format.
    writePubKeyFileToMemory :: [X509.PubKey] -> B.ByteString
    writePubKeyFileToMemory :: [PubKey] -> ByteString
    writePubKeyFileToMemory = [PEM] -> ByteString
    pemsWriteBS ([PEM] -> ByteString)
    -> ([PubKey] -> [PEM]) -> [PubKey] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PubKey -> PEM) -> [PubKey] -> [PEM]
    forall a b. (a -> b) -> [a] -> [b]
    map PubKey -> PEM
    pubKeyToPEM

    -- | Generate a PEM for a public key.
    pubKeyToPEM :: X509.PubKey -> PEM
    pubKeyToPEM :: PubKey -> PEM
    pubKeyToPEM PubKey
    pubKey = String -> ByteString -> PEM
    mkPEM String
    "PUBLIC KEY" (ASN1PS -> ByteString
    encodeASN1S (ASN1PS -> ByteString) -> ASN1PS -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ASN1] -> ASN1PS
    forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
    gMany [ASN1]
    asn1)
      where asn1 :: [ASN1]
    asn1 = PubKey -> ASN1S
    forall a. ASN1Object a => a -> ASN1S
    toASN1 PubKey
    pubKey []

    -- | Write signed objects to a PEM file.
    writeSignedObject :: SignedObject a => FilePath -> [X509.SignedExact a] -> IO ()
    writeSignedObject :: forall a. SignedObject a => String -> [SignedExact a] -> IO ()
    writeSignedObject String
    path = String -> [PEM] -> IO ()
    writePEMs String
    path ([PEM] -> IO ())
    -> ([SignedExact a] -> [PEM]) -> [SignedExact a] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SignedExact a -> PEM) -> [SignedExact a] -> [PEM]
    forall a b. (a -> b) -> [a] -> [b]
    map SignedExact a -> PEM
    forall a. SignedObject a => SignedExact a -> PEM
    signedToPEM

    -- | Write signed objects to a bytearray in PEM format.
    writeSignedObjectToMemory :: SignedObject a => [X509.SignedExact a] -> B.ByteString
    writeSignedObjectToMemory :: forall a. SignedObject a => [SignedExact a] -> ByteString
    writeSignedObjectToMemory = [PEM] -> ByteString
    pemsWriteBS ([PEM] -> ByteString)
    -> ([SignedExact a] -> [PEM]) -> [SignedExact a] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SignedExact a -> PEM) -> [SignedExact a] -> [PEM]
    forall a b. (a -> b) -> [a] -> [b]
    map SignedExact a -> PEM
    forall a. SignedObject a => SignedExact a -> PEM
    signedToPEM

    signedToPEM :: forall a. SignedObject a => X509.SignedExact a -> PEM
    signedToPEM :: forall a. SignedObject a => SignedExact a -> PEM
    signedToPEM SignedExact a
    obj = String -> ByteString -> PEM
    mkPEM (Proxy a -> String
    forall a (proxy :: * -> *). SignedObject a => proxy a -> String
    forall (proxy :: * -> *). proxy a -> String
    signedObjectName Proxy a
    prx) (SignedExact a -> ByteString
    forall a.
    (Show a, Eq a, ASN1Object a) =>
    SignedExact a -> ByteString
    X509.encodeSignedObject SignedExact a
    obj)
      where prx :: Proxy a
    prx = Proxy a
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy a

    mkPEM :: String -> B.ByteString -> PEM
    mkPEM :: String -> ByteString -> PEM
    mkPEM String
    name ByteString
    bs = PEM { pemName :: String
    pemName = String
    name, pemHeader :: [(String, ByteString)]
    pemHeader = [], pemContent :: ByteString
    pemContent = ByteString
    bs}

    -- RSA public keys

    newtype RSAPublicKey = RSAPublicKey RSA.PublicKey

    instance ASN1Elem e => ProduceASN1Object e RSAPublicKey where
        asn1s :: RSAPublicKey -> ASN1Stream e
    asn1s (RSAPublicKey PublicKey
    pub) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
    forall e.
    ASN1Elem e =>
    ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
    asn1Container ASN1ConstructionType
    Sequence (ASN1Stream e
    n ASN1Stream e -> ASN1Stream e -> ASN1Stream e
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ASN1Stream e
    e)
          where
            n :: ASN1Stream e
    n = Integer -> ASN1Stream e
    forall e. ASN1Elem e => Integer -> ASN1Stream e
    gIntVal (PublicKey -> Integer
    RSA.public_n PublicKey
    pub)
            e :: ASN1Stream e
    e = Integer -> ASN1Stream e
    forall e. ASN1Elem e => Integer -> ASN1Stream e
    gIntVal (PublicKey -> Integer
    RSA.public_e PublicKey
    pub)

    instance Monoid e => ParseASN1Object e RSAPublicKey where
        parse :: ParseASN1 e RSAPublicKey
    parse = ASN1ConstructionType
    -> ParseASN1 e RSAPublicKey -> ParseASN1 e RSAPublicKey
    forall e a.
    Monoid e =>
    ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
    onNextContainer ASN1ConstructionType
    Sequence (ParseASN1 e RSAPublicKey -> ParseASN1 e RSAPublicKey)
    -> ParseASN1 e RSAPublicKey -> ParseASN1 e RSAPublicKey
    forall a b. (a -> b) -> a -> b
    $ do
            IntVal Integer
    modulus <- ParseASN1 e ASN1
    forall e. Monoid e => ParseASN1 e ASN1
    getNext
            IntVal Integer
    pubexp <- ParseASN1 e ASN1
    forall e. Monoid e => ParseASN1 e ASN1
    getNext
            let pub :: PublicKey
    pub = RSA.PublicKey { public_size :: Int
    RSA.public_size = Integer -> Int
    numBytes Integer
    modulus
                                    , public_n :: Integer
    RSA.public_n    = Integer
    modulus
                                    , public_e :: Integer
    RSA.public_e    = Integer
    pubexp
                                    }
            RSAPublicKey -> ParseASN1 e RSAPublicKey
    forall a. a -> ParseASN1 e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PublicKey -> RSAPublicKey
    RSAPublicKey PublicKey
    pub)