{-# LANGUAGE TupleSections #-}
-- | Handle effects. They are most often caused by requests sent by clients
-- but sometimes also caused by projectiles or periodically activated items.
module Game.LambdaHack.Server.HandleEffectM
  ( applyItem, kineticEffectAndDestroy, effectAndDestroyAndAddKill
  , itemEffectEmbedded, highestImpression, dominateFidSfx
  , dropAllItems, pickDroppable
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , UseResult(..)
  , applyKineticDamage, refillHP, cutCalm, effectAndDestroy, imperishableKit
  , itemEffectDisco, effectSem
  , effectBurn, effectExplode, effectRefillHP, effectRefillCalm, effectDominate
  , dominateFid, effectImpress, effectPutToSleep, effectYell, effectSummon
  , effectAscend, findStairExit, switchLevels1, switchLevels2, effectEscape
  , effectParalyze, paralyze, effectParalyzeInWater, effectInsertMove
  , effectTeleport, effectCreateItem, effectDropItem, dropCStoreItem
  , effectPolyItem, effectRerollItem, effectDupItem, effectIdentify
  , identifyIid, effectDetect, effectDetectX, effectSendFlying
  , sendFlyingVector, effectDropBestWeapon, effectActivateInv
  , effectTransformContainer, effectApplyPerfume, effectOneOf
  , effectVerbNoLonger, effectVerbMsg, effectComposite
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Bits (xor)
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.HashMap.Strict as HM
import           Data.Int (Int64)
import           Data.Key (mapWithKeyM_)
import qualified Data.Ord as Ord
import qualified Data.Text as T

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Analytics
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.CommonM
import           Game.LambdaHack.Server.ItemM
import           Game.LambdaHack.Server.ItemRev
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.PeriodicM
import           Game.LambdaHack.Server.ServerOptions
import           Game.LambdaHack.Server.State

-- * Semantics of effects

data UseResult = UseDud | UseId | UseUp
 deriving (Eq, Ord)

applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m ()
applyItem aid iid cstore = do
  execSfxAtomic $ SfxApply aid iid cstore
  let c = CActor aid cstore
  -- Treated as if the actor hit himself with the item as a weapon,
  -- incurring both the kinetic damage and effect, hence the same call
  -- as in @reqMelee@.
  kineticEffectAndDestroy True aid aid aid iid c True

applyKineticDamage :: MonadServerAtomic m
                   => ActorId -> ActorId -> ItemId -> m Bool
applyKineticDamage source target iid = do
  itemKind <- getsState $ getIidKindServer iid
  if IK.idamage itemKind == 0 then return False else do  -- speedup
    sb <- getsState $ getActorBody source
    hurtMult <- getsState $ armorHurtBonus source target
    totalDepth <- getsState stotalDepth
    Level{ldepth} <- getLevel (blid sb)
    dmg <- rndToAction $ castDice ldepth totalDepth $ IK.idamage itemKind
    let rawDeltaHP = fromIntegral hurtMult * xM dmg `divUp` 100
        speedDeltaHP = case btrajectory sb of
          Just (_, speed) | bproj sb -> - modifyDamageBySpeed rawDeltaHP speed
          _ -> - rawDeltaHP
    if speedDeltaHP < 0 then do  -- damage the target, never heal
      refillHP source target speedDeltaHP
      return True
    else return False

refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m ()
refillHP source target speedDeltaHP = assert (speedDeltaHP /= 0) $ do
  tbOld <- getsState $ getActorBody target
  actorMaxSk <- getsState $ getActorMaxSkills target
  -- We don't ignore even tiny HP drains, because they can be very weak
  -- enemy projectiles and so will recur and in total can be deadly
  -- and also AI should rather be stupidly aggressive than stupidly lethargic.
  let serious = source /= target && not (bproj tbOld)
      hpMax = Ability.getSk Ability.SkMaxHP actorMaxSk
      deltaHP0 | serious && speedDeltaHP < minusM =
                 -- If overfull, at least cut back to max, unless minor drain.
                 min speedDeltaHP (xM hpMax - bhp tbOld)
               | otherwise = speedDeltaHP
      deltaHP = if | deltaHP0 > 0 && bhp tbOld > xM 999 ->  -- UI limit
                     tenthM  -- avoid nop, to avoid loops
                   | deltaHP0 < 0 && bhp tbOld < - xM 999 ->
                     -tenthM
                   | otherwise -> deltaHP0
  execUpdAtomic $ UpdRefillHP target deltaHP
  when serious $ cutCalm target
  tb <- getsState $ getActorBody target
  fact <- getsState $ (EM.! bfid tb) . sfactionD
  unless (bproj tb || fleaderMode (gplayer fact) == LeaderNull) $
    -- If leader just lost all HP, change the leader early (not when destroying
    -- the actor), to let players rescue him, especially if he's slowed
    -- by the attackers.
    when (bhp tb <= 0 && bhp tbOld > 0) $ do
      -- If all other party members dying, leadership will switch
      -- to one of them, which seems questionable, but it's rare
      -- and the disruption servers to underline the dire circumstance.
      electLeader (bfid tb) (blid tb) target
      mleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD
      -- If really nobody else in the party, make him the leader back again
      -- on the oft chance that he gets revived by a projectile, etc.
      when (isNothing mleader) $
        execUpdAtomic $ UpdLeadFaction (bfid tb) Nothing $ Just target

cutCalm :: MonadServerAtomic m => ActorId -> m ()
cutCalm target = do
  tb <- getsState $ getActorBody target
  actorMaxSk <- getsState $ getActorMaxSkills target
  let upperBound = if hpTooLow tb actorMaxSk
                   then 2  -- to trigger domination on next attack, etc.
                   else xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk
      deltaCalm = min minusM2 (upperBound - bcalm tb)
  -- HP loss decreases Calm by at least @minusM2@ to avoid "hears something",
  -- which is emitted when decreasing Calm by @minusM1@.
  updateCalm target deltaCalm

-- Here kinetic damage is applied. This is necessary so that the same
-- AI benefit calculation may be used for flinging and for applying items.
kineticEffectAndDestroy :: MonadServerAtomic m
                        => Bool -> ActorId -> ActorId -> ActorId
                        -> ItemId -> Container -> Bool
                        -> m ()
kineticEffectAndDestroy voluntary killer source target iid c mayDestroy = do
  bag <- getsState $ getContainerBag c
  case iid `EM.lookup` bag of
    Nothing -> error $ "" `showFailure` (source, target, iid, c)
    Just kit -> do
      itemFull <- getsState $ itemToFull iid
      tbOld <- getsState $ getActorBody target
      localTime <- getsState $ getLocalTime (blid tbOld)
      let recharged = hasCharge localTime itemFull kit
      -- If neither kinetic hit nor any effect is activated, there's no chance
      -- the items can be destroyed or even timeout changes, so we abort early.
      when recharged $ do
        kineticPerformed <- applyKineticDamage source target iid
        tb <- getsState $ getActorBody target
        -- Sometimes victim heals just after we registered it as killed,
        -- but that's OK, an actor killed two times is similar enough
        -- to two killed.
        when (kineticPerformed  -- speedup
              && bhp tb <= 0 && bhp tbOld > 0) $ do
          sb <- getsState $ getActorBody source
          arWeapon <- getsState $ (EM.! iid) . sdiscoAspect
          let killHow | not (bproj sb) =
                        if voluntary then KillKineticMelee else KillKineticPush
                      | IA.checkFlag Ability.Blast arWeapon = KillKineticBlast
                      | otherwise = KillKineticRanged
          addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)
        effectAndDestroyAndAddKill
          voluntary killer False (fst kit <= 1) kineticPerformed
          source target iid c False itemFull mayDestroy

effectAndDestroyAndAddKill :: MonadServerAtomic m
                           => Bool -> ActorId -> Bool -> Bool
                           -> Bool -> ActorId -> ActorId -> ItemId -> Container
                           -> Bool -> ItemFull -> Bool
                           -> m ()
effectAndDestroyAndAddKill voluntary killer onSmashOnly useAllCopies
                           kineticPerformed source target iid container
                           periodic itemFull mayDestroy = do
  tbOld <- getsState $ getActorBody target
  effectAndDestroy onSmashOnly useAllCopies kineticPerformed source target
                   iid container periodic itemFull mayDestroy
  tb <- getsState $ getActorBody target
  -- Sometimes victim heals just after we registered it as killed,
  -- but that's OK, an actor killed two times is similar enough to two killed.
  when (bhp tb <= 0 && bhp tbOld > 0) $ do
    sb <- getsState $ getActorBody source
    arWeapon <- getsState $ (EM.! iid) . sdiscoAspect
    let killHow | not (bproj sb) =
                  if voluntary then KillOtherMelee else KillOtherPush
                | IA.checkFlag Ability.Blast arWeapon = KillOtherBlast
                | otherwise = KillOtherRanged
    addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)

effectAndDestroy :: MonadServerAtomic m
                 => Bool -> Bool -> Bool
                 -> ActorId -> ActorId -> ItemId -> Container
                 -> Bool -> ItemFull -> Bool
                 -> m ()
