module Happstack.Server.SimpleHTTPS
     ( TLSConf(..)
     , nullTLSConf
     , simpleHTTPS
     , simpleHTTPS'
     ) where

import Data.Maybe                    (fromMaybe)
import Happstack.Server              (ToMessage(..), UnWebT, ServerPartT, simpleHTTP'', mapServerPartT, runValidator)
import Happstack.Server.Internal.TLS (TLSConf(..), nullTLSConf, listenTLS)

-- |start the https:\/\/ server, and handle requests using the supplied
-- 'ServerPart'.
--
-- This function will not return, though it may throw an exception.
--
simpleHTTPS :: (ToMessage a) =>
               TLSConf           -- ^ tls server configuration
            -> ServerPartT IO a  -- ^ server part to run
            -> IO ()
simpleHTTPS :: TLSConf -> ServerPartT IO a -> IO ()
simpleHTTPS = (UnWebT IO a -> UnWebT IO a)
-> TLSConf -> ServerPartT IO a -> IO ()
forall b (m :: * -> *) a.
(ToMessage b, Monad m, Functor m) =>
(UnWebT m a -> UnWebT IO b) -> TLSConf -> ServerPartT m a -> IO ()
simpleHTTPS' UnWebT IO a -> UnWebT IO a
forall a. a -> a
id

-- | similar 'simpleHTTPS' but allows you to supply a function to convert 'm' to 'IO'.
simpleHTTPS' :: (ToMessage b, Monad m, Functor m) =>
                (UnWebT m a -> UnWebT IO b)
            -> TLSConf
            -> ServerPartT m a
            -> IO ()
simpleHTTPS' :: (UnWebT m a -> UnWebT IO b) -> TLSConf -> ServerPartT m a -> IO ()
simpleHTTPS' UnWebT m a -> UnWebT IO b
toIO TLSConf
tlsConf ServerPartT m a
hs =
    TLSConf -> (Request -> IO Response) -> IO ()
listenTLS TLSConf
tlsConf (\Request
req -> (Response -> IO Response) -> Response -> IO Response
runValidator ((Response -> IO Response)
-> Maybe (Response -> IO Response) -> Response -> IO Response
forall a. a -> Maybe a -> a
fromMaybe Response -> IO Response
forall (m :: * -> *) a. Monad m => a -> m a
return (TLSConf -> Maybe (Response -> IO Response)
tlsValidator TLSConf
tlsConf)) (Response -> IO Response) -> IO Response -> IO Response
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ServerPartT IO b -> Request -> IO Response
forall b (m :: * -> *).
(ToMessage b, Monad m, Functor m) =>
ServerPartT m b -> Request -> m Response
simpleHTTP'' ((UnWebT m a -> UnWebT IO b) -> ServerPartT m a -> ServerPartT IO b
forall (m :: * -> *) a (n :: * -> *) b.
(UnWebT m a -> UnWebT n b) -> ServerPartT m a -> ServerPartT n b
mapServerPartT UnWebT m a -> UnWebT IO b
toIO ServerPartT m a
hs) Request
req))