feat(storage-key): postStorageKeyR

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
+    }