effectAndDestroy onSmashOnly useAllCopies kineticPerformed
                 source target iid container periodic
                 itemFull@ItemFull{itemBase, itemDisco, itemKindId, itemKind}
                 mayDestroy = do
  bag <- getsState $ getContainerBag container
  let (itemK, itemTimer) = bag EM.! iid
      effs = if onSmashOnly
             then IK.strengthOnSmash itemKind
             else IK.ieffects itemKind
      arItem = case itemDisco of
        ItemDiscoFull itemAspect -> itemAspect
        _ -> error "effectAndDestroy: server ignorant about an item"
      timeout = IA.aTimeout arItem
  lid <- getsState $ lidFromC container
  localTime <- getsState $ getLocalTime lid
  let it1 = let timeoutTurns = timeDeltaScale (Delta timeTurn) timeout
                charging startT = timeShift startT timeoutTurns > localTime
            in filter charging itemTimer
      len = length it1
      recharged = len < itemK || onSmashOnly
  -- If the item has no charges and the effects are not @OnSmash@
  -- we speed up by shortcutting early, because we don't need to activate
  -- effects and we know kinetic hit was not performed (no charges to do so
  -- and in case of @OnSmash@, only effects are triggered).
  when recharged $ do
    let it2 = if timeout /= 0 && recharged
              then if periodic && IA.checkFlag Ability.Fragile arItem
                   then replicate (itemK - length it1) localTime ++ it1
                           -- copies are spares only; one fires, all discharge
                   else localTime : it1
                           -- copies all fire, turn by turn; one discharges
              else itemTimer
        kit2 = (1, take 1 it2)
        !_A = assert (len <= itemK `blame` (source, target, iid, container)) ()
    -- We use up the charge even if eventualy every effect fizzles. Tough luck.
    -- At least we don't destroy the item in such case.
    -- Also, we ID it regardless.
    unless (itemTimer == it2) $
      execUpdAtomic $ UpdTimeItem iid container itemTimer it2
    -- We have to destroy the item before the effect affects the item
    -- or affects the actor holding it or standing on it (later on we could
    -- lose track of the item and wouldn't be able to destroy it) .
    -- This is OK, because we don't remove the item type from various
    -- item dictionaries, just an individual copy from the container,
    -- so, e.g., the item can be identified after it's removed.
    let imperishable = not mayDestroy || imperishableKit periodic itemFull
    unless imperishable $
      execUpdAtomic $ UpdLoseItem False iid itemBase kit2 container
    -- At this point, the item is potentially no longer in container
    -- @container@, therefore beware of assuming so in the code below.
    -- If the item activation is not periodic, but the item itself is,
    -- only the first effect gets activated (and the item may be destroyed,
    -- unlike with periodic activations).
    let effsManual = if not periodic
                        && IA.checkFlag Ability.Periodic arItem
                        && not (IA.checkFlag Ability.Condition arItem)
                     then take 1 effs  -- may be empty
                     else effs
    triggeredEffect <- itemEffectDisco useAllCopies kineticPerformed
                                       source target iid itemKindId itemKind
                                       container periodic effsManual
    let triggered = if kineticPerformed then UseUp else triggeredEffect
    sb <- getsState $ getActorBody source
    -- Announce no effect, which is rare and wastes time, so noteworthy.
    unless (triggered == UseUp  -- effects triggered; feedback comes from them
            || periodic  -- don't spam via fizzled periodic effects
            || bproj sb  -- don't spam, projectiles can be very numerous
            ) $
      execSfxAtomic $ SfxMsgFid (bfid sb) $
        if any IK.forApplyEffect effsManual
        then SfxFizzles  -- something didn't work, despite promising effects
        else SfxNothingHappens  -- fully expected
    -- If none of item's effects nor a kinetic hit were performed,
    -- we recreate the item (assuming we deleted the item above).
    -- Regardless, we don't rewind the time, because some info is gained
    -- (that the item does not exhibit any effects in the given context).
    unless (imperishable || triggered == UseUp) $
      execUpdAtomic $ UpdSpotItem False iid itemBase kit2 container

imperishableKit :: Bool -> ItemFull -> Bool
imperishableKit periodic itemFull =
  let arItem = aspectRecordFull itemFull
  in IA.checkFlag Ability.Durable arItem
     || periodic && not (IA.checkFlag Ability.Fragile arItem)

-- The item is triggered exactly once. If there are more copies,
-- they are left to be triggered next time.
itemEffectEmbedded :: MonadServerAtomic m
                   => Bool -> ActorId -> LevelId -> Point -> ItemId -> m ()
itemEffectEmbedded voluntary aid lid tpos iid = do
  -- First embedded item may move actor to another level, so @lid@
  -- may be unequal to @blid sb@.
  let c = CEmbed lid tpos
  -- Treated as if the actor hit himself with the embedded item as a weapon,
  -- incurring both the kinetic damage and effect, hence the same call
  -- as in @reqMelee@. Information whether this happened due to being pushed
  -- is preserved, but how did the pushing is lost, so we blame the victim.
  kineticEffectAndDestroy voluntary aid aid aid iid c True

-- | The source actor affects the target actor, with a given item.
-- If any of the effects fires up, the item gets identified.
-- Even using raw damage (beating the enemy with the magic wand,
-- for example) identifies the item. This means a costly @UpdDiscover@
-- is processed for each random timeout weapon hit and for most projectiles,
-- but at least not for most explosion particles nor plain organs.
-- And if not needed, the @UpdDiscover@ are eventually not sent to clients.
-- So, enemy missiles that hit us are no longer mysterious until picked up,
-- which is for the better, because the client knows their charging status
-- and so can generate accurate messages in the case when not recharged.
-- This also means that thrown consumables in flasks sturdy enough to cause
-- damage are always identified at hit, even if no effect activated.
-- So throwing them at foes is a better identification method than applying.
--
-- Note that if we activate a durable non-passive item, e.g., a spiked shield,
-- from the ground, it will get identified, which is perfectly fine,
-- until we want to add sticky armor that can't be easily taken off
-- (and, e.g., has some maluses).
itemEffectDisco :: MonadServerAtomic m
                => Bool -> Bool-> ActorId -> ActorId -> ItemId
                -> ContentId ItemKind -> ItemKind
                -> Container -> Bool -> [IK.Effect]
                -> m UseResult
itemEffectDisco useAllCopies kineticPerformed
                source target iid itemKindId itemKind
                c periodic effs = do
  urs <- mapM (effectSem useAllCopies source target iid c periodic) effs
  let ur = case urs of
        [] -> UseDud  -- there was no effects
        _ -> maximum urs
  -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary.
  when (ur >= UseId || kineticPerformed) $
    identifyIid iid c itemKindId itemKind
  return ur

-- | Source actor affects target actor, with a given effect and it strength.
-- Both actors are on the current level and can be the same actor.
-- The item may or may not still be in the container.
effectSem :: MonadServerAtomic m
          => Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool
          -> IK.Effect
          -> m UseResult
effectSem useAllCopies source target iid c periodic effect = do
  let recursiveCall = effectSem useAllCopies source target iid c periodic
  sb <- getsState $ getActorBody source
  pos <- getsState $ posFromC c
  -- @execSfx@ usually comes last in effect semantics, but not always
  -- and we are likely to introduce more variety.
  let execSfx = execSfxAtomic $ SfxEffect (bfid sb) target effect 0
      execSfxSource = execSfxAtomic $ SfxEffect (bfid sb) source effect 0
  case effect of
    IK.Burn nDm -> effectBurn nDm source target
    IK.Explode t -> effectExplode execSfx t source target
    IK.RefillHP p -> effectRefillHP p source target
    IK.RefillCalm p -> effectRefillCalm execSfx p source target
    IK.Dominate -> effectDominate source target
    IK.Impress -> effectImpress recursiveCall execSfx source target
    IK.PutToSleep -> effectPutToSleep execSfx target
    IK.Yell -> effectYell execSfx target
    IK.Summon grp nDm -> effectSummon grp nDm iid source target periodic
    IK.Ascend p -> effectAscend recursiveCall execSfx p source target pos
    IK.Escape{} -> effectEscape execSfx source target
    IK.Paralyze nDm -> effectParalyze execSfx nDm source target
    IK.ParalyzeInWater nDm -> effectParalyzeInWater execSfx nDm source target
    IK.InsertMove nDm -> effectInsertMove execSfx nDm source target
    IK.Teleport nDm -> effectTeleport execSfx nDm source target
    IK.CreateItem store grp tim ->
      effectCreateItem (Just $ bfid sb) Nothing source target store grp tim
    IK.DropItem n k store grp -> effectDropItem execSfx iid n k store grp target
    IK.PolyItem -> effectPolyItem execSfx iid target
    IK.RerollItem -> effectRerollItem execSfx iid target
    IK.DupItem -> effectDupItem execSfx iid target
    IK.Identify -> effectIdentify execSfx iid target
    IK.Detect d radius -> effectDetect execSfx d radius target pos
    IK.SendFlying tmod ->
      effectSendFlying execSfx tmod source target c Nothing
    IK.PushActor tmod ->
      effectSendFlying execSfx tmod source target c (Just True)
    IK.PullActor tmod ->
      effectSendFlying execSfx tmod source target c (Just False)
    IK.DropBestWeapon -> effectDropBestWeapon execSfx iid target
    IK.ActivateInv symbol -> effectActivateInv execSfx iid source target symbol
    IK.ApplyPerfume -> effectApplyPerfume execSfx target
    IK.OneOf l -> effectOneOf recursiveCall l
    IK.OnSmash _ -> return UseDud  -- ignored under normal circumstances
    IK.VerbNoLonger _ -> effectVerbNoLonger useAllCopies execSfxSource source
    IK.VerbMsg _ -> effectVerbMsg execSfxSource source
    IK.Composite l -> effectComposite recursiveCall l

-- * Individual semantic functions for effects

-- ** Burn

-- Damage from fire. Not affected by armor.
effectBurn :: MonadServerAtomic m
           => Dice.Dice -> ActorId -> ActorId -> m UseResult
effectBurn nDm source target = do
  tb <- getsState $ getActorBody target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  n0 <- rndToAction $ castDice ldepth totalDepth nDm
  let n = max 1 n0  -- avoid 0 and negative burn
      deltaHP = - xM n
  sb <- getsState $ getActorBody source
  -- Display the effect more accurately.
  let reportedEffect = IK.Burn $ Dice.intToDice n
  execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP
  refillHP source target deltaHP
  return UseUp

-- ** Explode

effectExplode :: MonadServerAtomic m
              => m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult
effectExplode execSfx cgroup source target = do
  execSfx
  tb <- getsState $ getActorBody target
  let itemFreq = [(cgroup, 1)]
      -- Explosion particles are placed among organs of the victim:
      container = CActor target COrgan
  m2 <- rollAndRegisterItem (blid tb) itemFreq container False Nothing
  let (iid, (ItemFull{itemBase, itemKind}, (itemK, _))) =
        fromMaybe (error $ "" `showFailure` cgroup) m2
      Point x y = bpos tb
      semirandom = T.length (IK.idesc itemKind)
      projectN k100 n = do
        -- We pick a point at the border, not inside, to have a uniform
        -- distribution for the points the line goes through at each distance
        -- from the source. Otherwise, e.g., the points on cardinal
        -- and diagonal lines from the source would be more common.
        let veryrandom = (k100 `xor` (semirandom + n)) `mod` 5
            fuzz = 5 + veryrandom
            k | n < 16 && n >= 12 = 12
              | n < 12 && n >= 8 = 8
              | n < 8 && n >= 4 = 4
              | otherwise = min n 16  -- fire in groups of 16 including old duds
            psDir4 =
              [ Point (x - 12) (y + 12)
              , Point (x + 12) (y + 12)
              , Point (x - 12) (y - 12)
              , Point (x + 12) (y - 12) ]
            psDir8 =
              [ Point (x - 12) y
              , Point (x + 12) y
              , Point x (y + 12)
              , Point x (y - 12) ]
            psFuzz =
              [ Point (x - 12) $ y + fuzz
              , Point (x + 12) $ y + fuzz
              , Point (x - 12) $ y - fuzz
              , Point (x + 12) $ y - fuzz
              , flip Point (y - 12) $ x + fuzz
              , flip Point (y + 12) $ x + fuzz
              , flip Point (y - 12) $ x - fuzz
              , flip Point (y + 12) $ x - fuzz ]
            randomReverse = if veryrandom `mod` 2 == 0 then id else reverse
            ps = take k $ concat $
              randomReverse
                [ zip (repeat True)  -- diagonal particles don't reach that far
                  $ take 4 (drop ((k100 + itemK + fuzz) `mod` 4) $ cycle psDir4)
                , zip (repeat False)  -- only some cardinal reach far
                  $ take 4 (drop ((k100 + n) `mod` 4) $ cycle psDir8) ]
              ++ [zip (repeat True)
                  $ take 8 (drop ((k100 + fuzz) `mod` 8) $ cycle psFuzz)]
        forM_ ps $ \(centerRaw, tpxy) -> do
          let center = centerRaw && itemK >= 8  -- if few, keep them regular
          mfail <- projectFail source target tpxy veryrandom center
                               iid COrgan True
          case mfail of
            Nothing -> return ()
            Just ProjectBlockTerrain -> return ()
            Just ProjectBlockActor | not $ bproj tb -> return ()
            Just failMsg ->
              execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnexpected failMsg
      tryFlying 0 = return ()
      tryFlying k100 = do
        -- Explosion particles were placed among organs of the victim:
        bag2 <- getsState $ borgan . getActorBody target
        -- We stop bouncing old particles when less than half remains,
        -- to prevent hoarding explosives to use only in cramped spaces.
        case EM.lookup iid bag2 of
          Just (n2, _) | n2 >= itemK `div` 2 -> do
            projectN k100 n2
            tryFlying $ k100 - 1
          _ -> return ()
  -- Some of the particles that fail to take off, bounce off obstacles
  -- up to 100 times in total, trying to fly in different directions.
  tryFlying 100
  bag3 <- getsState $ borgan . getActorBody target
  let mn3 = EM.lookup iid bag3
  -- Give up and destroy the remaining particles, if any.
  maybe (return ()) (\kit -> execUpdAtomic
                             $ UpdLoseItem False iid itemBase kit container) mn3
  return UseUp  -- we neglect verifying that at least one projectile got off

-- ** RefillHP

-- Unaffected by armor.
effectRefillHP :: MonadServerAtomic m
               => Int -> ActorId -> ActorId -> m UseResult
effectRefillHP power0 source target = do
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  curChalSer <- getsServer $ scurChalSer . soptions
  fact <- getsState $ (EM.! bfid tb) . sfactionD
  let power = if power0 <= -1 then power0 else max 1 power0  -- avoid 0
      deltaHP = xM power
  if | cfish curChalSer && deltaHP > 0
       && fhasUI (gplayer fact) && bfid sb /= bfid tb -> do
       execSfxAtomic $ SfxMsgFid (bfid tb) SfxColdFish
       return UseId
     | otherwise -> do
       let reportedEffect = IK.RefillHP power
       execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP
       refillHP source target deltaHP
       return UseUp

-- ** RefillCalm

effectRefillCalm :: MonadServerAtomic m
                 => m () -> Int -> ActorId -> ActorId -> m UseResult
effectRefillCalm execSfx power0 source target = do
  tb <- getsState $ getActorBody target
  actorMaxSk <- getsState $ getActorMaxSkills target
  let power = if power0 <= -1 then power0 else max 1 power0  -- avoid 0
      rawDeltaCalm = xM power
      calmMax = Ability.getSk Ability.SkMaxCalm actorMaxSk
      serious = rawDeltaCalm <= minusM2 && source /= target && not (bproj tb)
      deltaCalm0 | serious =  -- if overfull, at least cut back to max
                     min rawDeltaCalm (xM calmMax - bcalm tb)
                 | otherwise = rawDeltaCalm
      deltaCalm = if | deltaCalm0 > 0 && bcalm tb > xM 999 ->  -- UI limit
                       tenthM  -- avoid nop, to avoid loops
                     | deltaCalm0 < 0 && bcalm tb < - xM 999 ->
                       -tenthM
                     | otherwise -> deltaCalm0
  execSfx
  updateCalm target deltaCalm
  return UseUp

-- ** Dominate

-- The is another way to trigger domination (the normal way is by zeroed Calm).
-- Calm is here irrelevant. The other conditions are the same.
effectDominate :: MonadServerAtomic m => ActorId -> ActorId -> m UseResult
effectDominate source target = do
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  if | bproj tb -> return UseDud
     | bfid tb == bfid sb -> return UseDud  -- accidental hit; ignore
     | otherwise -> do
       fact <- getsState $ (EM.! bfid tb) . sfactionD
       hiImpression <- highestImpression tb
       let permitted = case hiImpression of
             Nothing -> False  -- no impression, no domination
             Just (hiImpressionFid, hiImpressionK) ->
                hiImpressionFid == bfid sb
                  -- highest impression needs to be by us
                && (fleaderMode (gplayer fact) /= LeaderNull
                    || hiImpressionK >= 10)
                     -- to tame/hack animal/robot, impress them a lot first
       if permitted then do
         b <- dominateFidSfx source target (bfid sb)
         return $! if b then UseUp else UseDud
       else do
         execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxUnimpressed target
         when (source /= target) $
           execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnimpressed target
         return UseDud

highestImpression :: MonadServerAtomic m
                  => Actor -> m (Maybe (FactionId, Int))
highestImpression tb = do
  getKind <- getsState $ flip getIidKindServer
  getItem <- getsState $ flip getItemBody
  let isImpression iid =
        maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid
      impressions = EM.filterWithKey (\iid _ -> isImpression iid) $ borgan tb
      f (_, (k, _)) = k
      maxImpression = maximumBy (Ord.comparing f) $ EM.assocs impressions
  if EM.null impressions
  then return Nothing
  else case jfid $ getItem $ fst maxImpression of
    Nothing -> return Nothing
    Just fid -> assert (fid /= bfid tb)
                $ return $ Just (fid, fst $ snd maxImpression)

dominateFidSfx :: MonadServerAtomic m
               => ActorId ->  ActorId -> FactionId -> m Bool
dominateFidSfx source target fid = do
  tb <- getsState $ getActorBody target
  let !_A = assert (not $ bproj tb) ()
  -- Actors that don't move freely can't be dominated, for otherwise,
  -- when they are the last survivors, they could get stuck and the game
  -- wouldn't end. Also, they are a hassle to guide through the dungeon.
  canTra <- getsState $ canTraverse target
  -- Being pushed protects from domination, for simplicity.
  -- A possible interesting exploit, but much help from content would be needed
  -- to make it practical.
  if isNothing (btrajectory tb) && canTra && bhp tb > 0 then do
    let execSfx = execSfxAtomic $ SfxEffect fid target IK.Dominate 0
    execSfx  -- if actor ours, possibly the last occasion to see him
    dominateFid fid source target
    -- If domination resulted in game over, the message won't be seen
    -- before the end game screens, but at least it will be seen afterwards
    -- and browsable in history while inside subsequent game, revealing
    -- the cause of the previous game over. Better than no message at all.
    execSfx  -- see the actor as theirs, unless position not visible
    return True
  else
    return False

dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> ActorId -> m ()
dominateFid fid source target = do
  tb0 <- getsState $ getActorBody target
  -- Game over deduced very early, so no further animation nor message
  -- will appear before game end screens. This is good in that our last actor
  -- that yielded will still be on screen when end game messages roll.
  -- This is bad in that last enemy actor that got dominated by us
  -- may not be on screen and we have no clue how we won until
  -- we see history in the next game. Even worse if our ally dominated
  -- the enemy actor. Then we may never learn. Oh well, that's realism.
  deduceKilled target
  electLeader (bfid tb0) (blid tb0) target
  fact <- getsState $ (EM.! bfid tb0) . sfactionD
  -- Drop all items so that domiation is not too nasty, especially
  -- if the dominated hero runs off or teleports away with gold
  -- or starts hitting with the most potent artifact weapon in the game.
  -- Prevent the faction's stash from being lost in case they are
  -- not spawners. Drop items while still of the original faction
  -- to mark them on the map for other party members to collect.
  when (isNothing $ gleader fact) $ moveStores False target CSha CInv
  dropAllItems target tb0
  tb <- getsState $ getActorBody target
  ais <- getsState $ getCarriedAssocsAndTrunk tb
  actorMaxSk <- getsState $ getActorMaxSkills target
  getKind <- getsState $ flip getIidKindServer
  let isImpression iid =
        maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid
      dropAllImpressions = EM.filterWithKey (\iid _ -> not $ isImpression iid)
      borganNoImpression = dropAllImpressions $ borgan tb
  -- Actor is not pushed nor projectile, so @sactorTime@ suffices.
  btime <-
    getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime
  execUpdAtomic $ UpdLoseActor target tb ais
  let maxCalm = Ability.getSk Ability.SkMaxCalm actorMaxSk
      maxHp = Ability.getSk Ability.SkMaxHP actorMaxSk
      bNew = tb { bfid = fid
                , bcalm = max (xM 10) $ xM maxCalm `div` 2
                , bhp = min (xM maxHp) $ bhp tb + xM 10
                , borgan = borganNoImpression}
  aisNew <- getsState $ getCarriedAssocsAndTrunk bNew
  modifyServer $ \ser ->
    ser {sactorTime = updateActorTime fid (blid tb) target btime
                      $ sactorTime ser}
  execUpdAtomic $ UpdSpotActor target bNew aisNew
  -- Focus on the dominated actor, by making him a leader.
  setFreshLeader fid target
  factionD <- getsState sfactionD
  let inGame fact2 = case gquit fact2 of
        Nothing -> True
        Just Status{stOutcome=Camping} -> True
        _ -> False
      gameOver = not $ any inGame $ EM.elems factionD
  -- Avoid the spam of identifying items, if game over.
  unless gameOver $ do
    -- Add some nostalgia for the old faction.
    void $ effectCreateItem (Just $ bfid tb) (Just 10) source target COrgan
                            "impressed" IK.timerNone
    -- Identify organs that won't get identified by use.
    getKindId <- getsState $ flip getIidKindIdServer
    let discoverIf (iid, cstore) = do
          let itemKindId = getKindId iid
              c = CActor target cstore
          assert (cstore /= CGround) $
            discoverIfMinorEffects c iid itemKindId
        aic = (btrunk tb, COrgan)
              : filter ((/= btrunk tb) . fst) (getCarriedIidCStore tb)
    mapM_ discoverIf aic

-- | Drop all actor's items.
dropAllItems :: MonadServerAtomic m => ActorId -> Actor -> m ()
dropAllItems aid b = do
  mapActorCStore_ CInv (dropCStoreItem False CInv aid b maxBound) b
  mapActorCStore_ CEqp (dropCStoreItem False CEqp aid b maxBound) b

-- ** Impress

effectImpress :: MonadServerAtomic m
              => (IK.Effect -> m UseResult) -> m () -> ActorId -> ActorId
              -> m UseResult
effectImpress recursiveCall execSfx source target = do
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  if | bproj tb -> return UseDud
     | bfid tb == bfid sb ->
       -- Unimpress wrt others, but only once. The recursive Sfx suffices.
       recursiveCall $ IK.DropItem 1 1 COrgan "impressed"
     | otherwise -> do
       -- Actors that don't move freely and so are stupid, can't be impressed.
       canTra <- getsState $ canTraverse target
       if canTra then do
         unless (bhp tb <= 0)
           execSfx  -- avoid spam just before death
         effectCreateItem (Just $ bfid sb) (Just 1) source target COrgan
                          "impressed" IK.timerNone
       else return UseDud  -- no message, because common and not crucial

-- ** PutToSleep

effectPutToSleep :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectPutToSleep execSfx target = do
  tb <- getsState $ getActorBody target
  if | bproj tb -> return UseDud
     | bwatch tb `elem` [WSleep, WWake] -> return UseId  -- can't increase sleep
     | otherwise -> do
       actorMaxSk <- getsState $ getActorMaxSkills target
       let maxCalm = xM $ Ability.getSk Ability.SkMaxCalm actorMaxSk
           deltaCalm = maxCalm - bcalm tb
       when (deltaCalm > 0) $
         updateCalm target deltaCalm  -- max Calm, but asleep vulnerability
       execSfx
       case bwatch tb of
         WWait n | n > 0 -> do
           nAll <- removeConditionSingle "braced" target
           let !_A = assert (nAll == 0) ()
           return ()
         _ -> return ()
       -- Forced sleep. No check if the actor can sleep naturally.
       addSleep target
       return UseUp

-- ** Yell

-- This is similar to 'reqYell', but also mentions that the actor is startled,
-- because, presumably, he yells involuntarily. It doesn't wake him up
-- via Calm instantly, just like yelling in a dream not always does.
effectYell :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectYell execSfx target = do
  tb <- getsState $ getActorBody target
  if bproj tb || bhp tb <= 0 then  -- avoid yelling projectiles or corpses
    return UseDud  -- the yell never manifested
  else do
    execSfx
    execSfxAtomic $ SfxTaunt False target
    when (deltaBenign $ bcalmDelta tb) $
      execUpdAtomic $ UpdRefillCalm target minusM
    return UseUp

-- ** Summon

-- Note that the Calm expended doesn't depend on the number of actors summoned.
effectSummon :: MonadServerAtomic m
             => GroupName ItemKind -> Dice.Dice -> ItemId
             -> ActorId -> ActorId -> Bool
             -> m UseResult
effectSummon grp nDm iid source target periodic = do
  -- Obvious effect, nothing announced.
  cops@COps{coTileSpeedup} <- getsState scops
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  sMaxSk <- getsState $ getActorMaxSkills source
  tMaxSk <- getsState $ getActorMaxSkills target
  totalDepth <- getsState stotalDepth
  lvl@Level{ldepth, lbig} <- getLevel (blid tb)
  nFriends <- getsState $ length . friendRegularAssocs (bfid sb) (blid sb)
  discoAspect <- getsState sdiscoAspect
  power0 <- rndToAction $ castDice ldepth totalDepth nDm
  let arItem = discoAspect EM.! iid
      power = max power0 1  -- KISS, always at least one summon
      -- We put @source@ instead of @target@ and @power@ instead of dice
      -- to make the message more accurate.
      effect = IK.Summon grp $ Dice.intToDice power
      durable = IA.checkFlag Ability.Durable arItem
      warnBothActors warning =
       unless (bproj sb) $ do
         execSfxAtomic $ SfxMsgFid (bfid sb) warning
         when (source /= target) $
           execSfxAtomic $ SfxMsgFid (bfid tb) warning
      deltaCalm = - xM 30
  -- Verify Calm only at periodic activations or if the item is durable.
  -- Otherwise summon uses up the item, which prevents summoning getting
  -- out of hand. I don't verify Calm otherwise, to prevent an exploit
  -- via draining one's calm on purpose when an item with good activation
  -- has a nasty summoning side-effect (the exploit still works on durables).
  if | (periodic || durable) && not (bproj sb)
       && (bcalm sb < - deltaCalm || not (calmEnough sb sMaxSk)) -> do
       warnBothActors $ SfxSummonLackCalm source
       return UseId
     | nFriends >= 20 -> do
       -- We assume the actor tries to summon his teammates or allies.
       -- As he repeats such summoning, he is going to bump into this limit.
       -- If he summons others, see the next condition.
       warnBothActors $ SfxSummonTooManyOwn source
       return UseId
     | EM.size lbig >= 200 -> do  -- lower than the 300 limit for spawning
       -- Even if the actor summons foes, he is prevented from exploiting it
       -- too many times and stopping natural monster spawning on the level
       -- (e.g., by filling the level with harmless foes).
       warnBothActors $ SfxSummonTooManyAll source
       return UseId
     | otherwise -> do
       unless (bproj sb) $ updateCalm source deltaCalm
       let validTile t = not $ Tile.isNoActor coTileSpeedup t
           ps = nearbyFreePoints cops lvl validTile (bpos tb)
       localTime <- getsState $ getLocalTime (blid tb)
       -- Make sure summoned actors start acting after the victim.
       let actorTurn = ticksPerMeter $ gearSpeed tMaxSk
           targetTime = timeShift localTime actorTurn
           afterTime = timeShift targetTime $ Delta timeClip
       when (length (take power ps) < power) $
          debugPossiblyPrint
            "Server: effectSummon: failed to find enough free positions"
       bs <- forM (take power ps) $ \p -> do
         -- Mark as summoned to prevent immediate chain summoning.
         -- Summon from current depth, not deeper due to many spawns already.
         maid <- addAnyActor True 0 [(grp, 1)] (blid tb) afterTime (Just p)
         case maid of
           Nothing -> return False  -- suspect content; server debug elsewhere
           Just aid -> do
             b <- getsState $ getActorBody aid
             mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD
             when (isNothing mleader) $ setFreshLeader (bfid b) aid
             return True
       if or bs then do
         execSfxAtomic $ SfxEffect (bfid sb) source effect 0
         return UseUp
       else do
         -- We don't display detailed warnings when @addAnyActor@ fails,
         -- e.g., because the actor groups can't be generated on a given level.
         -- However, we at least don't claim any summoning happened
         -- and we offer a general summoning failure messages.
         warnBothActors $ SfxSummonFailure source
         return UseId

-- ** Ascend

-- Note that projectiles can be teleported, too, for extra fun.
effectAscend :: MonadServerAtomic m
             => (IK.Effect -> m UseResult)
             -> m () -> Bool -> ActorId -> ActorId -> Point
             -> m UseResult
effectAscend recursiveCall execSfx up source target pos = do
  b1 <- getsState $ getActorBody target
  let lid1 = blid b1
  destinations <- getsState $ whereTo lid1 pos up . sdungeon
  sb <- getsState $ getActorBody source
  if | actorWaits b1 && source /= target -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid b1) $ SfxBracedImmune target
       return UseId
     | null destinations -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelNoMore
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid b1) SfxLevelNoMore
       -- We keep it useful even in shallow dungeons.
       recursiveCall $ IK.Teleport 30  -- powerful teleport
     | otherwise -> do
       (lid2, pos2) <- rndToAction $ oneOf destinations
       execSfx
       mbtime_bOld <-
         getsServer $ lookupActorTime (bfid b1) lid1 target . sactorTime
       mbtimeTraj_bOld <-
         getsServer $ lookupActorTime (bfid b1) lid1 target . strajTime
       pos3 <- findStairExit (bfid sb) up lid2 pos2
       let switch1 = void $ switchLevels1 (target, b1)
           switch2 = do
             -- Make the initiator of the stair move the leader,
             -- to let him clear the stairs for others to follow.
             let mlead = if bproj b1 then Nothing else Just target
             -- Move the actor to where the inhabitants were, if any.
             switchLevels2 lid2 pos3 (target, b1)
                           mbtime_bOld mbtimeTraj_bOld mlead
       -- The actor will be added to the new level,
       -- but there can be other actors at his new position.
       inhabitants <- getsState $ posToAidAssocs pos3 lid2
       case inhabitants of
         [] -> do
           switch1
           switch2
         (_, b2) : _ -> do
           -- Alert about the switch.
           execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelPushed
           -- Only tell one pushed player, even if many actors, because then
           -- they are projectiles, so not too important.
           when (source /= target) $
             execSfxAtomic $ SfxMsgFid (bfid b2) SfxLevelPushed
           -- Move the actor out of the way.
           switch1
           -- Move the inhabitants out of the way and to where the actor was.
           let moveInh inh = do
                 -- Preserve the old leader, since the actor is pushed,
                 -- so possibly has nothing worhwhile to do on the new level
                 -- (and could try to switch back, if made a leader,
                 -- leading to a loop).
                 mbtime_inh <-
                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)
                                . sactorTime
                 mbtimeTraj_inh <-
                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)
                                . strajTime
                 inhMLead <- switchLevels1 inh
                 switchLevels2 lid1 (bpos b1) inh
                               mbtime_inh mbtimeTraj_inh inhMLead
           mapM_ moveInh inhabitants
           -- Move the actor to his destination.
           switch2
       return UseUp

