implement gettimestamp

This commit is contained in:
Joey Hess 2024-07-10 10:23:10 -04:00
parent 7c588a5791
commit d4b9aea87b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 56 additions and 22 deletions

View file

@ -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"
_ :<|> _ :<|> _ :<|> _ :<|>
_ :<|> _ :<|> _ :<|> _ :<|>
_ :<|> _ :<|> _ :<|> _ :<|>

View file

@ -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