{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
{-# LANGUAGE MagicHash    #-}
module Data.OpenPGP.Internal where

import Data.Bits
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy     as BL
import Data.Char
import Data.Int
import Data.Word
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC.Exts
import GHC.Integer.GMP.Internals
import System.Endian
import System.IO.Unsafe
import Numeric (showHex)

#if defined(VERSION_cryptonite)
import qualified Data.ByteArray as Bytes
import Crypto.Hash.Algorithms
import Crypto.Hash
import Crypto.Error
#else
import qualified Data.Byteable as Vincent
import Crypto.Hash.SHA1 as SHA1
#endif

#ifdef CEREAL
import qualified Data.ByteString      as B
import qualified Data.ByteString.UTF8 as B (fromString, toString)
import Data.Serialize
#define BINARY_CLASS Serialize
#else
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Lazy      as B
import qualified Data.ByteString.Lazy.UTF8 as B (fromString, toString)
#define BINARY_CLASS Binary
#endif



decode_s2k_count :: Word8 -> Word32
decode_s2k_count c = shiftL (16 + (fromIntegral c .&. 15))
                            ((fromIntegral c `shiftR` 4) + 6)

encode_s2k_count :: Word32 -> Word8
encode_s2k_count iterations
    | iterations >= 65011712 = 255
    | decode_s2k_count result < iterations = result+1
    | otherwise = result
    where
    result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
    (count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
    encode_s2k_count' count c
        | count < 32 = (count, c)
        | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)

{-
getBigNum :: BS.ByteString -> Integer
getBigNum bytes = unsafeDupablePerformIO $
    let (fptr,offset,len) = BS.toForeignPtr bytes
    in withForeignPtr fptr $ \ptr -> do
        let p = ptr `plusPtr` offset :: Ptr Word64
            e = p `plusPtr` (len .&. complement 7)
            e2 = e `plusPtr` (len .&. 7)
            go !p !a
                | p==e      = return a
                | otherwise = do
                    w64 <- fromBE64 <$> peek p
                    let a' = (a `shiftL` 64) + fromIntegral w64
                    go (p `plusPtr` 8) a'
            go2 !p !a
                | p==e2     = return a
                | otherwise = do
                    w8 <- peek p
                    let a' = a * 256 + fromIntegral w8
                    go2 (p `plusPtr` 1) a'
        a <- go p 0
        go2 (castPtr e :: Ptr Word8) a
-}
getBigNum :: BS.ByteString -> Integer
getBigNum bytes = unsafeDupablePerformIO $
    let (fptr,offset,len) = BS.toForeignPtr bytes
    in withForeignPtr fptr $ \ptr -> do
        let Ptr addr = ptr `plusPtr` offset :: Ptr Word64
            I# n = len
        importIntegerFromAddr addr (int2Word# n) 1#

putBigNum :: Integer -> (Word16, BS.ByteString)
putBigNum 0 = (1,BS.singleton 0)
putBigNum i = ( (fromIntegral (BS.length bytes) - 1) * 8 + sigBit
            , bytes )
 where
    sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0)
    bytes = integerToBS i

-- big-endian
integerToBS :: Integer -> BS.ByteString
integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
        let Ptr addr = ptr
        cnt <- exportIntegerToAddr i addr 1# -- 1# for big-endian (use 0# for little-endian)
        return ()

getBigNumLE :: BS.ByteString -> Integer
getBigNumLE bytes = unsafeDupablePerformIO $
    let (fptr,offset,len) = BS.toForeignPtr bytes
    in withForeignPtr fptr $ \ptr -> do
        let Ptr addr = ptr `plusPtr` offset :: Ptr Word64
            I# n = len
        importIntegerFromAddr addr (int2Word# n) 0#

-- little-endian
integerToLE :: Integer -> BS.ByteString
integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
        let Ptr addr = ptr
        cnt <- exportIntegerToAddr i addr 0#
        return ()

toStrictBS :: B.ByteString -> BS.ByteString
toStrictBS = BS.concat . B.toChunks

checksum :: B.ByteString -> Word16
checksum = fromIntegral .
        B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)


checksumForKey :: Word8 {- s2k_usage byte -} -> (Int64, B.ByteString -> BS.ByteString)
checksumForKey 254 = (20, sha1 . toStrictBS)
 where
#if defined(VERSION_cryptonite)
    sha1 x = Bytes.convert (hash x :: Digest SHA1)
#else
    sha1 = SHA1.hash
#endif
checksumForKey _   = (2, toStrictBS . encode . checksum)
                    -- Words16s are written as 2 bytes in big-endian (network) order

hexString :: [Word8] -> String
hexString = foldr (pad `oo` showHex) ""
        where
        pad s | odd $ length s = '0':s
              | otherwise = s

        oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
        oo = (.) . (.)

hexify :: BS.ByteString -> String
hexify = map toUpper . hexString . BS.unpack