-- Internal.hs: OpenPGP (RFC4880) private routines for conduit stuff
-- Copyright © 2012  Clint Adams
-- This software is released under the terms of the ISC license.
-- (See the LICENSE file).

module Data.Conduit.OpenPGP.Internal (
   PacketStreamContext(..)
 , payloadForSig
 , asn1Prefix
 , hash
 , issuer
) where

import qualified Crypto.Hash.MD5 as MD5
import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
import qualified Crypto.Hash.SHA1 as SHA1
import qualified Crypto.Hash.SHA224 as SHA224
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Crypto.Hash.SHA384 as SHA384
import qualified Crypto.Hash.SHA512 as SHA512

import qualified Data.ASN1.DER as DER
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.List (find)
import Data.Serialize.Put (runPut)

import Codec.Encryption.OpenPGP.SerializeForSigs (putKeyforSigning, putUforSigning)
import Codec.Encryption.OpenPGP.Types

data PacketStreamContext = PacketStreamContext { lastLD :: Packet
                               , lastUIDorUAt :: Packet
                               , lastSig :: Packet
                               , lastPrimaryKey :: Packet
                               , lastSubkey :: Packet
                               }

payloadForSig :: SigType -> PacketStreamContext -> ByteString
payloadForSig BinarySig state = (\(LiteralData _ _ _ bs) -> bs) (lastLD state)
payloadForSig CanonicalTextSig state = payloadForSig BinarySig state
payloadForSig StandaloneSig _ = B.empty
payloadForSig GenericCert state = kandUPayload (lastPrimaryKey state) (lastUIDorUAt state)
payloadForSig PersonaCert state = payloadForSig GenericCert state
payloadForSig CasualCert state = payloadForSig GenericCert state
payloadForSig PositiveCert state = payloadForSig GenericCert state
payloadForSig SubkeyBindingSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) -- FIXME: embedded primary key binding sig should be verified as well
payloadForSig PrimaryKeyBindingSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) 
payloadForSig SignatureDirectlyOnAKey state = runPut (putKeyforSigning (lastPrimaryKey state))
payloadForSig KeyRevocationSig state = payloadForSig SignatureDirectlyOnAKey state
payloadForSig SubkeyRevocationSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state)
payloadForSig CertRevocationSig state = kandUPayload (lastPrimaryKey state) (lastUIDorUAt state) -- FIXME: this doesn't handle revocation of direct key signatures
payloadForSig st _ = error ("I dunno how to " ++ show st)

kandUPayload :: Packet -> Packet -> ByteString
kandUPayload k u = runPut (sequence_ [putKeyforSigning k, putUforSigning u])

kandKPayload :: Packet -> Packet -> ByteString
kandKPayload k1 k2 = runPut (sequence_ [putKeyforSigning k1, putKeyforSigning k2])

issuer :: Packet -> Maybe EightOctetKeyId
issuer (Signature (SigV4 _ _ _ _ usubs _ _)) = fmap (\(Issuer _ i) -> i) (find isIssuer usubs)
    where
        isIssuer (Issuer _ _) = True
        isIssuer _ = False
issuer _ = Nothing

hash :: HashAlgorithm -> ByteString -> ByteString
hash SHA1 = SHA1.hash
hash RIPEMD160 = RIPEMD160.hash
hash SHA256 = SHA256.hash
hash SHA384 = SHA384.hash
hash SHA512 = SHA512.hash
hash SHA224 = SHA224.hash
hash DeprecatedMD5 = MD5.hash
hash _ = id -- FIXME

asn1Prefix :: HashAlgorithm -> ByteString
asn1Prefix ha = do
    let start = DER.Start DER.Sequence
    let (blen, oid) = (bitLength ha, hashOid ha)
    let numpty = DER.Null
    let end = DER.End DER.Sequence
    let fakeint = DER.OctetString (BL.pack (replicate ((blen `div` 8) - 1) 0 ++ [1]))
    case DER.encodeASN1Stream [start,start,oid,numpty,end,fakeint,end] of
        Left _ -> error "encodeASN1 failure"
        Right l -> B.concat . BL.toChunks $ getPrefix l
    where
        getPrefix = BL.reverse . BL.dropWhile (==0) . BL.drop 1 . BL.reverse
        bitLength DeprecatedMD5 = 128
        bitLength SHA1 = 160
        bitLength RIPEMD160 = 160
        bitLength SHA256 = 256
        bitLength SHA384 = 384
        bitLength SHA512 = 512
        bitLength SHA224 = 224
        bitLength _ = 0
        hashOid DeprecatedMD5 = DER.OID [1,2,840,113549,2,5]
        hashOid RIPEMD160 = DER.OID [1,3,36,3,2,1]
        hashOid SHA1 = DER.OID [1,3,14,3,2,26]
        hashOid SHA224 = DER.OID [2,16,840,1,101,3,4,2,4]
        hashOid SHA256 = DER.OID [2,16,840,1,101,3,4,2,1]
        hashOid SHA384 = DER.OID [2,16,840,1,101,3,4,2,2]
        hashOid SHA512 = DER.OID [2,16,840,1,101,3,4,2,3]
        hashOid _ = DER.OID []