-- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel <sarah.vaupel@uniworx.systems>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Foundation.Yesod.StaticContent
  ( addStaticContent
  ) where

import Import.NoFoundation hiding (addStaticContent)

import Foundation.Type

import qualified Database.Memcached.Binary.IO as Memcached

import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Base64.URL as Base64 (encodeUnpadded)
import Data.ByteArray (convert)
import Crypto.Hash (SHAKE256)
import Crypto.Hash.Conduit (sinkHash)
import Data.Bits (Bits(zeroBits))

import qualified Data.Conduit.Combinators as C


addStaticContent :: Text
                 -> Text
                 -> Lazy.ByteString
                 -> HandlerFor UniWorX (Maybe (Either Text (Route UniWorX, [(Text, Text)])))
addStaticContent ext _mime content = do
  UniWorX{appWidgetMemcached, appSettings'} <- getYesod
  for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings') $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConf = MemcachedConf { memcachedExpiry }, widgetMemcachedBaseUrl }) -> do
    let expiry = maybe 0 ceiling memcachedExpiry
        touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn
        addItem = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn
        absoluteLink = unpack widgetMemcachedBaseUrl </> fileName
    catchIf Memcached.isKeyNotFound touch . const $
      handleIf Memcached.isKeyExists (const $ return ()) addItem
    return . Left $ pack absoluteLink
  where
    -- Generate a unique filename based on the content itself, this is used
    -- for deduplication so a collision resistant hash function is required
    --
    -- SHA-3 (SHAKE256) seemed to be a future-proof choice
    --
    -- Length of hash is 144 bits ~~instead of MD5's 128, so as to avoid
    -- padding after base64-conversion~~ for backwards compatibility
    fileName = (<.> unpack ext)
             . unpack
             . decodeUtf8
             . Base64.encodeUnpadded
             . (convert :: Digest (SHAKE256 144) -> ByteString)
             . runConduitPure
             $ C.sourceLazy content .| sinkHash