-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Lorentz.Contracts.Upgradeable.Common.Doc
  ( DUpgradeability (..)
  , UpgradeableEntrypointsKind
  , contractDoc
  , runDoc
  , runPermDoc
  , upgradeDoc
  , getVersionDoc
  , setAdministratorDoc
  , epwBeginUpgradeDoc
  , epwApplyMigrationDoc
  , epwSetCodeDoc
  , epwSetPermCodeDoc
  , epwFinishUpgradeDoc
  ) where

import Lorentz

import Fmt (Buildable(build))

import Util.Markdown

data DUpgradeability = DUpgradeability Markdown

instance DocItem DUpgradeability where
  docItemPos :: Natural
docItemPos = Natural
112
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Contract upgradeability"
  docItemToMarkdown :: HeaderLevel -> DUpgradeability -> Markdown
docItemToMarkdown HeaderLevel
_ (DUpgradeability Markdown
txt) = Markdown -> Markdown
forall p. Buildable p => p -> Markdown
build Markdown
txt

-- | Common marker for upgradeable, or /virtual/, entrypoints.
-- Can be used when each upgradeable entrypoint is simple,
-- i.e. does not itself consist of multiple entrypoints.
data UpgradeableEntrypointsKind

instance EntrypointKindHasDoc UpgradeableEntrypointsKind where
  entrypointKindPos :: Natural
entrypointKindPos = Natural
1050
  entrypointKindSectionName :: Text
entrypointKindSectionName = Text
"Top-level entrypoints of upgradeable contract"
  entrypointKindSectionDescription :: Maybe Markdown
entrypointKindSectionDescription = Markdown -> Maybe Markdown
forall a. a -> Maybe a
Just
    Markdown
"These entrypoints may change in new versions of the contract.\n\n\
    \Also they have a special calling routing, see the respective subsection \
    \in every entrypoint description."


contractDoc :: Markdown
contractDoc :: Markdown
contractDoc = [md|
  This contract uses upgradeability approach described [here](https://gitlab.com/morley-framework/morley/-/blob/a30dddb633ee880761c3cbf1d4a69ee040ffad25/docs/upgradeableContracts.md#section-2-administrator-forced-upgrades).
  This mechanism provides adminstrator-forced address-preserving upgradeability
  approach. For more information check out the doc referenced earlier.
  |]

runDoc :: Markdown
runDoc :: Markdown
runDoc =
  Markdown
"This entrypoint extracts contract code kept in storage under the \
  \corresponding name and executes it on an argument supplied via `UParam`."

runPermDoc :: Markdown
runPermDoc :: Markdown
runPermDoc =
  Markdown
"Similar to `Run` entrypoint, but calls permanent entrypoints - ones \
  \that will be present in all versions of the contract."

upgradeDoc :: Markdown
upgradeDoc :: Markdown
upgradeDoc = [md|
  This entry point is used to update the contract to a new version.
  Consider using this entrypoint when your upgrade to the new version isn't very large,
  otherwise, transaction with this entrypoint call won't fit instruction size limit.
  If this is your case, consider using entrypoint-wise upgrade. This entrypoint
  basically exchange `code` field in the storage and upgrade `dataMap` using
  provided migration lambda.
  |]

getVersionDoc :: Markdown
getVersionDoc :: Markdown
getVersionDoc =
  Markdown
"This entry point is used to get contract version."

setAdministratorDoc :: Markdown
setAdministratorDoc :: Markdown
setAdministratorDoc =
  Markdown
"This entry point is used to set the administrator address."

epwBeginUpgradeDoc :: Markdown
epwBeginUpgradeDoc :: Markdown
epwBeginUpgradeDoc =
  Markdown
"This entry point is used to start an entrypoint wise upgrade of the contract."

epwApplyMigrationDoc :: Markdown
epwApplyMigrationDoc :: Markdown
epwApplyMigrationDoc =
  Markdown
"This entry point is used to apply a storage migration script as part of an upgrade."

epwSetCodeDoc :: Markdown
epwSetCodeDoc :: Markdown
epwSetCodeDoc =
  Markdown
"This entry point is used to set the dispatching code that calls the packed entrypoints."

epwSetPermCodeDoc :: Markdown
epwSetPermCodeDoc :: Markdown
epwSetPermCodeDoc =
  Markdown
"Similar to `EpwSetCode`, but refers to permanent entrypoints - ones \
  \that will be present in all versions of the contract."

epwFinishUpgradeDoc :: Markdown
epwFinishUpgradeDoc :: Markdown
epwFinishUpgradeDoc =
  Markdown
"This entry point is used to mark that an upgrade has been finsihed."