-- | age file header.
module Crypto.Age.Header
  ( -- * Header
    Header (..)
  , headerBuilder
  , headerParser
    -- ** Stanza
  , Stanza (..)
  , stanzaBuilder
  , stanzaParser
    -- ** Header MAC
  , HeaderMac (..)
  , computeHeaderMac
  , headerMacBuilder
  , headerMacParser
  ) where

import Control.Monad ( void )
import Crypto.Age.Key ( FileKey, fileKeyToBytes )
import qualified Crypto.Hash as Crypto
import qualified Crypto.KDF.HKDF as HKDF
import qualified Crypto.MAC.HMAC as Crypto
import Data.Attoparsec.ByteString
  ( Parser, many', many1', sepBy1', string, take, takeWhile1 )
import Data.Attoparsec.ByteString.Base64 ( takeMNBase64Chars, takeNBase64Chars )
import Data.Attoparsec.ByteString.Char8 ( char8 )
import Data.ByteArray ( ScrubbedBytes, constEq )
import qualified Data.ByteArray as BA
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import Data.ByteString.Base64.Extra
  ( decodeBase64StdUnpadded, encodeBase64StdUnpadded )
import Data.ByteString.Builder ( Builder )
import qualified Data.ByteString.Builder as Builder
import Data.ByteString.Extra ( chunksOf )
import Data.Foldable ( foldMap' )
import qualified Data.List as L
import qualified Data.List.Compat as LC
import Data.List.NonEmpty ( NonEmpty )
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Prelude hiding ( take )

-- | Parse an ABNF @VCHAR@ string as specified in
-- [RFC 2234 section 6.1](https://www.rfc-editor.org/rfc/rfc2234#section-6.1).
vcharStringParser :: Parser ByteString
vcharStringParser :: Parser ByteString
vcharStringParser = (Word8 -> Bool) -> Parser ByteString
takeWhile1 (Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
0x21 .. Word8
0x7E])

-- | Parse and decode @n@ characters of unpadded base64.
base64UnpaddedParser :: Int -> Parser ByteString
base64UnpaddedParser :: Int -> Parser ByteString
base64UnpaddedParser Int
n = do
  ByteString
b64 <- Int -> Parser ByteString
take Int
n
  case ByteString -> Either Text ByteString
decodeBase64StdUnpadded ByteString
b64 of
    Left Text
err -> String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
err)
    Right ByteString
bs -> ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

-- | Stanza.
data Stanza = Stanza
  { -- | Stanza tag (technically, the first argument of the stanza).
    Stanza -> ByteString
sTag :: !ByteString
  , -- | Stanza arguments (every argument after the tag).
    Stanza -> [ByteString]
sArgs :: ![ByteString]
  , -- | Base64-decoded stanza body.
    Stanza -> ByteString
sBody :: !ByteString
  }
  deriving stock (Int -> Stanza -> ShowS
[Stanza] -> ShowS
Stanza -> String
(Int -> Stanza -> ShowS)
-> (Stanza -> String) -> ([Stanza] -> ShowS) -> Show Stanza
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stanza -> ShowS
showsPrec :: Int -> Stanza -> ShowS
$cshow :: Stanza -> String
show :: Stanza -> String
$cshowList :: [Stanza] -> ShowS
showList :: [Stanza] -> ShowS
Show, Stanza -> Stanza -> Bool
(Stanza -> Stanza -> Bool)
-> (Stanza -> Stanza -> Bool) -> Eq Stanza
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stanza -> Stanza -> Bool
== :: Stanza -> Stanza -> Bool
$c/= :: Stanza -> Stanza -> Bool
/= :: Stanza -> Stanza -> Bool
Eq)

stanzaBegin :: ByteString
stanzaBegin :: ByteString
stanzaBegin = ByteString
"-> "

stanzaBuilder :: Stanza -> Builder
stanzaBuilder :: Stanza -> Builder
stanzaBuilder Stanza
s = Builder
argLineBuilder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
bodyBuilder
  where
    Stanza
      { ByteString
sTag :: Stanza -> ByteString
sTag :: ByteString
sTag
      , [ByteString]
sArgs :: Stanza -> [ByteString]
sArgs :: [ByteString]
sArgs
      , ByteString
sBody :: Stanza -> ByteString
sBody :: ByteString
sBody
      } = Stanza
s

    bodyB64 :: ByteString
    bodyB64 :: ByteString
bodyB64 = ByteString -> ByteString
encodeBase64StdUnpadded ByteString
sBody

    bodyB64Chunks :: [ByteString]
    bodyB64Chunks :: [ByteString]
bodyB64Chunks = Int -> ByteString -> [ByteString]
chunksOf Int
64 ByteString
bodyB64

    argLineBuilder :: Builder
    argLineBuilder :: Builder
argLineBuilder =
      ByteString -> Builder
Builder.byteString ByteString
stanzaBegin
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString (ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
" " (ByteString
sTag ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
sArgs))
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
"\n"

    fullBodyLinesBuilder :: [ByteString] -> Builder
    fullBodyLinesBuilder :: [ByteString] -> Builder
fullBodyLinesBuilder [] = Builder
forall a. Monoid a => a
mempty
    fullBodyLinesBuilder [ByteString]
xs =
      ByteString -> Builder
Builder.byteString (ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" [ByteString]
xs)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
"\n"

    finalBodyLineBuilder :: ByteString -> Builder
    finalBodyLineBuilder :: ByteString -> Builder
finalBodyLineBuilder ByteString
bs
      | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = ByteString -> Builder
Builder.byteString (ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n\n")
      | Bool
otherwise = ByteString -> Builder
Builder.byteString (ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")

    bodyBuilder :: Builder
    bodyBuilder :: Builder
bodyBuilder =
      case [ByteString] -> Maybe ([ByteString], ByteString)
forall a. [a] -> Maybe ([a], a)
LC.unsnoc [ByteString]
bodyB64Chunks of
        Maybe ([ByteString], ByteString)
Nothing -> ByteString -> Builder
Builder.byteString ByteString
"\n"
        Just ([ByteString]
cs, ByteString
c) ->
          [ByteString] -> Builder
fullBodyLinesBuilder [ByteString]
cs
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
finalBodyLineBuilder ByteString
c

stanzaParser :: Parser Stanza
stanzaParser :: Parser Stanza
stanzaParser = do
  Parser ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ByteString ())
-> Parser ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
string ByteString
stanzaBegin
  (ByteString
tag, [ByteString]
args) <- Parser (ByteString, [ByteString])
argLineParser
  Parser ByteString Word8 -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ByteString ())
-> Parser ByteString Word8 -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Word8
char8 Char
'\n'
  ByteString
body <- Parser ByteString
bodyParser
  Stanza -> Parser Stanza
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stanza
    { sTag :: ByteString
sTag = ByteString
tag
    , sArgs :: [ByteString]
sArgs = [ByteString]
args
    , sBody :: ByteString
sBody = ByteString
body
    }
  where
    argLineParser :: Parser (ByteString, [ByteString])
    argLineParser :: Parser (ByteString, [ByteString])
argLineParser = do
      [ByteString]
args <- Parser ByteString
vcharStringParser Parser ByteString
-> Parser ByteString Word8 -> Parser ByteString [ByteString]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`sepBy1'` Char -> Parser ByteString Word8
char8 Char
' '
      case [ByteString] -> Maybe (ByteString, [ByteString])
forall a. [a] -> Maybe (a, [a])
L.uncons [ByteString]
args of
        Maybe (ByteString, [ByteString])
Nothing -> String -> Parser (ByteString, [ByteString])
forall a. HasCallStack => String -> a
error String
"stanzaParser: impossible: no elements in a list parsed using sepBy1"
        Just (ByteString
tag, [ByteString]
rest) -> (ByteString, [ByteString]) -> Parser (ByteString, [ByteString])
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
tag, [ByteString]
rest)

    fullBodyLineParser :: Parser ByteString
    fullBodyLineParser :: Parser ByteString
