-- ------------------------------------------------------ --
-- Copyright © 2014 AlephCloud Systems, Inc.
-- ------------------------------------------------------ --

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}

{-# OPTIONS_HADDOCK show-extensions #-}

module Configuration.Utils.Http
(
-- * HTTP Service TLS Configuration
  HttpServiceTLSConfiguration
, hstcCertFile
, hstcKeyFile
, defaultHttpServiceTLSConfiguration
, pHttpServiceTLSConfiguration
, validateHttpServiceTLSConfiguration

-- * HTTP Service Configuration
, HttpServiceConfiguration
, hscHost
, hscPort
, hscUseTLS
, defaultHttpServiceConfiguration
, pHttpServiceConfiguration
, validateHttpServiceConfiguration

-- * Http Client Configuration
, HttpClientConfiguration
, hccHost
, hccPort
, hccUseTLS
, defaultHttpClientConfiguration
, pHttpClientConfiguration
, validateHttpClientConfiguration
, httpService2clientConfiguration
) where

import Configuration.Utils
import Configuration.Utils.Internal
import Configuration.Utils.Validation

import Control.Monad (when)
import Control.Monad.Writer.Class (tell)

import qualified Data.ByteString.Char8 as B8
import qualified Data.DList as DL
import Data.Maybe (isJust)
import Data.Monoid.Unicode

import Prelude.Unicode hiding ((×))

-- -------------------------------------------------------------------------- --
-- Http Service TLS Configuration

-- | In order to make TLS optional this type should be used
-- wrapped into a Maybe.
--
data HttpServiceTLSConfiguration = HttpServiceTLSConfiguration
    { HttpServiceTLSConfiguration -> String
_hstcCertFile ∷ !FilePath
    , HttpServiceTLSConfiguration -> String
_hstcKeyFile ∷ !FilePath
    }
    deriving (Int -> HttpServiceTLSConfiguration -> ShowS
[HttpServiceTLSConfiguration] -> ShowS
HttpServiceTLSConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpServiceTLSConfiguration] -> ShowS
$cshowList :: [HttpServiceTLSConfiguration] -> ShowS
show :: HttpServiceTLSConfiguration -> String
$cshow :: HttpServiceTLSConfiguration -> String
showsPrec :: Int -> HttpServiceTLSConfiguration -> ShowS
$cshowsPrec :: Int -> HttpServiceTLSConfiguration -> ShowS
Show, ReadPrec [HttpServiceTLSConfiguration]
ReadPrec HttpServiceTLSConfiguration
Int -> ReadS HttpServiceTLSConfiguration
ReadS [HttpServiceTLSConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HttpServiceTLSConfiguration]
$creadListPrec :: ReadPrec [HttpServiceTLSConfiguration]
readPrec :: ReadPrec HttpServiceTLSConfiguration
$creadPrec :: ReadPrec HttpServiceTLSConfiguration
readList :: ReadS [HttpServiceTLSConfiguration]
$creadList :: ReadS [HttpServiceTLSConfiguration]
readsPrec :: Int -> ReadS HttpServiceTLSConfiguration
$creadsPrec :: Int -> ReadS HttpServiceTLSConfiguration
Read, HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
$c/= :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
== :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
$c== :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
Eq, Eq HttpServiceTLSConfiguration
HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> Ordering
HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration
$cmin :: HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration
max :: HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration
$cmax :: HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration
>= :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
$c>= :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
> :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
$c> :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
<= :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
$c<= :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
< :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
$c< :: HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration -> Bool
compare :: HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> Ordering
$ccompare :: HttpServiceTLSConfiguration
-> HttpServiceTLSConfiguration -> Ordering
Ord)

hstcCertFile ∷ Lens' HttpServiceTLSConfiguration FilePath
hstcCertFile :: Lens' HttpServiceTLSConfiguration String
hstcCertFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpServiceTLSConfiguration -> String
_hstcCertFile forall a b. (a -> b) -> a -> b
$ \HttpServiceTLSConfiguration
s String
a → HttpServiceTLSConfiguration
s { _hstcCertFile :: String
_hstcCertFile = String
a}

