Redirect plain http connections
This commit is contained in:
parent
0401ccd128
commit
0e4bb4024d
@ -67,3 +67,10 @@ app url' table = do
|
|||||||
json $ object [ "link" .= (url' <> name)
|
json $ object [ "link" .= (url' <> name)
|
||||||
, "name" .= name
|
, "name" .= name
|
||||||
, "original" .= url ]
|
, "original" .= url ]
|
||||||
|
|
||||||
|
|
||||||
|
toTLS :: Text -> SpockT IO ()
|
||||||
|
toTLS host = do
|
||||||
|
get var (redirect . new)
|
||||||
|
get "/" (redirect $ new "")
|
||||||
|
where new url = "https://" <> host <> "/" <> url
|
@ -45,7 +45,8 @@ settings = do
|
|||||||
else base <> ":" <> pack (show port)
|
else base <> ":" <> pack (show port)
|
||||||
|
|
||||||
return AppSettings
|
return AppSettings
|
||||||
{ bindPort = port
|
{ bindHost = host
|
||||||
|
, bindPort = port
|
||||||
, bindUrl = url <> "/"
|
, bindUrl = url <> "/"
|
||||||
, urlTable = urls
|
, urlTable = urls
|
||||||
, tlsSetts = tlsSettings cert key
|
, tlsSetts = tlsSettings cert key
|
||||||
|
@ -31,7 +31,7 @@ main = do
|
|||||||
AppSettings {..} <- settings
|
AppSettings {..} <- settings
|
||||||
table <- load urlTable
|
table <- load urlTable
|
||||||
|
|
||||||
putStrLn ("Serving on " ++ unpack bindUrl)
|
|
||||||
|
|
||||||
when (bindPort == 443) (forkIO' $ runTLSRedirect bindHost)
|
when (bindPort == 443) (forkIO' $ runTLSRedirect bindHost)
|
||||||
|
|
||||||
|
putStrLn ("Serving on " ++ unpack bindUrl)
|
||||||
runBreve tlsSetts bindPort (app bindUrl table)
|
runBreve tlsSetts bindPort (app bindUrl table)
|
Loading…
Reference in New Issue
Block a user