master..110e143 · rowtype-yoga/psfp

git.iko.soy/rowtype-yoga/psfp

on 110e143 help sign in

playground/packages.dhall+2−2

since splitsnapshots

unifiedsplit

@@ -117,7 +117,7 @@ let additions =

117-------------------------------

118-}

119let upstream =

120− https://github.com/purescript/package-sets/releases/download/psc-0.15.8-20230617/packages.dhall

120+ https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220901/packages.dhall

121− sha256:292a92e32db0272db2089f3234140287c9eaf2fc15b6790a3c51f41471050eeb

121+ sha256:f1531b29c21ac437ffe5666c1b6cc76f0a9c29d3c9d107ff047aa2567744994f

122

123in upstream

server/.idea/.gitignoredeleted−8

@@ -1,8 +0,0 @@

1−# Default ignored files

2−/shelf/

3−/workspace.xml

4−# Editor-based HTTP Client requests

5−/httpRequests/

6−# Datasource local storage ignored files

7−/dataSources/

8−/dataSources.local.xml

server/.idea/misc.xmldeleted−6

@@ -1,6 +0,0 @@

1−<?xml version="1.0" encoding="UTF-8"?>

2−<project version="4">

3− <component name="ProjectRootManager">

4− <output url="file://$PROJECT_DIR$/out" />

5− </component>

6−</project>

server/.idea/modules.xmldeleted−8

@@ -1,8 +0,0 @@

1−<?xml version="1.0" encoding="UTF-8"?>

2−<project version="4">

3− <component name="ProjectModuleManager">

4− <modules>

5− <module fileurl="file://$PROJECT_DIR$/.idea/server.iml" filepath="$PROJECT_DIR$/.idea/server.iml" />

6− </modules>

7− </component>

8−</project>

server/.idea/server.imldeleted−9

@@ -1,9 +0,0 @@

1−<?xml version="1.0" encoding="UTF-8"?>

2−<module type="JAVA_MODULE" version="4">

3− <component name="NewModuleRootManager" inherit-compiler-output="true">

4− <exclude-output />

5− <content url="file://$MODULE_DIR$" />

6− <orderEntry type="inheritedJdk" />

7− <orderEntry type="sourceFolder" forTests="false" />

8− </component>

9−</module>

server/.idea/vcs.xmldeleted−6

@@ -1,6 +0,0 @@

1−<?xml version="1.0" encoding="UTF-8"?>

2−<project version="4">

3− <component name="VcsDirectoryMappings">

4− <mapping directory="$PROJECT_DIR$/.." vcs="Git" />

5− </component>

6−</project>

server/spago.dhall−3

@@ -13,7 +13,6 @@ You can edit this file as you like.

13 , "avar"

14 , "bifunctors"

15 , "console"

16− , "control"

17 , "datetime"

16 , "datetime"

18 , "debug"

17 , "debug"

19 , "effect"

18 , "effect"

@@ -22,7 +21,6 @@ You can edit this file as you like.

22 , "express"

21 , "express"

23 , "foldable-traversable"

22 , "foldable-traversable"

24 , "foreign"

23 , "foreign"

25− , "foreign-object"

26 , "functions"

24 , "functions"

27 , "httpurple"

25 , "httpurple"

28 , "httpurple-yoga-json"

26 , "httpurple-yoga-json"

@@ -37,7 +35,6 @@ You can edit this file as you like.

37 , "node-http"

35 , "node-http"

38 , "node-net"

36 , "node-net"

39 , "node-process"

37 , "node-process"

40− , "ordered-collections"

41 , "parallel"

38 , "parallel"

42 , "posix-types"

39 , "posix-types"

43 , "prelude"

40 , "prelude"

server/src/Main.purs+45−68

@@ -15,12 +15,12 @@ import Data.Argonaut.Decode (class DecodeJson, decodeJson, printJsonDecodeError)

15import Data.Argonaut.Decode.Class (class DecodeJson)

16import Data.Argonaut.Decode.Decoders (decodeString)

17import Data.Argonaut.Encode (encodeJson)

18−import Data.Array (any, elem, (..))

18+import Data.Array (elem, (..))

19import Data.Bifunctor (lmap)

20−import Data.Either (Either(..), note)

20+import Data.Either (Either(..))

21import Data.Either (hush)

22import Data.Int (fromString)

23−import Data.Maybe (Maybe(..), fromMaybe, maybe)

23+import Data.Maybe (Maybe(..), fromMaybe)

24import Data.Newtype (un)

25import Data.Time.Duration (class Duration, Seconds(..), fromDuration)

26import Data.Traversable (traverse)

@@ -58,18 +58,6 @@ import Shared.Json (readAff, readJsonAff)