hstcKeyFile ∷ Lens' HttpServiceTLSConfiguration FilePath
hstcKeyFile :: Lens' HttpServiceTLSConfiguration String
hstcKeyFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpServiceTLSConfiguration -> String
_hstcKeyFile forall a b. (a -> b) -> a -> b
$ \HttpServiceTLSConfiguration
s String
a → HttpServiceTLSConfiguration
s { _hstcKeyFile :: String
_hstcKeyFile = String
a}

defaultHttpServiceTLSConfiguration ∷ HttpServiceTLSConfiguration
defaultHttpServiceTLSConfiguration :: HttpServiceTLSConfiguration
defaultHttpServiceTLSConfiguration = HttpServiceTLSConfiguration
    { _hstcCertFile :: String
_hstcCertFile = String
"cert.pem"
    , _hstcKeyFile :: String
_hstcKeyFile = String
"key.pem"
    }

validateHttpServiceTLSConfiguration
    ∷ ConfigValidation HttpServiceTLSConfiguration f
validateHttpServiceTLSConfiguration :: forall (f :: * -> *).
ConfigValidation HttpServiceTLSConfiguration f
validateHttpServiceTLSConfiguration HttpServiceTLSConfiguration
conf = do
    forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileReadable Text
"cert-file" forall a b. (a -> b) -> a -> b
$ HttpServiceTLSConfiguration -> String
_hstcCertFile HttpServiceTLSConfiguration
conf
    forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Text -> String -> m ()
validateFileReadable Text
"key-file" forall a b. (a -> b) -> a -> b
$ HttpServiceTLSConfiguration -> String
_hstcKeyFile HttpServiceTLSConfiguration
conf

instance FromJSON (HttpServiceTLSConfiguration → HttpServiceTLSConfiguration) where
    parseJSON :: Value
-> Parser
     (HttpServiceTLSConfiguration -> HttpServiceTLSConfiguration)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HttpServiceTLSConfiguration" forall a b. (a -> b) -> a -> b
$ \Object
o → forall a. a -> a
id
        forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' HttpServiceTLSConfiguration String
hstcCertFile forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"cert-file" forall a b. (a -> b) -> a -> b
% Object
o
        forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceTLSConfiguration String
hstcKeyFile forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"pem-file" forall a b. (a -> b) -> a -> b
% Object
o

-- | This is used as default when wrapped into Maybe and
--
-- 1. the parsed value is not 'Null' and
-- 2. the given default is not 'Nothing'.
--
instance FromJSON HttpServiceTLSConfiguration where
    parseJSON :: Value -> Parser HttpServiceTLSConfiguration
parseJSON Value
v = forall a. FromJSON a => Value -> Parser a
parseJSON Value
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure HttpServiceTLSConfiguration
defaultHttpServiceTLSConfiguration

instance ToJSON HttpServiceTLSConfiguration where
    toJSON :: HttpServiceTLSConfiguration -> Value
toJSON HttpServiceTLSConfiguration{String
_hstcKeyFile :: String
_hstcCertFile :: String
_hstcKeyFile :: HttpServiceTLSConfiguration -> String
_hstcCertFile :: HttpServiceTLSConfiguration -> String
..} = [Pair] -> Value
object
        [ Key
"cert-file" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
_hstcCertFile
        , Key
"key-file" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
_hstcKeyFile
        ]

-- | This option parser does not allow to enable or disable
-- usage of TLS. The option will have effect only when TLS
-- usage is configured in the configuration file or the default
-- configuration.
--
-- FIXME: print a warning and exit when one of these options is
-- provided even though TLS is turned off.
--
pHttpServiceTLSConfiguration ∷ String → MParser HttpServiceTLSConfiguration
pHttpServiceTLSConfiguration :: String -> MParser HttpServiceTLSConfiguration
pHttpServiceTLSConfiguration String
prefix = forall a. a -> a
id
    forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' HttpServiceTLSConfiguration String
hstcCertFile forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
prefix forall α. Monoid α => α -> α -> α
⊕ String
"cert-file")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help String
"File with PEM encoded TLS Certificate"
    forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceTLSConfiguration String
