{-# LANGUAGE OverloadedStrings #-}
-- ASCIIArmor/Decode.hs: OpenPGP (RFC9580) ASCII armor implementation
-- Copyright © 2012-2026  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
 , decodeWith
 , decodeLazyWith
) where

import Codec.Encryption.OpenPGP.ASCIIArmor.Types
import Codec.Encryption.OpenPGP.ASCIIArmor.Utils
import Control.Applicative (many, (<|>), optional)
import qualified Data.Attoparsec.Combinator as AC
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.Char (isAlphaNum, isSpace)
import Data.Digest.CRC24 (crc24)
import Data.Binary.Get (Get, runGetOrFail, getWord8)
import Data.Functor (($>))
import Data.List (dropWhileEnd)
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 = DecodeOptions -> ByteString -> Either e [Armor]
forall e.
IsString e =>
DecodeOptions -> ByteString -> Either e [Armor]
decodeWith DecodeOptions
defaultDecodeOptions

decodeWith :: IsString e => DecodeOptions -> B.ByteString -> Either e [Armor]
decodeWith :: forall e.
IsString e =>
DecodeOptions -> ByteString -> Either e [Armor]
decodeWith DecodeOptions
options 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 (DecodeOptions -> Parser [Armor]
parseArmors DecodeOptions
options) 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 = DecodeOptions -> ByteString -> Either e [Armor]
forall e.
IsString e =>
DecodeOptions -> ByteString -> Either e [Armor]
decodeLazyWith DecodeOptions
defaultDecodeOptions

decodeLazyWith :: IsString e => DecodeOptions -> BL.ByteString -> Either e [Armor]
decodeLazyWith :: forall e.
IsString e =>
DecodeOptions -> ByteString -> Either e [Armor]
decodeLazyWith DecodeOptions
options 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 (DecodeOptions -> Parser [Armor]
parseArmors DecodeOptions
options) 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 :: DecodeOptions -> Parser [Armor]
parseArmors :: DecodeOptions -> Parser [Armor]
parseArmors DecodeOptions
options = Parser ByteString Armor -> Parser [Armor]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (DecodeOptions -> Parser ByteString Armor
parseArmorWith DecodeOptions
options)

parseArmor :: Parser Armor
parseArmor :: Parser ByteString Armor
parseArmor = DecodeOptions -> Parser ByteString Armor
parseArmorWith DecodeOptions
defaultDecodeOptions

parseArmorWith :: DecodeOptions -> Parser Armor
parseArmorWith :: DecodeOptions -> Parser ByteString Armor
parseArmorWith DecodeOptions
options = Parser ByteString Armor -> Parser ByteString Armor
forall a. Parser a -> Parser a
prefixed (DecodeOptions -> Parser ByteString Armor
clearsigned DecodeOptions
options 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
<|> DecodeOptions -> Parser ByteString Armor
armor DecodeOptions
options) Parser ByteString Armor -> [Char] -> Parser ByteString Armor
forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"armor"

clearsigned :: DecodeOptions -> Parser Armor
clearsigned :: DecodeOptions -> Parser ByteString Armor
clearsigned DecodeOptions
options = 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 <- cleartextHeaders options <?> "clearsign headers"
    _ <- blankishLine <?> "blank line"
    cleartext <- dashEscapedCleartext
    sig <- armor options
    return $ ClearSigned headers cleartext sig

armor :: DecodeOptions -> Parser Armor
armor :: DecodeOptions -> Parser ByteString Armor
armor DecodeOptions
options = 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 options <?> "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"

cleartextHeaders :: DecodeOptions -> Parser [(String, String)]
cleartextHeaders :: DecodeOptions -> Parser [([Char], [Char])]
cleartextHeaders DecodeOptions
options
    | DecodeOptions -> Bool
shouldRequireHashOnlyHeaders DecodeOptions
options = 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])
hashHeader
    | Bool
otherwise = Parser [([Char], [Char])]
armorHeaders
    where
        hashHeader :: Parser ByteString ([Char], [Char])
hashHeader = do
            hdr@(k, v) <- Parser ByteString ([Char], [Char])
