[WIP] Staking rewards calculation

src/Ext/Contract/Value.purs

@@ -11,6 +11,9 @@ import Ctl.Internal.Types.ByteArray (ByteArray(..), byteArrayToHex, hexToByteArr
 import Data.Array (filter) as Array
 import Data.TextDecoder (decodeUtf8)
 
+tokenNameSizeLimit :: Int
+tokenNameSizeLimit = 32
+
 mkTokenName :: String -> Maybe Value.TokenName
 mkTokenName = Value.mkTokenName <=< byteArrayFromAscii
 

src/StakingPool/TokenName.purs

@@ -0,0 +1,57 @@
+module StakingPool.TokenName where
+
+import Contract.Prelude hiding (length)
+
+import Contract.Monad (Contract, liftContractM)
+import Contract.Value as Value
+import Data.BigInt (BigInt, fromString, toString)
+import Data.String (Pattern(..), codePointFromChar, drop, dropWhile, length, stripPrefix, takeWhile)
+import Ext.Contract.Time (TimeStamp)
+import Ext.Contract.Value (mkTokenName, tokenNameSizeLimit, tokenNameToString)
+
+receiptPrefix :: String
+receiptPrefix = "DPStake"
+
+type Receipt =
+  { time :: TimeStamp
+  , amount :: BigInt
+  }
+
+receiptTokenNameString :: Receipt -> Maybe String
+receiptTokenNameString receipt =
+  let
+    tn = receiptPrefix
+      <> toString receipt.time.epoch
+      <> "."
+      <> toString receipt.time.dayOfEpoch
+      <> "."
+      <> toString receipt.amount
+  in
+    if length tn > tokenNameSizeLimit then Nothing else Just tn
+
+receiptTokenName :: Receipt -> Maybe Value.TokenName
+receiptTokenName receipt = receiptTokenNameString receipt >>= mkTokenName
+
+mkReceiptTokenNameM :: Receipt -> Contract Value.TokenName
+mkReceiptTokenNameM =
+  liftContractM "Impossible to make a staking receipt token name" <<< receiptTokenName
+
+parseReceiptTokenName :: Value.TokenName -> Maybe Receipt
+parseReceiptTokenName tokenName = do
+  tokenNameStr <- tokenNameToString tokenName
+  receiptData <- stripPrefix (Pattern receiptPrefix) tokenNameStr
+  let
+    epochStr = takeWhile (\c -> c /= dotPoint) $ receiptData
+    withoutEpoch = drop 1 $ dropWhile (\c -> c /= dotPoint) $ receiptData
+    dayStr = takeWhile (\c -> c /= dotPoint) withoutEpoch
+    amountStr = drop 1 $ dropWhile (\c -> c /= dotPoint) withoutEpoch
+  (parsedEpoch :: BigInt) <- fromString epochStr
+  (parsedDay :: BigInt) <- fromString dayStr
+  (parsedAmt :: BigInt) <- fromString amountStr
+  pure { time: { epoch: parsedEpoch, dayOfEpoch: parsedDay }, amount: parsedAmt }
+  where
+  dotPoint = codePointFromChar '.'
+
+parseReceiptTokenNameM :: Value.TokenName -> Contract Receipt
+parseReceiptTokenNameM =
+  liftContractM "Impossible to parse a staking receipt token name" <<< parseReceiptTokenName

test/Unit/StakingTokenName.purs

@@ -0,0 +1,38 @@
+module Test.Unit.StakingTokenName (suite) where
+
+import Prelude
+
+import Contract.Value as Value
+import Ctl.Internal.Test.TestPlanM (TestPlanM)
+import Data.BigInt (fromInt)
+import Data.Maybe (Maybe(..), isJust)
+import Effect.Aff (Aff)
+import Ext.Contract.Value (mkTokenName)
+import Mote (test)
+import StakingPool.TokenName as StakingPool
+import Test.Utils (assertTrue)
+
+justTokenName :: Maybe Value.TokenName
+justTokenName = mkTokenName "DPStake11.42.99"
+
+parseTokenNameCase :: Maybe StakingPool.Receipt
+parseTokenNameCase = do
+  tn <- justTokenName
+  StakingPool.parseReceiptTokenName tn
+
+receipt :: StakingPool.Receipt
+receipt = { time: { epoch: fromInt 11, dayOfEpoch: fromInt 42 }, amount: (fromInt 99) }
+
+doubleConvertingCase :: Maybe StakingPool.Receipt
+doubleConvertingCase = do
+  tn <- StakingPool.receiptTokenName receipt
+  StakingPool.parseReceiptTokenName tn
+
+suite :: TestPlanM (Aff Unit) Unit
+suite = test "StakingTokenName tests" do
+  assertTrue "Should successfully create TokenName from provided data"
+    (StakingPool.receiptTokenName receipt == justTokenName && isJust justTokenName)
+  assertTrue "Should successfully parse Recept data from provided TokenName"
+    (parseTokenNameCase == Just receipt)
+  assertTrue "Should return same receipt after making tokenName"
+    (doubleConvertingCase == Just receipt)

test/UnitTests.purs

@@ -12,6 +12,7 @@ import Effect.Aff (Aff, cancelWith, effectCanceler, launchAff)
 import Test.Spec.Runner (defaultConfig)
 import Test.Unit.CalcFee as CalcFee
 import Test.Unit.Serialization as Serialization
+import Test.Unit.StakingTokenName as StakingTokenName
 
 -- Run with `spago test --main Test.UnitTests`
 main :: Effect Unit
@@ -25,3 +26,4 @@ testPlan :: TestPlanM (Aff Unit) Unit
 testPlan = do
   CalcFee.suite
   Serialization.suite
+  StakingTokenName.suite