hstcKeyFile forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
prefix forall α. Monoid α => α -> α -> α
⊕ String
"key-file")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help String
"File with PEM encoded TLS key"

-- -------------------------------------------------------------------------- --
-- Http Service Configuration

-- | We restrict services to use either HTTP or HTTPS but not both.
--
-- TLS can be turned off explicitely in the configuration file by
-- setting the respective section to @null@. It can not be
-- turned on or off via command line options. But once it is turned
-- on the values for the certificate and key file can be changed
-- by command line options.
--
data HttpServiceConfiguration = HttpServiceConfiguration
    { HttpServiceConfiguration -> ByteString
_hscHost ∷ !B8.ByteString
    , HttpServiceConfiguration -> Int
_hscPort ∷ !Int
    , HttpServiceConfiguration -> ByteString
_hscInterface ∷ !B8.ByteString
    , HttpServiceConfiguration -> Maybe HttpServiceTLSConfiguration
_hscUseTLS ∷ !(Maybe HttpServiceTLSConfiguration)
    }
    deriving (Int -> HttpServiceConfiguration -> ShowS
[HttpServiceConfiguration] -> ShowS
HttpServiceConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpServiceConfiguration] -> ShowS
$cshowList :: [HttpServiceConfiguration] -> ShowS
show :: HttpServiceConfiguration -> String
$cshow :: HttpServiceConfiguration -> String
showsPrec :: Int -> HttpServiceConfiguration -> ShowS
$cshowsPrec :: Int -> HttpServiceConfiguration -> ShowS
Show, ReadPrec [HttpServiceConfiguration]
ReadPrec HttpServiceConfiguration
Int -> ReadS HttpServiceConfiguration
ReadS [HttpServiceConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HttpServiceConfiguration]
$creadListPrec :: ReadPrec [HttpServiceConfiguration]
readPrec :: ReadPrec HttpServiceConfiguration
$creadPrec :: ReadPrec HttpServiceConfiguration
readList :: ReadS [HttpServiceConfiguration]
$creadList :: ReadS [HttpServiceConfiguration]
readsPrec :: Int -> ReadS HttpServiceConfiguration
$creadsPrec :: Int -> ReadS HttpServiceConfiguration
Read, HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
$c/= :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
== :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
$c== :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
Eq, Eq HttpServiceConfiguration
HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
HttpServiceConfiguration -> HttpServiceConfiguration -> Ordering
HttpServiceConfiguration
-> HttpServiceConfiguration -> HttpServiceConfiguration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HttpServiceConfiguration
-> HttpServiceConfiguration -> HttpServiceConfiguration
$cmin :: HttpServiceConfiguration
-> HttpServiceConfiguration -> HttpServiceConfiguration
max :: HttpServiceConfiguration
-> HttpServiceConfiguration -> HttpServiceConfiguration
$cmax :: HttpServiceConfiguration
-> HttpServiceConfiguration -> HttpServiceConfiguration
>= :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
$c>= :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
> :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
$c> :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
<= :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
$c<= :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
< :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
$c< :: HttpServiceConfiguration -> HttpServiceConfiguration -> Bool
compare :: HttpServiceConfiguration -> HttpServiceConfiguration -> Ordering
$ccompare :: HttpServiceConfiguration -> HttpServiceConfiguration -> Ordering
Ord)

hscHost ∷ Lens' HttpServiceConfiguration B8.ByteString
hscHost :: Lens' HttpServiceConfiguration ByteString
hscHost = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpServiceConfiguration -> ByteString
_hscHost forall a b. (a -> b) -> a -> b
$ \HttpServiceConfiguration
s ByteString
a → HttpServiceConfiguration
s { _hscHost :: ByteString
_hscHost = ByteString
a}

hscPort ∷ Lens' HttpServiceConfiguration Int
hscPort :: Lens' HttpServiceConfiguration Int
hscPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpServiceConfiguration -> Int
_hscPort forall a b. (a -> b) -> a -> b
$ \HttpServiceConfiguration
s Int
a → HttpServiceConfiguration
s { _hscPort :: Int
_hscPort = Int
a}

