    -- | Semantics of requests
    -- .
    -- A couple of them do not take time, the rest does.
    -- Note that since the results are atomic commands, which are executed
    -- only later (on the server and some of the clients), all condition
    -- are checkd by the semantic functions in the context of the state
    -- before the server command. Even if one or more atomic actions
    -- are already issued by the point an expression is evaluated, they do not
    -- influence the outcome of the evaluation.
    module Game.LambdaHack.Server.HandleRequestM
      ( handleRequestAI, handleRequestUI, handleRequestTimed, switchLeader
      , reqMoveGeneric, reqDisplaceGeneric, reqAlterFail
      , reqGameDropAndExit, reqGameSaveAndExit
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , execFailure, checkWaiting, processWatchfulness, affectStash
      , managePerRequest, handleRequestTimedCases, affectSmell
      , reqMove, reqMelee, reqMeleeChecked, reqDisplace, reqAlter
      , reqWait, reqWait10, reqYell, reqMoveItems, reqMoveItem, reqProject, reqApply
      , reqGameRestart, reqGameSave, reqDoctrine, reqAutomate
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.Text as T
    import qualified Text.Show.Pretty as Show.Pretty

    import           Game.LambdaHack.Atomic
    import           Game.LambdaHack.Client
      (ReqAI (..), ReqUI (..), RequestTimed (..))
    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.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.FactionKind
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import           Game.LambdaHack.Content.ModeKind
    import qualified Game.LambdaHack.Content.TileKind as TK
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import           Game.LambdaHack.Definition.Defs
    import           Game.LambdaHack.Server.CommonM
    import           Game.LambdaHack.Server.HandleEffectM
    import           Game.LambdaHack.Server.ItemM
    import           Game.LambdaHack.Server.MonadServer
    import           Game.LambdaHack.Server.PeriodicM
    import           Game.LambdaHack.Server.ServerOptions
    import           Game.LambdaHack.Server.State

    execFailure :: MonadServerAtomic m
                => ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure ActorId
    aid RequestTimed
    req ReqFailure
    failureSer = do
      -- Clients should rarely do that (only in case of invisible actors)
      -- so we report it to the client, but do not crash
      -- (server should work OK with stupid clients, too).
      body <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      let fid = Actor -> FactionId
    bfid Actor
    body
          msg = ReqFailure -> Text
    showReqFailure ReqFailure
    failureSer
          impossible = ReqFailure -> Bool
    impossibleReqFailure ReqFailure
    failureSer
          debugShow :: Show a => a -> Text
          debugShow = String -> Text
    T.pack (String -> Text) -> (a -> String) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    Show.Pretty.ppShow
          possiblyAlarm = if Bool
    impossible
                          then Text -> m ()
    forall (m :: * -> *). MonadServer m => Text -> m ()
    debugPossiblyPrintAndExit
                          else Text -> m ()
    forall (m :: * -> *). MonadServer m => Text -> m ()
    debugPossiblyPrint
      possiblyAlarm $
        "Server: execFailure:" <+> msg <> "\n"
        <> debugShow body <> "\n" <> debugShow req <> "\n" <> debugShow failureSer
      execSfxAtomic $ SfxMsgFid fid $ SfxUnexpected failureSer

    -- | The semantics of server commands.
    -- AI always takes time and so doesn't loop.
    handleRequestAI :: MonadServerAtomic m
                    => ReqAI
                    -> m (Maybe RequestTimed)
    handleRequestAI :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ReqAI -> m (Maybe RequestTimed)
    handleRequestAI ReqAI
    cmd = case ReqAI
    cmd of
      ReqAITimed RequestTimed
    cmdT -> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe RequestTimed -> m (Maybe RequestTimed))
    -> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> Maybe RequestTimed
    forall a. a -> Maybe a
    Just RequestTimed
    cmdT
      ReqAI
    ReqAINop -> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing

    -- | The semantics of server commands. Only the first two cases affect time.
    handleRequestUI :: MonadServerAtomic m
                    => FactionId -> ActorId -> ReqUI
                    -> m (Maybe RequestTimed)
    handleRequestUI :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> ActorId -> ReqUI -> m (Maybe RequestTimed)
    handleRequestUI FactionId
    fid ActorId
    aid ReqUI
    cmd = case ReqUI
    cmd of
      ReqUITimed RequestTimed
    cmdT -> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe RequestTimed -> m (Maybe RequestTimed))
    -> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a b. (a -> b) -> a -> b
    $ RequestTimed -> Maybe RequestTimed
    forall a. a -> Maybe a
    Just RequestTimed
    cmdT
      ReqUIGameRestart GroupName ModeKind
    t Challenge
    d -> ActorId -> GroupName ModeKind -> Challenge -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> GroupName ModeKind -> Challenge -> m ()
    reqGameRestart ActorId
    aid GroupName ModeKind
    t Challenge
    d m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing
      ReqUI
    ReqUIGameDropAndExit -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqGameDropAndExit ActorId
    aid m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing
      ReqUI
    ReqUIGameSaveAndExit -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqGameSaveAndExit ActorId
    aid m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing
      ReqUI
    ReqUIGameSave -> m ()
    forall (m :: * -> *). MonadServer m => m ()
    reqGameSave m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing
      ReqUIDoctrine Doctrine
    toT -> FactionId -> Doctrine -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> Doctrine -> m ()
    reqDoctrine FactionId
    fid Doctrine
    toT m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing
      ReqUI
    ReqUIAutomate -> FactionId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
    reqAutomate FactionId
    fid m () -> m (Maybe RequestTimed) -> m (Maybe RequestTimed)
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing
      ReqUI
    ReqUINop -> Maybe RequestTimed -> m (Maybe RequestTimed)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe RequestTimed
    forall a. Maybe a
    Nothing

    checkWaiting :: RequestTimed -> Maybe Bool
    checkWaiting :: RequestTimed -> Maybe Bool
    checkWaiting RequestTimed
    cmd = case RequestTimed
    cmd of
      RequestTimed
    ReqWait -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True  -- true wait, with bracing, no overhead, etc.
      RequestTimed
    ReqWait10 -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False  -- false wait, only one clip at a time
      RequestTimed
    _ -> Maybe Bool
    forall a. Maybe a
    Nothing

    -- | This is a shorthand. Instead of setting @bwatch@ in @ReqWait@
    -- and unsetting in all other requests, we call this once after
    -- executing a request.
    -- In game state, we collect the number of server requests pertaining
    -- to the actor (the number of actor's "moves"), through which
    -- the actor was waiting.
    processWatchfulness :: MonadServerAtomic m => Maybe Bool -> ActorId -> m ()
    processWatchfulness :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Maybe Bool -> ActorId -> m ()
    processWatchfulness Maybe Bool
    mwait ActorId
    aid = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      actorMaxSk <- getsState $ getActorMaxSkills aid
      let uneasy = ResDelta -> Bool
    deltasSerious (Actor -> ResDelta
    bcalmDelta Actor
    b) Bool -> Bool -> Bool
    || Bool -> Bool
    not (Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorMaxSk)
      case bwatch b of
        Watchfulness
    WWatch ->
          Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe Bool
    mwait Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $  -- only long wait switches to wait state
            if Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkWait Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 then do
              Bool -> GroupName ItemKind -> ActorId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> GroupName ItemKind -> ActorId -> m ()
    addCondition Bool
    False GroupName ItemKind
    IK.S_BRACED ActorId
    aid
              UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid Watchfulness
    WWatch (Int -> Watchfulness
    WWait Int
    1)
            else
              UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid Watchfulness
    WWatch (Int -> Watchfulness
    WWait Int
    0)
        WWait Int
    0 -> case Maybe Bool
    mwait of  -- actor couldn't brace last time
          Just Bool
    True -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- if he still waits, keep him stuck unbraced
          Maybe Bool
    _ -> UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid (Int -> Watchfulness
    WWait Int
    0) Watchfulness
    WWatch
        WWait Int
    n -> case Maybe Bool
    mwait of
          Just Bool
    True ->  -- only proper wait prevents switching to watchfulness
            if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    500 then  -- enough dozing to fall asleep
              if Bool -> Bool
    not Bool
    uneasy  -- won't wake up at once
                 Bool -> Bool -> Bool
    && Skills -> Bool
    canSleep Skills
    actorMaxSk  -- enough skills
              then do
                nAll <- GroupName ItemKind -> ActorId -> m Int
    forall (m :: * -> *).
    MonadServerAtomic m =>
    GroupName ItemKind -> ActorId -> m Int
    removeConditionSingle GroupName ItemKind
    IK.S_BRACED ActorId
    aid
                let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    nAll Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) ()
                addSleep aid
              else
                -- Start dozing from scratch to prevent hopeless skill checks.
                UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid (Int -> Watchfulness
    WWait Int
    n) (Int -> Watchfulness
    WWait Int
    1)
            else
              -- Doze some more before checking sleep eligibility.
              UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid (Int -> Watchfulness
    WWait Int
    n) (Int -> Watchfulness
    WWait (Int -> Watchfulness) -> Int -> Watchfulness
    forall a b. (a -> b) -> a -> b
    $ Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
          Maybe Bool
    _ -> do
            nAll <- GroupName ItemKind -> ActorId -> m Int
    forall (m :: * -> *).
    MonadServerAtomic m =>
    GroupName ItemKind -> ActorId -> m Int
    removeConditionSingle GroupName ItemKind
    IK.S_BRACED ActorId
    aid
            let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    nAll Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Int -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` Int
    nAll) ()
            execUpdAtomic $ UpdWaitActor aid (WWait n) WWatch
        Watchfulness
    WSleep ->
          if Maybe Bool
    mwait Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False  -- lurk can't wake up regardless; too short
             Bool -> Bool -> Bool
    && (Maybe Bool -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Bool
    mwait  -- not a wait
                 Bool -> Bool -> Bool
    || Bool
    uneasy  -- spooked
                 Bool -> Bool -> Bool
    || Bool -> Bool
    not (ResDelta -> Bool
    deltaBenign (ResDelta -> Bool) -> ResDelta -> Bool
    forall a b. (a -> b) -> a -> b
    $ Actor -> ResDelta
    bhpDelta Actor
    b))  -- any HP lost
          then UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid Watchfulness
    WSleep Watchfulness
    WWake
          else UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Int64 -> UpdAtomic
    UpdRefillHP ActorId
    aid Int64
    10000
                 -- no @xM@, so slow, but each turn HP gauge green;
                 -- this is 1HP per 100 turns, so it's 10 times slower
                 -- than a necklace that gives 1HP per 10 turns;
                 -- so if an actor sleeps for the duration of a 1000 turns,
                 -- which may be the time it takes to fully explore a level,
                 -- 10HP would be gained, so weak actors would wake up twice over,
                 -- which is fine: sleeping long enough to sidestep them at will,
                 -- but attacking, e.g., a group with explosives, is good choice
                 -- as well; so both stealth and mayhem fun correct tactically
        Watchfulness
    WWake -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Maybe Bool
    mwait Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $  -- lurk can't wake up; too fast
          ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    removeSleepSingle ActorId
    aid

    -- Even very primitive actors that can't pick up items can take over stash,
    -- to prevent them inadvertedly protecting enemy stash from skilled ones
    -- by standing over it (which AI tends to do).
    affectStash :: MonadServerAtomic m => Actor -> m ()
    affectStash :: forall (m :: * -> *). MonadServerAtomic m => Actor -> m ()
    affectStash Actor
    b = do
      let locateStash :: (FactionId, Faction) -> m ()
    locateStash (FactionId
    fid, Faction
    fact) = case Faction -> Maybe (LevelId, Point)
    gstash Faction
    fact of
            Just (LevelId
    lidS, Point
    posS)
              | LevelId
    lidS LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> LevelId
    blid Actor
    b Bool -> Bool -> Bool
    && Point
    posS Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Point
    bpos Actor
    b Bool -> Bool -> Bool
    && FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Actor -> FactionId
    bfid Actor
    b ->
                UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> FactionId -> LevelId -> Point -> UpdAtomic
    UpdLoseStashFaction Bool
    True FactionId
    fid LevelId
    lidS Point
    posS
            Maybe (LevelId, Point)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      factionD <- (State -> FactionDict) -> m FactionDict
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> FactionDict
    sfactionD
      mapM_ locateStash $ EM.assocs factionD

    handleRequestTimed :: MonadServerAtomic m
                       => FactionId -> ActorId -> RequestTimed -> m Bool
    handleRequestTimed :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> ActorId -> RequestTimed -> m Bool
    handleRequestTimed FactionId
    fid ActorId
    aid RequestTimed
    cmd = do
      let mwait :: Maybe Bool
    mwait = RequestTimed -> Maybe Bool
    checkWaiting RequestTimed
    cmd
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      -- Note that only the ordinary 1-turn wait eliminates overhead.
      -- The more fine-graned waits don't make actors braced and induce
      -- overhead, so that they have some drawbacks in addition to the
      -- benefit of seeing approaching danger up to almost a turn faster.
      -- It may be too late to block then, but not too late to sidestep or attack.
      unless (mwait == Just True) $ overheadActorTime fid (blid b)
      advanceTime aid (if mwait == Just False then 10 else 100) True
      handleRequestTimedCases aid cmd
      managePerRequest aid
      -- Note that due to the order, actor was still braced or sleeping
      -- throughout request processing, etc. So, if he hits himself kinetically,
      -- his armor from bracing previous turn is still in effect.
      processWatchfulness mwait aid
      return $! isNothing mwait  -- for speed, we report if @cmd@ harmless

    -- | Clear deltas for Calm and HP for proper UI display and AI hints.
    managePerRequest :: MonadServerAtomic m => ActorId -> m ()
    managePerRequest :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    managePerRequest ActorId
    aid = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      affectStash b
      let clearMark = Int64
    0
      unless (bcalmDelta b == ResDelta (0, 0) (0, 0)) $
        -- Clear delta for the next actor move.
        execUpdAtomic $ UpdRefillCalm aid clearMark
      unless (bhpDelta b == ResDelta (0, 0) (0, 0)) $
        -- Clear delta for the next actor move.
        execUpdAtomic $ UpdRefillHP aid clearMark

    handleRequestTimedCases :: MonadServerAtomic m
                            => ActorId -> RequestTimed -> m ()
    handleRequestTimedCases :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> m ()
    handleRequestTimedCases ActorId
    aid RequestTimed
    cmd = case RequestTimed
    cmd of
      ReqMove Vector
    target -> ActorId -> Vector -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Vector -> m ()
    reqMove ActorId
    aid Vector
    target
      ReqMelee ActorId
    target ItemId
    iid CStore
    cstore -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMelee ActorId
    aid ActorId
    target ItemId
    iid CStore
    cstore
      ReqDisplace ActorId
    target -> ActorId -> ActorId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ActorId -> m ()
    reqDisplace ActorId
    aid ActorId
    target
      ReqAlter Point
    tpos -> ActorId -> Point -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Point -> m ()
    reqAlter ActorId
    aid Point
    tpos
      RequestTimed
    ReqWait -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqWait ActorId
    aid
      RequestTimed
    ReqWait10 -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqWait10 ActorId
    aid
      RequestTimed
    ReqYell -> ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqYell ActorId
    aid
      ReqMoveItems [(ItemId, Int, CStore, CStore)]
    l -> ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
    reqMoveItems ActorId
    aid [(ItemId, Int, CStore, CStore)]
    l
      ReqProject Point
    p Int
    eps ItemId
    iid CStore
    cstore -> ActorId -> Point -> Int -> ItemId -> CStore -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Point -> Int -> ItemId -> CStore -> m ()
    reqProject ActorId
    aid Point
    p Int
    eps ItemId
    iid CStore
    cstore
      ReqApply ItemId
    iid CStore
    cstore -> ActorId -> ItemId -> CStore -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ItemId -> CStore -> m ()
    reqApply ActorId
    aid ItemId
    iid CStore
    cstore

    switchLeader :: MonadServerAtomic m => FactionId -> ActorId -> m ()
    {-# INLINE switchLeader #-}
    switchLeader :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> ActorId -> m ()
    switchLeader FactionId
    fid ActorId
    aidNew = do
      fact <- (State -> Faction) -> m Faction
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Faction) -> m Faction)
    -> (State -> Faction) -> m Faction
    forall a b. (a -> b) -> a -> b
    $ (FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (FactionDict -> Faction)
    -> (State -> FactionDict) -> State -> Faction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> FactionDict
    sfactionD
      bPre <- getsState $ getActorBody aidNew
      let mleader = Faction -> Maybe ActorId
    gleader Faction
    fact
          !_A1 = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    aidNew Maybe ActorId -> Maybe ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe ActorId
    mleader
                         Bool -> Bool -> Bool
    && Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    bPre)
                         Bool -> (ActorId, Actor, FactionId, Faction) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` (ActorId
    aidNew, Actor
    bPre, FactionId
    fid, Faction
    fact)) ()
          !_A2 = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Actor -> FactionId
    bfid Actor
    bPre FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    fid
                         Bool -> (String, (ActorId, Actor, FactionId, Faction)) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "client tries to move other faction actors"
                         String
    -> (ActorId, Actor, FactionId, Faction)
    -> (String, (ActorId, Actor, FactionId, Faction))
    forall v. String -> v -> (String, v)
    `swith` (ActorId
    aidNew, Actor
    bPre, FactionId
    fid, Faction
    fact)) ()
      let banned = Faction -> Bool
    bannedPointmanSwitchBetweenLevels Faction
    fact
      arena <- case mleader of
        Maybe ActorId
    Nothing -> LevelId -> m LevelId
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LevelId -> m LevelId) -> LevelId -> m LevelId
    forall a b. (a -> b) -> a -> b
    $! Actor -> LevelId
    blid Actor
    bPre
        Just ActorId
    leader -> do
          b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    leader
          return $! blid b
      if blid bPre /= arena && banned  -- catch the cheating clients
      then execFailure aidNew ReqWait{-hack-} NoChangeDunLeader
      else do
        execUpdAtomic $ UpdLeadFaction fid mleader (Just aidNew)
        -- We exchange times of the old and new leader.
        -- This permits an abuse, because a slow tank can be moved fast
        -- by alternating between it and many fast actors (until all of them
        -- get slowed down by this and none remain). But at least the sum
        -- of all times of a faction is conserved. And we avoid double moves
        -- against the UI player caused by his leader changes. There may still
        -- happen double moves caused by AI leader changes, but that's rare.
        -- The flip side is the possibility of multi-moves of the UI player
        -- as in the case of the tank.
        -- Warning: when the action is performed on the server,
        -- the time of the actor is different than when client prepared that
        -- action, so any client checks involving time should discount this.
        case mleader of
          Just ActorId
    aidOld | ActorId
    aidOld ActorId -> ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ActorId
    aidNew -> ActorId -> ActorId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ActorId -> m ()
    swapTime ActorId
    aidOld ActorId
    aidNew
          Maybe ActorId
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- * ReqMove

    -- | Add a smell trace for the actor to the level. If smell already there
    -- and the actor can smell, remove smell. Projectiles are ignored.
    -- As long as an actor can smell, he doesn't leave any smell ever.
    -- Smell trace is never left in water tiles.
    affectSmell :: MonadServerAtomic m => ActorId -> m ()
    affectSmell :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    affectSmell ActorId
    aid = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      b <- getsState $ getActorBody aid
      lvl <- getLevel $ blid b
      let aquatic = TileSpeedup -> ContentId TileKind -> Bool
    Tile.isAquatic TileSpeedup
    coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl Level -> Point -> ContentId TileKind
    `at` Actor -> Point
    bpos Actor
    b
      unless (bproj b || aquatic) $ do
        actorMaxSk <- getsState $ getActorMaxSkills aid
        let smellRadius = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkSmell Skills
    actorMaxSk
            hasOdor = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkOdor Skills
    actorMaxSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
        when (hasOdor || smellRadius > 0) $ do
          localTime <- getsState $ getLocalTime $ blid b
          let oldS = Time -> Maybe Time -> Time
    forall a. a -> Maybe a -> a
    fromMaybe Time
    timeZero (Maybe Time -> Time) -> Maybe Time -> Time
    forall a b. (a -> b) -> a -> b
    $ Point -> EnumMap Point Time -> Maybe Time
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    EM.lookup (Actor -> Point
    bpos Actor
    b) (EnumMap Point Time -> Maybe Time)
    -> (Level -> EnumMap Point Time) -> Level -> Maybe Time
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Level -> EnumMap Point Time
    lsmell (Level -> Maybe Time) -> Level -> Maybe Time
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl
              newTime = Time -> Delta Time -> Time
    timeShift Time
    localTime Delta Time
    smellTimeout
              newS = if Int
    smellRadius Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                     then Time
    timeZero
                     else Time
    newTime
          when (oldS /= newS) $
            execUpdAtomic $ UpdAlterSmell (blid b) (bpos b) oldS newS

    -- | Actor moves or attacks or alters by bumping.
    -- Note that client may not be able to see an invisible monster
    -- so it's the server that determines if melee took place, etc.
    -- Also, only the server is authorized to check if a move is legal
    -- and it needs full context for that, e.g., the initial actor position
    -- to check if melee attack does not try to reach to a distant tile.
    reqMove :: MonadServerAtomic m => ActorId -> Vector -> m ()
    reqMove :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Vector -> m ()
    reqMove = Bool -> Bool -> ActorId -> Vector -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> Bool -> ActorId -> Vector -> m ()
    reqMoveGeneric Bool
    True Bool
    True

    reqMoveGeneric :: MonadServerAtomic m
                   => Bool -> Bool -> ActorId -> Vector -> m ()
    reqMoveGeneric :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> Bool -> ActorId -> Vector -> m ()
    reqMoveGeneric Bool
    voluntary Bool
    mayAttack ActorId
    source Vector
    dir = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorSk <- currentSkillsServer source
      sb <- getsState $ getActorBody source
      let abInSkill Skill
    sk = Maybe ([Vector], Speed) -> Bool
    forall a. Maybe a -> Bool
    isJust (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    sb)
                         Bool -> Bool -> Bool
    || Skill -> Skills -> Int
    Ability.getSk Skill
    sk Skills
    actorSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
          lid = Actor -> LevelId
    blid Actor
    sb
      lvl <- getLevel lid
      let spos = Actor -> Point
    bpos Actor
    sb
          tpos = Point
    spos Point -> Vector -> Point
    `shift` Vector
    dir
      -- This predicate is symmetric wrt source and target, though the effect
      -- of collision may not be (the source projectiles applies its effect
      -- on the target particles, but loses 1 HP due to the collision).
      -- The condition implies that it's impossible to shoot down a bullet
      -- with a bullet, but a bullet can shoot down a burstable target,
      -- as well as be swept away by it, and two burstable projectiles
      -- burst when meeting mid-air. Projectiles that are not bursting
      -- nor damaging never collide with any projectile.
      collides <- getsState $ \State
    s Actor
    tb ->
        let sitemKind :: ItemKind
    sitemKind = ItemId -> State -> ItemKind
    getIidKindServer (Actor -> ItemId
    btrunk Actor
    sb) State
    s
            titemKind :: ItemKind
    titemKind = ItemId -> State -> ItemKind
    getIidKindServer (Actor -> ItemId
    btrunk Actor
    tb) State
    s
            sar :: AspectRecord
    sar = State -> DiscoveryAspect
    sdiscoAspect State
    s DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> ItemId
    btrunk Actor
    sb
            tar :: AspectRecord
    tar = State -> DiscoveryAspect
    sdiscoAspect State
    s DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> ItemId
    btrunk Actor
    tb
            -- Such projectiles are prone to bursting or are themselves
            -- particles of an explosion shockwave.
            bursting :: AspectRecord -> Bool
    bursting AspectRecord
    arItem =
              Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Fragile AspectRecord
    arItem
              Bool -> Bool -> Bool
    && Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Lobable AspectRecord
    arItem
            sbursting :: Bool
    sbursting = AspectRecord -> Bool
    bursting AspectRecord
    sar
            tbursting :: Bool
    tbursting = AspectRecord -> Bool
    bursting AspectRecord
    tar
            -- Such projectiles, even if not bursting themselves, can cause
            -- another projectile to burst.
            sdamaging :: Bool
    sdamaging = ItemKind -> Bool
    IK.isDamagingKind ItemKind
    sitemKind
            tdamaging :: Bool
    tdamaging = ItemKind -> Bool
    IK.isDamagingKind ItemKind
    titemKind
            -- Avoid explosion extinguishing itself via its own particles colliding.
            sameBlast :: Bool
    sameBlast = Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    sar
                        Bool -> Bool -> Bool
    && ItemId -> State -> ContentId ItemKind
    getIidKindIdServer (Actor -> ItemId
    btrunk Actor
    sb) State
    s
                           ContentId ItemKind -> ContentId ItemKind -> Bool
    forall a. Eq a => a -> a -> Bool
    == ItemId -> State -> ContentId ItemKind
    getIidKindIdServer (Actor -> ItemId
    btrunk Actor
    tb) State
    s
        in Bool -> Bool
    not Bool
    sameBlast
           Bool -> Bool -> Bool
    && (Bool
    sbursting Bool -> Bool -> Bool
    && (Bool
    tdamaging Bool -> Bool -> Bool
    || Bool
    tbursting)
               Bool -> Bool -> Bool
    || (Bool
    tbursting Bool -> Bool -> Bool
    && (Bool
    sdamaging Bool -> Bool -> Bool
    || Bool
    sbursting)))
      -- We start by checking actors at the target position.
      tgt <- getsState $ posToAidAssocs tpos lid
      case tgt of
        (ActorId
    target, Actor
    tb) : [(ActorId, Actor)]
    _ | Bool
    mayAttack Bool -> Bool -> Bool
    && (Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    sb)
                                         Bool -> Bool -> Bool
    || Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    tb)
                                         Bool -> Bool -> Bool
    || Actor -> Bool
    collides Actor
    tb) -> do
          -- A projectile is too small and insubstantial to hit another projectile,
          -- unless it's large enough or tends to explode (fragile and lobable).
          -- The actor in the way is visible or not; server sees him always.
          -- Below the only weapon (the only item) of projectiles is picked.
          mweapon <- ActorId -> ActorId -> m (Maybe (ItemId, CStore))
    forall (m :: * -> *).
    MonadServer m =>
    ActorId -> ActorId -> m (Maybe (ItemId, CStore))
    pickWeaponServer ActorId
    source ActorId
    target
          case mweapon of
            Just (ItemId
    wp, CStore
    cstore) | Skill -> Bool
    abInSkill Skill
    Ability.SkMelee ->
              Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMeleeChecked Bool
    voluntary ActorId
    source ActorId
    target ItemId
    wp CStore
    cstore
            Maybe (ItemId, CStore)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- waiting, even if no @SkWait@ skill
          -- Movement of projectiles only happens after melee and a check
          -- if they survive, so that if they don't, they explode in front
          -- of enemy, not under him, so that already first explosion blasts
          -- reach him, not only potential secondary explosions.
          when (bproj sb) $ do
            b2 <- getsState $ getActorBody source
            unless (actorDying b2) $ reqMoveGeneric voluntary False source dir
        [(ActorId, Actor)]
    _ ->
          -- Either the position is empty, or all involved actors are proj.
          -- Movement requires full access and skill.
          if TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos then
            if Skill -> Bool
    abInSkill Skill
    Ability.SkMove then do
              UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Point -> Point -> UpdAtomic
    UpdMoveActor ActorId
    source Point
    spos Point
    tpos
              ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    affectSmell ActorId
    source
              -- No remote ransacking nor underfoot effects by projectiles,
              -- through which a projectile could cook its only item,
              -- but retain the old raw name and which would spam water
              -- slowness every time a projectile flies over water.
              Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Actor -> Bool
    bproj Actor
    sb) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                -- Counts as bumping, because terrain transformation probably
                -- not intended, because the goal was probably just to move
                -- and then modifying the terrain is an unwelcome side effect.
                -- Barged into a tile, so normal effects need to activate,
                -- while crafting requires explicit altering.
                m (Maybe ReqFailure) -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    reqAlterFail Bool
    True EffToUse
    EffBare Bool
    voluntary ActorId
    source Point
    tpos
           else ActorId -> RequestTimed -> ReqFailure -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure ActorId
    source (Vector -> RequestTimed
    ReqMove Vector
    dir) ReqFailure
    MoveUnskilled
          else do
            -- If not walkable, this must be altering by bumping.
            -- If voluntary then probably intentional so report any errors.
            mfail <- Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    reqAlterFail Bool
    True EffToUse
    EffBare Bool
    voluntary ActorId
    source Point
    tpos
            when voluntary $ do
              let req = Vector -> RequestTimed
    ReqMove Vector
    dir
              maybe (return ()) (execFailure source req) mfail

    -- * ReqMelee

    -- | Resolves the result of an actor moving into another.
    -- Actors on unwalkable positions can be attacked without any restrictions.
    -- For instance, an actor embedded in a wall can be attacked from
    -- an adjacent position. This function is analogous to projectGroupItem,
    -- but for melee and not using up the weapon.
    -- No problem if there are many projectiles at the spot. We just
    -- attack the one specified.
    reqMelee :: MonadServerAtomic m
             => ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMelee :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMelee ActorId
    source ActorId
    target ItemId
    iid CStore
    cstore = do
      actorSk <- ActorId -> m Skills
    forall (m :: * -> *). MonadServer m => ActorId -> m Skills
    currentSkillsServer ActorId
    source
      if Ability.getSk Ability.SkMelee actorSk > 0 then
        reqMeleeChecked True source target iid cstore
      else execFailure source (ReqMelee target iid cstore) MeleeUnskilled

    reqMeleeChecked :: forall m. MonadServerAtomic m
                    => Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMeleeChecked :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMeleeChecked Bool
    voluntary ActorId
    source ActorId
    target ItemId
    iid CStore
    cstore = do
      sb <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    source
      tb <- getsState $ getActorBody target
      discoAspect <- getsState sdiscoAspect
      let req = ActorId -> ItemId -> CStore -> RequestTimed
    ReqMelee ActorId
    target ItemId
    iid CStore
    cstore
          arWeapon = DiscoveryAspect
    discoAspect DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! ItemId
    iid
          meleeableEnough = Actor -> Bool
    bproj Actor
    sb Bool -> Bool -> Bool
    || Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Meleeable AspectRecord
    arWeapon
      if source == target then execFailure source req MeleeSelf
      else if not (checkAdjacent sb tb) then execFailure source req MeleeDistant
      else if not meleeableEnough then execFailure source req MeleeNotWeapon
      else do
        -- If @voluntary@ is set, blame is exact, otherwise, an approximation.
        killer <- if | voluntary -> assert (not (bproj sb)) $ return source
                     | bproj sb -> getsServer $ EM.findWithDefault source source
                                   . strajPushedBy
                     | otherwise -> return source
        actorSk <- currentSkillsServer source
        let arTrunk = DiscoveryAspect
    discoAspect DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> ItemId
    btrunk Actor
    tb
            sfid = Actor -> FactionId
    bfid Actor
    sb
            tfid = Actor -> FactionId
    bfid Actor
    tb
            -- Let the missile drop down, but don't remove its trajectory
            -- so that it doesn't pretend to have hit a wall.
            haltTrajectory :: KillHow -> ActorId -> Actor -> m ()
            haltTrajectory KillHow
    killHow ActorId
    aid Actor
    b = case Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b of
              btra :: Maybe ([Vector], Speed)
    btra@(Just ([Vector]
    l, Speed
    speed)) | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Vector] -> Bool
    forall a. [a] -> Bool
    null [Vector]
    l -> do
                UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId
    -> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
    UpdTrajectory ActorId
    aid Maybe ([Vector], Speed)
    btra (Maybe ([Vector], Speed) -> UpdAtomic)
    -> Maybe ([Vector], Speed) -> UpdAtomic
    forall a b. (a -> b) -> a -> b
    $ ([Vector], Speed) -> Maybe ([Vector], Speed)
    forall a. a -> Maybe a
    Just ([], Speed
    speed)
                let arTrunkAid :: AspectRecord
    arTrunkAid = DiscoveryAspect
    discoAspect DiscoveryAspect -> ItemId -> AspectRecord
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! Actor -> ItemId
    btrunk Actor
    b
                Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Actor -> Bool
    bproj Actor
    b Bool -> Bool -> Bool
    && Bool -> Bool
    not (Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    arTrunkAid)) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  ActorId -> KillHow -> FactionId -> ItemId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> KillHow -> FactionId -> ItemId -> m ()
    addKillToAnalytics ActorId
    killer KillHow
    killHow (Actor -> FactionId
    bfid Actor
    b) (Actor -> ItemId
    btrunk Actor
    b)
              Maybe ([Vector], Speed)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        -- Only catch if braced. Never steal trunk from an already caught
        -- projectile or one with many items inside.
        if bproj tb
           && EM.size (beqp tb) == 1
           && not (IA.checkFlag Ability.Blast arTrunk)
           && actorWaits sb  -- still valid while request being processed
           && Ability.getSk Ability.SkMoveItem actorSk > 0  -- animals can't
        then do
          -- Catching the projectile, that is, stealing the item from its eqp.
          -- No effect from our weapon (organ) is applied to the projectile
          -- and the weapon (organ) is never destroyed, even if not durable.
          -- Pushed actor doesn't stop flight by catching the projectile
          -- nor does he lose 1HP.
          -- This is not overpowered, because usually at least one partial wait
          -- is needed to sync (if not, attacker should switch missiles)
          -- and so only every other missile can be caught. Normal sidestepping
          -- or sync and displace, if in a corridor, is as effective
          -- and blocking can be even more so, depending on powers of the missile.
          -- Missiles are really easy to defend against, but sight (and so, Calm)
          -- is the key, as well as light, ambush around a corner, etc.
          execSfxAtomic $ SfxSteal source target iid
          case EM.assocs $ beqp tb of
            [(ItemId
    iid2, (Int
    k, [ItemTimer]
    _))] -> do
              upds <- Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
    forall (m :: * -> *).
    MonadStateRead m =>
    Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
    generalMoveItem Bool
    True ItemId
    iid2 Int
    k (ActorId -> CStore -> Container
    CActor ActorId
    target CStore
    CEqp)
                                                  (ActorId -> CStore -> Container
    CActor ActorId
    source CStore
    CStash)
              mapM_ execUpdAtomic upds
              itemFull <- getsState $ itemToFull iid2
              discoverIfMinorEffects (CActor source CStash)
                                     iid2 (itemKindId itemFull)
            [(ItemId, ItemQuant)]
    err -> String -> m ()
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> [(ItemId, ItemQuant)] -> String
    forall v. Show v => String -> v -> String
    `showFailure` [(ItemId, ItemQuant)]
    err
          haltTrajectory KillCatch target tb
        else do
          if bproj sb && bproj tb then do
            -- Special case for collision of projectiles, because they just
            -- symmetrically ram into each other, so picking one to hit another,
            -- based on random timing, would be wrong.
            -- Instead of suffering melee attack, let the target projectile
            -- get smashed and burst (if fragile and if not piercing).
            -- The source projectile terminates flight (unless pierces) later on.
            when (bhp tb > oneM) $
              execUpdAtomic $ UpdRefillHP target minusM
            when (bhp tb <= oneM) $ do
              -- If projectile has too low HP to pierce, terminate its flight.
              let killHow | Flag -> AspectRecord -> Bool
    IA.checkFlag Flag
    Ability.Blast AspectRecord
    arWeapon = KillHow
    KillKineticBlast
                          | Bool
    otherwise = KillHow
    KillKineticRanged
              haltTrajectory killHow target tb
            -- Avoid spam when two explosions collide.
            unless (IA.checkFlag Ability.Blast arWeapon
                    && IA.checkFlag Ability.Blast arTrunk) $
              execSfxAtomic $ SfxStrike source target iid
          else do
            -- Normal hit, with effects, but first auto-apply defences.
            let mayDestroyTarget = Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    tb) Bool -> Bool -> Bool
    || Actor -> Int64
    bhp Actor
    tb Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    oneM
                effApplyFlagsTarget = EffApplyFlags
                  { effToUse :: EffToUse
    effToUse            = EffToUse
    EffBare
                  , effVoluntary :: Bool
    effVoluntary        = Bool
    voluntary
                  , effUseAllCopies :: Bool
    effUseAllCopies     = Bool
    False
                  , effKineticPerformed :: Bool
    effKineticPerformed = Bool
    False
                  , effActivation :: ActivationFlag
    effActivation       = if Actor -> Bool
    bproj Actor
    sb
                                          then ActivationFlag
    Ability.ActivationUnderRanged
                                          else ActivationFlag
    Ability.ActivationUnderMelee
                  , effMayDestroy :: Bool
    effMayDestroy       = Bool
    mayDestroyTarget
                  }
            unless (bproj tb) $
              autoApply effApplyFlagsTarget killer target tb
              $ if bproj sb then Ability.UnderRanged else Ability.UnderMelee
            -- This might have changed the actors.
            sb2 <- getsState $ getActorBody source
            targetMaxSk <- getsState $ getActorMaxSkills target
            if | bproj sb2
                 && Ability.getSk Ability.SkDeflectRanged targetMaxSk > 0 -> do
                   cutCalm target
                   execSfxAtomic $ SfxRecoil source target iid
               | Ability.getSk Ability.SkDeflectMelee targetMaxSk > 0 -> do
                   cutCalm target
                   execSfxAtomic $ SfxRecoil source target iid
               | otherwise -> do
                   -- Msgs inside @SfxStrike@ describe the source part
                   -- of the strike.
                   execSfxAtomic $ SfxStrike source target iid
                   let c = ActorId -> CStore -> Container
    CActor ActorId
    source CStore
    cstore
                       mayDestroySource = Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    sb2) Bool -> Bool -> Bool
    || Actor -> Int64
    bhp Actor
    sb2 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    oneM
                         -- piercing projectiles may not have their weapon destroyed
                   -- Msgs inside @itemEffect@ describe the target part
                   -- of the strike.
                   -- If any effects and aspects, this is also where they are
                   -- identified.
                   -- Here also the kinetic damage is applied,
                   -- before any effects are.
                   --
                   -- Note: that "hornet swarm detect items" via a scrolls
                   -- is intentional,
                   -- even though unrealistic and funny. Otherwise actors
                   -- could protect
                   -- themselves from some projectiles by lowering their apply stat.
                   -- Also, the animal faction won't have too much benefit
                   -- from that info,
                   -- so the problem is not balance, but the goofy message.
                   let effApplyFlagsSource = EffApplyFlags
                         { effToUse :: EffToUse
    effToUse            = EffToUse
    EffBare
                         , effVoluntary :: Bool
    effVoluntary        = Bool
    voluntary
                         , effUseAllCopies :: Bool
    effUseAllCopies     = Bool
    False
                         , effKineticPerformed :: Bool
    effKineticPerformed = Bool
    False
                         , effActivation :: ActivationFlag
    effActivation       = ActivationFlag
    Ability.ActivationMeleeable
                         , effMayDestroy :: Bool
    effMayDestroy       = Bool
    mayDestroySource
                         }
                   void $ kineticEffectAndDestroy effApplyFlagsSource killer
                                                  source target iid c
          sb2 <- getsState $ getActorBody source
          case btrajectory sb2 of
            Just{} | Bool -> Bool
    not Bool
    voluntary -> do
              -- Deduct a hitpoint for a pierce of a projectile
              -- or due to a hurled actor colliding with another (seen from
              -- @voluntary@, as opposed to hurled actor actively meleeing another).
              -- Don't deduct if no pierce, to prevent spam.
              -- Never kill in this way.
              Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Actor -> Int64
    bhp Actor
    sb2 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    oneM) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Int64 -> UpdAtomic
    UpdRefillHP ActorId
    source Int64
    minusM
                Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Actor -> Bool
    bproj Actor
    sb2) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                  SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    FactionId -> SfxMsg -> SfxAtomic
    SfxMsgFid (Actor -> FactionId
    bfid Actor
    sb2) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
    forall a b. (a -> b) -> a -> b
    $ ActorId -> ActorId -> SfxMsg
    SfxCollideActor ActorId
    source ActorId
    target
                  Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Actor -> Bool
    bproj Actor
    tb) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                    SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $
                      FactionId -> SfxMsg -> SfxAtomic
    SfxMsgFid (Actor -> FactionId
    bfid Actor
    tb) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
    forall a b. (a -> b) -> a -> b
    $ ActorId -> ActorId -> SfxMsg
    SfxCollideActor ActorId
    source ActorId
    target
              Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    sb2) Bool -> Bool -> Bool
    || Actor -> Int64
    bhp Actor
    sb2 Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int64
    oneM) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                -- Non-projectiles can't pierce, so terminate their flight.
                -- If projectile has too low HP to pierce, ditto.
                KillHow -> ActorId -> Actor -> m ()
    haltTrajectory KillHow
    KillActorLaunch ActorId
    source Actor
    sb2
            Maybe ([Vector], Speed)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          -- The only way to start a war is to slap an enemy voluntarily..
          -- Being hit by and hitting projectiles, as well as via pushing,
          -- count as unintentional friendly fire.
          sfact <- getsState $ (EM.! sfid) . sfactionD
          let friendlyFire = Actor -> Bool
    bproj Actor
    sb2 Bool -> Bool -> Bool
    || Actor -> Bool
    bproj Actor
    tb Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    voluntary
              fromDipl = Diplomacy -> FactionId -> EnumMap FactionId Diplomacy -> Diplomacy
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault Diplomacy
    Unknown FactionId
    tfid (Faction -> EnumMap FactionId Diplomacy
    gdipl Faction
    sfact)
          unless (friendlyFire
                  || isFoe sfid sfact tfid  -- already at war
                  || isFriend sfid sfact tfid) $  -- allies never at war
            execUpdAtomic $ UpdDiplFaction sfid tfid fromDipl War

    autoApply :: MonadServerAtomic m
              => EffApplyFlags -> ActorId -> ActorId -> Actor -> Ability.Flag
              -> m ()
    autoApply :: forall (m :: * -> *).
    MonadServerAtomic m =>
    EffApplyFlags -> ActorId -> ActorId -> Actor -> Flag -> m ()
    autoApply EffApplyFlags
    effApplyFlags ActorId
    killer ActorId
    target Actor
    tb Flag
    flag = do
      let autoApplyIid :: Container -> ItemId -> m ()
    autoApplyIid Container
    c ItemId
    iid = do
            itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
            let arItem = ItemFull -> AspectRecord
    aspectRecordFull ItemFull
    itemFull
            when (IA.checkFlag flag arItem) $
              void $ effectAndDestroyAndAddKill effApplyFlags killer target target
                                                iid c itemFull
      (ItemId -> m ()) -> [ItemId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Container -> ItemId -> m ()
    autoApplyIid (Container -> ItemId -> m ()) -> Container -> ItemId -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> CStore -> Container
    CActor ActorId
    target CStore
    CEqp) ([ItemId] -> m ()) -> [ItemId] -> m ()
    forall a b. (a -> b) -> a -> b
    $ EnumMap ItemId ItemQuant -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys (EnumMap ItemId ItemQuant -> [ItemId])
    -> EnumMap ItemId ItemQuant -> [ItemId]
    forall a b. (a -> b) -> a -> b
    $ Actor -> EnumMap ItemId ItemQuant
    beqp Actor
    tb
      (ItemId -> m ()) -> [ItemId] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Container -> ItemId -> m ()
    autoApplyIid (Container -> ItemId -> m ()) -> Container -> ItemId -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> CStore -> Container
    CActor ActorId
    target CStore
    COrgan) ([ItemId] -> m ()) -> [ItemId] -> m ()
    forall a b. (a -> b) -> a -> b
    $ EnumMap ItemId ItemQuant -> [ItemId]
    forall k a. Enum k => EnumMap k a -> [k]
    EM.keys (EnumMap ItemId ItemQuant -> [ItemId])
    -> EnumMap ItemId ItemQuant -> [ItemId]
    forall a b. (a -> b) -> a -> b
    $ Actor -> EnumMap ItemId ItemQuant
    borgan Actor
    tb

    -- * ReqDisplace

    -- | Actor tries to swap positions with another.
    reqDisplace :: MonadServerAtomic m => ActorId -> ActorId -> m ()
    reqDisplace :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ActorId -> m ()
    reqDisplace = Bool -> ActorId -> ActorId -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> ActorId -> m ()
    reqDisplaceGeneric Bool
    True

    reqDisplaceGeneric :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> m ()
    reqDisplaceGeneric :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> ActorId -> m ()
    reqDisplaceGeneric Bool
    voluntary ActorId
    source ActorId
    target = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      actorSk <- currentSkillsServer source
      sb <- getsState $ getActorBody source
      let abInSkill Skill
    sk = Maybe ([Vector], Speed) -> Bool
    forall a. Maybe a -> Bool
    isJust (Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    sb)
                         Bool -> Bool -> Bool
    || Skill -> Skills -> Int
    Ability.getSk Skill
    sk Skills
    actorSk Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
      tb <- getsState $ getActorBody target
      tfact <- getsState $ (EM.! bfid tb) . sfactionD
      let spos = Actor -> Point
    bpos Actor
    sb
          tpos = Actor -> Point
    bpos Actor
    tb
          atWar = FactionId -> Faction -> FactionId -> Bool
    isFoe (Actor -> FactionId
    bfid Actor
    tb) Faction
    tfact (Actor -> FactionId
    bfid Actor
    sb)
          req = ActorId -> RequestTimed
    ReqDisplace ActorId
    target
      actorMaxSk <- getsState $ getActorMaxSkills target
      dEnemy <- getsState $ dispEnemy source target actorMaxSk
      if | not (abInSkill Ability.SkDisplace) ->
             execFailure source req DisplaceUnskilled
         | not (checkAdjacent sb tb) -> execFailure source req DisplaceDistant
         | atWar && not dEnemy -> do  -- if not at war, can displace always
           -- We don't fail with DisplaceImmobile and DisplaceSupported.
           -- because it's quite common they can't be determined by the attacker,
           -- and so the failure would be too alarming to the player.
           -- If the character melees instead, the player can tell displace failed.
           -- As for the other failures, they are impossible and we don't
           -- verify here that they don't occur, for simplicity.
           mweapon <- pickWeaponServer source target
           case mweapon of
             Just (ItemId
    wp, CStore
    cstore) | Skill -> Bool
    abInSkill Skill
    Ability.SkMelee ->
               Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> ActorId -> ItemId -> CStore -> m ()
    reqMeleeChecked Bool
    voluntary ActorId
    source ActorId
    target ItemId
    wp CStore
    cstore
             Maybe (ItemId, CStore)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- waiting, even if no @SkWait@ skill
         | otherwise -> do
           let lid = Actor -> LevelId
    blid Actor
    sb
           lvl <- getLevel lid
           -- Displacing requires full access.
           if Tile.isWalkable coTileSpeedup $ lvl `at` tpos then
             case posToAidsLvl tpos lvl of
               [] -> String -> m ()
    forall a. (?callStack::CallStack) => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> (ActorId, Actor, ActorId, Actor) -> String
    forall v. Show v => String -> v -> String
    `showFailure` (ActorId
    source, Actor
    sb, ActorId
    target, Actor
    tb)
               [ActorId
    _] -> do
                 UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> ActorId -> UpdAtomic
    UpdDisplaceActor ActorId
    source ActorId
    target
                 -- We leave or wipe out smell, for consistency, but it's not
                 -- absolute consistency, e.g., blinking doesn't touch smell,
                 -- so sometimes smellers will backtrack once to wipe smell. OK.
                 ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    affectSmell ActorId
    source
                 ActorId -> m ()
    forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    affectSmell ActorId
    target
                 -- Counts as bumping, because terrain transformation not intended.
                 m (Maybe ReqFailure) -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    reqAlterFail Bool
    True EffToUse
    EffBare Bool
    False ActorId
    source Point
    tpos
                   -- possibly alter or activate
                 m (Maybe ReqFailure) -> m ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    reqAlterFail Bool
    True EffToUse
    EffBare Bool
    False ActorId
    target Point
    spos
               [ActorId]
    _ -> ActorId -> RequestTimed -> ReqFailure -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure ActorId
    source RequestTimed
    req ReqFailure
    DisplaceMultiple
           else
             -- Client foolishly tries to displace an actor without access.
             execFailure source req DisplaceAccess

    -- * ReqAlter

    -- | Search and/or alter the tile.
    reqAlter :: MonadServerAtomic m => ActorId -> Point -> m ()
    reqAlter :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Point -> m ()
    reqAlter ActorId
    source Point
    tpos = do
      COps{coTileSpeedup} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      sb <- getsState $ getActorBody source
      lvl <- getLevel $ blid sb
      -- This is explicit tile triggering. Walkable tiles are sparse enough
      -- that crafting effects can be activated without any others
      -- and without changing the tile and this is usually beneficial,
      -- so always attempted. OTOH, squeezing a hand into a non-walkable tile
      -- or barging into walkable tiles (but not as a projectile) activates all.
      let effToUse = if TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup (Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos)
                     then EffToUse
    EffOnCombine
                     else EffToUse
    EffBareAndOnCombine
      mfail <- reqAlterFail False effToUse True source tpos
      let req = Point -> RequestTimed
    ReqAlter Point
    tpos
      maybe (return ()) (execFailure source req) mfail

    reqAlterFail :: forall m. MonadServerAtomic m
                 => Bool -> EffToUse -> Bool -> ActorId -> Point
                 -> m (Maybe ReqFailure)
    reqAlterFail :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
    reqAlterFail Bool
    bumping EffToUse
    effToUse Bool
    voluntary ActorId
    source Point
    tpos = do
      cops@COps{cotile, coTileSpeedup, corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      sb <- getsState $ getActorBody source
      actorMaxSk <- getsState $ getActorMaxSkills source
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    sb Skills
    actorMaxSk
          lid = Actor -> LevelId
    blid Actor
    sb
      sClient <- getsServer $ (EM.! bfid sb) . sclientStates
      itemToF <- getsState $ flip itemToFull
      actorSk <- currentSkillsServer source
      localTime <- getsState $ getLocalTime lid
      embeds <- getsState $ getEmbedBag lid tpos
      lvl <- getLevel lid
      getKind <- getsState $ flip getIidKindServer
      let serverTile = Level
    lvl Level -> Point -> ContentId TileKind
    `at` Point
    tpos
          lvlClient = (EnumMap LevelId Level -> LevelId -> Level
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid) (EnumMap LevelId Level -> Level)
    -> (State -> EnumMap LevelId Level) -> State -> Level
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> EnumMap LevelId Level
    sdungeon (State -> Level) -> State -> Level
    forall a b. (a -> b) -> a -> b
    $ State
    sClient
          clientTile = Level
    lvlClient Level -> Point -> ContentId TileKind
    `at` Point
    tpos
          hiddenTile = ContentData TileKind
    -> ContentId TileKind -> Maybe (ContentId TileKind)
    Tile.hideAs ContentData TileKind
    cotile ContentId TileKind
    serverTile
          alterSkill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkAlter Skills
    actorSk
          tileMinSkill = TileSpeedup -> ContentId TileKind -> Int
    Tile.alterMinSkill TileSpeedup
    coTileSpeedup ContentId TileKind
    serverTile
          revealEmbeds = Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (EnumMap ItemId ItemQuant -> Bool
    forall k a. EnumMap k a -> Bool
    EM.null EnumMap ItemId ItemQuant
    embeds) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
            UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> Container -> EnumMap ItemId ItemQuant -> UpdAtomic
    UpdSpotItemBag Bool
    True (LevelId -> Point -> Container
    CEmbed LevelId
    lid Point
    tpos) EnumMap ItemId ItemQuant
    embeds
          embedKindList =
            ((ItemId, ItemQuant) -> (ItemKind, (ItemId, ItemQuant)))
    -> [(ItemId, ItemQuant)] -> [(ItemKind, (ItemId, ItemQuant))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ItemId
    iid, ItemQuant
    kit) -> (ItemId -> ItemKind
    getKind ItemId
    iid, (ItemId
    iid, ItemQuant
    kit))) (EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs EnumMap ItemId ItemQuant
    embeds)
          sbItemKind = ItemId -> ItemKind
    getKind (ItemId -> ItemKind) -> ItemId -> ItemKind
    forall a b. (a -> b) -> a -> b
    $ Actor -> ItemId
    btrunk Actor
    sb
          -- Prevent embeds triggering each other's exploding embeds
          -- via feeble mists, in the worst case, in a loop. However,
          -- if a tile can be changed with an item (e.g., the mist trunk)
          -- but without activating embeds, mists do fine.
          projNoDamage = Actor -> Bool
    bproj Actor
    sb Bool -> Bool -> Bool
    && Bool -> Bool
    not (ItemKind -> Bool
    IK.isDamagingKind ItemKind
    sbItemKind)
          tryApplyEmbed (ItemId
    iid, ItemQuant
    kit) = do
            let itemFull :: ItemFull
    itemFull = ItemId -> ItemFull
    itemToF ItemId
    iid
                -- Let even completely apply-unskilled actors trigger basic embeds.
                -- See the note about no skill check when melee triggers effects.
                legal :: Either ReqFailure Bool
    legal = RuleContent
    -> Time
    -> Int
    -> Bool
    -> Maybe CStore
    -> ItemFull
    -> ItemQuant
    -> Either ReqFailure Bool
    permittedApply RuleContent
    corule Time
    localTime Int
    forall a. Bounded a => a
    maxBound Bool
    calmE Maybe CStore
    forall a. Maybe a
    Nothing
                                       ItemFull
    itemFull ItemQuant
    kit
            case Either ReqFailure Bool
    legal of
              Left ReqFailure
    ApplyNoEffects -> UseResult -> m UseResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UseResult
    UseDud  -- pure flavour embed
              Left ReqFailure
    reqFail -> do
                -- The failure is fully expected, because client may choose
                -- to trigger some embeds, knowing that others won't fire.
                SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> SfxMsg -> SfxAtomic
    SfxMsgFid (Actor -> FactionId
    bfid Actor
    sb)
                              (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
    forall a b. (a -> b) -> a -> b
    $ ItemId -> LevelId -> ReqFailure -> SfxMsg
    SfxExpectedEmbed ItemId
    iid LevelId
    lid ReqFailure
    reqFail
                UseResult -> m UseResult
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UseResult
    UseDud
              Either ReqFailure Bool
    _ -> EffToUse
    -> Bool -> ActorId -> LevelId -> Point -> ItemId -> m UseResult
    forall (m :: * -> *).
    MonadServerAtomic m =>
    EffToUse
    -> Bool -> ActorId -> LevelId -> Point -> ItemId -> m UseResult
    itemEffectEmbedded EffToUse
    effToUse Bool
    voluntary ActorId
    source LevelId
    lid Point
    tpos ItemId
    iid
                     -- when @effToUse == EffOnCombine@, terrain, e.g., fire,
                     -- may be removed safely, without adverse effects
                     -- by crafting, even any silly crafting as an exploit; OK
          underFeet = Point
    tpos Point -> Point -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> Point
    bpos Actor
    sb  -- if enter and alter, be more permissive
          blockedByItem = Point -> EnumMap Point (EnumMap ItemId ItemQuant) -> Bool
    forall k a. Enum k => k -> EnumMap k a -> Bool
    EM.member Point
    tpos (Level -> EnumMap Point (EnumMap ItemId ItemQuant)
    lfloor Level
    lvl)
      if chessDist tpos (bpos sb) > 1
      then return $ Just AlterDistant
      else if Just clientTile == hiddenTile then  -- searches
        -- Only non-projectile actors with SkAlter > 1 can search terrain.
        -- Even projectiles with large altering bonuses can't.
        if bproj sb || not underFeet && alterSkill <= 1
        then return $ Just AlterUnskilled  -- don't leak about searching
        else do
          -- Blocking by items nor actors does not prevent searching.
          -- Searching broadcasted, in case actors from other factions are present
          -- so that they can learn the tile and learn our action.
          -- If they already know the tile, they will just consider our action
          -- a waste of time and ignore the command.
          execUpdAtomic $ UpdSearchTile source tpos serverTile
          -- Searching also reveals the embedded items of the tile.
          -- If the items are already seen by the client
          -- (e.g., due to item detection, despite tile being still hidden),
          -- the command is ignored on the client.
          revealEmbeds
          -- If the entries are already seen by the client
          -- the command is ignored on the client.
          case EM.lookup tpos $ lentry lvl of
            Maybe PlaceEntry
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            Just PlaceEntry
    entry -> UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ LevelId -> [(Point, PlaceEntry)] -> UpdAtomic
    UpdSpotEntry LevelId
    lid [(Point
    tpos, PlaceEntry
    entry)]
          -- Seaching triggers the embeds as well, after they are revealed.
          -- The rationale is that the items were all the time present
          -- (just invisible to the client), so they need to be triggered.
          -- The exception is changable tiles, because they are not so easy
          -- to trigger; they need previous or subsequent altering.
          unless (Tile.isModifiable coTileSpeedup serverTile || projNoDamage) $
            mapM_ (void <$> tryApplyEmbed)
                  (sortEmbeds cops serverTile embedKindList)
          return Nothing  -- searching is always success
      else
        -- Here either @clientTile == serverTile@ or the client
        -- is misguided re tile at that position, e.g., it is a projectile
        -- that can't see the tile and the tile was not revealed so far.
        -- In either case, try to alter the tile. If the messages
        -- are confusing, that's fair, situation is confusing.
        if not (bproj sb || underFeet)  -- no global skill check in these cases
           && alterSkill < tileMinSkill
        then return $ Just AlterUnskilled  -- don't leak about altering
        else do
          -- Save the original content of ground and eqp to abort transformations
          -- if any item is removed, possibly an item intended as the fuel.
          groundBag <- getsState $ getBodyStoreBag sb CGround
          eqpBag <- getsState $ getBodyStoreBag sb CEqp
          -- Compute items to use for transformation early, before any extra
          -- items added by activated embeds, to use only intended items as fuel.
          -- Use even unidentified items --- one more way to id by use.
          kitAssG <- getsState $ kitAssocs source [CGround]
          kitAssE <- getsState $ kitAssocs source [CEqp]
          let kitAss = [(ItemId, ItemFullKit)]
    -> [(ItemId, ItemFullKit)]
    -> [((CStore, Bool), (ItemId, ItemFullKit))]
    listToolsToConsume [(ItemId, ItemFullKit)]
    kitAssG [(ItemId, ItemFullKit)]
    kitAssE
              announceTileChange =
                -- If no embeds and the only thing that happens is the change
                -- of the tile, don't display a message, because the change
                -- is visible on the map (unless it changes into itself)
                -- and there's nothing more to speak about.
                -- However, even with embeds, don't spam if wading through
                -- terrain and changing it each step.
                Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool
    underFeet Bool -> Bool -> Bool
    || EnumMap ItemId ItemQuant -> Bool
    forall k a. EnumMap k a -> Bool
    EM.null EnumMap ItemId ItemQuant
    embeds) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                  SfxAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
    execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> LevelId -> Point -> ContentId TileKind -> SfxAtomic
    SfxTrigger ActorId
    source LevelId
    lid Point
    tpos ContentId TileKind
    serverTile
              changeTo GroupName TileKind
    tgroup = do
                -- No @SfxAlter@, because the effect is obvious (e.g., opened door).
                let nightCond :: TileKind -> Bool
    nightCond TileKind
    kt = Bool -> Bool
    not (Feature -> TileKind -> Bool
    Tile.kindHasFeature Feature
    TK.Walkable TileKind
    kt
                                        Bool -> Bool -> Bool
    && Feature -> TileKind -> Bool
    Tile.kindHasFeature Feature
    TK.Clear TileKind
    kt)
                                   Bool -> Bool -> Bool
    || (if Level -> Bool
    lnight Level
    lvl then Bool -> Bool
    forall a. a -> a
    id else Bool -> Bool
    not)
                                        (Feature -> TileKind -> Bool
    Tile.kindHasFeature Feature
    TK.Dark TileKind
    kt)
                -- Sometimes the tile is determined precisely by the ambient light
                -- of the source tiles. If not, default to cave day/night condition.
                mtoTile <- Rnd (Maybe (ContentId TileKind)) -> m (Maybe (ContentId TileKind))
    forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
    rndToAction (Rnd (Maybe (ContentId TileKind))
     -> m (Maybe (ContentId TileKind)))
    -> Rnd (Maybe (ContentId TileKind))
    -> m (Maybe (ContentId TileKind))
    forall a b. (a -> b) -> a -> b
    $ ContentData TileKind
    -> GroupName TileKind
    -> (TileKind -> Bool)
    -> Rnd (Maybe (ContentId TileKind))
    forall a.
    Show a =>
    ContentData a
    -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
    opick ContentData TileKind
    cotile GroupName TileKind
    tgroup TileKind -> Bool
    nightCond
                toTile <- maybe (rndToAction
                                 $ fromMaybe (error $ "" `showFailure` tgroup)
                                   <$> opick cotile tgroup (const True))
                                return
                                mtoTile
                embeds2 <- getsState $ getEmbedBag lid tpos
                let newHasEmbeds = TileSpeedup -> ContentId TileKind -> Bool
    Tile.isEmbed TileSpeedup
    coTileSpeedup ContentId TileKind
    toTile
                -- Don't regenerate same tile, unless it had embeds, but all spent.
                when (serverTile /= toTile
                      || EM.null embeds2 && newHasEmbeds) $ do
                  -- At most one of these two will be accepted on any given client.
                  when (serverTile /= toTile) $
                    execUpdAtomic $ UpdAlterTile lid tpos serverTile toTile
                  -- This case happens when a client does not see a searching
                  -- action by another faction, but sees the subsequent altering
                  -- or if another altering takes place in between.
                  case hiddenTile of
                    Just ContentId TileKind
    tHidden ->
                      UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ LevelId
    -> Point -> ContentId TileKind -> ContentId TileKind -> UpdAtomic
    UpdAlterTile LevelId
    lid Point
    tpos ContentId TileKind
    tHidden ContentId TileKind
    toTile
                    Maybe (ContentId TileKind)
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  -- @UpdAlterExplorable@ is received by any client regardless
                  -- of whether the alteration was seen and how.
                  case (Tile.isExplorable coTileSpeedup serverTile,
                        Tile.isExplorable coTileSpeedup toTile) of
                    (Bool
    False, Bool
    True) -> UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ LevelId -> Int -> UpdAtomic
    UpdAlterExplorable LevelId
    lid Int
    1
                    (Bool
    True, Bool
    False) -> UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ LevelId -> Int -> UpdAtomic
    UpdAlterExplorable LevelId
    lid (-Int
    1)
                    (Bool, Bool)
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                  -- At the end we replace old embeds (even if partially used up)
                  -- with new ones.
                  -- If the source tile was hidden, the items could not be visible
                  -- on a client, in which case the command would be ignored
                  -- on the client, without causing any problems. Otherwise,
                  -- if the position is in view, client has accurate info.
                  unless (EM.null embeds2) $
                    execUpdAtomic $ UpdLoseItemBag True (CEmbed lid tpos) embeds2
                  -- Altering always reveals the outcome tile, so it's not hidden
                  -- and so its embedded items are always visible.
                  embedItemOnPos lid tpos toTile
              tryChangeWith :: ( [(Int, GroupName IK.ItemKind)]
                               , GroupName TK.TileKind )
                            -> m Bool
              tryChangeWith ([(Int, GroupName ItemKind)]
    tools0, GroupName TileKind
    tgroup) = do
                let grps0 :: [(Bool, Int, GroupName ItemKind)]
    grps0 = ((Int, GroupName ItemKind) -> (Bool, Int, GroupName ItemKind))
    -> [(Int, GroupName ItemKind)] -> [(Bool, Int, GroupName ItemKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Int
    x, GroupName ItemKind
    y) -> (Bool
    False, Int
    x, GroupName ItemKind
    y)) [(Int, GroupName ItemKind)]
    tools0
                      -- apply if durable
                    (EnumMap CStore (EnumMap ItemId ItemQuant)
    bagsToLose, [(CStore, (ItemId, ItemFull))]
    iidsToApply, [(Bool, Int, GroupName ItemKind)]
    grps) =
                      ((EnumMap CStore (EnumMap ItemId ItemQuant),
      [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
     -> ((CStore, Bool), (ItemId, ItemFullKit))
     -> (EnumMap CStore (EnumMap ItemId ItemQuant),
         [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)]))
    -> (EnumMap CStore (EnumMap ItemId ItemQuant),
        [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
    -> [((CStore, Bool), (ItemId, ItemFullKit))]
    -> (EnumMap CStore (EnumMap ItemId ItemQuant),
        [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (EnumMap CStore (EnumMap ItemId ItemQuant),
     [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
    -> ((CStore, Bool), (ItemId, ItemFullKit))
    -> (EnumMap CStore (EnumMap ItemId ItemQuant),
        [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
    subtractIidfromGrps (EnumMap CStore (EnumMap ItemId ItemQuant)
    forall k a. EnumMap k a
    EM.empty, [], [(Bool, Int, GroupName ItemKind)]
    grps0) [((CStore, Bool), (ItemId, ItemFullKit))]
    kitAss
                if [(Bool, Int, GroupName ItemKind)] -> Bool
    forall a. [a] -> Bool
    null [(Bool, Int, GroupName ItemKind)]
    grps then do
                  m ()
    announceTileChange  -- first the result is foretold
                  ActorId
    -> EnumMap CStore (EnumMap ItemId ItemQuant)
    -> [(CStore, (ItemId, ItemFull))]
    -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId
    -> EnumMap CStore (EnumMap ItemId ItemQuant)
    -> [(CStore, (ItemId, ItemFull))]
    -> m ()
    consumeItems ActorId
    source EnumMap CStore (EnumMap ItemId ItemQuant)
    bagsToLose [(CStore, (ItemId, ItemFull))]
    iidsToApply  -- then the cost
                  GroupName TileKind -> m ()
    changeTo GroupName TileKind
    tgroup  -- then result is seen
                  Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                else Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
              feats = TileKind -> [Feature]
    TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
    forall a b. (a -> b) -> a -> b
    $ ContentData TileKind -> ContentId TileKind -> TileKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData TileKind
    cotile ContentId TileKind
    serverTile
              tileActions =
                (Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Bool
    -> Bool
    -> [(ItemKind, (ItemId, ItemQuant))]
    -> Feature
    -> Maybe TileAction
    parseTileAction
                            (Actor -> Bool
    bproj Actor
    sb)
                            (Bool
    underFeet Bool -> Bool -> Bool
    || Bool
    blockedByItem)  -- avoids AlterBlockItem
                            [(ItemKind, (ItemId, ItemQuant))]
    embedKindList)
                         [Feature]
    feats
              groupWithFromAction TileAction
    action = case TileAction
    action of
                WithAction [(Int, GroupName ItemKind)]
    grps GroupName TileKind
    _ | Bool -> Bool
    not Bool
    bumping -> [(Int, GroupName ItemKind)] -> Maybe [(Int, GroupName ItemKind)]
    forall a. a -> Maybe a
    Just [(Int, GroupName ItemKind)]
    grps
                TileAction
    _ -> Maybe [(Int, GroupName ItemKind)]
    forall a. Maybe a
    Nothing
              groupsToAlterWith = (TileAction -> Maybe [(Int, GroupName ItemKind)])
    -> [TileAction] -> [[(Int, GroupName ItemKind)]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe TileAction -> Maybe [(Int, GroupName ItemKind)]
    groupWithFromAction [TileAction]
    tileActions
              processTileActions :: Maybe UseResult -> [TileAction] -> m Bool
              processTileActions Maybe UseResult
    museResult [] =
                Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> m Bool) -> Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $! Bool -> (UseResult -> Bool) -> Maybe UseResult -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (UseResult -> UseResult -> Bool
    forall a. Eq a => a -> a -> Bool
    /= UseResult
    UseDud) Maybe UseResult
    museResult
              processTileActions Maybe UseResult
    museResult (TileAction
    ta : [TileAction]
    rest) = case TileAction
    ta of
                EmbedAction (ItemId
    iid, ItemQuant
    kit) ->
                  -- Embeds are activated in the order in tile definition
                  -- and never after the tile is changed.
                  -- If any embedded item was present and processed,
                  -- but none was triggered, both free and item-consuming terrain
                  -- alteration is disabled. The exception is projectiles
                  -- not being able to process embeds due to skill required,
                  -- which does not block future terrain alteration.
                  -- Skill check for non-projectiles is performed much earlier.
                  -- All projectiles have 0 skill for the purpose of embed
                  -- activation, regardless of their trunk.
                  if | Actor -> Bool
    bproj Actor
    sb Bool -> Bool -> Bool
    && Int
    tileMinSkill Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 ->  -- local skill check
                       Maybe UseResult -> [TileAction] -> m Bool
    processTileActions Maybe UseResult
    museResult [TileAction]
    rest
                         -- not blocking future terrain altering, e.g., oil mist
                         -- not slowed over water tile that has @talter@ equal to 2,
                         -- but able to change it into oil spill soon after
                     | Bool
    projNoDamage ->
                       Maybe UseResult -> [TileAction] -> m Bool
    processTileActions (UseResult -> Maybe UseResult
    forall a. a -> Maybe a
    Just UseResult
    UseDud) [TileAction]
    rest
                         -- projectiles having enough skill, but no damage,
                         -- not only can't activate embeds, but block future
                         -- terrain altering, e.g., oil mist not puncturing
                         -- a barrel and causing explosion, and so also
                         -- not causing it to disappear later on
                     | Bool
    otherwise -> do
                         -- here falls the case of fragmentation blast puncturing
                         -- a barrel and so causing an explosion
                         triggered <- (ItemId, ItemQuant) -> m UseResult
    tryApplyEmbed (ItemId
    iid, ItemQuant
    kit)
                         let useResult = UseResult -> Maybe UseResult -> UseResult
    forall a. a -> Maybe a -> a
    fromMaybe UseResult
    UseDud Maybe UseResult
    museResult
                         processTileActions (Just $ max useResult triggered) rest
                           -- max means that even one activated embed is enough
                           -- to alter terrain in a future action
                ToAction GroupName TileKind
    tgroup -> Bool -> m Bool -> m Bool
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Bool -> Bool
    not (Actor -> Bool
    bproj Actor
    sb)) (m Bool -> m Bool) -> m Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $
                  -- @parseTileAction@ ensures the above assertion
                  -- so that projectiles never cause normal transitions and,
                  -- e.g., mists douse fires or two flames thrown, first ignites,
                  -- second douses immediately afterwards
                  if Bool -> (UseResult -> Bool) -> Maybe UseResult -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (UseResult -> UseResult -> Bool
    forall a. Eq a => a -> a -> Bool
    == UseResult
    UseUp) Maybe UseResult
    museResult
                  then do
                    m ()
    announceTileChange
                    GroupName TileKind -> m ()
    changeTo GroupName TileKind
    tgroup
                    Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                  else Maybe UseResult -> [TileAction] -> m Bool
    processTileActions Maybe UseResult
    museResult [TileAction]
    rest
                WithAction [(Int, GroupName ItemKind)]
    grps GroupName TileKind
    tgroup -> do
                  -- Note that there is no skill check if the source actors
                  -- is a projectile. Permission is conveyed in @ProjYes@ instead.
                  groundBag2 <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> EnumMap ItemId ItemQuant)
     -> m (EnumMap ItemId ItemQuant))
    -> (State -> EnumMap ItemId ItemQuant)
    -> m (EnumMap ItemId ItemQuant)
    forall a b. (a -> b) -> a -> b
    $ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
    getBodyStoreBag Actor
    sb CStore
    CGround
                  eqpBag2 <- getsState $ getBodyStoreBag sb CEqp
                  if (not bumping || null grps)
                       -- 'M' confirmation needed to consume items, bump not enough
                     && (bproj sb || voluntary || null grps)
                           -- consume only if voluntary or released as projectile
                     && (maybe True (== UseUp) museResult
                         || effToUse == EffOnCombine)
                              -- unwanted crafting shouldn't block transformations
                     && let f (a
    k1, b
    _) (a
    k2, b
    _) = a
    k1 a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    k2
                        in EM.isSubmapOfBy f groundBag groundBag2
                           && EM.isSubmapOfBy f eqpBag eqpBag2
                          -- don't transform if items, possibly intended for
                          -- transformation, removed; also when only crafting
                          -- was intended, which almost always removes some items
                  then do
                    altered <- tryChangeWith (grps, tgroup)
                    if altered
                    then return True
                    else processTileActions museResult rest
                  else processTileActions museResult rest
          -- Note that stray embedded items (not from tile content definition)
          -- are never activated.
          if null tileActions then
            return $! if blockedByItem
                         && not underFeet
                         && Tile.isModifiable coTileSpeedup serverTile
                      then Just AlterBlockItem  -- likely cause
                      else Just AlterNothing  -- can't do; silly client; fail
          else
            if underFeet || not (occupiedBigLvl tpos lvl)
                            && not (occupiedProjLvl tpos lvl) then do
              -- The items are first revealed for the sake of clients that
              -- may see the tile as hidden. Note that the tile is not revealed
              -- (unless it's altered later on, in which case the new one is).
              revealEmbeds
              tileTriggered <- processTileActions Nothing tileActions
              let potentiallyMissing = ([(Int, GroupName ItemKind)] -> Bool)
    -> [[(Int, GroupName ItemKind)]] -> [[(Int, GroupName ItemKind)]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ([(Int, GroupName ItemKind)] -> Bool)
    -> [(Int, GroupName ItemKind)]
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Int, GroupName ItemKind)] -> Bool
    forall a. [a] -> Bool
    null) [[(Int, GroupName ItemKind)]]
    groupsToAlterWith
              when (not tileTriggered && not underFeet && voluntary
                    && not (null potentiallyMissing)) $
                execSfxAtomic $ SfxMsgFid (bfid sb)
                              $ SfxNoItemsForTile potentiallyMissing
              return Nothing  -- altered as much as items allowed; success
            else return $ Just AlterBlockActor

    -- * ReqWait

    -- | Do nothing. Wait skill 1 required. Bracing requires 2, sleep 3, lurking 4.
    --
    -- Something is sometimes done in 'processWatchfulness'.
    reqWait :: MonadServerAtomic m => ActorId -> m ()
    {-# INLINE reqWait #-}
    reqWait :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqWait ActorId
    source = do
      actorSk <- ActorId -> m Skills
    forall (m :: * -> *). MonadServer m => ActorId -> m Skills
    currentSkillsServer ActorId
    source
      unless (Ability.getSk Ability.SkWait actorSk > 0) $
        execFailure source ReqWait WaitUnskilled

    -- * ReqWait10

    -- | Do nothing.
    --
    -- Something is sometimes done in 'processWatchfulness'.
    reqWait10 :: MonadServerAtomic m => ActorId -> m ()
    {-# INLINE reqWait10 #-}
    reqWait10 :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqWait10 ActorId
    source = do
      actorSk <- ActorId -> m Skills
    forall (m :: * -> *). MonadServer m => ActorId -> m Skills
    currentSkillsServer ActorId
    source
      unless (Ability.getSk Ability.SkWait actorSk >= 4) $
        execFailure source ReqWait10 WaitUnskilled

    -- * ReqYell

    -- | Yell/yawn/stretch/taunt.
    -- Wakes up (gradually) from sleep. Causes noise heard by enemies on the level
    -- even if out of their hearing range.
    --
    -- Governed by the waiting skill (because everyone is supposed to have it).
    -- unlike @ReqWait@, induces overhead.
    --
    -- This is similar to the effect @Yell@, but always voluntary.
    reqYell :: MonadServerAtomic m => ActorId -> m ()
    reqYell :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqYell ActorId
    aid = do
      actorSk <- ActorId -> m Skills
    forall (m :: * -> *). MonadServer m => ActorId -> m Skills
    currentSkillsServer ActorId
    aid
      if | Ability.getSk Ability.SkWait actorSk > 0 ->
           -- Last yawn before waking up is displayed as a yell, but that's fine.
           -- To fix that, we'd need to move the @SfxTaunt@
           -- to @processWatchfulness@.
           execSfxAtomic $ SfxTaunt True aid
         | Ability.getSk Ability.SkMove actorSk <= 0
           || Ability.getSk Ability.SkDisplace actorSk <= 0
           || Ability.getSk Ability.SkMelee actorSk <= 0 ->
           -- Potentially, only waiting is possible, so given that it's drained,
           -- don't let the actor be stuck nor alarm about server failure.
           execSfxAtomic $ SfxTaunt False aid
         | otherwise -> do
           -- In most situation one of the 3 actions above
           -- can be performed and waiting skill is not needed for that,
           -- so given the 3 skills are available, waste turn, waiting until
           -- they can be performed, but don't alarm, because it does happen
           -- sometimes in crowds. No bracing granted, either, but mark
           -- waiting so that AI knows to change leader.
           --   execFailure aid ReqYell YellUnskilled
           b <- getsState $ getActorBody aid
           case bwatch b of
             WWait Int
    _ -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
             Watchfulness
    _ -> UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ ActorId -> Watchfulness -> Watchfulness -> UpdAtomic
    UpdWaitActor ActorId
    aid (Actor -> Watchfulness
    bwatch Actor
    b) (Int -> Watchfulness
    WWait Int
    0)

    -- * ReqMoveItems

    reqMoveItems :: MonadServerAtomic m
                 => ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
    reqMoveItems :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> [(ItemId, Int, CStore, CStore)] -> m ()
    reqMoveItems ActorId
    source [(ItemId, Int, CStore, CStore)]
    l = do
      actorSk <- ActorId -> m Skills
    forall (m :: * -> *). MonadServer m => ActorId -> m Skills
    currentSkillsServer ActorId
    source
      if Ability.getSk Ability.SkMoveItem actorSk > 0 then do
        b <- getsState $ getActorBody source
        actorMaxSk <- getsState $ getActorMaxSkills source
        -- Server accepts item movement based on calm at the start, not end
        -- or in the middle, to avoid interrupted or partially ignored commands.
        let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorMaxSk
        case l of
          [] -> ActorId -> RequestTimed -> ReqFailure -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure ActorId
    source ([(ItemId, Int, CStore, CStore)] -> RequestTimed
    ReqMoveItems [(ItemId, Int, CStore, CStore)]
    l) ReqFailure
    ItemNothing
          (ItemId, Int, CStore, CStore)
    iid : [(ItemId, Int, CStore, CStore)]
    rest -> do
            Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
    reqMoveItem Bool
    False ActorId
    source Bool
    calmE (ItemId, Int, CStore, CStore)
    iid
            -- Dropping previous may destroy next items.
            ((ItemId, Int, CStore, CStore) -> m ())
    -> [(ItemId, Int, CStore, CStore)] -> m ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    (a -> m ()) -> t a -> m ()
    mapM_ (Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
    reqMoveItem Bool
    True ActorId
    source Bool
    calmE) [(ItemId, Int, CStore, CStore)]
    rest
      else execFailure source (ReqMoveItems l) MoveItemUnskilled

    reqMoveItem :: MonadServerAtomic m
                => Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
    reqMoveItem :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool -> ActorId -> Bool -> (ItemId, Int, CStore, CStore) -> m ()
    reqMoveItem Bool
    absentPermitted ActorId
    aid Bool
    calmE (ItemId
    iid, Int
    kOld, CStore
    fromCStore, CStore
    toCStore) = do
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      let fromC = ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    fromCStore
          req = [(ItemId, Int, CStore, CStore)] -> RequestTimed
    ReqMoveItems [(ItemId
    iid, Int
    kOld, CStore
    fromCStore, CStore
    toCStore)]
      toC <- case toCStore of
        CStore
    CGround -> Bool -> ActorId -> Actor -> m Container
    forall (m :: * -> *).
    MonadStateRead m =>
    Bool -> ActorId -> Actor -> m Container
    pickDroppable Bool
    False ActorId
    aid Actor
    b  -- drop over fog, etc.
        CStore
    _ -> Container -> m Container
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Container -> m Container) -> Container -> m Container
    forall a b. (a -> b) -> a -> b
    $! ActorId -> CStore -> Container
    CActor ActorId
    aid CStore
    toCStore
      bagFrom <- getsState $ getContainerBag (CActor aid fromCStore)
      bagBefore <- getsState $ getContainerBag toC
      -- The effect of dropping previous items from this series may have
      -- increased or decreased the number of this item.
      let k = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    kOld (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ItemQuant -> Int
    forall a b. (a, b) -> a
    fst (ItemQuant -> Int) -> ItemQuant -> Int
    forall a b. (a -> b) -> a -> b
    $ ItemQuant -> ItemId -> EnumMap ItemId ItemQuant -> ItemQuant
    forall k a. Enum k => a -> k -> EnumMap k a -> a
    EM.findWithDefault (Int
    0, []) ItemId
    iid EnumMap ItemId ItemQuant
    bagFrom
      let !_A = Bool
    absentPermitted Bool -> Bool -> Bool
    || Int
    k Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    kOld
      if
       | absentPermitted && k == 0 -> return ()
       | k < 1 || fromCStore == toCStore -> execFailure aid req ItemNothing
       | fromCStore == CEqp && not calmE ->
         execFailure aid req ItemNotCalm
       | toCStore == CEqp && not calmE ->
         execFailure aid req ItemNotCalm
       | toCStore == CEqp && eqpOverfull b k ->
         execFailure aid req EqpOverfull
       | otherwise -> do
        upds <- generalMoveItem True iid k fromC toC
        mapM_ execUpdAtomic upds
        itemFull <- getsState $ itemToFull iid
        -- Let any item manipulation attempt to identify, in case the item
        -- got into stash, e.g., by being thrown at the stash location,
        -- and gets identified only when equipped or dropped and picked up again.
        discoverIfMinorEffects toC iid (itemKindId itemFull)
        -- The first recharging period after equipping is random,
        -- between 1 and 2 standard timeouts of the item.
        -- Timeouts for items in shared stash are not consistent wrt the actor's
        -- local time, because actors from many levels put items there
        -- all the time (and don't rebase it to the clock of the stash's level).
        -- If wrong local time in shared stash causes an item to recharge
        -- for a very long time wrt actor on some level,
        -- the player can reset it by dropping the item and picking up again
        -- (as a flip side, a charging item in stash may sometimes
        -- be used at once on another level, with different local time, but only
        -- once, because after first use, the timeout is set to local time).
        -- This is not terribly consistent, but not recharging in stash is
        -- not better, because either we block activation of any items with timeout,
        -- or encourage moving items out of stash, recharging and moving in.
        -- Which is not fun at all, but one more thing to remember doing regularly.
        when (toCStore `elem` [CEqp, COrgan]
              && fromCStore `notElem` [CEqp, COrgan]
              || fromCStore == CStash) $ do
          let beforeIt = case ItemId
    iid ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
    forall k a. Enum k => k -> EnumMap k a -> Maybe a
    `EM.lookup` EnumMap ItemId ItemQuant
    bagBefore of
                Maybe ItemQuant
    Nothing -> []  -- no such items before move
                Just (Int
    _, [ItemTimer]
    it2) -> [ItemTimer]
    it2
          randomResetTimeout k iid itemFull beforeIt toC

    -- * ReqProject

    reqProject :: MonadServerAtomic m
               => ActorId    -- ^ actor projecting the item (is on current lvl)
               -> Point      -- ^ target position of the projectile
               -> Int        -- ^ digital line parameter
               -> ItemId     -- ^ the item to be projected
               -> CStore     -- ^ which store the items comes from
               -> m ()
    reqProject :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Point -> Int -> ItemId -> CStore -> m ()
    reqProject ActorId
    source Point
    tpxy Int
    eps ItemId
    iid CStore
    cstore = do
      let req :: RequestTimed
    req = Point -> Int -> ItemId -> CStore -> RequestTimed
    ReqProject Point
    tpxy Int
    eps ItemId
    iid CStore
    cstore
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    source
      curChalSer <- getsServer $ scurChalSer . soptions
      fact <- getsState $ (EM.! bfid b) . sfactionD
      actorMaxSk <- getsState $ getActorMaxSkills source
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorMaxSk
      if | ckeeper curChalSer && fhasUI (gkind fact) ->
            execFailure source req ProjectFinderKeeper
         | cstore == CEqp && not calmE -> execFailure source req ItemNotCalm
         | otherwise -> do
             mfail <-
               projectFail source source (bpos b) tpxy eps False iid cstore False
             maybe (return ()) (execFailure source req) mfail

    -- * ReqApply

    reqApply :: MonadServerAtomic m
             => ActorId  -- ^ actor applying the item (is on current level)
             -> ItemId   -- ^ the item to be applied
             -> CStore   -- ^ the location of the item
             -> m ()
    reqApply :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ItemId -> CStore -> m ()
    reqApply ActorId
    aid ItemId
    iid CStore
    cstore = do
      COps{corule} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      let req = ItemId -> CStore -> RequestTimed
    ReqApply ItemId
    iid CStore
    cstore
      b <- getsState $ getActorBody aid
      actorMaxSk <- getsState $ getActorMaxSkills aid
      let calmE = Actor -> Skills -> Bool
    calmEnough Actor
    b Skills
    actorMaxSk
      if cstore == CEqp && not calmE then execFailure aid req ItemNotCalm
      else do
        bag <- getsState $ getBodyStoreBag b cstore
        case EM.lookup iid bag of
          Maybe ItemQuant
    Nothing -> ActorId -> RequestTimed -> ReqFailure -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure ActorId
    aid RequestTimed
    req ReqFailure
    ApplyOutOfReach
          Just ItemQuant
    kit -> do
            itemFull <- (State -> ItemFull) -> m ItemFull
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> ItemFull) -> m ItemFull)
    -> (State -> ItemFull) -> m ItemFull
    forall a b. (a -> b) -> a -> b
    $ ItemId -> State -> ItemFull
    itemToFull ItemId
    iid
            actorSk <- currentSkillsServer aid
            localTime <- getsState $ getLocalTime (blid b)
            let skill = Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkApply Skills
    actorSk
                legal = RuleContent
    -> Time
    -> Int
    -> Bool
    -> Maybe CStore
    -> ItemFull
    -> ItemQuant
    -> Either ReqFailure Bool
    permittedApply RuleContent
    corule Time
    localTime Int
    skill Bool
    calmE (CStore -> Maybe CStore
    forall a. a -> Maybe a
    Just CStore
    cstore)
                                       ItemFull
    itemFull ItemQuant
    kit
            case legal of
              Left ReqFailure
    reqFail -> ActorId -> RequestTimed -> ReqFailure -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> RequestTimed -> ReqFailure -> m ()
    execFailure ActorId
    aid RequestTimed
    req ReqFailure
    reqFail
              Right Bool
    _ -> ActorId -> ItemId -> CStore -> m ()
    forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ItemId -> CStore -> m ()
    applyItem ActorId
    aid ItemId
    iid CStore
    cstore

    -- * ReqGameRestart

    reqGameRestart :: MonadServerAtomic m
                   => ActorId -> GroupName ModeKind -> Challenge
                   -> m ()
    reqGameRestart :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> GroupName ModeKind -> Challenge -> m ()
    reqGameRestart ActorId
    aid GroupName ModeKind
    groupName Challenge
    scurChalSer = do
      noConfirmsGame <- m Bool
    forall (m :: * -> *). MonadStateRead m => m Bool
    isNoConfirmsGame
      factionD <- getsState sfactionD
      let fidsUI = ((FactionId, Faction) -> FactionId)
    -> [(FactionId, Faction)] -> [FactionId]
    forall a b. (a -> b) -> [a] -> [b]
    map (FactionId, Faction) -> FactionId
    forall a b. (a, b) -> a
    fst ([(FactionId, Faction)] -> [FactionId])
    -> [(FactionId, Faction)] -> [FactionId]
    forall a b. (a -> b) -> a -> b
    $ ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(FactionId
    _, Faction
    fact) -> FactionKind -> Bool
    fhasUI (Faction -> FactionKind
    gkind Faction
    fact))
                                    (FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    factionD)
      -- This call to `revealItems` and `revealPerception` is really needed,
      -- because the other happens only at natural game conclusion,
      -- not at forced quitting.
      unless noConfirmsGame $
        mapM_ revealAll fidsUI
      -- Announcing end of game, we send lore, because game is over.
      b <- getsState $ getActorBody aid
      oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD
      factionAn <- getsServer sfactionAn
      generationAn <- getsServer sgenerationAn
      execUpdAtomic $ UpdQuitFaction
                        (bfid b)
                        oldSt
                        (Just $ Status Restart (fromEnum $ blid b) (Just groupName))
                        (Just (factionAn, generationAn))
      -- We don't save game and don't wait for clips end. ASAP.
      modifyServer $ \StateServer
    ser -> StateServer
    ser { sbreakASAP = True
                                 , soptionsNxt = (soptionsNxt ser) {scurChalSer} }

    -- * ReqGameDropAndExit

    -- After we break out of the game loop, we will notice from @Camping@
    -- we shouldn exit the game.
    reqGameDropAndExit :: MonadServerAtomic m => ActorId -> m ()
    reqGameDropAndExit :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqGameDropAndExit ActorId
    aid = do
      m ()
    forall (m :: * -> *). MonadServer m => m ()
    verifyAssertExplored
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD
      execUpdAtomic $ UpdQuitFaction
                        (bfid b)
                        oldSt
                        (Just $ Status Camping (fromEnum $ blid b) Nothing)
                        Nothing
      modifyServer $ \StateServer
    ser -> StateServer
    ser { sbreakASAP = True
                                 , sbreakLoop = True }

    verifyAssertExplored :: MonadServer m => m ()
    verifyAssertExplored :: forall (m :: * -> *). MonadServer m => m ()
    verifyAssertExplored = do
      assertExplored <- (StateServer -> Maybe Int) -> m (Maybe Int)
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer ((StateServer -> Maybe Int) -> m (Maybe Int))
    -> (StateServer -> Maybe Int) -> m (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ ServerOptions -> Maybe Int
    sassertExplored (ServerOptions -> Maybe Int)
    -> (StateServer -> ServerOptions) -> StateServer -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateServer -> ServerOptions
    soptions
      case assertExplored of
        Maybe Int
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just Int
    lvlN -> do
          -- Exploration (by any party) verfied via spawning; beware of levels
          -- with disabled spawning.
          snumSpawned <- (StateServer -> EnumMap LevelId Int) -> m (EnumMap LevelId Int)
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer StateServer -> EnumMap LevelId Int
    snumSpawned
          let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int -> LevelId
    forall a. Enum a => Int -> a
    toEnum Int
    lvlN LevelId -> EnumMap LevelId Int -> Bool
    forall k a. Enum k => k -> EnumMap k a -> Bool
    `EM.member` EnumMap LevelId Int
    snumSpawned
                            Bool -> Bool -> Bool
    || Int -> LevelId
    forall a. Enum a => Int -> a
    toEnum (- Int
    lvlN) LevelId -> EnumMap LevelId Int -> Bool
    forall k a. Enum k => k -> EnumMap k a -> Bool
    `EM.member` EnumMap LevelId Int
    snumSpawned
                            Bool -> (String, Int) -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` String
    "by game end, exploration haven't reached the expected level depth, indicating stuck AI (or just very busy initial levels)"
                            String -> Int -> (String, Int)
    forall v. String -> v -> (String, v)
    `swith` Int
    lvlN) ()
          return ()

    -- * ReqGameSaveAndExit

    -- After we break out of the game loop, we will notice from @Camping@
    -- we shouldn exit the game.
    reqGameSaveAndExit :: MonadServerAtomic m => ActorId -> m ()
    reqGameSaveAndExit :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    reqGameSaveAndExit ActorId
    aid = do
      m ()
    forall (m :: * -> *). MonadServer m => m ()
    verifyAssertExplored
      b <- (State -> Actor) -> m Actor
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
    forall a b. (a -> b) -> a -> b
    $ ActorId -> State -> Actor
    getActorBody ActorId
    aid
      oldSt <- getsState $ gquit . (EM.! bfid b) . sfactionD
      execUpdAtomic $ UpdQuitFaction
                        (bfid b)
                        oldSt
                        (Just $ Status Camping (fromEnum $ blid b) Nothing)
                        Nothing
      modifyServer $ \StateServer
    ser -> StateServer
    ser { sbreakASAP = True
                                 , swriteSave = True }

    -- * ReqGameSave

    -- After we break out of the game loop, we will notice we shouldn't quit
    -- the game and we will enter the game loop again.
    reqGameSave :: MonadServer m => m ()
    reqGameSave :: forall (m :: * -> *). MonadServer m => m ()
    reqGameSave =
      (StateServer -> StateServer) -> m ()
    forall (m :: * -> *).
    MonadServer m =>
    (StateServer -> StateServer) -> m ()
    modifyServer ((StateServer -> StateServer) -> m ())
    -> (StateServer -> StateServer) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \StateServer
    ser -> StateServer
    ser { sbreakASAP = True
                                 , swriteSave = True }

    -- * ReqDoctrine

    reqDoctrine :: MonadServerAtomic m => FactionId -> Ability.Doctrine -> m ()
    reqDoctrine :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> Doctrine -> m ()
    reqDoctrine FactionId
    fid Doctrine
    toT = do
      fromT <- (State -> Doctrine) -> m Doctrine
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Doctrine) -> m Doctrine)
    -> (State -> Doctrine) -> m Doctrine
    forall a b. (a -> b) -> a -> b
    $ Faction -> Doctrine
    gdoctrine (Faction -> Doctrine) -> (State -> Faction) -> State -> Doctrine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (FactionDict -> Faction)
    -> (State -> FactionDict) -> State -> Faction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . State -> FactionDict
    sfactionD
      execUpdAtomic $ UpdDoctrineFaction fid toT fromT

    -- * ReqAutomate

    reqAutomate :: MonadServerAtomic m => FactionId -> m ()
    reqAutomate :: forall (m :: * -> *). MonadServerAtomic m => FactionId -> m ()
    reqAutomate FactionId
    fid = UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId -> Bool -> UpdAtomic
    UpdAutoFaction FactionId
    fid Bool
    True