-- Internal.hs: private utility functions
-- Copyright © 2012-2013  Clint Adams
-- This software is released under the terms of the ISC license.
-- (See the LICENSE file).

module Codec.Encryption.OpenPGP.Internal (
   countBits
 , beBSToInteger
 , integerToBEBS
 , PktStreamContext(..)
 , hashDescr
 , issuer
 , emptyPSC
 , pubkeyToMPIs
) where

import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.RSA as RSA

import Data.Bits (testBit, shiftL, shiftR, (.&.))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8
import Data.List (find, mapAccumR, unfoldr)
import Data.Word (Word8, Word16)

import Codec.Encryption.OpenPGP.Types

countBits :: ByteString -> Word16
countBits bs = fromIntegral (B.length bs * 8) - fromIntegral (go (B.head bs) 7)
    where
        go :: Word8 -> Int -> Word8
        go _ 0 = 7
        go n b = if testBit n b then 7 - fromIntegral b else go n (b-1)

beBSToInteger :: ByteString -> Integer
beBSToInteger = sum . snd . mapAccumR (\acc x -> (acc + 8, fromIntegral x `shiftL` acc)) 0 . B.unpack

integerToBEBS :: Integer -> ByteString
integerToBEBS = B.pack . reverse . unfoldr (\x -> if x == 0 then Nothing else Just ((fromIntegral x :: Word8) .&. 0xff, x `shiftR` 8))

data PktStreamContext = PktStreamContext { lastLD :: Pkt
                      , lastUIDorUAt :: Pkt
                      , lastSig :: Pkt
                      , lastPrimaryKey :: Pkt
                      , lastSubkey :: Pkt
                      }

emptyPSC :: PktStreamContext
emptyPSC = PktStreamContext (MarkerPkt B.empty) (MarkerPkt B.empty) (MarkerPkt B.empty) (MarkerPkt B.empty) (MarkerPkt B.empty)

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

hashDescr :: HashAlgorithm -> HashDescr
hashDescr SHA1 = hashDescrSHA1
hashDescr RIPEMD160 = HashDescr (RIPEMD160.hash) (B.append (BC8.pack "\x30\x21\x30\x09\x06\x05\x2b\x24\x03\x02\x01\x05\x00\x04\x14"))
hashDescr SHA256 = hashDescrSHA256
hashDescr SHA384 = hashDescrSHA384
hashDescr SHA512 = hashDescrSHA512
hashDescr SHA224 = hashDescrSHA224
hashDescr DeprecatedMD5 = hashDescrMD5
hashDescr _ = error "Hash problem" -- FIXME

pubkeyToMPIs :: PKey -> [MPI]
pubkeyToMPIs (RSAPubKey k) = [MPI (RSA.public_n k), MPI (RSA.public_e k)]
pubkeyToMPIs (DSAPubKey k) = (\(p,g,q) y -> [MPI p,MPI q,MPI g,MPI y]) (DSA.public_params k) (DSA.public_y k)
pubkeyToMPIs (ElGamalPubKey k) = fmap MPI k