hscInterface ∷ Lens' HttpServiceConfiguration B8.ByteString
hscInterface :: Lens' HttpServiceConfiguration ByteString
hscInterface = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpServiceConfiguration -> ByteString
_hscInterface forall a b. (a -> b) -> a -> b
$ \HttpServiceConfiguration
s ByteString
a → HttpServiceConfiguration
s { _hscInterface :: ByteString
_hscInterface = ByteString
a}

hscUseTLS ∷ Lens' HttpServiceConfiguration (Maybe HttpServiceTLSConfiguration)
hscUseTLS :: Lens' HttpServiceConfiguration (Maybe HttpServiceTLSConfiguration)
hscUseTLS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpServiceConfiguration -> Maybe HttpServiceTLSConfiguration
_hscUseTLS forall a b. (a -> b) -> a -> b
$ \HttpServiceConfiguration
s Maybe HttpServiceTLSConfiguration
a → HttpServiceConfiguration
s { _hscUseTLS :: Maybe HttpServiceTLSConfiguration
_hscUseTLS = Maybe HttpServiceTLSConfiguration
a}

defaultHttpServiceConfiguration ∷ HttpServiceConfiguration
defaultHttpServiceConfiguration :: HttpServiceConfiguration
defaultHttpServiceConfiguration = HttpServiceConfiguration
    { _hscHost :: ByteString
_hscHost = ByteString
"localhost"
    , _hscPort :: Int
_hscPort = Int
80
    , _hscInterface :: ByteString
_hscInterface = ByteString
"0.0.0.0"
    , _hscUseTLS :: Maybe HttpServiceTLSConfiguration
_hscUseTLS = forall a. Maybe a
Nothing
    }

validateHttpServiceConfiguration ∷ ConfigValidation HttpServiceConfiguration DL.DList
validateHttpServiceConfiguration :: ConfigValidation HttpServiceConfiguration DList
validateHttpServiceConfiguration HttpServiceConfiguration
conf = do
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (f :: * -> *).
ConfigValidation HttpServiceTLSConfiguration f
validateHttpServiceTLSConfiguration forall a b. (a -> b) -> a -> b
$ HttpServiceConfiguration -> Maybe HttpServiceTLSConfiguration
_hscUseTLS HttpServiceConfiguration
conf
    forall (m :: * -> *) n.
(MonadError Text m, Integral n, Show n) =>
Text -> n -> m ()
validatePort Text
"port" forall a b. (a -> b) -> a -> b
$ HttpServiceConfiguration -> Int
_hscPort HttpServiceConfiguration
conf
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HttpServiceConfiguration -> Int
_hscPort HttpServiceConfiguration
conf forall a. Ord a => a -> a -> Bool
< Int
1024) forall a b. (a -> b) -> a -> b
$
        forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Item (DList Text)
"listening on a priviledged port requires super user rights"]
    forall (m :: * -> *) a.
(MonadError Text m, Eq a, Monoid a) =>
Text -> a -> m ()
validateNonEmpty Text
"host" forall a b. (a -> b) -> a -> b
$ HttpServiceConfiguration -> ByteString
_hscHost HttpServiceConfiguration
conf
    forall (m :: * -> *). MonadError Text m => Text -> String -> m ()
validateIPv4 Text
"interface" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack forall a b. (a -> b) -> a -> b
$ HttpServiceConfiguration -> ByteString
_hscInterface HttpServiceConfiguration
conf

instance FromJSON (HttpServiceConfiguration → HttpServiceConfiguration) where
    parseJSON :: Value
-> Parser (HttpServiceConfiguration -> HttpServiceConfiguration)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HttpServiceConfiguration" forall a b. (a -> b) -> a -> b
$ \Object
o → forall a. a -> a
id
        forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' HttpServiceConfiguration ByteString
hscHost forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Iso' ByteString String
bs forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"host" forall a b. (a -> b) -> a -> b
% Object
o
        forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceConfiguration Int
hscPort forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"port" forall a b. (a -> b) -> a -> b
% Object
o
        forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceConfiguration ByteString
hscInterface forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Iso' ByteString String
bs forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"interface" forall a b. (a -> b) -> a -> b
% Object
o
        forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceConfiguration (Maybe HttpServiceTLSConfiguration)
