SEIPDv1.hs

-- SEIPDv1.hs: OpenPGP (RFC9580) legacy MDC/SEIPDv1
-- Copyright © 2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}

module Codec.Encryption.OpenPGP.SEIPDv1
    ( MDCFailure (..)
    , mdcTrailerForSEIPDv1
    , renderMDCFailure
    , seipdv1NonceFromIV
    , validateSEIPD1MDC
    , calculateMDC
    ) where

import Control.Error.Util (note)
import Control.Monad (when)
import qualified Crypto.Hash as CH
import qualified Crypto.Hash.Algorithms as CHA
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL

import Codec.Encryption.OpenPGP.Types

{- | Compute the MDC trailer appended to SEIPDv1 plaintext before encryption.
The trailer is: @0xd3 0x14 SHA1(nonce || plaintext || 0xd3 0x14)@.
-}
mdcTrailerForSEIPDv1 :: IV -> B.ByteString -> B.ByteString
mdcTrailerForSEIPDv1 iv plaintext = mdcHeader <> digest
  where
    mdcHeader = B.pack [0xd3, 0x14]
    nonce = seipdv1NonceFromIV iv
    digest =
        BA.convert
            (CH.hash (nonce <> plaintext <> mdcHeader) :: CH.Digest CHA.SHA1)

-- | The SEIPDv1 nonce: the IV bytes followed by its last two bytes (resync prefix).
seipdv1NonceFromIV :: IV -> B.ByteString
seipdv1NonceFromIV (IV ivBytes) = ivBytes <> B.drop (B.length ivBytes - 2) ivBytes

calculateMDC
    :: B.ByteString -> B.ByteString -> Maybe BL.ByteString
calculateMDC nonce garbage
    | B.length garbage < 23 = Nothing
    | otherwise =
        let digest =
                CH.hash
                    ( nonce
                        <> B.take (B.length garbage - 22) garbage
                        <> B.pack [211, 20]
                    )
                    :: CH.Digest CHA.SHA1
         in Just (BL.fromStrict (BA.convert digest :: B.ByteString))

data MDCFailure
    = MDCTrailerMissing
    | MDCTrailerCorrupted
    | MDCDigestMismatch
    deriving (Eq, Show)

renderMDCFailure :: MDCFailure -> String
renderMDCFailure MDCTrailerMissing = "MDC trailer missing"
renderMDCFailure MDCTrailerCorrupted = "MDC trailer corrupted"
renderMDCFailure MDCDigestMismatch = "MDC digest mismatch"

{- | Verify the MDC trailer of a decrypted SEIPDv1 payload.
Takes the CFB nonce (blockSize+2 prefix bytes retained from decryption)
and the full decrypted bytes (payload + MDC packet), and returns the
payload without the MDC trailer on success.
-}
validateSEIPD1MDC
    :: B.ByteString -> B.ByteString -> Either MDCFailure B.ByteString
validateSEIPD1MDC nonce decrypted = do
    when (B.length decrypted < 22) $
        Left MDCTrailerMissing
    let (payload, trailer) = B.splitAt (B.length decrypted - 22) decrypted
    when (B.take 2 trailer /= B.pack [211, 20]) $
        Left MDCTrailerCorrupted
    expectedMdc <-
        note MDCTrailerMissing (calculateMDC nonce decrypted)
    let actualMdc = BL.fromStrict (B.drop 2 trailer)
    when (expectedMdc /= actualMdc) $
        Left MDCDigestMismatch
    Right payload