diff --git a/.gitignore b/.gitignore index ec05c3122..ee3504e84 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,7 @@ extra/.cache # @TESTS elm-home +# Jim +experimental/ +.vscode/ +compiler.iml diff --git a/elm.cabal b/elm.cabal index 4f5b56605..cb2e1f308 100644 --- a/elm.cabal +++ b/elm.cabal @@ -316,6 +316,9 @@ Executable lamdera Test.WebGL Lamdera.Evergreen.TestMigrationHarness Lamdera.Evergreen.TestMigrationGenerator + Endpoint.Repl + Artifacts + Cors -- Debug helpers -- @@ -408,6 +411,7 @@ Executable lamdera -- Debug unicode-show, network-info, + network-uri, -- Future conduit-extra, diff --git a/extra/Cors.hs b/extra/Cors.hs new file mode 100644 index 000000000..e33b2f1f4 --- /dev/null +++ b/extra/Cors.hs @@ -0,0 +1,48 @@ +{-# OPTIONS_GHC -Wall #-} +module Cors + ( allow + ) + where + + +import qualified Data.HashSet as HashSet +import Network.URI (parseURI) +import Snap.Core (Snap, Method, method) +import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet) + + + +-- ALLOW + + +allow :: Method -> [String] -> Snap () -> Snap () +allow method_ origins snap = + applyCORS (toOptions method_ origins) $ method method_ $ + snap + + + +-- TO OPTIONS + + +toOptions :: (Monad m) => Method -> [String] -> CORSOptions m +toOptions method_ origins = + let + allowedOrigins = toOriginList origins + allowedMethods = HashSet.singleton (HashableMethod method_) + in + CORSOptions + { corsAllowOrigin = return allowedOrigins + , corsAllowCredentials = return True + , corsExposeHeaders = return HashSet.empty + , corsAllowedMethods = return allowedMethods + , corsAllowedHeaders = return + } + + +toOriginList :: [String] -> OriginList +toOriginList origins = + Origins $ mkOriginSet $ + case traverse parseURI origins of + Just uris -> uris + Nothing -> error "invalid entry given to toOriginList list" diff --git a/extra/Endpoint/Package.hs b/extra/Endpoint/Package.hs new file mode 100644 index 000000000..6526d6a44 --- /dev/null +++ b/extra/Endpoint/Package.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} + +module Endpoint.Package (handlePost, reportOnInstalledPackages) where + +{- + 1. + + This endpoint will respond to POST requests to "https://repl.lamdera.com/packageList" + with a JSON body of the form: + [ + { "name": "elm/core", "version": "1.0.5" }, + { "name": "elm/html", "version": "1.0.0" } + ] + It will write an elm.json file to the repl directory, and then reload the repl. + This response is mediate by function `handlePost` below. + + 2. + + In additon, this endpoint will respond to GET requests to "https://repl.lamdera.com/reportOnInstalledPackages" + with a JSON body of the form: + [ + { "name": "elm/core", "version": "1.0.5" }, + { "name": "elm/html", "version": "1.0.0" } + ] + The json body reports on the packages that are currently installed in the repl. + This response is mediated by function `reportOnInstalledPackages` below. + + NOTE. handlePost and reportOnInstalledPackages + are referenced in the Snap webserver at Develop.runWithRoot + via the code fragments + + SnapCore.path "packageList" $ Package.handlePost artifactRef) + SnapCore.path "reportOnInstalledPackages" $ Package.reportOnInstalledPackages) +-} + + +import GHC.Generics (Generic) +import Snap.Core +import Snap.Http.Server +import Data.Aeson (FromJSON, eitherDecode, encode, ToJSON, toJSON, object, (.=)) +import Data.ByteString (ByteString) +import Data.ByteString.Lazy (toStrict) +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.ByteString.Char8 as ByteString +import GHC.Generics +import System.IO (writeFile) +import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as Map +--- +import Snap.Util.FileServe +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Strict as HM +import Data.Text.Encoding (decodeUtf8) +import Snap.Http.Server.Config (setPort, defaultConfig) +import qualified ReplArtifacts +import Data.IORef + + +data Package = Package { name :: String, version :: String } deriving (Show, Generic) + +instance FromJSON Package +instance ToJSON Package + + +type PackageList = [Package] + +writeElmJson :: PackageList -> IO () +writeElmJson pkgs = do + let directDeps = Map.fromList $ ("elm/core", "1.0.5"):[(name p, version p) | p <- pkgs] + elmJson = object [ + "type" .= ("application" :: String), + "source-directories" .= (["../../repl-src"] :: [String]), + "elm-version" .= ("0.19.1" :: String), + "dependencies" .= object [ + "direct" .= directDeps, + "indirect" .= object [ + "elm/json" .= ("1.1.3" :: String) + ] + ], + "test-dependencies" .= object [ + "direct" .= (Map.empty :: Map.Map String String), + "indirect" .= (Map.empty :: Map.Map String String) + ] + ] + writeFile "./outlines/repl/elm.json" ( BL.unpack $ encode elmJson) + + +handlePost :: IORef ReplArtifacts.Artifacts -> Snap () +handlePost artifactRef = do + body <- readRequestBody 10000 + let maybePackageList = eitherDecode body :: Either String PackageList + case maybePackageList of + Left err -> writeBS $ "Error: Could not decode JSON: " <> (ByteString.pack err) + Right packages -> do + liftIO $ writeElmJson packages + let message = ByteString.pack $ "Packages added: " ++ (show $ length packages) + writeBS message + newArtifacts <- liftIO ReplArtifacts.loadRepl + liftIO $ writeIORef artifactRef newArtifacts + + + +data Dependencies = Dependencies { + direct :: HM.HashMap String String + } deriving (Generic, Show) + +data TopLevel = TopLevel { + dependencies :: Dependencies + } deriving (Generic, Show) + +instance FromJSON TopLevel + +instance FromJSON Dependencies + +--- curl -X POST -H "Content-Length: 0" http://localhost:8000/reportOnInstalledPackages + +reportOnInstalledPackages :: Snap () +reportOnInstalledPackages = do + jsonData <- liftIO $ LBS.readFile "./outlines/repl/elm.json" + case eitherDecode jsonData :: Either String TopLevel of + Left err -> writeBS $ "Failed to parse JSON: " <> (LBS.toStrict jsonData) + Right topLevel -> do + let directDeps = HM.toList $ direct $ dependencies topLevel + let outputList = map (\(name, version) -> object ["name" .= name, "version" .= version]) directDeps + writeBS . LBS.toStrict . encode $ outputList diff --git a/extra/Endpoint/Repl.hs b/extra/Endpoint/Repl.hs new file mode 100644 index 000000000..d721dfe42 --- /dev/null +++ b/extra/Endpoint/Repl.hs @@ -0,0 +1,304 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE OverloadedStrings #-} +module Endpoint.Repl + ( endpoint + ) + where + +{- + The purpose of this endpoint is to provide a REPL for Elm that + is accessible via Http requests. The function `endpoint` of + this module is referenced in the Snap webserver at Develop.runWithRoot + via the code fragment + + SnapCore.path "repl" $ Repl.endpoint artifactRef + + + Function decodeBodyHelp decodes incoming Json requests to the repl. + The Json data has the form + + { "imports": , + "types": , + "decls": , + "entry": + } + + where the dictionaries are of the form + + { "name": , "source": } + + and "entry" the string representation of the Elm + code to be evaluated. + + Here is a typical incoming json object from a request to + evaluate `run (first int (symbol ".")) "42."`: + + entry: "run (first int (symbol \".\")) \"42.\"" + imports: Dict.fromList [("Parser","import Parser exposing(..)\n")] + decls: Dict.fromList [("first p q","first p q = p |> andThen (\s -> q |> map (\_ -> s))\n"))] + types: Dict.fromList [] + + NOTES. + + 1. Repl.endpoint defined here is called by the Snap server Develop.runWithRoot + via the code fragment + + SnapCore.path "repl" $ Repl.endpoint artifactRef + + 2. The value of of artifactRef is set by + + initialArtifacts <- ReplArtifacts.loadRepl + + in `Develop.runWithRoot`. + + 3. If `endpoint artifactRef` successfully decodes the request, it + passes the resulting information to + + toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome + + which in turn passes the information to `compile`. The result + of compilation is handed to `serveOutcome` which (at long last) + replies to the client's request. + +-} + +import Data.Aeson ((.:)) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map as Map +import Data.Map ((!)) +import qualified Data.Map.Utils as Map +import qualified Data.Name as N +import qualified Data.NonEmptyList as NE +import Snap.Core +import qualified ReplArtifacts as A +import qualified Cors +import qualified AST.Source as Src +import qualified AST.Canonical as Can +import qualified AST.Optimized as Opt +import qualified Compile +import qualified Elm.Interface as I +import qualified Elm.ModuleName as ModuleName +import qualified Elm.Package as Pkg +import qualified File +import qualified Generate.JavaScript as JS +import qualified Json.Encode as Encode +import qualified Parse.Module as Parse +import qualified Repl +import qualified Reporting.Annotation as A +import qualified Reporting.Error as Error +import qualified Reporting.Error.Import as Import +import qualified Reporting.Exit as Exit +import qualified Reporting.Exit.Help as Help +import qualified Reporting.Render.Type.Localizer as L +import Lamdera as LA +import qualified Data.Text + +import Data.IORef + + +-- ALLOWED ORIGINS + + +allowedOrigins :: [String] +allowedOrigins = + [ "http://localhost:8007" + ] + + + +-- ENDPOINT + + +endpoint :: IORef A.Artifacts -> Snap () +endpoint artifactRef = + Cors.allow POST allowedOrigins $ + do currentArtifacts <- liftIO $ readIORef artifactRef + body <- readRequestBody (64 * 1024) + case decodeBody body of + Just (state, entry) -> + serveOutcome (toOutcome currentArtifacts state entry) + + Nothing -> + do modifyResponse $ setResponseStatus 400 "Bad Request" + modifyResponse $ setContentType "text/html; charset=utf-8" + writeBS "Received unexpected JSON body." + + + +-- TO OUTCOME + + +data Outcome + = NewImport N.Name + | NewType N.Name + | NewWork B.Builder + -- + | Skip + | Indent + | DefStart N.Name + -- + | NoPorts + | InvalidCommand + | Failure BS.ByteString Error.Error + + +toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome +toOutcome artifacts state entry = + case reverse (lines entry) of + [] -> + Skip + + prev : rev -> + case Repl.categorize (Repl.Lines prev rev) of + Repl.Done input -> + case input of + Repl.Import name src -> compile artifacts state (ImportEntry name src) + Repl.Type name src -> compile artifacts state (TypeEntry name src) + Repl.Decl name src -> compile artifacts state (DeclEntry name src) + Repl.Expr src -> compile artifacts state (ExprEntry src) + Repl.Port -> NoPorts + Repl.Skip -> Skip + Repl.Reset -> InvalidCommand + Repl.Exit -> InvalidCommand + Repl.Help _ -> InvalidCommand + + Repl.Continue prefill -> + case prefill of + Repl.Indent -> Indent + Repl.DefStart name -> DefStart name + + + +-- SERVE OUTCOME + + +serveOutcome :: Outcome -> Snap () +serveOutcome outcome = + let + serveString = serveBuilder "text/plain" + in + case outcome of + NewImport name -> serveString $ "add-import:" <> N.toBuilder name + NewType name -> serveString $ "add-type:" <> N.toBuilder name + NewWork js -> serveBuilder "application/javascript" js + Skip -> serveString $ "skip" + Indent -> serveString $ "indent" + DefStart name -> serveString $ "def-start:" <> N.toBuilder name + NoPorts -> serveString $ "no-ports" + InvalidCommand -> serveString $ "invalid-command" + Failure source err -> + serveBuilder "application/json" $ Encode.encodeUgly $ Exit.toJson $ + Help.compilerReport "/" (Error.Module N.replModule "/repl" File.zeroTime source err) [] + + +serveBuilder :: BS.ByteString -> B.Builder -> Snap () +serveBuilder mime builder = + do modifyResponse (setContentType mime) + writeBuilder builder + + + +-- COMPILE + + +data EntryType + = ImportEntry N.Name BS.ByteString + | TypeEntry N.Name BS.ByteString + | DeclEntry N.Name BS.ByteString + | ExprEntry BS.ByteString + + +compile :: A.Artifacts -> Repl.State -> EntryType -> Outcome +compile (A.Artifacts interfaces objects) state@(Repl.State imports types decls) entryType = + let + source = + case entryType of + ImportEntry name src -> Repl.toByteString (state { Repl._imports = Map.insert name (B.byteString src) imports }) Repl.OutputNothing + TypeEntry name src -> Repl.toByteString (state { Repl._types = Map.insert name (B.byteString src) types }) Repl.OutputNothing + DeclEntry name src -> Repl.toByteString (state { Repl._decls = Map.insert name (B.byteString src) decls }) (Repl.OutputDecl name) + ExprEntry src -> Repl.toByteString state (Repl.OutputExpr src) + in + case + do modul <- mapLeft Error.BadSyntax $ Parse.fromByteString Parse.Application (LA.debugPassText "@SOURCE" ( Data.Text.pack $ show source) $ source) + ifaces <- mapLeft Error.BadImports $ checkImports interfaces (Src._imports modul) + artifacts <- Compile.compile Pkg.dummyName ifaces modul + return ( modul, artifacts, objects ) + of + Left err -> + Failure source err + + Right info -> + case entryType of + ImportEntry name _ -> NewImport name + TypeEntry name _ -> NewType name + DeclEntry name _ -> NewWork (toJavaScript info (Just name)) + ExprEntry _ -> NewWork (toJavaScript info Nothing) + + +toJavaScript :: (Src.Module, Compile.Artifacts, Opt.GlobalGraph) -> Maybe N.Name -> B.Builder +toJavaScript (modul, Compile.Artifacts canModule types locals, objects) maybeName = + let + localizer = L.fromModule modul + graph = Opt.addLocalGraph locals objects + home = Can._name canModule + tipe = types ! maybe N.replValueToPrint id maybeName + in + JS.generateForReplEndpoint localizer graph home maybeName tipe + + +mapLeft :: (x -> y) -> Either x a -> Either y a +mapLeft func result = + either (Left . func) Right result + + +checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface) +checkImports interfaces imports = + let + importDict = Map.fromValues Src.getImportName imports + missing = Map.difference importDict interfaces + in + case Map.elems missing of + [] -> + Right (Map.intersection interfaces importDict) + + i:is -> + let + unimported = + Map.keysSet (Map.difference interfaces importDict) + + toError (Src.Import (A.At region name) _ _) = + Import.Error region name unimported Import.NotFound + in + Left (fmap toError (NE.List i is)) + + + +-- DECODE BODY + + +decodeBody :: LBS.ByteString -> Maybe ( Repl.State, String ) +decodeBody body = + case Aeson.eitherDecode body of + Right obj -> + Aeson.parseMaybe decodeBodyHelp obj + Left err -> + error $ show err + + +decodeBodyHelp :: Aeson.Object -> Aeson.Parser ( Repl.State, String ) +decodeBodyHelp obj = + let + get key = + do dict <- obj .: key + let f (k,v) = (N.fromChars k, B.stringUtf8 v) + return $ Map.fromList $ map f $ Map.toList dict + in + do imports <- get "imports" + types <- get "types" + decls <- get "decls" + entry <- obj .: "entry" + return ( Repl.State imports types decls, entry ) diff --git a/extra/ReplArtifacts.hs b/extra/ReplArtifacts.hs new file mode 100644 index 000000000..2852853a5 --- /dev/null +++ b/extra/ReplArtifacts.hs @@ -0,0 +1,161 @@ +{-# OPTIONS_GHC -Wall #-} +module ReplArtifacts + ( Artifacts(..) + , loadCompile + , loadRepl + , toDepsInfo + ) + where + +{- + + load artifacts for /extra/Endpoint/Repl. See note (2) in that file. + +-} + + +import Control.Concurrent (readMVar) +import Control.Monad (liftM2) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Map as Map +import qualified Data.Name as N +import qualified Data.OneOrMore as OneOrMore +import qualified System.Directory as Dir +import System.FilePath (()) + +import qualified AST.Canonical as Can +import qualified AST.Optimized as Opt +import qualified BackgroundWriter as BW +import qualified Elm.Details as Details +import qualified Elm.Interface as I +import qualified Elm.ModuleName as ModuleName +import qualified Elm.Package as Pkg +import Json.Encode ((==>)) +import qualified Json.Encode as E +import qualified Json.String as Json +import qualified Reporting + + + +-- ARTIFACTS + + +data Artifacts = + Artifacts + { _ifaces :: Map.Map ModuleName.Raw I.Interface + , _graph :: Opt.GlobalGraph + } + + +loadCompile :: IO Artifacts +loadCompile = + load ("outlines" "compile") + + +loadRepl :: IO Artifacts +loadRepl = + load ("outlines" "repl") + + + +-- LOAD + + +load :: FilePath -> IO Artifacts +load dir = + BW.withScope $ \scope -> + do putStrLn $ "Loading " ++ dir "elm.json" + style <- Reporting.terminal + root <- fmap ( dir) Dir.getCurrentDirectory + result <- Details.load style scope root + case result of + Left _ -> + error $ "Ran into some problem loading elm.json\nTry running `lamdera make` in: " ++ dir + + Right details -> + do omvar <- Details.loadObjects root details + imvar <- Details.loadInterfaces root details + mdeps <- readMVar imvar + mobjs <- readMVar omvar + case liftM2 (,) mdeps mobjs of + Nothing -> + error $ "Ran into some weird problem loading elm.json\nTry running `lamdera make` in: " ++ dir + + Just (deps, objs) -> + return $ Artifacts (toInterfaces deps) objs + + +toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface +toInterfaces deps = + Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $ + Map.elems (Map.mapMaybeWithKey getPublic deps) + + +getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface) +getPublic (ModuleName.Canonical _ name) dep = + case dep of + I.Public iface -> Just (name, OneOrMore.one iface) + I.Private _ _ _ -> Nothing + + +toUnique :: OneOrMore.OneOrMore a -> Maybe a +toUnique oneOrMore = + case oneOrMore of + OneOrMore.One value -> Just value + OneOrMore.More _ _ -> Nothing + + + +-- TO DEPS INFO + + +toDepsInfo :: Artifacts -> BS.ByteString +toDepsInfo (Artifacts ifaces _) = + LBS.toStrict $ B.toLazyByteString $ E.encodeUgly $ encode ifaces + + + +-- ENCODE + + +encode :: Map.Map ModuleName.Raw I.Interface -> E.Value +encode ifaces = + E.dict Json.fromName encodeInterface ifaces + + +encodeInterface :: I.Interface -> E.Value +encodeInterface (I.Interface pkg values unions aliases binops) = + E.object + [ "pkg" ==> E.chars (Pkg.toChars pkg) + , "ops" ==> E.list E.name (Map.keys binops) + , "values" ==> E.list E.name (Map.keys values) + , "aliases" ==> E.list E.name (Map.keys (Map.filter isPublicAlias aliases)) + , "types" ==> E.dict Json.fromName (E.list E.name) (Map.mapMaybe toPublicUnion unions) + ] + + +isPublicAlias :: I.Alias -> Bool +isPublicAlias alias = + case alias of + I.PublicAlias _ -> True + I.PrivateAlias _ -> False + + +toPublicUnion :: I.Union -> Maybe [N.Name] +toPublicUnion union = + case union of + I.OpenUnion (Can.Union _ variants _ _) -> + Just (map getVariantName variants) + + I.ClosedUnion _ -> + Just [] + + I.PrivateUnion _ -> + Nothing + + +getVariantName :: Can.Ctor -> N.Name +getVariantName (Can.Ctor name _ _ _) = + name diff --git a/outlines/repl/elm.json b/outlines/repl/elm.json new file mode 100644 index 000000000..1b34e293e --- /dev/null +++ b/outlines/repl/elm.json @@ -0,0 +1 @@ +{"dependencies":{"direct":{"elm/core":"1.0.5","zwilias/elm-rosetree":"1.5.0"},"indirect":{"elm/json":"1.1.3"}},"elm-version":"0.19.1","source-directories":["../../repl-src"],"test-dependencies":{"direct":{},"indirect":{}},"type":"application"} \ No newline at end of file diff --git a/repl-src/.keep b/repl-src/.keep new file mode 100644 index 000000000..e69de29bb diff --git a/terminal/src/Develop.hs b/terminal/src/Develop.hs index d4f2217ba..f7bc53555 100644 --- a/terminal/src/Develop.hs +++ b/terminal/src/Develop.hs @@ -22,6 +22,7 @@ import qualified Data.NonEmptyList as NE import qualified System.Directory as Dir import System.FilePath as FP import Snap.Core hiding (path) +import qualified Snap.Core as SnapCore import Snap.Http.Server import Snap.Util.FileServe @@ -54,6 +55,12 @@ import Control.Concurrent.STM (atomically, newTVarIO, readTVar, writeTVar, TVar) import StandaloneInstances +import qualified ReplArtifacts +import qualified Endpoint.Repl as Repl +import qualified Endpoint.Package as Package + +import Data.IORef + -- RUN THE DEV SERVER @@ -69,6 +76,7 @@ run () flags = do Dir.setCurrentDirectory root runWithRoot root flags +-- currentArtifacts <- liftIO $ readIORef artifactRef runWithRoot :: FilePath -> Flags -> IO () runWithRoot root (Flags maybePort) = @@ -87,6 +95,10 @@ runWithRoot root (Flags maybePort) = sentryCache <- liftIO $ Sentry.init + initialArtifacts <- ReplArtifacts.loadRepl + artifactRef <- newIORef initialArtifacts + + let recompile :: [String] -> IO () recompile events = do @@ -121,6 +133,9 @@ runWithRoot root (Flags maybePort) = Lamdera.ReverseProxy.start + initialArtifacts <- ReplArtifacts.loadRepl + artifactRef <- newIORef initialArtifacts + Live.withEnd liveState $ httpServe (config port) $ gcatchlog "general" $ -- Add /public/* as if it were /* to mirror production, but still render .elm files as an Elm app first @@ -135,6 +150,9 @@ runWithRoot root (Flags maybePort) = <|> route [ ("_r/:endpoint", Live.serveRpc liveState port) ] <|> Live.openEditorHandler root <|> Live.serveExperimental root + <|> (SnapCore.path "repl" $ Repl.endpoint artifactRef) + <|> (SnapCore.path "packageList" $ Package.handlePost artifactRef) + <|> (SnapCore.path "reportOnInstalledPackages" $ Package.reportOnInstalledPackages) <|> serveAssets -- Compiler packaged static files <|> Live.serveUnmatchedUrlsToIndex root (serveElm sentryCache) -- Everything else without extensions goes to Lamdera LocalDev harness <|> error404 -- Will get hit for any non-matching extensioned paths i.e. /hello.blah diff --git a/worker/elm.cabal b/worker/elm.cabal index be9294894..795cb9d7a 100644 --- a/worker/elm.cabal +++ b/worker/elm.cabal @@ -49,7 +49,7 @@ Executable worker Main.hs other-modules: - Artifacts + ReplArtifacts Cors Endpoint.Compile Endpoint.Donate diff --git a/worker/src/Endpoint/Compile.hs b/worker/src/Endpoint/Compile.hs index f3d0d2468..26f3991e9 100644 --- a/worker/src/Endpoint/Compile.hs +++ b/worker/src/Endpoint/Compile.hs @@ -59,6 +59,7 @@ allowedOrigins :: [String] allowedOrigins = [ "https://elm-lang.org" , "https://package.elm-lang.org" + ,"http://localhost:8007" ]