summaryrefslogtreecommitdiff
path: root/PEM.hs
blob: e07b3d489de08f1c63ee2c41090f4b558de28448 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
{-# LANGUAGE OverloadedStrings #-}
module PEM where

import Data.Monoid
import qualified Data.ByteString.Lazy as LW
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad
import Control.Applicative
import qualified Codec.Binary.Base64 as Base64
import ScanningParser

data PEMBlob = PEMBlob { pemType :: L.ByteString
                       , pemBlob :: L.ByteString
                       }
 deriving (Eq,Show)

pemParser mtyp = ScanningParser (maybe fndany fndtyp mtyp) pbdy
 where
    hdr typ = "-----BEGIN " <> typ <> "-----"
    fndtyp typ bs = if bs==hdr typ then Just typ else Nothing
    fndany bs = do
        guard $ "-----BEGIN " `L.isPrefixOf` bs
        let x0 = L.drop 11 bs
        guard $ "-----" `LW.isSuffixOf` x0
        let typ = L.take (L.length x0 - 5) x0
        return typ

    pbdy typ xs = (mblob, drop 1 rs)
     where
        (ys,rs) = span (/="-----END " <> typ <> "-----") xs
        mblob = PEMBlob typ <$> LW.pack <$> Base64.decode (L.unpack dta)
        dta = case ys of
                []        -> ""
                dta_lines -> L.concat dta_lines