use https when .git/annex/privkey.pem and .git/annex/certificate.pem exist (untested)

I have not managed to generate a key that is accepted by the old version of
warp-tls I have here.

Assistant/Threads/WebApp.hs

@@ -45,6 +45,7 @@ import Git
 import Yesod
 import Network.Socket (SockAddr, HostName)
 import Data.Text (pack, unpack)
+import qualified Network.Wai.Handler.WarpTLS as TLS
 
 mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes")
 
@@ -80,15 +81,16 @@ webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun
 		( return $ httpDebugLogger app
 		, return app
 		)
-	runWebApp listenhost app' $ \addr -> if noannex
+	tlssettings <- runThreadState (threadState assistantdata) getTlsSettings
+	runWebApp tlssettings listenhost app' $ \addr -> if noannex
 		then withTmpFile "webapp.html" $ \tmpfile h -> do
 			hClose h
-			go addr webapp tmpfile Nothing
+			go tlssettings addr webapp tmpfile Nothing
 		else do
 			let st = threadState assistantdata
 			htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim
 			urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile
-			go addr webapp htmlshim (Just urlfile)
+			go tlssettings addr webapp htmlshim (Just urlfile)
   where
   	-- The webapp thread does not wait for the startupSanityCheckThread
 	-- to finish, so that the user interface remains responsive while
@@ -99,13 +101,25 @@ webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun
 		| otherwise = Just <$>
 			(relHome =<< absPath
 				=<< runThreadState (threadState assistantdata) (fromRepo repoPath))
-	go addr webapp htmlshim urlfile = do
+	go tlssettings addr webapp htmlshim urlfile = do
-		let url = myUrl webapp addr
+		let url = myUrl tlssettings webapp addr
 		maybe noop (`writeFileProtected` url) urlfile
 		writeHtmlShim "Starting webapp..." url htmlshim
 		maybe noop (\a -> a url htmlshim) onstartup
 
-myUrl :: WebApp -> SockAddr -> Url
+myUrl :: Maybe TLS.TLSSettings -> WebApp -> SockAddr -> Url
-myUrl webapp addr = unpack $ yesodRender webapp urlbase DashboardR []
+myUrl tlssettings webapp addr = unpack $ yesodRender webapp urlbase DashboardR []
   where
-	urlbase = pack $ "http://" ++ show addr
+	urlbase = pack $ proto ++ "://" ++ show addr
+	proto
+		| isJust tlssettings = "https"
+		| otherwise = "http"
+
+getTlsSettings :: Annex (Maybe TLS.TLSSettings)
+getTlsSettings = do
+	cert <- fromRepo gitAnnexWebCertificate
+	privkey <- fromRepo gitAnnexWebPrivKey
+	ifM (liftIO $ allM doesFileExist [cert, privkey])
+		( return $ Just $ TLS.tlsSettings cert privkey
+		, return Nothing
+		)

Locations.hs

@@ -34,6 +34,8 @@ module Locations (
 	gitAnnexScheduleState,
 	gitAnnexTransferDir,
 	gitAnnexCredsDir,
+	gitAnnexWebCertificate,
+	gitAnnexWebPrivKey,
 	gitAnnexFeedStateDir,
 	gitAnnexFeedState,
 	gitAnnexMergeDir,
@@ -223,6 +225,13 @@ gitAnnexScheduleState r = gitAnnexDir r </> "schedulestate"
 gitAnnexCredsDir :: Git.Repo -> FilePath
 gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r </> "creds"
 
+{- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp
+ - when HTTPS is enabled -}
+gitAnnexWebCertificate :: Git.Repo -> FilePath
+gitAnnexWebCertificate r = gitAnnexDir r </> "certificate.pem"
+gitAnnexWebPrivKey :: Git.Repo -> FilePath
+gitAnnexWebPrivKey r = gitAnnexDir r </> "privkey.pem"
+
 {- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}
 gitAnnexFeedStateDir :: Git.Repo -> FilePath
 gitAnnexFeedStateDir r = addTrailingPathSeparator $ gitAnnexDir r </> "feedstate"

Utility/WebApp.hs

@@ -17,6 +17,7 @@ import Utility.Hash
 import qualified Yesod
 import qualified Network.Wai as Wai
 import Network.Wai.Handler.Warp
+import Network.Wai.Handler.WarpTLS
 import Network.Wai.Logger
 import Control.Monad.IO.Class
 import Network.HTTP.Types
@@ -70,10 +71,12 @@ browserProc url = proc "xdg-open" [url]
  - An IO action can also be run, to do something with the address,
  - such as start a web browser to view the webapp.
  -}
-runWebApp :: Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO ()
+runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO ()
-runWebApp h app observer = withSocketsDo $ do
+runWebApp tlssettings h app observer = withSocketsDo $ do
 	sock <- getSocket h
-	void $ forkIO $ runSettingsSocket webAppSettings sock app
+	void $ forkIO $ 
+		(maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)
+			webAppSettings sock app	
 	sockaddr <- fixSockAddr <$> getSocketName sock
 	observer sockaddr