OnlySecure.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
module OnlySecure where
import Servant
import Data.Typeable
import Network.Wai (Request(..))
import Servant.Server.Internal.RoutingApplication (
    withRequest, delayedFailFatal, Delayed(..))
import Servant.Server.Internal.RoutingApplication (delayedFailFatal)
import Control.Monad (when)

data OnlySecure deriving (Typeable)

instance HasServer api context => HasServer (OnlySecure :> api) context where
  type ServerT (OnlySecure :> api) m = ServerT api m

  route Proxy context subserver =
      route (Proxy :: Proxy api) context (subserver `addCheck` check)

    where
        check = withRequest $ \req -> when (isSecure req == False) $ do
            delayedFailFatal err403
        addCheck Delayed{..} new =
          Delayed
            { authD   = new *> authD
            , ..
            }