tests: image tests of the chat flow on a small image, unit test of the crop (#7980)

* tests: profile image from file on a small image, unit test of the crop

* tests: image preview in the chat flow on a small image

tests/ChatTests/Files.hs

@@ -181,12 +181,12 @@ testSendImagePreview =
   testChat2 aliceProfile bobProfile $
     \alice bob -> withXFTPServer alice $ do
       connectUsers alice bob
-      alice ##> "/img @bob ./tests/fixtures/test.jpg"
-      alice <# "/f @bob ./tests/fixtures/test.jpg"
+      alice ##> "/img @bob ./tests/fixtures/logo.jpg"
+      alice <# "/f @bob ./tests/fixtures/logo.jpg"
       alice <## "use /fc 1 to cancel sending"
-      bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
+      bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
       bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
-      alice <## "completed uploading file 1 (test.jpg) for bob"
+      alice <## "completed uploading file 1 (logo.jpg) for bob"
       preview <- lastImagePreview bob 2
       T.length preview `shouldSatisfy` (<= 14000)
       preview `shouldSatisfy` ("data:image/jpg;base64," `T.isPrefixOf`)

tests/ChatTests/Profiles.hs

@@ -1218,7 +1218,7 @@ testSetProfileImageFromFile ps = testChat aliceProfile test ps
     emptyPath = tmp <> "/empty.png"
     test alice = do
       -- set profile image from a .jpg file
-      alice ##> "/set profile image file ./tests/fixtures/test.jpg"
+      alice ##> "/set profile image file ./tests/fixtures/logo.jpg"
       alice <## "profile image updated"
       Profile {image = Just (ImageData img)} <- withCCUser alice $ \User {profile} -> pure $ fromLocalProfile profile
       T.length img `shouldSatisfy` (<= 12500)

tests/ImageTests.hs

@@ -59,6 +59,7 @@ imageTests = do
     it "should scale and sharpen as the research code" testScaleResearch
     it "should keep an image of the same size" testScaleSameSize
     it "should scale transparency in premultiplied alpha" testScaleTransparency
+    it "should crop to the centre square" testCropToSquare
   describe "colour profiles" $ do
     it "should write the Display P3 profile for Display P3 JPEG" testJpegProfile
     it "should write the Display P3 profile for Display P3 PNG" testPngProfile
@@ -333,6 +334,24 @@ testScaleSameSize = do
   imageData (scaleRGB8 rgb (64, 48)) `shouldBe` imageData rgb
   imageData (scaleRGBA8 rgba (64, 48)) `shouldBe` imageData rgba
 
+testCropToSquare :: IO ()
+testCropToSquare = do
+  let pixel :: Int -> Int -> PixelRGB8
+      pixel x y = PixelRGB8 (fromIntegral x) (fromIntegral y) 128
+      rgbaPixel :: Int -> Int -> PixelRGBA8
+      rgbaPixel x y = PixelRGBA8 (fromIntegral x) (fromIntegral y) 128 200
+  ImageRGB8 wide <- pure $ cropToSquare $ ImageRGB8 $ generateImage pixel 7 4
+  imageSize (ImageRGB8 wide) `shouldBe` (4, 4)
+  imageData wide `shouldBe` imageData (generateImage (\x y -> pixel (x + 1) y) 4 4)
+  ImageRGB8 tall <- pure $ cropToSquare $ ImageRGB8 $ generateImage pixel 4 7
+  imageSize (ImageRGB8 tall) `shouldBe` (4, 4)
+  imageData tall `shouldBe` imageData (generateImage (\x y -> pixel x (y + 1)) 4 4)
+  ImageRGBA8 rgba <- pure $ cropToSquare $ ImageRGBA8 $ generateImage rgbaPixel 6 3
+  imageSize (ImageRGBA8 rgba) `shouldBe` (3, 3)
+  imageData rgba `shouldBe` imageData (generateImage (\x y -> rgbaPixel (x + 1) y) 3 3)
+  ImageRGB8 square <- pure $ cropToSquare $ ImageRGB8 $ generateImage pixel 4 4
+  imageData square `shouldBe` imageData (generateImage pixel 4 4)
+
 testScaleTransparency :: IO ()
 testScaleTransparency = do
   let scaled = scaleRGBA8 (generateImage pixel 64 64) (40, 40)