armorHeader
            if k == "Hash" && isConformantHashHeader v
                then return hdr
                else fail "Only well-formed Hash headers are allowed before cleartext payload"

isConformantHashHeader :: String -> Bool
isConformantHashHeader :: [Char] -> Bool
isConformantHashHeader [Char]
v = Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
tokens) Bool -> Bool -> Bool
&& ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Char] -> Bool
isValidToken [[Char]]
tokens
    where
        tokens :: [[Char]]
tokens = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
trim ([Char] -> [[Char]]
splitOnComma [Char]
v)
        splitOnComma :: [Char] -> [[Char]]
splitOnComma [] = [[Char]
""]
        splitOnComma [Char]
xs =
            let ([Char]
a, [Char]
rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') [Char]
xs
             in [Char]
a [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: case [Char]
rest of
                 [] -> []
                 (Char
_:[Char]
ys) -> [Char] -> [[Char]]
splitOnComma [Char]
ys
        trim :: [Char] -> [Char]
trim = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
        isValidToken :: [Char] -> Bool
isValidToken [] = Bool
False
        isValidToken [Char]
t = (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-') [Char]
t

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 :: DecodeOptions -> Parser ByteString
base64Data :: DecodeOptions -> Parser ByteString
base64Data DecodeOptions
options = do
    ls <- Parser ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser ByteString
base64Line
    let payload = [ByteString] -> ByteString
B.concat [ByteString]
ls
    case crc24Validation options of
        DecodeCRC24Validation
DecodeCRC24ValidationStrict -> do
            decodedChecksum <- Parser ByteString
checksumLineStrict
            validateChecksum payload (Just decodedChecksum) True
            return (BL.fromStrict payload)
        DecodeCRC24Validation
DecodeCRC24ValidationPermissive -> do
            decodedChecksum <- Parser ByteString -> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString
checksumLinePermissive
            validateChecksum payload decodedChecksum False
            return (BL.fromStrict payload)
        DecodeCRC24Validation
DecodeCRC24ValidationAuto -> [Char] -> Parser ByteString
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Internal error: unresolved CRC24 validation mode"
  where
    base64Line :: Parser B.ByteString
    base64Line :: Parser ByteString
base64Line = do
        startsChecksum <- Parser Bool
isChecksumLineStart
        if startsChecksum
            then fail "checksum line"
            else do
                b64line <- B.pack <$> many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/= \t"))
                _ <- lineEnding
                let cleaned = ByteString -> ByteString
stripInlineWhitespace ByteString
b64line
                case Base64.decode cleaned 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

    isChecksumLineStart :: Parser Bool
    isChecksumLineStart :: Parser Bool
isChecksumLineStart = Parser Bool -> Parser Bool
forall i a. Parser i a -> Parser i a
AC.lookAhead (Parser Bool -> Parser Bool) -> Parser Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ do
        _ <- 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"))
        c <- satisfy (notInClass "\n\r")
        return (c == fromIntegral (fromEnum '='))

    checksumLineStrict :: Parser B.ByteString
    checksumLineStrict :: Parser ByteString
checksumLineStrict = 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 <- B.pack <$> many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/ \t"))
        _ <- lineEnding
        case Base64.decode (stripInlineWhitespace b64) 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

    checksumLinePermissive :: Parser B.ByteString
    checksumLinePermissive :: Parser ByteString
checksumLinePermissive = 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
'=')
        raw <- B.pack <$> many (satisfy (notInClass "\n\r"))
        _ <- lineEnding
        case Base64.decode (stripInlineWhitespace raw) of
            Left [Char]
_ -> ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
            Right ByteString
bs -> ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

validateChecksum :: B.ByteString -> Maybe B.ByteString -> Bool -> Parser ()
validateChecksum :: ByteString -> Maybe ByteString -> Bool -> Parser ()
validateChecksum ByteString
payload Maybe ByteString
mDecodedChecksum Bool
requireValidCrc =
    case Maybe ByteString
mDecodedChecksum of
        Maybe ByteString
Nothing ->
            if Bool
requireValidCrc
                then [Char] -> Parser ()
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Missing CRC24 checksum line"
                else () -> Parser ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ByteString
decodedChecksum ->
            if ByteString -> Int
B.length ByteString
decodedChecksum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3
                then if Bool
requireValidCrc then [Char] -> Parser ()
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Malformed CRC24 checksum line" else () -> Parser ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                else
                    case Get Word32
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, Word32)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
runGetOrFail Get Word32
d24 (ByteString -> ByteString
BL.fromStrict ByteString
decodedChecksum) of
                        Left (ByteString
_,ByteOffset
_,[Char]
err) ->
                            if Bool
requireValidCrc then [Char] -> Parser ()
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
err else () -> Parser ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Right (ByteString
_,ByteOffset
_,Word32
theircksum) ->
                            let ourcksum :: Word32
ourcksum = ByteString -> Word32
crc24 ByteString
payload
                             in if Word32
theircksum Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
ourcksum Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
requireValidCrc
                                   then () -> Parser ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                   else [Char] -> Parser ()
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
decodedChecksum) [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)

