{-# LANGUAGE OverloadedStrings #-}
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 = Line
"-----BEGIN "
endMarker :: Line
endMarker = Line
"-----END "
findPem :: [Line] -> Either (Maybe String) (PEM, [Line])
findPem [] = forall a b. a -> Either a b
Left forall a. Maybe a
Nothing
findPem (Line
l:[Line]
ls) = case Line
beginMarker Line -> Line -> Maybe Line
`prefixEat` Line
l of
Maybe Line
Nothing -> [Line] -> Either (Maybe String) (PEM, [Line])
findPem [Line]
ls
Just Line
n -> 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 String -> t -> Either (Maybe a) b
next Line
n t
ls =
let (Line
name, Line
r) = (Word8 -> Bool) -> Line -> (Line, Line)
L.break (forall a. Eq a => a -> a -> Bool
== Word8
0x2d) Line
n in
case Line
r of
Line
"-----" -> String -> t -> Either (Maybe a) b
next (Line -> String
LC.unpack Line
name) t
ls
Line
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
"invalid PEM delimiter found"
getPemHeaders :: String -> [Line] -> Either (Maybe String) (PEM, [Line])
getPemHeaders String
name [Line]
lbs =
case forall {a} {a} {a}.
IsString a =>
[a] -> Either (Maybe a) ([a], [a])
getPemHeaderLoop [Line]
lbs of
Left Maybe String
err -> forall a b. a -> Either a b
Left Maybe String
err
Right ([(String, ByteString)]
hdrs, [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 [] = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
"invalid PEM: no more content in header context"
getPemHeaderLoop (a
r:[a]
rs) =
forall a b. b -> Either a b
Right ([], a
rforall 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 String
name [(String, ByteString)]
hdrs [ByteString]
contentLines [Line]
lbs =
case [Line]
lbs of
[] -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
"invalid PEM: no end marker found"
(Line
l:[Line]
ls) -> case Line
endMarker Line -> Line -> Maybe Line
`prefixEat` Line
l of
Maybe Line
Nothing ->
case forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 forall a b. (a -> b) -> a -> b
$ Line -> ByteString
L.toStrict Line
l of
Left String
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
"invalid PEM: decoding failed: " forall a. [a] -> [a] -> [a]
++ String
err)
Right ByteString
content -> String
-> [(String, ByteString)]
-> [ByteString]
-> [Line]
-> Either (Maybe String) (PEM, [Line])
getPemContent String
name [(String, ByteString)]
hdrs (ByteString
content forall a. a -> [a] -> [a]
: [ByteString]
contentLines) [Line]
ls
Just Line
n -> forall {a} {t} {b}.
IsString a =>
(String -> t -> Either (Maybe a) b)
-> Line -> t -> Either (Maybe a) b
getPemName (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 String
name [(String, ByteString)]
hdrs [bin]
contentLines String
nameEnd b
lbs
| String
nameEnd forall a. Eq a => a -> a -> Bool
/= String
name = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
"invalid PEM: end name doesn't match start name"
| Bool
otherwise =
let pem :: PEM
pem = PEM { pemName :: String
pemName = String
name
, pemHeader :: [(String, ByteString)]
pemHeader = [(String, ByteString)]
hdrs
, pemContent :: ByteString
pemContent = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
[bin] -> bout
BA.concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [bin]
contentLines }
in forall a b. b -> Either a b
Right (PEM
pem, b
lbs)
prefixEat :: Line -> Line -> Maybe Line
prefixEat Line
prefix Line
x =
let (Line
x1, Line
x2) = Int64 -> Line -> (Line, Line)
L.splitAt (Line -> Int64
L.length Line
prefix) Line
x
in if Line
x1 forall a. Eq a => a -> a -> Bool
== Line
prefix then forall a. a -> Maybe a
Just Line
x2 else forall a. Maybe a
Nothing
pemParse :: [Line] -> [Either String PEM]
pemParse :: [Line] -> [Either String PEM]
pemParse [Line]
l
| 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 Maybe String
Nothing -> []
Left (Just String
err) -> [forall a b. a -> Either a b
Left String
err]
Right (PEM
p, [Line]
remaining) -> forall a b. b -> Either a b
Right PEM
p forall a. a -> [a] -> [a]
: [Line] -> [Either String PEM]
pemParse [Line]
remaining
pemParseBS :: ByteString -> Either String [PEM]
pemParseBS :: ByteString -> Either String [PEM]
pemParseBS ByteString
b = Line -> Either String [PEM]
pemParseLBS forall a b. (a -> b) -> a -> b
$ [ByteString] -> Line
L.fromChunks [ByteString
b]
pemParseLBS :: L.ByteString -> Either String [PEM]
pemParseLBS :: Line -> Either String [PEM]
pemParseLBS Line
bs = case forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ [Line] -> [Either String PEM]
pemParse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Line -> Line
unCR forall a b. (a -> b) -> a -> b
$ Line -> [Line]
LC.lines Line
bs of
(String
x:[String]
_,[PEM]
_ ) -> forall a b. a -> Either a b
Left String
x
([] ,[PEM]
pems) -> forall a b. b -> Either a b
Right [PEM]
pems
where unCR :: Line -> Line
unCR Line
b | Line -> Int64
L.length Line
b forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
&& HasCallStack => Line -> Word8
L.last Line
b forall a. Eq a => a -> a -> Bool
== Word8
cr = HasCallStack => Line -> Line
L.init Line
b
| Bool
otherwise = Line
b
cr :: Word8
cr = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum Char
'\r'