master..70a4737 · project-m36

git.iko.soy/project-m36

on 70a4737 help sign in

.github/workflows/ci.yaml+7−9

since splitsnapshots

unifiedsplit

@@ -18,7 +18,6 @@ jobs:

18 - name: docker load

19 run: docker load < $(nix-build docker.nix)

20 - name: docker login

21− if: ${{ github.ref == 'refs/heads/master' }}

22 run: echo ${{secrets.DOCKERHUB_PASSWORD}} | docker login --username ${{secrets.DOCKERHUB_USER}} --password-stdin

21 run: echo ${{secrets.DOCKERHUB_PASSWORD}} | docker login --username ${{secrets.DOCKERHUB_USER}} --password-stdin

23 - name: docker tag with version

22 - name: docker tag with version

24 run: docker tag project-m36:latest projectm36/project-m36:$(awk '/^Version:/ {print $2}' project-m36.cabal)

23 run: docker tag project-m36:latest projectm36/project-m36:$(awk '/^Version:/ {print $2}' project-m36.cabal)

@@ -41,24 +40,23 @@ jobs:

41 include:

40 include:

42 - os: macos-latest

41 - os: macos-latest

43 ghc: ghc8.10

42 ghc: ghc8.10

44− env:

45− STACK_YAML: stack.${{ matrix.ghc }}.yaml

46 steps:

43 steps:

44+ - name: Setup

45+ run: |

46+ echo "::set-env name=stack-yaml::stack.${{ matrix.ghc }}.yaml"

47 - uses: actions/checkout@v2

48 - name: Cache

49 uses: actions/cache@v1

50 with:

51 path: ~/.stack

52− key: ${{ runner.os }}-build-stack-${{ matrix.ghc }}-${{ hashFiles(env.STACK_YAML) }}-${{ hashFiles('**/*.cabal') }}

52+ key: ${{ runner.os }}-build-stack-${{ env.stack-yaml }}-${{ hashFiles(env.stack-yaml) }}-${{ hashFiles('**/*.cabal') }}

53 restore-keys: |

54− ${{ runner.os }}-build-stack-${{ matrix.ghc }}-${{ hashFiles(env.STACK_YAML) }}

54+ ${{ runner.os }}-build-stack-${{ env.stack-yaml }}-${{ hashFiles(env.stack-yaml) }}

55− ${{ runner.os }}-build-stack-${{ matrix.ghc }}

55+ ${{ runner.os }}-build-stack-${{ env.stack-yaml }}

56− - name: Fix macOS cache bug

57− run: rm -rf ~/.stack/setup-exe-cache

58 - name: Build

56 - name: Build

59 run: stack build --ghc-options -O2 --local-bin-path out --copy-bins

57 run: stack build --ghc-options -O2 --local-bin-path out --copy-bins

60 - name: Test

58 - name: Test

61− run: stack test --stack-yaml=${{ env.STACK_YAML }}

59+ run: stack test --stack-yaml=${{ env.stack-yaml }}

62 - name: HLint

60 - name: HLint

63 run: curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s .

61 run: curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s .

64 - name: Haddock

62 - name: Haddock

README.markdown+1

@@ -4,6 +4,7 @@

