diff --git a/src/Tokenomia/CLI.hs b/src/Tokenomia/CLI.hs index 4c6641f2..1a6c34c2 100644 --- a/src/Tokenomia/CLI.hs +++ b/src/Tokenomia/CLI.hs @@ -143,6 +143,7 @@ recursiveMenu = do ICOWhitelistingNotValid index indexRetrieved -> printLn $ "ICO - Whitelisting not valid index =" <> show index <> " retrieved= " <> show indexRetrieved InvalidTransaction e -> printLn $ "Invalid Transaction : " <> e + InvalidPrivateSale e -> printLn $ "Invalid Private sale input : " <> e ChildAddressNotIndexed w address -> printLn $ "Address not indexed " <> show (w,address) <>", please generate your indexes appropriately") diff --git a/src/Tokenomia/Common/Error.hs b/src/Tokenomia/Common/Error.hs index 8178e572..7363328d 100644 --- a/src/Tokenomia/Common/Error.hs +++ b/src/Tokenomia/Common/Error.hs @@ -40,6 +40,7 @@ data TokenomiaError | ICOWhitelistingNotValid Integer Integer | ICONoValidTxs String | InvalidTransaction String + | InvalidPrivateSale String deriving Show whenNullThrow :: MonadError e m => e -> [a] -> m (NonEmpty a) diff --git a/src/Tokenomia/Vesting/GenerateNative.hs b/src/Tokenomia/Vesting/GenerateNative.hs new file mode 100644 index 00000000..fe030989 --- /dev/null +++ b/src/Tokenomia/Vesting/GenerateNative.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Tokenomia.Vesting.GenerateNative (generatePrivateSaleFiles) where + +import qualified Cardano.Api as Api +import Control.Monad.Except (MonadError (throwError), liftEither) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Reader (MonadReader, asks) +import Data.Aeson (eitherDecodeFileStrict) +import Data.Aeson.TH (defaultOptions, deriveJSON) +import Data.Bifunctor (first) +import Data.Either (lefts) +import Data.Foldable (foldl', traverse_) +import Data.Foldable.Extra (sumOn') +import Data.Kind (Type) +import Data.List.NonEmpty (NonEmpty, nonEmpty, (<|)) +import qualified Data.List.NonEmpty as List.NonEmpty +import qualified Data.Map.NonEmpty as Map.NonEmpty +import Data.Text (Text, unpack) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Numeric.Natural + +import Ledger (Address, POSIXTime (POSIXTime), Slot (Slot, getSlot)) +import Ledger.Value (AssetClass) + +import Tokenomia.Common.Environment (Environment (Mainnet, Testnet, magicNumber), convertToExternalPosix, toSlot) +import Tokenomia.Common.Error (TokenomiaError (InvalidPrivateSale)) +import Tokenomia.TokenDistribution.Parser.Address (serialiseCardanoAddress) + +type Amount = Natural + +data Tranche = Tranche + { percentage :: Natural -- out of 10,000 + , duration :: Integer -- number of slots + } + deriving stock (Show) +$(deriveJSON defaultOptions ''Tranche) + +-- Invariants +-- Σ percentages = 100% +-- Description : Represent Vesting Tranches (Time Sequential and contiguous) + +newtype Tranches = Tranches (NonEmpty Tranche) + deriving stock (Show) + +-- Separate to keep the derived json instance clean +unTranches :: Tranches -> NonEmpty Tranche +unTranches (Tranches x) = x + +$(deriveJSON defaultOptions ''Tranches) + +data PrivateInvestor = PrivateInvestor + -- TODO: Verify the from json instance for this is the longform string addr1..., and not just its raw constructors. If it isn't, use blockfrost's Address and convert + { address :: Address + , allocation :: Amount + } + deriving stock (Show) + +$(deriveJSON defaultOptions ''PrivateInvestor) + +data PrivateSale = PrivateSale + { start :: POSIXTime + , tranches :: Tranches + , assetClass :: AssetClass + , investors :: NonEmpty PrivateInvestor + } + deriving stock (Show) + +$(deriveJSON defaultOptions ''PrivateSale) + +data NativeScript = NativeScript + { pkh :: String + , unlockTime :: Integer + } + deriving stock (Show) + +$(deriveJSON defaultOptions ''NativeScript) + +data LockedFund = LockedFund + { nativeScript :: NativeScript + , asset :: AssetClassSimple + } + deriving stock (Show) + +$(deriveJSON defaultOptions ''LockedFund) + +-- | Simplified AssetClass that serialises to JSON without newtypes over currency symbol and token name +data AssetClassSimple = AssetClassSimple + { currencySymbol :: String -- As hex + , tokenName :: String -- As hex + } + deriving stock (Show) + +$(deriveJSON defaultOptions ''AssetClassSimple) + +-- Map AddressAsText [LockedFund] +type DatabaseOutput = Map Text [LockedFund] + +getNetworkId :: forall (m :: Type -> Type). MonadReader Environment m => m Api.NetworkId +getNetworkId = asks readNetworkId + where + readNetworkId :: Environment -> Api.NetworkId + readNetworkId Mainnet {} = Api.Mainnet + readNetworkId Testnet {magicNumber} = Api.Testnet . Api.NetworkMagic $ fromInteger magicNumber + +parsePrivateSale :: + forall (m :: Type -> Type). + ( MonadIO m + , MonadError TokenomiaError m + ) => + String -> + m PrivateSale +parsePrivateSale path = do + eitherErrPriv <- liftIO . (eitherDecodeFileStrict @PrivateSale) $ path + liftEither $ do + prvSale <- first InvalidPrivateSale eitherErrPriv + validateTranches $ tranches prvSale + pure prvSale + +generatePrivateSaleFiles :: + forall (m :: Type -> Type). + ( MonadIO m + , MonadError TokenomiaError m + , MonadReader Environment m + ) => + m () +generatePrivateSaleFiles = do + liftIO . putStrLn $ "Please enter a filepath with JSON data" + path <- liftIO getLine + + prvSale <- parsePrivateSale path + nativeData <- splitInTranches prvSale + -- Generate DatabaseOutput as `path` with filename as database.json + -- Generate Distribution as `path` with filename as distribution.json + -- AMIR, start here :) + pure () + +assertErr :: String -> Bool -> Either TokenomiaError () +assertErr _ True = Right () +assertErr err _ = Left $ InvalidPrivateSale err + +validateTranches :: Tranches -> Either TokenomiaError () +validateTranches tranches = do + assertErr + ("The sum of all the tranches must be 10000, but we got: " <> show tranchesSum) + $ tranchesSum == 10000 + where + tranchesSum = sumOn' percentage $ unTranches tranches + +mergeInvestors :: NonEmpty PrivateInvestor -> Map.NonEmpty.NEMap Address Amount +mergeInvestors = Map.NonEmpty.fromListWith (+) . (toTuple <$>) + where + toTuple :: PrivateInvestor -> (Address, Amount) + toTuple (PrivateInvestor x y) = (x, y) + +{- | We are taking the floor of the corresponding percentage in all items + except in the last one where we do the corrections to sum the right amount. +-} +splitAmountInTranches :: + Slot -> + Amount -> + Tranches -> + Amount -> + NonEmpty (Slot, Amount) +splitAmountInTranches startSlot total trs acc = + case nonEmpty . List.NonEmpty.tail $ unTranches trs of + Nothing -> pure (nextSlot, total - acc) + Just remainTranches -> + let takenAmount :: Amount + takenAmount = div (total * percentage tranche) 10000 + in (nextSlot, takenAmount) <| splitAmountInTranches nextSlot total (Tranches remainTranches) (acc + takenAmount) + where + tranche :: Tranche + tranche = List.NonEmpty.head $ unTranches trs + nextSlot :: Slot + nextSlot = Slot (duration tranche) + startSlot + +splitInTranches :: + forall (m :: Type -> Type). + ( MonadIO m + , MonadError TokenomiaError m + , MonadReader Environment m + ) => + PrivateSale -> + m (Map.NonEmpty.NEMap Address (NonEmpty (NativeScript, Amount))) +splitInTranches PrivateSale {..} = do + networkId <- getNetworkId + startSlot <- toSlot $ posixSecondsToUTCTime $ convertToExternalPosix start -- change undefined for posix -> utc + let f :: Address -> Amount -> m (NonEmpty (NativeScript, Amount)) + f addr x = traverse (toNative addr) $ splitAmountInTranches startSlot x tranches 0 + + toNative :: Address -> (Slot, Amount) -> m (NativeScript, Amount) + toNative addr (slot, amt) = do + addrStr <- liftEither $ first toAddressError $ serialiseCardanoAddress networkId addr + pure $ (NativeScript (unpack addrStr) $ getSlot slot, amt) + + toAddressError :: Text -> TokenomiaError + toAddressError err = InvalidPrivateSale $ "Failed to serialise address " <> unpack err + + investorsMap :: Map.NonEmpty.NEMap Address Amount + investorsMap = mergeInvestors investors + + Map.NonEmpty.traverseWithKey f investorsMap diff --git a/tokenomia.cabal b/tokenomia.cabal index e356cb30..5dcce6b1 100644 --- a/tokenomia.cabal +++ b/tokenomia.cabal @@ -140,6 +140,7 @@ library Tokenomia.ICO.Funds.Validation.Status Tokenomia.ICO.Funds.Validation.CardanoCLI.Plan Tokenomia.ICO.Funds.Validation.Investor.Plan.Settings + Tokenomia.Vesting.GenerateNative build-depends: base >= 4.9 && < 5, Cabal,