58import Shared.Models.Body (CompileRequest, RunResult, CompileResult)

59import Shared.Models.Body as Body

60import Unsafe.Coerce (unsafeCoerce)

61−import Foreign.Object (lookup) as Object

62−import Control.Alt ((<|>))

63−import Data.Array (elem) as Array

64−import HTTPurple.Response (notFound, unauthorized, unprocessableEntity')

65−import Control.Monad.Error.Class (throwError)

66−import Data.Monoid (guard)

67−import HTTPurple.Headers (RequestHeaders)

68−import Data.Map (lookup) as Mapl

69−import Data.String.CaseInsensitive (CaseInsensitiveString(CaseInsensitiveString))

70−import Data.Map (lookup) as Map

71−import HTTPurple.Validation (fromValidated, fromValidatedE)

72−import HTTPurple.Status (forbidden, unauthorized, unprocessableEntity) as Status

74toBody ∷ ∀ r m. MonadEffect m => { stdout ∷ Buffer, stderr ∷ Buffer | r } -> m RunResult

62toBody ∷ ∀ r m. MonadEffect m => { stdout ∷ Buffer, stderr ∷ Buffer | r } -> m RunResult

75toBody result =

63toBody result =

@@ -93,6 +81,7 @@ runCode timeout folder =

93 , Nothing <$ delay (timeout # fromDuration)

81 , Nothing <$ delay (timeout # fromDuration)

94 ]

82 ]

84+

96srcFolder ∷ String

85srcFolder ∷ String

97srcFolder = "../playground"

86srcFolder = "../playground"

@@ -124,7 +113,7 @@ main = do

124 , timeout: 10.0 # Seconds # fromDuration

113 , timeout: 10.0 # Seconds # fromDuration

125 }

114 }

126 pool

115 pool

127− void $ liftEffect (serverSetup tokens q)

116+ void $ liftEffect (serverSetup q)

128

117

129-- makeApp ∷ Array Token -> Queue PscIdeConnection -> App

118-- makeApp ∷ Array Token -> Queue PscIdeConnection -> App

130-- makeApp tokens q = do

119-- makeApp tokens q = do

@@ -145,7 +134,6 @@ main = do

145-- pure { key, cert }

134-- pure { key, cert }

146

135

147data Route = CompileAndRun

136data Route = CompileAndRun

148−

149derive instance Generic Route _

137derive instance Generic Route _

150

138

151route :: RouteDuplex' Route

139route :: RouteDuplex' Route

@@ -153,31 +141,21 @@ route = mkRoute

153 { "CompileAndRun": "compileAndRun" / noArgs

141 { "CompileAndRun": "compileAndRun" / noArgs

154 }

142 }

155

143

156−serverSetup :: Array Token -> Queue _ -> Effect Unit

144+serverSetup :: Queue _ -> Effect Unit

157−serverSetup tokens queue = do

145+serverSetup queue = do

158 maybePortString <- lookupEnv "PORT" # liftEffect

146 maybePortString <- lookupEnv "PORT" # liftEffect

159 let port = maybePortString >>= fromString # fromMaybe 14188

147 let port = maybePortString >>= fromString # fromMaybe 14188

160− --liftEffect $ (listenHttp app port) \_ ->

148+ --liftEffect $ (listenHttp app port) \_ ->

161 info $ "psfp server started on port " <> show port

149 info $ "psfp server started on port " <> show port

162

150

163 void $ serve { port } { route, router }

151 void $ serve { port } { route, router }

164 where

152 where

165− getToken' headers = do

166− lookup headers "Token" # maybe

167− (Left $ "Missing Token Header")

168− (Right <<< Token)

169−

170− validateToken' :: Token -> Either String Unit

171− validateToken' token = do

172− if Array.elem token tokens then Right unit else Left "Invalid Token"

173−

174− router { route: CompileAndRun, headers, method: Post, body } = usingCont do

153+ router { route: CompileAndRun, method: Post, body } = usingCont do

175− token <- fromValidatedE getToken' (response' Status.forbidden empty) headers

176− fromValidatedE validateToken' (response' Status.unauthorized empty) token

177 { code } :: { code :: String } <- fromJson YogaJson.jsonDecoder body -- parse the json input

154 { code } :: { code :: String } <- fromJson YogaJson.jsonDecoder body -- parse the json input

178 -- jobId <- compileAndRunJob code

155 -- jobId <- compileAndRunJob code

179 compileAndRunJobCont queue { code } -- do your business logic

156 compileAndRunJobCont queue { code } -- do your business logic

157+ -- whatever queue body

180− --notFound

158+ --notFound

181 router _ = notFound

159 router _ = notFound

182 makeHttpsOptions = do

160 makeHttpsOptions = do