findStairExit :: MonadStateRead m
              => FactionId -> Bool -> LevelId -> Point -> m Point
findStairExit side moveUp lid pos = do
  COps{coTileSpeedup} <- getsState scops
  fact <- getsState $ (EM.! side) . sfactionD
  lvl <- getLevel lid
  let defLanding = uncurry Vector $ if moveUp then (1, 0) else (-1, 0)
      center = uncurry Vector $ if moveUp then (-1, 0) else (1, 0)
      (mvs2, mvs1) = break (== defLanding) moves
      mvs = center : filter (/= center) (mvs1 ++ mvs2)
      ps = filter (Tile.isWalkable coTileSpeedup . (lvl `at`))
           $ map (shift pos) mvs
      posOcc :: State -> Int -> Point -> Bool
      posOcc s k p = case posToAidAssocs p lid s of
        [] -> k == 0
        (_, b) : _ | bproj b -> k == 3
        (_, b) : _ | isFoe side fact (bfid b) -> k == 1  -- non-proj foe
        _ -> k == 2  -- moving a non-projectile friend
  unocc <- getsState posOcc
  case concatMap (\k -> filter (unocc k) ps) [0..3] of
    [] -> error $ "" `showFailure` ps
    posRes : _ -> return posRes

switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 (aid, bOld) = do
  let side = bfid bOld
  mleader <- getsState $ gleader . (EM.! side) . sfactionD
  -- Prevent leader pointing to a non-existing actor.
  mlead <-
    if not (bproj bOld) && isJust mleader then do
      execUpdAtomic $ UpdLeadFaction side mleader Nothing
      return mleader
        -- outside of a client we don't know the real tgt of aid, hence fst
    else return Nothing
  -- Remove the actor from the old level.
  -- Onlookers see somebody disappear suddenly.
  -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead.
  ais <- getsState $ getCarriedAssocsAndTrunk bOld
  execUpdAtomic $ UpdLoseActor aid bOld ais
  return mlead

