-- 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 Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512, hashDescrRIPEMD160)
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 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 = hashDescrRIPEMD160
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) = [
                               pkParams DSA.params_p
                             , pkParams DSA.params_q
                             , pkParams DSA.params_g
                             , MPI . DSA.public_y $ k
			     ]
  where pkParams f = MPI . f . DSA.public_params $ k

pubkeyToMPIs (ElGamalPubKey k) = fmap MPI k