Clean up unused exports, remove unused / duplicated functions

shelley/chain-and-ledger/executable-spec/src/LedgerState.hs

@@ -42,19 +42,14 @@ module LedgerState
   , KeyPairs
   , UTxOState(..)
   , StakeShare(..)
-  , mkStakeShare
   , emptyAccount
   , emptyPState
   , emptyDState
   , poolRAcnt
   , treasury
   , reserves
   -- * state transitions
-  , asStateTransition
-  , asStateTransition'
-  , retirePools
   , emptyDelegation
-  , applyUTxOUpdate
   , applyTxBody
   -- * Genesis State
   , genesisId
@@ -64,15 +59,7 @@ module LedgerState
   , LedgerValidation(..)
   , minfee
   , txsize
-  , validStakePoolRetire
-  , validInputs
-  , validNoReplay
-  , validFee
-  , validKeyRegistration
-  , validKeyDeregistration
-  , validStakeDelegation
   , validTx
-  , preserveBalance
   , produced
   , consumed
   , verifiedWits
@@ -95,15 +82,9 @@ module LedgerState
   -- refunds
   , keyRefunds
   , keyRefund
-  , decayedKey
   , decayedTx
-  , poolRefunds
   -- epoch boundary
-  , poolRewards
-  , leaderRew
   , memberRew
-  , rewardOnePool
-  , reward
   , stakeDistr
   , applyRUpd
   , createRUpd
@@ -129,8 +110,7 @@ import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Delegation.Certificates (requiresVKeyWitness)
 import           EpochBoundary (BlocksMade (..), SnapShots (..), Stake (..), aggregateOuts,
-                     baseStake, emptySnapShots, maxPool, poolRefunds, poolStake, ptrStake,
-                     rewardStake)
+                     baseStake, emptySnapShots, maxPool, poolStake, ptrStake, rewardStake)
 import           GHC.Generics (Generic)
 import           Keys (AnyKeyHash, GenDelegs (..), GenKeyHash, KeyDiscriminator (..), KeyHash,
                      KeyPair, Signable, hash, undiscriminateKeyHash)
