module Handler.Sheet.PersonalisedFiles.Types
  ( PersonalisedSheetFilesDownloadAnonymous(..)
  , _PersonalisedSheetFilesDownloadAnonymous, _PersonalisedSheetFilesDownloadSurnames, _PersonalisedSheetFilesDownloadMatriculations, _PersonalisedSheetFilesDownloadGroups
  , PersonalisedSheetFilesSeed(..)
  , mkPersonalisedSheetFilesSeed
  , PersonalisedSheetFilesSeedKey
  , derivePersonalisedSheetFilesSeedKey, newPersonalisedSheetFilesSeedKey
  , PersonalisedSheetFilesKeySet(..)
  ) where

import Import.NoModel
import Model.Types.Common (UserIdent)

import Web.HttpApiData (ToHttpApiData, FromHttpApiData)
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA

import Crypto.Hash.Algorithms (SHAKE256)
import qualified Crypto.MAC.KMAC as Crypto
import qualified Crypto.Random as Crypto
import qualified Data.Binary as Binary

import qualified Data.CaseInsensitive as CI

import Data.CryptoID.ByteString (CryptoIDKey)

import Data.Typeable (typeOf)
  
import Data.Binary.Put (putByteString)
import Data.Binary.Get (getByteString)


data PersonalisedSheetFilesDownloadAnonymous
  = PersonalisedSheetFilesDownloadAnonymous
  | PersonalisedSheetFilesDownloadSurnames
  | PersonalisedSheetFilesDownloadMatriculations
  | PersonalisedSheetFilesDownloadGroups
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
  deriving anyclass (Universe, Finite)
nullaryPathPiece ''PersonalisedSheetFilesDownloadAnonymous $ camelToPathPiece' 4

makePrisms ''PersonalisedSheetFilesDownloadAnonymous


newtype PersonalisedSheetFilesSeed = PersonalisedSheetFilesSeed (Digest (SHAKE256 144))
  deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
  deriving newtype ( PersistField
                   , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
                   , Hashable, NFData
                   , ByteArrayAccess
                   , Binary
                   )

newtype PersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey { psfskKeyMaterial :: ByteString }
  deriving (Typeable)
  deriving newtype (ByteArrayAccess)
  
-- | Does not actually show any key material
instance Show PersonalisedSheetFilesSeedKey where
  show = show . typeOf

instance Binary PersonalisedSheetFilesSeedKey where
  put = putByteString . psfskKeyMaterial
  get = PersonalisedSheetFilesSeedKey <$> getByteString 16
  
instance Eq PersonalisedSheetFilesSeedKey where
  (==) = BA.constEq

derivePersistFieldBinary ''PersonalisedSheetFilesSeedKey
deriveJSONBinary ''PersonalisedSheetFilesSeedKey


derivePersonalisedSheetFilesSeedKey :: ByteArrayAccess ba => PersonalisedSheetFilesSeedKey -> ba -> PersonalisedSheetFilesSeedKey
derivePersonalisedSheetFilesSeedKey k = PersonalisedSheetFilesSeedKey . BA.convert . Crypto.kmac @(SHAKE256 128) (enc 'derivePersonalisedSheetFilesSeedKey) k
  where
    enc :: forall a. Binary a => a -> ByteString
    enc = toStrict . Binary.encode

newPersonalisedSheetFilesSeedKey :: Crypto.MonadRandom m => m PersonalisedSheetFilesSeedKey
newPersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey <$> Crypto.getRandomBytes 16
  
mkPersonalisedSheetFilesSeed :: PersonalisedSheetFilesSeedKey
                             -> UserIdent
                             -> PersonalisedSheetFilesSeed
mkPersonalisedSheetFilesSeed k u = PersonalisedSheetFilesSeed . Crypto.kmacGetDigest $ Crypto.kmac (enc 'mkPersonalisedSheetFilesSeed) k (enc $ CI.foldedCase u)
  where
    enc :: forall a. Binary a => a -> ByteString
    enc = toStrict . Binary.encode

data PersonalisedSheetFilesKeySet = PersonalisedSheetFilesKeySet
  { psfksCryptoID :: CryptoIDKey
  , psfksSeed :: Maybe PersonalisedSheetFilesSeedKey 
  } deriving (Show, Typeable)
