content: {-# LANGUAGE KindSignatures #-}
  
  -- | An abstract blockchain. This sits between the pure UTxO based DSL and a
  --   full-fat implementation of Cardano.
  
  module Chain.Abstract where
  
  import qualified Data.Hashable
  import           Data.Monoid (Sum (..))
  import qualified Data.Set as Set
  import           Pos.Core.Chrono
  import           Prelude (Show (..))
  import           Universum hiding (Show, show)
  import qualified UTxO.DSL as DSL
  
  import           Chain.Abstract.FinitelySupportedFunction
                       (FinitelySupportedFunction)
  import           Chain.Abstract.Repartition (Repartition)
  
  -- | In the abstract DSL, we identify transactions with integers.
  newtype Addr = Addr Int
    deriving (Buildable, Eq, Ord, Show)
  
  -- | Block hash.
  newtype BlockHash = BlockHash Int deriving (Eq, Show)
  
  -- | Hash of the genesis block.
  genesisBlockHash :: BlockHash
  genesisBlockHash = BlockHash 0
  
  -- | Invalid block hash.
  invalidBlockHash :: BlockHash
  invalidBlockHash = BlockHash $ Data.Hashable.hash @String "invalid"
  
  -- | The stake distribution function assigns stake values to addresses.
  data StakeDistribution a =
    forall f. FinitelySupportedFunction f a (Sum Int) => StakeDistribution f
  
  data Delegation (h :: * -> *) a = Delegation
    { delegator :: a
    , delegatee :: a
    } deriving (Eq)
  
  deriving instance (Show a) => Show (Delegation h a)
  
  newtype SlotId = SlotId Int deriving (Eq, Show)
  
  nextSlot :: SlotId -> SlotId
  nextSlot (SlotId i) = SlotId $ i + 1
  
  data Output (h :: * -> *) a = Output
    { outAddr        :: a
    , outVal         :: DSL.Value
      -- | Repartitioning of the stake associated with this transaction's inputs.
    , outRepartition :: Repartition a
    }
  
  instance Show a => Show (Output h a) where
      show o = "Output {outAddr = " ++ (show $ outAddr o) ++ ", outVal = " ++
                  (show $ outVal o) ++ ", outRepartition = /scrambled/}"
  
  -- TODO(md): This is just a work-around for not being able to define an Eq
  -- instance for Repartition a
  instance Eq a => Eq (Output h a) where
      (Output {outAddr = a1, outVal = v1, outRepartition = _})
          == (Output {outAddr = a2, outVal = v2, outRepartition = _}) = a1 == a2 && v1 == v2
  
  -- | Extract the DSL output from the abstract one.
  outDSL :: Output h a -> DSL.Output h a
  outDSL o = DSL.Output
    { DSL.outAddr = outAddr o
    , DSL.outVal = outVal o
    }
  
  data Transaction h a = Transaction
    { trFresh   :: DSL.Value
    -- ^ The money that is created by this transaction. This money
    -- implicitly comes from the treasury.
    , trIns     :: NE (DSL.Input h a)
    -- ^ The set of input transactions that feed this transaction.
    , trOuts    :: NE (Output h a)
    -- ^ The list of outputs for this transaction.
    , trFee     :: DSL.Value
    -- ^ The fee charged to this transaction.
    , trHash    :: Int
    -- ^ The hash of this transaction. Must be unique in the entire chain.
    , trExtra   :: [Text]
    -- ^ Free-form comments, used for debugging
    , trWitness :: NE a
    -- ^ Transaction witnesses. There should be one witness per transaction input.
    } deriving Eq
  
  instance Show (Transaction h a) where
      show t = show $ trHash t
  
  -- | The abstract transaction has the same hash as the underlying DSL transaction.
  hash :: DSL.Hash h a
       => Transaction h a
       -> h (DSL.Transaction h a)
  hash t = DSL.hash $ trDSL t
  
  -- | Extract the DSL transaction from the abstract one.
  trDSL :: DSL.Hash h a => Transaction h a -> DSL.Transaction h a
  trDSL t = DSL.Transaction
    { DSL.trFresh = trFresh t
    , DSL.trIns = Set.fromList . toList $ trIns t
    , DSL.trOuts = outDSL <$> (toList $ trOuts t)
    , DSL.trFee = trFee t
    , DSL.trHash = trHash t
    , DSL.trExtra = trExtra t
    }
  
  data Block h a = Block
    { -- | Previous block hash
      blockPred         :: BlockHash
      -- | Slot occupied by this block
    , blockSlot         :: SlotId
      -- | The address issuing this block.
    , blockIssuer       :: a
    , blockTransactions :: OldestFirst [] (Transaction h a)
    , blockDlg          :: [Delegation h a]
    } deriving (Eq, Show)
  
  -- | Calculate the hash of the block
  blockHash :: Block h a -> BlockHash
  blockHash (blockPred -> BlockHash oldHash) = BlockHash (oldHash + 1)
  
  type Chain h a = OldestFirst [] (Block h a)
  
  -- The Parameters type was moved here from the Chain.Validation.Parameters
  -- module to avoid circular dependencies
  
  -- | Random seed
  newtype Seed = Seed Int
      deriving (Eq, Show)
  
  -- | Parameters to chain validation.
  --
  --   This is defined in section 4 of the paper. These parameters act as the
  --   environment within which we can validate chain extension or other
  --   operations.
  data Parameters st h a = Parameters
    { slotLeader               :: Seed -> StakeDistribution a -> SlotId -> a
      -- | Extract the current random seed from the state.
    , currentSeed              :: st -> Seed
    , currentSlot              :: st -> SlotId
    , height                   :: st -> Int
    , quality                  :: Int -> Int
    , inCommitmentPhase        :: SlotId -> Bool
    , inOpenPhase              :: SlotId -> Bool
    , inRecoveryPhase          :: SlotId -> Bool
    , maxMempoolSize           :: Int
      -- | The chain rollback limit. This is defined in the original Ouroboros
      -- paper. After this many blocks, a block is considered stable and may not
      -- be rolled back.
    , k                        :: Int
    -- | TODO: Should the support of the initial stake distribution be a subset
    -- of the bootstrapStakeholders?
    , initialStakeDistribution :: StakeDistribution a
    , initialSeed              :: Seed
    , minFee                   :: Transaction h a -> Int
    , initTransactions         :: [Transaction h a]
    , bootstrapStakeholders    :: Set.Set a
    }
  