stripInlineWhitespace :: B.ByteString -> B.ByteString
stripInlineWhitespace :: ByteString -> ByteString
stripInlineWhitespace = (Word8 -> Bool) -> ByteString -> ByteString
B.filter (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x20 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x09)

crc24Validation :: DecodeOptions -> DecodeCRC24Validation
crc24Validation :: DecodeOptions -> DecodeCRC24Validation
crc24Validation DecodeOptions
options =
    case DecodeOptions -> DecodeCRC24Validation
decodeCRC24Validation DecodeOptions
options of
        DecodeCRC24Validation
DecodeCRC24ValidationAuto ->
            case DecodeOptions -> ConformanceProfile
decodeConformanceProfile DecodeOptions
options of
                ConformanceProfile
Strict_4880_AA -> DecodeCRC24Validation
DecodeCRC24ValidationStrict
                ConformanceProfile
Strict_9580_AA -> DecodeCRC24Validation
DecodeCRC24ValidationPermissive
                ConformanceProfile
Postel_AA -> DecodeCRC24Validation
DecodeCRC24ValidationPermissive
        DecodeCRC24Validation
explicitMode -> DecodeCRC24Validation
explicitMode

shouldRequireHashOnlyHeaders :: DecodeOptions -> Bool
shouldRequireHashOnlyHeaders :: DecodeOptions -> Bool
shouldRequireHashOnlyHeaders DecodeOptions
options =
    case DecodeOptions -> DecodeCleartextHeaderPolicy
decodeCleartextHeaderPolicy DecodeOptions
options of
        DecodeCleartextHeaderPolicy
DecodeCleartextHeaderPolicyAuto ->
            DecodeOptions -> ConformanceProfile
decodeConformanceProfile DecodeOptions
options ConformanceProfile -> ConformanceProfile -> Bool
forall a. Eq a => a -> a -> Bool
== ConformanceProfile
Strict_9580_AA
        DecodeCleartextHeaderPolicy
DecodeCleartextHeaderPolicyLegacy -> Bool
False
        DecodeCleartextHeaderPolicy
DecodeCleartextHeaderPolicyHashOnly -> Bool
True

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 = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
crlfUnlines ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Parser ByteString [ByteString]
go []
    where
        go :: [ByteString] -> Parser ByteString [ByteString]
go [ByteString]
acc = do
            isSignatureStart <- Parser Bool -> Parser Bool
forall i a. Parser i a -> Parser i a
AC.lookAhead ((ByteString -> Parser ByteString
string ByteString
"-----BEGIN PGP " Parser ByteString -> Parser Bool -> Parser Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Parser Bool -> Parser Bool -> Parser Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
            if isSignatureStart
                then return (reverse acc)
                else do
                    rawLine <- B.pack <$> many (satisfy (notInClass "\n\r"))
                    _ <- lineEnding
                    go (undash rawLine : acc)

        undash :: B.ByteString -> B.ByteString
        undash :: ByteString -> ByteString
undash ByteString
line
            | [Char] -> ByteString
BC8.pack [Char]
"- " ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
line = Int -> ByteString -> ByteString
B.drop Int
2 ByteString
line
            | Bool
otherwise = ByteString
line