From 547adabfe368e693d9686099c4f960f96586d290 Mon Sep 17 00:00:00 2001
From: Sasa Bogicevic <t4nt0r@protonmail.com>
Date: Thu, 26 Apr 2018 15:35:11 +0200
Subject: [PATCH] Add NFData instance

add deepseq dep
Hardcode bool param for now
---
 servant-server/servant-server.cabal                    |  1 +
 servant-server/src/Servant/Server.hs                   |  6 +++++-
 .../src/Servant/Server/Internal/RoutingApplication.hs  |  8 ++++++--
 .../src/Servant/Server/Internal/ServantErr.hs          | 10 +++++++---
 4 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal
index 1823eba3..ca8d14d2 100644
--- a/servant-server/servant-server.cabal
+++ b/servant-server/servant-server.cabal
@@ -83,6 +83,7 @@ library
     , base-compat         >= 0.9.3    && < 0.11
     , attoparsec          >= 0.13.2.0 && < 0.14
     , base64-bytestring   >= 1.0.0.1  && < 1.1
+    , deepseq             >= 1.4.3.0  && < 1.5
     , exceptions          >= 0.8.3    && < 0.11
     , http-api-data       >= 0.3.7.1  && < 0.4
     , http-media          >= 0.7.1.1  && < 0.8
diff --git a/servant-server/src/Servant/Server.hs b/servant-server/src/Servant/Server.hs
index f05128ea..9b325103 100644
--- a/servant-server/src/Servant/Server.hs
+++ b/servant-server/src/Servant/Server.hs
@@ -125,10 +125,14 @@ import           Servant.Server.Internal
 serve :: (HasServer api '[]) => Proxy api -> Server api -> Application
 serve p = serveWithContext p EmptyContext
 
+type FullyEvaluateResponse = Bool
+
 serveWithContext :: (HasServer api context)
     => Proxy api -> Context context -> Server api -> Application
 serveWithContext p context server =
-  toApplication (runRouter (route p context (emptyDelayed (Route server))))
+  toApplication
+    False
+    (runRouter (route p context (emptyDelayed (Route server))))
 
 -- | Hoist server implementation.
 --
diff --git a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs
index 8a01894d..a9cc95cc 100644
--- a/servant-server/src/Servant/Server/Internal/RoutingApplication.hs
+++ b/servant-server/src/Servant/Server/Internal/RoutingApplication.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE UndecidableInstances       #-}
 module Servant.Server.Internal.RoutingApplication where
 
+import           Control.DeepSeq                    (force)
 import           Control.Monad                      (ap, liftM)
 import           Control.Monad.Base                 (MonadBase (..))
 import           Control.Monad.Catch                (MonadThrow (..))
@@ -84,9 +85,12 @@ instance MonadTransControl RouteResultT where
 instance MonadThrow m => MonadThrow (RouteResultT m) where
     throwM = lift . throwM
 
-toApplication :: RoutingApplication -> Application
-toApplication ra request respond = ra request routingRespond
+toApplication :: Bool -> RoutingApplication -> Application
+toApplication fullyEvaluate ra request respond = ra request routingRespond
  where
+  maybeEval :: (RouteResult Response -> IO ResponseReceived)
+     -> RouteResult Response -> IO ResponseReceived
+  maybeEval resp = if fullyEvaluate then force resp else resp 
   routingRespond :: RouteResult Response -> IO ResponseReceived
   routingRespond (Fail err)      = respond $ responseServantErr err
   routingRespond (FailFatal err) = respond $ responseServantErr err
diff --git a/servant-server/src/Servant/Server/Internal/ServantErr.hs b/servant-server/src/Servant/Server/Internal/ServantErr.hs
index 82a5ccb0..22c7ffcc 100644
--- a/servant-server/src/Servant/Server/Internal/ServantErr.hs
+++ b/servant-server/src/Servant/Server/Internal/ServantErr.hs
@@ -1,20 +1,24 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE DeriveAnyClass     #-}
 module Servant.Server.Internal.ServantErr where
 
+import           Control.DeepSeq (NFData)
 import           Control.Exception (Exception)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy  as LBS
 import           Data.Typeable (Typeable)
 import qualified Network.HTTP.Types    as HTTP
 import           Network.Wai           (Response, responseLBS)
+import           GHC.Generics (Generic)
 
 data ServantErr = ServantErr { errHTTPCode     :: Int
                              , errReasonPhrase :: String
                              , errBody         :: LBS.ByteString
                              , errHeaders      :: [HTTP.Header]
-                             } deriving (Show, Eq, Read, Typeable)
+                             } deriving (Show, Eq, Read, Typeable, Generic, NFData)
 
 instance Exception ServantErr