-- |
-- 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 forall a. Eq a => a -> a -> Bool
== forall a (proxy :: * -> *). SignedObject a => proxy a -> String
signedObjectName proxy a
prx Bool -> Bool -> Bool
|| String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a (proxy :: * -> *). SignedObject a => 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 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) [PEM] -> [PubKey]
accumulate forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [PEM]
pemParseBS

accumulate :: [PEM] -> [X509.PubKey]
accumulate :: [PEM] -> [PubKey]
accumulate = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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 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 -> forall {t} {a} {a} {a}. (t -> Either a (a, [a])) -> t -> Maybe a
run (String -> [ASN1] -> Either String (PubKey, [ASN1])
getParser forall a b. (a -> b) -> a -> b
$ PEM -> String
pemName PEM
pem) [ASN1]
asn1 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, []) -> forall a. a -> Maybe a
Just a
pubKey
            Either a (a, [a])
_                  -> forall a. Maybe a
Nothing

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

    rsapkParser :: ParseASN1 () PubKey
rsapkParser = (\(RSAPublicKey PublicKey
pub) -> PublicKey -> PubKey
X509.PubKeyRSA PublicKey
pub) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. SignedObject a => [PEM] -> [SignedExact a]
accumulate' 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) forall a. SignedObject a => [PEM] -> [SignedExact a]
accumulate' 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' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
(ASN1Object a, Eq a, Show a) =>
PEM -> [SignedExact a] -> [SignedExact a]
pemToSigned []
  where
    prx :: Proxy a
prx = forall {k} (t :: k). Proxy t
Proxy :: Proxy a

    pemToSigned :: PEM -> [SignedExact a] -> [SignedExact a]
pemToSigned PEM
pem [SignedExact a]
acc
        | forall a (proxy :: * -> *).
SignedObject a =>
proxy a -> String -> Bool
validObjectName Proxy a
prx (PEM -> String
pemName PEM
pem) =
            case forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
X509.decodeSignedObject 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
asn1)
  where asn1 :: [ASN1]
asn1 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 (forall a (proxy :: * -> *). SignedObject a => proxy a -> String
signedObjectName Proxy a
prx) (forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X509.encodeSignedObject SignedExact a
obj)
  where prx :: Proxy a
prx = 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) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
e)
      where
        n :: ASN1Stream e
n = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PublicKey -> Integer
RSA.public_n PublicKey
pub)
        e :: ASN1Stream e
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 = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
        IntVal Integer
modulus <- forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal Integer
pubexp <- 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
                                }
        forall (m :: * -> *) a. Monad m => a -> m a
return (PublicKey -> RSAPublicKey
RSAPublicKey PublicKey
pub)