feat: format Test-Runs certificate compliant with CIP-0096 ( PLT-6087)

client/Main.hs

@@ -33,7 +33,7 @@ import Data.Int
 
 import qualified Data.ByteString.Base16 as Hexa
 import GHC.TypeLits (KnownSymbol)
-
+import Plutus.Certification.Metadata
 
 newtype PublicKey = PublicKey { unPublicKey :: ByteString }
 newtype JWT = JWT { unJWT :: ByteString }
@@ -173,14 +173,90 @@ createCertificationParser :: Parser CreateCertificationArgs
 createCertificationParser = CreateCertificationArgs
   <$> getRunParser
   <*> authParser
+  <*> certificationInputParser
+  -- dry-run
+  <*> optional (switch
+      ( long "dry-run"
+      <> help "dry run"
+      ))
+
+certificationIssuerParser :: Parser CertificateIssuer
+certificationIssuerParser  = CertificateIssuer
+  -- name
+  <$> option str
+      ( long "issuer-name"
+      <> metavar "ISSUER-NAME"
+      <> help "issuer name"
+      )
+  -- URL
+  <*> optional ( URL <$> option str
+      ( long "issuer-url"
+      <> metavar "ISSUER-URL"
+      <> help "issuer URL"
+      ))
+  <*> parseSocial
+
+parseSocial :: Parser Social
+parseSocial = Social
+  <$> optional ( option str
+      ( long "twitter"
+      <> metavar "TWITTER"
+      <> help "twitter handle"
+      ))
+  <*> optional ( option str
+      ( long "github"
+      <> metavar "GITHUB"
+      <> help "github handle"
+      ))
+  <*> option str
+      ( long "contact"
+      <> metavar "CONTACT"
+      <> help "contact email"
+      )
+  <*> option str
+      ( long "website"
+      <> metavar "WEBSITE"
+      <> help "website URL"
+      )
+  <*> optional ( option str
+      ( long "discord"
+      <> metavar "DISCORD"
+      <> help "discord handle"
+      ))
+
+subjectInputParser :: Parser Subject
+subjectInputParser = option patternedTextReader
+  ( long "subject"
+  <> metavar "SUBJECT"
+  <> help "dapp subject"
+  )
+
+certificationInputParser :: Parser CertificationInput
+certificationInputParser  = CertificationInput
+  <$> certificationIssuerParser
+  <*> option str
+      ( long "summary"
+      <> metavar "SUMMARY"
+      <> help "dapp summary"
+      )
+  -- disclaimer optional
+  <*> option str
+      ( long "disclaimer"
+      <> metavar "DISCLAIMER"
+      <> help "dapp disclaimer"
+      <> value Text.empty
+      )
+  -- TODO: add scripts
+  <*> pure []
+
+
 
 data RunCommand
   = Create !CreateRunArgs
   | Get !RunIDV1
   | Abort !AbortRunArgs
   | GetLogs !GetLogsArgs
   | GetRuns !GetRunsArgs
-  | GetCertification !RunIDV1
   | CreateCertification !CreateCertificationArgs
 
 runCommandParser :: Parser RunCommand
@@ -190,8 +266,7 @@ runCommandParser = hsubparser
  <> command "abort" (Abort <$> abortRunInfo)
  <> command "get-logs" (GetLogs <$> getLogsInfo)
  <> command "get-many" (GetRuns <$> getRunsInfo)
- <> command "get-certification" (GetCertification <$> getCertificationInfo)
- <> command "create-certification" (CreateCertification <$> createCertificationInfo)
+ <> command "create-l1-certification" (CreateCertification <$> createCertificationInfo)
   )
 
 data CreateRunArgs = CreateRunArgs !CommitOrBranch !Auth
@@ -200,7 +275,8 @@ data GetRunsArgs = GetRunsArgs !Auth !(Maybe UTCTime) !(Maybe Int)
 
 type DeleteRun = Maybe Bool
 data AbortRunArgs = AbortRunArgs !RunIDV1 !Auth !DeleteRun
-data CreateCertificationArgs= CreateCertificationArgs !RunIDV1 !Auth
+type DryRun = Maybe Bool
+data CreateCertificationArgs= CreateCertificationArgs !RunIDV1 !Auth !CertificationInput !DryRun
 
 data GetLogsArgs = GetLogsArgs
   { runId :: !RunIDV1
@@ -274,6 +350,7 @@ dappParser = DApp (toId 0)
        <> help "dapp version"
         )
   <*> optional gitHubAccessTokenParser
+  <*> optional subjectInputParser
 
 profileBodyParser :: Parser ProfileBody
 profileBodyParser = ProfileBody