switchLevels2 ::MonadServerAtomic m
              => LevelId -> Point -> (ActorId, Actor)
              -> Maybe Time -> Maybe Time -> Maybe ActorId
              -> m ()
switchLevels2 lidNew posNew (aid, bOld) mbtime_bOld mbtimeTraj_bOld mlead = do
  let lidOld = blid bOld
      side = bfid bOld
  let !_A = assert (lidNew /= lidOld `blame` "stairs looped" `swith` lidNew) ()
  -- Sync actor's items' timeouts with the new local time of the level.
  -- We need to sync organs and equipment due to periodic activations,
  -- but also inventory pack (as well as some organs and equipment),
  -- due to timeouts after use, e.g., for some weapons (they recharge also
  -- in the pack; however, this doesn't encourage micromanagement for periodic
  -- items, because the timeout is randomised upon move to equipment).
  --
  -- We don't rebase timeouts for items in stash, because they are
  -- used by many actors on levels with different local times,
  -- so there is no single rebase that would match all.
  -- This is not a big problem: after a single use by an actor the timeout is
  -- set to his current local time, so further uses by that actor have
  -- not anomalously short or long recharge times. If the recharge time
  -- is very long, the player has an option of moving the item from stash
  -- to pack and back, to reset the timeout. An abuse is possible when recently
  -- used item is put from inventory to stash and at once used on another level
  -- taking advantage of local time difference, but this only works once
  -- and using the item back again at the original level makes the recharge
  -- time longer, in turn.
  timeOld <- getsState $ getLocalTime lidOld
  timeLastActive <- getsState $ getLocalTime lidNew
  let delta = timeLastActive `timeDeltaToFrom` timeOld
      shiftByDelta = (`timeShift` delta)
      computeNewTimeout :: ItemQuant -> ItemQuant
      computeNewTimeout (k, it) = (k, map shiftByDelta it)
      rebaseTimeout :: ItemBag -> ItemBag
      rebaseTimeout = EM.map computeNewTimeout
      bNew = bOld { blid = lidNew
                  , bpos = posNew
                  , boldpos = Just posNew  -- new level, new direction
                  , borgan = rebaseTimeout $ borgan bOld
                  , beqp = rebaseTimeout $ beqp bOld
                  , binv = rebaseTimeout $ binv bOld }
  ais <- getsState $ getCarriedAssocsAndTrunk bOld
  -- Sync the actor time with the level time.
  -- This time shift may cause a double move of a foe of the same speed,
  -- but this is OK --- the foe didn't have a chance to move
  -- before, because the arena went inactive, so he moves now one more time.
  maybe (return ())
        (\btime_bOld ->
    modifyServer $ \ser ->
      ser {sactorTime = updateActorTime (bfid bNew) lidNew aid
                                        (shiftByDelta btime_bOld)
                        $ sactorTime ser})
        mbtime_bOld
  maybe (return ())
        (\btime_bOld ->
    modifyServer $ \ser ->
      ser {strajTime = updateActorTime (bfid bNew) lidNew aid
                                       (shiftByDelta btime_bOld)
                       $ strajTime ser})
        mbtimeTraj_bOld
  -- Materialize the actor at the new location.
  -- Onlookers see somebody appear suddenly. The actor himself
  -- sees new surroundings and has to reset his perception.
  execUpdAtomic $ UpdCreateActor aid bNew ais
  case mlead of
    Nothing -> return ()
    Just leader ->
      -- The leader is fresh in the sense that he's on a new level
      -- and so doesn't have up to date Perception.
      setFreshLeader side leader

