module Handler.StorageKey
  ( postStorageKeyR
  ) where

import Import

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

{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}


data StorageKeyType
  = SKTExamCorrect
    { _sktExam :: CryptoUUIDExam
    }
deriveJSON defaultOptions
  { fieldLabelModifier     = camelToPathPiece' 1
  , constructorTagModifier = camelToPathPiece' 1
  , tagSingleConstructors  = True
  } ''StorageKeyType

data StorageKeyRequest
  = StorageKeyRequest
    { skReqType      :: StorageKeyType
    , skReqTimestamp :: Maybe UTCTime
    , skReqSalt      :: Maybe Text
    , skReqLength    :: Int
    }
deriveJSON defaultOptions
  { fieldLabelModifier = camelToPathPiece' 2
  , omitNothingFields  = True
  } ''StorageKeyRequest

data StorageKeyResponse
  = StorageKeyResponse
    { skResKey       :: Text
    , skResTimestamp :: UTCTime
    , skResSalt      :: Text
    }
deriveJSON defaultOptions
  { fieldLabelModifier     = camelToPathPiece' 2
  , constructorTagModifier = camelToPathPiece' 2
  } ''StorageKeyResponse


postStorageKeyR :: Handler Value
postStorageKeyR = do
  uid   <- requireAuthId
  sbKey <- secretBoxKey

  StorageKeyRequest{..} <- requireCheckJsonBody

  now <- liftIO getCurrentTime

  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

  return $ toJSON StorageKeyResponse
    { skResKey       = (decodeUtf8 . Base64.encode) key
    , skResTimestamp = timestamp
    , skResSalt      = (decodeUtf8 . Base64.encode) salt
    }