-- |
-- Module      : Crypto.Store.PEM
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Extend module "Data.PEM".
module Crypto.Store.PEM
    ( readPEMs
    , writePEMs
    , pemsWriteBS
    , pemsWriteLBS
    , module Data.PEM
    ) where

import Data.PEM
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L

-- | Read a PEM file from disk.
readPEMs :: FilePath -> IO [PEM]
readPEMs :: FilePath -> IO [PEM]
readPEMs FilePath
filepath = (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
<$> FilePath -> IO ByteString
L.readFile FilePath
filepath

-- | Convert a list of PEM elements to a bytestring.
pemsWriteBS :: [PEM] -> B.ByteString
pemsWriteBS :: [PEM] -> ByteString
pemsWriteBS = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> ([PEM] -> ByteString) -> [PEM] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PEM] -> ByteString
pemsWriteLBS

-- | Convert a list of PEM elements to a lazy bytestring.
pemsWriteLBS :: [PEM] -> L.ByteString
pemsWriteLBS :: [PEM] -> ByteString
pemsWriteLBS = [ByteString] -> ByteString
L.concat ([ByteString] -> ByteString)
-> ([PEM] -> [ByteString]) -> [PEM] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PEM -> ByteString) -> [PEM] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map PEM -> ByteString
pemWriteLBS

-- | Write a PEM file to disk.
writePEMs :: FilePath -> [PEM] -> IO ()
writePEMs :: FilePath -> [PEM] -> IO ()
writePEMs FilePath
filepath = FilePath -> ByteString -> IO ()
L.writeFile FilePath
filepath (ByteString -> IO ()) -> ([PEM] -> ByteString) -> [PEM] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PEM] -> ByteString
pemsWriteLBS