{-# LANGUAGE CPP #-}

{- |
Module      : Data.ASN1.Internal
License     : BSD-style
Copyright   : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown
-}

module Data.ASN1.Internal
  ( uintOfBytes
  , intOfBytes
  , bytesOfUInt
  , bytesOfInt
  , putVarEncodingIntegral
  ) where

import           Data.Bits
                   ( Bits, (.&.), (.|.), complement, shiftL, shiftR, testBit )
import           Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import           Data.List.NonEmpty ( NonEmpty (..), (<|) )
import qualified Data.List.NonEmpty as NE
import           Data.Word ( Word8 )

-- | Helper function while base < 4.15.0.0 (GHC < 9.0.1) is supported.

singletonNE :: a -> NonEmpty a
#if MIN_VERSION_base(4,15,0)
singletonNE :: forall a. a -> NonEmpty a
singletonNE = a -> NonEmpty a
forall a. a -> NonEmpty a
NE.singleton
#else
singletonNE a = a :| []
#endif

-- | Returns the number of bytes and the unsigned integer represented by the

-- bytes.

uintOfBytes :: ByteString -> (Int, Integer)
uintOfBytes :: ByteString -> (Int, Integer)
uintOfBytes ByteString
b =
  (ByteString -> Int
B.length ByteString
b, (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl (\Integer
acc Word8
n -> (Integer
acc Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Integer
0 ByteString
b)

--bytesOfUInt i = B.unfoldr (\x -> if x == 0 then Nothing else Just (fromIntegral (x .&. 0xff), x `shiftR` 8)) i

bytesOfUInt :: Integer -> NonEmpty Word8
bytesOfUInt :: Integer -> NonEmpty Word8
bytesOfUInt Integer
x = NonEmpty Word8 -> NonEmpty Word8
forall a. NonEmpty a -> NonEmpty a
NE.reverse (Integer -> NonEmpty Word8
forall {t} {a}.
(Integral t, Num a, Bits a, Bits t) =>
t -> NonEmpty a
list Integer
x)
 where
  list :: t -> NonEmpty a
list t
i = if t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0xff
    then a -> NonEmpty a
forall a. a -> NonEmpty a
singletonNE (t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i)
    else (t -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
i a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xff) a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
<| t -> NonEmpty a
list (t
i t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

-- | Returns the number of bytes in the list and the represented integer by a

-- two's completement list of bytes.

intOfBytes :: ByteString -> (Int, Integer)
intOfBytes :: ByteString -> (Int, Integer)
intOfBytes ByteString
b
  | ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = (Int
0, Integer
0)
  | Bool
otherwise         = (Int
len, if Bool
isNeg then -(Integer
maxIntLen Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) else Integer
v)
 where
  (Int
len, Integer
v)  = ByteString -> (Int, Integer)
uintOfBytes ByteString
b
  maxIntLen :: Integer
maxIntLen = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
  isNeg :: Bool
isNeg     = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
b) Int
7

-- | Convert an integer into a two's completemented list of bytes.

bytesOfInt :: Integer -> NonEmpty Word8
bytesOfInt :: Integer -> NonEmpty Word8
bytesOfInt Integer
i
  | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0     = if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (NonEmpty Word8 -> Word8
forall a. NonEmpty a -> a
NE.head NonEmpty Word8
uints) Int
7 then Word8
0 Word8 -> NonEmpty Word8 -> NonEmpty Word8
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Word8
uints else NonEmpty Word8
uints
  | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0    = Word8 -> NonEmpty Word8
forall a. a -> NonEmpty a
singletonNE Word8
0
  | Bool
otherwise = if Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (NonEmpty Word8 -> Word8
forall a. NonEmpty a -> a
NE.head NonEmpty Word8
nints) Int
7 then NonEmpty Word8
nints else Word8
0xff Word8 -> NonEmpty Word8 -> NonEmpty Word8
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty Word8
nints
 where
  uints :: NonEmpty Word8
uints = Integer -> NonEmpty Word8
bytesOfUInt (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
  nints :: NonEmpty Word8
nints = NonEmpty Word8 -> NonEmpty Word8
forall a. NonEmpty a -> NonEmpty a
NE.reverse (NonEmpty Word8 -> NonEmpty Word8)
-> NonEmpty Word8 -> NonEmpty Word8
forall a b. (a -> b) -> a -> b
$ NonEmpty Word8 -> NonEmpty Word8
forall {a}. (Eq a, Num a) => NonEmpty a -> NonEmpty a
plusOne (NonEmpty Word8 -> NonEmpty Word8)
-> NonEmpty Word8 -> NonEmpty Word8
forall a b. (a -> b) -> a -> b
$ NonEmpty Word8 -> NonEmpty Word8
forall a. NonEmpty a -> NonEmpty a
NE.reverse (NonEmpty Word8 -> NonEmpty Word8)
-> NonEmpty Word8 -> NonEmpty Word8
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> NonEmpty Word8 -> NonEmpty Word8
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map Word8 -> Word8
forall a. Bits a => a -> a
complement NonEmpty Word8
uints
  plusOne :: NonEmpty a -> NonEmpty a
plusOne (a
0xff :| []) = a
0 a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a
1]
  plusOne (a
0xff :| (a
x : [a]
xs)) = a
0 a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
<| NonEmpty a -> NonEmpty a
plusOne (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
  plusOne (a
x :| [a]
xs) = (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs

{- ASN1 often uses a particular kind of 7-bit encoding of integers like
   in the case of long tags or encoding of integer component of OID's.
   Use this function for such an encoding. Assumes a positive integer.

   Here is the description of the algorithm of the above encoding:

   1. The integer is chunked up into 7-bit groups. Each of these 7bit
      chunks are encoded as a single octet.

   2. All the octets except the last one has its 8th bit set.
-}
putVarEncodingIntegral :: (Bits i, Integral i) => i -> ByteString
putVarEncodingIntegral :: forall i. (Bits i, Integral i) => i -> ByteString
putVarEncodingIntegral i
i = ByteString -> ByteString
B.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ((i, Bool) -> Maybe (Word8, (i, Bool))) -> (i, Bool) -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
B.unfoldr (i, Bool) -> Maybe (Word8, (i, Bool))
forall {a} {a}.
(Integral a, Bits a, Bits a, Num a) =>
(a, Bool) -> Maybe (a, (a, Bool))
genOctets (i
i, Bool
True)
 where
  genOctets :: (a, Bool) -> Maybe (a, (a, Bool))
genOctets (a
x, Bool
first)
    | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0     =
        let out :: a
out = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7F) a -> a -> a
forall a. Bits a => a -> a -> a
.|. (if Bool
first then a
0 else a
0x80)
        in  (a, (a, Bool)) -> Maybe (a, (a, Bool))
forall a. a -> Maybe a
Just (a
out, (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
x Int
7, Bool
False))
    | Bool
otherwise = Maybe (a, (a, Bool))
forall a. Maybe a
Nothing