4[![Public Domain](https://img.shields.io/badge/license-Public%20Domain-brightgreen.svg)](http://unlicense.org)

5[![Hackage](https://img.shields.io/hackage/v/project-m36.svg)](http://hackage.haskell.org/package/project-m36)

6[![Hackage dependency status](https://img.shields.io/hackage-deps/v/project-m36.svg)](http://packdeps.haskellers.com/feed?needle=project-m36)

7+[![Build status](https://travis-ci.org/agentm/project-m36.svg?branch=master)](https://travis-ci.org/agentm/project-m36)

7[![Windows Build status](https://ci.appveyor.com/api/projects/status/q7jyddd6dy1ibqdo/branch/master?svg=true)](https://ci.appveyor.com/project/agentm/project-m36)

8[![Windows Build status](https://ci.appveyor.com/api/projects/status/q7jyddd6dy1ibqdo/branch/master?svg=true)](https://ci.appveyor.com/project/agentm/project-m36)

8[![Github Workflow status](https://github.com/agentm/project-m36/workflows/CI/badge.svg)](https://github.com/agentm/project-m36/actions?query=workflow%3ACI)

9[![Github Workflow status](https://github.com/agentm/project-m36/workflows/CI/badge.svg)](https://github.com/agentm/project-m36/actions?query=workflow%3ACI)

docker.nix+1−1

@@ -4,7 +4,7 @@

4}:

5let

6 release = import ./release.nix { inherit pkgs compiler sources; };

7− static-project-m36 = pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.justStaticExecutables release.project);

7+ static-project-m36 = pkgs.haskell.lib.justStaticExecutables release.project;

8in

9pkgs.dockerTools.buildImage {

10 name = "project-m36";

docs/introduction_to_the_relational_algebra.markdown+1−1

@@ -202,7 +202,7 @@ Join (Instructor relation)

202

203(Course Relation)

204

205−|(Course Name, Course Name Type)|(Instructor Name, Instructor Name Type)|(Course Room Number, Room Number Type)|

205+|(Course Name, Course Name Type)|(Instructor, Instructor Name Type)|(Course Room Number, Room Number Type)|

206|-------------------------------|----------------------------------|--------------------------------------|

207|English 1|Steve|Room 104|

208|French 2|Bob|Room 103|

project-m36.cabal+1−1

@@ -433,7 +433,7 @@ Test-Suite test-scripts

433

434Executable project-m36-websocket-server

435 Default-Language: Haskell2010

436− Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, semigroups, attoparsec, parser-combinators, prettyprinter, network, modern-uri, http-conduit, base16-bytestring, http-types, cryptohash-sha256, wai, wai-websockets, warp, warp-tls

436+ Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, aeson, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, semigroups, attoparsec, parser-combinators, prettyprinter, network, modern-uri, http-conduit, base16-bytestring, http-types, cryptohash-sha256

437 Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs

438 Other-Modules: ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer

439 GHC-Options: -Wall -threaded

src/bin/ProjectM36/Server/WebSocket/websocket-server.hs+9−42

@@ -1,40 +1,23 @@

1{-# LANGUAGE CPP #-}

2−

2+import ProjectM36.Server.WebSocket

3+import ProjectM36.Server.Config

4+import ProjectM36.Server.ParseArgs

5+import ProjectM36.Server

3import Control.Concurrent

6import Control.Concurrent

7+import qualified Network.WebSockets as WS

4import Control.Exception

8import Control.Exception

5−import Control.Monad (when)

6−import Data.Maybe (isJust)

7−import Data.String (fromString)

8−import Network.HTTP.Types (status400)

9import Network.Socket

10−import Network.Wai (Application, responseLBS)

11−import Network.Wai.Handler.Warp

12−import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)

13−import qualified Network.Wai.Handler.WebSockets as WS

14−import Network.WebSockets (defaultConnectionOptions)

15−import ProjectM36.Server

16−import ProjectM36.Server.Config

17−import ProjectM36.Server.ParseArgs

18−import ProjectM36.Server.WebSocket

20main :: IO ()

11main :: IO ()

21main = do

12main = do

22 -- launch normal project-m36-server

13 -- launch normal project-m36-server

23 addressMVar <- newEmptyMVar

14 addressMVar <- newEmptyMVar

24− wsConfig <- parseWSConfigWithDefaults (defaultServerConfig {bindPort = 8000, bindHost = "127.0.0.1"})

15+ serverConfig <- parseConfigWithDefaults (defaultServerConfig { bindPort = 8000, bindHost = "127.0.0.1" })

25−

26 --usurp the serverConfig for our websocket server and make the proxied server run locally

16 --usurp the serverConfig for our websocket server and make the proxied server run locally

27− let serverConfig = wsServerConfig wsConfig

28− wsHost = bindHost serverConfig

17+ let wsHost = bindHost serverConfig

29 wsPort = bindPort serverConfig

18 wsPort = bindPort serverConfig

30 serverHost = "127.0.0.1"

19 serverHost = "127.0.0.1"

31 serverConfig' = serverConfig {bindPort = 0, bindHost = serverHost}

20 serverConfig' = serverConfig {bindPort = 0, bindHost = serverHost}

32− configCertificateFile = tlsCertificatePath wsConfig

33− configKeyFile = tlsKeyPath wsConfig

34−

35− when (isJust configCertificateFile /= isJust configKeyFile) $

36− throwIO $ ErrorCall "TLS_CERTIFICATE_PATH and TLS_KEY_PATH must be set in tandem"

37−

38 _ <- forkFinally (launchServer serverConfig' (Just addressMVar) >> pure ()) (either throwIO pure)

21 _ <- forkFinally (launchServer serverConfig' (Just addressMVar) >> pure ()) (either throwIO pure)

39 --wait for server to be listening

22 --wait for server to be listening

40 addr <- takeMVar addressMVar

23 addr <- takeMVar addressMVar

@@ -42,22 +25,6 @@ main = do

42 case addr of

25 case addr of

43 SockAddrInet port' _ -> fromIntegral port'

26 SockAddrInet port' _ -> fromIntegral port'

44 _ -> error "unsupported socket address (IPv4 only currently)"

27 _ -> error "unsupported socket address (IPv4 only currently)"

45− wsApp = websocketProxyServer port serverHost

28+ --this built-in server is apparently not meant for production use, but it's easier to test than starting up the wai or snap interfaces

46− waiApp = WS.websocketsOr defaultConnectionOptions wsApp backupApp

47− settings = warpSettings wsHost (fromIntegral wsPort)

29+ WS.runServer wsHost (fromIntegral wsPort) (websocketProxyServer port serverHost)

48−

49− case (configCertificateFile, configKeyFile) of

50− (Just certificate, Just key) -> runTLS (tlsSettings certificate key) settings waiApp

51− _ -> runSettings settings waiApp

52−

53−backupApp :: Application

54−backupApp _ respond = respond $ responseLBS status400 [] "Not a WebSocket request"

56−warpSettings :: HostName -> Port -> Settings

57−warpSettings host port =

58− setHost (fromString host)

59− . setPort port

60− . setServerName "project-m36"

61− . setTimeout 3600

62− . setGracefulShutdownTimeout (Just 5)

63− $ defaultSettings

src/lib/ProjectM36/Server/Config.hs−6

@@ -12,12 +12,6 @@ data ServerConfig = ServerConfig { persistenceStrategy :: PersistenceStrategy,

12 }

13 deriving (Show)

15−data WebsocketServerConfig = WebsocketServerConfig { wsServerConfig :: ServerConfig,

16− tlsCertificatePath :: Maybe String,

17− tlsKeyPath :: Maybe String

18− }

19− deriving (Show)

20−

21defaultServerConfig :: ServerConfig

15defaultServerConfig :: ServerConfig

22defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,

16defaultServerConfig = ServerConfig { persistenceStrategy = NoPersistence,

23 checkFS = True,

17 checkFS = True,

src/lib/ProjectM36/Server/ParseArgs.hs+14−31

@@ -17,14 +17,14 @@ parseArgsWithDefaults defaults = ServerConfig <$>

17 many parseGhcPkgPath <*>

18 parseTimeout (perRequestTimeout defaults) <*>

19 parseTestMode

20−

20+

21parsePersistenceStrategy :: Parser PersistenceStrategy

22parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

23 MinimalPersistence <$> dbdirOpt <|>

24 pure NoPersistence

25− where

25+ where

26− dbdirOpt = strOption (short 'd' <>

26+ dbdirOpt = strOption (short 'd' <>

27− long "database-directory" <>

27+ long "database-directory" <>

28 metavar "DIRECTORY" <>

29 showDefaultWith show

30 )

@@ -34,60 +34,43 @@ parsePersistenceStrategy = CrashSafePersistence <$> (dbdirOpt <* fsyncOpt) <|>

35parseTestMode :: Parser Bool

36parseTestMode = flag True False (long "test-mode" <> hidden)

37−

37+

38−parseCheckFS :: Parser Bool

38+parseCheckFS :: Parser Bool

39parseCheckFS = flag True False (long "disable-fscheck" <>

40 help "Disable filesystem check for journaling.")

41−

41+

42parseDatabaseName :: Parser DatabaseName

43parseDatabaseName = strOption (short 'n' <>

44 long "database" <>

45 metavar "DATABASE_NAME")

47−parseHostname :: Hostname -> Parser Hostname

47+parseHostname :: Hostname -> Parser Hostname

48parseHostname defHostname = strOption (short 'h' <>

49 long "hostname" <>

50 metavar "HOST_NAME" <>

51 value defHostname)

52−

52+

53parsePort :: Port -> Parser Port

54parsePort defPort = option auto (short 'p' <>

55 long "port" <>

56 metavar "PORT_NUMBER" <>

57 value defPort)

58−

58+

59parseGhcPkgPath :: Parser String

60parseGhcPkgPath = strOption (long "ghc-pkg-dir" <>

61 metavar "GHC_PACKAGE_DIRECTORY")

62−

62+

63−parseTimeout :: Int -> Parser Int

63+parseTimeout :: Int -> Parser Int

64parseTimeout defTimeout = option auto (long "timeout" <>

65 metavar "MICROSECONDS" <>

66 value defTimeout)

68parseConfig :: IO ServerConfig

69parseConfig = parseConfigWithDefaults defaultServerConfig

70−

70+

71parseConfigWithDefaults :: ServerConfig -> IO ServerConfig

72parseConfigWithDefaults defaults = execParser (info (parseArgsWithDefaults defaults <**> helpOption) idm)

74−parseWSConfigWithDefaults :: ServerConfig -> IO WebsocketServerConfig

75−parseWSConfigWithDefaults defaults = execParser (info (parseWSArgsWithDefaults defaults <**> helpOption) idm)

76−

77−parseWSArgsWithDefaults :: ServerConfig -> Parser WebsocketServerConfig

78−parseWSArgsWithDefaults defaults = WebsocketServerConfig <$>

79− parseArgsWithDefaults defaults <*>

80− parseTlsCertificatePath <*>

81− parseTlsKeyPath

82−

83−

84−parseTlsCertificatePath :: Parser (Maybe String)

85−parseTlsCertificatePath = optional $ strOption (long "tls-certificate-path" <>

86− metavar "TLS_CERTIFICATE_PATH")

87−

88−parseTlsKeyPath :: Parser (Maybe String)

89−parseTlsKeyPath = optional $ strOption (long "tls-key-path" <>

90− metavar "TLS_KEY_PATH")

92helpOption :: Parser (a -> a)

75helpOption :: Parser (a -> a)

93helpOption = abortOption helpText $ mconcat

76helpOption = abortOption helpText $ mconcat

@@ -97,6 +80,6 @@ helpOption = abortOption helpText $ mconcat

97 where

80 where

98#if MIN_VERSION_optparse_applicative(0,16,0)

81#if MIN_VERSION_optparse_applicative(0,16,0)

99 helpText = ShowHelpText Nothing

82 helpText = ShowHelpText Nothing

100−#else

83+#else

101 helpText = ShowHelpText

84 helpText = ShowHelpText

102#endif

85#endif