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

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

import Control.Applicative ((<$>),(<*>))
import Control.Monad (replicateM, mplus, when)
import qualified Crypto.Cipher.RSA as R
import qualified Crypto.Cipher.DSA as D
import Data.Bits ((.&.), (.|.), shiftL, shiftR)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8
import Data.List (mapAccumL)
import Data.Maybe (isJust, fromJust)
import Data.Serialize (Serialize, get, put)
import Data.Serialize.Get (Get, getWord8, getWord16be, getWord32be, getBytes, getByteString, getWord16le, runGet, remaining)
import Data.Serialize.Put (Put, putWord8, putWord16be, putWord32be, putByteString, putWord16le, runPut)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word (Word8, Word16)

import Codec.Encryption.OpenPGP.Internal (countBits, beBSToInteger, integerToBEBS)
import Codec.Encryption.OpenPGP.Serialize ()
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

putPartialSigforSigning :: Packet -> Put
putPartialSigforSigning (Signature (SigV4 st pka ha hashed unhashed left16 mpis)) = do
    putWord8 4
    put st
    put pka
    put ha
    let hb = runPut $ mapM_ put hashed
    putWord16be . fromIntegral . B.length $ hb
    putByteString hb

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

putUIDforSigning :: Packet -> Put
putUIDforSigning (UserId u) = do
    putWord8 0xB4
    let bs = BC8.pack u
    putWord32be . fromIntegral . B.length $ bs
    putByteString bs

putUAtforSigning :: Packet -> Put
putUAtforSigning (UserAttribute us) = do
    putWord8 0xD1
    let bs = B.empty -- FIXME: what gets hashed?
    putWord32be . fromIntegral . B.length $ bs
    putByteString bs

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

putKeyforSigning :: Packet -> Put
putKeyforSigning (PublicKey pkp) = putKeyForSigning' pkp Nothing
putKeyforSigning (PublicSubkey pkp) = putKeyForSigning' pkp Nothing
putKeyforSigning (SecretKey pkp ska) = putKeyForSigning' pkp (Just ska)
putKeyforSigning (SecretSubkey pkp ska) = putKeyForSigning' pkp (Just ska)

putKeyForSigning' :: PKPayload -> Maybe SKAddendum -> Put
putKeyForSigning' pkp mska = do
    putWord8 0x99
    let bs = runPut $ put pkp
    -- FIXME: add ska
    putWord32be . fromIntegral . B.length $ bs
    putByteString bs