{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
module Servant.API.IsSecure
  ( -- $issecure
    IsSecure(..)
  ) where

import           Data.Typeable
                 (Typeable)
import           GHC.Generics
                 (Generic)

-- | Was this request made over an SSL connection?
--
-- Note that this value will not tell you if the client originally
-- made this request over SSL, but rather whether the current
-- connection is SSL. The distinction lies with reverse proxies.
-- In many cases, the client will connect to a load balancer over SSL,
-- but connect to the WAI handler without SSL. In such a case,
-- the handlers would get 'NotSecure', but from a user perspective,
-- there is a secure connection.
data IsSecure = Secure    -- ^ the connection to the server
                          --   is secure (HTTPS)
              | NotSecure -- ^ the connection to the server
                          --   is not secure (HTTP)
  deriving (IsSecure -> IsSecure -> Bool
(IsSecure -> IsSecure -> Bool)
-> (IsSecure -> IsSecure -> Bool) -> Eq IsSecure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsSecure -> IsSecure -> Bool
$c/= :: IsSecure -> IsSecure -> Bool
== :: IsSecure -> IsSecure -> Bool
$c== :: IsSecure -> IsSecure -> Bool
Eq, Int -> IsSecure -> ShowS
[IsSecure] -> ShowS
IsSecure -> String
(Int -> IsSecure -> ShowS)
-> (IsSecure -> String) -> ([IsSecure] -> ShowS) -> Show IsSecure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsSecure] -> ShowS
$cshowList :: [IsSecure] -> ShowS
show :: IsSecure -> String
$cshow :: IsSecure -> String
showsPrec :: Int -> IsSecure -> ShowS
$cshowsPrec :: Int -> IsSecure -> ShowS
Show, ReadPrec [IsSecure]
ReadPrec IsSecure
Int -> ReadS IsSecure
ReadS [IsSecure]
(Int -> ReadS IsSecure)
-> ReadS [IsSecure]
-> ReadPrec IsSecure
-> ReadPrec [IsSecure]
-> Read IsSecure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IsSecure]
$creadListPrec :: ReadPrec [IsSecure]
readPrec :: ReadPrec IsSecure
$creadPrec :: ReadPrec IsSecure
readList :: ReadS [IsSecure]
$creadList :: ReadS [IsSecure]
readsPrec :: Int -> ReadS IsSecure
$creadsPrec :: Int -> ReadS IsSecure
Read, (forall x. IsSecure -> Rep IsSecure x)
-> (forall x. Rep IsSecure x -> IsSecure) -> Generic IsSecure
forall x. Rep IsSecure x -> IsSecure
forall x. IsSecure -> Rep IsSecure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IsSecure x -> IsSecure
$cfrom :: forall x. IsSecure -> Rep IsSecure x
Generic, Eq IsSecure
Eq IsSecure
-> (IsSecure -> IsSecure -> Ordering)
-> (IsSecure -> IsSecure -> Bool)
-> (IsSecure -> IsSecure -> Bool)
-> (IsSecure -> IsSecure -> Bool)
-> (IsSecure -> IsSecure -> Bool)
-> (IsSecure -> IsSecure -> IsSecure)
-> (IsSecure -> IsSecure -> IsSecure)
-> Ord IsSecure
IsSecure -> IsSecure -> Bool
IsSecure -> IsSecure -> Ordering
IsSecure -> IsSecure -> IsSecure
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 :: IsSecure -> IsSecure -> IsSecure
$cmin :: IsSecure -> IsSecure -> IsSecure
max :: IsSecure -> IsSecure -> IsSecure
$cmax :: IsSecure -> IsSecure -> IsSecure
>= :: IsSecure -> IsSecure -> Bool
$c>= :: IsSecure -> IsSecure -> Bool
> :: IsSecure -> IsSecure -> Bool
$c> :: IsSecure -> IsSecure -> Bool
<= :: IsSecure -> IsSecure -> Bool
$c<= :: IsSecure -> IsSecure -> Bool
< :: IsSecure -> IsSecure -> Bool
$c< :: IsSecure -> IsSecure -> Bool
compare :: IsSecure -> IsSecure -> Ordering
$ccompare :: IsSecure -> IsSecure -> Ordering
$cp1Ord :: Eq IsSecure
Ord, Typeable)

-- $issecure
--
-- | Use 'IsSecure' whenever your request handlers need to know whether
--   the connection to the server is secure or not.
--   This would make the request handlers receive an argument of type 'IsSecure',
--   whose value can be one of 'Secure' (HTTPS) or 'NotSecure' (HTTP).
--
-- Example:
--
-- >>> type API = "sensitive-data" :> IsSecure :> Get '[JSON] NationSecrets

-- $setup
-- >>> import Servant.API
-- >>> data NationSecrets