module Data.X509.File (
    readSignedObject,
    readKeyFile,
    PEMError (..),
) where

import Control.Applicative
import Control.Exception (Exception (..), throw)
import Data.ASN1.BinaryEncoding
import Data.ASN1.Encoding
import Data.ASN1.Types
import qualified Data.ByteString.Lazy as L
import Data.Maybe
import Data.PEM (PEM, pemContent, pemName, pemParseLBS)
import qualified Data.X509 as X509
import Data.X509.Memory (pemToKey)

newtype PEMError = PEMError {PEMError -> String
displayPEMError :: String}
    deriving (Int -> PEMError -> ShowS
[PEMError] -> ShowS
PEMError -> String
(Int -> PEMError -> ShowS)
-> (PEMError -> String) -> ([PEMError] -> ShowS) -> Show PEMError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PEMError -> ShowS
showsPrec :: Int -> PEMError -> ShowS
$cshow :: PEMError -> String
show :: PEMError -> String
$cshowList :: [PEMError] -> ShowS
showList :: [PEMError] -> ShowS
Show)

instance Exception PEMError where
    displayException :: PEMError -> String
displayException = PEMError -> String
displayPEMError

readPEMs :: FilePath -> IO [PEM]
readPEMs :: String -> IO [PEM]
readPEMs String
filepath = do
    ByteString
content <- String -> IO ByteString
L.readFile String
filepath
    (String -> IO [PEM])
-> ([PEM] -> IO [PEM]) -> Either String [PEM] -> IO [PEM]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PEMError -> IO [PEM]
forall a e. Exception e => e -> a
throw (PEMError -> IO [PEM])
-> (String -> PEMError) -> String -> IO [PEM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PEMError
PEMError) [PEM] -> IO [PEM]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [PEM] -> IO [PEM])
-> Either String [PEM] -> IO [PEM]
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String [PEM]
pemParseLBS ByteString
content

-- | return all the signed objects in a file.
--
-- (only one type at a time).
readSignedObject
    :: (ASN1Object a, Eq a, Show a)
    => FilePath
    -> IO [X509.SignedExact a]
readSignedObject :: forall a.
(ASN1Object a, Eq a, Show a) =>
String -> IO [SignedExact a]
readSignedObject String
filepath = [PEM] -> [SignedExact a]
forall {a}.
(Show a, Eq a, ASN1Object a) =>
[PEM] -> [SignedExact a]
decodePEMs ([PEM] -> [SignedExact a]) -> IO [PEM] -> IO [SignedExact a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [PEM]
readPEMs String
filepath
  where
    decodePEMs :: [PEM] -> [SignedExact a]
decodePEMs [PEM]
pems =
        [SignedExact a
obj | PEM
pem <- [PEM]
pems, Right SignedExact a
obj <- [ByteString -> Either String (SignedExact a)
forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
X509.decodeSignedObject (ByteString -> Either String (SignedExact a))
-> ByteString -> Either String (SignedExact a)
forall a b. (a -> b) -> a -> b
$ PEM -> ByteString
pemContent PEM
pem]]

-- | return all the private keys that were successfully read from a file.
readKeyFile :: FilePath -> IO [X509.PrivKey]
readKeyFile :: String -> IO [PrivKey]
readKeyFile String
path = [Maybe PrivKey] -> [PrivKey]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe PrivKey] -> [PrivKey])
-> ([PEM] -> [Maybe PrivKey]) -> [PEM] -> [PrivKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe PrivKey] -> PEM -> [Maybe PrivKey])
-> [Maybe PrivKey] -> [PEM] -> [Maybe PrivKey]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Maybe PrivKey] -> PEM -> [Maybe PrivKey]
pemToKey [] ([PEM] -> [PrivKey]) -> IO [PEM] -> IO [PrivKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [PEM]
readPEMs String
path