-- ** Escape

-- | The faction leaves the dungeon.
effectEscape :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult
effectEscape execSfx source target = do
  -- Obvious effect, nothing announced.
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  let fid = bfid tb
  fact <- getsState $ (EM.! fid) . sfactionD
  if | bproj tb ->
       return UseDud  -- basically a misfire
     | not (fcanEscape $ gplayer fact) -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxEscapeImpossible
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) SfxEscapeImpossible
       return UseId
     | otherwise -> do
       execSfx
       deduceQuits (bfid tb) $ Status Escape (fromEnum $ blid tb) Nothing
       return UseUp

-- ** Paralyze

-- | Advance target actor time by this many time clips. Not by actor moves,
-- to hurt fast actors more.
effectParalyze :: MonadServerAtomic m
               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectParalyze execSfx nDm source target = do
  tb <- getsState $ getActorBody target
  if bproj tb then return UseDud else  -- shortcut for speed
    paralyze execSfx nDm source target

paralyze :: MonadServerAtomic m
         => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
paralyze execSfx nDm source target = do
  tb <- getsState $ getActorBody target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  power0 <- rndToAction $ castDice ldepth totalDepth nDm
  let power = max power0 1  -- KISS, avoid special case
  actorStasis <- getsServer sactorStasis
  if | ES.member target actorStasis -> do
       sb <- getsState $ getActorBody source
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects
       return UseId
     | otherwise -> do
       execSfx
       let t = timeDeltaScale (Delta timeClip) power
       -- Only the normal time, not the trajectory time, is affected.
       modifyServer $ \ser ->
         ser { sactorTime = ageActor (bfid tb) (blid tb) target t
                            $ sactorTime ser
             , sactorStasis = ES.insert target (sactorStasis ser) }
                 -- actor's time warped, so he is in stasis,
                 -- immune to further warps
       return UseUp

-- ** ParalyzeInWater

-- | Advance target actor time by this many time clips. Not by actor moves,
-- to hurt fast actors more. Due to water, so resistable.
effectParalyzeInWater :: MonadServerAtomic m
                      => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectParalyzeInWater execSfx nDm source target = do
  tb <- getsState $ getActorBody target
  if bproj tb then return UseDud else do  -- shortcut for speed
    actorMaxSk <- getsState $ getActorMaxSkills target
    let swimmingOrFlying = max (Ability.getSk Ability.SkSwimming actorMaxSk)
                               (Ability.getSk Ability.SkFlying actorMaxSk)
    if Dice.supDice nDm > swimmingOrFlying
    then paralyze execSfx nDm source target  -- no help at all
    else  -- fully resisted
      -- Don't spam:
      -- sb <- getsState $ getActorBody source
      -- execSfxAtomic $ SfxMsgFid (bfid sb) SfxWaterParalysisResisted
      return UseId

-- ** InsertMove

-- | Give target actor the given number of tenths of extra move. Don't give
-- an absolute amount of time units, to benefit slow actors more.
effectInsertMove :: MonadServerAtomic m
                 => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectInsertMove execSfx nDm source target = do
  tb <- getsState $ getActorBody target
  actorMaxSk <- getsState $ getActorMaxSkills target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  actorStasis <- getsServer sactorStasis
  power0 <- rndToAction $ castDice ldepth totalDepth nDm
  let power = max power0 1  -- KISS, avoid special case
      actorTurn = ticksPerMeter $ gearSpeed actorMaxSk
      t = timeDeltaScale (timeDeltaPercent actorTurn 10) (-power)
  if | bproj tb -> return UseDud  -- shortcut for speed
     | ES.member target actorStasis -> do
       sb <- getsState $ getActorBody source
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects
       return UseId
     | otherwise -> do
       execSfx
       -- Only the normal time, not the trajectory time, is affected.
       modifyServer $ \ser ->
         ser { sactorTime = ageActor (bfid tb) (blid tb) target t
                            $ sactorTime ser
             , sactorStasis = ES.insert target (sactorStasis ser) }
                 -- actor's time warped, so he is in stasis,
                 -- immune to further warps
       return UseUp

-- ** Teleport

-- | Teleport the target actor.
-- Note that projectiles can be teleported, too, for extra fun.
effectTeleport :: MonadServerAtomic m
               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectTeleport execSfx nDm source target = do
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  if actorWaits tb && source /= target
       -- immune only against not own effects, to enable teleport as beneficial
       -- necklace drawback; also consistent with sleep not protecting
  then do
    execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target
    when (source /= target) $
      execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target
    return UseId
  else do
    COps{coTileSpeedup} <- getsState scops
    totalDepth <- getsState stotalDepth
    lvl@Level{ldepth} <- getLevel (blid tb)
    range <- rndToAction $ castDice ldepth totalDepth nDm
    let spos = bpos tb
        dMinMax !delta !pos =
          let d = chessDist spos pos
          in d >= range - delta && d <= range + delta
        dist !delta !pos _ = dMinMax delta pos
    mtpos <- rndToAction $ findPosTry 200 lvl
      (\p !t -> Tile.isWalkable coTileSpeedup t
                && not (Tile.isNoActor coTileSpeedup t)
                && not (occupiedBigLvl p lvl)
                && not (occupiedProjLvl p lvl))
      [ dist 1
      , dist $ 1 + range `div` 9
      , dist $ 1 + range `div` 7
      , dist $ 1 + range `div` 5
      , dist 5
      , dist 7
      , dist 9
      ]
    case mtpos of
      Nothing -> do  -- really very rare, so debug
        debugPossiblyPrint
          "Server: effectTeleport: failed to find any free position"
        execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible
        when (source /= target) $
          execSfxAtomic $ SfxMsgFid (bfid tb) SfxTransImpossible
        return UseId
      Just tpos -> do
        execSfx
        execUpdAtomic $ UpdMoveActor target spos tpos
        return UseUp

