-- |
-- Module      : System.X509
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unix only
--
-- this module is portable to unix system where there is usually
-- a /etc/ssl/certs with system X509 certificates.
--
-- the path can be dynamically override using the environment variable
-- defined by envPathOverride in the module, which by
-- default is SYSTEM_CERTIFICATE_PATH
module System.X509.Unix (
    getSystemCertificateStore,
) where

import Data.X509.CertificateStore
import System.Environment (getEnv)
import System.X509.Common (maybeSSLCertEnvOr)

import Control.Applicative ((<$>))
import qualified Control.Exception as E

import Data.Maybe (catMaybes)
import Data.Monoid (mconcat)

defaultSystemPaths :: [FilePath]
defaultSystemPaths :: [FilePath]
defaultSystemPaths =
    [ FilePath
"/etc/pki/ca-trust/extracted/pem/tls-ca-bundle.pem" -- fedora
    , FilePath
"/etc/ssl/certs/" -- linux
    , FilePath
"/system/etc/security/cacerts/" -- android
    , FilePath
"/usr/local/share/certs/" -- freebsd
    , FilePath
"/etc/ssl/cert.pem" -- openbsd
    ]

envPathOverride :: String
envPathOverride :: FilePath
envPathOverride = FilePath
"SYSTEM_CERTIFICATE_PATH"

getSystemCertificateStore :: IO CertificateStore
getSystemCertificateStore :: IO CertificateStore
getSystemCertificateStore =
    IO CertificateStore -> IO CertificateStore
maybeSSLCertEnvOr
        ([CertificateStore] -> CertificateStore
forall a. Monoid a => [a] -> a
mconcat ([CertificateStore] -> CertificateStore)
-> ([Maybe CertificateStore] -> [CertificateStore])
-> [Maybe CertificateStore]
-> CertificateStore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe CertificateStore] -> [CertificateStore]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe CertificateStore] -> CertificateStore)
-> IO [Maybe CertificateStore] -> IO CertificateStore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO [FilePath]
getSystemPaths IO [FilePath]
-> ([FilePath] -> IO [Maybe CertificateStore])
-> IO [Maybe CertificateStore]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO (Maybe CertificateStore))
-> [FilePath] -> IO [Maybe CertificateStore]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO (Maybe CertificateStore)
readCertificateStore))

getSystemPaths :: IO [FilePath]
getSystemPaths :: IO [FilePath]
getSystemPaths = IO [FilePath] -> (IOException -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch ((FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: []) (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getEnv FilePath
envPathOverride) IOException -> IO [FilePath]
inDefault
  where
    inDefault :: E.IOException -> IO [FilePath]
    inDefault :: IOException -> IO [FilePath]
inDefault IOException
_ = [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
defaultSystemPaths