hscUseTLS forall b a.
FromJSON (b -> b) =>
Lens' a b -> Text -> Object -> Parser (a -> a)
%.: Text
"use-tls" forall a b. (a -> b) -> a -> b
% Object
o
      where
        bs ∷ Iso' B8.ByteString String
        bs :: Iso' ByteString String
bs = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ByteString -> String
B8.unpack String -> ByteString
B8.pack

instance ToJSON HttpServiceConfiguration where
    toJSON :: HttpServiceConfiguration -> Value
toJSON HttpServiceConfiguration{Int
Maybe HttpServiceTLSConfiguration
ByteString
_hscUseTLS :: Maybe HttpServiceTLSConfiguration
_hscInterface :: ByteString
_hscPort :: Int
_hscHost :: ByteString
_hscUseTLS :: HttpServiceConfiguration -> Maybe HttpServiceTLSConfiguration
_hscInterface :: HttpServiceConfiguration -> ByteString
_hscPort :: HttpServiceConfiguration -> Int
_hscHost :: HttpServiceConfiguration -> ByteString
..} = [Pair] -> Value
object
        [ Key
"host" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> String
B8.unpack ByteString
_hscHost
        , Key
"port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
_hscPort
        , Key
"interface" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> String
B8.unpack ByteString
_hscInterface
        , Key
"use-tls" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe HttpServiceTLSConfiguration
_hscUseTLS
        ]

pHttpServiceConfiguration ∷ String → MParser HttpServiceConfiguration
pHttpServiceConfiguration :: String -> MParser HttpServiceConfiguration
pHttpServiceConfiguration String
prefix = forall a. a -> a
id
    forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' HttpServiceConfiguration ByteString
hscHost forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Iso' ByteString String
bs forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
prefix forall α. Monoid α => α -> α -> α
⊕ String
"host")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help String
"Hostname of the service"
    forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceConfiguration Int
hscPort forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
prefix forall α. Monoid α => α -> α -> α
⊕ String
"port")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help String
"Port of the service"
    forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpServiceConfiguration ByteString
hscInterface forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Iso' ByteString String
bs forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
prefix forall α. Monoid α => α -> α -> α
⊕ String
"interface")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help String
"Interface of the service"
    forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< (Lens' HttpServiceConfiguration (Maybe HttpServiceTLSConfiguration)
hscUseTLS forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f (b -> b) -> f (a -> a)
%:: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> MParser HttpServiceTLSConfiguration
pHttpServiceTLSConfiguration String
prefix))
  where
    bs ∷ Iso' B8.ByteString String
    bs :: Iso' ByteString String
bs = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ByteString -> String
B8.unpack String -> ByteString
B8.pack

-- -------------------------------------------------------------------------- --
-- Http Client Configuration

data HttpClientConfiguration = HttpClientConfiguration
    { HttpClientConfiguration -> ByteString
_hccHost ∷ !B8.ByteString
    , HttpClientConfiguration -> Int
_hccPort ∷ !Int
    , HttpClientConfiguration -> Bool
_hccUseTLS ∷ !Bool
    }
    deriving (Int -> HttpClientConfiguration -> ShowS
[HttpClientConfiguration] -> ShowS
HttpClientConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpClientConfiguration] -> ShowS
$cshowList :: [HttpClientConfiguration] -> ShowS
show :: HttpClientConfiguration -> String
$cshow :: HttpClientConfiguration -> String
showsPrec :: Int -> HttpClientConfiguration -> ShowS
$cshowsPrec :: Int -> HttpClientConfiguration -> ShowS
Show, ReadPrec [HttpClientConfiguration]
ReadPrec HttpClientConfiguration
Int -> ReadS HttpClientConfiguration
ReadS [HttpClientConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HttpClientConfiguration]
$creadListPrec :: ReadPrec [HttpClientConfiguration]
readPrec :: ReadPrec HttpClientConfiguration
$creadPrec :: ReadPrec HttpClientConfiguration
readList :: ReadS [HttpClientConfiguration]
$creadList :: ReadS [HttpClientConfiguration]
readsPrec :: Int -> ReadS HttpClientConfiguration
$creadsPrec :: Int -> ReadS HttpClientConfiguration
Read, HttpClientConfiguration -> HttpClientConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
$c/= :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
== :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
$c== :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
Eq, Eq HttpClientConfiguration
HttpClientConfiguration -> HttpClientConfiguration -> Bool
HttpClientConfiguration -> HttpClientConfiguration -> Ordering
HttpClientConfiguration
-> HttpClientConfiguration -> HttpClientConfiguration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HttpClientConfiguration
-> HttpClientConfiguration -> HttpClientConfiguration
$cmin :: HttpClientConfiguration
-> HttpClientConfiguration -> HttpClientConfiguration
max :: HttpClientConfiguration
-> HttpClientConfiguration -> HttpClientConfiguration
$cmax :: HttpClientConfiguration
-> HttpClientConfiguration -> HttpClientConfiguration
>= :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
$c>= :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
> :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
$c> :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
<= :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
$c<= :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
< :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
$c< :: HttpClientConfiguration -> HttpClientConfiguration -> Bool
compare :: HttpClientConfiguration -> HttpClientConfiguration -> Ordering
$ccompare :: HttpClientConfiguration -> HttpClientConfiguration -> Ordering
Ord)