-- ** CreateItem

effectCreateItem :: MonadServerAtomic m
                 => Maybe FactionId -> Maybe Int -> ActorId -> ActorId -> CStore
                 -> GroupName ItemKind -> IK.TimerDice
                 -> m UseResult
effectCreateItem jfidRaw mcount source target store grp tim = do
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  let fscale unit nDm = do
        k0 <- rndToAction $ castDice ldepth totalDepth nDm
        let k = max 1 k0  -- KISS, don't freak out if dice permit 0
        return $! timeDeltaScale unit k
      fgame = fscale (Delta timeTurn)
      factor nDm = do
        actorMaxSk <- getsState $ getActorMaxSkills target
        -- A tiny bit added to make sure length 1 effect doesn't end before
        -- the end of first turn, which would make, e.g., speed, useless.
        let actorTurn =
              timeDeltaPercent (ticksPerMeter $ gearSpeed actorMaxSk) 101
        fscale actorTurn nDm
  delta <- IK.foldTimer (return $ Delta timeZero) fgame factor tim
  let c = CActor target store
  bagBefore <- getsState $ getBodyStoreBag tb store
  -- Power depth of new items unaffected by number of spawned actors.
  freq <- prepareItemKind 0 (blid tb) [(grp, 1)]
  m2 <- rollItemAspect freq (blid tb)
  let (itemKnownRaw, (itemFullRaw, kitRaw)) =
        fromMaybe (error $ "" `showFailure` (blid tb, freq, c)) m2
      -- Avoid too many different item identifiers (one for each faction)
      -- for blasts or common item generating tiles. Conditions are
      -- allowed to be duplicated, because they provide really useful info
      -- (perpetrator). However, if timer is none, they are not duplicated
      -- to make sure that, e.g., poisons stack with each other regardless
      -- of perpetrator and we don't get "no longer poisoned" message
      -- while still poisoned due to another faction. With timed aspects,
      -- e.g., slowness, the message is less misleading, and it's interesting
      -- that I'm twice slower due to aspects from two factions and not
      -- as deadly as being poisoned at twice the rate from two factions.
      jfid = if store == COrgan && not (IK.isTimerNone tim)
                || grp == "impressed"
             then jfidRaw
             else Nothing
      (itemKnown, itemFull) =
        let ItemKnown kindIx ar _ = itemKnownRaw
        in ( ItemKnown kindIx ar jfid
           , itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} )
      kitNew = case mcount of
        Just itemK -> (itemK, [])
        Nothing -> kitRaw
  itemRev <- getsServer sitemRev
  let mquant = case HM.lookup itemKnown itemRev of
        Nothing -> Nothing
        Just iid -> (iid,) <$> iid `EM.lookup` bagBefore
  case mquant of
    Just (iid, (_, afterIt@(timer : rest))) | not $ IK.isTimerNone tim -> do
      -- Already has such items and timer change requested, so only increase
      -- the timer of the first item by the delta, but don't create items.
      let newIt = timer `timeShift` delta : rest
      if afterIt /= newIt then do
        execUpdAtomic $ UpdTimeItem iid c afterIt newIt
        -- It's hard for the client to tell this timer change from charge use,
        -- timer reset on pickup, etc., so we create the msg manually.
        -- Sending to both involved factions lets the player notice
        -- both the extensions he caused and suffered. Other faction causing
        -- that on themselves or on others won't be noticed. TMI.
        execSfxAtomic $ SfxMsgFid (bfid sb)
                      $ SfxTimerExtended (blid tb) target iid store delta
        when (bfid sb /= bfid tb) $
          execSfxAtomic $ SfxMsgFid (bfid tb)
                        $ SfxTimerExtended (blid tb) target iid store delta
        return UseUp
      else return UseDud  -- probably incorrect content, but let it be
    _ -> do
      -- No such items or some items, but void delta, so create items.
      -- If it's, e.g., a periodic poison, the new items will stack with any
      -- already existing items.
      iid <- registerItem (itemFull, kitNew) itemKnown c True
      -- If created not on the ground, ID it, because it won't be on pickup.
      when (store /= CGround) $
        discoverIfMinorEffects c iid (itemKindId itemFull)
      -- Now, if timer change requested, change the timer, but in the new items,
      -- possibly increased in number wrt old items.
      when (not $ IK.isTimerNone tim) $ do
        tb2 <- getsState $ getActorBody target
        bagAfter <- getsState $ getBodyStoreBag tb2 store
        localTime <- getsState $ getLocalTime (blid tb)
        let newTimer = localTime `timeShift` delta
            (afterK, afterIt) =
              fromMaybe (error $ "" `showFailure` (iid, bagAfter, c))
                        (iid `EM.lookup` bagAfter)
            newIt = replicate afterK newTimer
        when (afterIt /= newIt) $
          execUpdAtomic $ UpdTimeItem iid c afterIt newIt
      return UseUp

-- ** DropItem

-- | Make the target actor drop items in a store from the given group.
-- The item itself is immune (any copies).
effectDropItem :: MonadServerAtomic m
               => m () -> ItemId -> Int -> Int -> CStore
               -> GroupName ItemKind -> ActorId
               -> m UseResult
effectDropItem execSfx iidId ngroup kcopy store grp target = do
  tb <- getsState $ getActorBody target
  fact <- getsState $ (EM.! bfid tb) . sfactionD
  isRaw <- allGroupItems store grp target
  curChalSer <- getsServer $ scurChalSer . soptions
  factionD <- getsState sfactionD
  let is = filter ((/= iidId) . fst) isRaw
  if | bproj tb || null is -> return UseDud
     | ngroup == maxBound && kcopy == maxBound
       && store `elem` [CEqp, CInv, CSha]
       && fhasGender (gplayer fact)  -- hero in Allure's decontamination chamber
       && (cdiff curChalSer == 1     -- at lowest difficulty for its faction
           && any (fhasUI . gplayer . snd)
                  (filter (\(fi, fa) -> isFriend fi fa (bfid tb))
                          (EM.assocs factionD))
           || cdiff curChalSer == difficultyBound
              && any (fhasUI . gplayer  . snd)
                     (filter (\(fi, fa) -> isFoe fi fa (bfid tb))
                             (EM.assocs factionD))) ->
{-
A hardwired hack, because AI heroes don't cope with Allure's decontamination
chamber; beginners may struggle too, so this is trigered by difficulty.
- AI heroes don't switch leader to the hero past laboratory to equip
weapons from stash between the in-lab hero picks up the loot pile
and himself enters the decontamination chamber
- all consumables always end up in a pack and the whole pack
is always left behind, because consumables are not shared among
actors via shared stash (yet); we could pack consumables to stash
by default, but it's too confusing and risky for beginner players
and doesn't work for heroes that have not enough Calm ATM and AI
would still need to learn to spread consumables from stash to packs afterwards
- the items of the last actor would be lost anyway, unless AI
is taught the foolproof solution of this puzzle, which is yet a bit more
specific than the two general abilities described as desirable above
-}
       return UseUp
     | otherwise -> do
       unless (store == COrgan) execSfx
       mapM_ (uncurry (dropCStoreItem True store target tb kcopy))
             (take ngroup is)
       return UseUp

-- | Drop a single actor's item (though possibly multiple copies).
-- Note that if there are multiple copies, at most one explodes
-- to avoid excessive carnage and UI clutter (let's say,
-- the multiple explosions interfere with each other or perhaps
-- larger quantities of explosives tend to be packaged more safely).
-- Note also that @OnSmash@ effects are activated even if item discharged.
dropCStoreItem :: MonadServerAtomic m
               => Bool -> CStore -> ActorId -> Actor -> Int
               -> ItemId -> ItemQuant
               -> m ()
dropCStoreItem verbose store aid b kMax iid (k, _) = do
  itemFull@ItemFull{itemBase} <- getsState $ itemToFull iid
  let arItem = aspectRecordFull itemFull
      c = CActor aid store
      fragile = IA.checkFlag Ability.Fragile arItem
      durable = IA.checkFlag Ability.Durable arItem
      isDestroyed = bproj b && (bhp b <= 0 && not durable || fragile)
                    || IA.checkFlag Ability.Condition arItem
  if isDestroyed then do
    let -- We don't know if it's voluntary, so we conservatively assume
        -- it is and we blame @aid@.
        voluntary = True
        onSmashOnly = True
        useAllCopies = kMax >= k
    effectAndDestroyAndAddKill voluntary aid onSmashOnly useAllCopies False
                               aid aid iid c False itemFull True
    -- One copy was destroyed (or none if the item was discharged),
    -- so let's mop up.
    bag <- getsState $ getContainerBag c
    maybe (return ())
          (\(k1, it) ->
             let destroyedSoFar = k - k1
                 k2 = min (kMax - destroyedSoFar) k1
                 kit2 = (k2, take k2 it)
             in when (k2 > 0)
                $ execUpdAtomic $ UpdLoseItem False iid itemBase kit2 c)
          (EM.lookup iid bag)
  else do
    cDrop <- pickDroppable False aid b  -- drop over fog, etc.
    mvCmd <- generalMoveItem verbose iid (min kMax k) (CActor aid store) cDrop
    mapM_ execUpdAtomic mvCmd

pickDroppable :: MonadStateRead m => Bool -> ActorId -> Actor -> m Container
pickDroppable respectNoItem aid b = do
  cops@COps{coTileSpeedup} <- getsState scops
  lvl <- getLevel (blid b)
  let validTile t = not (respectNoItem && Tile.isNoItem coTileSpeedup t)
  if validTile $ lvl `at` bpos b
  then return $! CActor aid CGround
  else do
    let ps = nearbyFreePoints cops lvl validTile (bpos b)
    return $! case filter (adjacent $ bpos b) $ take 8 ps of
      [] -> CActor aid CGround  -- fallback; still correct, though not ideal
      pos : _ -> CFloor (blid b) pos

