-- 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 -> ByteString -> ByteString
mdcTrailerForSEIPDv1 IV
iv ByteString
plaintext = ByteString
mdcHeader ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
digest
  where
    mdcHeader :: ByteString
mdcHeader = [Word8] -> ByteString
B.pack [Word8
0xd3, Word8
0x14]
    nonce :: ByteString
nonce = IV -> ByteString
seipdv1NonceFromIV IV
iv
    digest :: ByteString
digest =
        Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
            (ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash (ByteString
nonce ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
plaintext ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
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 -> ByteString
seipdv1NonceFromIV (IV ByteString
ivBytes) = ByteString
ivBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
ivBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) ByteString
ivBytes

calculateMDC
    :: B.ByteString -> B.ByteString -> Maybe BL.ByteString
calculateMDC :: ByteString -> ByteString -> Maybe ByteString
calculateMDC ByteString
nonce ByteString
garbage
    | ByteString -> Int
B.length ByteString
garbage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
23 = Maybe ByteString
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let digest :: Digest SHA1
digest =
                ByteString -> Digest SHA1
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash
                    ( ByteString
nonce
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
garbage Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
22) ByteString
garbage
                        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
B.pack [Word8
211, Word8
20]
                    )
                    :: CH.Digest CHA.SHA1
         in ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> ByteString
BL.fromStrict (Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Digest SHA1
digest :: B.ByteString))

data MDCFailure
    = MDCTrailerMissing
    | MDCTrailerCorrupted
    | MDCDigestMismatch
    deriving (MDCFailure -> MDCFailure -> Bool
(MDCFailure -> MDCFailure -> Bool)
-> (MDCFailure -> MDCFailure -> Bool) -> Eq MDCFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MDCFailure -> MDCFailure -> Bool
== :: MDCFailure -> MDCFailure -> Bool
$c/= :: MDCFailure -> MDCFailure -> Bool
/= :: MDCFailure -> MDCFailure -> Bool
Eq, Int -> MDCFailure -> ShowS
[MDCFailure] -> ShowS
MDCFailure -> String
(Int -> MDCFailure -> ShowS)
-> (MDCFailure -> String)
-> ([MDCFailure] -> ShowS)
-> Show MDCFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MDCFailure -> ShowS
showsPrec :: Int -> MDCFailure -> ShowS
$cshow :: MDCFailure -> String
show :: MDCFailure -> String
$cshowList :: [MDCFailure] -> ShowS
showList :: [MDCFailure] -> ShowS
Show)

renderMDCFailure :: MDCFailure -> String
renderMDCFailure :: MDCFailure -> String
renderMDCFailure MDCFailure
MDCTrailerMissing = String
"MDC trailer missing"
renderMDCFailure MDCFailure
MDCTrailerCorrupted = String
"MDC trailer corrupted"
renderMDCFailure MDCFailure
MDCDigestMismatch = String
"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 :: ByteString -> ByteString -> Either MDCFailure ByteString
validateSEIPD1MDC ByteString
nonce ByteString
decrypted = do
    Bool -> Either MDCFailure () -> Either MDCFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
decrypted Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
22) (Either MDCFailure () -> Either MDCFailure ())
-> Either MDCFailure () -> Either MDCFailure ()
forall a b. (a -> b) -> a -> b
$
        MDCFailure -> Either MDCFailure ()
forall a b. a -> Either a b
Left MDCFailure
MDCTrailerMissing
    let (ByteString
payload, ByteString
trailer) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
decrypted Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
22) ByteString
decrypted
    Bool -> Either MDCFailure () -> Either MDCFailure ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> ByteString -> ByteString
B.take Int
2 ByteString
trailer ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> ByteString
B.pack [Word8
211, Word8
20]) (Either MDCFailure () -> Either MDCFailure ())
-> Either MDCFailure () -> Either MDCFailure ()
forall a b. (a -> b) -> a -> b
$
        MDCFailure -> Either MDCFailure ()
forall a b. a -> Either a b
Left MDCFailure
MDCTrailerCorrupted
    expectedMdc <-
        MDCFailure -> Maybe ByteString -> Either MDCFailure ByteString
forall a b. a -> Maybe b -> Either a b
note MDCFailure
MDCTrailerMissing (ByteString -> ByteString -> Maybe ByteString
calculateMDC ByteString
nonce ByteString
decrypted)
    let actualMdc = ByteString -> ByteString
BL.fromStrict (Int -> ByteString -> ByteString
B.drop Int
2 ByteString
trailer)
    when (expectedMdc /= actualMdc) $
        Left MDCDigestMismatch
    Right payload