Fix duplicate image styles

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

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

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

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

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
 

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"