@@ -592,12 +669,11 @@ main = do
       handle $ apiClient.getLogs ref zt act
     CmdRun (GetRuns (GetRunsArgs pubKey after' count')) ->
       withAuth pubKey $ \c authKey -> c.getRuns authKey after' count'
-    CmdRun (GetCertification ref) ->
-      handle $ apiClient.getCertification ref
     CmdGetRepositoryInfo (GetGitHubAddressArgs owner' repo' gitHubAccessToken') ->
       handle $ apiClient.getRepositoryInfo owner' repo' gitHubAccessToken'
-    CmdRun (CreateCertification (CreateCertificationArgs ref auth)) ->
-      withAuth auth $ \c authKey -> True <$ c.createCertification authKey ref
+    CmdRun (CreateCertification (CreateCertificationArgs ref auth certInput dryRun)) ->
+      withAuth auth $ \c authKey ->
+        c.createCertification authKey ref certInput dryRun
     CmdCurrentProfile (GetCurrentProfile auth) ->
       withAuth auth $ \c authKey -> c.getCurrentProfile authKey
     CmdCurrentProfile (UpdateCurrentProfile (UpdateCurrentProfileArgs auth profileBody)) -> do

dapps-certification-persistence/src/IOHK/Certification/Persistence/Pattern.hs

@@ -14,6 +14,7 @@ module IOHK.Certification.Persistence.Pattern
 , Website
 , Email
 , ProfileWalletAddress
+, Subject
 , mkPatternedText
 , match
 , getPattern
@@ -111,5 +112,8 @@ type Email = PatternedText "Email" "^[A-Z0-9a-z._%+-]+@[A-Za-z0-9.-_]+\\.[A-Za-z
 
 type Website = PatternedText "Website"
   "^(https?:\\/\\/)?(www\\.)?[-a-zA-Z0-9@:%._\\+~#=]{1,255}\\.[a-z]{2,6}(\\b([-a-zA-Z0-9@:%_\\+.~#()?&\\/\\/=]*))?$"
+
 type ProfileWalletAddress = PatternedText "ProfileWalletAddress"
   "^(addr_test1|addr1|stake|stake_test1)[a-zA-Z0-9]{53,}$"
+
+type Subject = PatternedText "Subject" "^[A-Za-z0-9_]{1,64}$"

dapps-certification-persistence/src/IOHK/Certification/Persistence/Structure.hs

@@ -39,6 +39,7 @@ import           IOHK.Certification.Interface
   , ghAccessTokenFromText
   )
 
+import qualified Data.Swagger.Lens as SL
 import qualified Data.Text         as Text
 import qualified Data.Aeson.KeyMap as KM
 
@@ -205,13 +206,15 @@ instance ToSchema ProfileDTO where
 
 --------------------------------------------------------------------------------
 -- | Dapp
+
 data DApp = DApp
   { dappId      :: ID Profile
   , dappName    :: Text
   , dappOwner   :: Text
   , dappRepo    :: Text
   , dappVersion :: Text
   , dappGitHubToken :: Maybe GitHubAccessToken
+  , dappSubject :: Maybe Subject
   } deriving (Generic,Show,Eq)
 
 instance ToSchema DApp where
@@ -226,6 +229,7 @@ instance ToSchema DApp where
           , ("repo", textSchema)
           , ("version", textSchema)
           , ("githubToken", ghTokenSchema)
+          , ("subject", textSchema)
           ]
       & required .~ ["name", "owner", "repo", "version"]
 
@@ -237,6 +241,7 @@ instance FromJSON DApp where
     <*> v .: "repo"
     <*> v .: "version"
     <*> v .:? "githubToken"
+    <*> v .:? "subject"
 
 instance ToJSON DApp where
   toJSON (DApp{..}) = object
@@ -245,6 +250,7 @@ instance ToJSON DApp where
       , "repo" .= dappRepo
       , "version" .= dappVersion
       , "githubToken" .= dappGitHubToken
+      , "subject" .= dappSubject
       ]
 
 instance SqlType GitHubAccessToken where

dapps-certification-persistence/src/IOHK/Certification/Persistence/Structure/Certification.hs

@@ -51,24 +51,24 @@ instance SqlType CertificationLevel where
 
 instance ToJSON CertificationLevel where
   toJSON = toJSON . \case
-    L0 -> "l0" :: String
-    L1 -> "l1"
-    L2 -> "l2"
-    L3 -> "l3"
+    L0 -> 0 :: Int
+    L1 -> 1
+    L2 -> 2
+    L3 -> 3
 
 instance FromJSON CertificationLevel where
