{-# LANGUAGE OverloadedStrings #-}

{- |

Support for the [Siege](https://www.joedog.org/siege-home/) http load testing and benchmarking utility.
-}
module Servant.Benchmark.Tools.Siege (export, Settings (..)) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Types (parseMethod)
import Servant.API.Verbs
import Servant.Benchmark.Endpoint

-- | Siege settings.
newtype Settings = MkSettings
    {Settings -> Text
root :: T.Text}

serialize :: Settings -> Endpoint -> BS.ByteString
serialize :: Settings -> Endpoint -> ByteString
serialize (MkSettings Text
rootPath) Endpoint
endpoint =
    case Endpoint -> Maybe ByteString
method Endpoint
endpoint of
        Maybe ByteString
Nothing -> Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
rootPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Endpoint -> Text
path Endpoint
endpoint
        Just ByteString
actualMethod ->
            case ByteString -> Either ByteString StdMethod
parseMethod ByteString
actualMethod of
                Right StdMethod
GET -> Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
rootPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Endpoint -> Text
path Endpoint
endpoint
                Right StdMethod
POST -> Text -> ByteString
T.encodeUtf8 (Text
rootPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Endpoint -> Text
path Endpoint
endpoint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" POST ") ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Endpoint -> Maybe ByteString
body Endpoint
endpoint)
                Either ByteString StdMethod
_ -> ByteString
BS.empty

{- | Export a URL files path.
  Note that since Siege-@.06 and later, only the POST and GET directives are supported.
  All other methods will not produce a url in the URLs file.
-}
export :: FilePath -> Settings -> [Endpoint] -> IO ()
export :: FilePath -> Settings -> [Endpoint] -> IO ()
export FilePath
file Settings
settings [Endpoint]
endpoints = do
    let serialized :: ByteString
serialized = [ByteString] -> ByteString
BS8.unlines ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS8.null) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Endpoint -> ByteString) -> [Endpoint] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Settings -> Endpoint -> ByteString
serialize Settings
settings (Endpoint -> ByteString)
-> (Endpoint -> Endpoint) -> Endpoint -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endpoint -> Endpoint
pack) [Endpoint]
endpoints
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
file ByteString
serialized