Fix Arbitrary instances and enable corresponding roundtrip tests

libs/types-common/src/Data/Misc.hs

@@ -76,7 +76,7 @@ import qualified Data.Swagger.Build.Api as Doc
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Imports
-import Test.QuickCheck (Arbitrary (arbitrary))
+import Test.QuickCheck (Arbitrary (arbitrary), chooseInteger)
 import qualified Test.QuickCheck as QC
 import Text.Read (Read (..))
 import URI.ByteString hiding (Port)
@@ -220,7 +220,12 @@ newtype Milliseconds = Ms
   { ms :: Word64
   }
   deriving stock (Eq, Ord, Show, Generic)
-  deriving newtype (Num, Arbitrary)
+  deriving newtype (Num)
+
+-- only generate values which can be represented exactly by double
+-- precision floating points
+instance Arbitrary Milliseconds where
+  arbitrary = Ms . fromIntegral <$> chooseInteger (0 :: Integer, 2 ^ (53 :: Int))
 
 -- | Convert milliseconds to 'Int64', with clipping if it doesn't fit.
 msToInt64 :: Milliseconds -> Int64

libs/wire-api/src/Wire/API/Asset/V3.hs

@@ -65,13 +65,13 @@ import Data.ByteString.Builder
 import Data.ByteString.Conversion
 import qualified Data.ByteString.Lazy as LBS
 import Data.Id
