feat: format L1 Certificate compliant with CIP-0096 ( PLT-6087)

client/Main.hs

@@ -32,6 +32,7 @@ import Text.Regex
 import Data.Int
 
 import qualified Data.ByteString.Base16 as Hexa
+import Plutus.Certification.Metadata
 
 
 newtype PublicKey = PublicKey { unPublicKey :: ByteString }
@@ -172,14 +173,88 @@ 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"
+      ))
+
+certificationInputParser :: Parser CertificationInput
+certificationInputParser  = CertificationInput
+  <$> (Subject <$> option str
+      ( long "subject"
+     <> metavar "SUBJECT"
+     <> help "dapp subject"
+      ))
+  <*> 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
@@ -189,8 +264,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
@@ -199,7 +273,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
@@ -572,12 +647,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)) ->

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

@@ -115,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"
@@ -205,7 +201,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,8 +290,7 @@ 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
+  , 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

src/Plutus/Certification/Metadata.hs

@@ -14,6 +14,10 @@ module Plutus.Certification.Metadata
 , createDraftMetadata
 , createMetadataAndPushToIpfs
 , FullMetadata(..)
+, parseURIUnsafe
+, CertificationInput(..)
+, AuditorCertificationInput(..)
+, URL(..)
 ) where
 
 import Plutus.Certification.Metadata.Types as X
@@ -77,22 +81,26 @@ user error (Report URLs do not match)
 Report {reportURLs = [ReportURL {unReportURL = ipfs://bafkreihic53arwawc73rivbnxl3ax2cc26xvd23x67obm5vq33uosdwbcy},ReportURL {unReportURL = https://bafkreihic53arwawc73rivbnxl3ax2cc26xvd23x67obm5vq33uosdwbcy.ipfs.w3s.link}], reportHash = "64663839663138363636393838333631346534613932333265346235643236376337396531346435316266643836383263616661623536396663376433313463"}
 -}
 
-certLevel :: DB.CertificationLevel
-certLevel = DB.L2
+--certLevel :: DB.CertificationLevel
+--certLevel = DB.L2
 
 createOffchainMetadata :: (MonadIO m)
                        => AuditorCertificationInput
+                       -> DB.CertificationLevel
                        -> m OffChainMetadata
-createOffchainMetadata AuditorCertificationInput{..} = do
+createOffchainMetadata AuditorCertificationInput{..} certLevel = do
+  let CertificationInput{..} = certificationInput
   report' <- toReport report
   let certificationLevel = certLevel
   pure OffChainMetadata { report = report', ..}
 
 createOnchainMetadata :: AuditorCertificationInput
                       -> Maybe (OffChainMetadata,[MetadataUrl])
+                      -> DB.CertificationLevel
                       -> OnChainMetadata
-createOnchainMetadata AuditorCertificationInput{..} offchainM =
-  let (rootHash,metadata') = case offchainM of
+createOnchainMetadata AuditorCertificationInput{..} offchainM certLevel =
+  let CertificationInput{..} = certificationInput
+      (rootHash,metadata') = case offchainM of
         Nothing -> (Hash "",[])
         Just (offchain,metadata) ->
           -- hash represents the encoded json of the offchain metadata
@@ -137,20 +145,24 @@ instance ToSchema FullMetadata where
 
 createDraftMetadata :: MonadIO m
                     => AuditorCertificationInput
+                    -> DB.CertificationLevel
                     -> m FullMetadata
-createDraftMetadata input = do
-  offchain <- createOffchainMetadata input
-  let onchain = createOnchainMetadata input Nothing
+createDraftMetadata input certLevel = do
+  offchain <- createOffchainMetadata input certLevel
+  let onchain = createOnchainMetadata input Nothing certLevel
   pure $ FullMetadata (onchain,offchain)
 
 createMetadataAndPushToIpfs :: MonadIO m
                             => AuditorCertificationInput
+                            -> DB.CertificationLevel
                             -> m (FullMetadata,IpfsCid)
-createMetadataAndPushToIpfs input = do
-  offchain <- createOffchainMetadata input
+createMetadataAndPushToIpfs input certLevel = do
+  offchain <- createOffchainMetadata input certLevel
   finalOffchain <- addIpfsToMetadataIfNecessary offchain
   ipfsCid <- uploadToIpfs finalOffchain
-  let onchain = createOnchainMetadata input $ Just (finalOffchain,[toMetadataUrl ipfsCid])
+  let onchain = createOnchainMetadata input
+        (Just (finalOffchain,[toMetadataUrl ipfsCid]))
+        certLevel
   pure (FullMetadata (onchain,finalOffchain),IpfsCid ipfsCid)
   where
   addIpfsToMetadataIfNecessary (offchain :: OffChainMetadata) = do

src/Plutus/Certification/Metadata/Types.hs

@@ -28,12 +28,13 @@ import           Data.Text.Encoding as Text
 import           Data.Vector
 import           Plutus.Certification.Internal
 import           IOHK.Certification.SignatureVerification
-import Network.URI
-import Data.ByteString (ByteString)
-import Control.Monad (when)
+import           Network.URI
+import           Data.ByteString (ByteString)
+import           Control.Monad (when)
 
 import qualified IOHK.Certification.Persistence as DB
 import qualified Data.Swagger.Lens as SL
+import qualified Data.Aeson.KeyMap as KM
 import GHC.OverloadedLabels
 
 --------------------------------------------------------------------------------
@@ -472,22 +473,46 @@ instance ToSchema OffChainMetadata where
 --------------------------------------------------------------------------------
 -- | AUDITOR CERTIFICATION INPUT
 
-data AuditorCertificationInput = AuditorCertificationInput
+data CertificationInput = CertificationInput
   { subject :: Subject
   , certificateIssuer :: CertificateIssuer
-  , report :: [ReportURL]
   , summary :: Text
   , disclaimer :: Text
   , scripts :: [Script]
   } deriving (Generic,Show)
 
+data AuditorCertificationInput = AuditorCertificationInput
+  { certificationInput :: CertificationInput
+  , report :: [ReportURL]
+  } deriving (Generic,Show)
+
 instance ToJSON AuditorCertificationInput where
-  toJSON = genericToJSON defaultOptions
+  toJSON AuditorCertificationInput{..} = Object (x <> y)
+    where
+    x = case toJSON certificationInput of
+            Object obj -> obj
+            _          -> KM.empty
+    y = KM.fromList [ "report" .= report ]
 
 instance FromJSON AuditorCertificationInput where
-  parseJSON = genericParseJSON defaultOptions
+  parseJSON = withObject "AuditorCertificationInput" $ \v -> AuditorCertificationInput
+      <$> parseJSON (Object v)
+      <*> v .:? "report" .!= []
 
 instance ToSchema AuditorCertificationInput where
+  declareNamedSchema _ = do
+    certificationInputSchema <- declareSchema (Proxy :: Proxy CertificationInput)
+    reportSchema <- declareSchemaRef (Proxy :: Proxy [ReportURL])
+    return $ NamedSchema (Just "AuditorCertificationInput") $ certificationInputSchema
+              & properties %~ (`mappend` [ ("report", reportSchema) ])
+
+instance ToJSON CertificationInput where
+  toJSON = genericToJSON defaultOptions
+
+instance FromJSON CertificationInput where
+  parseJSON = genericParseJSON defaultOptions
+
+instance ToSchema CertificationInput where
   declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions