{-# LANGUAGE OverloadedStrings #-}

module Servant.Benchmark.BasicAuth where

import Data.ByteString.Base64 (encode)
import Data.ByteString.Char8 as BS8
import Network.HTTP.Types (Header, hAuthorization)
import Servant.API (BasicAuthData (..))
import Test.QuickCheck (Gen)
import Test.QuickCheck.Gen (generate)

{- | Given a function (a -> BasicAuthData), produce an authorization header from a
 random value of `a`
-}
encodeBasicAuth :: (a -> BasicAuthData) -> Gen a -> IO Header
encodeBasicAuth :: (a -> BasicAuthData) -> Gen a -> IO Header
encodeBasicAuth a -> BasicAuthData
f Gen a
gen = do
    BasicAuthData
basicAuthData <- a -> BasicAuthData
f (a -> BasicAuthData) -> IO a -> IO BasicAuthData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> IO a
forall a. Gen a -> IO a
generate Gen a
gen
    let bs64 :: ByteString
bs64 = String -> ByteString
BS8.pack String
"Basic " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
encode (BasicAuthData -> ByteString
basicAuthUsername BasicAuthData
basicAuthData ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS8.singleton Char
':' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> BasicAuthData -> ByteString
basicAuthPassword BasicAuthData
basicAuthData)
    Header -> IO Header
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeaderName
hAuthorization, ByteString
bs64)