diff options
Diffstat (limited to 'PEM.hs')
-rw-r--r-- | PEM.hs | 34 |
1 files changed, 34 insertions, 0 deletions
@@ -0,0 +1,34 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | module PEM where | ||
3 | |||
4 | import Data.Maybe | ||
5 | import Data.Monoid | ||
6 | import qualified Data.ByteString.Lazy as LW | ||
7 | import qualified Data.ByteString.Lazy.Char8 as L | ||
8 | import Control.Monad | ||
9 | import Control.Applicative | ||
10 | import qualified Codec.Binary.Base64 as Base64 | ||
11 | import ScanningParser | ||
12 | |||
13 | data PEMBlob = PEMBlob { pemType :: L.ByteString | ||
14 | , pemBlob :: L.ByteString | ||
15 | } | ||
16 | |||
17 | pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy | ||
18 | where | ||
19 | hdr typ = "-----BEGIN " <> typ <> "-----" | ||
20 | fndtyp typ bs = if bs==hdr typ then Just typ else Nothing | ||
21 | fndany bs = do | ||
22 | guard $ "-----BEGIN " `L.isPrefixOf` bs | ||
23 | let x0 = L.drop 11 bs | ||
24 | guard $ "-----" `LW.isSuffixOf` x0 | ||
25 | let typ = L.take (L.length x0 - 5) x0 | ||
26 | return typ | ||
27 | |||
28 | pbdy typ xs = (mblob, rs) | ||
29 | where | ||
30 | (ys,rs) = span (/="-----END " <> typ <> "-----") xs | ||
31 | mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta) | ||
32 | dta = case ys of | ||
33 | _:dta_lines -> L.concat dta_lines | ||
34 | [] -> "" | ||