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
    (Maybe Handle
_, Just Handle
hout, Maybe Handle
_, ProcessHandle
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 :: StdStream
std_out = StdStream
CreatePipe }
    [PEM]
pems <- (FilePath -> [PEM])
-> ([PEM] -> [PEM]) -> Either FilePath [PEM] -> [PEM]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> [PEM]
forall a. HasCallStack => FilePath -> a
error [PEM] -> [PEM]
forall a. a -> a
id (Either FilePath [PEM] -> [PEM])
-> (ByteString -> Either FilePath [PEM]) -> ByteString -> [PEM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath [PEM]
pemParseLBS (ByteString -> [PEM]) -> IO ByteString -> IO [PEM]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
LBS.hGetContents Handle
hout
    let targets :: [SignedCertificate]
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
    ExitCode
_ <- [SignedCertificate]
targets [SignedCertificate] -> IO ExitCode -> IO ExitCode
`seq` ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
    [SignedCertificate] -> IO [SignedCertificate]
forall (m :: * -> *) a. Monad m => a -> m a
return [SignedCertificate]
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]