fullBodyLineParser = Word -> Parser ByteString
takeNBase64Chars Word
64 Parser ByteString -> Parser ByteString Word8 -> 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
<* Char -> Parser ByteString Word8
char8 Char
'\n'

    finalBodyLineParser :: Parser ByteString
    finalBodyLineParser :: Parser ByteString
finalBodyLineParser = Word -> Word -> Parser ByteString
takeMNBase64Chars Word
0 Word
63 Parser ByteString -> Parser ByteString Word8 -> 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
<* Char -> Parser ByteString Word8
char8 Char
'\n'

    -- Parse the line-wrapped base64-encoded stanza body.
    --
    -- This parser returns each base64-encoded line of the stanza body.
    wrappedBodyParser :: Parser [ByteString]
    wrappedBodyParser :: Parser ByteString [ByteString]
wrappedBodyParser = do
      [ByteString]
fullLines <- Parser ByteString -> Parser ByteString [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ByteString
fullBodyLineParser
      ByteString
finalLine <- Parser ByteString
finalBodyLineParser
      [ByteString] -> Parser ByteString [ByteString]
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> Parser ByteString [ByteString])
-> [ByteString] -> Parser ByteString [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
fullLines [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
finalLine]

    -- Parse and decode the stanza body.
    --
    -- This parses each base64-encoded line of the stanza body, concatenates
    -- them, and then base64 decodes the result.
    bodyParser :: Parser ByteString
    bodyParser :: Parser ByteString
bodyParser = do
      [ByteString]
bodyLines <- Parser ByteString [ByteString]
wrappedBodyParser
      case ByteString -> Either Text ByteString
decodeBase64StdUnpadded ([ByteString] -> ByteString
BS.concat [ByteString]
bodyLines) of
        Left Text
err -> String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
T.unpack Text
err)
        Right ByteString
