sc2hs (empty) → 0.1.0.0

raw patch · 7 files changed

+422/−0 lines, 7 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, directory, etc, filepath, freer-simple, gitrev, lens, lens-labels, proto-lens, sc2-lowlevel, sc2-proto, sc2-support, sc2hs, text

Files

README.md +96/−0
app/Main.hs +56/−0
sc2hs.cabal +77/−0
src/Control/Effects/Logging.hs +19/−0
src/Control/Effects/Modalities/Belief.lhs +4/−0
src/Control/Effects/Modalities/Knowledge.lhs +6/−0
src/Network/SC2/Agent.hs +164/−0

+ README.md view

@@ -0,0 +1,96 @@+# sc2hs: Haskell bindings for the StarCraft II API
+
+## Introduction
+`sc2hs` is an Effect-based API for StarCraft II.
+Currently, the API is quite small, basically enough to get the worker rush bot working, but the framework is there.
+
+## Example
+A quick example of the API is in order!
+```haskell
+-- Orders a worker rush on the first frame.
+workerRush :: Member Logging r =>   Eff (Agent ':r ) () -- 1
+workerRush = do
+  updateObservations -- 2
+  units <- workers -- 3
+  locs <- enemyStartLocations -- 4
+  units `attack` (head locs) -- 5
+  logMessage 1 "Worker rush ^_^"
+  loop
+  
+loop :: Member Logging r =>  Eff (Agent ': r) ()
+loop = do
+  step -- 6
+  status <- getStatus -- 7
+  case status of
+    Ended -> logMessage 1 "Ending game"
+    _     -> loop
+
+```
+Let's look at what this does:
+1. An entity which interacts with SC2 is a computation using the `Agent` Effect. This is roughly the level of API that is exposed by, for example, `python-sc2`.
+2. `updateObservations` asks SC2 to send all the info the `Agent` can legitimately know of, and processes the result. It should be called once per game tick.
+3. `workers` is a function which returns a list of the player's worker units (SCVs/Drones/Probes)
+4. `enemyStartLocations` retrieves the list of possible start locations for the enemy, which is a property of the map.
+5. `attack` is a wrapper around an `Order`, which instructs units to use abilities. `attack` just creates an `Order` to attack, using the specified `units` and a given `Targetable`, which can be a point or a specified unit.
+6. `step` tells SC2 that it is ready to advance to the next game tick. This is only useful in non-realtime modes.
+7. `getStatus` returns the status of the protocol state machine.
+
+
+## Installation
+### Required dependencies
+* Stack
+* protoc (from the protobuf package) must also be in your path
+* If you want to actually run it, then you need StarCraft II installed.
+
+#### Windows
+I think that's it.
+
+#### Linux
+Nix is highly recommended. If not, then make sure you also have zlib headers available.
+
+#### Mac
+No idea. Someone let me know!
+
+### Before compilation
+Due to a bug in proto-lens-protoc 0.4.0.1, enum generation is broken when there are underscores in names. Thus, you must apply the patch in sc2-proto to the s2client-proto submodule.
+
+### Compilation
+`stack build`
+
+### Running the demo app
+First, launch SC2 and create a game manually. Then, do `stack run`.
+
+This should run the demo bot, which launches a game, chooses the 9th map in the available maps, and joins as a Protoss player against a random Medium Computer player.
+
+## Design
+`sc2hs` is split into several packages:
+```mermaid
+graph BT
+    sc2-proto --> sc2-lowlevel
+    sc2-support --> sc2-lowlevel
+    sc2-proto --> sc2hs
+    sc2-support --> sc2hs
+    sc2-lowlevel --> sc2hs
+    sc2-lowlevel --> sc2hs-demo
+    sc2hs --> sc2hs-demo
+```
+
+### sc2-proto
+`sc2-proto` is an autogenerated wrapper library around the SC2 protobuf API description.
+
+### sc2-support
+`sc2-support` contains basic SC2-related definitions, such as the various directories, as well as a Template Haskell module which generates data types and functions converting between the raw integers used to refer to units, abilities, upgrades, buffs and effects, into a more usable form. It does this by parsing `stableid.json`, which is only created after running SC2 using the API at least once. Therefore, it also includes a backup copy, which may be out of date; but it shouldn't change frequently.
+
+Eventually, the goal is for `sc2-support` to augment this data with properties harvested from balance data extracted from the SC2 editor, but how to do that *well* when it changes with each patch is still to be worked out.
+
+### sc2-lowlevel
+`sc2-lowlevel` handles launching the game, managing its process, connecting to it, and communicating at the protobuf API logical layer. It also has some higher level types used by `sc2hs`. The protocol state machine is modeled using an Effect.
+
+### sc2hs
+`sc2hs` is centered on the `Network.SC2.Agent` module. This defines an Effect, `Agent`, which provides an abstraction over the low-level protocol. Currently it uses just the Raw interface, but the goal is to augment it with data from the feature-layer interface and UI.
+
+### sc2hs-demo
+The demo app shows how to create a basic bot and use it in a game.
+
+## Contributing
+Currently the focus is on expanding horizontally along the layers, by translating more of the protobuf protocol into `Requestable`s in `sc2-lowlevel`, and into the `Agent` Effect. That would be a great place to contribute; however contributions anywhere else are more than welcome! :heart_eyes_cat:

