-- |
-- 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)