module Data.ASN1.Internal
( uintOfBytes
, intOfBytes
, bytesOfUInt
, bytesOfInt
, putVarEncodingIntegral
) where
import Data.Word
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
uintOfBytes :: ByteString -> (Int, Integer)
uintOfBytes b = (B.length b, B.foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 b)
bytesOfUInt :: Integer -> [Word8]
bytesOfUInt x = reverse (list x)
where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8)
intOfBytes :: ByteString -> (Int, Integer)
intOfBytes b
| B.length b == 0 = (0, 0)
| otherwise = (len, if isNeg then -(maxIntLen - v + 1) else v)
where
(len, v) = uintOfBytes b
maxIntLen = 2 ^ (8 * len) - 1
isNeg = testBit (B.head b) 7
bytesOfInt :: Integer -> [Word8]
bytesOfInt i
| i > 0 = if testBit (head uints) 7 then 0 : uints else uints
| i == 0 = [0]
| otherwise = if testBit (head nints) 7 then nints else 0xff : nints
where
uints = bytesOfUInt (abs i)
nints = reverse $ plusOne $ reverse $ map complement $ uints
plusOne [] = [1]
plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs
putVarEncodingIntegral :: (Bits i, Integral i) => i -> ByteString
putVarEncodingIntegral i = B.reverse $ B.unfoldr genOctets (i,True)
where genOctets (x,first)
| x > 0 =
let out = fromIntegral (x .&. 0x7F) .|. (if first then 0 else 0x80) in
Just (out, (shiftR x 7, False))
| otherwise = Nothing