p2pHttpApp with a map of UUIDs to server states

This is early groundwork for making p2phttp support serving multiple
repositories from a single daemon.

So far only 1 repository is served still. And this commit breaks support
for proxying!
This commit is contained in:
Joey Hess 2024-11-20 12:51:25 -04:00
parent b8a717a617
commit 254073569f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 85 additions and 76 deletions

View file

@ -16,6 +16,7 @@ import P2P.Http.Server
import P2P.Http.Url
import qualified P2P.Protocol as P2P
import Utility.Env
import Annex.UUID
import Servant
import qualified Network.Wai.Handler.Warp as Warp
@ -102,24 +103,27 @@ optParser _ = Options
))
seek :: Options -> CommandSeek
seek o = getAnnexWorkerPool $ \workerpool ->
withP2PConnections workerpool
(fromMaybe 1 $ proxyConnectionsOption o)
(fromMaybe 1 $ clusterJobsOption o)
(go workerpool)
seek o = do
u <- getUUID
getAnnexWorkerPool $ \workerpool ->
withP2PConnections workerpool
(fromMaybe 1 $ proxyConnectionsOption o)
(fromMaybe 1 $ clusterJobsOption o)
(go u workerpool)
where
go workerpool acquireconn = liftIO $ do
go u workerpool acquireconn = liftIO $ do
authenv <- getAuthEnv
st <- mkP2PHttpServerState acquireconn workerpool $
mkGetServerMode authenv o
let mst = M.singleton u st
let settings = Warp.setPort port $ Warp.setHost host $
Warp.defaultSettings
case (certFileOption o, privateKeyFileOption o) of
(Nothing, Nothing) -> Warp.runSettings settings (p2pHttpApp st)
(Nothing, Nothing) -> Warp.runSettings settings (p2pHttpApp mst)
(Just certfile, Just privatekeyfile) -> do
let tlssettings = Warp.tlsSettingsChain
certfile (chainFileOption o) privatekeyfile
Warp.runTLS tlssettings settings (p2pHttpApp st)
Warp.runTLS tlssettings settings (p2pHttpApp mst)
_ -> giveup "You must use both --certfile and --privatekeyfile options to enable HTTPS."
port = maybe