bs -> ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

-- | Header MAC.
--
-- Note that this type's 'Eq' instance performs a constant-time equality
-- check.
newtype HeaderMac = HeaderMac
  { HeaderMac -> HMAC SHA256
unHeaderMac :: Crypto.HMAC Crypto.SHA256 }

instance Show HeaderMac where
  show :: HeaderMac -> String
show = Digest SHA256 -> String
forall a. Show a => a -> String
show (Digest SHA256 -> String)
-> (HeaderMac -> Digest SHA256) -> HeaderMac -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMAC SHA256 -> Digest SHA256
forall a. HMAC a -> Digest a
Crypto.hmacGetDigest (HMAC SHA256 -> Digest SHA256)
-> (HeaderMac -> HMAC SHA256) -> HeaderMac -> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderMac -> HMAC SHA256
unHeaderMac

instance Eq HeaderMac where
  HeaderMac HMAC SHA256
x == :: HeaderMac -> HeaderMac -> Bool
== HeaderMac HMAC SHA256
y = HMAC SHA256
x HMAC SHA256 -> HMAC SHA256 -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` HMAC SHA256
y

-- | Compute the 'HeaderMac' for a 'Header' which would contain the provided 'Stanza's.
computeHeaderMac :: FileKey -> NonEmpty Stanza -> HeaderMac
computeHeaderMac :: FileKey -> NonEmpty Stanza -> HeaderMac
computeHeaderMac FileKey
fk NonEmpty Stanza
stanzas = do
  let info :: ByteString
      info :: ByteString
info = ByteString
"header"

      prk :: HKDF.PRK Crypto.SHA256
      prk :: PRK SHA256
prk = ByteString -> ScrubbedBytes -> PRK SHA256
forall a salt ikm.
(HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) =>
salt -> ikm -> PRK a
HKDF.extract ByteString
BS.empty (FileKey -> ScrubbedBytes
fileKeyToBytes FileKey
fk)

      hmacKey :: ScrubbedBytes
      hmacKey :: ScrubbedBytes
hmacKey = PRK SHA256 -> ByteString -> Int -> ScrubbedBytes
forall a info out.
(HashAlgorithm a, ByteArrayAccess info, ByteArray out) =>
PRK a -> info -> Int -> out
HKDF.expand PRK SHA256
prk ByteString
info Int
32

      partialHeaderBs :: ByteString
      partialHeaderBs :: ByteString
partialHeaderBs =
        LazyByteString -> ByteString
BS.toStrict (LazyByteString -> ByteString)
-> (Builder -> LazyByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
          PartialHeader -> Maybe HeaderMac -> Builder
headerBuilder' (NonEmpty Stanza -> PartialHeader
PartialHeader NonEmpty Stanza
stanzas) Maybe HeaderMac
forall a. Maybe a
Nothing

  HMAC SHA256 -> HeaderMac
HeaderMac (ScrubbedBytes -> ByteString -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
Crypto.hmac ScrubbedBytes
hmacKey ByteString
partialHeaderBs)

headerMacMark :: ByteString
headerMacMark :: ByteString
headerMacMark = ByteString
"---"

headerMacBegin :: ByteString
headerMacBegin :: ByteString
headerMacBegin = ByteString
headerMacMark ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "

headerMacBuilder :: HeaderMac -> Builder
headerMacBuilder :: HeaderMac -> Builder
headerMacBuilder (HeaderMac HMAC SHA256
h) =
  ByteString -> Builder
Builder.byteString ByteString
headerMacBegin
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString (ByteString -> ByteString
encodeBase64StdUnpadded (ByteString -> ByteString)
-> (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
forall a b. (a -> b) -> a -> b
$ HMAC SHA256 -> Digest SHA256
forall a. HMAC a -> Digest a
Crypto.hmacGetDigest HMAC SHA256
h)

headerMacParser :: Parser HeaderMac
headerMacParser :: Parser HeaderMac
headerMacParser = do
  Parser ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ByteString ())
-> Parser ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
string ByteString
headerMacBegin
  ByteString
macBs <- Int -> Parser ByteString
base64UnpaddedParser Int
43
  case ByteString -> Maybe (Digest SHA256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
Crypto.digestFromByteString ByteString
macBs of
    Maybe (Digest SHA256)
Nothing -> String -> Parser HeaderMac
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid header HMAC"
    Just Digest SHA256
d -> HeaderMac -> Parser HeaderMac
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeaderMac -> Parser HeaderMac) -> HeaderMac -> Parser HeaderMac
forall a b. (a -> b) -> a -> b
$ HMAC SHA256 -> HeaderMac
HeaderMac (Digest SHA256 -> HMAC SHA256
forall a. Digest a -> HMAC a
Crypto.HMAC Digest SHA256
d)

-- | Partial header.
--
-- This is an internal data type used for computing the header MAC.
newtype PartialHeader = PartialHeader (NonEmpty Stanza)
  deriving stock (Int -> PartialHeader -> ShowS
[PartialHeader] -> ShowS
PartialHeader -> String
(Int -> PartialHeader -> ShowS)
-> (PartialHeader -> String)
-> ([PartialHeader] -> ShowS)
-> Show PartialHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PartialHeader -> ShowS
showsPrec :: Int -> PartialHeader -> ShowS
$cshow :: PartialHeader -> String
show :: PartialHeader -> String
$cshowList :: [PartialHeader] -> ShowS
showList :: [PartialHeader] -> ShowS
Show, PartialHeader -> PartialHeader -> Bool
(PartialHeader -> PartialHeader -> Bool)
-> (PartialHeader -> PartialHeader -> Bool) -> Eq PartialHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PartialHeader -> PartialHeader -> Bool
== :: PartialHeader -> PartialHeader -> Bool
$c/= :: PartialHeader -> PartialHeader -> Bool
/= :: PartialHeader -> PartialHeader -> Bool
Eq)

-- | Convert a 'Header' to a 'PartialHeader'.
toPartialHeader :: Header -> PartialHeader
toPartialHeader :: Header -> PartialHeader
toPartialHeader Header{NonEmpty Stanza
hStanzas :: NonEmpty Stanza
hStanzas :: Header -> NonEmpty Stanza
hStanzas} = NonEmpty Stanza -> PartialHeader
PartialHeader NonEmpty Stanza
hStanzas

-- | Header.
data Header = Header
  { -- | Stanzas.
    Header -> NonEmpty Stanza
hStanzas :: !(NonEmpty Stanza)
  , -- | Header MAC.
    --
    -- Note that the value of this field is /not/ guaranteed to be
    -- cryptographically verified. For example, if this value was constructed
    -- as the result of parsing an age file, that only means that the value was
    -- deemed to be /syntactically/ valid. It does not mean that it was
    -- verified to be /cryptographically/ valid.
    Header -> HeaderMac
hMac :: !HeaderMac
  } deriving stock (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show, Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
/= :: Header -> Header -> Bool
Eq)

headerVersionLine :: ByteString
headerVersionLine :: ByteString
headerVersionLine = ByteString
"age-encryption.org/v1\n"

-- | Encoder which can either encode a partial header (i.e. one with no MAC;
-- which is used for computing the MAC) or a full header (i.e. one with a MAC).
--
-- Note that this function is not intended to be exported.
headerBuilder' :: PartialHeader -> Maybe HeaderMac -> Builder
headerBuilder' :: PartialHeader -> Maybe HeaderMac -> Builder
headerBuilder' (PartialHeader NonEmpty Stanza
stanzas) Maybe HeaderMac
mbHeaderMac =
  ByteString -> Builder
Builder.byteString ByteString
headerVersionLine
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Stanza -> Builder) -> NonEmpty Stanza -> Builder
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Stanza -> Builder
stanzaBuilder NonEmpty Stanza
stanzas
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case Maybe HeaderMac
mbHeaderMac of
      Just HeaderMac
m -> HeaderMac -> Builder
headerMacBuilder HeaderMac
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
"\n"
      Maybe HeaderMac
Nothing -> ByteString -> Builder
Builder.byteString ByteString
headerMacMark

-- | 'Header' encoder.
headerBuilder :: Header -> Builder
headerBuilder :: Header -> Builder
headerBuilder h :: Header
h@Header{HeaderMac
hMac :: Header -> HeaderMac
hMac :: HeaderMac
hMac} =
  PartialHeader -> Maybe HeaderMac -> Builder
headerBuilder' (Header -> PartialHeader
toPartialHeader Header
h) (HeaderMac -> Maybe HeaderMac
forall a. a -> Maybe a
Just HeaderMac
hMac)

-- | 'Header' parser.
headerParser :: Parser Header
headerParser :: Parser Header
headerParser = do
  Parser ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ByteString ())
-> Parser ByteString -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
string ByteString
headerVersionLine
  [Stanza]
stanzas <- Parser Stanza -> Parser ByteString [Stanza]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Stanza
stanzaParser
  NonEmpty Stanza
nonEmptyStanzas <-
    case [Stanza] -> Maybe (NonEmpty Stanza)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Stanza]
stanzas of
      Maybe (NonEmpty Stanza)
Nothing -> String -> Parser ByteString (NonEmpty Stanza)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting one or more recipient stanzas"
      Just NonEmpty Stanza
x -> NonEmpty Stanza -> Parser ByteString (NonEmpty Stanza)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty Stanza
x
  HeaderMac
mac <- Parser HeaderMac
headerMacParser
  Parser ByteString Word8 -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ByteString ())
-> Parser ByteString Word8 -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Word8
char8 Char
'\n'
  Header -> Parser Header
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Header
    { hStanzas :: NonEmpty Stanza
hStanzas = NonEmpty Stanza
nonEmptyStanzas
    , hMac :: HeaderMac
hMac = HeaderMac
mac
    }