diff --git a/src/Handler/StorageKey.hs b/src/Handler/StorageKey.hs index ea00a4bd7..dc18f2047 100644 --- a/src/Handler/StorageKey.hs +++ b/src/Handler/StorageKey.hs @@ -4,16 +4,18 @@ module Handler.StorageKey import Import --- import qualified Data.Binary as Binary +import Crypto.Hash + +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Base64 as Base64 (encode, decodeLenient) +import qualified Data.Binary as Binary (encode) +import qualified Crypto.KDF.HKDF as HKDF data StorageKeyType = SKTExamCorrect ExamId - -- { sktExamCorrectExamId :: ExamId - -- } deriveJSON defaultOptions - { fieldLabelModifier = camelToPathPiece' 3 - , constructorTagModifier = camelToPathPiece' 3 + { constructorTagModifier = camelToPathPiece' 3 } ''StorageKeyType data StorageKeyRequest @@ -29,7 +31,9 @@ deriveJSON defaultOptions data StorageKeyResponse = StorageKeyResponse - { skResKey :: Text + { skResKey :: Text + , skResTimestamp :: UTCTime + , skResSalt :: Text } deriveJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 2 @@ -39,8 +43,35 @@ deriveJSON defaultOptions postStorageKeyR :: Handler Value postStorageKeyR = do + uid <- requireAuthId + sbKey <- secretBoxKey + StorageKeyRequest{..} <- requireCheckJsonBody - let key = "TODO" + now <- liftIO getCurrentTime - sendResponseStatus ok200 $ toJSON StorageKeyResponse{ skResKey = key } + let + (lBound,rBound) = case skReqType of + SKTExamCorrect _ -> (-30*nominalDay, nominalDay) + + timestampInBounds = maybe False (\ts -> addUTCTime lBound now < ts && addUTCTime rBound now > ts) skReqTimestamp + + timestamp = if + | Just ts <- skReqTimestamp, timestampInBounds -> ts + | otherwise -> now + + salt <- let sltSize = hashDigestSize SHA3_256 in if + | Just slt <- Base64.decodeLenient . encodeUtf8 <$> skReqSalt + , timestampInBounds + , length slt == sltSize -> return slt + | otherwise -> pack . take sltSize <$> liftIO getRandoms + + let + ikm = (toStrict . Aeson.encode) (skReqType, uid, sbKey) + key = HKDF.expand (HKDF.extract salt ikm :: HKDF.PRK SHA3_256) (toStrict $ Binary.encode (timestamp,skReqLength)) skReqLength + + sendResponseStatus ok200 $ toJSON StorageKeyResponse + { skResKey = (decodeUtf8 . Base64.encode) key + , skResTimestamp = timestamp + , skResSalt = (decodeUtf8 . Base64.encode) salt + }