hccHost ∷ Lens' HttpClientConfiguration B8.ByteString
hccHost :: Lens' HttpClientConfiguration ByteString
hccHost = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpClientConfiguration -> ByteString
_hccHost forall a b. (a -> b) -> a -> b
$ \HttpClientConfiguration
s ByteString
a → HttpClientConfiguration
s { _hccHost :: ByteString
_hccHost = ByteString
a}

hccPort ∷ Lens' HttpClientConfiguration Int
hccPort :: Lens' HttpClientConfiguration Int
hccPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpClientConfiguration -> Int
_hccPort forall a b. (a -> b) -> a -> b
$ \HttpClientConfiguration
s Int
a → HttpClientConfiguration
s { _hccPort :: Int
_hccPort = Int
a}

hccUseTLS ∷ Lens' HttpClientConfiguration Bool
hccUseTLS :: Lens' HttpClientConfiguration Bool
hccUseTLS = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens HttpClientConfiguration -> Bool
_hccUseTLS forall a b. (a -> b) -> a -> b
$ \HttpClientConfiguration
s Bool
a → HttpClientConfiguration
s { _hccUseTLS :: Bool
_hccUseTLS = Bool
a}

defaultHttpClientConfiguration ∷ HttpClientConfiguration
defaultHttpClientConfiguration :: HttpClientConfiguration
defaultHttpClientConfiguration = HttpClientConfiguration
    { _hccHost :: ByteString
_hccHost = ByteString
"localhost"
    , _hccPort :: Int
_hccPort = Int
80
    , _hccUseTLS :: Bool
_hccUseTLS = Bool
False
    }

validateHttpClientConfiguration ∷ ConfigValidation HttpClientConfiguration f
validateHttpClientConfiguration :: forall (f :: * -> *). ConfigValidation HttpClientConfiguration f
validateHttpClientConfiguration HttpClientConfiguration
conf = do
    forall (m :: * -> *) n.
(MonadError Text m, Integral n, Show n) =>
Text -> n -> m ()
validatePort Text
"port" forall a b. (a -> b) -> a -> b
$ HttpClientConfiguration -> Int
_hccPort HttpClientConfiguration
conf
    forall (m :: * -> *) a.
(MonadError Text m, Eq a, Monoid a) =>
Text -> a -> m ()
validateNonEmpty Text
"host" forall a b. (a -> b) -> a -> b
$ HttpClientConfiguration -> ByteString
_hccHost HttpClientConfiguration
conf

instance FromJSON (HttpClientConfiguration → HttpClientConfiguration) where
    parseJSON :: Value
-> Parser (HttpClientConfiguration -> HttpClientConfiguration)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"HttpClientConfiguration" forall a b. (a -> b) -> a -> b
$ \Object
o → forall a. a -> a
id
        forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' HttpClientConfiguration ByteString
hccHost forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Iso' ByteString String
bs forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"host" forall a b. (a -> b) -> a -> b
% Object
o
        forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpClientConfiguration Int
