From 0eeb78147e19f6bebe201a9349767a3cb1ebd402 Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Sat, 13 Jul 2024 22:53:45 +0200 Subject: [PATCH] Fix duplicate image styles (#44) * Fix image style render * Misc fixes --- Application/Helper/View.hs | 14 ++++++++------ Config/Config.hs | 9 +++++++++ Web/Controller/ImageStyle.hs | 4 ++-- Web/Controller/ParagraphQuotes.hs | 2 +- Web/Controller/Prelude.hs | 2 -- Web/Element/ElementWrap.hs | 2 ++ 6 files changed, 22 insertions(+), 11 deletions(-) diff --git a/Application/Helper/View.hs b/Application/Helper/View.hs index 77d1eaf..7bb88f9 100644 --- a/Application/Helper/View.hs +++ b/Application/Helper/View.hs @@ -11,13 +11,15 @@ import qualified Text.MMark as MMark -- | Sign the image URL to prevent tampering. signImageUrl :: (?context::ControllerContext) => Text -> Int -> Int -> Text -signImageUrl imageUrl width height= case RSA.sign Nothing (Just Hash.Algorithms.SHA256) rsaPrivateKey (cs $ imageUrl <> size) of - Left msg -> error $ "Cannot sign image URL, private key is invalid:" <> show msg - Right signature -> signature |> Base64.encode |> cs - where - size = show width <> "x" <> show height +signImageUrl imageUrl width height= + case RSA.sign Nothing (Just Hash.Algorithms.SHA256) rsaPrivateKey (cs $ imageUrl <> size) of + Left msg -> error $ "Cannot sign image URL, private key is invalid:" <> show msg + Right signature -> signature |> Base64.encode |> cs + where + size = show width ++ "x" ++ show height -renderMarkdown text = case text |> MMark.parse "" of +renderMarkdown text = + case text |> MMark.parse "" of -- On error, render the text as is. Left error -> cs text Right markdown -> MMark.render markdown |> tshow |> preEscapedToHtml \ No newline at end of file diff --git a/Config/Config.hs b/Config/Config.hs index b1e51f9..1255ed4 100644 --- a/Config/Config.hs +++ b/Config/Config.hs @@ -9,6 +9,8 @@ import "cryptonite" Crypto.PubKey.RSA as RSA import Control.Exception (catch) import qualified Data.ByteString as BS import Web.JWT +import qualified IHP.Log as Log +import IHP.Log.Types data RsaKeys = RsaKeys { publicKey :: RSA.PublicKey, privateKey :: RSA.PrivateKey } @@ -29,6 +31,13 @@ config = do (Just privateKey, Just publicKey) -> option $ RsaKeys publicKey privateKey _ -> error "Failed to read RSA keys, please execute from the root of your project: ssh-keygen -t rsa -b 4096 -m PEM -f ./Config/jwtRS256.key && openssl rsa -in ./Config/jwtRS256.key -pubout -outform PEM -out ./Config/jwtRS256.key.pub" + -- Less verbose logs. + logger <- liftIO $ newLogger def + { level = Error + , formatter = withTimeFormatter + } + option logger + readRsaKeyFromFile :: FilePath -> IO BS.ByteString readRsaKeyFromFile path = do diff --git a/Web/Controller/ImageStyle.hs b/Web/Controller/ImageStyle.hs index 33152f3..72d4f7b 100644 --- a/Web/Controller/ImageStyle.hs +++ b/Web/Controller/ImageStyle.hs @@ -10,6 +10,7 @@ import "cryptonite" Crypto.PubKey.RSA.PKCS15 as RSA import "cryptonite" Crypto.Hash.Algorithms as Hash.Algorithms import Config import Data.ByteString.Base64 as Base64 +import qualified Data.UUID as UUID (fromString) instance Controller ImageStyleController where action RenderImageStyleAction { width, height, originalImagePath, signed } = do @@ -23,11 +24,9 @@ instance Controller ImageStyleController where -- Get the original image directory and UUID from the path. let (originalImageDirectory, uuid) = extractDirectoryAndUUID originalImagePath - let imageStylePathDirectory = originalImageDirectory <> "/imageStyles/" <> size let imageStylePath = imageStylePathDirectory <> "/" <> uuid - fileExists <- doesFileExist (cs $ storagePrefix <> imageStylePath) if fileExists @@ -39,6 +38,7 @@ instance Controller ImageStyleController where let options :: StoreFileOptions = def { directory = imageStylePathDirectory , preprocess = applyImageMagick "jpg" ["-resize", cs size <> "^", "-gravity", "center", "-extent", cs size, "-quality", "85%", "-strip"] + , fileName = UUID.fromString (cs uuid) } storedFile <- storeFileFromPath (cs $ storagePrefix <> originalImageDirectory <> "/" <> uuid) options diff --git a/Web/Controller/ParagraphQuotes.hs b/Web/Controller/ParagraphQuotes.hs index 51291be..793beac 100644 --- a/Web/Controller/ParagraphQuotes.hs +++ b/Web/Controller/ParagraphQuotes.hs @@ -5,7 +5,7 @@ import Web.View.ParagraphQuotes.New import Web.View.ParagraphQuotes.Edit instance Controller ParagraphQuotesController where - action NewParagraphQuoteAction { landingPageId } = do + action NewParagraphQuoteAction { .. } = do weight <- getParagraphsCount landingPageId let paragraphQuote = newRecord |> set #landingPageId landingPageId diff --git a/Web/Controller/Prelude.hs b/Web/Controller/Prelude.hs index 517097d..106e039 100644 --- a/Web/Controller/Prelude.hs +++ b/Web/Controller/Prelude.hs @@ -3,8 +3,6 @@ module Web.Controller.Prelude , module Application.Helper.Controller , module IHP.ControllerPrelude , module Generated.Types -, fetchLandingPageWithRecords -, getParagraphsCount ) where diff --git a/Web/Element/ElementWrap.hs b/Web/Element/ElementWrap.hs index 7ac0c3b..5d5a37f 100644 --- a/Web/Element/ElementWrap.hs +++ b/Web/Element/ElementWrap.hs @@ -24,6 +24,7 @@ wrapBackgroundColor color paddingType element = case color of ColorTransparent -> "bg-transparent" Blue100 -> "bg-blue-100" + Gray100 -> "bg-gray-100" Gray300 -> "bg-gray-300" Gray500 -> "bg-gray-500" Gray900 -> "bg-gray-900" @@ -355,6 +356,7 @@ wrapTextColor color element = case color of ColorTransparent -> "text-transparent" Blue100 -> "text-blue-200" + Gray100 -> "text-gray-100" Gray300 -> "text-gray-300" Gray500 -> "text-gray-500" Gray900 -> "text-gray-900"