From 5d470373262f1d5a4a0db3739a40a359892ceea3 Mon Sep 17 00:00:00 2001
From: Bogdan Manole <bogdan.manole@iohk.io>
Date: Thu, 21 Sep 2023 12:25:36 +0000
Subject: [PATCH] feat(metadata): replace DiscordAccount with DiscordLink

---
 src/Plutus/Certification/Metadata/Types.hs |  8 +++----
 test/Instances/Persistence.hs              | 25 +++++++++++++++-------
 test/JSONSpec.hs                           |  2 +-
 3 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/src/Plutus/Certification/Metadata/Types.hs b/src/Plutus/Certification/Metadata/Types.hs
index 292b24ad..1e775a25 100644
--- a/src/Plutus/Certification/Metadata/Types.hs
+++ b/src/Plutus/Certification/Metadata/Types.hs
@@ -258,15 +258,15 @@ instance ToSchema CertificationType where
 type GitHubAccount = DB.PatternedText "GitHubAccount"
  "^(?=.{1,39}$)[a-zA-Z0-9]+(-[a-zA-Z0-9]+)*$"
 
-type DiscordAccount = DB.PatternedText "DiscordAccount"
-  "^.{3,32}#[0-9]{4}$"
+type DiscordLink = DB.PatternedText "DiscordLink"
+   "^(?:https?:\\/\\/)?discord(?:\\.gg|app\\.com\\/invite|\\.com\\/invite)\\/[\\w-]+$"
 
 data Social = Social
   { twitter :: !(Maybe DB.Twitter)
   , github :: !(Maybe GitHubAccount)
   , contact :: !DB.Email
   , website :: !DB.Website
-  , discord :: !(Maybe DiscordAccount)
+  , discord :: !(Maybe DiscordLink)
   } deriving (Show, Eq, Generic)
 
 instance ToJSON Social where
@@ -281,7 +281,7 @@ instance ToSchema Social where
     uriSchema <- declareSchemaRef (Proxy :: Proxy DB.Website)
     twitterSchema <- declareSchemaRef (Proxy :: Proxy DB.Twitter)
     githubSchema <- declareSchemaRef (Proxy :: Proxy GitHubAccount)
-    discordSchema <- declareSchemaRef (Proxy :: Proxy DiscordAccount)
+    discordSchema <- declareSchemaRef (Proxy :: Proxy DiscordLink)
     return $ NamedSchema (Just "Social") $ mempty
       & type_ ?~ SwaggerObject
       & properties .~
diff --git a/test/Instances/Persistence.hs b/test/Instances/Persistence.hs
index 3078e745..cce04ad8 100644
--- a/test/Instances/Persistence.hs
+++ b/test/Instances/Persistence.hs
@@ -137,15 +137,24 @@ instance Arbitrary GitHubAccount where
       suffix <- replicateM (len - whereToSplit) (elements alphaNum)
       return $ pack $ prefix ++ (if hasHyphen then "-" else "") ++ suffix
 
-
-instance Arbitrary DiscordAccount where
-  arbitrary = genPatternedTextWith discordAccount
+-- Pattern for Discord ^(?:https?:\/\/)?discord(?:\.gg|app\.com\/invite|\.com\/invite)\/[\w-]+$
+-- Valid examples:
+-- https://discordapp.com/invite/asda
+-- https://discord.com/invite/asda
+-- https://discord.gg/asda
+instance Arbitrary DiscordLink where
+  arbitrary = genPatternedTextWith discordLink
     where
-    discordAccount = do
-      len <- choose (3, 32)
-      prefix <- replicateM len (elements alphaNum)
-      suffix <- replicateM 4 (elements "0123456789")
-      return $ pack $ prefix ++ "#" ++ suffix
+    discordLink = do
+      prefix <- elements ["https://", "http://"]
+      domain <- elements ["discordapp.com", "discord.com", "discord.gg"]
+      invite <- elements ["/invite/"]
+      account <- genDiscordAccount
+      return $ pack $ prefix ++ domain ++ (if domain == "discord.gg" then "/" else invite) ++ account
+      where
+      genDiscordAccount = do
+        len <- choose (1, 15)
+        replicateM len (elements "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
 
 instance Arbitrary Social where
   arbitrary = Social
diff --git a/test/JSONSpec.hs b/test/JSONSpec.hs
index 99b7e8fe..a2bcc0e1 100644
--- a/test/JSONSpec.hs
+++ b/test/JSONSpec.hs
@@ -24,7 +24,7 @@ spec = do
       testJSON' "Email" (na :: Email)
       testJSON' "Subject" (na :: Subject)
       testJSON' "GitHubAccount" (na :: GitHubAccount)
-      testJSON' "DiscordAccount" (na :: DiscordAccount)
+      testJSON' "DiscordLink" (na :: DiscordLink)
       testJSON' "CertificationIssuerName" (na :: CertificationIssuerName)
       testJSON' "ProfileWalletAddress" (na :: ProfileWalletAddress)
       testJSON' "Website" (na :: Website)