module System.X509.Common (
    maybeSSLCertEnvOr,
)
where

import Data.Foldable (asum)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (mconcat)
import Data.X509.CertificateStore
import System.Environment (lookupEnv)

getOpenSslEnvs :: IO (Maybe String)
getOpenSslEnvs :: IO (Maybe String)
getOpenSslEnvs =
    [Maybe String] -> Maybe String
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        ([Maybe String] -> Maybe String)
-> IO [Maybe String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
            String -> IO (Maybe String)
lookupEnv
            [ String
"SSL_CERT_FILE"
            , String
"SSL_CERT_DIR"
            ]

maybeSSLCertEnvOr :: IO CertificateStore -> IO CertificateStore
maybeSSLCertEnvOr :: IO CertificateStore -> IO CertificateStore
maybeSSLCertEnvOr IO CertificateStore
defaultStore = do
    overrideCertPaths <- IO (Maybe String)
getOpenSslEnvs
    case overrideCertPaths of
        Maybe String
Nothing -> IO CertificateStore
defaultStore
        Just String
certPath -> CertificateStore -> Maybe CertificateStore -> CertificateStore
forall a. a -> Maybe a -> a
fromMaybe CertificateStore
forall a. Monoid a => a
mempty (Maybe CertificateStore -> CertificateStore)
-> IO (Maybe CertificateStore) -> IO CertificateStore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe CertificateStore)
readCertificateStore String
certPath)