diff --git a/.gitignore b/.gitignore index 8236bc4..618d2d1 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,8 @@ dist-newstyle/ node_modules/ .stack-work/ .ccls-cache/ + +adminpass.txt +secretkey.txt +pubkey.txt +trustedkeys.txt diff --git a/play-haskell-server/example-snippets.txt b/play-haskell-server/example-snippets.txt index b5e09c8..2ccbaf8 100644 --- a/play-haskell-server/example-snippets.txt +++ b/play-haskell-server/example-snippets.txt @@ -1,99 +1,70 @@ -import Data.List (partition) +module Project where +import Control.LinearlyVersionedMonad qualified as LVM +import Prelude.YulDSL + +-- | Ethereum contract is a Yul Object in Yolc. +object = mkYulObject "ERC20" emptyCtor + [ staticFn "balanceOf" erc20_balance_of + , omniFn "mint" erc20_mint + , omniFn "transfer" erc20_transfer + ] + +-- | ERC20 balance storage location for the account. +-- +-- TODO: this code can be made more palatable in the future versions of Yolc. +erc20_balance_storage_of = fn @(ADDR -> B32) $locId $ + \acc -> yulKeccak256 $ + -- shell$ cast keccak "Yolc.Demo.ERC20.Storage.AccountBalance" + (YulEmb (0xc455e3e95e9cd89a306d7619bc5f6406a85b850d31788d0c0fb15e6364be6592 :: U256)) + `YulFork` acc + +balance_ref_of account'p = ver'l $ callFn'lpp erc20_balance_storage_of account'p + +balance_of account'p = sget $ balance_ref_of account'p + +-- | ERC20 balance of the account. +erc20_balance_of = lfn $locId $ yulmonad'p @(ADDR -> U256) + \account'p -> balance_of account'p + +erc20_mint = lfn $locId $ yulmonad'p @(ADDR -> U256 -> ()) + \account'p mintAmount'p -> LVM.do + -- fetch balance of the account + (account'p, balanceBefore) <- pass account'p balance_of + -- use linear port (naming convention, "*'p") values safely + (account'p, mintAmount'p) <- passN_ (account'p, mintAmount'p) \(account'p, mintAmount'p) -> + -- update balance + sput (balance_ref_of account'p) (balanceBefore + ver'l mintAmount'p) + -- call unsafe external contract onTokenMinted + externalCall onTokenMinted (ver'l account'p) (ver'l mintAmount'p) + + -- -- fetch balance of the account + -- (account'p, balanceBefore) <- pass account'p balance_of + -- -- use linear port (naming convention, "*'p") values safely + -- (account'p, mintAmount'p) <- passN_ (account'p, mintAmount'p) \(account'p, mintAmount'p) -> + -- -- call unsafe external contract onTokenMinted + -- externalCall onTokenMinted (ver'l account'p) (ver'l mintAmount'p) + -- -- update balance, but using out dated "balanceBefore value" will fail to compile + -- sput (balance_ref_of account'p) (balanceBefore + ver'l mintAmount'p) + +erc20_transfer = lfn $locId $ yulmonad'p @(ADDR -> ADDR -> U256 -> BOOL) + \from'p to'p amount'p -> LVM.do + -- get sender balance + (from'p, senderBalanceRef) <- pass from'p (ypure . balance_ref_of) + -- get receiver balance + (to'p, receiverBalanceRef) <- pass to'p (ypure . balance_ref_of) + -- calculate new balances + (amount, newSenderBalance) <- pass (ver'l amount'p) + \amount -> ypure $ callFn'l erc20_balance_of (ver'l from'p) - amount + newReceiverBalance <- with amount + \amount -> ypure $ callFn'l erc20_balance_of (ver'l to'p) + amount + -- update storages + sputs $ + senderBalanceRef := newSenderBalance :| + receiverBalanceRef := newReceiverBalance : [] + -- always return true as a silly urban-legendary ERC20 convention + embed true + +-- TODO: to be abstracted in an interface definition +-- +onTokenMinted = declareExternalFn @(U256 -> ()) "onTokenMinted" -main :: IO () -main = do - let unsorted = [10,9..1] - putStrLn $ show $ quicksort unsorted - -quicksort :: Ord a => [a] -> [a] -quicksort [] = [] -quicksort (x:xs) = let (lesser, greater) = partition (<= x) xs - in quicksort lesser ++ [x] ++ quicksort greater - --- ~~~~ CUT - -{-# LANGUAGE OverloadedStrings #-} - -import qualified Data.Text as T -import qualified Data.Time as Time - -data Visitor - = Member Profile - | NonMember (Maybe T.Text) - deriving Show - -data Profile = - Profile - { name :: T.Text - , birthday :: Time.Day - } deriving Show - -main :: IO () -main = do - let haskell = Member Profile - { name = "Haskell Curry" - , birthday = read "1900-09-12" - } - greeting <- makeGreeting haskell - putStrLn $ T.unpack greeting - -makeGreeting :: Visitor -> IO T.Text -makeGreeting visitor = - case visitor of - NonMember maybeName -> - pure $ case maybeName of - Just name -> "Hello, " <> name <> "!" - Nothing -> "Hello, mysterious visitor!" - Member profile -> do - today <- Time.utctDay <$> Time.getCurrentTime - let monthAndDay = (\(_y, m, d) -> (m, d)) . Time.toGregorian - if monthAndDay today == monthAndDay (birthday profile) - then pure $ "Happy birthday, " <> name profile <> "!" - else pure $ "Welcome back, " <> name profile <> "!" - --- ~~~~ CUT - -import Control.Monad (replicateM) -import Data.Foldable (foldl') -import qualified System.Random.Stateful as Rand - -data Drone = Drone - { xPos :: Int - , yPos :: Int - , zPos :: Int - } deriving Show - -data Movement - = Forward | Back | ToLeft | ToRight | Up | Down - deriving (Show, Enum, Bounded) - -main :: IO () -main = do - let initDrone = Drone { xPos = 0, yPos = 100, zPos = 0 } - -- Generate 15 moves randomly - randomMoves <- replicateM 15 $ Rand.uniformEnumM Rand.globalStdGen - let resultDrone = foldl' moveDrone initDrone randomMoves - print resultDrone - -moveDrone :: Drone -> Movement -> Drone -moveDrone drone move = - case move of - Forward -> drone { zPos = zPos drone + 1 } - Back -> drone { zPos = zPos drone - 1 } - ToLeft -> drone { xPos = xPos drone - 1 } - ToRight -> drone { xPos = xPos drone + 1 } - Up -> drone { yPos = yPos drone + 1 } - Down -> drone { yPos = yPos drone - 1 } - --- ~~~~ CUT --- ~~~~ # adapted from @liamzee's https://github.com/haskript/big-book-of-small-haskell-projects/blob/51fd3ac4db30e9df2f14924d66d1469638aed009/35.HexGrid/HexGrid.hs - -main :: IO () -main = putStr $ unlines $ hexagons 12 17 - -hexagons :: Int -> Int -> [String] -hexagons xRepeat yRepeat = - yRepeat `times` [xRepeat `times` "/ \\_" - ,xRepeat `times` "\\_/ "] - where - n `times` l = concat (replicate n l) diff --git a/play-haskell-server/play.mustache b/play-haskell-server/play.mustache index a311d82..a2d460b 100644 --- a/play-haskell-server/play.mustache +++ b/play-haskell-server/play.mustache @@ -3,8 +3,8 @@ - -Haskell Playground + +Yolc Playground