implement gettimestamp

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 9e94a93b01304ed29700d1a28f1b6aa25cfb4df9..077617ca1b0991db7cff73b500f201d67853dc1c 100644 (file)
--- 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 08bb85dad4e172e33d4b3ff8e515f89895cde4a3..a361105b719791e7240bd020b664ed1ac31f462d 100644 (file)
--- 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 79fcc24bfb78a4d5f29da23a5983ab9427bfef00..18fc729f333f789e656210b80bb814c8b474dc9b 100644 (file)
--- 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