183 key <- readTextFile UTF8 "server.key"

161 key <- readTextFile UTF8 "server.key"

@@ -186,41 +164,40 @@ serverSetup tokens queue = do

186

164

187compileAndRunJobCont :: Queue _ -> CompileRequest -> ContT Response Aff Response

165compileAndRunJobCont :: Queue _ -> CompileRequest -> ContT Response Aff Response

188compileAndRunJobCont queue { code } = do

166compileAndRunJobCont queue { code } = do

189− resultVar <- lift AVar.empty

167+ resultVar <- lift AVar.empty

190− let

168+ let

191− job :: NewJob _

169+ job :: NewJob _

192− job = NewJob \jobId conn -> do

170+ job = NewJob \jobId conn -> do

193− stringOrErr ∷ Either Error String <- attempt $ compileCode code conn

171+ stringOrErr ∷ Either Error String <- attempt $ compileCode code conn

194− jsonOrErr ∷ Either Error (Either Error CompileResult) <- attempt $ readJsonAff `traverse` stringOrErr

172+ jsonOrErr ∷ Either Error (Either Error CompileResult) <- attempt $ readJsonAff `traverse` stringOrErr

195− let folder = getFolder conn

173+ let folder = getFolder conn

196− AVar.put { jsonOrErr, stringOrErr, folder } resultVar

174+ AVar.put { jsonOrErr, stringOrErr, folder } resultVar

197− enqueueResult <- lift $ liftEffect $ Q.enqueue job queue

175+ enqueueResult <- lift $ liftEffect $ Q.enqueue job queue

198− case enqueueResult of

176+ case enqueueResult of

199− QueueFull -> notFound

177+ QueueFull -> notFound

200− _ -> do

178+ _ -> do

201− { jsonOrErr, stringOrErr, folder } <- AVar.take resultVar # lift

179+ { jsonOrErr, stringOrErr, folder } <- AVar.take resultVar # lift

202− case jsonOrErr ∷ Either Error (Either Error CompileResult) of

180+ case jsonOrErr ∷ Either Error (Either Error CompileResult) of

203− Left e -> do

181+ Left e -> do

204− lift $ log $ "Aff failed with " <> message e

182+ lift $ log $ "Aff failed with " <> message e

205− internalServerError' jsonHeaders $ toJson YogaJson.jsonEncoder { error: show e }

183+ internalServerError' jsonHeaders $ toJson YogaJson.jsonEncoder { error: show e }

206− Right (Right res)

184+ Right (Right res)

207− | res.resultType == "error" -> do

185+ | res.resultType == "error" -> do

208− let body = toJson YogaJson.jsonEncoder { result: res.result }

209− response' Status.unprocessableEntity empty body

186+ unprocessableEntity

210− Right (Right res) -> do

187+ Right (Right res) -> do

211− runResult <- runCode timeout folder # lift

188+ runResult <- runCode timeout folder # lift

212− case runResult of

189+ case runResult of

213− Nothing -> do

190+ Nothing -> do

214− requestTimeout' jsonHeaders -- $ toJson YogaJson.jsonEncoder { error: "Timed out after running for " <> show timeout }

191+ requestTimeout' jsonHeaders -- $ toJson YogaJson.jsonEncoder { error: "Timed out after running for " <> show timeout }

215− Just rr -> do

192+ Just rr -> do

216− resultBody <- toBody rr # lift

193+ resultBody <- toBody rr # lift

217− ok' jsonHeaders $ toJson YogaJson.jsonEncoder { resultBody }

194+ ok' jsonHeaders $ toJson YogaJson.jsonEncoder{ resultBody }

218− Right (Left errs) -> do

195+ Right (Left errs) -> do

219− log $ "Could not decode: " <> show (lmap (const "no way") stringOrErr) <> "\nErrors: " <> show errs

196+ log $ "Could not decode: " <> show (lmap (const "no way") stringOrErr) <> "\nErrors: " <> show errs

220− internalServerError' jsonHeaders $ toJson YogaJson.jsonEncoder { error: show errs }

197+ internalServerError' jsonHeaders $ toJson YogaJson.jsonEncoder { error: show errs }

221− -- case r of

198+ -- case r of

222− -- Left err -> internalServerError' jsonHeaders $ toJson YogaJson.jsonEncoder { error: show err }

199+ -- Left err -> internalServerError' jsonHeaders $ toJson YogaJson.jsonEncoder { error: show err }

223− -- Right result -> ok' jsonHeaders $ toJson YogaJson.jsonEncoder result

200+ -- Right result -> ok' jsonHeaders $ toJson YogaJson.jsonEncoder result

224

201

225 where

202 where

226 jsonBody = toJson

203 jsonBody = toJson