-import Data.Json.Util (toUTCTimeMillis, (#))
+import Data.Json.Util (UTCTimeMillis (fromUTCTimeMillis), toUTCTimeMillis, (#))
 import Data.Text.Ascii (AsciiBase64Url)
 import qualified Data.Text.Encoding as T
 import Data.Time.Clock
 import qualified Data.UUID as UUID
 import Imports
-import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
+import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..))
 
 --------------------------------------------------------------------------------
 -- Asset
@@ -83,7 +83,12 @@ data Asset = Asset
     _assetToken :: Maybe AssetToken
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform Asset)
+
+-- Generate expiry time with millisecond precision
+instance Arbitrary Asset where
+  arbitrary = Asset <$> arbitrary <*> (fmap milli <$> arbitrary) <*> arbitrary
+    where
+      milli = fromUTCTimeMillis . toUTCTimeMillis
 
 mkAsset :: AssetKey -> Asset
 mkAsset k = Asset k Nothing Nothing

libs/wire-api/src/Wire/API/Asset/V3/Resumable.hs

@@ -46,10 +46,10 @@ import Control.Lens (makeLenses)
 import Data.Aeson
 import Data.Aeson.Types
 import Data.ByteString.Conversion
-import Data.Json.Util (toUTCTimeMillis, (#))
+import Data.Json.Util (UTCTimeMillis (fromUTCTimeMillis), toUTCTimeMillis, (#))
 import Data.Time.Clock
 import Imports
-import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
+import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..))
 import Wire.API.Asset.V3
 
 --------------------------------------------------------------------------------
@@ -115,7 +115,11 @@ data ResumableAsset = ResumableAsset
     _resumableChunkSize :: ChunkSize
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform ResumableAsset)
+
+instance Arbitrary ResumableAsset where
+  arbitrary = ResumableAsset <$> arbitrary <*> (milli <$> arbitrary) <*> arbitrary
+    where
+      milli = fromUTCTimeMillis . toUTCTimeMillis
 
 makeLenses ''ResumableAsset
 

libs/wire-api/src/Wire/API/Conversation/Member.hs

@@ -272,8 +272,10 @@ instance FromJSON MemberUpdate where
 
 instance Arbitrary MemberUpdate where
   arbitrary =
-    (getGenericUniform <$> arbitrary)
+    (removeMuteStatus . getGenericUniform <$> arbitrary)
       `QC.suchThat` (isRight . validateMemberUpdate)
+    where
+      removeMuteStatus mup = mup {mupOtrMuteStatus = Nothing}
 
 validateMemberUpdate :: MemberUpdate -> Either String MemberUpdate
 validateMemberUpdate u =
@@ -298,7 +300,9 @@ data OtherMemberUpdate = OtherMemberUpdate
   { omuConvRoleName :: Maybe RoleName
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform OtherMemberUpdate)
+
+instance Arbitrary OtherMemberUpdate where
+  arbitrary = OtherMemberUpdate . Just <$> arbitrary
 
 modelOtherMemberUpdate :: Doc.Model
 modelOtherMemberUpdate = Doc.defineModel "otherMemberUpdate" $ do

libs/wire-api/src/Wire/API/Event/Conversation.hs

@@ -67,7 +67,7 @@ import Data.Aeson
 import Data.Aeson.Types (Parser)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Id
-import Data.Json.Util (ToJSONObject (toJSONObject), toUTCTimeMillis, (#))
+import Data.Json.Util (ToJSONObject (toJSONObject), UTCTimeMillis (fromUTCTimeMillis), toUTCTimeMillis, (#))
 import qualified Data.Swagger.Build.Api as Doc
 import Data.Time
 import Imports
@@ -149,8 +149,10 @@ instance Arbitrary Event where
     Event typ
       <$> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> (milli <$> arbitrary)
       <*> genEventData typ
+    where
+      milli = fromUTCTimeMillis . toUTCTimeMillis
 
 data EventType
   = MemberJoin

libs/wire-api/src/Wire/API/Message.hs

@@ -49,7 +49,7 @@ import Data.Json.Util
 import qualified Data.Swagger.Build.Api as Doc
 import Data.Time
 import Imports
-import Wire.API.Arbitrary (Arbitrary, GenericUniform (..))
+import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..))
 import Wire.API.User.Client (UserClientMap (..), UserClients (..), modelOtrClientMap, modelUserClients)
 
 --------------------------------------------------------------------------------
@@ -199,7 +199,13 @@ data ClientMismatch = ClientMismatch
     deletedClients :: UserClients
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform ClientMismatch)
+
+instance Arbitrary ClientMismatch where
+  arbitrary =
+    ClientMismatch
+      <$> (milli <$> arbitrary) <*> arbitrary <*> arbitrary <*> arbitrary
+    where
+      milli = fromUTCTimeMillis . toUTCTimeMillis
 
 modelClientMismatch :: Doc.Model
 modelClientMismatch = Doc.defineModel "ClientMismatch" $ do

libs/wire-api/src/Wire/API/Team.hs

@@ -80,6 +80,7 @@ import Data.Misc (PlainTextPassword (..))
 import Data.Range
 import qualified Data.Swagger.Build.Api as Doc
 import Imports
+import Test.QuickCheck.Gen (suchThat)
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
 import Wire.API.Team.Member (TeamMember, modelTeamMember)
 
@@ -283,7 +284,13 @@ data TeamUpdateData = TeamUpdateData
     _iconKeyUpdate :: Maybe (Range 1 256 Text)
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform TeamUpdateData)
+
+instance Arbitrary TeamUpdateData where
+  arbitrary = arb `suchThat` valid
+    where
+      arb = TeamUpdateData <$> arbitrary <*> arbitrary <*> arbitrary
+      valid (TeamUpdateData Nothing Nothing Nothing) = False
+      valid _ = True
 
 modelUpdateData :: Doc.Model
 modelUpdateData = Doc.defineModel "TeamUpdateData" $ do

libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs

@@ -22,7 +22,6 @@ import Data.Aeson.Types (parseEither)
 import Data.Id (ConvId)
 import Imports
 import qualified Test.Tasty as T
-import Test.Tasty.ExpectedFailure (ignoreTest)
 import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (===))
 import Type.Reflection (typeRep)
 import qualified Wire.API.Asset as Asset
@@ -80,12 +79,12 @@ tests =
       testRoundTrip @Asset.AssetRetention,
       testRoundTrip @Asset.AssetSettings,
       testRoundTrip @Asset.AssetKey,
-      currentlyFailing (testRoundTrip @Asset.Asset), -- because ToJSON is rounding UTCTime
+      testRoundTrip @Asset.Asset,
       testRoundTrip @Asset.Resumable.ResumableSettings,
       testRoundTrip @Asset.Resumable.TotalSize,
       testRoundTrip @Asset.Resumable.ChunkSize,
       testRoundTrip @Asset.Resumable.Offset,
-      currentlyFailing (testRoundTrip @Asset.Resumable.ResumableAsset), -- because ToJSON is rounding UTCTime
+      testRoundTrip @Asset.Resumable.ResumableAsset,
       testRoundTrip @Call.Config.TurnHost,
       testRoundTrip @Call.Config.Scheme,
       testRoundTrip @Call.Config.Transport,
@@ -100,9 +99,9 @@ tests =
       testRoundTrip @Connection.UserConnection,
       testRoundTrip @Connection.UserConnectionList,
       testRoundTrip @Connection.ConnectionUpdate,
-      currentlyFailing (testRoundTrip @Conversation.Conversation), -- flaky, fails for large sizes because of rounding error in cnvMessageTimer
-      currentlyFailing (testRoundTrip @Conversation.NewConvUnmanaged),
-      currentlyFailing (testRoundTrip @Conversation.NewConvManaged),
+      testRoundTrip @Conversation.Conversation,
+      testRoundTrip @Conversation.NewConvUnmanaged,
+      testRoundTrip @Conversation.NewConvManaged,
       testRoundTrip @(Conversation.ConversationList ConvId),
       testRoundTrip @(Conversation.ConversationList Conversation.Conversation),
       testRoundTrip @Conversation.Access,
@@ -114,38 +113,38 @@ tests =
       testRoundTrip @Conversation.ConversationRename,
       testRoundTrip @Conversation.ConversationAccessUpdate,
       testRoundTrip @Conversation.ConversationReceiptModeUpdate,
-      currentlyFailing (testRoundTrip @Conversation.ConversationMessageTimerUpdate),
+      testRoundTrip @Conversation.ConversationMessageTimerUpdate,
       testRoundTrip @Conversation.Bot.AddBot,
-      currentlyFailing (testRoundTrip @Conversation.Bot.AddBotResponse),
-      currentlyFailing (testRoundTrip @Conversation.Bot.RemoveBotResponse),
+      testRoundTrip @Conversation.Bot.AddBotResponse,
+      testRoundTrip @Conversation.Bot.RemoveBotResponse,
       testRoundTrip @Conversation.Bot.UpdateBotPrekeys,
       testRoundTrip @Conversation.Code.ConversationCode,
-      currentlyFailing (testRoundTrip @Conversation.Member.MemberUpdate),
+      testRoundTrip @Conversation.Member.MemberUpdate,
       testRoundTrip @Conversation.Member.MutedStatus,
       testRoundTrip @Conversation.Member.Member,
       testRoundTrip @Conversation.Member.OtherMember,
       testRoundTrip @Conversation.Member.ConvMembers,
-      currentlyFailing (testRoundTrip @Conversation.Member.OtherMemberUpdate),
+      testRoundTrip @Conversation.Member.OtherMemberUpdate,
       testRoundTrip @Conversation.Role.RoleName,
       testRoundTrip @Conversation.Role.Action,
       testRoundTrip @Conversation.Role.ConversationRole,
       testRoundTrip @Conversation.Role.ConversationRolesList,
       testRoundTrip @Conversation.Typing.TypingStatus,
       testRoundTrip @Conversation.Typing.TypingData,
       testRoundTrip @CustomBackend.CustomBackend,
-      currentlyFailing (testRoundTrip @Event.Conversation.Event), -- because ToJSON is rounding UTCTime
+      testRoundTrip @Event.Conversation.Event,
       testRoundTrip @Event.Conversation.EventType,
       testRoundTrip @Event.Conversation.SimpleMember,
       testRoundTrip @Event.Conversation.SimpleMembers,
       testRoundTrip @Event.Conversation.Connect,
       testRoundTrip @Event.Conversation.MemberUpdateData,
       testRoundTrip @Event.Conversation.OtrMessage,
-      currentlyFailing (testRoundTrip @Event.Team.Event), -- flaky, fails because of TeamUpdateData
+      testRoundTrip @Event.Team.Event,
       testRoundTrip @Event.Team.EventType,
       testRoundTrip @Message.Priority,
       testRoundTrip @Message.OtrRecipients,
       testRoundTrip @Message.NewOtrMessage,
-      currentlyFailing (testRoundTrip @Message.ClientMismatch), -- because ToJSON is rounding UTCTime
+      testRoundTrip @Message.ClientMismatch,
       testRoundTrip @Notification.QueuedNotification,
       testRoundTrip @Notification.QueuedNotificationList,
       testRoundTrip @Properties.PropertyKey,
@@ -191,7 +190,7 @@ tests =
       testRoundTrip @Team.TeamBinding,
       testRoundTrip @Team.Team,
       testRoundTrip @Team.TeamList,
-      currentlyFailing (testRoundTrip @Team.TeamUpdateData), -- "no update data specified" if all fields are 'Nothing'
+      testRoundTrip @Team.TeamUpdateData,
       testRoundTrip @Team.TeamDeleteData,
       testRoundTrip @Team.Conversation.TeamConversation,
       testRoundTrip @Team.Conversation.TeamConversationList,
@@ -314,8 +313,6 @@ tests =
       testRoundTrip @User.Search.TeamContact,
       testRoundTrip @(Wrapped.Wrapped "some_int" Int)
     ]
-  where
-    currentlyFailing = ignoreTest
 
 testRoundTrip ::
   forall a.