    {-# LANGUAGE OverloadedStrings #-}
    -- |
    -- Module      : Data.PEM.Parser
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : portable
    --
    -- Parse PEM content.
    --
    -- A PEM contains contains from one to many PEM sections.
    -- Each section contains an optional key-value pair header
    -- and a binary content encoded in base64.
    --
    module Data.PEM.Parser
        ( pemParseBS
        , pemParseLBS
        ) where

    import Data.Either (partitionEithers)
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as BC
    import qualified Data.ByteString.Lazy as L
    import qualified Data.ByteString.Lazy.Char8 as LC

    import Data.PEM.Types
    import Data.ByteArray.Encoding (Base(Base64), convertFromBase)
    import qualified Data.ByteArray as BA

    type Line = L.ByteString

    parseOnePEM :: [Line] -> Either (Maybe String) (PEM, [Line])
    parseOnePEM :: [Line] -> Either (Maybe String) (PEM, [Line])
    parseOnePEM = [Line] -> Either (Maybe String) (PEM, [Line])
    findPem
      where beginMarker :: Line
    beginMarker = "-----BEGIN "
            endMarker :: Line
    endMarker   = "-----END "

            findPem :: [Line] -> Either (Maybe String) (PEM, [Line])
    findPem []     = Maybe String -> Either (Maybe String) (PEM, [Line])
    forall a b. a -> Either a b
    Left Maybe String
    forall a. Maybe a
    Nothing
            findPem (l :: Line
    l:ls :: [Line]
    ls) = case Line
    beginMarker Line -> Line -> Maybe Line
    `prefixEat` Line
    l of
                                 Nothing -> [Line] -> Either (Maybe String) (PEM, [Line])
    findPem [Line]
    ls
                                 Just n :: Line
    n  -> (String -> [Line] -> Either (Maybe String) (PEM, [Line]))
    -> Line -> [Line] -> Either (Maybe String) (PEM, [Line])
    forall a t b.
    IsString a =>
    (String -> t -> Either (Maybe a) b)
    -> Line -> t -> Either (Maybe a) b
    getPemName String -> [Line] -> Either (Maybe String) (PEM, [Line])
    getPemHeaders Line
    n [Line]
    ls
            getPemName :: (String -> t -> Either (Maybe a) b)
    -> Line -> t -> Either (Maybe a) b
    getPemName next :: String -> t -> Either (Maybe a) b
    next n :: Line
    n ls :: t
    ls =
                let (name :: Line
    name, r :: Line
    r) = (Word8 -> Bool) -> Line -> (Line, Line)
    L.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0x2d) Line
    n in
                case Line
    r of
                    "-----" -> String -> t -> Either (Maybe a) b
    next (Line -> String
    LC.unpack Line
    name) t
    ls
                    _       -> Maybe a -> Either (Maybe a) b
    forall a b. a -> Either a b
    Left (Maybe a -> Either (Maybe a) b) -> Maybe a -> Either (Maybe a) b
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just "invalid PEM delimiter found"

            getPemHeaders :: String -> [Line] -> Either (Maybe String) (PEM, [Line])
    getPemHeaders name :: String
    name lbs :: [Line]
    lbs =
                case [Line] -> Either (Maybe String) ([(String, ByteString)], [Line])
    forall a a a. IsString a => [a] -> Either (Maybe a) ([a], [a])
    getPemHeaderLoop [Line]
    lbs of
                    Left err :: Maybe String
    err           -> Maybe String -> Either (Maybe String) (PEM, [Line])
    forall a b. a -> Either a b
    Left Maybe String
    err
                    Right (hdrs :: [(String, ByteString)]
    hdrs, lbs2 :: [Line]
    lbs2) -> String
    -> [(String, ByteString)]
    -> [ByteString]
    -> [Line]
    -> Either (Maybe String) (PEM, [Line])
    getPemContent String
    name [(String, ByteString)]
    hdrs [] [Line]
    lbs2
              where getPemHeaderLoop :: [a] -> Either (Maybe a) ([a], [a])
    getPemHeaderLoop []     = Maybe a -> Either (Maybe a) ([a], [a])
    forall a b. a -> Either a b
    Left (Maybe a -> Either (Maybe a) ([a], [a]))
    -> Maybe a -> Either (Maybe a) ([a], [a])
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just "invalid PEM: no more content in header context"
                    getPemHeaderLoop (r :: a
    r:rs :: [a]
    rs) = -- FIXME doesn't properly parse headers yet
                        ([a], [a]) -> Either (Maybe a) ([a], [a])
    forall a b. b -> Either a b
    Right ([], a
    ra -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    rs)

            getPemContent :: String -> [(String,ByteString)] -> [BC.ByteString] -> [L.ByteString] -> Either (Maybe String) (PEM, [L.ByteString])
            getPemContent :: String
    -> [(String, ByteString)]
    -> [ByteString]
    -> [Line]
    -> Either (Maybe String) (PEM, [Line])
    getPemContent name :: String
    name hdrs :: [(String, ByteString)]
    hdrs contentLines :: [ByteString]
    contentLines lbs :: [Line]
    lbs =
                case [Line]
    lbs of
                    []     -> Maybe String -> Either (Maybe String) (PEM, [Line])
    forall a b. a -> Either a b
    Left (Maybe String -> Either (Maybe String) (PEM, [Line]))
    -> Maybe String -> Either (Maybe String) (PEM, [Line])
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String
    forall a. a -> Maybe a
    Just "invalid PEM: no end marker found"
                    (l :: Line
    l:ls :: [Line]
    ls) -> case Line
    endMarker Line -> Line -> Maybe Line
    `prefixEat` Line
    l of
                                  Nothing ->
                                        case Base -> ByteString -> Either String ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> Either String bout
    convertFromBase Base
    Base64 (ByteString -> Either String ByteString)
    -> ByteString -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ Line -> ByteString
    L.toStrict Line
    l of
                                            Left err :: String
    err      -> Maybe String -> Either (Maybe String) (PEM, [Line])
    forall a b. a -> Either a b
    Left (Maybe String -> Either (Maybe String) (PEM, [Line]))
    -> Maybe String -> Either (Maybe String) (PEM, [Line])
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String
    forall a. a -> Maybe a
    Just ("invalid PEM: decoding failed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err)
                                            Right content :: ByteString
    content -> String
    -> [(String, ByteString)]
    -> [ByteString]
    -> [Line]
    -> Either (Maybe String) (PEM, [Line])
    getPemContent String
    name [(String, ByteString)]
    hdrs (ByteString
    content ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : [ByteString]
    contentLines) [Line]
    ls
                                  Just n :: Line
    n  -> (String -> [Line] -> Either (Maybe String) (PEM, [Line]))
    -> Line -> [Line] -> Either (Maybe String) (PEM, [Line])
    forall a t b.
    IsString a =>
    (String -> t -> Either (Maybe a) b)
    -> Line -> t -> Either (Maybe a) b
    getPemName (String
    -> [(String, ByteString)]
    -> [ByteString]
    -> String
    -> [Line]
    -> Either (Maybe String) (PEM, [Line])
    forall a bin b.
    (IsString a, ByteArrayAccess bin) =>
    String
    -> [(String, ByteString)]
    -> [bin]
    -> String
    -> b
    -> Either (Maybe a) (PEM, b)
    finalizePem String
    name [(String, ByteString)]
    hdrs [ByteString]
    contentLines) Line
    n [Line]
    ls
            finalizePem :: String
    -> [(String, ByteString)]
    -> [bin]
    -> String
    -> b
    -> Either (Maybe a) (PEM, b)
    finalizePem name :: String
    name hdrs :: [(String, ByteString)]
    hdrs contentLines :: [bin]
    contentLines nameEnd :: String
    nameEnd lbs :: b
    lbs
                | String
    nameEnd String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    name = Maybe a -> Either (Maybe a) (PEM, b)
    forall a b. a -> Either a b
    Left (Maybe a -> Either (Maybe a) (PEM, b))
    -> Maybe a -> Either (Maybe a) (PEM, b)
    forall a b. (a -> b) -> a -> b
    $ a -> Maybe a
    forall a. a -> Maybe a
    Just "invalid PEM: end name doesn't match start name"
                | Bool
    otherwise       =
                    let pem :: PEM
    pem = PEM :: String -> [(String, ByteString)] -> ByteString -> PEM
    PEM { pemName :: String
    pemName    = String
    name
                                  , pemHeader :: [(String, ByteString)]
    pemHeader  = [(String, ByteString)]
    hdrs
                                  , pemContent :: ByteString
    pemContent = [bin] -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    [bin] -> bout
    BA.concat ([bin] -> ByteString) -> [bin] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [bin] -> [bin]
    forall a. [a] -> [a]
    reverse [bin]
    contentLines }
                     in (PEM, b) -> Either (Maybe a) (PEM, b)
    forall a b. b -> Either a b
    Right (PEM
    pem, b
    lbs)

            prefixEat :: Line -> Line -> Maybe Line
    prefixEat prefix :: Line
    prefix x :: Line
    x =
                let (x1 :: Line
    x1, x2 :: Line
    x2) = Int64 -> Line -> (Line, Line)
    L.splitAt (Line -> Int64
    L.length Line
    prefix) Line
    x
                 in if Line
    x1 Line -> Line -> Bool
    forall a. Eq a => a -> a -> Bool
    == Line
    prefix then Line -> Maybe Line
    forall a. a -> Maybe a
    Just Line
    x2 else Maybe Line
    forall a. Maybe a
    Nothing

    -- | parser to get PEM sections
    pemParse :: [Line] -> [Either String PEM]
    pemParse :: [Line] -> [Either String PEM]
    pemParse l :: [Line]
    l
        | [Line] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Line]
    l    = []
        | Bool
    otherwise = case [Line] -> Either (Maybe String) (PEM, [Line])
    parseOnePEM [Line]
    l of
                            Left Nothing         -> []
                            Left (Just err :: String
    err)      -> [String -> Either String PEM
    forall a b. a -> Either a b
    Left String
    err]
                            Right (p :: PEM
    p, remaining :: [Line]
    remaining) -> PEM -> Either String PEM
    forall a b. b -> Either a b
    Right PEM
    p Either String PEM -> [Either String PEM] -> [Either String PEM]
    forall a. a -> [a] -> [a]
    : [Line] -> [Either String PEM]
    pemParse [Line]
    remaining

    -- | parse a PEM content using a strict bytestring
    pemParseBS :: ByteString -> Either String [PEM]
    pemParseBS :: ByteString -> Either String [PEM]
    pemParseBS b :: ByteString
    b = Line -> Either String [PEM]
    pemParseLBS (Line -> Either String [PEM]) -> Line -> Either String [PEM]
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> Line
    L.fromChunks [ByteString
    b]

    -- | parse a PEM content using a dynamic bytestring
    pemParseLBS :: L.ByteString -> Either String [PEM]
    pemParseLBS :: Line -> Either String [PEM]
    pemParseLBS bs :: Line
    bs = case [Either String PEM] -> ([String], [PEM])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers ([Either String PEM] -> ([String], [PEM]))
    -> [Either String PEM] -> ([String], [PEM])
    forall a b. (a -> b) -> a -> b
    $ [Line] -> [Either String PEM]
    pemParse ([Line] -> [Either String PEM]) -> [Line] -> [Either String PEM]
    forall a b. (a -> b) -> a -> b
    $ (Line -> Line) -> [Line] -> [Line]
    forall a b. (a -> b) -> [a] -> [b]
    map Line -> Line
    unCR ([Line] -> [Line]) -> [Line] -> [Line]
    forall a b. (a -> b) -> a -> b
    $ Line -> [Line]
    LC.lines Line
    bs of
                        (x :: String
    x:_,_   ) -> String -> Either String [PEM]
    forall a b. a -> Either a b
    Left String
    x
                        ([] ,pems :: [PEM]
    pems) -> [PEM] -> Either String [PEM]
    forall a b. b -> Either a b
    Right [PEM]
    pems
      where unCR :: Line -> Line
    unCR b :: Line
    b | Line -> Int64
    L.length Line
    b Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && Line -> Word8
    L.last Line
    b Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    cr = Line -> Line
    L.init Line
    b
                   | Bool
    otherwise                        = Line
    b
            cr :: Word8
    cr = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    forall a. Enum a => a -> Int
    fromEnum '\r'