-- ** PolyItem

-- Can't apply to the item itself (any copies).
effectPolyItem :: MonadServerAtomic m
               => m () -> ItemId -> ActorId -> m UseResult
effectPolyItem execSfx iidId target = do
  tb <- getsState $ getActorBody target
  let cstore = CGround
  kitAss <- getsState $ kitAssocs target [cstore]
  case filter ((/= iidId) . fst) kitAss of
    [] -> do
      execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNothing
      -- Do not spam the source actor player about the failures.
      return UseId
    (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind}
          , (itemK, itemTimer) )) : _ -> do
      let arItem = aspectRecordFull itemFull
          maxCount = Dice.supDice $ IK.icount itemKind
      if | IA.checkFlag Ability.Unique arItem -> do
           execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeUnique
           return UseId
         | maybe True (<= 0) $ lookup "common item" $ IK.ifreq itemKind -> do
           execSfxAtomic $ SfxMsgFid (bfid tb) SfxPurposeNotCommon
           return UseId
         | itemK < maxCount -> do
           execSfxAtomic $ SfxMsgFid (bfid tb)
                         $ SfxPurposeTooFew maxCount itemK
           return UseId
         | otherwise -> do
           -- Only the required number of items is used up, not all of them.
           let c = CActor target cstore
               kit = (maxCount, take maxCount itemTimer)
           execSfx
           identifyIid iid c itemKindId itemKind
           execUpdAtomic $ UpdDestroyItem iid itemBase kit c
           effectCreateItem (Just $ bfid tb) Nothing
                            target target cstore "common item" IK.timerNone

-- ** RerollItem

-- Can't apply to the item itself (any copies).
effectRerollItem :: forall m . MonadServerAtomic m
                 => m () -> ItemId -> ActorId -> m UseResult
effectRerollItem execSfx iidId target = do
  COps{coItemSpeedup} <- getsState scops
  tb <- getsState $ getActorBody target
  let cstore = CGround  -- if ever changed, call @discoverIfMinorEffects@
  kitAss <- getsState $ kitAssocs target [cstore]
  case filter ((/= iidId) . fst) kitAss of
    [] -> do
      execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNothing
      -- Do not spam the source actor player about the failures.
      return UseId
    (iid, ( ItemFull{ itemBase, itemKindId, itemKind
                    , itemDisco=ItemDiscoFull itemAspect }
          , (_, itemTimer) )) : _ ->
      if | IA.kmConst $ getKindMean itemKindId coItemSpeedup -> do
           execSfxAtomic $ SfxMsgFid (bfid tb) SfxRerollNotRandom
           return UseId
         | otherwise -> do
           let c = CActor target cstore
               kit = (1, take 1 itemTimer)  -- prevent micromanagement
               freq = pure (itemKindId, itemKind)
           execSfx
           identifyIid iid c itemKindId itemKind
           execUpdAtomic $ UpdDestroyItem iid itemBase kit c
           dungeon <- getsState sdungeon
           let maxLid = fst $ maximumBy (Ord.comparing (ldepth . snd))
                            $ EM.assocs dungeon
               roll100 :: Int -> m (ItemKnown, ItemFullKit)
               roll100 n = do
                 m2 <- rollItemAspect freq maxLid
                 case m2 of
                   Nothing ->
                     error "effectRerollItem: can't create rerolled item"
                   Just i2@(ItemKnown _ ar2 _, _) ->
                     if ar2 == itemAspect && n > 0
                     then roll100 (n - 1)
                     else return i2
           (itemKnown, (itemFull, _)) <- roll100 100
           void $ registerItem (itemFull, kit) itemKnown c True
           return UseUp
    _ -> error "effectRerollItem: server ignorant about an item"

-- ** DupItem

-- Can't apply to the item itself (any copies).
effectDupItem :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult
effectDupItem execSfx iidId target = do
  tb <- getsState $ getActorBody target
  let cstore = CGround  -- beware of other options, e.g., creating in eqp
                        -- and not setting timeout to a random value
  kitAss <- getsState $ kitAssocs target [cstore]
  case filter ((/= iidId) . fst) kitAss of
    [] -> do
      execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupNothing
      -- Do not spam the source actor player about the failures.
      return UseId
    (iid, ( itemFull@ItemFull{itemBase, itemKindId, itemKind}
          , _ )) : _ -> do
      let arItem = aspectRecordFull itemFull
      if | IA.checkFlag Ability.Unique arItem -> do
           execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupUnique
           return UseId
         | maybe False (> 0) $ lookup "valuable" $ IK.ifreq itemKind -> do
           execSfxAtomic $ SfxMsgFid (bfid tb) SfxDupValuable
           return UseId
         | otherwise -> do
           let c = CActor target cstore
           execSfx
           identifyIid iid c itemKindId itemKind
           execUpdAtomic $ UpdCreateItem iid itemBase (1, []) c
           return UseUp

-- ** Identify

effectIdentify :: MonadServerAtomic m
               => m () -> ItemId -> ActorId -> m UseResult
effectIdentify execSfx iidId target = do
  COps{coItemSpeedup} <- getsState scops
  discoAspect <- getsState sdiscoAspect
  -- The actor that causes the application does not determine what item
  -- is identifiable, becuase it's the target actor that identifies
  -- his possesions.
  tb <- getsState $ getActorBody target
  sClient <- getsServer $ (EM.! bfid tb) . sclientStates
  let tryFull store as = case as of
        [] -> return False
        (iid, _) : rest | iid == iidId -> tryFull store rest  -- don't id itself
        (iid, ItemFull{itemBase, itemKindId, itemKind}) : rest -> do
          let arItem = discoAspect EM.! iid
              kindIsKnown = case jkind itemBase of
                IdentityObvious _ -> True
                IdentityCovered ix _ -> ix `EM.member` sdiscoKind sClient
          if iid `EM.member` sdiscoAspect sClient  -- already fully identified
             || IA.isHumanTrinket itemKind  -- hack; keep them non-identified
             || store == CGround && IA.onlyMinorEffects arItem itemKind
               -- will be identified when picked up, so don't bother
             || IA.kmConst (getKindMean itemKindId coItemSpeedup)
                && kindIsKnown
               -- constant aspects and known kind; no need to identify further;
               -- this should normally not be needed, since clients should
               -- identify such items for free
          then tryFull store rest
          else do
            let c = CActor target store
            execSfx
            identifyIid iid c itemKindId itemKind
            return True
      tryStore stores = case stores of
        [] -> do
          execSfxAtomic $ SfxMsgFid (bfid tb) SfxIdentifyNothing
          return UseId  -- the message tells it's ID effect
        store : rest -> do
          allAssocs <- getsState $ fullAssocs target [store]
          go <- tryFull store allAssocs
          if go then return UseUp else tryStore rest
  tryStore [CGround, CEqp, CInv, CSha]

identifyIid :: MonadServerAtomic m
            => ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid iid c itemKindId itemKind =
  unless (IA.isHumanTrinket itemKind) $ do
    discoAspect <- getsState sdiscoAspect
    execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid

-- ** Detect

effectDetect :: MonadServerAtomic m
             => m () -> IK.DetectKind -> Int -> ActorId -> Point -> m UseResult
effectDetect execSfx d radius target pos = do
  COps{coitem, coTileSpeedup} <- getsState scops
  b <- getsState $ getActorBody target
  lvl <- getLevel $ blid b
  s <- getState
  getKind <- getsState $ flip getIidKindServer
  let lootPredicate p =
        p `EM.member` lfloor lvl
        || (case posToBigAssoc p (blid b) s of
              Nothing -> False
              Just (_, body) ->
                let belongings = EM.keys (beqp body) ++ EM.keys (binv body)
                      -- shared stash ignored, because hard to get
                in any belongingIsLoot belongings)
        || any embedHasLoot (EM.keys $ getEmbedBag (blid b) p s)
      itemKindIsLoot = isNothing . lookup "unreported inventory" . IK.ifreq
      belongingIsLoot iid = itemKindIsLoot $ getKind iid
      embedHasLoot iid = any effectHasLoot $ IK.ieffects $ getKind iid
      reported acc _ _ itemKind = acc && itemKindIsLoot itemKind
      effectHasLoot (IK.CreateItem cstore grp _) =
        cstore `elem` [CGround, CEqp, CInv, CSha]
        && ofoldlGroup' coitem grp reported True
      effectHasLoot IK.PolyItem = True
      effectHasLoot IK.RerollItem = True
      effectHasLoot IK.DupItem = True
      effectHasLoot (IK.OneOf l) = any effectHasLoot l
      effectHasLoot (IK.OnSmash eff) = effectHasLoot eff
      effectHasLoot (IK.Composite l) = any effectHasLoot l
      effectHasLoot _ = False
      (predicate, action) = case d of
        IK.DetectAll -> (const True, const $ return False)
        IK.DetectActor -> ((`EM.member` lbig lvl), const $ return False)
        IK.DetectLoot -> (lootPredicate, const $ return False)
        IK.DetectExit ->
          let (ls1, ls2) = lstair lvl
          in ((`elem` ls1 ++ ls2 ++ lescape lvl), const $ return False)
        IK.DetectHidden ->
          let predicateH p = Tile.isHideAs coTileSpeedup $ lvl `at` p
              revealEmbed p = do
                embeds <- getsState $ getEmbedBag (blid b) p
                unless (EM.null embeds) $ do
                  let ais = map (\iid -> (iid, getItemBody iid s))
                                (EM.keys embeds)
                  execUpdAtomic $ UpdSpotItemBag (CEmbed (blid b) p) embeds ais
              actionH l = do
                let f p = when (p /= pos) $ do
                      let t = lvl `at` p
                      execUpdAtomic $ UpdSearchTile target p t
                      -- This is safe searching; embedded items
                      -- are not triggered, but they are revealed.
                      revealEmbed p
                      case EM.lookup p $ lentry lvl of
                        Nothing -> return ()
                        Just entry ->
                          execUpdAtomic $ UpdSpotEntry (blid b) [(p, entry)]
                mapM_ f l
                return $! not $ null l  -- KISS, even if client knows all
          in (predicateH, actionH)
        IK.DetectEmbed -> ((`EM.member` lembed lvl), const $ return False)
  effectDetectX d predicate action execSfx radius target

effectDetectX :: MonadServerAtomic m
              => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool)
              -> m () -> Int -> ActorId -> m UseResult
