erc20.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}

import Control.Arrow
import Data.Map (Map)
import qualified Data.Map as Map
import GHC.Base (assert)
import GHC.IO
import System.IO ()

newtype Address = Address String deriving (Eq, Ord, Show)

newtype AddressPayable = AddressPayable String deriving (Eq, Ord, Show)

payable :: Address -> AddressPayable
payable (Address a) = AddressPayable a

type Value = Word

data Context = Context
  { sender :: Address,
    value :: Value
  }

data State = State
  { balances :: Map Address Value,
    allowances :: Map Address (Map Address Value),
    totalSupply :: Value,
    decimals :: Integer,
    name :: String,
    symbol :: String
  }
  deriving (Eq, Show)

data EnvironmentInput = EnvironmentInput
  { context :: Context,
    inState :: State
  }

data EnvironmentOutput = EnvironmentOutput
  { outState :: State,
    logs :: [Event]
  }

type ExecutionResult r = Either String (r, EnvironmentOutput)

data Event = Transfer
  { sender :: Address,
    recipient :: Address,
    amount :: Value
  }
  deriving (Eq, Show)

emit :: Event -> EnvironmentOutput -> EnvironmentOutput
emit e EnvironmentOutput {outState, logs} =
  EnvironmentOutput
    { outState,
      logs = e : logs
    }

constructor :: String -> String -> Context -> EnvironmentOutput
constructor name symbol _ =
  EnvironmentOutput
    { outState =
        State
          { balances = Map.empty,
            allowances = Map.empty,
            totalSupply = 0,
            decimals = 18,
            name,
            symbol
          },
      logs = []
    }

_balanceOf :: Address -> EnvironmentInput -> Value
_balanceOf account EnvironmentInput {inState = State {balances}} =
  Map.findWithDefault 0 account balances

balanceOf :: Address -> EnvironmentInput -> ExecutionResult Value
balanceOf account env =
  Right (_balanceOf account env, EnvironmentOutput {outState = inState env, logs = []})

mint :: Address -> Value -> EnvironmentInput -> ExecutionResult ()
mint (Address "0") _ _ = Left "Zero account"
mint account amount env@EnvironmentInput {inState = state@State {balances}} =
  Right
    ( (),
      emit
        Transfer
          { sender = Address "0",
            recipient = account,
            amount
          }
        EnvironmentOutput
          { outState =
              state
                { balances = Map.insert account (_balanceOf account env + amount) balances,
                  totalSupply = totalSupply state + amount
                },
            logs = []
          }
    )

_uncheckedTransfer :: Address -> Address -> Value -> Map Address Value -> Map Address Value
_uncheckedTransfer sender recipient amount balances =
  let newSenderBalance = Map.findWithDefault 0 sender balances - amount
      newRecipientBalance = Map.findWithDefault 0 recipient balances + amount
   in Map.insert sender newSenderBalance $
        Map.insert recipient newRecipientBalance balances

transfer :: Address -> Value -> EnvironmentInput -> ExecutionResult Bool
transfer (Address "0") _ _ = Left "Zero address"
transfer
  recipient
  amount
  env@EnvironmentInput
    { inState = state@State {balances},
      context = context@Context {sender}
    }
    | senderBalance < amount = Left "Insufficient funds"
    | otherwise =
      Right
        ( True,
          emit
            Transfer
              { sender,
                recipient,
                amount
              }
            EnvironmentOutput
              { outState =
                  state
                    { balances = _uncheckedTransfer sender recipient amount balances
                    },
                logs = []
              }
        )
    where
      senderBalance = _balanceOf sender env

exec :: Show a => (EnvironmentInput -> ExecutionResult a) -> Context -> State -> IO State
exec f context state =
  case f EnvironmentInput {inState = state, context} of
    Left e -> do
      print $ "Error: " ++ show e
      return state
    Right (value, EnvironmentOutput {outState, logs}) ->
      do
        print $ "Value: " ++ show value
        print "Logs:"
        print logs
        return outState

-- execSeq :: Show a => [EnvironmentInput -> (a, EnvironmentOutput)] -> Context -> State -> IO State
-- execSeq (f : fs) context state = do
--   newState <- exec f context state
--   execSeq fs context newState
-- execSeq _ context state = return state

main :: IO ()
main = do
  let
      alice = Address "alice"
      bob = Address "bob"
      context =
        Context
          { sender = alice,
            value = 0
          }
      EnvironmentOutput {outState = state} = constructor "Name" "Symbol" context
   in do
        state <- exec (mint alice 5) context state
        state <- exec (mint bob 10) context state
        state <- exec (balanceOf alice) context state
        state <- exec (balanceOf bob) context state
        return ()