Remove internal TLS, add option for HTTPS redirection

src/Middleware.hs

@@ -5,12 +5,14 @@ module Middleware where
 
 import Data.Aeson
 
-import Network.HTTP.Types.Header (hContentType)
-import Network.HTTP.Types.Status (status400)
+import Network.HTTP.Types.Header (hContentType, hLocation)
+import Network.HTTP.Types.Status (status400, status301)
 import Database.HDBC.Types (SqlError(..))
 import Control.Exception (catchJust)
+import Data.String.Conversions (cs)
 import Network.Wai
-
+import Network.URI (URI(..), parseURI)
+import Data.Monoid (mconcat)
 
 instance ToJSON SqlError where
   toJSON t = object [
@@ -31,3 +33,25 @@ reportPgErrors app req respond =
   where
     isPgException :: SqlError -> Maybe SqlError
     isPgException = Just
+
+
+redirectInsecure :: Middleware
+redirectInsecure app req respond = do
+  let hdrs = requestHeaders req
+      host = lookup "host" hdrs
+      uriM = parseURI . cs =<< mconcat [
+        Just "https://",
+        host,
+        Just $ rawPathInfo req,
+        Just $ rawQueryString req]
+      isHerokuSecure = lookup "x-forwarded-proto" hdrs == Just "https"
+
+  if not (isSecure req || isHerokuSecure)
+    then case uriM of
+              Just uri ->
+                respond $ responseLBS status301 [
+                    (hLocation, cs . show $ uri { uriScheme = "https:" })
+                  ] ""
+              Nothing ->
+                respond $ responseLBS status400 [] "SSL is required"
+    else app req respond