effectDetectX d predicate action execSfx radius target = do
  COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops
  b <- getsState $ getActorBody target
  sperFidOld <- getsServer sperFid
  let perOld = sperFidOld EM.! bfid b EM.! blid b
      Point x0 y0 = bpos b
      perList = filter predicate
        [ Point x y
        | y <- [max 0 (y0 - radius) .. min (rYmax - 1) (y0 + radius)]
        , x <- [max 0 (x0 - radius) .. min (rXmax - 1) (x0 + radius)]
        ]
      extraPer = emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList}
      inPer = diffPer extraPer perOld
  unless (nullPer inPer) $ do
    -- Perception is modified on the server and sent to the client
    -- together with all the revealed info.
    let perNew = addPer inPer perOld
        fper = EM.adjust (EM.insert (blid b) perNew) (bfid b)
    modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser}
    execSendPer (bfid b) (blid b) emptyPer inPer perNew
  pointsModified <- action perList
  if not (nullPer inPer) || pointsModified then do
    execSfx
    -- Perception is reverted. This is necessary to ensure save and restore
    -- doesn't change game state.
    unless (nullPer inPer) $ do
      modifyServer $ \ser -> ser {sperFid = sperFidOld}
      execSendPer (bfid b) (blid b) inPer emptyPer perOld
  else
    execSfxAtomic $ SfxMsgFid (bfid b) $ SfxVoidDetection d
  return UseUp  -- even if nothing spotted, in itself it's still useful data

-- ** SendFlying

-- | Send the target actor flying like a projectile. If the actors are adjacent,
-- the vector is directed outwards, if no, inwards, if it's the same actor,
-- boldpos is used, if it can't, a random outward vector of length 10
-- is picked.
effectSendFlying :: MonadServerAtomic m
                 => m () -> IK.ThrowMod -> ActorId -> ActorId -> Container
                 -> Maybe Bool
                 -> m UseResult
effectSendFlying execSfx IK.ThrowMod{..} source target c modePush = do
  v <- sendFlyingVector source target modePush
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  let eps = 0
      fpos = bpos tb `shift` v
      isEmbed = case c of
        CEmbed{} -> True
        _ -> False
  if bhp tb <= 0  -- avoid dragging around corpses
     || bproj tb && isEmbed then  -- fyling projectiles can't slip on the floor
    return UseDud  -- the impact never manifested
  else if actorWaits tb
          && source /= target
          && isNothing (btrajectory tb) then do
    execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target
    when (source /= target) $
      execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target
    return UseUp  -- waste it to prevent repeated throwing at immobile actors
  else do
   COps{corule=RuleContent{rXmax, rYmax}} <- getsState scops
   case bla rXmax rYmax eps (bpos tb) fpos of
    Nothing -> error $ "" `showFailure` (fpos, tb)
    Just [] -> error $ "projecting from the edge of level"
                       `showFailure` (fpos, tb)
    Just (pos : rest) -> do
      weightAssocs <- getsState $ fullAssocs target [CInv, CEqp, COrgan]
      let weight = sum $ map (IK.iweight . itemKind . snd) weightAssocs
          path = bpos tb : pos : rest
          (trajectory, (speed, _)) =
            -- Note that the @ThrowMod@ aspect of the actor's trunk is ignored.
            computeTrajectory weight throwVelocity throwLinger path
          ts = Just (trajectory, speed)
      if null trajectory
      then return UseId  -- e.g., actor is too heavy; but a jerk is noticeable
      else do
        execSfx
        -- Old and new trajectories are not added; the old one is replaced.
        unless (btrajectory tb == ts) $
          execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts
        -- If propeller is a projectile, it pushes involuntarily,
        -- so its originator is to blame.
        -- However, we can't easily see whether a pushed non-projectile actor
        -- pushed another due to colliding or voluntarily, so we assign
        -- blame to him.
        originator <- if bproj sb
                      then getsServer $ EM.findWithDefault source source
                                        . strajPushedBy
                      else return source
        modifyServer $ \ser ->
          ser {strajPushedBy = EM.insert target originator $ strajPushedBy ser}
        -- In case of pre-existing pushing, don't touch the time
        -- so that the pending @advanceTimeTraj@ can do its job
        -- (it will, because non-empty trajectory is here set, unless, e.g.,
        -- subsequent effects from the same item change the trajectory).
        when (isNothing $ btrajectory tb) $ do
          -- Set flying time to almost now, so that the push happens ASAP,
          -- because it's the first one, so almost no delay is needed.
          localTime <- getsState $ getLocalTime (blid tb)
          -- But add a slight overhead to avoid displace-slide loops
          -- of 3 actors in a line.
          let overheadTime = timeShift localTime (Delta timeClip)
          modifyServer $ \ser ->
            ser {strajTime =
                   updateActorTime (bfid tb) (blid tb) target overheadTime
                   $ strajTime ser}
        return UseUp

sendFlyingVector :: MonadServerAtomic m
                 => ActorId -> ActorId -> Maybe Bool -> m Vector
sendFlyingVector source target modePush = do
  sb <- getsState $ getActorBody source
  let boldpos_sb = fromMaybe (bpos sb) (boldpos sb)
  if source == target then
    if boldpos_sb == bpos sb then rndToAction $ do
      z <- randomR (-10, 10)
      oneOf [Vector 10 z, Vector (-10) z, Vector z 10, Vector z (-10)]
    else
      return $! vectorToFrom (bpos sb) boldpos_sb
  else do
    tb <- getsState $ getActorBody target
    let pushV = vectorToFrom (bpos tb) (bpos sb)
        pullV = vectorToFrom (bpos sb) (bpos tb)
    return $! case modePush of
                Just True -> pushV
                Just False -> pullV
                Nothing | adjacent (bpos sb) (bpos tb) -> pushV
                Nothing -> pullV

-- ** DropBestWeapon

-- | Make the target actor drop his best weapon.
-- The item itself is immune (any copies).
effectDropBestWeapon :: MonadServerAtomic m
                     => m () -> ItemId -> ActorId -> m UseResult
effectDropBestWeapon execSfx iidId target = do
  tb <- getsState $ getActorBody target
  if bproj tb then return UseDud else do
    localTime <- getsState $ getLocalTime (blid tb)
    kitAssRaw <- getsState $ kitAssocs target [CEqp]
    let kitAss = filter (\(iid, (i, _)) ->
                          IA.checkFlag Ability.Meleeable (aspectRecordFull i)
                          && iid /= iidId) kitAssRaw
        ignoreCharges = True
    case strongestMelee ignoreCharges Nothing localTime kitAss of
      (_, (_, (iid, _))) : _ -> do
        execSfx
        let kit = beqp tb EM.! iid
        dropCStoreItem True CEqp target tb 1 iid kit  -- not the whole stack
        return UseUp
      [] ->
        return UseDud

-- ** ActivateInv

-- | Activate all items with the given symbol
-- in the target actor's equipment (there's no variant that activates
-- a random one, to avoid the incentive for carrying garbage).
-- Only one item of each stack is activated (and possibly consumed).
-- Won't activate the item itself (any copies).
effectActivateInv :: MonadServerAtomic m
                  => m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult
effectActivateInv execSfx iidId source target symbol = do
  let c = CActor target CInv
  effectTransformContainer execSfx iidId symbol c $ \iid _ ->
    -- We don't know if it's voluntary, so we conservatively assume it is
    -- and we blame @source@.
    kineticEffectAndDestroy True source target target iid c True

effectTransformContainer :: forall m. MonadServerAtomic m
                         => m () -> ItemId -> Char -> Container
                         -> (ItemId -> ItemQuant -> m ())
                         -> m UseResult
effectTransformContainer execSfx iidId symbol c m = do
  getKind <- getsState $ flip getIidKindServer
  let hasSymbol (iid, _kit) = do
        let jsymbol = IK.isymbol $ getKind iid
        return $! jsymbol == symbol
  assocsCStore <- getsState $ EM.assocs . getContainerBag c
  is <- filter ((/= iidId) . fst) <$> if symbol == ' '
                                      then return assocsCStore
                                      else filterM hasSymbol assocsCStore
  if null is
  then return UseDud
  else do
    execSfx
    mapM_ (uncurry m) is
    -- Even if no item produced any visible effect, rummaging through
    -- the inventory uses up the effect and produced discernible vibrations.
    return UseUp

-- ** ApplyPerfume

effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectApplyPerfume execSfx target = do
  tb <- getsState $ getActorBody target
  Level{lsmell} <- getLevel $ blid tb
  unless (EM.null lsmell) $ do
    execSfx
    let f p fromSm = execUpdAtomic $ UpdAlterSmell (blid tb) p fromSm timeZero
    mapWithKeyM_ f lsmell
  return UseUp  -- even if no smell before, the perfume is noticeable

-- ** OneOf

effectOneOf :: MonadServerAtomic m
            => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult
effectOneOf recursiveCall l = do
  let call1 = do
        ef <- rndToAction $ oneOf l
        recursiveCall ef
      call99 = replicate 99 call1
      f call result = do
        ur <- call
        -- We avoid 99 calls to a fizzling effect that only prints
        -- a failure message and IDs the item.
        if ur == UseDud then result else return ur
  foldr f (return UseDud) call99
  -- no @execSfx@, because individual effects sent them

-- ** VerbNoLonger

effectVerbNoLonger :: MonadServerAtomic m
                   => Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger useAllCopies execSfx source = do
  b <- getsState $ getActorBody source
  when (useAllCopies  -- @UseUp@ below ensures that if all used, all destroyed
        && not (bproj b)) $  -- no spam when projectiles activate
    execSfx  -- announce that all copies have run out (or whatever message)
  return UseUp  -- help to destroy the copy, even if not all used up

-- ** VerbMsg

effectVerbMsg :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectVerbMsg execSfx source = do
  b <- getsState $ getActorBody source
  unless (bproj b) execSfx  -- don't spam when projectiles activate
  return UseUp  -- announcing always successful and this helps
                -- to destroy the item

-- ** Composite

effectComposite :: forall m. MonadServerAtomic m
                => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult
effectComposite recursiveCall l = do
  let f :: IK.Effect -> m UseResult -> m UseResult
      f eff result = do
        ur <- recursiveCall eff
        when (ur == UseUp) $ void result  -- UseResult comes from the first
        return ur
  foldr f (return UseDud) l
  -- no @execSfx@, because individual effects sent them
