{-# LANGUAGE ScopedTypeVariables #-}

module OpenSSL.X509.SystemStore.Unix
    ( contextLoadSystemCerts
    ) where

import OpenSSL.Session (SSLContext, contextSetCADirectory, contextSetCAFile)
import qualified System.Posix.Files as U
import Control.Exception (try, IOException)
import System.IO.Unsafe (unsafePerformIO)

contextLoadSystemCerts :: SSLContext -> IO ()
contextLoadSystemCerts :: SSLContext -> IO ()
contextLoadSystemCerts =
    IO (SSLContext -> IO ()) -> SSLContext -> IO ()
forall a. IO a -> a
unsafePerformIO (IO (SSLContext -> IO ()) -> SSLContext -> IO ())
-> IO (SSLContext -> IO ()) -> SSLContext -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Bool, FilePath)] -> IO (SSLContext -> IO ())
loop [(Bool, FilePath)]
defaultSystemPaths
  where
    loop :: [(Bool, FilePath)] -> IO (SSLContext -> IO ())
loop ((Bool
isDir, FilePath
path) : [(Bool, FilePath)]
rest) = do
        Either IOException FileStatus
mst <- IO FileStatus -> IO (Either IOException FileStatus)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO FileStatus -> IO (Either IOException FileStatus))
-> IO FileStatus -> IO (Either IOException FileStatus)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
U.getFileStatus FilePath
path
            :: IO (Either IOException U.FileStatus)
        case Either IOException FileStatus
mst of
            Right FileStatus
st | Bool
isDir, FileStatus -> Bool
U.isDirectory FileStatus
st ->
                (SSLContext -> IO ()) -> IO (SSLContext -> IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SSLContext -> FilePath -> IO ())
-> FilePath -> SSLContext -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip SSLContext -> FilePath -> IO ()
contextSetCADirectory FilePath
path)
            Right FileStatus
st | Bool -> Bool
not Bool
isDir, FileStatus -> Bool
U.isRegularFile FileStatus
st ->
                (SSLContext -> IO ()) -> IO (SSLContext -> IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((SSLContext -> FilePath -> IO ())
-> FilePath -> SSLContext -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip SSLContext -> FilePath -> IO ()
contextSetCAFile FilePath
path)
            Either IOException FileStatus
_ -> [(Bool, FilePath)] -> IO (SSLContext -> IO ())
loop [(Bool, FilePath)]
rest
    loop [] = (SSLContext -> IO ()) -> IO (SSLContext -> IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> SSLContext -> IO ()
forall a b. a -> b -> a
const (IO () -> SSLContext -> IO ()) -> IO () -> SSLContext -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) -- throw an exception instead?
{-# NOINLINE contextLoadSystemCerts #-}

-- A True value indicates that the path must be a directory.
-- According to [1], the fedora path should be tried before /etc/ssl/certs
-- because of [2].
--
-- [1] https://www.happyassassin.net/2015/01/12/a-note-about-ssltls-trusted-certificate-stores-and-platforms/
-- [2] https://bugzilla.redhat.com/show_bug.cgi?id=1053882
defaultSystemPaths :: [(Bool, FilePath)]
defaultSystemPaths :: [(Bool, FilePath)]
defaultSystemPaths =
    [ (Bool
False, FilePath
"/etc/pki/tls/certs/ca-bundle.crt"      ) -- red hat, fedora, centos
    , (Bool
True , FilePath
"/etc/ssl/certs"                        ) -- other linux, netbsd
    , (Bool
True , FilePath
"/system/etc/security/cacerts"          ) -- android
    , (Bool
False, FilePath
"/etc/ssl/cert.pem"                     ) -- openbsd/freebsd
    , (Bool
False, FilePath
"/usr/share/ssl/certs/ca-bundle.crt"    ) -- older red hat
    , (Bool
False, FilePath
"/usr/local/share/certs/ca-root-nss.crt") -- freebsd (security/ca-root-nss)
    , (Bool
True , FilePath
"/usr/local/share/certs"                ) -- freebsd
    ]