Skip to content

Commit f7b8cee

Browse files
ChrisPennerChrisPenner
committed
WIP
1 parent 11507f0 commit f7b8cee

File tree

4 files changed

+90
-42
lines changed

4 files changed

+90
-42
lines changed

‎share-api/src/Share/Web/UCM/SyncV2/Impl.hs‎

Lines changed: 0 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -142,43 +142,6 @@ queueToStream q = do
142142
loop
143143
loop
144144

145-
data CodebaseLoadingError
146-
= CodebaseLoadingErrorProjectNotFound ProjectShortHand
147-
| CodebaseLoadingErrorUserNotFound UserHandle
148-
| CodebaseLoadingErrorNoReadPermission SyncV2.BranchRef
149-
| CodebaseLoadingErrorInvalidBranchRef Text SyncV2.BranchRef
150-
deriving stock (Show)
151-
deriving (Logging.Loggable) via Logging.ShowLoggable Logging.UserFault CodebaseLoadingError
152-
153-
instance ToServerError CodebaseLoadingError where
154-
toServerError = \case
155-
CodebaseLoadingErrorProjectNotFound projectShortHand -> (ErrorID "codebase-loading:project-not-found", Servant.err404 {errBody = from . Text.encodeUtf8 $ "Project not found: " <> (IDs.toText projectShortHand)})
156-
CodebaseLoadingErrorUserNotFound userHandle -> (ErrorID "codebase-loading:user-not-found", Servant.err404 {errBody = from . Text.encodeUtf8 $ "User not found: " <> (IDs.toText userHandle)})
157-
CodebaseLoadingErrorNoReadPermission branchRef -> (ErrorID "codebase-loading:no-read-permission", Servant.err403 {errBody = from . Text.encodeUtf8 $ "No read permission for branch ref: " <> (SyncV2.unBranchRef branchRef)})
158-
CodebaseLoadingErrorInvalidBranchRef err branchRef -> (ErrorID "codebase-loading:invalid-branch-ref", Servant.err400 {errBody = from . Text.encodeUtf8 $ "Invalid branch ref: " <> err <> " " <> (SyncV2.unBranchRef branchRef)})
159-
160-
codebaseForBranchRef :: SyncV2.BranchRef -> (ExceptT CodebaseLoadingError WebApp Codebase.CodebaseEnv)
161-
codebaseForBranchRef branchRef = do
162-
case parseBranchRef branchRef of
163-
Left err -> throwError (CodebaseLoadingErrorInvalidBranchRef err branchRef)
164-
Right (Left (ProjectReleaseShortHand {userHandle, projectSlug})) -> do
165-
let projectShortHand = ProjectShortHand {userHandle, projectSlug}
166-
(Project {ownerUserId = projectOwnerUserId}, contributorId) <- ExceptT . PG.tryRunTransaction $ do
167-
project <- PGQ.projectByShortHand projectShortHand `whenNothingM` throwError (CodebaseLoadingErrorProjectNotFound $ projectShortHand)
168-
pure (project, Nothing)
169-
authZToken <- lift AuthZ.checkDownloadFromProjectBranchCodebase `whenLeftM` \_err -> throwError (CodebaseLoadingErrorNoReadPermission branchRef)
170-
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
171-
pure $ Codebase.codebaseEnv authZToken codebaseLoc
172-
Right (Right (ProjectBranchShortHand {userHandle, projectSlug, contributorHandle})) -> do
173-
let projectShortHand = ProjectShortHand {userHandle, projectSlug}
174-
(Project {ownerUserId = projectOwnerUserId}, contributorId) <- ExceptT . PG.tryRunTransaction $ do
175-
project <- (PGQ.projectByShortHand projectShortHand) `whenNothingM` throwError (CodebaseLoadingErrorProjectNotFound projectShortHand)
176-
mayContributorUserId <- for contributorHandle \ch -> fmap user_id $ (UserQ.userByHandle ch) `whenNothingM` throwError (CodebaseLoadingErrorUserNotFound ch)
177-
pure (project, mayContributorUserId)
178-
authZToken <- lift AuthZ.checkDownloadFromProjectBranchCodebase `whenLeftM` \_err -> throwError (CodebaseLoadingErrorNoReadPermission branchRef)
179-
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
180-
pure $ Codebase.codebaseEnv authZToken codebaseLoc
181-
182145
-- | Run an IO action in the background while streaming the results.
183146
--
184147
-- Servant doesn't provide any easier way to do bracketing like this, all the IO must be

