move the p2phttp server state map into a data type
This commit is contained in:
Joey Hess
parent
d7ed99a55f
commit
6bdf4a85fb
3 changed files with 38 additions and 32 deletions
|
|
@ -110,9 +110,12 @@ seek o = getAnnexWorkerPool $ \workerpool ->
|
|||
where
|
||||
go workerpool servinguuids acquireconn = liftIO $ do
|
||||
authenv <- getAuthEnv
|
||||
st <- mkP2PHttpServerState acquireconn workerpool $
|
||||
st <- mkPerRepoServerState acquireconn workerpool $
|
||||
mkGetServerMode authenv o
|
||||
let mst = M.fromList $ zip servinguuids (repeat st)
|
||||
let mst = P2PHttpServerState
|
||||
{ servedRepos = M.fromList $
|
||||
zip servinguuids (repeat st)
|
||||
}
|
||||
let settings = Warp.setPort port $ Warp.setHost host $
|
||||
Warp.defaultSettings
|
||||
case (certFileOption o, privateKeyFileOption o) of
|
||||
|
|
|
|||
|
|
@ -40,16 +40,15 @@ import qualified Servant.Types.SourceT as S
|
|||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString.Lazy.Internal as LI
|
||||
import qualified Data.Map as M
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent
|
||||
import System.IO.Unsafe
|
||||
import Data.Either
|
||||
|
||||
p2pHttpApp :: M.Map UUID P2PHttpServerState -> Application
|
||||
p2pHttpApp :: P2PHttpServerState -> Application
|
||||
p2pHttpApp = serve p2pHttpAPI . serveP2pHttp
|
||||
|
||||
serveP2pHttp :: M.Map UUID P2PHttpServerState -> Server P2PHttpAPI
|
||||
serveP2pHttp :: P2PHttpServerState -> Server P2PHttpAPI
|
||||
serveP2pHttp st
|
||||
= serveGet st
|
||||
:<|> serveGet st
|
||||
|
|
@ -92,7 +91,7 @@ serveP2pHttp st
|
|||
:<|> serveGetGeneric st
|
||||
|
||||
serveGetGeneric
|
||||
:: M.Map UUID P2PHttpServerState
|
||||
:: P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> B64Key
|
||||
-> Maybe (B64UUID ClientSide)
|
||||
|
|
@ -110,7 +109,7 @@ serveGetGeneric st su@(B64UUID u) k mcu bypass =
|
|||
|
||||
serveGet
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
-> B64Key
|
||||
|
|
@ -223,7 +222,7 @@ serveGet mst su apiver (B64Key k) cu bypass baf startat sec auth = do
|
|||
|
||||
serveCheckPresent
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
-> B64Key
|
||||
|
|
@ -241,7 +240,7 @@ serveCheckPresent st su apiver (B64Key k) cu bypass sec auth = do
|
|||
|
||||
serveRemove
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> (RemoveResultPlus -> t)
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
|
|
@ -263,7 +262,7 @@ serveRemove st resultmangle su apiver (B64Key k) cu bypass sec auth = do
|
|||
|
||||
serveRemoveBefore
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
-> B64Key
|
||||
|
|
@ -286,7 +285,7 @@ serveRemoveBefore st su apiver (B64Key k) cu bypass (Timestamp ts) sec auth = do
|
|||
|
||||
serveGetTimestamp
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
-> B64UUID ClientSide
|
||||
|
|
@ -305,7 +304,7 @@ serveGetTimestamp st su apiver cu bypass sec auth = do
|
|||
|
||||
servePut
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> (PutResultPlus -> t)
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
|
|
@ -397,7 +396,7 @@ servePut mst resultmangle su apiver _datapresent (DataLength len) k cu bypass ba
|
|||
closeP2PConnection conn
|
||||
|
||||
servePutAction
|
||||
:: (P2PConnectionPair, P2PHttpServerState)
|
||||
:: (P2PConnectionPair, PerRepoServerState)
|
||||
-> B64Key
|
||||
-> Maybe B64FilePath
|
||||
-> (P2P.Protocol.Offset -> Proto (Maybe [UUID]))
|
||||
|
|
@ -422,7 +421,7 @@ servePutResult resultmangle res = case res of
|
|||
|
||||
servePut'
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> (PutResultPlus -> t)
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
|
|
@ -440,7 +439,7 @@ servePut' st resultmangle su v = servePut st resultmangle su v Nothing
|
|||
|
||||
servePutOffset
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> (PutOffsetResultPlus -> t)
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
|
|
@ -464,7 +463,7 @@ servePutOffset st resultmangle su apiver (B64Key k) cu bypass sec auth = do
|
|||
|
||||
serveLockContent
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
-> B64Key
|
||||
|
|
@ -501,7 +500,7 @@ serveLockContent mst su apiver (B64Key k) cu bypass sec auth = do
|
|||
|
||||
serveKeepLocked
|
||||
:: APIVersion v
|
||||
=> M.Map UUID P2PHttpServerState
|
||||
=> P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> v
|
||||
-> LockID
|
||||
|
|
|
|||
|
|
@ -44,6 +44,10 @@ import Control.Concurrent.Async
|
|||
import Data.Time.Clock.POSIX
|
||||
|
||||
data P2PHttpServerState = P2PHttpServerState
|
||||
{ servedRepos :: M.Map UUID PerRepoServerState
|
||||
}
|
||||
|
||||
data PerRepoServerState = PerRepoServerState
|
||||
{ acquireP2PConnection :: AcquireP2PConnection
|
||||
, annexWorkerPool :: AnnexWorkerPool
|
||||
, getServerMode :: GetServerMode
|
||||
|
|
@ -62,8 +66,8 @@ data ServerMode
|
|||
}
|
||||
| CannotServeRequests
|
||||
|
||||
mkP2PHttpServerState :: AcquireP2PConnection -> AnnexWorkerPool -> GetServerMode -> IO P2PHttpServerState
|
||||
mkP2PHttpServerState acquireconn annexworkerpool getservermode = P2PHttpServerState
|
||||
mkPerRepoServerState :: AcquireP2PConnection -> AnnexWorkerPool -> GetServerMode -> IO PerRepoServerState
|
||||
mkPerRepoServerState acquireconn annexworkerpool getservermode = PerRepoServerState
|
||||
<$> pure acquireconn
|
||||
<*> pure annexworkerpool
|
||||
<*> pure getservermode
|
||||
|
|
@ -75,7 +79,7 @@ data ActionClass = ReadAction | WriteAction | RemoveAction | LockAction
|
|||
withP2PConnection
|
||||
:: APIVersion v
|
||||
=> v
|
||||
-> M.Map UUID P2PHttpServerState
|
||||
-> P2PHttpServerState
|
||||
-> B64UUID ClientSide
|
||||
-> B64UUID ServerSide
|
||||
-> [B64UUID Bypass]
|
||||
|
|
@ -83,7 +87,7 @@ withP2PConnection
|
|||
-> Maybe Auth
|
||||
-> ActionClass
|
||||
-> (ConnectionParams -> ConnectionParams)
|
||||
-> ((P2PConnectionPair, P2PHttpServerState) -> Handler (Either ProtoFailure a))
|
||||
-> ((P2PConnectionPair, PerRepoServerState) -> Handler (Either ProtoFailure a))
|
||||
-> Handler a
|
||||
withP2PConnection apiver mst cu su bypass sec auth actionclass fconnparams connaction =
|
||||
withP2PConnection' apiver mst cu su bypass sec auth actionclass fconnparams connaction'
|
||||
|
|
@ -96,7 +100,7 @@ withP2PConnection apiver mst cu su bypass sec auth actionclass fconnparams conna
|
|||
withP2PConnection'
|
||||
:: APIVersion v
|
||||
=> v
|
||||
-> M.Map UUID P2PHttpServerState
|
||||
-> P2PHttpServerState
|
||||
-> B64UUID ClientSide
|
||||
-> B64UUID ServerSide
|
||||
-> [B64UUID Bypass]
|
||||
|
|
@ -104,7 +108,7 @@ withP2PConnection'
|
|||
-> Maybe Auth
|
||||
-> ActionClass
|
||||
-> (ConnectionParams -> ConnectionParams)
|
||||
-> ((P2PConnectionPair, P2PHttpServerState) -> Handler a)
|
||||
-> ((P2PConnectionPair, PerRepoServerState) -> Handler a)
|
||||
-> Handler a
|
||||
withP2PConnection' apiver mst cu su bypass sec auth actionclass fconnparams connaction = do
|
||||
(conn, st) <- getP2PConnection apiver mst cu su bypass sec auth actionclass fconnparams
|
||||
|
|
@ -114,7 +118,7 @@ withP2PConnection' apiver mst cu su bypass sec auth actionclass fconnparams conn
|
|||
getP2PConnection
|
||||
:: APIVersion v
|
||||
=> v
|
||||
-> M.Map UUID P2PHttpServerState
|
||||
-> P2PHttpServerState
|
||||
-> B64UUID ClientSide
|
||||
-> B64UUID ServerSide
|
||||
-> [B64UUID Bypass]
|
||||
|
|
@ -122,7 +126,7 @@ getP2PConnection
|
|||
-> Maybe Auth
|
||||
-> ActionClass
|
||||
-> (ConnectionParams -> ConnectionParams)
|
||||
-> Handler (P2PConnectionPair, P2PHttpServerState)
|
||||
-> Handler (P2PConnectionPair, PerRepoServerState)
|
||||
getP2PConnection apiver mst cu su bypass sec auth actionclass fconnparams =
|
||||
checkAuthActionClass mst su sec auth actionclass go
|
||||
where
|
||||
|
|
@ -143,15 +147,15 @@ getP2PConnection apiver mst cu su bypass sec auth actionclass fconnparams =
|
|||
}
|
||||
|
||||
checkAuthActionClass
|
||||
:: M.Map UUID P2PHttpServerState
|
||||
:: P2PHttpServerState
|
||||
-> B64UUID ServerSide
|
||||
-> IsSecure
|
||||
-> Maybe Auth
|
||||
-> ActionClass
|
||||
-> (P2PHttpServerState -> P2P.ServerMode -> Handler a)
|
||||
-> (PerRepoServerState -> P2P.ServerMode -> Handler a)
|
||||
-> Handler a
|
||||
checkAuthActionClass mst su sec auth actionclass go =
|
||||
case M.lookup (fromB64UUID su) mst of
|
||||
case M.lookup (fromB64UUID su) (servedRepos mst) of
|
||||
Just st -> select st
|
||||
Nothing -> throwError err404
|
||||
where
|
||||
|
|
@ -493,13 +497,13 @@ mkLocker lock unlock = do
|
|||
wait locktid
|
||||
return Nothing
|
||||
|
||||
storeLock :: LockID -> Locker -> P2PHttpServerState -> IO ()
|
||||
storeLock :: LockID -> Locker -> PerRepoServerState -> IO ()
|
||||
storeLock lckid locker st = atomically $ do
|
||||
m <- takeTMVar (openLocks st)
|
||||
let !m' = M.insert lckid locker m
|
||||
putTMVar (openLocks st) m'
|
||||
|
||||
keepingLocked :: LockID -> P2PHttpServerState -> IO ()
|
||||
keepingLocked :: LockID -> PerRepoServerState -> IO ()
|
||||
keepingLocked lckid st = do
|
||||
m <- atomically $ readTMVar (openLocks st)
|
||||
case M.lookup lckid m of
|
||||
|
|
@ -508,7 +512,7 @@ keepingLocked lckid st = do
|
|||
atomically $ void $
|
||||
tryPutTMVar (lockerTimeoutDisable locker) ()
|
||||
|
||||
dropLock :: LockID -> P2PHttpServerState -> IO ()
|
||||
dropLock :: LockID -> PerRepoServerState -> IO ()
|
||||
dropLock lckid st = do
|
||||
v <- atomically $ do
|
||||
m <- takeTMVar (openLocks st)
|
||||
|
|
@ -532,7 +536,7 @@ getAnnexWorkerPool a = startConcurrency transferStages $
|
|||
Nothing -> giveup "Use -Jn or set annex.jobs to configure the number of worker threads."
|
||||
Just wp -> a wp
|
||||
|
||||
inAnnexWorker :: P2PHttpServerState -> Annex a -> IO (Either SomeException a)
|
||||
inAnnexWorker :: PerRepoServerState -> Annex a -> IO (Either SomeException a)
|
||||
inAnnexWorker st = inAnnexWorker' (annexWorkerPool st)
|
||||
|
||||
inAnnexWorker' :: AnnexWorkerPool -> Annex a -> IO (Either SomeException a)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue