{-# LANGUAGE ExistentialQuantification #-}

-- | A simple model of HashFlare.io services

module Data.HashFlare
  (
    MEFTable, makeMEFTable
  , PayoutTable, makePayoutTable
  , MiningContract, makeMiningContract, makeMiningContractSimple
  , UserAccount, makeUserAccount
  , contractHashrate
  , contractCost
  , contractExpiration
  , contractMEF
  , contractPayout
  , accountBalance
  , accountContracts
  , userAccountMEF
  , userAccountPayout
  , infoUserAccount

  , defaultMEFTable
  )
    where

import           Data.Money
import           Data.Hashrate
import qualified Data.Map as M
import           Data.Typeable

{-
  Payments do NOT include the cryptocurrency's network difficulty,
   so a constant earning value (an actual payout) is used: e.g. BTC for the H/s.
  TODO: somehow reflect the diffculty.
  TODO: Read instances?
-}

-- | HashFlare.io mining contract
data MiningContract = forall a. (MiningAlgorithm a) => MiningContract
  { contractHashrate :: Hashrate a
  -- ^ Hashrate provided by the contract
  , contractCost :: Money USD
  -- ^ Base cost of the contract
  , contractExpiration :: Int
  -- ^ Contract expiration, in days (or 0 for n/a)
  }

-- | Construct a new mining contract with hashrate, cost and expiration days
makeMiningContract :: (MiningAlgorithm a) => Hashrate a -> Money USD -> Int -> MiningContract
makeMiningContract = MiningContract

-- | Make the contract without costs and expiration (suppose you didn't invest your money..)
makeMiningContractSimple :: (MiningAlgorithm a) => Hashrate a -> MiningContract
makeMiningContractSimple h = makeMiningContract h (makeUSD 0) 0

instance Show MiningContract where
  show (MiningContract h c e) = "MiningContract "
    ++ "{contractHashrate = " ++ show h ++ ", "
    ++ "contractCost = " ++ show c ++ ", "
    ++ "contractExpiration = " ++ show e ++ "}"

-- | HashFlare.io account
data UserAccount = UserAccount
  { accountBalance :: Money BTC
  -- ^ Current account balance (in Bitcoins)
  , accountContracts :: [MiningContract]
  -- ^ List of current mining contracts
  }

instance Show UserAccount where
  show (UserAccount m cs) = "UserAccount {"
    ++ "accountBalance = " ++ show m ++ ", "
    ++ "accountContracts = " ++ show cs ++ "}"


-- | Construct a new HashFlare.io user account model with start balance and the list of mining contracts
makeUserAccount :: Money BTC -> [MiningContract] -> UserAccount
makeUserAccount = UserAccount

-- | Summarize all of the payouts for the account's contracts (XXX they may come in different cryptocurrencies or BTC only??)
userAccountPayouts :: PayoutTable -> UserAccount -> [Money BTC]
userAccountPayouts t (UserAccount _ cs) = map (contractPayout t) cs

-- | Total payout for the account
userAccountPayout :: PayoutTable -> UserAccount -> Money BTC
userAccountPayout t = (foldr (\m ma -> m ^+^ ma) (makeBTC 0)) . (userAccountPayouts t)

-- | Summarize all of the MEF for the account's contracts
userAccountMEFs :: MEFTable -> UserAccount -> [Money USD]
userAccountMEFs t (UserAccount _ cs) = map (contractMEF t) cs

-- | Total MEF for the account (in USD)
userAccountMEF :: MEFTable -> UserAccount -> Money USD
userAccountMEF t = (foldr (\m ma -> m ^+^ ma) (makeUSD 0)) . (userAccountMEFs t)


-- | Pretty-print info on the user account
infoUserAccount :: UserAccount -> String
infoUserAccount (UserAccount m cs) = "HashFlare.io account, balance = " ++ show (amount m) ++ " BTC, contracts = " ++ show (length cs) ++ "\n"
  ++ "Total SHA256 hashrate = " ++ show (sha256r / tera) ++ " TH/s\n"
  ++ "Total Scrypt hashrate = " ++ show (scryptr / mega) ++ " MH/s\n"  
  ++ "Total ETHASH hashrate = " ++ show (ethashr) ++ " H/s\n"
  ++ "Total X11 hashrate = " ++ show (x11r) ++ " H/s\n"  
  ++ "Total EQUIHASH hashrate = " ++ show (equihashr ) ++ " H/s\n"
  where hs = map (\(MiningContract h _ _) -> (typeOf (algorithm h), rate h)) cs
        algosum algo = sum $ map snd $ filter (\talr -> fst talr == algo) hs
        sha256r = algosum $ typeOf SHA256
        scryptr = algosum $ typeOf Scrypt
        ethashr = algosum $ typeOf ETHASH
        x11r = algosum $ typeOf X11
        equihashr = algosum $ typeOf EQUIHASH

-- | Type representing costs for the hardware MEFs: key is algo type, value is (costs, rate quantity)
type MEFTable = M.Map (TypeRep) (Money USD, Double)

-- | Construct MEF table
makeMEFTable :: [(TypeRep, (Money USD, Double))] -> MEFTable
makeMEFTable = M.fromList

-- | Calculate MEF costs for the hashrate
hashrateMEF :: MiningAlgorithm a =>  MEFTable -> Hashrate a -> Money USD
hashrateMEF t h = c
  where al = (typeOf . algorithm) h
        hr = rate h
        c = case M.lookup al t of
          -- Don't know how they're calculating the remainder part
--          Just (m, r) -> m ^* (hr / r)
          Just (m, r) -> m ^* ((fromIntegral . truncate) (hr / r))
          Nothing -> makeUSD 0


-- | Calculate MEF costs for the contract
contractMEF :: MEFTable -> MiningContract -> Money USD
contractMEF t (MiningContract h _ _) = hashrateMEF t h


-- | Type representing actual (or projected) payouts wrt algo from mining pools XXX
type PayoutTable = M.Map TypeRep (Money BTC, Double) -- XXX ugly

-- | Construct mining payouts table
makePayoutTable :: [(TypeRep, (Money BTC, Double))] -> PayoutTable
makePayoutTable = M.fromList

-- | Calculate (project) the mining pools' payout for the hashrate (the payout is 0 if not found!)
hashratePayout :: MiningAlgorithm a =>  PayoutTable -> Hashrate a -> Money BTC
hashratePayout t h = c
  where al = (typeOf . algorithm) h
        hr = rate h
        c = case M.lookup al t of
          Just (m, r) -> m ^* (hr / r)
          Nothing -> makeBTC 0

-- | Calculate contract's hashrate payout
contractPayout :: PayoutTable -> MiningContract -> Money BTC
contractPayout t (MiningContract h _ _ ) = hashratePayout t h



------------------------------------------------

-- | HashFlare.io minimal SHA256 mining contract
defaultSHA256Contract = MiningContract (makeHashrate SHA256 (10 * giga)) (makeUSD 1.20) 0

-- | HashFlare.io minimal Scrypt mining contract
defaultScryptContract = MiningContract (makeHashrate Scrypt (1 * mega)) (makeUSD 8.20) 0

-- | Default HashFlare.io MEF prices (no record means no MEF)
defaultMEFTable = makeMEFTable
  [ (typeOf SHA256, (makeUSD 0.004, 10 * giga))
  , (typeOf Scrypt, (makeUSD 0.01, 1 * mega))
  ]