-  parseJSON = withText "CertificationLevel" $ \case
-    "l0" -> pure L0
-    "l1" -> pure L1
-    "l2" -> pure L2
-    "l3" -> pure L3
+  parseJSON = withScientific "CertificationLevel" $ \case
+    0 -> pure L0
+    1 -> pure L1
+    2 -> pure L2
+    3 -> pure L3
     _    -> fail "CertificationLevel"
 
 instance ToSchema CertificationLevel where
    declareNamedSchema _ = do
-     let values = [ "l0", "l1", "l2", "l3" ] :: [Value]
+     let values = [Number x | x <- [0,1,2,3]] :: [Value]
      return $ NamedSchema (Just "CertificationLevel") $ mempty
-       & type_ ?~ SwaggerString
+       & type_ ?~ SwaggerNumber
        & enum_ ?~ values
 
 data Certification = Certification

dapps-certification-persistence/src/IOHK/Certification/Persistence/Structure/Run.hs

@@ -76,7 +76,7 @@ data Run = Run
   , runStatus           :: Status
   , profileId           :: ID Profile
   , certificationPrice  :: CertificationPrice
-  , reportContentId :: Maybe Text
+  , reportContentId     :: Maybe Text
   } deriving (Generic,Show)
 
 instance ToSchema Status where

src/Plutus/Certification/API/Routes.hs

@@ -14,7 +14,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -53,7 +52,6 @@ import qualified Data.Swagger.Lens as SL
 import qualified IOHK.Certification.Persistence as DB
 import qualified IOHK.Cicero.API.Run as Cicero.Run (RunLog(..))
 import qualified Data.Aeson.KeyMap as KM
-import Data.Either (fromRight)
 
 type API (auth :: Symbol)  = NamedRoutes (NamedAPI auth)
 
@@ -117,18 +115,14 @@ type UpdateCurrentProfileRoute (auth :: Symbol) = "profile"
   :> ReqBody '[JSON] ProfileBody
   :> Put '[JSON] DB.ProfileDTO
 
-type CreateCertificationRoute (auth :: Symbol) = "run"
+type CreateL1CertificationRoute (auth :: Symbol) = "run"
   :> Description "Store the L1 Report into IPFS and broadcasts the Certificate onchain"
   :> AuthProtect auth
   :> Capture "id" RunIDV1
   :> "certificate"
-  :> PostNoContent
-
-type GetCertificateRoute = "run"
-  :> Description "Get the L1 IPFS CID and the transaction id of the onchain stored Certificate"
-  :> Capture "id" RunIDV1
-  :> "certificate"
-  :> Get '[JSON] DB.L1CertificationDTO
+  :> ReqBody '[JSON] CertificationInput
+  :> QueryParam "dry-run" Bool
+  :> Post '[JSON] Metadata.FullMetadata
 
 type GetBalanceRoute (auth :: Symbol) = "profile"
   :> Description "Get the current balance of the profile"
@@ -214,7 +208,7 @@ type GetAdaUsdPriceRoute = "ada-usd-price"
   :> Get '[JSON] DB.AdaUsdPrice
 
 type CreateAuditorReport (auth :: Symbol) = "auditor"
-  :> Description "Get the available tiers"
+  :> Description "Get the L2 report"
   :> "reports"
   :> QueryParam "dry-run" Bool
   :> ReqBody '[JSON] Metadata.AuditorCertificationInput
@@ -294,9 +288,8 @@ data NamedAPI (auth :: Symbol) mode = NamedAPI
   , getRuns :: mode :- GetRunsRoute auth
   , getCurrentProfile :: mode :- GetCurrentProfileRoute auth
   , updateCurrentProfile :: mode :- UpdateCurrentProfileRoute auth
-  , createCertification :: mode :- CreateCertificationRoute auth
-  , getCertification :: mode :- GetCertificateRoute
   , getProfileWalletAddress :: mode :- GetProfileWalletAddressRoute auth
+  , createCertification :: mode :- CreateL1CertificationRoute auth
   , walletAddress :: mode :- WalletAddressRoute
   , getProfileBalance :: mode :- GetBalanceRoute auth
   , getRunDetails :: mode :- GetRunDetailsRoute

src/Plutus/Certification/API/Swagger.hs

@@ -37,8 +37,7 @@ type UnnamedApi (auth :: Symbol)
   :<|> GetRunDetailsRoute
   :<|> GetCurrentProfileRoute auth
   :<|> UpdateCurrentProfileRoute auth
-  :<|> CreateCertificationRoute auth
-  :<|> GetCertificateRoute
+  :<|> CreateL1CertificationRoute auth
   :<|> GetBalanceRoute auth
   :<|> WalletAddressRoute
   :<|> GitHubRoute