‎src/Share/Web/UCM/SyncCommon/Impl.hs‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
module Share.Web.UCM.SyncCommon.Impl (codebaseForBranchRef) where
2+
3+
codebaseForBranchRef :: SyncV2.BranchRef -> (ExceptT CodebaseLoadingError WebApp Codebase.CodebaseEnv)
4+
codebaseForBranchRef branchRef = do
5+
case parseBranchRef branchRef of
6+
Left err -> throwError (CodebaseLoadingErrorInvalidBranchRef err branchRef)
7+
Right (Left (ProjectReleaseShortHand {userHandle, projectSlug})) -> do
8+
let projectShortHand = ProjectShortHand {userHandle, projectSlug}
9+
(Project {ownerUserId = projectOwnerUserId}, contributorId) <- ExceptT . PG.tryRunTransaction $ do
10+
project <- PGQ.projectByShortHand projectShortHand `whenNothingM` throwError (CodebaseLoadingErrorProjectNotFound $ projectShortHand)
11+
pure (project, Nothing)
12+
authZToken <- lift AuthZ.checkDownloadFromProjectBranchCodebase `whenLeftM` \_err -> throwError (CodebaseLoadingErrorNoReadPermission branchRef)
13+
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
14+
pure $ Codebase.codebaseEnv authZToken codebaseLoc
15+
Right (Right (ProjectBranchShortHand {userHandle, projectSlug, contributorHandle})) -> do
16+
let projectShortHand = ProjectShortHand {userHandle, projectSlug}
17+
(Project {ownerUserId = projectOwnerUserId}, contributorId) <- ExceptT . PG.tryRunTransaction $ do
18+
project <- (PGQ.projectByShortHand projectShortHand) `whenNothingM` throwError (CodebaseLoadingErrorProjectNotFound projectShortHand)
19+
mayContributorUserId <- for contributorHandle \ch -> fmap user_id $ (UserQ.userByHandle ch) `whenNothingM` throwError (CodebaseLoadingErrorUserNotFound ch)
20+
pure (project, mayContributorUserId)
21+
authZToken <- lift AuthZ.checkDownloadFromProjectBranchCodebase `whenLeftM` \_err -> throwError (CodebaseLoadingErrorNoReadPermission branchRef)
22+
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
23+
pure $ Codebase.codebaseEnv authZToken codebaseLoc

‎src/Share/Web/UCM/SyncCommon/Types.hs‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
module Share.Web.UCM.SyncCommon.Types () where
2+
3+
newtype BranchRef = BranchRef {unBranchRef :: Text}
4+
deriving (Serialise, Eq, Show, Ord, ToJSON, FromJSON) via Text
5+
6+
instance From (ProjectAndBranch ProjectName ProjectBranchName) BranchRef where
7+
from pab = BranchRef $ from pab
8+
9+
10+
data CodebaseLoadingError
11+
= CodebaseLoadingErrorProjectNotFound ProjectShortHand
12+
| CodebaseLoadingErrorUserNotFound UserHandle
13+
| CodebaseLoadingErrorNoReadPermission SyncV2.BranchRef
14+
| CodebaseLoadingErrorInvalidBranchRef Text SyncV2.BranchRef
15+
deriving stock (Show)
16+
deriving (Logging.Loggable) via Logging.ShowLoggable Logging.UserFault CodebaseLoadingError
17+
18+
instance ToServerError CodebaseLoadingError where
19+
toServerError = \case
20+
CodebaseLoadingErrorProjectNotFound projectShortHand -> (ErrorID "codebase-loading:project-not-found", Servant.err404 {errBody = from . Text.encodeUtf8 $ "Project not found: " <> (IDs.toText projectShortHand)})
21+
CodebaseLoadingErrorUserNotFound userHandle -> (ErrorID "codebase-loading:user-not-found", Servant.err404 {errBody = from . Text.encodeUtf8 $ "User not found: " <> (IDs.toText userHandle)})
22+
CodebaseLoadingErrorNoReadPermission branchRef -> (ErrorID "codebase-loading:no-read-permission", Servant.err403 {errBody = from . Text.encodeUtf8 $ "No read permission for branch ref: " <> (SyncV2.unBranchRef branchRef)})
23+
CodebaseLoadingErrorInvalidBranchRef err branchRef -> (ErrorID "codebase-loading:invalid-branch-ref", Servant.err400 {errBody = from . Text.encodeUtf8 $ "Invalid branch ref: " <> err <> " " <> (SyncV2.unBranchRef branchRef)})
24+
25+
codebaseForBranchRef :: SyncV2.BranchRef -> (ExceptT CodebaseLoadingError WebApp Codebase.CodebaseEnv)
26+
codebaseForBranchRef branchRef = do
27+
case parseBranchRef branchRef of
28+
Left err -> throwError (CodebaseLoadingErrorInvalidBranchRef err branchRef)
29+
Right (Left (ProjectReleaseShortHand {userHandle, projectSlug})) -> do
30+
let projectShortHand = ProjectShortHand {userHandle, projectSlug}
31+
(Project {ownerUserId = projectOwnerUserId}, contributorId) <- ExceptT . PG.tryRunTransaction $ do
32+
project <- PGQ.projectByShortHand projectShortHand `whenNothingM` throwError (CodebaseLoadingErrorProjectNotFound $ projectShortHand)
33+
pure (project, Nothing)
34+
authZToken <- lift AuthZ.checkDownloadFromProjectBranchCodebase `whenLeftM` \_err -> throwError (CodebaseLoadingErrorNoReadPermission branchRef)
35+
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
36+
pure $ Codebase.codebaseEnv authZToken codebaseLoc
37+
Right (Right (ProjectBranchShortHand {userHandle, projectSlug, contributorHandle})) -> do
38+
let projectShortHand = ProjectShortHand {userHandle, projectSlug}
39+
(Project {ownerUserId = projectOwnerUserId}, contributorId) <- ExceptT . PG.tryRunTransaction $ do
40+
project <- (PGQ.projectByShortHand projectShortHand) `whenNothingM` throwError (CodebaseLoadingErrorProjectNotFound projectShortHand)
41+
mayContributorUserId <- for contributorHandle \ch -> fmap user_id $ (UserQ.userByHandle ch) `whenNothingM` throwError (CodebaseLoadingErrorUserNotFound ch)
42+
pure (project, mayContributorUserId)
43+
authZToken <- lift AuthZ.checkDownloadFromProjectBranchCodebase `whenLeftM` \_err -> throwError (CodebaseLoadingErrorNoReadPermission branchRef)
44+
let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
45+
pure $ Codebase.codebaseEnv authZToken codebaseLoc