hccPort forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"port" forall a b. (a -> b) -> a -> b
% Object
o
        forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpClientConfiguration Bool
hccUseTLS forall b a.
FromJSON b =>
Lens' a b -> Text -> Object -> Parser (a -> a)
..: Text
"use-tls" forall a b. (a -> b) -> a -> b
% Object
o
      where
        bs ∷ Iso' B8.ByteString String
        bs :: Iso' ByteString String
bs = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ByteString -> String
B8.unpack String -> ByteString
B8.pack

instance ToJSON HttpClientConfiguration where
    toJSON :: HttpClientConfiguration -> Value
toJSON HttpClientConfiguration{Bool
Int
ByteString
_hccUseTLS :: Bool
_hccPort :: Int
_hccHost :: ByteString
_hccUseTLS :: HttpClientConfiguration -> Bool
_hccPort :: HttpClientConfiguration -> Int
_hccHost :: HttpClientConfiguration -> ByteString
..} = [Pair] -> Value
object
        [ Key
"host" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> String
B8.unpack ByteString
_hccHost
        , Key
"port" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
_hccPort
        , Key
"use-tls" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
_hccUseTLS
        ]

pHttpClientConfiguration ∷ String → MParser HttpClientConfiguration
pHttpClientConfiguration :: String -> MParser HttpClientConfiguration
pHttpClientConfiguration String
serviceName = forall a. a -> a
id
    forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a -> b) -> f (a -> c)
<$< Lens' HttpClientConfiguration ByteString
hccHost forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Iso' ByteString String
bs forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
serviceName forall α. Monoid α => α -> α -> α
⊕ String
"-host")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help (String
"Hostname of " forall α. Monoid α => α -> α -> α
⊕ String
serviceName)
    forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpClientConfiguration Int
hccPort forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
serviceName forall α. Monoid α => α -> α -> α
⊕ String
"-port")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help (String
"Port of " forall α. Monoid α => α -> α -> α
⊕ String
serviceName)
    forall (f :: * -> *) b c a.
Applicative f =>
f (b -> c) -> f (a -> b) -> f (a -> c)
<*< Lens' HttpClientConfiguration Bool
hccUseTLS forall (f :: * -> *) a b.
(Alternative f, Applicative f) =>
Lens' a b -> f b -> f (a -> a)
.:: Mod FlagFields Bool -> Parser Bool
switch
        forall a b. (a -> b) -> a -> b
% forall (f :: * -> *) a. HasName f => String -> Mod f a
long (String
serviceName forall α. Monoid α => α -> α -> α
⊕ String
"-use-tls")
        forall α. Monoid α => α -> α -> α
⊕ forall (f :: * -> *) a. String -> Mod f a
help (String
"Connect to " forall α. Monoid α => α -> α -> α
⊕ String
serviceName forall α. Monoid α => α -> α -> α
⊕ String
" via TLS")
  where
    bs ∷ Iso' B8.ByteString String
    bs :: Iso' ByteString String
bs = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ByteString -> String
B8.unpack String -> ByteString
B8.pack

httpService2clientConfiguration ∷ HttpServiceConfiguration → HttpClientConfiguration
httpService2clientConfiguration :: HttpServiceConfiguration -> HttpClientConfiguration
httpService2clientConfiguration HttpServiceConfiguration{Int
Maybe HttpServiceTLSConfiguration
ByteString
_hscUseTLS :: Maybe HttpServiceTLSConfiguration
_hscInterface :: ByteString
_hscPort :: Int
_hscHost :: ByteString
_hscUseTLS :: HttpServiceConfiguration -> Maybe HttpServiceTLSConfiguration
_hscInterface :: HttpServiceConfiguration -> ByteString
_hscPort :: HttpServiceConfiguration -> Int
_hscHost :: HttpServiceConfiguration -> ByteString
..} = HttpClientConfiguration
    { _hccHost :: ByteString
_hccHost = ByteString
_hscHost
    , _hccPort :: Int
_hccPort = Int
_hscPort
    , _hccUseTLS :: Bool
_hccUseTLS = forall a. Maybe a -> Bool
isJust Maybe HttpServiceTLSConfiguration
_hscUseTLS
    }