feat(metadata): replace DiscordAccount with DiscordLink

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 .~

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

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)