module System.X509.MacOS
    ( getSystemCertificateStore
    ) where

import Data.PEM (pemParseLBS, PEM(..))
import System.Process
import qualified Data.ByteString.Lazy as LBS
import Control.Applicative
import Data.Either

import Data.X509
import Data.X509.CertificateStore

rootCAKeyChain :: FilePath
rootCAKeyChain :: FilePath
rootCAKeyChain = FilePath
"/System/Library/Keychains/SystemRootCertificates.keychain"

systemKeyChain :: FilePath
systemKeyChain :: FilePath
systemKeyChain = FilePath
"/Library/Keychains/System.keychain"

listInKeyChains :: [FilePath] -> IO [SignedCertificate]
listInKeyChains :: [FilePath] -> IO [SignedCertificate]
listInKeyChains [FilePath]
keyChains = do
    (_, Just hout, _, ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (FilePath -> [FilePath] -> CreateProcess
proc FilePath
"security" (FilePath
"find-certificate" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath
"-pa" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
keyChains)) { std_out = CreatePipe }
    pems <- either error id . pemParseLBS <$> LBS.hGetContents hout
    let targets = [Either FilePath SignedCertificate] -> [SignedCertificate]
forall a b. [Either a b] -> [b]
rights ([Either FilePath SignedCertificate] -> [SignedCertificate])
-> [Either FilePath SignedCertificate] -> [SignedCertificate]
forall a b. (a -> b) -> a -> b
$ (PEM -> Either FilePath SignedCertificate)
-> [PEM] -> [Either FilePath SignedCertificate]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Either FilePath SignedCertificate
decodeSignedCertificate (ByteString -> Either FilePath SignedCertificate)
-> (PEM -> ByteString) -> PEM -> Either FilePath SignedCertificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PEM -> ByteString
pemContent) ([PEM] -> [Either FilePath SignedCertificate])
-> [PEM] -> [Either FilePath SignedCertificate]
forall a b. (a -> b) -> a -> b
$ (PEM -> Bool) -> [PEM] -> [PEM]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"CERTIFICATE") (FilePath -> Bool) -> (PEM -> FilePath) -> PEM -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PEM -> FilePath
pemName) [PEM]
pems
    _ <- targets `seq` waitForProcess ph
    return targets

getSystemCertificateStore :: IO CertificateStore
getSystemCertificateStore :: IO CertificateStore
getSystemCertificateStore = [SignedCertificate] -> CertificateStore
makeCertificateStore ([SignedCertificate] -> CertificateStore)
-> IO [SignedCertificate] -> IO CertificateStore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO [SignedCertificate]
listInKeyChains [FilePath
rootCAKeyChain, FilePath
systemKeyChain]