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

    module Codec.Encryption.OpenPGP.Internal (
       countBits
     , beBSToInteger
     , integerToBEBS
     , PktStreamContext(..)
     , hashDescr
     , issuer
     , emptyPSC
     , pubkeyToMPIs
     , multiplicativeInverse
     , sigType
     , sigPKA
     , sigHA
    ) 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

    multiplicativeInverse :: Integral a => a -> a -> a
    multiplicativeInverse _ 1 = 1
    multiplicativeInverse q p = (n * q + 1) `div` p
        where n = p - multiplicativeInverse p (q `mod` p)

    sigType :: SignaturePayload -> Maybe SigType
    sigType (SigV3 st _ _ _ _ _ _) = Just st
    sigType (SigV4 st _ _ _ _ _ _) = Just st
    sigType _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild

    sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm
    sigPKA (SigV3 _ _ _ pka _ _ _) = Just pka
    sigPKA (SigV4 _ pka _ _ _ _ _) = Just pka
    sigPKA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild

    sigHA :: SignaturePayload -> Maybe HashAlgorithm
    sigHA (SigV3 _ _ _ _ ha _ _) = Just ha
    sigHA (SigV4 _ _ ha _ _ _ _) = Just ha
    sigHA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild