-- SerializeForSigs.hs: OpenPGP (RFC4880) special serialization for signature purposes
-- Copyright © 2012  Clint Adams
-- This software is released under the terms of the ISC license.
-- (See the LICENSE file).

module Codec.Encryption.OpenPGP.SerializeForSigs (
   putPKPforFingerprinting
 , putPartialSigforSigning
 , putSigTrailer
 , putUforSigning
 , putUIDforSigning
 , putUAtforSigning
 , putKeyforSigning
 , putSigforSigning
-- , putSigforSigning
) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8
import Data.Serialize (Serialize, put)
import Data.Serialize.Put (Put, putWord8, putWord16be, putWord32be, putByteString, runPut)

import Codec.Encryption.OpenPGP.Serialize (putSKAddendum)
import Codec.Encryption.OpenPGP.Types

putPKPforFingerprinting :: Packet -> Put -- FIXME
putPKPforFingerprinting (PublicKey pkp) = do
    putWord8 0x99
    let bs = runPut $ put pkp
    putWord16be . fromIntegral $ B.length bs
    putByteString bs
putPKPforFingerprinting _ = fail "This should never happen"

putPartialSigforSigning :: Packet -> Put
putPartialSigforSigning (Signature (SigV4 st pka ha hashed _ _ _)) = do
    putWord8 4
    put st
    put pka
    put ha
    let hb = runPut $ mapM_ put hashed
    putWord16be . fromIntegral . B.length $ hb
    putByteString hb
putPartialSigforSigning _ = fail "This should never happen"

putSigTrailer :: Packet -> Put
putSigTrailer (Signature (SigV4 _ _ _ hs _ _ _)) = do
            putWord8 0x04
            putWord8 0xff
            putWord32be . fromIntegral . (+6) . B.length $ runPut $ mapM_ put hs
            -- this +6 seems like a bug in RFC4880
putSigTrailer _ = fail "This should never happen"

putUforSigning :: Packet -> Put
putUforSigning u@(UserId _) = putUIDforSigning u
putUforSigning u@(UserAttribute _) = putUAtforSigning u
putUforSigning _ = fail "This should never happen"

putUIDforSigning :: Packet -> Put
putUIDforSigning (UserId u) = do
    putWord8 0xB4
    let bs = BC8.pack u
    putWord32be . fromIntegral . B.length $ bs
    putByteString bs
putUIDforSigning _ = fail "This should never happen"

putUAtforSigning :: Packet -> Put
putUAtforSigning (UserAttribute us) = do
    putWord8 0xD1
    let bs = runPut (mapM_ put us)
    putWord32be . fromIntegral . B.length $ bs
    putByteString bs
putUAtforSigning _ = fail "This should never happen"

putSigforSigning :: Packet -> Put
putSigforSigning (Signature (SigV4 st pka ha hashed _ left16 mpis)) = do
    putWord8 0x88
    let bs = runPut $ put (SigV4 st pka ha hashed [] left16 mpis)
    putWord32be . fromIntegral . B.length $ bs
    putByteString bs
putSigforSigning _ = fail "Non-V4 not implemented."

putKeyforSigning :: Packet -> Put
putKeyforSigning (PublicKey pkp) = putKeyForSigning' pkp
putKeyforSigning (PublicSubkey pkp) = putKeyForSigning' pkp
putKeyforSigning (SecretKey pkp _) = putKeyForSigning' pkp
putKeyforSigning (SecretSubkey pkp _) = putKeyForSigning' pkp
putKeyforSigning _ = fail "This should never happen"

putKeyForSigning' :: PKPayload -> Put
putKeyForSigning' pkp = do
    putWord8 0x99
    let bs = runPut $ put pkp
    putWord16be . fromIntegral . B.length $ bs
    putByteString bs