mirror of https://github.com/voidlizard/hbs2
tcp minor fix + fixme
This commit is contained in:
parent
f04dedde31
commit
55cdf976da
|
@ -155,6 +155,23 @@ TODO: hbs2-git-export-segment-params-to-export-ASAP
|
||||||
от проекта, коммиты -- более менее стабильного размера и
|
от проекта, коммиты -- более менее стабильного размера и
|
||||||
маленькие.
|
маленькие.
|
||||||
|
|
||||||
NOTE: test-1
|
TODO: hbs2-git-http
|
||||||
NOTE: test-2
|
Реализовать простой http сервер для отдачи объектов
|
||||||
|
по git протоколу, что бы локально работало клонирование
|
||||||
|
объектов и т.п.
|
||||||
|
|
||||||
|
В самом последнем случае --- просто клонируем каталог
|
||||||
|
и отдаём файлы из него.
|
||||||
|
|
||||||
|
В текущей реализации:
|
||||||
|
|
||||||
|
- Время от времени синхронизируем репо (git fetch) ?
|
||||||
|
|
||||||
|
1. По запросу -- выясняем, в каком логе лежит объект
|
||||||
|
2. Сканируем лог, сохраняем все объекты из него, запоминаем
|
||||||
|
3. Отдаём сохраненные объекты (с tmp, sendfile-ом?)
|
||||||
|
4. Время от времени (config) зачищаем файлы
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -38,6 +38,7 @@ import Network.Socket hiding (listen,connect)
|
||||||
-- import Network.Socket.ByteString.Lazy hiding (send,recv)
|
-- import Network.Socket.ByteString.Lazy hiding (send,recv)
|
||||||
import Streaming.Prelude qualified as S
|
import Streaming.Prelude qualified as S
|
||||||
import System.Random hiding (next)
|
import System.Random hiding (next)
|
||||||
|
import Control.Monad.Trans.Resource
|
||||||
|
|
||||||
import UnliftIO.Async
|
import UnliftIO.Async
|
||||||
import UnliftIO.STM
|
import UnliftIO.STM
|
||||||
|
@ -205,6 +206,8 @@ spawnConnection :: forall m . MonadIO m
|
||||||
|
|
||||||
spawnConnection tp env so sa = liftIO do
|
spawnConnection tp env so sa = liftIO do
|
||||||
|
|
||||||
|
runResourceT do
|
||||||
|
|
||||||
let myCookie = view tcpCookie env
|
let myCookie = view tcpCookie env
|
||||||
let own = view tcpOwnPeer env
|
let own = view tcpOwnPeer env
|
||||||
let newP = fromSockAddr @'TCP sa
|
let newP = fromSockAddr @'TCP sa
|
||||||
|
@ -234,6 +237,9 @@ spawnConnection tp env so sa = liftIO do
|
||||||
modifyTVar (view tcpConnUsed env) (HashMap.insertWith (+) connId 1)
|
modifyTVar (view tcpConnUsed env) (HashMap.insertWith (+) connId 1)
|
||||||
readTVar (view tcpConnUsed env) <&> HashMap.findWithDefault 0 connId
|
readTVar (view tcpConnUsed env) <&> HashMap.findWithDefault 0 connId
|
||||||
|
|
||||||
|
|
||||||
|
void $ allocate (pure connId) cleanupConn
|
||||||
|
|
||||||
debug $ "USED:" <+> viaShow tp <+> pretty own <+> pretty used
|
debug $ "USED:" <+> viaShow tp <+> pretty own <+> pretty used
|
||||||
|
|
||||||
when ( used <= 2 ) do
|
when ( used <= 2 ) do
|
||||||
|
@ -286,7 +292,7 @@ spawnConnection tp env so sa = liftIO do
|
||||||
|
|
||||||
void $ waitAnyCatchCancel [rd,wr]
|
void $ waitAnyCatchCancel [rd,wr]
|
||||||
|
|
||||||
cleanupConn connId
|
-- cleanupConn connId
|
||||||
|
|
||||||
-- gracefulClose so 1000
|
-- gracefulClose so 1000
|
||||||
debug $ "spawnConnection exit" <+> pretty sa
|
debug $ "spawnConnection exit" <+> pretty sa
|
||||||
|
|
Loading…
Reference in New Issue