From d4b9aea87b622f0ac1c24c66ec0eb199fcd7a427 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 10 Jul 2024 10:23:10 -0400
Subject: [PATCH] implement gettimestamp

---
 Command/P2PHttp.hs | 13 ++++++++++++-
 P2P/Http.hs        | 30 ++++++++++++++++++++++++------
 P2P/Protocol.hs    | 35 ++++++++++++++++++++---------------
 3 files changed, 56 insertions(+), 22 deletions(-)

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 9e94a93b01..077617ca1b 100644
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -73,7 +73,7 @@ seek o = startConcurrency commandStages $ do
 	-- XXX remove this
 	when (isNothing (portOption o)) $ do
 		liftIO $ putStrLn "test begins"
-		testRemoveBefore
+		testGetTimestamp
 		giveup "TEST DONE" 
 	withLocalP2PConnections $ \acquireconn -> liftIO $ do
 		authenv <- getAuthEnv
@@ -187,3 +187,14 @@ testRemoveBefore = do
 		Nothing
 	liftIO $ print res
 
+testGetTimestamp = do
+	mgr <- httpManager <$> getUrlOptions
+	burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
+	res <- liftIO $ clientGetTimestamp (mkClientEnv mgr burl)
+		(P2P.ProtocolVersion 3)
+		(B64UUID (toUUID ("cu" :: String)))
+		(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
+		[]
+		Nothing
+	liftIO $ print res
+
diff --git a/P2P/Http.hs b/P2P/Http.hs
index 08bb85dad4..a361105b71 100644
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -325,6 +325,8 @@ type GetTimestampAPI
 	= ClientUUID Required
 	:> ServerUUID Required
 	:> BypassUUIDs
+	:> IsSecure
+	:> AuthHeader
 	:> Post '[JSON] GetTimestampResult
 
 serveGetTimestamp
@@ -334,19 +336,35 @@ serveGetTimestamp
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
+	-> IsSecure
+	-> Maybe Auth
 	-> Handler GetTimestampResult
-serveGetTimestamp = undefined -- TODO
+serveGetTimestamp st apiver cu su bypass sec auth = do
+	res <- withP2PConnection apiver st cu su bypass sec auth ReadAction
+		$ \runst conn ->
+			liftIO $ runNetProto runst conn getTimestamp
+	case res of
+		Right ts -> return $ GetTimestampResult (Timestamp ts)
+		Left err -> throwError $
+			err500 { errBody = encodeBL err }
 
 clientGetTimestamp
-	:: ProtocolVersion
+	:: ClientEnv
+	-> ProtocolVersion
 	-> B64UUID ClientSide
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
-	-> ClientM GetTimestampResult
-clientGetTimestamp (ProtocolVersion ver) = case ver of
-	3 -> v3 V3
-	_ -> error "unsupported protocol version"
+	-> Maybe Auth
+	-> IO GetTimestampResult
+clientGetTimestamp clientenv (ProtocolVersion ver) cu su bypass auth = 
+	withClientM (cli cu su bypass auth) clientenv $ \case
+		Left err -> throwM err
+		Right res -> return res
   where
+	cli = case ver of
+		3 -> v3 V3
+		_ -> error "unsupported protocol version"
+	
 	_ :<|> _ :<|> _ :<|> _ :<|>
 		_ :<|> _ :<|> _ :<|> _ :<|>
 		_ :<|> _ :<|> _ :<|> _ :<|>
diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index 79fcc24bfb..18fc729f33 100644
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -416,6 +416,16 @@ remove proof key =
 		net $ sendMessage (REMOVE key)
 		checkSuccessFailurePlus
 
+getTimestamp :: Proto (Either String MonotonicTimestamp)
+getTimestamp = do
+	net $ sendMessage GETTIMESTAMP
+	net receiveMessage >>= \case
+		Just (TIMESTAMP ts) -> return (Right ts)
+		Just (ERROR err) -> return (Left err)
+		_ -> do
+			net $ sendMessage (ERROR "expected TIMESTAMP")
+			return (Left "protocol error")
+
 {- The endtime is the last local time at which the key can be removed.
  - To tell the remote how long it has to remove the key, get its current
  - timestamp, and add to it the number of seconds from the current local
@@ -427,21 +437,16 @@ remove proof key =
  - reduces the allowed time.
  -}
 removeBefore :: POSIXTime -> Key -> Proto (Either String Bool, Maybe [UUID])
-removeBefore endtime key = do
-	net $ sendMessage GETTIMESTAMP
-	net receiveMessage >>= \case
-		Just (TIMESTAMP remotetime) -> do
-			localtime <- local getLocalCurrentTime
-			let timeleft = endtime - localtime
-			let timeleft' = MonotonicTimestamp (floor timeleft)
-			let remoteendtime = remotetime + timeleft'
-			if timeleft <= 0
-				then return (Right False, Nothing)
-				else removeBeforeRemoteEndTime remoteendtime key
-		Just (ERROR err) -> return (Left err, Nothing)
-		_ -> do
-			net $ sendMessage (ERROR "expected TIMESTAMP")
-			return (Right False, Nothing)
+removeBefore endtime key = getTimestamp >>= \case
+	Right remotetime -> do
+		localtime <- local getLocalCurrentTime
+		let timeleft = endtime - localtime
+		let timeleft' = MonotonicTimestamp (floor timeleft)
+		let remoteendtime = remotetime + timeleft'
+		if timeleft <= 0
+			then return (Right False, Nothing)
+			else removeBeforeRemoteEndTime remoteendtime key
+	Left err -> return (Left err, Nothing)
 
 removeBeforeRemoteEndTime :: MonotonicTimestamp -> Key -> Proto (Either String Bool, Maybe [UUID])
 removeBeforeRemoteEndTime remoteendtime key = do