‎src/Share/Web/UCM/SyncV3/Impl.hs‎

Lines changed: 22 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
{-# LANGUAGE RecordWildCards #-}
33
{-# LANGUAGE TypeOperators #-}
44

5-
module Share.Web.UCM.SyncV3.Impl where
5+
module Share.Web.UCM.SyncV3.Impl (server) where
66

77
import Control.Lens hiding ((.=))
88
import Control.Monad.Except (runExceptT)
@@ -28,6 +28,7 @@ import Unison.SyncV3.Types
2828
import Unison.Util.Websockets (Queues (..), withQueues)
2929
import UnliftIO qualified
3030
import UnliftIO.STM
31+
import Unison.Debug qualified as Debug
3132

3233
-- Amount of entities to buffer from the network into the send/recv queues.
3334
sendBufferSize :: Natural
@@ -36,10 +37,10 @@ sendBufferSize = 100
3637
recvBufferSize :: Natural
3738
recvBufferSize = 100
3839

39-
data StreamInitInfo = StreamInitInfo
40+
-- data StreamInitInfo = StreamInitInfo
4041

41-
streamSettings :: StreamInitInfo
42-
streamSettings = StreamInitInfo
42+
-- streamSettings :: StreamInitInfo
43+
-- streamSettings = StreamInitInfo
4344

4445
server :: Maybe UserId -> SyncV3.Routes WebAppServer
4546
server mayUserId =
@@ -49,6 +50,7 @@ server mayUserId =
4950

5051
downloadEntitiesImpl :: Maybe UserId -> WS.Connection -> WebApp ()
5152
downloadEntitiesImpl _mayCallerUserId conn = do
53+
Debug.debugLogM Debug.Temp "Got connection"
5254
-- Auth is currently done via HashJWTs
5355
_authZReceipt <- AuthZ.checkDownloadFromUserCodebase
5456
doSyncEmitter shareEmitter conn
@@ -70,13 +72,18 @@ doSyncEmitter emitterImpl conn = do
7072
sendBufferSize
7173
conn
7274
\(q@Queues {receive}) -> handleErr q $ do
75+
Debug.debugLogM Debug.Temp "Got queues"
7376
let recvM :: ExceptT SyncError m (FromReceiverMessage HashJWT Hash32)
7477
recvM = do
7578
result <- liftIO $ atomically receive
79+
Debug.debugM Debug.Temp "Received: " result
7680
case result of
7781
Msg msg -> pure msg
7882
Err err -> throwError err
83+
84+
Debug.debugLogM Debug.Temp "Waiting for init message"
7985
initMsg <- recvM
86+
Debug.debugM Debug.Temp "Got init: " initMsg
8087
syncState <- case initMsg of
8188
ReceiverInitStream initMsg -> lift $ initialize initMsg
8289
other -> throwError $ InitializationError ("Expected ReceiverInitStream message, got: " <> tShow other)
@@ -93,7 +100,17 @@ doSyncEmitter emitterImpl conn = do
93100
Right r -> pure r
94101

95102
initialize :: InitMsg ah -> m (SyncState sh hash)
96-
initialize = undefined
103+
initialize InitMsg{initMsgClientVersion, initMsgBranchRef, initMsgRootCausal, initMsgRequestedDepth} = do
104+
let initialCausalHash = hashjwtHash initMsgRootCausal
105+
validRequestsVar <- newTVarIO Set.empty
106+
requestedEntitiesVar <- newTVarIO (Set.singleton initialCausalHash)
107+
entitiesAlreadySentVar <- newTVarIO Set.empty
108+
pure $ SyncState
109+
{ codebase = PG.codebaseEnv,
110+
validRequestsVar,
111+
requestedEntitiesVar,
112+
entitiesAlreadySentVar
113+
}
97114

98115
data SyncState sh hash = SyncState
99116
{ codebase :: CodebaseEnv,

0 commit comments

Comments
 (0)