    {-# LANGUAGE OverloadedStrings #-}
    -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation
    -- Copyright © 2012-2018  Clint Adams
    -- This software is released under the terms of the Expat license.
    -- (See the LICENSE file).

    module Codec.Encryption.OpenPGP.ASCIIArmor.Decode (
       parseArmor
     , decode
     , decodeLazy
    ) where

    import Codec.Encryption.OpenPGP.ASCIIArmor.Types
    import Codec.Encryption.OpenPGP.ASCIIArmor.Utils
    import Control.Applicative (many, (<|>), (<$>), (<*), (<*>), (*>), optional)
    import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>))
    import qualified Data.Attoparsec.ByteString as AS
    import qualified Data.Attoparsec.ByteString.Lazy as AL
    import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar)
    import Data.Bits (shiftL)
    import Data.ByteString.Lazy (ByteString)
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.ByteString.Char8 as BC8
    import qualified Data.ByteString.Base64 as Base64
    import Data.Digest.CRC24 (crc24)
    import Data.Binary.Get (Get, runGetOrFail, getWord8)
    import Data.Functor (($>))
    import Data.String (IsString, fromString)
    import Data.Word (Word32)

    decode :: IsString e => B.ByteString -> Either e [Armor]
    decode :: forall e. IsString e => ByteString -> Either e [Armor]
    decode ByteString
    bs = IResult ByteString [Armor] -> Either e [Armor]
    forall {a} {b}. IsString a => IResult ByteString b -> Either a b
    go (Parser [Armor] -> ByteString -> IResult ByteString [Armor]
    forall a. Parser a -> ByteString -> Result a
    AS.parse Parser [Armor]
    parseArmors ByteString
    bs)
        where
            go :: IResult ByteString b -> Either a b
    go (AS.Fail ByteString
    _ [[Char]]
    _ [Char]
    e) = a -> Either a b
    forall a b. a -> Either a b
    Left ([Char] -> a
    forall a. IsString a => [Char] -> a
    fromString [Char]
    e)
            go (AS.Partial ByteString -> IResult ByteString b
    cont) = IResult ByteString b -> Either a b
    go (ByteString -> IResult ByteString b
    cont ByteString
    B.empty)
            go (AS.Done ByteString
    _ b
    r) = b -> Either a b
    forall a b. b -> Either a b
    Right b
    r

    decodeLazy :: IsString e => BL.ByteString -> Either e [Armor]
    decodeLazy :: forall e. IsString e => ByteString -> Either e [Armor]
    decodeLazy ByteString
    bs = Result [Armor] -> Either e [Armor]
    forall {a} {b}. IsString a => Result b -> Either a b
    go (Parser [Armor] -> ByteString -> Result [Armor]
    forall a. Parser a -> ByteString -> Result a
    AL.parse Parser [Armor]
    parseArmors ByteString
    bs)
        where
            go :: Result b -> Either a b
    go (AL.Fail ByteString
    _ [[Char]]
    _ [Char]
    e) = a -> Either a b
    forall a b. a -> Either a b
    Left ([Char] -> a
    forall a. IsString a => [Char] -> a
    fromString [Char]
    e)
            go (AL.Done ByteString
    _ b
    r) = b -> Either a b
    forall a b. b -> Either a b
    Right b
    r

    parseArmors :: Parser [Armor]
    parseArmors :: Parser [Armor]
    parseArmors = Parser ByteString Armor -> Parser [Armor]
    forall a. Parser ByteString a -> Parser ByteString [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser ByteString Armor
    parseArmor

    parseArmor :: Parser Armor
    parseArmor :: Parser ByteString Armor
    parseArmor = Parser ByteString Armor -> Parser ByteString Armor
    forall a. Parser a -> Parser a
    prefixed (Parser ByteString Armor
    clearsigned Parser ByteString Armor
    -> Parser ByteString Armor -> Parser ByteString Armor
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser ByteString Armor
    armor) Parser ByteString Armor -> [Char] -> Parser ByteString Armor
    forall i a. Parser i a -> [Char] -> Parser i a
    <?> [Char]
    "armor"

    clearsigned :: Parser Armor
    clearsigned :: Parser ByteString Armor
    clearsigned = do
        _ <- ByteString -> Parser ByteString
    string ByteString
    "-----BEGIN PGP SIGNED MESSAGE-----" Parser ByteString -> [Char] -> Parser ByteString
    forall i a. Parser i a -> [Char] -> Parser i a
    <?> [Char]
    "clearsign header"
        _ <- lineEnding <?> "line ending"
        headers <- armorHeaders <?> "clearsign headers"
        _ <- blankishLine <?> "blank line"
        cleartext <- dashEscapedCleartext
        sig <- armor
        return $ ClearSigned headers cleartext sig

    armor :: Parser Armor
    armor :: Parser ByteString Armor
    armor = do
        atype <- Parser ArmorType
    beginLine Parser ArmorType -> [Char] -> Parser ArmorType
    forall i a. Parser i a -> [Char] -> Parser i a
    <?> [Char]
    "begin line"
        headers <- armorHeaders <?> "headers"
        _ <- blankishLine <?> "blank line"
        payload <- base64Data <?> "base64 data"
        _ <- endLine atype <?> "end line"
        return $ Armor atype headers payload

    beginLine :: Parser ArmorType
    beginLine :: Parser ArmorType
    beginLine = do
        _ <- ByteString -> Parser ByteString
    string ByteString
    "-----BEGIN PGP " Parser ByteString -> [Char] -> Parser ByteString
    forall i a. Parser i a -> [Char] -> Parser i a
    <?> [Char]
    "leading minus-hyphens"
        atype <- pubkey <|> privkey <|> parts <|> message <|> signature
        _ <- string "-----" <?> "trailing minus-hyphens"
        _ <- many (satisfy (inClass " \t")) <?> "whitespace"
        _ <- lineEnding <?> "line ending"
        return atype
        where
            message :: Parser ArmorType
    message = ByteString -> Parser ByteString
    string ByteString
    "MESSAGE" Parser ByteString -> ArmorType -> Parser ArmorType
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> ArmorType
    ArmorMessage
            pubkey :: Parser ArmorType
    pubkey = ByteString -> Parser ByteString
    string ByteString
    "PUBLIC KEY BLOCK" Parser ByteString -> ArmorType -> Parser ArmorType
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> ArmorType
    ArmorPublicKeyBlock
            privkey :: Parser ArmorType
    privkey = ByteString -> Parser ByteString
    string ByteString
    "PRIVATE KEY BLOCK" Parser ByteString -> ArmorType -> Parser ArmorType
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> ArmorType
    ArmorPrivateKeyBlock
            signature :: Parser ArmorType
    signature = ByteString -> Parser ByteString
    string ByteString
    "SIGNATURE" Parser ByteString -> ArmorType -> Parser ArmorType
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> ArmorType
    ArmorSignature
            parts :: Parser ArmorType
    parts = ByteString -> Parser ByteString
    string ByteString
    "MESSAGE, PART " Parser ByteString -> Parser ArmorType -> Parser ArmorType
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Parser ArmorType
    partsdef Parser ArmorType -> Parser ArmorType -> Parser ArmorType
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser ArmorType
    partsindef)
            partsdef :: Parser ArmorType
    partsdef = do
                firstnum <- Parser ByteString [Word8]
    num
                _ <- word8 (fromIntegral . fromEnum $ '/')
                secondnum <- num
                return $ ArmorSplitMessage (BL.pack firstnum) (BL.pack secondnum)
            partsindef :: Parser ArmorType
    partsindef = ByteString -> ArmorType
    ArmorSplitMessageIndefinite (ByteString -> ArmorType)
    -> ([Word8] -> ByteString) -> [Word8] -> ArmorType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> ByteString
    BL.pack ([Word8] -> ArmorType)
    -> Parser ByteString [Word8] -> Parser ArmorType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString [Word8]
    num
            num :: Parser ByteString [Word8]
    num = Parser ByteString Word8 -> Parser ByteString [Word8]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many1 ((Word8 -> Bool) -> Parser ByteString Word8
    satisfy Word8 -> Bool
    isDigit_w8) Parser ByteString [Word8] -> [Char] -> Parser ByteString [Word8]
    forall i a. Parser i a -> [Char] -> Parser i a
    <?> [Char]
    "number"

    lineEnding :: Parser B.ByteString
    lineEnding :: Parser ByteString
    lineEnding = ByteString -> Parser ByteString
    string ByteString
    "\n" Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ByteString -> Parser ByteString
    string ByteString
    "\r\n"

    armorHeaders :: Parser [(String, String)]
    armorHeaders :: Parser [([Char], [Char])]
    armorHeaders = Parser ByteString ([Char], [Char]) -> Parser [([Char], [Char])]
    forall a. Parser ByteString a -> Parser ByteString [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser ByteString ([Char], [Char])
    armorHeader

    armorHeader :: Parser (String, String)
    armorHeader :: Parser ByteString ([Char], [Char])
    armorHeader = do
        key <- Parser ByteString Word8 -> Parser ByteString [Word8]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many1 ((Word8 -> Bool) -> Parser ByteString Word8
    satisfy ([Char] -> Word8 -> Bool
    inClass [Char]
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"))
        _ <- string ": "
        val <- many1 (satisfy (notInClass "\n\r"))
        _ <- lineEnding
        return (w8sToString key, w8sToString val)
        where
            w8sToString :: [Word8] -> [Char]
    w8sToString = ByteString -> [Char]
    BC8.unpack (ByteString -> [Char])
    -> ([Word8] -> ByteString) -> [Word8] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> ByteString
    B.pack

    blankishLine ::  Parser B.ByteString
    blankishLine :: Parser ByteString
    blankishLine = Parser ByteString Word8 -> Parser ByteString [Word8]
    forall a. Parser ByteString a -> Parser ByteString [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many ((Word8 -> Bool) -> Parser ByteString Word8
    satisfy ([Char] -> Word8 -> Bool
    inClass [Char]
    " \t")) Parser ByteString [Word8] -> Parser ByteString -> Parser ByteString
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString
    lineEnding

    endLine :: ArmorType -> Parser B.ByteString
    endLine :: ArmorType -> Parser ByteString
    endLine ArmorType
    atype = do
        _ <- ByteString -> Parser ByteString
    string (ByteString -> Parser ByteString)
    -> ByteString -> Parser ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    "-----END PGP " ByteString -> ByteString -> ByteString
    `B.append` ArmorType -> ByteString
    aType ArmorType
    atype ByteString -> ByteString -> ByteString
    `B.append` ByteString
    "-----"
        lineEnding

    aType :: ArmorType -> B.ByteString
    aType :: ArmorType -> ByteString
    aType ArmorType
    ArmorMessage = [Char] -> ByteString
    BC8.pack [Char]
    "MESSAGE"
    aType ArmorType
    ArmorPublicKeyBlock = [Char] -> ByteString
    BC8.pack [Char]
    "PUBLIC KEY BLOCK"
    aType ArmorType
    ArmorPrivateKeyBlock = [Char] -> ByteString
    BC8.pack [Char]
    "PRIVATE KEY BLOCK"
    aType (ArmorSplitMessage ByteString
    x ByteString
    y) = [Char] -> ByteString
    BC8.pack [Char]
    "MESSAGE, PART " ByteString -> ByteString -> ByteString
    `B.append` ByteString -> ByteString
    l2s ByteString
    x ByteString -> ByteString -> ByteString
    `B.append` Char -> ByteString
    BC8.singleton Char
    '/' ByteString -> ByteString -> ByteString
    `B.append` ByteString -> ByteString
    l2s ByteString
    y
    aType (ArmorSplitMessageIndefinite ByteString
    x) = [Char] -> ByteString
    BC8.pack [Char]
    "MESSAGE, PART " ByteString -> ByteString -> ByteString
    `B.append` ByteString -> ByteString
    l2s ByteString
    x
    aType ArmorType
    ArmorSignature = [Char] -> ByteString
    BC8.pack [Char]
    "SIGNATURE"

    l2s :: BL.ByteString -> B.ByteString
    l2s :: ByteString -> ByteString
    l2s = [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    BL.toChunks

    base64Data :: Parser ByteString
    base64Data :: Parser ByteString
    base64Data = do
        ls <- Parser ByteString -> Parser ByteString [ByteString]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many1 Parser ByteString
    base64Line
        cksum <- checksumLine
        let payload = [ByteString] -> ByteString
    B.concat [ByteString]
    ls
        let ourcksum = ByteString -> Word32
    crc24 ByteString
    payload
        case runGetOrFail d24 (BL.fromStrict cksum) of
            Left (ByteString
    _,ByteOffset
    _,[Char]
    err) -> [Char] -> Parser ByteString
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    err
            Right (ByteString
    _,ByteOffset
    _,Word32
    theircksum) -> if Word32
    theircksum Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    ourcksum then ByteString -> Parser ByteString
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> ByteString
    BL.fromStrict ByteString
    payload) else [Char] -> Parser ByteString
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char]
    "CRC24 mismatch: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Word8] -> [Char]
    forall a. Show a => a -> [Char]
    show (ByteString -> [Word8]
    B.unpack ByteString
    cksum) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Word32 -> [Char]
    forall a. Show a => a -> [Char]
    show Word32
    theircksum [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " vs. " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Word32 -> [Char]
    forall a. Show a => a -> [Char]
    show Word32
    ourcksum)
        where
            base64Line :: Parser B.ByteString
            base64Line :: Parser ByteString
    base64Line = do
                            b64 <- Parser ByteString Word8 -> Parser ByteString [Word8]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many1 ((Word8 -> Bool) -> Parser ByteString Word8
    satisfy ([Char] -> Word8 -> Bool
    inClass [Char]
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
                            pad <- many (word8 (fromIntegral . fromEnum $ '='))
                            _ <- lineEnding
                            let line = [Word8] -> ByteString
    B.pack [Word8]
    b64 ByteString -> ByteString -> ByteString
    `B.append` [Word8] -> ByteString
    B.pack [Word8]
    pad
                            case Base64.decode line of
                                Left [Char]
    err -> [Char] -> Parser ByteString
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    err
                                Right ByteString
    bs -> ByteString -> Parser ByteString
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs
            checksumLine :: Parser B.ByteString
            checksumLine :: Parser ByteString
    checksumLine = do
                            _ <- Word8 -> Parser ByteString Word8
    word8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    forall a. Enum a => a -> Int
    fromEnum (Char -> Word8) -> Char -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char
    '=')
                            b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
                            _ <- lineEnding
                            let line = [Word8] -> ByteString
    B.pack [Word8]
    b64
                            case Base64.decode line of
                                Left [Char]
    err -> [Char] -> Parser ByteString
    forall a. [Char] -> Parser ByteString a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    err
                                Right ByteString
    bs -> ByteString -> Parser ByteString
    forall a. a -> Parser ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    bs

    d24 :: Get Word32
    d24 :: Get Word32
    d24 = do
        a <- Get Word8
    getWord8
        b <- getWord8
        c <- getWord8
        return $ shiftL (fromIntegral a :: Word32) 16 + shiftL (fromIntegral b :: Word32) 8 + (fromIntegral c :: Word32)

    prefixed :: Parser a -> Parser a
    prefixed :: forall a. Parser a -> Parser a
    prefixed Parser a
    end = Parser a
    end Parser a -> Parser a -> Parser a
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser Char
    anyChar Parser Char -> Parser a -> Parser a
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser a -> Parser a
    forall a. Parser a -> Parser a
    prefixed Parser a
    end

    dashEscapedCleartext :: Parser ByteString
    dashEscapedCleartext :: Parser ByteString
    dashEscapedCleartext = do
        ls <- Parser ByteString -> Parser ByteString [ByteString]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many1 ((Parser ByteString
    deLine Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a.
    Parser ByteString a -> Parser ByteString a -> Parser ByteString a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser ByteString
    unescapedLine) Parser ByteString -> Parser ByteString -> Parser ByteString
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser ByteString
    lineEnding)
        return . BL.fromStrict $ crlfUnlines ls
        where
            deLine :: Parser B.ByteString
            deLine :: Parser ByteString
    deLine = [Word8] -> ByteString
    B.pack ([Word8] -> ByteString)
    -> Parser ByteString [Word8] -> Parser ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (ByteString -> Parser ByteString
    string ByteString
    "- " Parser ByteString
    -> Parser ByteString [Word8] -> Parser ByteString [Word8]
    forall a b.
    Parser ByteString a -> Parser ByteString b -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ByteString Word8 -> Parser ByteString [Word8]
    forall a. Parser ByteString a -> Parser ByteString [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many ((Word8 -> Bool) -> Parser ByteString Word8
    satisfy ([Char] -> Word8 -> Bool
    notInClass [Char]
    "\n\r")))
            unescapedLine :: Parser B.ByteString
            unescapedLine :: Parser ByteString
    unescapedLine = ByteString
    -> ([Word8] -> ByteString) -> Maybe [Word8] -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString
    B.empty [Word8] -> ByteString
    B.pack (Maybe [Word8] -> ByteString)
    -> Parser ByteString (Maybe [Word8]) -> Parser ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser ByteString [Word8] -> Parser ByteString (Maybe [Word8])
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional ((:) (Word8 -> [Word8] -> [Word8])
    -> Parser ByteString Word8
    -> Parser ByteString ([Word8] -> [Word8])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Word8 -> Bool) -> Parser ByteString Word8
    satisfy ([Char] -> Word8 -> Bool
    notInClass [Char]
    "-\n\r") Parser ByteString ([Word8] -> [Word8])
    -> Parser ByteString [Word8] -> Parser ByteString [Word8]
    forall a b.
    Parser ByteString (a -> b)
    -> Parser ByteString a -> Parser ByteString b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser ByteString Word8 -> Parser ByteString [Word8]
    forall a. Parser ByteString a -> Parser ByteString [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many ((Word8 -> Bool) -> Parser ByteString Word8
    satisfy ([Char] -> Word8 -> Bool
    notInClass [Char]
    "\n\r")))