{-# LANGUAGE BinaryLiterals #-}

module Network.QUIC.Types.Integer (
    encodeInt
  , encodeInt8
  , encodeInt'
  , encodeInt'2
  , encodeInt'4
  , decodeInt
  , decodeInt'
  ) where

import Data.ByteString.Internal (unsafeCreate)
import Foreign.Ptr
import Foreign.Storable
import System.IO.Unsafe (unsafeDupablePerformIO)

import Network.QUIC.Imports

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Network.QUIC.Utils

----------------------------------------------------------------

-- |
-- >>> enc16 $ encodeInt 151288809941952652
-- "c2197c5eff14e88c"
-- >>> enc16 $ encodeInt 494878333
-- "9d7f3e7d"
-- >>> enc16 $ encodeInt 15293
-- "7bbd"
-- >>> enc16 $ encodeInt 37
-- "25"
encodeInt :: Int64  -> ByteString
encodeInt :: Int64 -> ByteString
encodeInt Int64
i = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
n ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Int64 -> Ptr Word8 -> IO ()
go Word8
tag Int
n Int64
i'
  where
    (Word8
tag,Int
n,Int64
i') = Int64 -> (Word8, Int, Int64)
tagLen Int64
i
{-# NOINLINE encodeInt #-}

encodeInt8 :: Int64  -> ByteString
encodeInt8 :: Int64 -> ByteString
encodeInt8 Int64
i = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
n ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Int64 -> Ptr Word8 -> IO ()
go Word8
tag Int
n Int64
i
  where
    n :: Int
n = Int
8
    tag :: Word8
tag = Word8
0b11000000
{-# NOINLINE encodeInt8 #-}

encodeInt' :: WriteBuffer -> Int64 -> IO ()
encodeInt' :: WriteBuffer -> Int64 -> IO ()
encodeInt' WriteBuffer
wbuf Int64
i = Word8 -> Int -> Int64 -> WriteBuffer -> IO ()
go' Word8
tag Int
n Int64
i' WriteBuffer
wbuf
  where
    (Word8
tag,Int
n,Int64
i') = Int64 -> (Word8, Int, Int64)
tagLen Int64
i

encodeInt'2 :: WriteBuffer -> Int64 -> IO ()
encodeInt'2 :: WriteBuffer -> Int64 -> IO ()
encodeInt'2 WriteBuffer
wbuf Int64
i = Word8 -> Int -> Int64 -> WriteBuffer -> IO ()
go' Word8
tag Int
n Int64
i' WriteBuffer
wbuf
  where
    tag :: Word8
tag = Word8
0b01000000
    n :: Int
n = Int
2
    i' :: Int64
i' = Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
48

encodeInt'4 :: WriteBuffer -> Int64 -> IO ()
encodeInt'4 :: WriteBuffer -> Int64 -> IO ()
encodeInt'4 WriteBuffer
wbuf Int64
i = Word8 -> Int -> Int64 -> WriteBuffer -> IO ()
go' Word8
tag Int
n Int64
i' WriteBuffer
wbuf
  where
    tag :: Word8
tag = Word8
0b10000000
    n :: Int
n = Int
4
    i' :: Int64
i' = Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
32

tagLen :: Int64 -> (Word8, Int, Int64)
tagLen :: Int64 -> (Word8, Int, Int64)
tagLen Int64
i | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<=         Int64
63 = (Word8
0b00000000, Int
1, Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
56)
         | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<=      Int64
16383 = (Word8
0b01000000, Int
2, Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
48)
         | Int64
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
1073741823 = (Word8
0b10000000, Int
4, Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
32)
         | Bool
otherwise       = (Word8
0b11000000, Int
8, Int64
i)
{-# INLINE tagLen #-}

msb8 :: Int64 -> Word8
msb8 :: Int64 -> Word8
msb8 Int64
i = Int64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.>>. Int
56)
{-# INLINE msb8 #-}

go :: Word8 -> Int -> Int64 -> Ptr Word8 -> IO ()
go :: Word8 -> Int -> Int64 -> Ptr Word8 -> IO ()
go Word8
tag Int
n0 Int64
i0 Ptr Word8
p0 = do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p0 (Word8
tag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int64 -> Word8
msb8 Int64
i0)
    let n' :: Int
n' = Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        i' :: Int64
i' = Int64
i0 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
8
        p' :: Ptr b
p' = Ptr Word8
p0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
    Int -> Int64 -> Ptr Word8 -> IO ()
forall t. (Eq t, Num t) => t -> Int64 -> Ptr Word8 -> IO ()
loop Int
n' Int64
i' Ptr Word8
forall b. Ptr b
p'
  where
    loop :: t -> Int64 -> Ptr Word8 -> IO ()
loop t
0 Int64
_ Ptr Word8
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop t
n Int64
i Ptr Word8
p = do
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
msb8 Int64
i
        let n' :: t
n' = t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1
            i' :: Int64
i' = Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
8
            p' :: Ptr b
p' = Ptr Word8
p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
        t -> Int64 -> Ptr Word8 -> IO ()
loop t
n' Int64
i' Ptr Word8
forall b. Ptr b
p'
{-# INLINE go #-}

go' :: Word8 -> Int -> Int64 -> WriteBuffer -> IO ()
go' :: Word8 -> Int -> Int64 -> WriteBuffer -> IO ()
go' Word8
tag Int
n0 Int64
i0 WriteBuffer
wbuf = do
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf (Word8
tag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int64 -> Word8
msb8 Int64
i0)
    let n' :: Int
n' = Int
n0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        i' :: Int64
i' = Int64
i0 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
8
    Int -> Int64 -> IO ()
forall t. (Eq t, Num t) => t -> Int64 -> IO ()
loop Int
n' Int64
i'
  where
    loop :: t -> Int64 -> IO ()
loop t
0 Int64
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop t
n Int64
i = do
        WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8
msb8 Int64
i
        let n' :: t
n' = t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1
            i' :: Int64
i' = Int64
i Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
.<<. Int
8
        t -> Int64 -> IO ()
loop t
n' Int64
i'
{-# INLINE go' #-}

----------------------------------------------------------------

-- |
-- >>> decodeInt (dec16 "c2197c5eff14e88c")
-- 151288809941952652
-- >>> decodeInt (dec16 "9d7f3e7d")
-- 494878333
-- >>> decodeInt (dec16 "7bbd")
-- 15293
-- >>> decodeInt (dec16 "25")
-- 37
decodeInt :: ByteString -> Int64
decodeInt :: ByteString -> Int64
decodeInt ByteString
bs = IO Int64 -> Int64
forall a. IO a -> a
unsafeDupablePerformIO (IO Int64 -> Int64) -> IO Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> (ReadBuffer -> IO Int64) -> IO Int64
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
bs ReadBuffer -> IO Int64
decodeInt'
{-# NOINLINE decodeInt #-}

decodeInt' :: ReadBuffer -> IO Int64
decodeInt' :: ReadBuffer -> IO Int64
decodeInt' ReadBuffer
rbuf = do
    Word8
b0 <- ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
    let flag :: Word8
flag = Word8
b0 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
.>>. Int
6
        b1 :: Int64
b1 = Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
b0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b00111111)
    case Word8
flag of
      Word8
0 -> Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
b1
      Word8
1 -> Int64 -> Int -> IO Int64
loop Int64
b1 Int
1
      Word8
2 -> Int64 -> Int -> IO Int64
loop Int64
b1 Int
3
      Word8
_ -> Int64 -> Int -> IO Int64
loop Int64
b1 Int
7
  where
    loop :: Int64 -> Int -> IO Int64
    loop :: Int64 -> Int -> IO Int64
loop Int64
r Int
0 = Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
r
    loop Int64
r Int
n = do
        Int64
b <- Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int64) -> IO Word8 -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Word8
forall a. Readable a => a -> IO Word8
read8 ReadBuffer
rbuf
        Int64 -> Int -> IO Int64
loop (Int64
rInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
256 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
b) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)