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

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
#if __GLASGOW_HASKELL__>=708
{-# LANGUAGE OverloadedLists #-}
#endif
{-# 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)
#if __GLASGOW_HASKELL__>=708
import Control.Monad.Writer.Class (tell)
#endif

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

import Prelude.Unicode

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

-- | In order to make TLS optional this type should be used
-- wrapped into a Maybe.
--
data HttpServiceTLSConfiguration = HttpServiceTLSConfiguration
    { _hstcCertFile  !FilePath
    , _hstcKeyFile  !FilePath
    }
    deriving (Show, Read, Eq, Ord)

hstcCertFile  Lens' HttpServiceTLSConfiguration FilePath
hstcCertFile = lens _hstcCertFile $ \s a  s { _hstcCertFile = a}

hstcKeyFile  Lens' HttpServiceTLSConfiguration FilePath
hstcKeyFile = lens _hstcKeyFile $ \s a  s { _hstcKeyFile = a}

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

validateHttpServiceTLSConfiguration
     ConfigValidation HttpServiceTLSConfiguration f
validateHttpServiceTLSConfiguration conf = do
    validateFileReadable "cert-file" $ _hstcCertFile conf
    validateFileReadable "key-file" $ _hstcKeyFile conf

instance FromJSON (HttpServiceTLSConfiguration  HttpServiceTLSConfiguration) where
    parseJSON = withObject "HttpServiceTLSConfiguration" $ \o  id
        <$< hstcCertFile ..: "cert-file" × o
        <*< hstcKeyFile ..: "pem-file" × 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 v = parseJSON v <*> pure defaultHttpServiceTLSConfiguration

instance ToJSON HttpServiceTLSConfiguration where
    toJSON HttpServiceTLSConfiguration{..} = object
        [ "cert-file" .= _hstcCertFile
        , "key-file" .= _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 prefix = id
    <$< hstcCertFile .:: strOption
        × long (prefix  "cert-file")
         help "File with PEM encoded TLS Certificate"
    <*< hstcKeyFile .:: strOption
        × long (prefix  "key-file")
         help "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
    { _hscHost  !B8.ByteString
    , _hscPort  !Int
    , _hscInterface  !B8.ByteString
    , _hscUseTLS  !(Maybe HttpServiceTLSConfiguration)
    }
    deriving (Show, Read, Eq, Ord)

hscHost  Lens' HttpServiceConfiguration B8.ByteString
hscHost = lens _hscHost $ \s a  s { _hscHost = a}

hscPort  Lens' HttpServiceConfiguration Int
hscPort = lens _hscPort $ \s a  s { _hscPort = a}

hscInterface  Lens' HttpServiceConfiguration B8.ByteString
hscInterface = lens _hscInterface $ \s a  s { _hscInterface = a}

hscUseTLS  Lens' HttpServiceConfiguration (Maybe HttpServiceTLSConfiguration)
hscUseTLS = lens _hscUseTLS $ \s a  s { _hscUseTLS = a}

defaultHttpServiceConfiguration  HttpServiceConfiguration
defaultHttpServiceConfiguration = HttpServiceConfiguration
    { _hscHost = "localhost"
    , _hscPort = 80
    , _hscInterface = "0.0.0.0"
    , _hscUseTLS = Nothing
    }

validateHttpServiceConfiguration  ConfigValidation HttpServiceConfiguration DL.DList
validateHttpServiceConfiguration conf = do
    maybe (return ()) validateHttpServiceTLSConfiguration $ _hscUseTLS conf
    validatePort "port" $ _hscPort conf
#if __GLASGOW_HASKELL__>=708
    when (_hscPort conf < 1024) $
        tell ["listening on a priviledged port requires super user rights"]
#endif
    validateNonEmpty "host" $ _hscHost conf
    validateIPv4 "interface" . B8.unpack $ _hscInterface conf

instance FromJSON (HttpServiceConfiguration  HttpServiceConfiguration) where
    parseJSON = withObject "HttpServiceConfiguration" $ \o  id
        <$< hscHost  bs ..: "host" × o
        <*< hscPort ..: "port" × o
        <*< hscInterface  bs ..: "interface" × o
        <*< hscUseTLS %.: "use-tls" × o
      where
        bs  Iso' B8.ByteString String
        bs = iso B8.unpack B8.pack

instance ToJSON HttpServiceConfiguration where
    toJSON HttpServiceConfiguration{..} = object
        [ "host" .= B8.unpack _hscHost
        , "port" .= _hscPort
        , "interface" .= B8.unpack _hscInterface
        , "use-tls" .= _hscUseTLS
        ]

pHttpServiceConfiguration  String  MParser HttpServiceConfiguration
pHttpServiceConfiguration prefix = id
    <$< hscHost  bs .:: strOption
        × long (prefix  "host")
         help "Hostname of the service"
    <*< hscPort .:: option auto
        × long (prefix  "port")
         help "Port of the service"
    <*< hscInterface  bs .:: option auto
        × long (prefix  "interface")
         help "Interface of the service"
    <*< (hscUseTLS %:: (fmap <$> pHttpServiceTLSConfiguration prefix))
  where
    bs  Iso' B8.ByteString String
    bs = iso B8.unpack B8.pack

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

data HttpClientConfiguration = HttpClientConfiguration
    { _hccHost  !B8.ByteString
    , _hccPort  !Int
    , _hccUseTLS  !Bool
    }
    deriving (Show, Read, Eq, Ord)

hccHost  Lens' HttpClientConfiguration B8.ByteString
hccHost = lens _hccHost $ \s a  s { _hccHost = a}

hccPort  Lens' HttpClientConfiguration Int
hccPort = lens _hccPort $ \s a  s { _hccPort = a}

hccUseTLS  Lens' HttpClientConfiguration Bool
hccUseTLS = lens _hccUseTLS $ \s a  s { _hccUseTLS = a}

defaultHttpClientConfiguration  HttpClientConfiguration
defaultHttpClientConfiguration = HttpClientConfiguration
    { _hccHost = "localhost"
    , _hccPort = 80
    , _hccUseTLS = False
    }

validateHttpClientConfiguration  ConfigValidation HttpClientConfiguration f
validateHttpClientConfiguration conf = do
    validatePort "port" $ _hccPort conf
    validateNonEmpty "host" $ _hccHost conf

instance FromJSON (HttpClientConfiguration  HttpClientConfiguration) where
    parseJSON = withObject "HttpClientConfiguration" $ \o  id
        <$< hccHost  bs ..: "host" × o
        <*< hccPort ..: "port" × o
        <*< hccUseTLS ..: "use-tls" × o
      where
        bs  Iso' B8.ByteString String
        bs = iso B8.unpack B8.pack

instance ToJSON HttpClientConfiguration where
    toJSON HttpClientConfiguration{..} = object
        [ "host" .= B8.unpack _hccHost
        , "port" .= _hccPort
        , "use-tls" .= _hccUseTLS
        ]

pHttpClientConfiguration  String  MParser HttpClientConfiguration
pHttpClientConfiguration serviceName = id
    <$< hccHost  bs .:: strOption
        × long (serviceName  "-host")
         help ("Hostname of "  serviceName)
    <*< hccPort .:: option auto
        × long (serviceName  "-port")
         help ("Port of "  serviceName)
    <*< hccUseTLS .:: switch
        × long (serviceName  "-use-tls")
         help ("Connect to "  serviceName  " via TLS")
  where
    bs  Iso' B8.ByteString String
    bs = iso B8.unpack B8.pack

httpService2clientConfiguration  HttpServiceConfiguration  HttpClientConfiguration
httpService2clientConfiguration HttpServiceConfiguration{..} = HttpClientConfiguration
    { _hccHost = _hscHost
    , _hccPort = _hscPort
    , _hccUseTLS = isJust _hscUseTLS
    }