{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module Configuration.Utils.Http
(
HttpServiceTLSConfiguration
, hstcCertFile
, hstcKeyFile
, defaultHttpServiceTLSConfiguration
, pHttpServiceTLSConfiguration
, validateHttpServiceTLSConfiguration
, HttpServiceConfiguration
, hscHost
, hscPort
, hscUseTLS
, defaultHttpServiceConfiguration
, pHttpServiceConfiguration
, validateHttpServiceConfiguration
, 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 ((×))
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
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
]
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"
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
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
}