{-# LANGUAGE OverloadedStrings #-}

module Network.QUIC.Utils where

import Control.Monad (replicateM)
import qualified Data.ByteString as BS
import Data.ByteString.Base16
import qualified Data.ByteString.Char8 as C8
import Data.ByteString.Internal (ByteString (..))
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as Short
import Data.Char (chr)
import Data.List (foldl')
import Data.Word
import Foreign.ForeignPtr (withForeignPtr)
import Foreign.Ptr (Ptr, plusPtr)
import System.Random (randomIO)
import UnliftIO.Exception

-- GHC 8.0 does not provide fromRight.
fromRight :: b -> Either a b -> b
fromRight :: forall b a. b -> Either a b -> b
fromRight b
_ (Right b
b) = b
b
fromRight b
b Either a b
_ = b
b

dec16 :: ByteString -> ByteString
dec16 :: ByteString -> ByteString
dec16 = forall b a. b -> Either a b -> b
fromRight ByteString
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decode

enc16 :: ByteString -> ByteString
enc16 :: ByteString -> ByteString
enc16 = ByteString -> ByteString
encode

dec16s :: ShortByteString -> ShortByteString
dec16s :: ShortByteString -> ShortByteString
dec16s = ByteString -> ShortByteString
Short.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> Either a b -> b
fromRight ByteString
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
Short.fromShort

enc16s :: ShortByteString -> ShortByteString
enc16s :: ShortByteString -> ShortByteString
enc16s = ByteString -> ShortByteString
Short.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
Short.fromShort

shortToString :: ShortByteString -> String
shortToString :: ShortByteString -> String
shortToString = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
Short.unpack

getRandomOneByte :: IO Word8
getRandomOneByte :: IO Word8
getRandomOneByte = forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO

getRandomBytes :: Int -> IO ShortByteString
getRandomBytes :: Int -> IO ShortByteString
getRandomBytes Int
n = [Word8] -> ShortByteString
Short.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n IO Word8
getRandomOneByte

{-# INLINE totalLen #-}
totalLen :: [ByteString] -> Int
totalLen :: [ByteString] -> Int
totalLen = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
n ByteString
bs -> Int
n forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
bs) Int
0

sum' :: (Functor f, Foldable f) => f Int -> Int
sum' :: forall (f :: * -> *). (Functor f, Foldable f) => f Int -> Int
sum' = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) Int
0

withByteString :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString :: forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString (PS ForeignPtr Word8
fptr Int
off Int
_) Ptr Word8 -> IO a
f = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
    Ptr Word8 -> IO a
f (Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)

shortpack :: String -> ShortByteString
shortpack :: String -> ShortByteString
shortpack = ByteString -> ShortByteString
Short.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
C8.pack

ignore :: SomeException -> IO ()
ignore :: SomeException -> IO ()
ignore SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()