@@ -142,10 +122,10 @@ import           PParams (PParams (..), activeSlotCoeff, d, emptyPParams, keyDec
 import           Slot (Duration (..), Epoch (..), Slot (..), epochFromSlot, firstSlot,
                      slotsPerEpoch, (+*), (-*))
 import           Tx (extractKeyHash)
-import           TxData (Addr (..), Credential (..), Delegation (..), Ix, PoolParams, Ptr (..),
-                     RewardAcnt (..), StakeCredential, Tx (..), TxBody (..), TxId (..), TxIn (..),
-                     TxOut (..), body, certs, getRwdCred, inputs, poolOwners, poolPledge,
-                     poolRAcnt, ttl, txfee, wdrls, witKeyHash)
+import           TxData (Addr (..), Credential (..), Ix, PoolParams, Ptr (..), RewardAcnt (..),
+                     StakeCredential, Tx (..), TxBody (..), TxId (..), TxIn (..), TxOut (..), body,
+                     certs, getRwdCred, inputs, poolOwners, poolPledge, poolRAcnt, ttl, txfee,
+                     wdrls, witKeyHash)
 import           Updates (AVUpdate (..), PPUpdate (..), Update (..), UpdateState (..), emptyUpdate,
                      emptyUpdateState)
 import           UTxO (UTxO (..), balance, deposits, txinLookup, txins, txouts, txup, verifyWitVKey)
@@ -178,13 +158,6 @@ newtype StakeShare =
   StakeShare Rational
   deriving (Show, Ord, Eq, NoUnexpectedThunks)
 
--- | Construct an optional probability value
-mkStakeShare :: Rational -> Maybe StakeShare
-mkStakeShare p =
-  if 0 <= p
-    then Just $ StakeShare p
-    else Nothing
-
 data DState crypto= DState
     {  -- |The active stake keys.
       _stkCreds    :: StakeCreds crypto
@@ -662,75 +635,8 @@ validTx tx d' slot pp l =
                    (l ^. utxoState)
  <> validRuleUTXOW tx d' l
 
--- The rules for checking validiy of stake delegation transitions return
--- `certificate_type_correct(cert) -> valid_cert(cert)`, i.e., if the
--- certificate is of a different type, it's considered to be valid due to the
--- falsified hypothesis.
-
--- | Checks whether a key registration certificat is valid.
-validKeyRegistration
-  :: DCert crypto
-  -> DState crypto
-  -> Validity
-validKeyRegistration cert ds =
-  case cert of
-    RegKey key -> if not $ Map.member key stakeKeys
-                  then Valid else Invalid [StakeKeyAlreadyRegistered]
-                   where (StakeCreds stakeKeys) = ds ^. stkCreds
-    _          -> Valid
-
-validKeyDeregistration
-  :: DCert crypto
-  -> DState crypto
-  -> Validity
-validKeyDeregistration cert ds =
-  case cert of
-    DeRegKey key -> if Map.member key stakeKeys
-                    then Valid else Invalid [StakeKeyNotRegistered]
-                      where (StakeCreds stakeKeys) = ds ^. stkCreds
-    _            -> Valid
-
-validStakeDelegation
-  ::  DCert crypto
-  -> DState crypto
-  -> Validity
-validStakeDelegation cert ds =
-  case cert of
-    Delegate (Delegation source _)
-      -> if Map.member source stakeKeys
-         then Valid else Invalid [StakeDelegationImpossible]
-           where (StakeCreds stakeKeys) = ds ^. stkCreds
-    _ -> Valid
-
-
-validStakePoolRetire
-  :: DCert crypto
-  -> PState crypto
-  -> Validity
-validStakePoolRetire cert ps =
-  case cert of
-    RetirePool key _ -> if Map.member key stakePools
-                        then Valid else Invalid [StakePoolNotRegisteredOnKey]
-                         where (StakePools stakePools) = ps ^. stPools
-    _                -> Valid
-
 -- Functions for stake delegation model
 
--- |Retire the appropriate stake pools when the epoch changes.
-retirePools
-  :: LedgerState crypto
-  -> Epoch
-  -> LedgerState crypto
-retirePools ls@(LedgerState _ ds _) epoch =
-    ls & delegationState .~
-           (ds & pstate . stPools .~
-                 (StakePools $ Map.filterWithKey
-                        (\hk _ -> Map.notMember hk retiring')
-                        stakePools)
-               & pstate . retiring .~ active)
-  where (active, retiring') = Map.partition (epoch /=) (ds ^. pstate . retiring)
-        (StakePools stakePools) = ds ^. pstate . stPools
-
 -- |Calculate the change to the deposit pool for a given transaction.
 depositPoolChange
   :: LedgerState crypto
@@ -778,77 +684,6 @@ applyUTxOUpdate
   -> UTxOState crypto
 applyUTxOUpdate u tx = u & utxo .~ txins tx ⋪ (u ^. utxo) ∪ txouts tx
 
--- |Apply a delegation certificate as a state transition function on the ledger state.
-applyDCert
-  :: Ptr
-  -> DCert crypto
-  -> DPState crypto
-  -> DPState crypto
-
-applyDCert ptr dcert@(RegKey _) ds =
-  ds & dstate %~ applyDCertDState ptr dcert
-
-applyDCert ptr dcert@(DeRegKey _) ds =
-  ds & dstate %~ applyDCertDState ptr dcert
-
-applyDCert ptr dcert@(RegPool _) ds = ds & pstate %~ applyDCertPState ptr dcert
-
-applyDCert ptr dcert@(RetirePool _ _) ds =
-  ds & pstate %~ applyDCertPState ptr dcert
-
-applyDCert _ (GenesisDelegate _) ds = ds -- TODO: check this
-
-applyDCert _ (InstantaneousRewards _) _ = undefined
-
--- TODO do we also have to check hashKey target?
-applyDCert ptr dcert@(Delegate _) ds =
-  ds & dstate %~ applyDCertDState ptr dcert
-
-applyDCertDState
-  :: Ptr
-  -> DCert crypto
-  -> DState crypto
-  -> DState crypto
-applyDCertDState (Ptr slot txIx clx) (DeRegKey key) ds =
-    ds & stkCreds      .~ (StakeCreds $ Map.delete hksk stkcreds')
-       & rewards     %~ Map.delete (RewardAcnt hksk)
-       & delegations %~ Map.delete hksk
-       & ptrs        %~ Map.delete (Ptr slot txIx clx)
-        where hksk = key
-              (StakeCreds stkcreds') = ds ^. stkCreds
-
-applyDCertDState (Ptr slot txIx clx) (RegKey key) ds =
-    ds & stkCreds  .~ (StakeCreds $ Map.insert hksk slot stkcreds')
-       & rewards %~ Map.insert (RewardAcnt hksk) (Coin 0)
-       & ptrs    %~ Map.insert (Ptr slot txIx clx) hksk
-        where hksk = key
-              (StakeCreds stkcreds') = ds ^. stkCreds
-
-applyDCertDState _ (Delegate (Delegation source target)) ds =
-    ds & delegations %~ Map.insert source target
-
-applyDCertDState _ _ ds = ds
-
-applyDCertPState
-  :: Ptr
-  -> DCert crypto
-  -> PState crypto
-  -> PState crypto
-applyDCertPState (Ptr slot _ _ ) (RegPool sp) ps =
-    ps & stPools  .~ (StakePools $ Map.insert hsk slot' pools)
-       & pParams  %~ Map.insert hsk sp
-       & retiring %~ Map.delete hsk
-  where hsk = sp ^. poolPubKey
-        (StakePools pools) = ps ^. stPools
-        slot' = fromMaybe slot (Map.lookup hsk pools)
-
--- TODO check epoch (not in new doc atm.)
-applyDCertPState _ (RetirePool key epoch) ps =
-  ps & retiring %~ Map.insert key epoch
-
--- | Use only pool registration or retirement certificates
-applyDCertPState _ _ ps = ps
-
 ---------------------------------
 -- epoch boundary calculations --
 ---------------------------------

shelley/chain-and-ledger/executable-spec/src/STS/PoolReap.hs

@@ -13,6 +13,7 @@ import qualified Data.Set as Set
 import           Lens.Micro ((^.))
 
 import           Delegation.Certificates
+import           EpochBoundary (poolRefunds)
 import           LedgerState
 import           PParams
 import           Slot