+ app/Main.hs view

@@ -0,0 +1,56 @@+{-#LANGUAGE NoMonadFailDesugaring #-}
+{-#LANGUAGE OverloadedLabels, TypeOperators, DataKinds, MonoLocalBinds #-}
+{-#LANGUAGE OverloadedStrings #-}
+{-#LANGUAGE FlexibleContexts #-}
+module Main where
+
+import Network.SC2.LowLevel hiding (getStatus, Step)
+import qualified Proto.S2clientprotocol.Sc2api as A
+import qualified Proto.S2clientprotocol.Common as A
+import qualified Proto.S2clientprotocol.Sc2api_Fields as A
+import qualified Proto.S2clientprotocol.Raw as A
+import qualified Proto.S2clientprotocol.Raw_Fields as A
+
+import Lens.Labels.Unwrapped ()
+import Control.Lens
+import Control.Effects.Logging
+import Network.SC2.Agent 
+
+main :: IO ()
+main = withMain mempty (runLocal  (runLoggingStdOut 999 . runSC2 bot) ) where   
+  
+
+bot :: SC2LowLevel '[Logging] ()
+bot = do
+  Right info <- syncRequest Ping
+  logMessage 1 ("info: " ++ show info)
+
+  Right maps@(map : _) <- syncRequest AvailableMaps
+
+  Right () <- syncRequest $ CreateGameFull (maps !! 8) [Participant Protoss, Computer (Random ()) Medium] Fog RandomSeed Realtime
+  logMessage 1 "create game success"
+
+  Right pid <- syncRequest $ JoinGame Protoss [Raw]
+  logMessage 1 ("join game: " ++ show pid)
+
+  Right info <- syncRequest $ GameInfo
+  runSC2Agent (initialiseWithGameInfo info) $ workerRush  
+  
+
+-- Orders a worker rush on the first frame.
+workerRush :: Member Logging r =>   Eff (Agent ':r ) ()
+workerRush = do
+  updateObservations
+  units <- workers
+  locs <- enemyStartLocations
+  units `attack` (head locs)
+  logMessage 1 "Worker rush ^_^"
+  loop
+  
+loop :: Member Logging r =>  Eff (Agent ': r) ()
+loop = do
+  step
+  status <- getStatus
+  case status of
+    Ended -> logMessage 1 "Ending game"
+    _     -> loop

+ sc2hs.cabal view

@@ -0,0 +1,77 @@+cabal-version: 1.12
++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: f086e331f701cd87b975296192cd455557ca861235fdfff3553a26f960451d35++name:           sc2hs+version:        0.1.0.0+synopsis:       An interface to the Starcraft II bot API+category:       Network, FFI, Game+homepage:       https://github.com/spacekitteh/sc2hs+author:         Sophie Taylor <sophie@spacekitteh.moe>+maintainer:     Sophie Taylor <sophie@spacekitteh.moe>+license:        OtherLicense+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://gitlab.com/spacekitteh/sc2hs++library+  exposed-modules:+      Control.Effects.Logging+      Control.Effects.Modalities.Belief+      Control.Effects.Modalities.Knowledge+      Network.SC2.Agent+  other-modules:+      Paths_sc2hs+  hs-source-dirs:+      src+  build-depends:+      base >=4.12 && <5+    , bytestring >=0.10+    , containers >=0.6+    , directory >=1.3+    , etc+    , filepath >=1.4+    , freer-simple >=1.2+    , gitrev >=1.3+    , lens+    , lens-labels >=0.3+    , proto-lens >=0.4+    , sc2-lowlevel+    , sc2-proto+    , sc2-support+    , text >=1.2+  default-language: Haskell2010++executable sc2hs-demo+  main-is: Main.hs+  other-modules:+      Paths_sc2hs+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , bytestring >=0.10+    , containers >=0.6+    , directory >=1.3+    , etc+    , filepath >=1.4+    , freer-simple >=1.2+    , gitrev >=1.3+    , lens+    , lens-labels >=0.3+    , proto-lens >=0.4+    , sc2-lowlevel+    , sc2-proto+    , sc2-support+    , sc2hs+    , text >=1.2+  default-language: Haskell2010

+ src/Control/Effects/Logging.hs view

@@ -0,0 +1,19 @@+{-#LANGUAGE GADTs, TypeOperators, FlexibleContexts, DataKinds, RankNTypes #-}
+module Control.Effects.Logging where
+
+import Control.Monad.Freer
+-- todo use Text
+data Logging a where
+    Log :: Int -> String -> Logging ()
+
+logMessage :: Member Logging effs => Int -> String -> Eff effs ()
+logMessage loglevel msg = send (Log loglevel msg)
+
+runLoggingStdOut :: Member IO r => Int -> Eff (Logging ': r) ~> Eff r
+runLoggingStdOut maxLevel = interpret act where
+    act :: (Member IO r) => Logging ~> Eff r
+    act (Log lvl msg) = do
+        if lvl <= maxLevel then send (putStrLn msg) else return ()
+
+logError :: Member Logging effs => String -> Eff effs ()
+logError = logMessage 0

+ src/Control/Effects/Modalities/Belief.lhs view

@@ -0,0 +1,4 @@+\begin{code}
+module Control.Effects.Modalities.Belief where
+
+\end{code}

+ src/Control/Effects/Modalities/Knowledge.lhs view

@@ -0,0 +1,6 @@+\begin{code}
+module Control.Effects.Modalities.Knowledge where
+
+
+
+\end{code}

+ src/Network/SC2/Agent.hs view

@@ -0,0 +1,164 @@+{-#LANGUAGE NoMonadFailDesugaring #-} -- FIXME
+{-#LANGUAGE TypeApplications, TemplateHaskell, NamedFieldPuns, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables#-}
+{-#LANGUAGE GADTs, RankNTypes, GeneralisedNewtypeDeriving, PatternSynonyms, DataKinds, ConstraintKinds, FlexibleContexts, TypeOperators,OverloadedLabels, PartialTypeSignatures #-}
+module Network.SC2.Agent where
+
+import Control.Monad.Freer
+import Control.Effects.Logging
+import Data.OpenUnion ((:++:))
+import Control.Monad.Freer.Reader
+import Data.Traversable
+import Control.Lens
+import Data.Functor.Identity
+import Network.SC2.LowLevel.Requests as LLR
+import Control.Monad.Freer.State
+import Data.Word
+import Network.SC2.Constants.Entities
+import qualified Network.SC2.Constants.Abilities as A
+import qualified Network.SC2.Constants.Units as U
+import qualified Proto.S2clientprotocol.Sc2api as S
+import qualified Proto.S2clientprotocol.Raw as S
+import Network.SC2.LowLevel.Types 
+import Control.Monad.Freer.TH
+import Lens.Labels (HasLens')
+import Network.SC2.LowLevel.Protocol  as LLP (SC2Control, syncRequest, Split, unsafeRequest, unsafeResponse, getStatus)
+import Data.ProtoLens (defMessage)
+import qualified Data.Text as T
+import Network.SC2.LowLevel.Convert
+import Data.Maybe
+import Data.Coerce
+
+data AgentUnitKnowledge = UnitKnowledge { -- TODO Use an entity component system, or at least...
+    --TODO Turn this into a map from PlayerID -> UnitContainer or some other associative structure
+    --TODO or just a damn Reader and use local
+    ownUnits :: UnitContainer
+    , enemyUnits :: UnitContainer
+    , alliedUnits :: UnitContainer
+    , neutralUnits :: UnitContainer
+    , allUnits :: UnitContainer
+} deriving (Eq, Show)
+defUnitKnowledge :: AgentUnitKnowledge
+defUnitKnowledge = UnitKnowledge{ownUnits = [], enemyUnits = [], alliedUnits = [], neutralUnits =[], allUnits = []}
+type UnitFilter = Unit -> Bool
+
+instance Eq UnitKnowledgeFilter where
+    (==) a b= True
+instance Show UnitKnowledgeFilter where
+    show a = ""
+data WorldState = WorldState {
+    gameInfo :: GameInfoResponse,
+    knownUnits :: AgentUnitKnowledge
+} deriving (Eq, Show)
+
+
+type UnitKnowledgeFilter = (AgentUnitKnowledge -> UnitContainer)
+data Agent a where
+    UpdateObservations :: Agent ()
+    ViewPlayerResources :: Agent PlayerResources
+    ViewMapInfo :: Agent MapInfo
+    ViewUnits ::  Agent AgentUnitKnowledge
+    OrderUnits :: forall a. Orderable a=> a -> Order -> Agent ()
+    SendChat :: T.Text -> ChatChannel -> Agent ()
+    ViewWorldState :: Agent WorldState
+    Step :: Agent ()
+    StepN :: Word -> Agent ()
+    GetStatus :: Agent S.Status
+
+    
+$(makeEffect ''Agent)
+type SC2Agent r = Member Agent r 
+type SC2AgentEffects = Agent
+type SC2AgentSupportEffects = '[Split, Logging]
+runSC2Agent :: (Members (SC2AgentSupportEffects) r) =>  WorldState -> Eff (Agent ': r) ~> Eff ( SC2Control ': r)
+runSC2Agent initialState = evalState initialState . reinterpret2 act where
+    act :: (Members (SC2AgentSupportEffects) r) => Agent  ~> Eff (State WorldState ': SC2Control ': r)
+    act (Network.SC2.Agent.Step) = do --ugh
+        result <- syncRequest (LLR.Step) --ugh
+        case result of 
+            Right () -> return ()
+            Left e -> logError ("runSC2Agent Step: " ++ show e)
+    act (StepN i) = do
+        result <- syncRequest (StepMany i)
+        case result of
+            Right () -> return ()
+            Left e -> logError ("runSC2Agent StepN: " ++ show e)
+    act GetStatus = LLP.getStatus
+        
+    act UpdateObservations = do
+        Right obs <- syncRequest $ ((defMessage & #observation .~ defMessage) :: S.Request) -- FIXME
+        currState <- get @WorldState
+        put $ processObservations currState (obs ^. #observation . #observation)
+    
+    act ViewUnits= do
+        state <- get
+        return (knownUnits state)
+    act ViewWorldState = get
+    act (OrderUnits units order) = do -- TODO: This is terribly hacky. Make Action a Requestable!
+        let aruc = (defMessage:: S.ActionRawUnitCommand) & #abilityId .~ (A.toInt $ abilityID order) & setTarget (target order)  & #unitTags .~ (toTags units)
+        let ar = (defMessage :: S.ActionRaw) & #unitCommand .~ aruc
+        let a = (defMessage :: S.RequestAction) & #actions .~ [(defMessage :: S.Action) & #actionRaw .~ ar]
+        _ <- syncRequest ((defMessage & #action .~ a)      :: S.Request)
+        return ()
+        where
+            setTarget (TargetPoint p) m = m & #targetWorldSpacePos .~ convertTo p
+            setTarget (TargetUnit u) m = m & #targetUnitTag .~ coerce u
+
+
+
+
+
+enemyStartLocations :: Eff (Agent ': r) [Point]
+enemyStartLocations = do
+    state <- viewWorldState
+    return $ (startLocations . fromJust . startRaw . gameInfo) state
+processObservations ::  WorldState -> S.Observation -> WorldState
+processObservations state obs = state {knownUnits = knownUnits'} where
+    knownUnits' = UnitKnowledge {ownUnits, enemyUnits, alliedUnits, neutralUnits, allUnits}
+    allUnits = fmap (fromJust . convertFrom) (obs ^. #rawData . #units)
+    ownUnits = filter (\u -> alliance u == S.Self) allUnits
+    enemyUnits = filter (\u -> alliance u == S.Enemy) allUnits
+    alliedUnits = filter (\u -> alliance u == S.Ally) allUnits
+    neutralUnits = filter (\u -> alliance u == S.Neutral) allUnits
+
+
+
+--TODO: Turn this into a lens (is it a zoom?) over arbitrary UnitContainer
+
+selectFromAllUnits :: SC2Agent r=>  UnitFilter -> Eff r UnitContainer
+selectFromAllUnits f= do
+    unitsKnown <- viewUnits
+    return (filter f (allUnits unitsKnown))
+    
+
+units :: SC2Agent r=> Eff  r UnitContainer
+units = do
+    all <- viewUnits
+    return (ownUnits all)
+
+
+
+workers :: SC2Agent r =>  Eff r UnitContainer
+workers = do
+    un <- units
+    return (filter isWorker un)
+    
+
+
+isWorker' :: UnitType -> Bool
+isWorker' u = u == U.Probe || u == U.SCV || u == U.Drone
+isWorker :: Unit -> Bool
+isWorker u = isWorker' (unitType u)
+
+viewUnitsOfPlayer :: SC2Agent r => PlayerID -> Eff (r) UnitContainer
+viewUnitsOfPlayer player = selectFromAllUnits (\u -> owner u == player)
+
+
+initialiseWithGameInfo :: GameInfoResponse -> WorldState
+initialiseWithGameInfo gi = WorldState {gameInfo = gi, knownUnits = defUnitKnowledge}
+
+
+attack :: (Member Agent r, Orderable a, Targetable b) => a -> b -> Eff r ()
+attack units target = do
+    send $ OrderUnits units order
+    where
+        order = Order A.Attack (asTarget target) False