implement gettimestamp

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
+

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
+	-> Maybe Auth
-clientGetTimestamp (ProtocolVersion ver) = case ver of
+	-> IO GetTimestampResult
-	3 -> v3 V3
+clientGetTimestamp clientenv (ProtocolVersion ver) cu su bypass auth = 
-	_ -> error "unsupported protocol version"
+	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"
+	
 	_ :<|> _ :<|> _ :<|> _ :<|>
 		_ :<|> _ :<|> _ :<|> _ :<|>
 		_ :<|> _ :<|> _ :<|> _ :<|>

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
+removeBefore endtime key = getTimestamp >>= \case
-	net $ sendMessage GETTIMESTAMP
+	Right remotetime -> do
-	net receiveMessage >>= \case
+		localtime <- local getLocalCurrentTime
-		Just (TIMESTAMP remotetime) -> do
+		let timeleft = endtime - localtime
-			localtime <- local getLocalCurrentTime
+		let timeleft' = MonotonicTimestamp (floor timeleft)
-			let timeleft = endtime - localtime
+		let remoteendtime = remotetime + timeleft'
-			let timeleft' = MonotonicTimestamp (floor timeleft)
+		if timeleft <= 0
-			let remoteendtime = remotetime + timeleft'
+			then return (Right False, Nothing)
-			if timeleft <= 0
+			else removeBeforeRemoteEndTime remoteendtime key
-				then return (Right False, Nothing)
+	Left err -> return (Left err, Nothing)
-				else removeBeforeRemoteEndTime remoteendtime key
-		Just (ERROR err) -> return (Left err, Nothing)
-		_ -> do
-			net $ sendMessage (ERROR "expected TIMESTAMP")
-			return (Right False, Nothing)
 
 removeBeforeRemoteEndTime :: MonotonicTimestamp -> Key -> Proto (Either String Bool, Maybe [UUID])
 removeBeforeRemoteEndTime remoteendtime key = do