├── .gitignore ├── .stylish-haskell.yaml ├── .travis.yml ├── README.md ├── backend ├── LICENSE ├── Setup.hs ├── app │ └── Main.hs ├── default.nix ├── example-config.yaml ├── gen-docs │ └── Main.hs ├── gen-elm │ └── Main.hs ├── hercules.cabal ├── shell.nix ├── src │ ├── Control │ │ └── Monad │ │ │ └── Except │ │ │ └── Extra.hs │ ├── Data │ │ └── ByteString │ │ │ └── Extra.hs │ ├── Hercules │ │ ├── API.hs │ │ ├── Config.hs │ │ ├── Database │ │ │ ├── Extra.hs │ │ │ ├── Hercules.hs │ │ │ ├── Hercules │ │ │ │ └── Migration.hs │ │ │ └── Hydra.hs │ │ ├── Encryption.hs │ │ ├── Lib.hs │ │ ├── Log.hs │ │ ├── OAuth.hs │ │ ├── OAuth │ │ │ ├── Authenticators.hs │ │ │ ├── Authenticators │ │ │ │ ├── GitHub.hs │ │ │ │ └── Google.hs │ │ │ ├── Types.hs │ │ │ └── User.hs │ │ ├── Query │ │ │ ├── Hercules.hs │ │ │ └── Hydra.hs │ │ ├── ServerEnv.hs │ │ ├── Static.hs │ │ └── Swagger.hs │ ├── Network │ │ └── URI │ │ │ └── Extra.hs │ ├── Opaleye │ │ └── Extra.hs │ ├── Servant │ │ ├── Mandatory.hs │ │ └── Redirect.hs │ └── migrations │ │ └── create-users.sql └── test │ └── Spec.hs ├── default.nix ├── docs ├── Makefile ├── conf.py ├── default.nix ├── faq.rst ├── getting-started.rst └── index.rst ├── frontend ├── .gitignore ├── TODO ├── default.nix ├── elm-package.json ├── package.json ├── src │ ├── Components │ │ ├── Breadcrumbs.elm │ │ ├── Help.elm │ │ ├── LiveSearch.elm │ │ └── Navbar.elm │ ├── Main.elm │ ├── Models.elm │ ├── Msg.elm │ ├── Pages │ │ ├── Admin.elm │ │ ├── Build.elm │ │ ├── Evaluation.elm │ │ ├── Jobset.elm │ │ ├── Project.elm │ │ ├── Queue.elm │ │ ├── Search.elm │ │ └── User.elm │ ├── Update.elm │ ├── Urls.elm │ ├── Utils.elm │ ├── View.elm │ ├── index.html │ └── index.js └── webpack.config.js ├── haskell-packages.nix └── pkgs.nix /.gitignore: -------------------------------------------------------------------------------- 1 | #-- Configuration 2 | secret.key 3 | 4 | #-- Elm 5 | docs/_build/ 6 | elm-stuff/ 7 | frontend/src/Hercules.elm 8 | frontend/index.html 9 | node_modules/ 10 | 11 | #-- Haskell & Stack 12 | cabal-dev 13 | cabal.sandbox.config 14 | cabal.project.local 15 | dist 16 | dist-* 17 | dist/ 18 | *.aux 19 | *.chi 20 | *.chs.h 21 | *.dyn_o 22 | *.dyn_hi 23 | *.eventlog 24 | *.hi 25 | *.hp 26 | *.o 27 | *.prof 28 | .cabal-sandbox/ 29 | .hpc 30 | .hsenv 31 | .stack-work/ 32 | .HTF/ 33 | 34 | #-- Nix 35 | result 36 | 37 | #-- Unix 38 | *~ 39 | 40 | #-- Vim 41 | *.swp 42 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # stylish-haskell configuration file 2 | # ================================== 3 | 4 | # The stylish-haskell tool is mainly configured by specifying steps. These steps 5 | # are a list, so they have an order, and one specific step may appear more than 6 | # once (if needed). Each file is processed by these steps in the given order. 7 | steps: 8 | # Convert some ASCII sequences to their Unicode equivalents. This is disabled 9 | # by default. 10 | # - unicode_syntax: 11 | # # In order to make this work, we also need to insert the UnicodeSyntax 12 | # # language pragma. If this flag is set to true, we insert it when it's 13 | # # not already present. You may want to disable it if you configure 14 | # # language extensions using some other method than pragmas. Default: 15 | # # true. 16 | # add_language_pragma: true 17 | 18 | # Align the right hand side of some elements. This is quite conservative 19 | # and only applies to statements where each element occupies a single 20 | # line. 21 | - simple_align: 22 | cases: true 23 | top_level_patterns: true 24 | records: true 25 | 26 | # Import cleanup 27 | - imports: 28 | # There are different ways we can align names and lists. 29 | # 30 | # - global: Align the import names and import list throughout the entire 31 | # file. 32 | # 33 | # - file: Like global, but don't add padding when there are no qualified 34 | # imports in the file. 35 | # 36 | # - group: Only align the imports per group (a group is formed by adjacent 37 | # import lines). 38 | # 39 | # - none: Do not perform any alignment. 40 | # 41 | # Default: global. 42 | align: group 43 | 44 | # Folowing options affect only import list alignment. 45 | # 46 | # List align has following options: 47 | # 48 | # - after_alias: Import list is aligned with end of import including 49 | # 'as' and 'hiding' keywords. 50 | # 51 | # > import qualified Data.List as List (concat, foldl, foldr, head, 52 | # > init, last, length) 53 | # 54 | # - with_alias: Import list is aligned with start of alias or hiding. 55 | # 56 | # > import qualified Data.List as List (concat, foldl, foldr, head, 57 | # > init, last, length) 58 | # 59 | # - new_line: Import list starts always on new line. 60 | # 61 | # > import qualified Data.List as List 62 | # > (concat, foldl, foldr, head, init, last, length) 63 | # 64 | # Default: after_alias 65 | list_align: after_alias 66 | 67 | # Long list align style takes effect when import is too long. This is 68 | # determined by 'columns' setting. 69 | # 70 | # - inline: This option will put as much specs on same line as possible. 71 | # 72 | # - new_line: Import list will start on new line. 73 | # 74 | # - new_line_multiline: Import list will start on new line when it's 75 | # short enough to fit to single line. Otherwise it'll be multiline. 76 | # 77 | # - multiline: One line per import list entry. 78 | # Type with contructor list acts like single import. 79 | # 80 | # > import qualified Data.Map as M 81 | # > ( empty 82 | # > , singleton 83 | # > , ... 84 | # > , delete 85 | # > ) 86 | # 87 | # Default: inline 88 | long_list_align: inline 89 | 90 | # List padding determines indentation of import list on lines after import. 91 | # This option affects 'list_align' and 'long_list_align'. 92 | list_padding: 4 93 | 94 | # Separate lists option affects formating of import list for type 95 | # or class. The only difference is single space between type and list 96 | # of constructors, selectors and class functions. 97 | # 98 | # - true: There is single space between Foldable type and list of it's 99 | # functions. 100 | # 101 | # > import Data.Foldable (Foldable (fold, foldl, foldMap)) 102 | # 103 | # - false: There is no space between Foldable type and list of it's 104 | # functions. 105 | # 106 | # > import Data.Foldable (Foldable(fold, foldl, foldMap)) 107 | # 108 | # Default: true 109 | separate_lists: true 110 | 111 | # Language pragmas 112 | - language_pragmas: 113 | # We can generate different styles of language pragma lists. 114 | # 115 | # - vertical: Vertical-spaced language pragmas, one per line. 116 | # 117 | # - compact: A more compact style. 118 | # 119 | # - compact_line: Similar to compact, but wrap each line with 120 | # `{-#LANGUAGE #-}'. 121 | # 122 | # Default: vertical. 123 | style: vertical 124 | 125 | # Align affects alignment of closing pragma brackets. 126 | # 127 | # - true: Brackets are aligned in same collumn. 128 | # 129 | # - false: Brackets are not aligned together. There is only one space 130 | # between actual import and closing bracket. 131 | # 132 | # Default: true 133 | align: true 134 | 135 | # stylish-haskell can detect redundancy of some language pragmas. If this 136 | # is set to true, it will remove those redundant pragmas. Default: true. 137 | remove_redundant: true 138 | 139 | # Replace tabs by spaces. This is disabled by default. 140 | # - tabs: 141 | # # Number of spaces to use for each tab. Default: 8, as specified by the 142 | # # Haskell report. 143 | # spaces: 8 144 | 145 | # Remove trailing whitespace 146 | - trailing_whitespace: {} 147 | 148 | # A common setting is the number of columns (parts of) code will be wrapped 149 | # to. Different steps take this into account. Default: 80. 150 | columns: 80 151 | 152 | # By default, line endings are converted according to the OS. You can override 153 | # preferred format here. 154 | # 155 | # - native: Native newline format. CRLF on Windows, LF on other OSes. 156 | # 157 | # - lf: Convert to LF ("\n"). 158 | # 159 | # - crlf: Convert to CRLF ("\r\n"). 160 | # 161 | # Default: native. 162 | newline: lf 163 | 164 | # Sometimes, language extensions are specified in a cabal file or from the 165 | # command line instead of using language pragmas in the file. stylish-haskell 166 | # needs to be aware of these, so it can parse the file correctly. 167 | # 168 | # No language extensions are enabled by default. 169 | language_extensions: 170 | - MultiParamTypeClasses 171 | # - QuasiQuotes 172 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: nix 2 | # sadly containers have 12GB of total HDD space, which is not enough 3 | sudo: enabled 4 | cache: 5 | directories: 6 | - frontend/elm-stuff 7 | - frontend/node_modules 8 | script: 9 | - pushd frontend 10 | - nix-shell --run "npm i && elm package install -y" -j 8 11 | - popd 12 | - nix-build 13 | deploy: 14 | provider: s3 15 | access_key_id: AKIAJETSFTAMXGNCGC6Q 16 | secret_access_key: 17 | secure: K9aTtJKN1N2O0ItkGGt6qWaW1n6a032zrpfWWOd85fCrDdEuTtyO85HEFNpDZO+fJVlx3F2VHcBHmgljPxFzK1WJwNvPbjd8v6DIOR8oOtPW1tXWpwecbGsd7C3yz7+LpeOmZAe9Z35zywYe7s3xxxabELV3Qsr4udbpaOhy/74uI8w6OxrQ+t8sUA4Vp0MafaVLjiKhVirvnNyiIU/VH3px4ZR7oEckyWvt089lmoU5P4hRfAw8AhPR8JhFeMF60w/r8SqOOr9SC2dRTQHvDt0W0LXX4aCXUcBaY4QHhAf1txVS75JB8Ts8Qxdjxpy19957Ktx6/eM/nb9BgZzlVF7fMWxBcApTGyQCLdBq4yJb0tgVIBY+ohGHSkbqg5Zbkfk+V1xfAe0fTikqNQH1nAE7DUYWCrMdGOMTqSm3VQS38ZAWCGlcRBMITZW6cDrCmTG9WDLF7feaio3sdXpIhKAvreClBX5FBiSJPIMCcSGA/68iB7pVNV6JKeS/+f45k7N6ib0UjsEhuXDuqLCDzg/2ovu4Y/L/psvHttmphgncdIrZZMmYdobyY2nGGA2YB4GVBzkXE8ZjMLGa2uTZJKgpPuV0Ghgbkr8PNYMdWpsY11GftQs3vmuzMao3gqEStPbrYK8iveeN8w3guX4Dm5hKcre3+Hdh5NA+TBftZjs= 18 | bucket: hercules-ci 19 | skip_cleanup: true 20 | local_dir: result-2 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # This project is abandoned and has been restarted in different form: https://hercules-ci.com 2 | 3 | --- 4 | 5 | # Hercules 6 | 7 | [![Build Status](https://travis-ci.org/hercules-ci/hercules.svg?branch=master)](https://travis-ci.org/hercules-ci/hercules) 8 | 9 | Continuous Integration for Nix projects. 10 | 11 | Hercules uses the same DB schema as [Hydra](http://www.nixos.org/hydra/), 12 | but a new Haskell backend with a RESTful API and Elm as new frontend. 13 | 14 | The goal of the 1.0 milestone is to run Hercules as a CI for Github Pull Requests. 15 | 16 | ## Background 17 | 18 | Nix needs better tooling for building, testing and deploying of Nix expressions. 19 | 20 | Hydra has gone through many iterations, but it has become big and 21 | hard to maintain (not many Nix developers do Perl). 22 | 23 | Hercules goes quite far by using Servant as contract between the API, 24 | docs and the frontend. 25 | 26 | There should be minimal configuration to host Hercules and to 27 | build Nix projects. 28 | 29 | ## Documentation 30 | 31 | - [Introduction](http://hercules-ci.s3-website-us-west-2.amazonaws.com/) 32 | - [Getting started](http://hercules-ci.s3-website-us-west-2.amazonaws.com/getting-started.html) 33 | - [FAQ](http://hercules-ci.s3-website-us-west-2.amazonaws.com/faq.html) 34 | - [HTTP API](http://hercules-ci.s3-website-us-west-2.amazonaws.com/api.html) 35 | 36 | ## Status 37 | 38 | Very WIP - not usable yet. See [#5](https://github.com/hercules-ci/hercules/issues/5) for progress report. 39 | 40 | ![Status](https://cloud.githubusercontent.com/assets/126339/21887274/9b0eabd4-d8bf-11e6-9aeb-5f87f54e002c.png) 41 | 42 | ## License 43 | 44 | Backend ([BSD3](backend/LICENSE)) / Frontend ([BSD3](frontend/elm-package.json)) 45 | -------------------------------------------------------------------------------- /backend/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Joe Hermaszewski (c) 2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Joe Hermaszewski nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /backend/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /backend/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module Main where 4 | 5 | import qualified Data.ByteString.Char8 as BSC 6 | import qualified Data.ByteString.Extra as BS 7 | import Data.Foldable (fold) 8 | import qualified Data.Text as T 9 | import Data.Yaml (decodeFileEither, 10 | prettyPrintParseException) 11 | import Options.Applicative 12 | import System.Exit 13 | import System.IO (hPutStrLn, stderr) 14 | 15 | import Hercules.Config 16 | import Hercules.Lib 17 | 18 | main :: IO () 19 | main = getConfig >>= startApp 20 | 21 | -- | Parse the command line options. If incorrect options are given exit with 22 | -- 'exitFailure'. 23 | getConfig :: IO Config 24 | getConfig = execParser options >>= \case 25 | Left f -> decodeFileEither f >>= \case 26 | Left err -> do 27 | hPutStrLn stderr (prettyPrintParseException err) 28 | exitFailure 29 | Right c -> pure c 30 | Right c -> pure c 31 | 32 | -- | A parser for the hercules config or a filepath to load one from 33 | options :: ParserInfo (Either FilePath Config) 34 | options = info (helper <*> parser) description 35 | where 36 | parser = Left <$> configFileParser <|> Right <$> configParser 37 | configFileParser = strOption (fold [ long "config" 38 | , short 'c' 39 | , metavar "FILE" 40 | , help "Configuration in Haskell syntax" 41 | ]) 42 | configParser = Config 43 | <$> option auto (fold [ long "port" 44 | , short 'p' 45 | , metavar "PORT" 46 | , help "port to listen on" 47 | , value 8080 48 | , showDefault 49 | ] 50 | ) 51 | <*> (T.pack <$> strOption (fold [ long "hostname" 52 | , short 'h' 53 | , metavar "HOST" 54 | , help "The hostname of this server" 55 | ] 56 | ) 57 | ) 58 | <*> option auto (fold [ long "access-log-level" 59 | , short 'a' 60 | , metavar "LOG_LEVEL" 61 | , help "Level at which to log http accesses" 62 | , value Disabled 63 | , showDefault 64 | ] 65 | ) 66 | <*> strOption (fold [ long "secret-key-file" 67 | , short 'k' 68 | , metavar "FILE" 69 | , help "A file containing a 256 bit key for encrypting github tokens" 70 | ] 71 | ) 72 | <*> (T.pack <$> strOption (fold [ long "hercules-connection" 73 | , short 'e' 74 | , metavar "CONNECTION_STRING" 75 | , help "hercules database postgres connection string, see https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING" 76 | ] 77 | ) 78 | ) 79 | <*> (T.pack <$> strOption (fold [ long "hydra-connection" 80 | , short 'y' 81 | , metavar "CONNECTION_STRING" 82 | , help "hydra database postgres connection string, see https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING" 83 | ] 84 | ) 85 | ) 86 | <*> optional (authInfoParser "google") 87 | <*> optional (authInfoParser "github") 88 | 89 | authInfoParser name = AuthClientInfo 90 | <$> (BSC.pack <$> strOption (fold [ long (name ++ "-client") 91 | , metavar "CLIENT_ID" 92 | , help (name ++ "Google OAuth2 Client ID") 93 | ] 94 | ) 95 | ) 96 | <*> (BSC.pack <$> strOption (fold [ long (name ++ "-secret") 97 | , metavar "CLIENT_SECRET" 98 | , help (name ++ "OAuth2 Client Secret") 99 | ] 100 | ) 101 | ) 102 | 103 | description = fold 104 | [ fullDesc 105 | , header "hercules" 106 | , progDesc "A program to query a Hydra CI database" 107 | ] 108 | 109 | -------------------------------------------------------------------------------- /backend/default.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? (import ../pkgs.nix) {} }: 2 | 3 | with (import ../haskell-packages.nix) {inherit pkgs;}; 4 | with haskellPackages; 5 | with pkgs; 6 | 7 | haskellPackageGen { 8 | extraEnvPackages = [ opaleye-gen postgresql ]; 9 | } ./. 10 | -------------------------------------------------------------------------------- /backend/example-config.yaml: -------------------------------------------------------------------------------- 1 | port: 8080 2 | hostname: "localhost" 3 | accessLogLevel: Disabled 4 | secretKeyFile: "secret.key" 5 | hydraConnectionString: "postgresql://hydra@/hydra" 6 | herculesConnectionString: "postgresql://hercules@/hercules" 7 | -------------------------------------------------------------------------------- /backend/gen-docs/Main.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main 3 | ) where 4 | 5 | import Data.Aeson (encode) 6 | import qualified Data.ByteString.Lazy.Char8 as BL8 7 | 8 | import Hercules.Swagger (swaggerDoc) 9 | 10 | main :: IO () 11 | main = writeFile "api.yml" $ BL8.unpack $ encode swaggerDoc 12 | -------------------------------------------------------------------------------- /backend/gen-elm/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | {-# LANGUAGE TypeSynonymInstances #-} 10 | 11 | module Main 12 | ( main 13 | ) where 14 | 15 | import Data.Text (Text, replace, pack) 16 | import Data.Monoid ((<>)) 17 | import Elm 18 | import Servant.Auth.Server 19 | import Servant.Elm 20 | import Servant.Foreign 21 | import Servant.Foreign.Internal (Elem) 22 | import Options.Applicative 23 | 24 | import Hercules.API 25 | import Hercules.Database.Extra 26 | 27 | 28 | elmoptions :: Options 29 | elmoptions = Options {fieldLabelModifier = replace "'" ""} 30 | 31 | spec :: ElmOptions -> Spec 32 | spec elmexportoptions = Spec ["Hercules"] 33 | (defElmImports 34 | : toElmTypeSourceWith elmoptions (Proxy :: Proxy Project) 35 | : toElmDecoderSourceWith elmoptions (Proxy :: Proxy Project) 36 | : toElmTypeSourceWith elmoptions (Proxy :: Proxy Jobset) 37 | : toElmDecoderSourceWith elmoptions (Proxy :: Proxy Jobset) 38 | : toElmTypeSourceWith elmoptions (Proxy :: Proxy ProjectWithJobsets) 39 | : toElmDecoderSourceWith elmoptions (Proxy :: Proxy ProjectWithJobsets) 40 | : generateElmForAPIWith elmexportoptions (Proxy :: Proxy QueryAPI) 41 | ) 42 | 43 | -- Generate Authorization header for Elm protected URLs 44 | -- https://github.com/plow-technologies/servant-auth/issues/8 45 | instance forall lang ftype api auths a. 46 | ( HasForeign lang ftype api 47 | , HasForeignType lang ftype Text 48 | , JWT `Elem` auths 49 | ) 50 | => HasForeign lang ftype (Auth auths a :> api) where 51 | type Foreign ftype (Auth auths a :> api) = Foreign ftype api 52 | 53 | foreignFor lang Proxy Proxy subR = 54 | foreignFor lang Proxy (Proxy :: Proxy api) req 55 | where 56 | req = subR{ _reqHeaders = HeaderArg arg : _reqHeaders subR } 57 | arg = Arg 58 | { _argName = PathSegment "authorization" 59 | , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy Text) 60 | } 61 | 62 | data ElmConfig = ElmConfig 63 | { elmpath :: String 64 | } 65 | 66 | parser :: Parser ElmConfig 67 | parser = 68 | ElmConfig 69 | <$> argument str (metavar "FOLDER") 70 | 71 | main :: IO () 72 | main = do 73 | elmconfig <- execParser $ info (helper <*> parser) 74 | (fullDesc <> progDesc "Generate types for Elm frontend") 75 | let elmexportoptions = defElmOptions { elmExportOptions = elmoptions , urlPrefix = Dynamic } 76 | specsToDir [spec elmexportoptions] $ elmpath elmconfig 77 | -------------------------------------------------------------------------------- /backend/hercules.cabal: -------------------------------------------------------------------------------- 1 | name: hercules 2 | version: 0.1.0.0 3 | synopsis: A server to interface with a Hydra database 4 | description: Please see README.md 5 | homepage: https://github.com/expipiplus1/hercules#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Joe Hermaszewski 9 | maintainer: alcmene@monoid.al 10 | copyright: 2016 Joe Hermaszewski 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: default.nix shell.nix 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Control.Monad.Except.Extra 19 | Data.ByteString.Extra 20 | Hercules.Lib 21 | Hercules.API 22 | Hercules.Config 23 | Hercules.Database.Extra 24 | Hercules.Database.Hercules 25 | Hercules.Database.Hercules.Migration 26 | Hercules.Database.Hydra 27 | Hercules.Encryption 28 | Hercules.Log 29 | Hercules.OAuth 30 | Hercules.OAuth.Authenticators 31 | Hercules.OAuth.Authenticators.GitHub 32 | Hercules.OAuth.Authenticators.Google 33 | Hercules.OAuth.Types 34 | Hercules.OAuth.User 35 | Hercules.Query.Hercules 36 | Hercules.Query.Hydra 37 | Hercules.ServerEnv 38 | Hercules.Static 39 | Hercules.Swagger 40 | Network.URI.Extra 41 | Opaleye.Extra 42 | Servant.Mandatory 43 | Servant.Redirect 44 | build-depends: base >= 4.7 && < 5 45 | , aeson 46 | , async 47 | , blaze-html 48 | , bytestring 49 | , cryptonite 50 | , file-embed 51 | , github 52 | , hoauth2 53 | , http-client 54 | , http-client-tls 55 | , interpolatedstring-perl6 56 | , jose 57 | , lens 58 | , logging-effect 59 | , markdown 60 | , memory 61 | , monad-control 62 | , mtl 63 | , network-uri 64 | , opaleye 65 | , postgresql-simple 66 | , postgresql-simple-migration 67 | , product-profunctors 68 | , profunctors 69 | , resource-pool 70 | , safe 71 | , say 72 | , servant-auth-server 73 | , servant-auth-swagger 74 | , servant-swagger-ui 75 | , servant-swagger 76 | , swagger2 77 | , servant-blaze 78 | , servant-elm 79 | , servant-server 80 | , text 81 | , time 82 | , wai 83 | , wai-extra 84 | , warp 85 | , wl-pprint-text 86 | , yaml 87 | default-language: Haskell2010 88 | ghc-options: -Wall 89 | 90 | executable hercules 91 | hs-source-dirs: app 92 | main-is: Main.hs 93 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 94 | build-depends: base 95 | , hercules 96 | , bytestring 97 | , optparse-applicative 98 | , text 99 | , yaml 100 | default-language: Haskell2010 101 | 102 | executable gen-elm 103 | hs-source-dirs: gen-elm 104 | main-is: Main.hs 105 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 106 | build-depends: base 107 | , hercules 108 | , elm-export 109 | , optparse-applicative 110 | , servant-auth-server 111 | , servant-elm 112 | , servant-foreign 113 | , text 114 | default-language: Haskell2010 115 | 116 | executable gen-docs 117 | hs-source-dirs: gen-docs 118 | main-is: Main.hs 119 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 120 | build-depends: base 121 | , hercules 122 | , bytestring 123 | , aeson 124 | , text 125 | default-language: Haskell2010 126 | 127 | test-suite test 128 | type: exitcode-stdio-1.0 129 | hs-source-dirs: test 130 | main-is: Spec.hs 131 | build-depends: base 132 | , hspec 133 | , hercules 134 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 135 | default-language: Haskell2010 136 | 137 | source-repository head 138 | type: git 139 | location: https://github.com/expipiplus1/hercules 140 | -------------------------------------------------------------------------------- /backend/shell.nix: -------------------------------------------------------------------------------- 1 | (import ./default.nix {}).env 2 | -------------------------------------------------------------------------------- /backend/src/Control/Monad/Except/Extra.hs: -------------------------------------------------------------------------------- 1 | module Control.Monad.Except.Extra 2 | ( failWith 3 | , failWithM 4 | , throwLeftWith 5 | , throwLeftWithM 6 | , module Control.Monad.Except 7 | ) where 8 | 9 | import Control.Monad.Except 10 | 11 | failWith :: MonadError e m => e -> Maybe a -> m a 12 | failWith e = maybe (throwError e) pure 13 | 14 | failWithM :: MonadError e m => e -> m (Maybe a) -> m a 15 | failWithM e m = failWith e =<< m 16 | 17 | throwLeftWith :: MonadError e m => (e' -> e) -> Either e' a -> m a 18 | throwLeftWith f = either (throwError . f) pure 19 | 20 | throwLeftWithM :: MonadError e m => (e' -> e) -> m (Either e' a) -> m a 21 | throwLeftWithM f m = throwLeftWith f =<< m 22 | -------------------------------------------------------------------------------- /backend/src/Data/ByteString/Extra.hs: -------------------------------------------------------------------------------- 1 | module Data.ByteString.Extra 2 | ( module Data.ByteString 3 | , readFileMaybe 4 | ) where 5 | 6 | import Control.Exception 7 | import Data.ByteString 8 | 9 | -- | Catch any 'IOException's and return Nothing, otherwise the file contents 10 | readFileMaybe :: FilePath -> IO (Maybe ByteString) 11 | readFileMaybe f = catch (Just <$> Data.ByteString.readFile f) h 12 | where h :: IOException -> IO (Maybe a) 13 | h = pure . const Nothing 14 | -------------------------------------------------------------------------------- /backend/src/Hercules/API.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module Hercules.API 5 | ( API 6 | , QueryAPI 7 | , Unprotected 8 | , Protected 9 | , UserId(..) 10 | ) where 11 | 12 | import Data.Text 13 | import Servant 14 | import Servant.Auth.Server 15 | import Servant.HTML.Blaze 16 | import Servant.Swagger.UI 17 | import Text.Blaze.Html5 18 | 19 | import Hercules.Database.Extra (Project, ProjectWithJobsets) 20 | import Hercules.OAuth.Authenticators (AuthenticatorName) 21 | import Hercules.OAuth.Types (AuthClientState, AuthCode, AuthError, 22 | AuthStatePacked, FrontendURL) 23 | import Hercules.OAuth.User 24 | 25 | type Unprotected = 26 | "projectNames" :> Get '[JSON] [Text] 27 | :<|> "project" :> Get '[JSON] [Project] 28 | :<|> "project" :> Capture "projectName" Text :> Get '[JSON] (Maybe Project) 29 | :<|> "projectWithJobsets" :> Get '[JSON] [ProjectWithJobsets] 30 | 31 | type Protected = "protected" :> Get '[JSON] Text 32 | 33 | type QueryAPI = Unprotected 34 | :<|> Auth '[JWT] UserId :> Protected 35 | 36 | -- | A bunch of pages used for debugging and examples 37 | type Pages = "login" :> Get '[HTML] Html 38 | :<|> "login" :> Capture "authType" AuthenticatorName 39 | :> QueryParam "state" AuthClientState 40 | :> QueryParam "frontendURL" FrontendURL 41 | :> Get '[HTML] Html 42 | :<|> "auth-callback" :> Capture "authType" AuthenticatorName 43 | :> QueryParam "code" AuthCode 44 | :> QueryParam "error" AuthError 45 | :> QueryParam "state" AuthStatePacked 46 | :> Get '[HTML] Html 47 | :<|> "logged-in" :> QueryParam "jwt" Text 48 | :> Get '[HTML] Html 49 | :<|> "repos" :> Auth '[JWT] UserId :> Get '[HTML] Html 50 | 51 | type API = (QueryAPI 52 | :<|> Pages 53 | -- TODO: Waiting for Servant to gain Redirect combinators, 54 | -- The return type is wrong, this endpoint always redirects 55 | -- See https://github.com/haskell-servant/servant/issues/117 56 | :<|> Get '[HTML] Html) 57 | :<|> SwaggerSchemaUI "docs" "swagger.json" 58 | -------------------------------------------------------------------------------- /backend/src/Hercules/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE StrictData #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | 5 | module Hercules.Config 6 | ( Config(..) 7 | , ConnectInfo(..) 8 | , AuthClientInfo(..) 9 | , HostName 10 | , AccessLogLevel(..) 11 | ) where 12 | 13 | import Data.Aeson 14 | import Data.Aeson.TH 15 | import Data.Char (toLower) 16 | import Data.Text (Text) 17 | import Database.PostgreSQL.Simple (ConnectInfo (..)) 18 | import GHC.Generics 19 | import Network.Wai.Handler.Warp (Port) 20 | 21 | import Hercules.OAuth.Types 22 | 23 | type HostName = Text 24 | 25 | -- | Access logging level 26 | data AccessLogLevel = Disabled | Enabled | Development 27 | deriving(Read, Show, Generic) 28 | 29 | instance FromJSON AccessLogLevel 30 | 31 | data Config = Config { configPort :: Port 32 | , configHostname :: HostName 33 | , configAccessLogLevel :: AccessLogLevel 34 | , configSecretKeyFile :: FilePath 35 | , configHerculesConnectionString :: Text 36 | , configHydraConnectionString :: Text 37 | , configGoogleAuthInfo :: Maybe AuthClientInfo 38 | , configGitHubAuthInfo :: Maybe AuthClientInfo 39 | } 40 | deriving(Read, Show) 41 | 42 | -- Derive JSON dropping 'config' and making the first character lowercase. 43 | deriveFromJSON defaultOptions 44 | { fieldLabelModifier = \s -> 45 | case drop (length "config") s of 46 | [] -> [] 47 | x:xs -> toLower x : xs 48 | } 49 | ''Config 50 | -------------------------------------------------------------------------------- /backend/src/Hercules/Database/Extra.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | module Hercules.Database.Extra 6 | ( ProjectWithJobsets(..) 7 | , module Hercules.Database.Hydra 8 | ) where 9 | 10 | import Data.Aeson 11 | import GHC.Generics 12 | import Hercules.Database.Hydra 13 | import Servant.Elm 14 | 15 | data ProjectWithJobsets = ProjectWithJobsets 16 | { projectWithJobsetsProject :: Project 17 | , projectWithJobsetsJobsets :: [Jobset] 18 | } 19 | deriving(Generic) 20 | 21 | instance ToJSON ProjectWithJobsets where 22 | instance ElmType ProjectWithJobsets where 23 | -------------------------------------------------------------------------------- /backend/src/Hercules/Database/Hercules.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | 6 | module Hercules.Database.Hercules where 7 | 8 | import Data.ByteString 9 | import Data.Profunctor 10 | import Data.Profunctor.Product 11 | import Data.Profunctor.Product.Default 12 | import Data.Profunctor.Product.TH (makeAdaptorAndInstance) 13 | import Data.Text 14 | import GHC.Int 15 | import Opaleye hiding (fromNullable) 16 | 17 | -- | A newtype around @a -> Maybe b@ to facilitate conversions from the 18 | -- Nullable types. 19 | newtype ToMaybe a b = ToMaybe { unToMaybe :: a -> Maybe b } 20 | 21 | instance Profunctor ToMaybe where 22 | dimap f g (ToMaybe h) = ToMaybe (fmap g . h . f) 23 | 24 | instance ProductProfunctor ToMaybe where 25 | empty = ToMaybe pure 26 | (ToMaybe f) ***! (ToMaybe g) = ToMaybe (\(x, y) -> (,) <$> f x <*> g y) 27 | 28 | -- | This instance makes sure that values which are required in the output are 29 | -- required in the input. 30 | instance Default ToMaybe (Maybe a) a where 31 | def = ToMaybe id 32 | 33 | -- | This instance allows values which are optional in the output to be 34 | -- optional in the input. 35 | instance Default ToMaybe (Maybe a) (Maybe a) where 36 | def = ToMaybe pure 37 | 38 | -- | Convert from any Nullable type by "sequencing" over all the fields. 39 | fromNullable :: Default ToMaybe a b => a -> Maybe b 40 | fromNullable = unToMaybe def 41 | 42 | ---- Types for table: users ---- 43 | 44 | data User' c1 c2 c3 c4 c5 = 45 | User 46 | { userId :: c1 47 | , userName :: c2 48 | , userEmail :: c3 49 | , userGithubId :: c4 50 | , userGithubToken :: c5 51 | } 52 | 53 | type User = User' Int64 (Maybe Text) (Maybe Text) (Maybe Text) (Maybe ByteString) 54 | 55 | type UserReadColumns = User' (Column PGInt8) (Column (Nullable PGText)) (Column (Nullable PGText)) (Column (Nullable PGText)) (Column (Nullable PGBytea)) 56 | 57 | type UserWriteColumns = User' (Maybe (Column PGInt8)) (Maybe (Column (Nullable PGText))) (Maybe (Column (Nullable PGText))) (Maybe (Column (Nullable PGText))) (Maybe (Column (Nullable PGBytea))) 58 | 59 | type UserNullableColumns = User' (Column (Nullable PGInt8)) (Column (Nullable PGText)) (Column (Nullable PGText)) (Column (Nullable PGText)) (Column (Nullable PGBytea)) 60 | 61 | type UserNullable = User' (Maybe Int64) (Maybe Text) (Maybe Text) (Maybe Text) (Maybe ByteString) 62 | 63 | fromNullableUser :: UserNullable -> Maybe User 64 | fromNullableUser = fromNullable 65 | 66 | $(makeAdaptorAndInstance "pUser" ''User') 67 | 68 | userTable :: Table UserWriteColumns UserReadColumns 69 | userTable = Table "users" (pUser 70 | User 71 | { userId = optional "id" 72 | , userName = optional "name" 73 | , userEmail = optional "email" 74 | , userGithubId = optional "github_id" 75 | , userGithubToken = optional "github_token" 76 | } 77 | ) 78 | 79 | -------------------------------------------------------------------------------- /backend/src/Hercules/Database/Hercules/Migration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | 5 | module Hercules.Database.Hercules.Migration 6 | ( readyDatabase 7 | , MigrationResult(..) 8 | , Verbosity(..) 9 | ) where 10 | 11 | import Control.Monad (void, when) 12 | import Data.FileEmbed 13 | import Data.Text 14 | import Database.PostgreSQL.Simple (Connection, execute, 15 | withTransaction) 16 | import Database.PostgreSQL.Simple.Migration 17 | 18 | -- | Prepare the database for Hercules use 19 | readyDatabase :: Verbosity -> Connection -> IO (MigrationResult Text) 20 | readyDatabase verbosity con = 21 | fmap (fmap pack) . withTransaction con $ do 22 | -- Silence any informational warnings. 23 | when (verbosity == Quiet) $ 24 | void (execute con "SET LOCAL client_min_messages TO warning;" ()) 25 | 26 | -- Ready the database 27 | runMigrations (verbosityToBool verbosity) con migrations 28 | 29 | data Verbosity = Verbose | Quiet 30 | deriving (Eq) 31 | 32 | verbosityToBool :: Verbosity -> Bool 33 | verbosityToBool = \case 34 | Verbose -> True 35 | Quiet -> False 36 | 37 | -- | The migrations to get an empty database in a usable state 38 | -- 39 | -- It's really important that one doesn't change the elements of this list and 40 | -- only appends to it as the hashes of these commands are stored and used to 41 | -- verify that the database is in a good state. 42 | migrations :: [MigrationCommand] 43 | migrations = 44 | [ MigrationInitialization 45 | , MigrationScript "Create the users table" 46 | $(embedFile "src/migrations/create-users.sql") 47 | ] 48 | -------------------------------------------------------------------------------- /backend/src/Hercules/Encryption.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | {-| A module for encrypting and decrypting data for Hercules 5 | -} 6 | module Hercules.Encryption 7 | ( encrypt 8 | , decrypt 9 | ) where 10 | 11 | import Control.Monad.Log 12 | import Control.Monad.Reader 13 | import Crypto.Cipher.Types 14 | import Crypto.Random.Entropy 15 | import Data.ByteArray as BA 16 | import Data.ByteString as BS 17 | import Data.Semigroup 18 | import Servant 19 | 20 | import Hercules.ServerEnv 21 | 22 | -- | Encrypt a 'ByteString' with a new IV. 23 | encrypt :: ByteString -> App ByteString 24 | encrypt bs = do 25 | cipher <- asks envCipher 26 | iv <- newIV 27 | let ivBytes = BS.pack . BA.unpack $ iv 28 | pure $ ivBytes <> ctrCombine cipher iv bs 29 | 30 | -- | Decrypt a 'ByteString' encrypted with 'encrypt'. 31 | decrypt :: ByteString -> App ByteString 32 | decrypt bs = do 33 | cipher <- asks envCipher 34 | let ivLen = blockSize cipher 35 | if BS.length bs < ivLen 36 | then do 37 | logError "Trying to decrypt too short bytestring" 38 | throwError err500 39 | else do 40 | let (ivBytes, message) = BS.splitAt ivLen bs 41 | iv <- makeIV' ivBytes 42 | pure $ ctrCombine cipher iv message 43 | 44 | -- | Get a new random IV 45 | newIV :: App (IV HerculesCipher) 46 | newIV = do 47 | cipher <- asks envCipher 48 | makeIV' =<< liftIO (getEntropy (blockSize cipher)) 49 | 50 | -- | Convert some bytes into an IV 51 | makeIV' :: ByteString -> App (IV HerculesCipher) 52 | makeIV' bs = case makeIV bs of 53 | Nothing -> do 54 | logError "Unable to create IV for encryption" 55 | throwError err500 56 | Just iv -> pure iv 57 | -------------------------------------------------------------------------------- /backend/src/Hercules/Lib.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | module Hercules.Lib 6 | ( startApp 7 | , swaggerDoc 8 | ) where 9 | 10 | import Control.Monad (join) 11 | import Control.Monad.Log 12 | import Data.Bifunctor (second) 13 | import Data.Foldable (toList) 14 | import Data.List (sortOn) 15 | import Data.Maybe (catMaybes) 16 | import Data.Monoid ((<>)) 17 | import Data.Swagger 18 | import Data.Text 19 | import Network.Wai 20 | import Network.Wai.Handler.Warp 21 | import Network.Wai.Middleware.RequestLogger 22 | import Safe (headMay) 23 | import Servant 24 | import Servant.Auth.Server (AuthResult (..), 25 | defaultCookieSettings) 26 | import Servant.Mandatory 27 | import Servant.Redirect 28 | import Servant.Swagger 29 | import Servant.Swagger.UI 30 | 31 | import qualified Data.List.NonEmpty as NE 32 | import qualified Data.Text.IO as T 33 | 34 | import Hercules.API 35 | import Hercules.Config 36 | import Hercules.Database.Extra (JobsetNullable, Project, 37 | ProjectWithJobsets (..), 38 | fromNullableJobset, projectName) 39 | import Hercules.OAuth 40 | import Hercules.OAuth.Authenticators 41 | import Hercules.Query.Hydra 42 | import Hercules.ServerEnv 43 | import Hercules.Static 44 | import Hercules.Swagger 45 | 46 | startApp :: Config -> IO () 47 | startApp config = do 48 | let authenticators = configAuthenticatorList config 49 | port = configPort config 50 | logging = loggingMiddleware config 51 | newEnv config authenticators >>= \case 52 | Nothing -> pure () 53 | Just env -> do 54 | T.putStrLn $ "Serving on http://" <> configHostname config 55 | <> ":" <> (pack . show $ port) 56 | run port . logging =<< app env 57 | 58 | loggingMiddleware :: Config -> Middleware 59 | loggingMiddleware config = case configAccessLogLevel config of 60 | Disabled -> id 61 | Enabled -> logStdout 62 | Development -> logStdoutDev 63 | 64 | app :: Env -> IO Application 65 | app env = do 66 | let api = Proxy :: Proxy API 67 | authConfig = defaultCookieSettings :. envJWTSettings env :. EmptyContext 68 | pure $ serveWithContext api authConfig (server env) 69 | 70 | server :: Env -> Server API 71 | server env = enter (Nat (runApp env)) api :<|> serveSwagger 72 | where api = queryApi 73 | :<|> pages 74 | :<|> root 75 | pages = welcomePage 76 | :<|> (mandatory1 .: loginPage) 77 | :<|> (mandatory1 .∵ authCallback) 78 | :<|> loggedInPage 79 | :<|> (join . withAuthenticated userInfoPage) 80 | queryApi = unprotected :<|> protected 81 | unprotected = getProjectNames 82 | :<|> getProjects 83 | :<|> getProject 84 | :<|> getProjectsWithJobsets 85 | protected = getUser 86 | 87 | (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d 88 | (.:) = (.) . (.) 89 | 90 | (.∵) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e 91 | (.∵) = (.) . (.) . (.) 92 | 93 | 94 | root :: App a 95 | root = redirectBS "/docs/" 96 | 97 | serveSwagger :: Server (SwaggerSchemaUI "docs" "swagger.json") 98 | serveSwagger = swaggerSchemaUIServer swaggerDoc 99 | 100 | getUser :: AuthResult UserId -> App Text 101 | getUser = withAuthenticated (pack . show) 102 | 103 | withAuthenticated :: (a -> b) -> AuthResult a -> App b 104 | withAuthenticated f = \case 105 | (Authenticated x) -> pure (f x) 106 | _ -> do 107 | logNotice "Failed user authentication attempt" 108 | throwError err401 109 | 110 | getProjectNames :: App [Text] 111 | getProjectNames = runHydraQueryWithConnection projectNameQuery 112 | 113 | getProject :: Text -> App (Maybe Project) 114 | getProject name = headMay <$> runHydraQueryWithConnection (projectQuery name) 115 | 116 | getProjects :: App [Project] 117 | getProjects = runHydraQueryWithConnection projectsQuery 118 | 119 | getProjectsWithJobsets :: App [ProjectWithJobsets] 120 | getProjectsWithJobsets = 121 | fmap (uncurry makeProjectWithJobsets . second toList) 122 | . groupSortOn projectName 123 | <$> (runHydraQueryWithConnection projectsWithJobsetsQuery :: App [(Project, JobsetNullable)]) 124 | where 125 | makeProjectWithJobsets :: Project -> [JobsetNullable] -> ProjectWithJobsets 126 | makeProjectWithJobsets p jms = 127 | let js = catMaybes (fromNullableJobset <$> jms) 128 | in ProjectWithJobsets p js 129 | 130 | groupSortOn :: Ord k => (a -> k) -> [(a, v)] -> [(a, NE.NonEmpty v)] 131 | groupSortOn f = fmap (\x -> (fst $ NE.head x, fmap snd x)) 132 | . NE.groupWith (f . fst) 133 | . sortOn (f . fst) 134 | 135 | -------------------------------------------------------------------------------- /backend/src/Hercules/Log.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module Hercules.Log 4 | ( LogM 5 | , LogMessage(..) 6 | , render 7 | ) where 8 | 9 | import Control.Monad.Log 10 | import Data.String 11 | import Data.Text 12 | import Data.Text.Lazy (fromStrict) 13 | import Text.PrettyPrint.Leijen.Text 14 | 15 | -- | See this comment: 16 | -- https://github.com/ocharles/logging-effect/pull/6#issuecomment-252511869 for 17 | -- why this type is necessary. 18 | type LogM l m = LoggingT l (LoggingT (WithTimestamp l) m) 19 | 20 | newtype LogMessage = LogString Text 21 | 22 | instance IsString LogMessage where 23 | fromString = LogString . fromString 24 | 25 | render :: LogMessage -> Doc 26 | render = \case 27 | LogString s -> text (fromStrict s) 28 | -------------------------------------------------------------------------------- /backend/src/Hercules/OAuth.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module Hercules.OAuth 5 | ( AuthState(..) 6 | , AuthCode(..) 7 | , authCallback 8 | ) where 9 | 10 | import Control.Monad.Except.Extra 11 | import Data.Aeson 12 | import Data.ByteString.Lazy (fromStrict, toStrict) 13 | import Data.Text 14 | import Data.Text.Encoding 15 | import Network.OAuth.OAuth2 16 | import qualified Network.OAuth.OAuth2 as OA 17 | import Servant 18 | import Servant.Redirect 19 | 20 | import Hercules.OAuth.Authenticators 21 | import Hercules.OAuth.Types 22 | import Hercules.ServerEnv 23 | 24 | authCallback :: AuthenticatorName 25 | -> Maybe AuthCode 26 | -> Maybe AuthError 27 | -> AuthStatePacked 28 | -> App a 29 | authCallback authName maybeCode maybeError packedState = do 30 | -- Extract the state 31 | state <- failWith err400 (unpackState packedState) 32 | 33 | case (maybeCode, maybeError) of 34 | (Nothing, Nothing) -> throwError err400 35 | (Nothing, Just err) -> handleError state err 36 | (Just code, Nothing) -> handleCode authName state code 37 | (Just _, Just _) -> throwError err400 38 | 39 | handleError :: AuthState 40 | -> AuthError 41 | -> App a 42 | handleError state err = do 43 | let redirectURI :: OA.URI 44 | redirectURI = encodeUtf8 . unFrontendURL . authStateFrontendURL $ state 45 | redirectError redirectURI (unAuthError err) 46 | 47 | handleCode :: AuthenticatorName 48 | -> AuthState 49 | -> AuthCode 50 | -> App a 51 | handleCode authName state (AuthCode code) = do 52 | -- Can we handle this authenticator 53 | authenticator <- failWithM err404 (getAuthenticator authName) 54 | let config = authenticatorConfig authenticator 55 | 56 | let clientState = authStateClientState state 57 | redirectURI :: OA.URI 58 | redirectURI = encodeUtf8 . unFrontendURL . authStateFrontendURL $ state 59 | failWithBS err = redirectError redirectURI (decodeUtf8 . toStrict $ err) 60 | 61 | -- Get the access token for this user 62 | token <- either failWithBS pure 63 | =<< withHttpManager (\m -> fetchAccessToken m config (encodeUtf8 code)) 64 | 65 | -- Get the user info with the token 66 | user <- either (redirectError redirectURI) pure 67 | =<< authenticatorGetUserInfo authenticator token 68 | 69 | -- Create a JWT 70 | jwt <- either (const (redirectError redirectURI "Failed to create JWT")) pure 71 | =<< makeUserJWT user 72 | 73 | -- Return to the frontend 74 | redirectSuccess redirectURI jwt clientState 75 | 76 | redirectError :: OA.URI 77 | -> Text 78 | -- ^ An error message 79 | -> App a 80 | redirectError uri message = 81 | let param = [("authFailure", encodeUtf8 message)] 82 | in redirectBS (uri `appendQueryParam` param) 83 | 84 | redirectSuccess :: OA.URI 85 | -> PackedJWT 86 | -- ^ This user's token 87 | -> Maybe AuthClientState 88 | -> App a 89 | redirectSuccess uri jwt state = 90 | let params = ("jwt", unPackedJWT jwt) : 91 | case state of 92 | Nothing -> [] 93 | Just s -> [("state", encodeUtf8 . unAuthClientState $ s)] 94 | in redirectBS (uri `appendQueryParam` params) 95 | 96 | unpackState :: AuthStatePacked -> Maybe AuthState 97 | unpackState = decode . fromStrict . encodeUtf8 . unAuthStatePacked 98 | -------------------------------------------------------------------------------- /backend/src/Hercules/OAuth/Authenticators.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {-| 5 | A module providing data types and functions for getting information about 6 | different authentication providers. 7 | -} 8 | module Hercules.OAuth.Authenticators 9 | ( AuthenticatorName(..) 10 | , OAuth2Authenticator 11 | , configAuthenticatorList 12 | , authenticationURLWithState 13 | ) where 14 | 15 | import Data.Aeson 16 | import Data.ByteString (ByteString) 17 | import Data.ByteString.Lazy (toStrict) 18 | import Data.Maybe (catMaybes) 19 | import Data.Text 20 | import Network.OAuth.OAuth2 hiding (URI) 21 | import Network.URI (URI (..), URIAuth (..)) 22 | 23 | import Hercules.Config 24 | import Hercules.OAuth.Authenticators.GitHub 25 | import Hercules.OAuth.Authenticators.Google 26 | import Hercules.OAuth.Types 27 | import Hercules.ServerEnv (App) 28 | 29 | -- | Get a list of usable authentication services from the given config. 30 | configAuthenticatorList :: Config -> [OAuth2Authenticator App] 31 | configAuthenticatorList Config{..} = catMaybes 32 | [ googleAuthenticator makeCallback <$> configGoogleAuthInfo 33 | , githubAuthenticator makeCallback <$> configGitHubAuthInfo 34 | ] 35 | where 36 | makeCallback :: AuthenticatorName -> URI 37 | makeCallback (AuthenticatorName name) = 38 | let authority = URIAuth "" (unpack configHostname) (":" ++ show configPort) 39 | path = "/auth-callback/" ++ unpack name 40 | in URI "http:" (Just authority) path "" "" 41 | 42 | -- | Get the URL to redirect clients to with the given state to roundtrip 43 | authenticationURLWithState :: OAuth2Authenticator m -> AuthState -> UserAuthURL 44 | authenticationURLWithState authenticator state = 45 | let stateBS = packAuthState state 46 | queryParams = authenticatorAuthQueryParams authenticator 47 | ++ [("state", stateBS)] 48 | config = authenticatorConfig authenticator 49 | in UserAuthURL $ authorizationUrl config `appendQueryParam` queryParams 50 | 51 | packAuthState :: AuthState -> ByteString 52 | packAuthState = toStrict . encode 53 | -------------------------------------------------------------------------------- /backend/src/Hercules/OAuth/Authenticators/GitHub.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 6 | 7 | {-| 8 | GitHub specific OAuth2 functionality 9 | -} 10 | module Hercules.OAuth.Authenticators.GitHub 11 | ( githubAuthenticator 12 | ) where 13 | 14 | import Control.Monad.Log 15 | import Data.Aeson.TH 16 | import Data.Maybe (fromJust) 17 | import Data.Semigroup 18 | import Data.Text hiding (tail) 19 | import Network.HTTP.Client (Manager) 20 | import Network.OAuth.OAuth2 hiding (URI) 21 | import Network.URI 22 | 23 | import Hercules.Config (AuthClientInfo (..)) 24 | import Hercules.Database.Hercules 25 | import Hercules.Encryption 26 | import Hercules.Log 27 | import Hercules.OAuth.Types 28 | import Hercules.OAuth.User 29 | import Hercules.Query.Hercules 30 | import Hercules.ServerEnv 31 | 32 | {-# ANN module ("HLint: Ignore Use CamelCase" :: String) #-} 33 | 34 | 35 | data GitHubUser = 36 | GitHubUser { gid :: Integer 37 | , gname :: Text 38 | , gemail :: Text 39 | } 40 | deriving (Show, Eq) 41 | 42 | deriveJSON defaultOptions{fieldLabelModifier = tail} ''GitHubUser 43 | 44 | githubAuthenticator 45 | :: (AuthenticatorName -> URI) 46 | -> AuthClientInfo 47 | -> OAuth2Authenticator App 48 | githubAuthenticator makeCallback clientInfo = 49 | makeAuthenticator makeCallback 50 | (AuthenticatorName "github") 51 | githubScopeEmail 52 | githubOAuthEndpoint 53 | githubAccessTokenEndpoint 54 | clientInfo 55 | githubGetUserInfo 56 | 57 | githubScopeEmail :: QueryParams 58 | githubScopeEmail = [("scope", "user:email")] 59 | 60 | githubOAuthEndpoint :: OAuthEndpoint 61 | githubOAuthEndpoint = OAuthEndpoint . fromJust . parseURI 62 | $ "https://github.com/login/oauth/authorize" 63 | 64 | githubAccessTokenEndpoint :: AccessTokenEndpoint 65 | githubAccessTokenEndpoint = AccessTokenEndpoint . fromJust . parseURI 66 | $ "https://github.com/login/oauth/access_token" 67 | 68 | githubGetUserInfo :: AccessToken -> App (Either Text UserId) 69 | githubGetUserInfo token = do 70 | withHttpManager (\m -> getUserInfo m token) >>= \case 71 | Left _err -> pure $ Left "Error getting user info" 72 | Right user -> findOrCreateUser user token 73 | 74 | findOrCreateUser :: GitHubUser -> AccessToken -> App (Either Text UserId) 75 | findOrCreateUser user token = do 76 | let textId = pack . show . gid $ user 77 | runHerculesQueryWithConnection (userGitHubIdQuery textId) >>= \case 78 | [] -> createUser user token 79 | [u] -> pure $ Right (UserId (userId (u :: User))) 80 | _ -> pure $ Left "Multiple users with the same id in database!" 81 | 82 | createUser :: GitHubUser -> AccessToken -> App (Either Text UserId) 83 | createUser GitHubUser{..} token = do 84 | encryptedToken <- encrypt (accessToken token) 85 | let user = User () gname gemail (pack . show $ gid) encryptedToken 86 | withHerculesConnection (\c -> insertUser c user) >>= \case 87 | Nothing -> pure $ Left "Error inserting user" 88 | Just i -> do 89 | logInfo (LogString ("Added user " <> gname <> " to database")) 90 | pure $ Right i 91 | 92 | getUserInfo :: Manager -> AccessToken -> IO (OAuth2Result GitHubUser) 93 | getUserInfo manager token = do 94 | authGetJSON manager token "https://api.github.com/user" 95 | -------------------------------------------------------------------------------- /backend/src/Hercules/OAuth/Authenticators/Google.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} 5 | 6 | {-| 7 | Google specific OAuth2 functionality 8 | -} 9 | module Hercules.OAuth.Authenticators.Google 10 | ( googleAuthenticator 11 | ) where 12 | 13 | import Control.Concurrent.Async (concurrently) 14 | import Control.Monad.Except 15 | import Data.Aeson.TH 16 | import Data.Maybe (fromJust) 17 | import Data.Text 18 | import Data.Text.Encoding 19 | import Network.HTTP.Client (Manager) 20 | import Network.OAuth.OAuth2 hiding (URI) 21 | import Network.URI 22 | 23 | import Hercules.Config (AuthClientInfo (..)) 24 | import Hercules.OAuth.Types 25 | import Hercules.OAuth.User 26 | import Hercules.ServerEnv 27 | 28 | {-# ANN module ("HLint: Ignore Use CamelCase" :: String) #-} 29 | 30 | data GoogleToken = GoogleToken 31 | { audience :: Text 32 | , scope :: Text 33 | , userid :: Maybe Text 34 | , expires_in :: Integer 35 | } 36 | deriving (Show) 37 | 38 | deriveJSON defaultOptions ''GoogleToken 39 | 40 | data GoogleUser = GoogleUser 41 | { id :: Text 42 | , email :: Text 43 | , verified_email :: Bool 44 | , name :: Text 45 | } 46 | deriving (Show) 47 | 48 | deriveJSON defaultOptions ''GoogleUser 49 | 50 | googleAuthenticator 51 | :: (AuthenticatorName -> URI) 52 | -> AuthClientInfo 53 | -> OAuth2Authenticator App 54 | googleAuthenticator makeCallback clientInfo = 55 | makeAuthenticator makeCallback 56 | (AuthenticatorName "google") 57 | googleScopeEmail 58 | googleOAuthEndpoint 59 | googleAccessTokenEndpoint 60 | clientInfo 61 | (googleGetUserInfo clientInfo) 62 | 63 | googleOAuthEndpoint :: OAuthEndpoint 64 | googleOAuthEndpoint = OAuthEndpoint . fromJust . parseURI 65 | $ "https://accounts.google.com/o/oauth2/auth" 66 | 67 | googleAccessTokenEndpoint :: AccessTokenEndpoint 68 | googleAccessTokenEndpoint = AccessTokenEndpoint . fromJust . parseURI $ "https://www.googleapis.com/oauth2/v3/token" 69 | 70 | -- | The scope parameter for the users email address 71 | googleScopeEmail :: QueryParams 72 | googleScopeEmail = [("scope", "https://www.googleapis.com/auth/userinfo.email")] 73 | 74 | googleGetUserInfo :: AuthClientInfo -> AccessToken -> App (Either Text UserId) 75 | googleGetUserInfo clientInfo token = do 76 | (tokenInfo', userInfo') <- 77 | withHttpManager (\m -> concurrently (validateToken m token) 78 | (getUserInfo m token)) 79 | 80 | let ourClientId = decodeUtf8 $ authClientInfoId clientInfo 81 | 82 | pure $ do 83 | tokenInfo <- failWith (const "Error getting token info") tokenInfo' 84 | _userInfo <- failWith (const "Error getting user info") userInfo' 85 | when (audience tokenInfo /= ourClientId) $ 86 | throwError "Client id didn't match" 87 | Right (UserId 0) -- TODO fix 88 | 89 | validateToken :: Manager -> AccessToken -> IO (OAuth2Result GoogleToken) 90 | validateToken manager token = parseResponseJSON <$> authGetBS' manager token uri 91 | where uri = "https://www.googleapis.com/oauth2/v2/tokeninfo" 92 | 93 | getUserInfo :: Manager -> AccessToken -> IO (OAuth2Result GoogleUser) 94 | getUserInfo manager token = 95 | authGetJSON manager token "https://www.googleapis.com/oauth2/v2/userinfo" 96 | 97 | failWith :: MonadError e m => (e' -> e) -> Either e' a -> m a 98 | failWith f = \case 99 | Left e -> throwError (f e) 100 | Right x -> pure x 101 | -------------------------------------------------------------------------------- /backend/src/Hercules/OAuth/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE StrictData #-} 7 | 8 | {-| 9 | A module describing some newtypes and data types to handle information used 10 | during authentication. 11 | 12 | Several of these types are just newtypes around URI or Bytestring just to make 13 | passing them round a little safer. 14 | -} 15 | module Hercules.OAuth.Types 16 | ( AuthClientInfo(..) 17 | , OAuth2Authenticator 18 | , makeAuthenticator 19 | , authenticatorName 20 | , authenticatorConfig 21 | , authenticatorAuthQueryParams 22 | , authenticatorGetUserInfo 23 | , AuthState(..) 24 | -- * newtypes 25 | , AuthenticatorName(..) 26 | , AuthClientState(..) 27 | , AuthCode(..) 28 | , AuthError(..) 29 | , AuthStatePacked(..) 30 | , UserAuthURL(..) 31 | , OAuthEndpoint(..) 32 | , AccessTokenEndpoint(..) 33 | , FrontendURL(..) 34 | , PackedJWT(..) 35 | ) where 36 | 37 | import Data.Aeson 38 | import Data.ByteString.Char8 39 | import Data.Text (Text) 40 | import GHC.Generics (Generic) 41 | import Network.OAuth.OAuth2 hiding (URI) 42 | import Network.URI.Extra 43 | import Servant (FromHttpApiData) 44 | 45 | import Hercules.OAuth.User 46 | 47 | -- | The name of an authenticator, "google" or "github" for example 48 | newtype AuthenticatorName = AuthenticatorName 49 | { unAuthenticatorName :: Text } 50 | deriving (Eq, FromHttpApiData) 51 | 52 | -- | The state the client can pass when authenticating, this will be returned 53 | -- if the authentication is successful. 54 | newtype AuthClientState = AuthClientState 55 | { unAuthClientState :: Text } 56 | deriving (ToJSON, FromJSON, Show, FromHttpApiData) 57 | 58 | -- | This is the value which is actually sent to the authenticator. It's a 59 | -- combination of the users data and some unique state generated on the server 60 | -- which is checked upon completion of the authentication to prevent CSRF 61 | -- attacks. 62 | data AuthState = AuthState 63 | { authStateFrontendURL :: FrontendURL 64 | , authStateClientState :: Maybe AuthClientState 65 | } 66 | deriving (Generic, Show) 67 | 68 | instance ToJSON AuthState where 69 | instance FromJSON AuthState where 70 | 71 | newtype AuthStatePacked = AuthStatePacked 72 | { unAuthStatePacked :: Text } 73 | deriving (FromHttpApiData, Show) 74 | 75 | newtype FrontendURL = FrontendURL 76 | { unFrontendURL :: Text } 77 | deriving (ToJSON, FromJSON, Show, FromHttpApiData) 78 | 79 | newtype AuthCode = AuthCode 80 | { unAuthCode :: Text } 81 | deriving (FromHttpApiData) 82 | 83 | newtype AuthError = AuthError 84 | { unAuthError :: Text } 85 | deriving (FromHttpApiData) 86 | 87 | newtype OAuthEndpoint = OAuthEndpoint 88 | { unOAuthEndpoint :: URI } 89 | 90 | newtype AccessTokenEndpoint = AccessTokenEndpoint 91 | { unAccessTokenEndpoint :: URI} 92 | 93 | -- | A URL to redirect the user to in order for them to authenticate themselves 94 | newtype UserAuthURL = UserAuthURL 95 | { unUserAuthURL :: ByteString } 96 | 97 | newtype PackedJWT = PackedJWT 98 | { unPackedJWT :: ByteString } 99 | 100 | -- | The Id and secret for a client on an external service 101 | data AuthClientInfo = AuthClientInfo 102 | { authClientInfoId :: ByteString 103 | , authClientInfoSecret :: ByteString 104 | } 105 | deriving(Read, Show) 106 | 107 | instance FromJSON AuthClientInfo where 108 | parseJSON = withObject "AuthClientInfo" (\v -> 109 | AuthClientInfo <$> (pack <$> v .: "id") 110 | <*> (pack <$> v .: "secret")) 111 | 112 | -- | A collection of all the information necessary to authenticate with a 113 | -- provider 114 | -- 115 | -- One should use 'makeAuthenticator' to construct values of this type as the 116 | -- config and name must remain in sync. 117 | -- 118 | -- The authentication validation takes place in the monad 'm' 119 | data OAuth2Authenticator m = OAuth2Authenticator 120 | { authenticatorName :: AuthenticatorName 121 | , authenticatorConfig :: OAuth2 122 | , authenticatorAuthQueryParams :: QueryParams 123 | , authenticatorGetUserInfo :: AccessToken -> m (Either Text UserId) 124 | } 125 | 126 | -- | Construct an 'OAuth2Authenticator' 127 | makeAuthenticator 128 | :: (AuthenticatorName -> URI) 129 | -- ^ A function to make the callback URI for the named authenticator 130 | -> AuthenticatorName 131 | -- ^ The name of this authenticator 132 | -> QueryParams 133 | -- ^ Any additional query params this authenticator requires 134 | -> OAuthEndpoint 135 | -> AccessTokenEndpoint 136 | -> AuthClientInfo 137 | -> (AccessToken -> m (Either Text UserId)) 138 | -> OAuth2Authenticator m 139 | makeAuthenticator makeCallback name queryParams 140 | authEndpoint accessTokenEndpoint AuthClientInfo{..} 141 | getUserInfo = 142 | OAuth2Authenticator { authenticatorName = name 143 | , authenticatorConfig = config 144 | , authenticatorAuthQueryParams = queryParams 145 | , authenticatorGetUserInfo = getUserInfo 146 | } 147 | where 148 | config :: OAuth2 149 | config = OAuth2 150 | { oauthClientId = authClientInfoId 151 | , oauthClientSecret = authClientInfoSecret 152 | , oauthCallback = Just . uriToByteString . makeCallback $ name 153 | , oauthOAuthorizeEndpoint = 154 | uriToByteString . unOAuthEndpoint $ authEndpoint 155 | , oauthAccessTokenEndpoint = 156 | uriToByteString . unAccessTokenEndpoint $ accessTokenEndpoint 157 | } 158 | 159 | -------------------------------------------------------------------------------- /backend/src/Hercules/OAuth/User.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE StrictData #-} 3 | 4 | {-| 5 | This module describes a data type and functions for dealing with authenticated 6 | users. 7 | -} 8 | module Hercules.OAuth.User 9 | ( UserId(..) 10 | ) where 11 | 12 | import Data.Aeson 13 | import Data.Int 14 | import GHC.Generics (Generic) 15 | import Servant.Auth.Server 16 | 17 | newtype UserId = UserId 18 | { unUserId :: Int64 } 19 | deriving(Show, Generic) 20 | 21 | instance ToJSON UserId 22 | instance ToJWT UserId 23 | instance FromJSON UserId 24 | instance FromJWT UserId 25 | -------------------------------------------------------------------------------- /backend/src/Hercules/Query/Hercules.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE NamedFieldPuns #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | {-| 7 | A module to handle the different queries we might want to make to Hercules's 8 | database 9 | -} 10 | module Hercules.Query.Hercules 11 | ( userIdQuery 12 | , userGitHubIdQuery 13 | , insertUser 14 | ) where 15 | 16 | import Control.Arrow (returnA) 17 | import Data.ByteString 18 | import Data.Text 19 | import Database.PostgreSQL.Simple (Connection) 20 | import Opaleye.Extra 21 | 22 | import Hercules.Database.Hercules 23 | import Hercules.OAuth.User 24 | 25 | -- | A query to get a user from their id 26 | userIdQuery :: UserId -> Query UserReadColumns 27 | userIdQuery (UserId uid) = proc () -> do 28 | user@User{..} <- queryTable userTable -< () 29 | restrict -< pgInt8 uid .== userId 30 | returnA -< user 31 | 32 | -- | A query to get a user by their github id 33 | userGitHubIdQuery :: Text -> Query UserReadColumns 34 | userGitHubIdQuery githubId = proc () -> do 35 | user@User{..} <- queryTable userTable -< () 36 | restrict -< pgStrictText githubId `eqNullable` userGithubId 37 | returnA -< user 38 | 39 | insertUser :: Connection -> User' a Text Text Text ByteString -> IO (Maybe UserId) 40 | insertUser c User {userName 41 | ,userEmail 42 | ,userGithubId 43 | ,userGithubToken} = 44 | let user = 45 | User 46 | Nothing 47 | (Just (toNullable (pgStrictText userName))) 48 | (Just (toNullable (pgStrictText userEmail))) 49 | (Just (toNullable (pgStrictText userGithubId))) 50 | (Just (toNullable (pgStrictByteString userGithubToken))) 51 | in runInsertManyReturning c userTable [user] userId >>= 52 | \case 53 | [i] -> pure $ Just (UserId i) 54 | _ -> pure Nothing 55 | -------------------------------------------------------------------------------- /backend/src/Hercules/Query/Hydra.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {-| 5 | A module to handle the different queries we might want to make to Hydra's 6 | database 7 | -} 8 | module Hercules.Query.Hydra 9 | ( projectNameQuery 10 | , projectQuery 11 | , projectsQuery 12 | , projectsWithJobsetsQuery 13 | ) where 14 | 15 | import Control.Arrow (returnA) 16 | import Data.Text 17 | import Opaleye 18 | 19 | import Hercules.Database.Hydra 20 | 21 | -- | A query to get a list of all the project names 22 | projectNameQuery :: Query (Column PGText) 23 | projectNameQuery = proc () -> do 24 | Project{..} <- queryTable projectTable -< () 25 | returnA -< projectName 26 | 27 | -- | A query to get a list of all the projects 28 | projectsQuery :: Query ProjectReadColumns 29 | projectsQuery = queryTable projectTable 30 | 31 | -- | A query to get all the projects with the specified name (There should be 32 | -- only one) 33 | projectQuery :: Text -> Query ProjectReadColumns 34 | projectQuery name = proc () -> do 35 | project@Project{..} <- queryTable projectTable -< () 36 | restrict -< projectName .== pgStrictText name 37 | returnA -< project 38 | 39 | -- | A query to get a list of all the jobsets 40 | jobsetsQuery :: Query JobsetReadColumns 41 | jobsetsQuery = queryTable jobsetTable 42 | 43 | projectsWithJobsetsQuery 44 | :: Query (ProjectReadColumns, JobsetNullableColumns) 45 | projectsWithJobsetsQuery = leftJoin projectsQuery jobsetsQuery eqName 46 | where 47 | eqName (Project{..}, Jobset{..}) = projectName .== jobsetProject 48 | -------------------------------------------------------------------------------- /backend/src/Hercules/ServerEnv.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE ScopedTypeVariables #-} 7 | {-# LANGUAGE StrictData #-} 8 | 9 | module Hercules.ServerEnv 10 | ( Env(..) 11 | , App(..) 12 | , runApp 13 | , runAppWithConfig 14 | , newEnv 15 | , runHerculesQueryWithConnection 16 | , runHerculesQueryWithConnectionSingular 17 | , runHydraQueryWithConnection 18 | , withHerculesConnection 19 | , withHttpManager 20 | , getAuthenticator 21 | , makeUserJWT 22 | , getHostAndPort 23 | , HerculesCipher 24 | ) where 25 | 26 | import Control.Monad.Except.Extra 27 | import Control.Monad.Log 28 | import Control.Monad.Reader 29 | import Crypto.Cipher.AES 30 | import Crypto.Cipher.Types 31 | import Crypto.Error 32 | import Crypto.JOSE.Error 33 | import Crypto.Random.Entropy 34 | import Data.ByteString.Extra as BS (readFileMaybe, writeFile, ByteString) 35 | import Data.ByteString.Lazy (toStrict) 36 | import Data.List (find) 37 | import Data.Maybe (fromMaybe) 38 | import Data.Pool 39 | import Data.Profunctor.Product.Default (Default) 40 | import Data.Semigroup 41 | import Data.String (fromString) 42 | import Data.Text (Text, pack) 43 | import Data.Text.Encoding (encodeUtf8) 44 | import Data.Time.Format 45 | import Data.Yaml 46 | import Database.PostgreSQL.Simple (Connection, close, connectPostgreSQL) 47 | import Network.HTTP.Client as HTTP 48 | import Network.HTTP.Client.TLS 49 | import Opaleye (Query, QueryRunner, Unpackspec, 50 | runQuery, showSql) 51 | import Say 52 | import Servant (ServantErr) 53 | import Servant.Auth.Server (JWTSettings, defaultJWTSettings, 54 | generateKey, makeJWT) 55 | 56 | import Hercules.Config 57 | import Hercules.Database.Hercules.Migration 58 | import Hercules.Log 59 | import Hercules.OAuth.Types (AuthenticatorName, 60 | OAuth2Authenticator, 61 | PackedJWT (..), authenticatorName) 62 | import Hercules.OAuth.User 63 | import Network.Wai.Handler.Warp (Port) 64 | 65 | {-# ANN module ("HLint: ignore Avoid lambda" :: String) #-} 66 | 67 | data Env = Env { envHerculesConnectionPool :: Pool Connection 68 | , envHydraConnectionPool :: Pool Connection 69 | , envHttpManager :: HTTP.Manager 70 | , envAuthenticators :: [OAuth2Authenticator App] 71 | , envJWTSettings :: JWTSettings 72 | , envCipher :: HerculesCipher 73 | , envPort :: Port 74 | , envHostname :: HostName 75 | } 76 | 77 | -- | The cipher Hercues uses for encrypting the github access tokens 78 | type HerculesCipher = AES256 79 | 80 | newtype App a = App 81 | { unApp :: ReaderT Env (ExceptT ServantErr (LogM (WithSeverity LogMessage) IO)) a 82 | } 83 | deriving ( Functor 84 | , Applicative 85 | , Monad 86 | , MonadError ServantErr 87 | , MonadIO 88 | , MonadLog (WithSeverity LogMessage) 89 | , MonadReader Env 90 | ) 91 | 92 | -- | Perform an action with a PostgreSQL connection to the Hercules DB and 93 | -- return the result 94 | withHerculesConnection :: (Connection -> IO a) -> App a 95 | withHerculesConnection f = do 96 | connectionPool <- asks envHerculesConnectionPool 97 | liftIO $ withResource connectionPool f 98 | 99 | -- | Perform an action with a PostgreSQL connection to the Hydra DB and return 100 | -- the result 101 | withHydraConnection :: (Connection -> IO a) -> App a 102 | withHydraConnection f = do 103 | connectionPool <- asks envHydraConnectionPool 104 | liftIO $ withResource connectionPool f 105 | 106 | withHttpManager :: (HTTP.Manager -> IO a) -> App a 107 | withHttpManager f = do 108 | manager <- asks envHttpManager 109 | liftIO $ f manager 110 | 111 | getAuthenticator :: AuthenticatorName -> App (Maybe (OAuth2Authenticator App)) 112 | getAuthenticator name = 113 | find ((== name) . authenticatorName) <$> asks envAuthenticators 114 | 115 | makeUserJWT :: UserId -> App (Either Error PackedJWT) 116 | makeUserJWT user = do 117 | jwtSettings <- asks envJWTSettings 118 | liftIO $ fmap (PackedJWT . toStrict) <$> makeJWT user jwtSettings Nothing 119 | 120 | -- | Evaluate a query in an 'App' value 121 | runHerculesQueryWithConnection 122 | :: Default QueryRunner columns haskells 123 | => Default Unpackspec columns columns 124 | => Query columns -> App [haskells] 125 | runHerculesQueryWithConnection q = do 126 | logQuery q 127 | withHerculesConnection (\c -> runQuery c q) 128 | 129 | -- | Evaluate a query in an 'App' value returning a singular result 130 | runHerculesQueryWithConnectionSingular 131 | :: Default QueryRunner columns haskells 132 | => Default Unpackspec columns columns => 133 | Query columns -> App (Maybe haskells) 134 | runHerculesQueryWithConnectionSingular q = 135 | runHerculesQueryWithConnection q >>= 136 | \case 137 | [] -> pure Nothing 138 | [x] -> pure $ Just x 139 | _ -> do 140 | logError "Singular query returned multiple results" 141 | pure Nothing 142 | 143 | -- | Evaluate a query in an 'App' value 144 | runHydraQueryWithConnection 145 | :: Default QueryRunner columns haskells 146 | => Default Unpackspec columns columns 147 | => Query columns -> App [haskells] 148 | runHydraQueryWithConnection q = do 149 | logQuery q 150 | withHydraConnection (\c -> runQuery c q) 151 | 152 | logQuery 153 | :: Default Unpackspec columns columns 154 | => Query columns 155 | -> App () 156 | logQuery q = 157 | let s = fromMaybe "Empty query" $ showSql q 158 | in logDebug (fromString s) 159 | 160 | runApp :: Env -> App a -> ExceptT ServantErr IO a 161 | runApp env = mapExceptT runLog 162 | . flip runReaderT env 163 | . unApp 164 | where 165 | runLog :: LogM (WithSeverity LogMessage) IO a -> IO a 166 | runLog = (`runLoggingT` printMessage) . mapLogMessageM timestamp 167 | printMessage :: WithTimestamp (WithSeverity LogMessage) -> IO () 168 | printMessage = print . renderWithTimestamp renderTime (renderWithSeverity render) 169 | renderTime = formatTime defaultTimeLocale "%b %_d %H:%M:%S" 170 | 171 | -- | Get a pool of connections to the Hercules database. Return 'Nothing' if the 172 | -- schema can't be updated to the correct one. 173 | getHerculesConnection :: MonadIO m => Config -> m (Maybe (Pool Connection)) 174 | getHerculesConnection Config{..} = liftIO $ do 175 | herculesConnection <- createPool 176 | (connectPostgreSQL (encodeUtf8 configHerculesConnectionString)) 177 | close 178 | 4 10 4 179 | withResource herculesConnection (readyDatabase Quiet) >>= \case 180 | MigrationError s -> do 181 | sayErr ("Error migrating hercules database: " <> s) 182 | pure Nothing 183 | MigrationSuccess -> pure (Just herculesConnection) 184 | 185 | -- | Load the key from the secret key file if it exists or create one. 186 | getCipher :: MonadIO m => Config -> m (Maybe HerculesCipher) 187 | getCipher Config{..} = liftIO $ do 188 | sayErr ("Trying to open key at: " <> pack configSecretKeyFile) 189 | key <- readFileMaybe configSecretKeyFile >>= \case 190 | Nothing -> do 191 | sayErr ("Unable to open secret key file: " <> pack configSecretKeyFile) 192 | bytes <- generateNewKey 193 | sayErr ("Store generated key in file: " <> pack configSecretKeyFile) 194 | BS.writeFile configSecretKeyFile bytes 195 | pure bytes 196 | Just key -> pure key 197 | 198 | case cipherInit key of 199 | CryptoFailed e -> do 200 | sayErr ("Unable to create cipher" <> pack (show e)) 201 | pure Nothing 202 | CryptoPassed cipher -> pure (Just cipher) 203 | 204 | -- | Generate random data to build an encryption key. 205 | -- Use system Pseudo-Random-Number-Generator. 206 | generateNewKey :: IO BS.ByteString 207 | generateNewKey = do 208 | let herculeCipherBlockSize = blockSize (undefined :: HerculesCipher) 209 | let herculeCipherKeySize = case cipherKeySize (undefined :: HerculesCipher) of 210 | KeySizeFixed value -> value 211 | KeySizeEnum values -> maximum values 212 | KeySizeRange _ maxValue -> maxValue 213 | sayErr ("Cipher name: " <> pack (show (cipherName (undefined :: HerculesCipher)))) 214 | sayErr ("Cipher block size: " <> pack (show herculeCipherBlockSize)) 215 | sayErr ("Cipher key size: " <> pack (show herculeCipherKeySize)) 216 | bytes <- getEntropy herculeCipherKeySize 217 | pure bytes 218 | 219 | -- | Get the hostname and port for this server separated by a colon 220 | -- 221 | -- >>> getHostAndPort 222 | -- "localhost:8080" 223 | getHostAndPort :: App Text 224 | getHostAndPort = do 225 | hostname <- asks envHostname 226 | port <- asks envPort 227 | pure $ hostname <> ":" <> (pack . show $ port) 228 | 229 | newEnv :: MonadIO m => Config -> [OAuth2Authenticator App] -> m (Maybe Env) 230 | newEnv c@Config{..} authenticators = 231 | getHerculesConnection c >>= \case 232 | Nothing -> pure Nothing 233 | Just herculesConnection -> liftIO $ do 234 | hydraConnection <- createPool 235 | (connectPostgreSQL (encodeUtf8 configHydraConnectionString)) 236 | close 237 | 4 10 4 238 | httpManager <- newManager tlsManagerSettings 239 | key <- liftIO generateKey 240 | let jwtSettings = defaultJWTSettings key 241 | getCipher c >>= \case 242 | Nothing -> pure Nothing 243 | Just cipher -> 244 | pure . Just $ Env 245 | herculesConnection 246 | hydraConnection 247 | httpManager 248 | authenticators 249 | jwtSettings 250 | cipher 251 | configPort 252 | configHostname 253 | 254 | -- | Load a yaml configuration and run an 'App' value, useful for testing in 255 | -- the REPL. 256 | runAppWithConfig :: FilePath -> App a -> IO a 257 | runAppWithConfig yaml m = 258 | decodeFileEither yaml >>= \case 259 | Left err -> error (prettyPrintParseException err) 260 | Right config -> 261 | newEnv config [] >>= \case 262 | Nothing -> error "Can't create env" 263 | Just env -> 264 | runExceptT (runApp env m) >>= \case 265 | Left err -> error (show err) 266 | Right x -> pure x 267 | -------------------------------------------------------------------------------- /backend/src/Hercules/Static.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE QuasiQuotes #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | {-| 7 | This module describes some static pages being used for testing. 8 | -} 9 | module Hercules.Static 10 | ( welcomePage 11 | , loginPage 12 | , loggedInPage 13 | , userInfoPage 14 | ) where 15 | 16 | 17 | import Control.Monad.Except.Extra 18 | import Control.Monad.Log 19 | import Data.Foldable (toList) 20 | import Data.Maybe 21 | import Data.Semigroup 22 | import Data.Text as T 23 | import GitHub.Endpoints.Repos as GH hiding (User) 24 | import GitHub.Request 25 | import Network.URI 26 | import Servant 27 | import Servant.Redirect 28 | import Text.Blaze.Html (Html) 29 | import Text.InterpolatedString.Perl6 30 | import Text.Markdown (defaultMarkdownSettings, markdown) 31 | 32 | import Hercules.Database.Hercules 33 | import Hercules.Encryption 34 | import Hercules.Log 35 | import Hercules.OAuth.Authenticators 36 | import Hercules.OAuth.Types 37 | import Hercules.OAuth.User 38 | import Hercules.Query.Hercules 39 | import Hercules.ServerEnv 40 | 41 | welcomePage :: App Html 42 | welcomePage = do 43 | hostAndPort <- getHostAndPort 44 | let stateString = "my state" 45 | frontendURL :: Text 46 | frontendURL = "http://" <> hostAndPort <> "/logged-in" 47 | uriGoogle, uriGitHub :: Text 48 | uriGoogle = [qc|/login/google?state={escapeURIString isUnescapedInURIComponent stateString}&frontendURL={frontendURL}|] 49 | uriGitHub = [qc|/login/github?state={escapeURIString isUnescapedInURIComponent stateString}&frontendURL={frontendURL}|] 50 | pure $ markdown defaultMarkdownSettings [qc| 51 | # Login Page 52 | 53 | ## Parameters 54 | 55 | - state: `{stateString}` 56 | - frontendURL: `{frontendURL}` 57 | 58 | ## links: 59 | 60 | - [google]({uriGoogle}) 61 | - [github]({uriGitHub}) 62 | |] 63 | 64 | loggedInPage :: Maybe Text -> App Html 65 | loggedInPage jwt = 66 | pure $ markdown defaultMarkdownSettings [qc| 67 | # Logged in! 68 | 69 | JWT: `{jwt}` 70 | |] 71 | 72 | -- | This is a redirect for authenticating with google with the given user 73 | -- state. 74 | loginPage :: AuthenticatorName -> Maybe AuthClientState -> FrontendURL -> App a 75 | loginPage name stateString frontendURL = do 76 | state <- makeState frontendURL stateString 77 | authenticator <- failWithM err404 (getAuthenticator name) 78 | let authURL = authenticationURLWithState authenticator state 79 | redirectBS (unUserAuthURL authURL) 80 | 81 | makeState :: FrontendURL -> Maybe AuthClientState -> App AuthState 82 | makeState frontendURL = pure . AuthState frontendURL 83 | 84 | userInfoPage :: UserId -> App Html 85 | userInfoPage uid = 86 | runHerculesQueryWithConnectionSingular (userIdQuery uid) >>= \case 87 | Nothing -> pure $ noUserHtml uid 88 | Just u -> reposHtml u 89 | 90 | reposHtml :: User -> App Html 91 | reposHtml User{..} = do 92 | logInfo (LogString ("Showing repos for " <> fromMaybe "unnamed user" userName)) 93 | case userGithubToken of 94 | Nothing -> 95 | pure $ markdown defaultMarkdownSettings [qc| 96 | # No github login for user 97 | |] 98 | Just encryptedToken -> do 99 | token <- GH.OAuth <$> decrypt encryptedToken 100 | let repoRequest = currentUserReposR RepoPublicityAll FetchAll 101 | withHttpManager 102 | (\mgr -> executeRequestWithMgr mgr token repoRequest) >>= \case 103 | Left err -> 104 | pure $ markdown defaultMarkdownSettings [qc| 105 | # Error getting repo list 106 | 107 | {err}|] 108 | Right repos -> 109 | pure $ markdown defaultMarkdownSettings [qc| 110 | # Repos for {fromMaybe "Unnamed user" userName} 111 | {T.unlines . toList . fmap repoLine $ repos}|] 112 | 113 | repoLine :: Repo -> Text 114 | repoLine Repo{..} = [qc|- [{untagName repoName}]({getUrl repoHtmlUrl})|] 115 | 116 | noUserHtml :: UserId -> Html 117 | noUserHtml uid = markdown defaultMarkdownSettings [qc| 118 | No user with id `{uid}` 119 | |] 120 | -------------------------------------------------------------------------------- /backend/src/Hercules/Swagger.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {-# OPTIONS_GHC -fno-warn-orphans #-} 6 | 7 | module Hercules.Swagger 8 | ( swaggerDoc 9 | ) where 10 | 11 | import Control.Lens hiding ((.=)) 12 | import Data.Proxy 13 | import Data.Swagger 14 | import Servant.Auth.Swagger () 15 | import Servant.Swagger 16 | 17 | import Hercules.API (QueryAPI) 18 | import Hercules.Database.Extra 19 | 20 | instance ToSchema Project where 21 | instance ToSchema Jobset where 22 | instance ToSchema ProjectWithJobsets where 23 | 24 | swaggerDoc :: Swagger 25 | swaggerDoc = toSwagger (Proxy :: Proxy QueryAPI) 26 | & info.title .~ "Hercules CI API" 27 | & info.version .~ "1.0" 28 | & info.description ?~ "" 29 | -------------------------------------------------------------------------------- /backend/src/Network/URI/Extra.hs: -------------------------------------------------------------------------------- 1 | module Network.URI.Extra 2 | ( uriToByteString 3 | , module Network.URI 4 | ) where 5 | 6 | import Data.ByteString.Char8 7 | import Network.URI 8 | 9 | uriToByteString :: URI -> ByteString 10 | uriToByteString = pack . ($ "") . uriToString id 11 | -------------------------------------------------------------------------------- /backend/src/Opaleye/Extra.hs: -------------------------------------------------------------------------------- 1 | module Opaleye.Extra 2 | ( module Opaleye 3 | , eqNullable 4 | ) where 5 | 6 | import Opaleye 7 | 8 | -- | Returns false when the second input is nullable 9 | eqNullable :: Column a -> Column (Nullable a) -> Column PGBool 10 | eqNullable a = matchNullable (pgBool False) (a .==) 11 | -------------------------------------------------------------------------------- /backend/src/Servant/Mandatory.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | 4 | module Servant.Mandatory 5 | ( mandatory1 6 | , mandatory2 7 | ) where 8 | 9 | import Control.Monad.Except 10 | import Data.Maybe (fromMaybe) 11 | import Servant 12 | 13 | -- | Throw 'err400' if the parameter is missing 14 | mandatory1 :: MonadError ServantErr f => (a -> f b) -> Maybe a -> f b 15 | -- mandatory1 f x = case x of 16 | -- Nothing -> throwError err400 17 | -- Just x -> f x 18 | mandatory1 f a = fromMaybe (throwError err400) (f <$> a) 19 | 20 | -- | Throw 'err400' if either parameter is missing 21 | mandatory2 :: MonadError ServantErr f => (a -> b -> f c) -> Maybe a -> Maybe b -> f c 22 | mandatory2 f a b = fromMaybe (throwError err400) (f <$> a <*> b) 23 | 24 | -------------------------------------------------------------------------------- /backend/src/Servant/Redirect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Servant.Redirect 4 | ( redirect 5 | , redirectBS 6 | ) where 7 | 8 | import Control.Monad.Except 9 | import Data.ByteString 10 | import Network.URI 11 | import Network.URI.Extra 12 | import Servant.Server 13 | 14 | import Hercules.ServerEnv 15 | 16 | redirectBS :: ByteString -> App a 17 | redirectBS uri = throwError err303 { errHeaders = [("Location", uri)] } 18 | 19 | redirect :: URI -> App a 20 | redirect = redirectBS . uriToByteString 21 | 22 | -------------------------------------------------------------------------------- /backend/src/migrations/create-users.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE users( 2 | id bigserial PRIMARY KEY NOT NULL, 3 | name text, 4 | email text UNIQUE, 5 | github_id text UNIQUE, 6 | github_token bytea UNIQUE 7 | ); 8 | -------------------------------------------------------------------------------- /backend/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? (import ./pkgs.nix) {}}: 2 | 3 | rec { 4 | backend = import ./backend/default.nix { inherit pkgs; }; 5 | frontend = import ./frontend/default.nix { inherit pkgs backend; }; 6 | docs = import ./docs/default.nix { inherit pkgs backend; }; 7 | } 8 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line. 5 | SPHINXOPTS = 6 | SPHINXBUILD = sphinx-build 7 | PAPER = 8 | BUILDDIR = _build 9 | 10 | # Internal variables. 11 | PAPEROPT_a4 = -D latex_paper_size=a4 12 | PAPEROPT_letter = -D latex_paper_size=letter 13 | ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) . 14 | # the i18n builder cannot share the environment and doctrees with the others 15 | I18NSPHINXOPTS = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) . 16 | 17 | .PHONY: help 18 | help: 19 | @echo "Please use \`make ' where is one of" 20 | @echo " html to make standalone HTML files" 21 | @echo " dirhtml to make HTML files named index.html in directories" 22 | @echo " singlehtml to make a single large HTML file" 23 | @echo " pickle to make pickle files" 24 | @echo " json to make JSON files" 25 | @echo " htmlhelp to make HTML files and a HTML help project" 26 | @echo " qthelp to make HTML files and a qthelp project" 27 | @echo " applehelp to make an Apple Help Book" 28 | @echo " devhelp to make HTML files and a Devhelp project" 29 | @echo " epub to make an epub" 30 | @echo " epub3 to make an epub3" 31 | @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter" 32 | @echo " latexpdf to make LaTeX files and run them through pdflatex" 33 | @echo " latexpdfja to make LaTeX files and run them through platex/dvipdfmx" 34 | @echo " text to make text files" 35 | @echo " man to make manual pages" 36 | @echo " texinfo to make Texinfo files" 37 | @echo " info to make Texinfo files and run them through makeinfo" 38 | @echo " gettext to make PO message catalogs" 39 | @echo " changes to make an overview of all changed/added/deprecated items" 40 | @echo " xml to make Docutils-native XML files" 41 | @echo " pseudoxml to make pseudoxml-XML files for display purposes" 42 | @echo " linkcheck to check all external links for integrity" 43 | @echo " doctest to run all doctests embedded in the documentation (if enabled)" 44 | @echo " coverage to run coverage check of the documentation (if enabled)" 45 | @echo " dummy to check syntax errors of document sources" 46 | 47 | .PHONY: clean 48 | clean: 49 | rm -rf $(BUILDDIR)/* 50 | 51 | .PHONY: html 52 | html: 53 | $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html 54 | @echo 55 | @echo "Build finished. The HTML pages are in $(BUILDDIR)/html." 56 | 57 | .PHONY: dirhtml 58 | dirhtml: 59 | $(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml 60 | @echo 61 | @echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml." 62 | 63 | .PHONY: singlehtml 64 | singlehtml: 65 | $(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml 66 | @echo 67 | @echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml." 68 | 69 | .PHONY: pickle 70 | pickle: 71 | $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle 72 | @echo 73 | @echo "Build finished; now you can process the pickle files." 74 | 75 | .PHONY: json 76 | json: 77 | $(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json 78 | @echo 79 | @echo "Build finished; now you can process the JSON files." 80 | 81 | .PHONY: htmlhelp 82 | htmlhelp: 83 | $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp 84 | @echo 85 | @echo "Build finished; now you can run HTML Help Workshop with the" \ 86 | ".hhp project file in $(BUILDDIR)/htmlhelp." 87 | 88 | .PHONY: qthelp 89 | qthelp: 90 | $(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp 91 | @echo 92 | @echo "Build finished; now you can run "qcollectiongenerator" with the" \ 93 | ".qhcp project file in $(BUILDDIR)/qthelp, like this:" 94 | @echo "# qcollectiongenerator $(BUILDDIR)/qthelp/Hercules.qhcp" 95 | @echo "To view the help file:" 96 | @echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Hercules.qhc" 97 | 98 | .PHONY: applehelp 99 | applehelp: 100 | $(SPHINXBUILD) -b applehelp $(ALLSPHINXOPTS) $(BUILDDIR)/applehelp 101 | @echo 102 | @echo "Build finished. The help book is in $(BUILDDIR)/applehelp." 103 | @echo "N.B. You won't be able to view it unless you put it in" \ 104 | "~/Library/Documentation/Help or install it in your application" \ 105 | "bundle." 106 | 107 | .PHONY: devhelp 108 | devhelp: 109 | $(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp 110 | @echo 111 | @echo "Build finished." 112 | @echo "To view the help file:" 113 | @echo "# mkdir -p $$HOME/.local/share/devhelp/Hercules" 114 | @echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/Hercules" 115 | @echo "# devhelp" 116 | 117 | .PHONY: epub 118 | epub: 119 | $(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub 120 | @echo 121 | @echo "Build finished. The epub file is in $(BUILDDIR)/epub." 122 | 123 | .PHONY: epub3 124 | epub3: 125 | $(SPHINXBUILD) -b epub3 $(ALLSPHINXOPTS) $(BUILDDIR)/epub3 126 | @echo 127 | @echo "Build finished. The epub3 file is in $(BUILDDIR)/epub3." 128 | 129 | .PHONY: latex 130 | latex: 131 | $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex 132 | @echo 133 | @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex." 134 | @echo "Run \`make' in that directory to run these through (pdf)latex" \ 135 | "(use \`make latexpdf' here to do that automatically)." 136 | 137 | .PHONY: latexpdf 138 | latexpdf: 139 | $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex 140 | @echo "Running LaTeX files through pdflatex..." 141 | $(MAKE) -C $(BUILDDIR)/latex all-pdf 142 | @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex." 143 | 144 | .PHONY: latexpdfja 145 | latexpdfja: 146 | $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex 147 | @echo "Running LaTeX files through platex and dvipdfmx..." 148 | $(MAKE) -C $(BUILDDIR)/latex all-pdf-ja 149 | @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex." 150 | 151 | .PHONY: text 152 | text: 153 | $(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text 154 | @echo 155 | @echo "Build finished. The text files are in $(BUILDDIR)/text." 156 | 157 | .PHONY: man 158 | man: 159 | $(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man 160 | @echo 161 | @echo "Build finished. The manual pages are in $(BUILDDIR)/man." 162 | 163 | .PHONY: texinfo 164 | texinfo: 165 | $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo 166 | @echo 167 | @echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo." 168 | @echo "Run \`make' in that directory to run these through makeinfo" \ 169 | "(use \`make info' here to do that automatically)." 170 | 171 | .PHONY: info 172 | info: 173 | $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo 174 | @echo "Running Texinfo files through makeinfo..." 175 | make -C $(BUILDDIR)/texinfo info 176 | @echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo." 177 | 178 | .PHONY: gettext 179 | gettext: 180 | $(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale 181 | @echo 182 | @echo "Build finished. The message catalogs are in $(BUILDDIR)/locale." 183 | 184 | .PHONY: changes 185 | changes: 186 | $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes 187 | @echo 188 | @echo "The overview file is in $(BUILDDIR)/changes." 189 | 190 | .PHONY: linkcheck 191 | linkcheck: 192 | $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck 193 | @echo 194 | @echo "Link check complete; look for any errors in the above output " \ 195 | "or in $(BUILDDIR)/linkcheck/output.txt." 196 | 197 | .PHONY: doctest 198 | doctest: 199 | $(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest 200 | @echo "Testing of doctests in the sources finished, look at the " \ 201 | "results in $(BUILDDIR)/doctest/output.txt." 202 | 203 | .PHONY: coverage 204 | coverage: 205 | $(SPHINXBUILD) -b coverage $(ALLSPHINXOPTS) $(BUILDDIR)/coverage 206 | @echo "Testing of coverage in the sources finished, look at the " \ 207 | "results in $(BUILDDIR)/coverage/python.txt." 208 | 209 | .PHONY: xml 210 | xml: 211 | $(SPHINXBUILD) -b xml $(ALLSPHINXOPTS) $(BUILDDIR)/xml 212 | @echo 213 | @echo "Build finished. The XML files are in $(BUILDDIR)/xml." 214 | 215 | .PHONY: pseudoxml 216 | pseudoxml: 217 | $(SPHINXBUILD) -b pseudoxml $(ALLSPHINXOPTS) $(BUILDDIR)/pseudoxml 218 | @echo 219 | @echo "Build finished. The pseudo-XML files are in $(BUILDDIR)/pseudoxml." 220 | 221 | .PHONY: dummy 222 | dummy: 223 | $(SPHINXBUILD) -b dummy $(ALLSPHINXOPTS) $(BUILDDIR)/dummy 224 | @echo 225 | @echo "Build finished. Dummy builder generates no files." 226 | -------------------------------------------------------------------------------- /docs/conf.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | # -*- coding: utf-8 -*- 3 | # 4 | # Hercules documentation build configuration file, created by 5 | # sphinx-quickstart on Thu Jan 5 19:53:43 2017. 6 | # 7 | # This file is execfile()d with the current directory set to its 8 | # containing dir. 9 | # 10 | # Note that not all possible configuration values are present in this 11 | # autogenerated file. 12 | # 13 | # All configuration values have a default; values that are commented out 14 | # serve to show the default. 15 | 16 | # If extensions (or modules to document with autodoc) are in another directory, 17 | # add these directories to sys.path here. If the directory is relative to the 18 | # documentation root, use os.path.abspath to make it absolute, like shown here. 19 | # 20 | # import os 21 | # import sys 22 | # sys.path.insert(0, os.path.abspath('.')) 23 | 24 | # -- General configuration ------------------------------------------------ 25 | 26 | # If your documentation needs a minimal Sphinx version, state it here. 27 | # 28 | # needs_sphinx = '1.0' 29 | 30 | # Add any Sphinx extension module names here, as strings. They can be 31 | # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom 32 | # ones. 33 | extensions = [ 34 | #'sphinx.ext.intersphinx', 35 | 'sphinx.ext.todo', 36 | 'sphinxcontrib.openapi', 37 | ] 38 | 39 | # Add any paths that contain templates here, relative to this directory. 40 | templates_path = ['_templates'] 41 | 42 | # The suffix(es) of source filenames. 43 | # You can specify multiple suffix as a list of string: 44 | # 45 | # source_suffix = ['.rst', '.md'] 46 | source_suffix = '.rst' 47 | 48 | # The encoding of source files. 49 | # 50 | # source_encoding = 'utf-8-sig' 51 | 52 | # The master toctree document. 53 | master_doc = 'index' 54 | 55 | # General information about the project. 56 | project = 'Hercules' 57 | copyright = '2017, Domen Kožar, Joe Hermaszewski' 58 | author = 'Domen Kožar, Joe Hermaszewski' 59 | 60 | # The version info for the project you're documenting, acts as replacement for 61 | # |version| and |release|, also used in various other places throughout the 62 | # built documents. 63 | # 64 | # The short X.Y version. 65 | version = '0.1' 66 | # The full version, including alpha/beta/rc tags. 67 | release = '0.1' 68 | 69 | # The language for content autogenerated by Sphinx. Refer to documentation 70 | # for a list of supported languages. 71 | # 72 | # This is also used if you do content translation via gettext catalogs. 73 | # Usually you set "language" from the command line for these cases. 74 | language = None 75 | 76 | # There are two options for replacing |today|: either, you set today to some 77 | # non-false value, then it is used: 78 | # 79 | # today = '' 80 | # 81 | # Else, today_fmt is used as the format for a strftime call. 82 | # 83 | # today_fmt = '%B %d, %Y' 84 | 85 | # List of patterns, relative to source directory, that match files and 86 | # directories to ignore when looking for source files. 87 | # This patterns also effect to html_static_path and html_extra_path 88 | exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] 89 | 90 | # The reST default role (used for this markup: `text`) to use for all 91 | # documents. 92 | # 93 | # default_role = None 94 | 95 | # If true, '()' will be appended to :func: etc. cross-reference text. 96 | # 97 | # add_function_parentheses = True 98 | 99 | # If true, the current module name will be prepended to all description 100 | # unit titles (such as .. function::). 101 | # 102 | # add_module_names = True 103 | 104 | # If true, sectionauthor and moduleauthor directives will be shown in the 105 | # output. They are ignored by default. 106 | # 107 | # show_authors = False 108 | 109 | # The name of the Pygments (syntax highlighting) style to use. 110 | pygments_style = 'sphinx' 111 | 112 | # A list of ignored prefixes for module index sorting. 113 | # modindex_common_prefix = [] 114 | 115 | # If true, keep warnings as "system message" paragraphs in the built documents. 116 | # keep_warnings = False 117 | 118 | # If true, `todo` and `todoList` produce output, else they produce nothing. 119 | todo_include_todos = True 120 | 121 | 122 | # -- Options for HTML output ---------------------------------------------- 123 | 124 | # The theme to use for HTML and HTML Help pages. See the documentation for 125 | # a list of builtin themes. 126 | # 127 | import sphinx_rtd_theme 128 | html_theme = 'sphinx_rtd_theme' 129 | html_theme_path = [sphinx_rtd_theme.get_html_theme_path()] 130 | 131 | # Theme options are theme-specific and customize the look and feel of a theme 132 | # further. For a list of options available for each theme, see the 133 | # documentation. 134 | # 135 | # html_theme_options = {} 136 | 137 | # Add any paths that contain custom themes here, relative to this directory. 138 | # html_theme_path = [] 139 | 140 | # The name for this set of Sphinx documents. 141 | # " v documentation" by default. 142 | # 143 | # html_title = 'Hercules v0.1' 144 | 145 | # A shorter title for the navigation bar. Default is the same as html_title. 146 | # 147 | # html_short_title = None 148 | 149 | # The name of an image file (relative to this directory) to place at the top 150 | # of the sidebar. 151 | # 152 | # html_logo = None 153 | 154 | # The name of an image file (relative to this directory) to use as a favicon of 155 | # the docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32 156 | # pixels large. 157 | # 158 | # html_favicon = None 159 | 160 | # Add any paths that contain custom static files (such as style sheets) here, 161 | # relative to this directory. They are copied after the builtin static files, 162 | # so a file named "default.css" will overwrite the builtin "default.css". 163 | html_static_path = ['_static'] 164 | 165 | # Add any extra paths that contain custom files (such as robots.txt or 166 | # .htaccess) here, relative to this directory. These files are copied 167 | # directly to the root of the documentation. 168 | # 169 | # html_extra_path = [] 170 | 171 | # If not None, a 'Last updated on:' timestamp is inserted at every page 172 | # bottom, using the given strftime format. 173 | # The empty string is equivalent to '%b %d, %Y'. 174 | # 175 | # html_last_updated_fmt = None 176 | 177 | # If true, SmartyPants will be used to convert quotes and dashes to 178 | # typographically correct entities. 179 | # 180 | # html_use_smartypants = True 181 | 182 | # Custom sidebar templates, maps document names to template names. 183 | # 184 | # html_sidebars = {} 185 | 186 | # Additional templates that should be rendered to pages, maps page names to 187 | # template names. 188 | # 189 | # html_additional_pages = {} 190 | 191 | # If false, no module index is generated. 192 | # 193 | # html_domain_indices = True 194 | 195 | # If false, no index is generated. 196 | # 197 | # html_use_index = True 198 | 199 | # If true, the index is split into individual pages for each letter. 200 | # 201 | # html_split_index = False 202 | 203 | # If true, links to the reST sources are added to the pages. 204 | # 205 | # html_show_sourcelink = True 206 | 207 | # If true, "Created using Sphinx" is shown in the HTML footer. Default is True. 208 | # 209 | # html_show_sphinx = True 210 | 211 | # If true, "(C) Copyright ..." is shown in the HTML footer. Default is True. 212 | # 213 | # html_show_copyright = True 214 | 215 | # If true, an OpenSearch description file will be output, and all pages will 216 | # contain a tag referring to it. The value of this option must be the 217 | # base URL from which the finished HTML is served. 218 | # 219 | # html_use_opensearch = '' 220 | 221 | # This is the file name suffix for HTML files (e.g. ".xhtml"). 222 | # html_file_suffix = None 223 | 224 | # Language to be used for generating the HTML full-text search index. 225 | # Sphinx supports the following languages: 226 | # 'da', 'de', 'en', 'es', 'fi', 'fr', 'h', 'it', 'ja' 227 | # 'nl', 'no', 'pt', 'ro', 'r', 'sv', 'tr', 'zh' 228 | # 229 | # html_search_language = 'en' 230 | 231 | # A dictionary with options for the search language support, empty by default. 232 | # 'ja' uses this config value. 233 | # 'zh' user can custom change `jieba` dictionary path. 234 | # 235 | # html_search_options = {'type': 'default'} 236 | 237 | # The name of a javascript file (relative to the configuration directory) that 238 | # implements a search results scorer. If empty, the default will be used. 239 | # 240 | # html_search_scorer = 'scorer.js' 241 | 242 | # Output file base name for HTML help builder. 243 | htmlhelp_basename = 'Herculesdoc' 244 | 245 | # -- Options for LaTeX output --------------------------------------------- 246 | 247 | latex_elements = { 248 | # The paper size ('letterpaper' or 'a4paper'). 249 | # 250 | # 'papersize': 'letterpaper', 251 | 252 | # The font size ('10pt', '11pt' or '12pt'). 253 | # 254 | # 'pointsize': '10pt', 255 | 256 | # Additional stuff for the LaTeX preamble. 257 | # 258 | # 'preamble': '', 259 | 260 | # Latex figure (float) alignment 261 | # 262 | # 'figure_align': 'htbp', 263 | } 264 | 265 | # Grouping the document tree into LaTeX files. List of tuples 266 | # (source start file, target name, title, 267 | # author, documentclass [howto, manual, or own class]). 268 | latex_documents = [ 269 | (master_doc, 'Hercules.tex', 'Hercules Documentation', 270 | 'Domen Kožar, Joe Hermaszewski', 'manual'), 271 | ] 272 | 273 | # The name of an image file (relative to this directory) to place at the top of 274 | # the title page. 275 | # 276 | # latex_logo = None 277 | 278 | # For "manual" documents, if this is true, then toplevel headings are parts, 279 | # not chapters. 280 | # 281 | # latex_use_parts = False 282 | 283 | # If true, show page references after internal links. 284 | # 285 | # latex_show_pagerefs = False 286 | 287 | # If true, show URL addresses after external links. 288 | # 289 | # latex_show_urls = False 290 | 291 | # Documents to append as an appendix to all manuals. 292 | # 293 | # latex_appendices = [] 294 | 295 | # It false, will not define \strong, \code, itleref, \crossref ... but only 296 | # \sphinxstrong, ..., \sphinxtitleref, ... To help avoid clash with user added 297 | # packages. 298 | # 299 | # latex_keep_old_macro_names = True 300 | 301 | # If false, no module index is generated. 302 | # 303 | # latex_domain_indices = True 304 | 305 | 306 | # -- Options for manual page output --------------------------------------- 307 | 308 | # One entry per manual page. List of tuples 309 | # (source start file, name, description, authors, manual section). 310 | man_pages = [ 311 | (master_doc, 'hercules', 'Hercules Documentation', 312 | [author], 1) 313 | ] 314 | 315 | # If true, show URL addresses after external links. 316 | # 317 | # man_show_urls = False 318 | 319 | 320 | # -- Options for Texinfo output ------------------------------------------- 321 | 322 | # Grouping the document tree into Texinfo files. List of tuples 323 | # (source start file, target name, title, author, 324 | # dir menu entry, description, category) 325 | texinfo_documents = [ 326 | (master_doc, 'Hercules', 'Hercules Documentation', 327 | author, 'Hercules', 'One line description of project.', 328 | 'Miscellaneous'), 329 | ] 330 | 331 | # Documents to append as an appendix to all manuals. 332 | # 333 | # texinfo_appendices = [] 334 | 335 | # If false, no module index is generated. 336 | # 337 | # texinfo_domain_indices = True 338 | 339 | # How to display URL addresses: 'footnote', 'no', or 'inline'. 340 | # 341 | # texinfo_show_urls = 'footnote' 342 | 343 | # If true, do not generate a @detailmenu in the "Top" node's menu. 344 | # 345 | # texinfo_no_detailmenu = False 346 | 347 | 348 | # -- Options for Epub output ---------------------------------------------- 349 | 350 | # Bibliographic Dublin Core info. 351 | epub_title = project 352 | epub_author = author 353 | epub_publisher = author 354 | epub_copyright = copyright 355 | 356 | # The basename for the epub file. It defaults to the project name. 357 | # epub_basename = project 358 | 359 | # The HTML theme for the epub output. Since the default themes are not 360 | # optimized for small screen space, using the same theme for HTML and epub 361 | # output is usually not wise. This defaults to 'epub', a theme designed to save 362 | # visual space. 363 | # 364 | # epub_theme = 'epub' 365 | 366 | # The language of the text. It defaults to the language option 367 | # or 'en' if the language is not set. 368 | # 369 | # epub_language = '' 370 | 371 | # The scheme of the identifier. Typical schemes are ISBN or URL. 372 | # epub_scheme = '' 373 | 374 | # The unique identifier of the text. This can be a ISBN number 375 | # or the project homepage. 376 | # 377 | # epub_identifier = '' 378 | 379 | # A unique identification for the text. 380 | # 381 | # epub_uid = '' 382 | 383 | # A tuple containing the cover image and cover page html template filenames. 384 | # 385 | # epub_cover = () 386 | 387 | # A sequence of (type, uri, title) tuples for the guide element of content.opf. 388 | # 389 | # epub_guide = () 390 | 391 | # HTML files that should be inserted before the pages created by sphinx. 392 | # The format is a list of tuples containing the path and title. 393 | # 394 | # epub_pre_files = [] 395 | 396 | # HTML files that should be inserted after the pages created by sphinx. 397 | # The format is a list of tuples containing the path and title. 398 | # 399 | # epub_post_files = [] 400 | 401 | # A list of files that should not be packed into the epub file. 402 | epub_exclude_files = ['search.html'] 403 | 404 | # The depth of the table of contents in toc.ncx. 405 | # 406 | # epub_tocdepth = 3 407 | 408 | # Allow duplicate toc entries. 409 | # 410 | # epub_tocdup = True 411 | 412 | # Choose between 'default' and 'includehidden'. 413 | # 414 | # epub_tocscope = 'default' 415 | 416 | # Fix unsupported image types using the Pillow. 417 | # 418 | # epub_fix_images = False 419 | 420 | # Scale large images. 421 | # 422 | # epub_max_image_width = 0 423 | 424 | # How to display URL addresses: 'footnote', 'no', or 'inline'. 425 | # 426 | # epub_show_urls = 'inline' 427 | 428 | # If false, no index is generated. 429 | # 430 | # epub_use_index = True 431 | 432 | 433 | # Example configuration for intersphinx: refer to the Python standard library. 434 | intersphinx_mapping = {'https://docs.python.org/': None} 435 | -------------------------------------------------------------------------------- /docs/default.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? (import ./../pkgs.nix) {} 2 | , backend ? (import ./../backend {}) 3 | }: 4 | 5 | with pkgs; 6 | 7 | 8 | stdenv.mkDerivation { 9 | name = "hercules-docs"; 10 | 11 | src = ./.; 12 | 13 | propagatedBuildInputs = with python3Packages; [ sphinxcontrib-openapi sphinx_rtd_theme ]; 14 | 15 | preBuild = '' 16 | ${backend}/bin/gen-docs 17 | echo "HTTP API" > api.rst 18 | echo "********" >> api.rst 19 | echo ".. openapi:: api.yml" >> api.rst 20 | ''; 21 | 22 | buildFlags = ["html"]; 23 | 24 | installPhase = '' 25 | mkdir $out 26 | cp -R _build/html/* $out 27 | ''; 28 | } 29 | -------------------------------------------------------------------------------- /docs/faq.rst: -------------------------------------------------------------------------------- 1 | FAQ 2 | === 3 | 4 | Q: What problems is it going to solve? 5 | ************************************** 6 | 7 | Continuous Integration for `Nix `_. 8 | 9 | Q: Is it going to replace travis on nixpkgs? 10 | ******************************************** 11 | 12 | On the long run this might be a logical step, 13 | but current focus is providing Pull Requests testing 14 | for Nix projects in general. 15 | 16 | Q: How is task scheduling going to work? 17 | ******************************************** 18 | 19 | For 1.0 same as in Hydra. 20 | 21 | Q: Is it going to be able to merge PRs? 22 | ******************************************** 23 | 24 | Not in 1.0, maybe later on. 25 | 26 | Q: Is it going to simplify the deployment of the CI? 27 | **************************************************** 28 | 29 | Yes. There will be a NixOS module with releases. 30 | 31 | Q: It there a mode that merges the code before running the tests? 32 | ***************************************************************** 33 | 34 | That will be the default. 35 | 36 | Q: How is the DB provisioned without hydra? 37 | ******************************************** 38 | 39 | Not determined yet, there `will be a command `_ eventually. 40 | 41 | Q: What does Eelco think of this project, how likely is it that hydra will be replaced by it? 42 | ********************************************************************************************* 43 | 44 | No official word out yet. It's too soon. 45 | -------------------------------------------------------------------------------- /docs/getting-started.rst: -------------------------------------------------------------------------------- 1 | Getting Started 2 | =============== 3 | 4 | Backend 5 | ******* 6 | 7 | You'll need: 8 | 9 | - `Nix installed `_ 10 | - `Hydra database loaded into Postgresql `_ for hydra user 11 | 12 | To setup the hercules database, execute as Postgres superuser:: 13 | 14 | $ CREATE ROLE hercules LOGIN; 15 | $ CREATE DATABASE hercules OWNER hercules; 16 | 17 | Add the following snippet to your NixOS configuration.nix:: 18 | 19 | services.postgresql = { 20 | identMap = '' 21 | hydra-users YOUR_USER hydra 22 | hercules-users YOUR_USER hercules 23 | ''; 24 | authentication = '' 25 | local hercules all ident map=hercules-users 26 | ''; 27 | }; 28 | 29 | 30 | To build:: 31 | 32 | $ cd backend 33 | $ nix-build 34 | $ ./result/bin/hercules -c example-config.yaml 35 | 36 | 37 | Frontend 38 | ******** 39 | 40 | Hot reloading is used for development, so you can start your development server:: 41 | 42 | $ cd frontend 43 | $ nix-shell --run "npm i && npm run dev" 44 | 45 | And open your browser and point it to http://localhost:3000 46 | 47 | -------------------------------------------------------------------------------- /docs/index.rst: -------------------------------------------------------------------------------- 1 | .. Hercules documentation master file, created by 2 | sphinx-quickstart on Thu Jan 5 19:53:43 2017. 3 | You can adapt this file completely to your liking, but it should at least 4 | contain the root `toctree` directive. 5 | 6 | Welcome to Hercules's documentation! 7 | ==================================== 8 | 9 | :Author: Domen Kožar , Joe Hermaszewski 10 | :Source code: `github.com/hercules-ci/hercules `_ 11 | :License: BSD3 12 | :Version: |release| 13 | 14 | 15 | .. sidebar:: Features 16 | 17 | - RESTful API `Haskell Servant `_ 18 | - Separate frontend written in `Elm `_ 19 | - Github integration (Authentication and Pull Requests) 20 | - Declarative configuration using a YAML file 21 | 22 | 23 | .. topic:: Introduction 24 | 25 | Continuous Integration for Nix projects. 26 | 27 | Hercules uses the same DB schema as Hydra, but a new Haskell backend with a RESTful API and Elm as new frontend. 28 | 29 | The goal of the MVP is to run Hercules as a CI for Github. 30 | 31 | 32 | Documentation 33 | ============= 34 | 35 | .. toctree:: 36 | :maxdepth: 2 37 | 38 | getting-started.rst 39 | faq.rst 40 | api.rst 41 | 42 | 43 | Indices and tables 44 | ================== 45 | 46 | * :ref:`genindex` 47 | * :ref:`modindex` 48 | * :ref:`search` 49 | 50 | -------------------------------------------------------------------------------- /frontend/.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | elm-stuff/ 3 | node_modules/ 4 | -------------------------------------------------------------------------------- /frontend/TODO: -------------------------------------------------------------------------------- 1 | https://github.com/webpack/docs/wiki/list-of-plugins#environmentplugin 2 | 3 | ## NEXT 4 | 5 | - jobset page 6 | - eval page 7 | - build page 8 | - login logic 9 | - search page 10 | 11 | ### TODO 12 | 13 | - proxy api requests to hydra https://webpack.github.io/docs/webpack-dev-server.html#bypass-the-proxy 14 | - http://noredink.github.io/json-to-elm/ 15 | - http://mbylstra.github.io/html-to-elm/ 16 | 17 | ## TODO (neat) 18 | 19 | - pinned jobsets support 20 | - jobset: filter by system 21 | - evaluation: view of jobs that changed in this evaluation 22 | - use font awesome as fallback method for icons on build products 23 | - live counts for queue and builds 24 | - hide renamed/forgotten builds on jobs view 25 | 26 | 27 | 28 | 29 | 12 src/root/all.tt (latest builds) 30 | 108 src/root/auth.tt (google+persona login) 31 | 9 src/root/build-deps.tt 32 | 519 src/root/build.tt (build id page) 33 | 86 src/root/channel-contents.tt 34 | 659 src/root/common.tt (everything) 35 | 12 src/root/dashboard-my-jobsets-tab.tt 36 | 17 src/root/dashboard-my-jobs-tab.tt 37 | 49 src/root/dashboard.tt 38 | 39 | 220 src/root/edit-jobset.tt 40 | 83 src/root/edit-project.tt 41 | 8 src/root/error.tt 42 | 14 src/root/evals.tt (project, build, all evaluations) 43 | 34 src/root/jobset-channels-tab.tt 44 | 165 src/root/jobset-eval.tt 45 | 69 src/root/jobset-jobs-tab.tt 46 | 201 src/root/jobset.tt 47 | 48 | - hide disabled ones by default (and have a toggle to show them) 49 | - add a way to show more of them (defaut max 3 per project) 50 | - (nice to have) unite channels view 51 | 52 | 120 src/root/job.tt (build logs) 53 | 17 src/root/log.tt 54 | 58 src/root/machine-status.tt 55 | 30 src/root/machines.tt 56 | 7 src/root/metric.tt 57 | 42 src/root/news.tt 58 | 48 src/root/overview.tt 59 | 39 src/root/plain-reload.tt 60 | 10 src/root/plain.tt 61 | 293 src/root/product-list.tt 62 | 8 src/root/queue-runner-status.tt 63 | 33 src/root/queue-summary.tt 64 | 14 src/root/queue.tt 65 | 219 src/root/reproduce.tt 66 | 9 src/root/runtime-deps.tt 67 | 29 src/root/deps.tt 68 | 87 src/root/search.tt 69 | 14 src/root/status.tt (running builds) 70 | 39 src/root/steps.tt (latest steps) 71 | 31 src/root/users.tt (admin users) 72 | 162 src/root/user.tt (create/edit user) 73 | 74 | 75 | In progress: 76 | 77 | 154 src/root/topbar.tt 78 | 79 | - private hydra 80 | 81 | 115 src/root/project.tt 82 | 29 src/root/release.tt (deprecated) 83 | 115 src/root/layout.tt 84 | 85 | - bootbox (get rid of modals or replace with bootstrap modals) 86 | - set TRACKER 87 | - tree.css, logfile.css, common.js, rtated-th.css, hydra.css 88 | - google auth client + process auth.tt https://github.com/NixOS/hydra/blob/master/src/root/auth.tt 89 | - support staring of projects/jobs 90 | - https://github.com/NixOS/hydra/blob/master/src/root/topbar.tt 91 | - flot JS? 92 | 93 | 62 src/root/edit-release.tt (deprecated) 94 | -------------------------------------------------------------------------------- /frontend/default.nix: -------------------------------------------------------------------------------- 1 | { backend ? (import ./../backend {}) 2 | , pkgs ? (import ./../pkgs.nix) {} 3 | , backendURL ? "http://localhost:8080" }: 4 | 5 | with pkgs; 6 | 7 | stdenv.mkDerivation { 8 | name = "hercules-frontend"; 9 | 10 | src = ./.; 11 | 12 | buildInputs = [ elmPackages.elm elmPackages.elm-format nodejs ]; 13 | 14 | patchPhase = '' 15 | patchShebangs node_modules/webpack 16 | ''; 17 | 18 | # https://github.com/NixHercules/hercules/issues/3 19 | buildHercules = "${backend}/bin/gen-elm src && sed -i \"s@'@@g\" src/Hercules.elm"; 20 | 21 | BACKEND_URL = backendURL; 22 | 23 | buildPhase = '' 24 | npm run build 25 | ''; 26 | 27 | installPhase = '' 28 | mkdir $out 29 | cp -R dist/* $out/ 30 | ''; 31 | } 32 | -------------------------------------------------------------------------------- /frontend/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "helpful summary of your project, less than 80 characters", 4 | "repository": "https://github.com/user/project.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [], 10 | "dependencies": { 11 | "MichaelCombs28/elm-mdl": "1.0.0 <= v < 2.0.0", 12 | "NoRedInk/elm-decode-pipeline": "3.0.0 <= v < 4.0.0", 13 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 14 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 15 | "elm-lang/http": "1.0.0 <= v < 2.0.0", 16 | "elm-lang/navigation": "2.0.1 <= v < 3.0.0", 17 | "evancz/url-parser": "2.0.1 <= v < 3.0.0" 18 | }, 19 | "elm-version": "0.18.0 <= v < 0.19.0" 20 | } 21 | -------------------------------------------------------------------------------- /frontend/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "frontend", 3 | "version": "1.0.0", 4 | "description": "Hydra frontend", 5 | "main": "index.js", 6 | "dependencies": { 7 | "elm-hot-loader": "^0.3.2", 8 | "elm-webpack-loader": "3.0.0", 9 | "file-loader": "^0.8.5", 10 | "webpack": "^1.13.0", 11 | "webpack-dev-middleware": "^1.6.1", 12 | "webpack-dev-server": "^1.14.1" 13 | }, 14 | "devDependencies": {}, 15 | "scripts": { 16 | "test": "echo \"Error: no test specified\" && exit 1", 17 | "build": "eval \"$buildHercules\" && webpack --optimize-minimize --bail", 18 | "watch": "eval \"$buildHercules\" && webpack --watch", 19 | "dev": "eval \"$buildHercules\" && webpack-dev-server --watch --hot --port 3000" 20 | }, 21 | "author": "Domen Kozar", 22 | "license": "ISC" 23 | } 24 | -------------------------------------------------------------------------------- /frontend/src/Components/Breadcrumbs.elm: -------------------------------------------------------------------------------- 1 | module Components.Breadcrumbs exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import List 6 | import Material.Icon as Icon 7 | import Material.Options as Options 8 | import Msg exposing (..) 9 | import Models exposing (..) 10 | import Urls as Urls exposing (..) 11 | import Utils exposing (onClickPage) 12 | 13 | 14 | type alias Breadcrumb = 15 | { name : String 16 | , page : Maybe Page 17 | } 18 | 19 | 20 | renderBreadcrumbs : List Breadcrumb -> List (Html Msg) 21 | renderBreadcrumbs breadcrumbs = 22 | let 23 | home = 24 | a (onClickPage Home) [ text "Hydra" ] 25 | 26 | render breadcrumb = 27 | case breadcrumb.page of 28 | Just page -> 29 | a (onClickPage page) 30 | [ text breadcrumb.name ] 31 | 32 | Nothing -> 33 | span [ class "active" ] 34 | [ text breadcrumb.name ] 35 | in 36 | List.intersperse 37 | (Icon.view "keyboard_arrow_right" 38 | [ Icon.size36 39 | , Options.css "top" "10px" 40 | , Options.css "position" "relative" 41 | ] 42 | ) 43 | (home :: List.map render breadcrumbs) 44 | 45 | 46 | breadCrumbs : AppModel -> List (Html Msg) 47 | breadCrumbs model = 48 | let 49 | breadcrumbs = 50 | case model.currentPage of 51 | Home -> 52 | [] 53 | 54 | NewProject -> 55 | [ Breadcrumb "New Project" Nothing ] 56 | 57 | Project project -> 58 | [ Breadcrumb project Nothing ] 59 | 60 | Jobset project jobset -> 61 | [ Breadcrumb project (Just (Urls.Project project)) 62 | , Breadcrumb jobset Nothing 63 | ] 64 | in 65 | renderBreadcrumbs breadcrumbs 66 | -------------------------------------------------------------------------------- /frontend/src/Components/Help.elm: -------------------------------------------------------------------------------- 1 | module Components.Help exposing (..) 2 | 3 | import Html exposing (..) 4 | import Material.Icon as Icon 5 | import Material.Options as Options 6 | import Material.Tooltip as Tooltip 7 | import Msg exposing (..) 8 | import Models exposing (..) 9 | 10 | 11 | {-| Uses ports to communicate with jQuery and initialize twitter 12 | bootstrap popover plugin. Each help element is a questionmark 13 | icon which on popover shows some help text. 14 | -} 15 | popoverHelp : AppModel -> List (Html Msg) -> Html Msg 16 | popoverHelp model html = 17 | span 18 | [] 19 | [ Icon.view "help" 20 | [ Options.css "margin" "0 6px" 21 | , Options.css "color" "#0088CC" 22 | , Options.css "cursor" "help" 23 | , Tooltip.attach Mdl [ 3 ] 24 | ] 25 | , Tooltip.render Mdl 26 | [ 3 ] 27 | model.mdl 28 | [ Tooltip.large ] 29 | html 30 | ] 31 | 32 | 33 | projectHelp : AppModel -> Html Msg 34 | projectHelp model = 35 | popoverHelp model [ text "TODO" ] 36 | 37 | 38 | jobsetHelp : AppModel -> Html Msg 39 | jobsetHelp model = 40 | popoverHelp 41 | model 42 | [ text "Jobsets evaluate a Nix expression and provide an overview of successful/failed builds." ] 43 | 44 | 45 | evaluationHelp : AppModel -> Html Msg 46 | evaluationHelp model = 47 | popoverHelp model [ text "" ] 48 | 49 | 50 | buildHelp : AppModel -> Html Msg 51 | buildHelp model = 52 | popoverHelp model [ text "" ] 53 | 54 | 55 | buildStepHelp : AppModel -> Html Msg 56 | buildStepHelp model = 57 | popoverHelp model [ text "" ] 58 | -------------------------------------------------------------------------------- /frontend/src/Components/LiveSearch.elm: -------------------------------------------------------------------------------- 1 | module Components.LiveSearch exposing (update, view, search, Msg) 2 | 3 | import Html exposing (..) 4 | import Html.Events exposing (..) 5 | import Json.Decode as Json 6 | import String 7 | import Material 8 | import Material.Textfield as Textfield 9 | import Material.Color as Color 10 | import Material.Icon as Icon 11 | import Material.Options as Options 12 | import Models exposing (..) 13 | 14 | 15 | type Msg 16 | = SearchInput String 17 | | SearchEscape 18 | | Mdl (Material.Msg Msg) 19 | 20 | 21 | compareCaseInsensitve : String -> String -> Bool 22 | compareCaseInsensitve s1 s2 = 23 | String.contains (String.toLower s1) (String.toLower s2) 24 | 25 | 26 | {-| Filter project by Project name or Jobset name 27 | -} 28 | searchProject : String -> Project -> Project 29 | searchProject searchstring project = 30 | let 31 | projectFilteredJobsets = 32 | { project | jobsets = List.map (filterByName searchstring) project.jobsets } 33 | 34 | hasJobsets = 35 | List.any (\j -> j.isShown) projectFilteredJobsets.jobsets 36 | 37 | newproject = 38 | filterByName searchstring project 39 | in 40 | if 41 | newproject.isShown 42 | -- if project matches, display all jobsets 43 | then 44 | { newproject | jobsets = List.map (\j -> { j | isShown = True }) newproject.jobsets } 45 | else if 46 | hasJobsets 47 | -- if project doesn't match, only display if any of jobsets match 48 | then 49 | { projectFilteredJobsets | isShown = True } 50 | else 51 | newproject 52 | 53 | 54 | filterByName : String -> { b | name : String, isShown : Bool } -> { b | name : String, isShown : Bool } 55 | filterByName searchstring project = 56 | if compareCaseInsensitve searchstring project.name then 57 | { project | isShown = True } 58 | else 59 | { project | isShown = False } 60 | 61 | 62 | {-| Filter any record by isShown field 63 | 64 | TODO: recursively apply all lists in the structure 65 | -} 66 | search : List { a | isShown : Bool } -> List { a | isShown : Bool } 67 | search projects = 68 | List.filter (\x -> x.isShown) projects 69 | 70 | 71 | update : Msg -> AppModel -> ( AppModel, Cmd Msg ) 72 | update msg model = 73 | case msg of 74 | SearchInput searchstring -> 75 | let 76 | newprojects = 77 | List.map (searchProject searchstring) model.projects 78 | in 79 | ( { model 80 | | projects = newprojects 81 | , searchString = searchstring 82 | } 83 | , Cmd.none 84 | ) 85 | 86 | -- on Escape, clear search bar and return all projects/jobsets 87 | SearchEscape -> 88 | ( { model 89 | | searchString = "" 90 | , projects = List.map (searchProject "") model.projects 91 | } 92 | , Cmd.none 93 | ) 94 | 95 | Mdl msg_ -> 96 | Material.update msg_ model 97 | 98 | 99 | view : AppModel -> Html Msg 100 | view model = 101 | span 102 | [] 103 | [ Textfield.render Mdl 104 | [ 0 ] 105 | model.mdl 106 | [ Textfield.label "Search" 107 | , Textfield.floatingLabel 108 | , Textfield.text_ 109 | , Textfield.onInput SearchInput 110 | , onEscape SearchEscape 111 | , Textfield.value model.searchString 112 | , Textfield.style 113 | [ Options.css "border-radius" "0.5em" 114 | , Color.background Color.primaryDark 115 | ] 116 | ] 117 | , Icon.view 118 | "search" 119 | [ Icon.onClick (SearchInput model.searchString) 120 | -- TODO: trigger a proper search page 121 | , Options.css "position" "relative" 122 | , Options.css "top" "8px" 123 | , Options.css "right" "28px" 124 | , Options.css "z-index" "100" 125 | , Options.css "cursor" "pointer" 126 | ] 127 | ] 128 | 129 | 130 | onEscape : msg -> Textfield.Property msg 131 | onEscape msg = 132 | Textfield.on "keydown" (Json.map (always msg) (Json.int |> Json.andThen isEscape)) 133 | 134 | 135 | isEscape : Int -> Json.Decoder Int 136 | isEscape code = 137 | case code of 138 | 27 -> 139 | Json.succeed 27 140 | 141 | _ -> 142 | Json.fail "not the right key code" 143 | -------------------------------------------------------------------------------- /frontend/src/Components/Navbar.elm: -------------------------------------------------------------------------------- 1 | module Components.Navbar exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Maybe 6 | import Material.Layout as Layout 7 | import Material.Icon as Icon 8 | import Material.Menu as Menu 9 | import Material.Options as Options 10 | import Msg exposing (..) 11 | import Models exposing (AppModel) 12 | import Components.Breadcrumbs exposing (breadCrumbs) 13 | import Components.LiveSearch as LiveSearch 14 | import Urls exposing (..) 15 | import Utils exposing (..) 16 | 17 | 18 | tabs : AppModel -> List (Html Msg) 19 | tabs model = 20 | [ span [] [ whiteBadge [] [ text (toString model.queueStats.numBuilding) ], text " in progress" ] 21 | , span [] [ whiteBadge [] [ text (toString model.queueStats.numWaiting) ], text " in queue" ] 22 | , span [] [ whiteBadge [] [ text (toString model.queueStats.numMachines) ], text " machines" ] 23 | , text "evaluations" 24 | , text "builds" 25 | , text "steps" 26 | ] 27 | 28 | 29 | view : AppModel -> List (Html Msg) 30 | view model = 31 | let 32 | menuItems = 33 | case model.user of 34 | Nothing -> 35 | [ Menu.item 36 | [ Menu.onSelect <| LoginUserClick Google ] 37 | [ menuIcon "input" 38 | , text "Sign in with Google" 39 | ] 40 | , Menu.item 41 | [ Menu.onSelect <| LoginUserClick Hydra ] 42 | [ menuIcon "input" 43 | , text "Sign in with a password" 44 | ] 45 | ] 46 | 47 | Just user -> 48 | [ Menu.item 49 | [ Menu.onSelect <| PreferencesClick ] 50 | [ menuIcon "settings" 51 | , text "Preferences" 52 | ] 53 | , Menu.item 54 | [ Menu.onSelect <| LogoutUserClick ] 55 | [ Icon.view "power_settings_new" 56 | [ Options.css "width" "40px" 57 | , Options.css "color" "red" 58 | ] 59 | , text "Sign out" 60 | ] 61 | ] 62 | in 63 | [ Layout.row [] 64 | [ Layout.title 65 | [] 66 | ([ if model.hydraConfig.logo == "" then 67 | text "" 68 | else 69 | img 70 | ([ src model.hydraConfig.logo 71 | , alt "Hydra Logo" 72 | , class "logo" 73 | , style [ ( "height", "37px" ), ( "margin", "5px" ) ] 74 | ] 75 | ++ (onClickPage Home) 76 | ) 77 | [] 78 | ] 79 | ++ (breadCrumbs model) 80 | ) 81 | , Layout.spacer 82 | , Layout.navigation [] 83 | [ Html.map LiveSearchMsg (LiveSearch.view model) 84 | , span [] (Maybe.withDefault [] (Maybe.map (\user -> [ text user.name ]) model.user)) 85 | , Menu.render Mdl 86 | [ 1 ] 87 | model.mdl 88 | [ Menu.ripple 89 | , Menu.bottomRight 90 | , Menu.icon "account_circle" 91 | ] 92 | menuItems 93 | ] 94 | ] 95 | ] 96 | -------------------------------------------------------------------------------- /frontend/src/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import Maybe 4 | import Material 5 | import Navigation 6 | import UrlParser exposing (parsePath) 7 | import Hercules exposing (..) 8 | import Msg exposing (..) 9 | import Models exposing (..) 10 | import Update exposing (..) 11 | import View exposing (..) 12 | import Urls exposing (..) 13 | 14 | 15 | init : Flags -> Navigation.Location -> ( AppModel, Cmd Msg ) 16 | init flags location = 17 | let 18 | page = Maybe.withDefault Home (parsePath pageParser location) 19 | model = initialModel page flags 20 | in model ! [ Material.init Mdl 21 | , title (pageToTitle page) 22 | ] 23 | 24 | 25 | main : Program Flags AppModel Msg 26 | main = 27 | Navigation.programWithFlags UrlChange 28 | { init = init 29 | , update = update 30 | , view = view 31 | , subscriptions = Material.subscriptions Mdl 32 | } 33 | -------------------------------------------------------------------------------- /frontend/src/Models.elm: -------------------------------------------------------------------------------- 1 | module Models exposing (..) 2 | 3 | import Material 4 | import Maybe 5 | import Date 6 | import Urls exposing (..) 7 | 8 | 9 | type alias Flags = 10 | { backendURL : String 11 | } 12 | 13 | type AlertType 14 | = Danger 15 | | Info 16 | | Warning 17 | | Success 18 | 19 | 20 | type alias Alert = 21 | { kind : AlertType 22 | , msg : String 23 | } 24 | 25 | 26 | type alias User = 27 | { id : String 28 | , name : String 29 | , email : String 30 | , roles : List String 31 | , recieveEvaluationErrors : Bool 32 | } 33 | 34 | 35 | type alias Jobset = 36 | { id : String 37 | , name : String 38 | , description : String 39 | , queued : Int 40 | , failed : Int 41 | , succeeded : Int 42 | , lastEvaluation : String 43 | , isShown : Bool 44 | } 45 | 46 | 47 | type alias Project = 48 | { id : String 49 | , name : String 50 | , description : String 51 | , jobsets : List Jobset 52 | , isShown : Bool 53 | } 54 | 55 | 56 | type alias HydraConfig = 57 | { logo : String 58 | , hydraVersion : String 59 | , nixVersion : String 60 | } 61 | 62 | 63 | type alias QueueStats = 64 | { numBuilding : Int 65 | , numWaiting : Int 66 | , numMachines : Int 67 | } 68 | 69 | 70 | type alias JobSummary = 71 | { succeeded : Int 72 | , failed : Int 73 | , inQueue : Int 74 | } 75 | 76 | 77 | type alias Evaluation = 78 | { id : Int 79 | , inputChanges : String 80 | , jobSummary : JobSummary 81 | , evaluatedAt : Result String Date.Date 82 | } 83 | 84 | 85 | type alias JobsetPage = 86 | { latestCheckTime : Result String Date.Date 87 | , latestEvaluationTime : Result String Date.Date 88 | , latestFinishedEvaluationTime : Result String Date.Date 89 | , evaluations : List Evaluation 90 | , name : String 91 | } 92 | 93 | 94 | type AjaxError msg 95 | = AjaxFail msg 96 | | Loading 97 | 98 | 99 | type alias AppModel = 100 | { alert : Maybe Alert 101 | , hydraConfig : HydraConfig 102 | , projects : List Project 103 | , jobsets : Result AjaxError (List Jobset) 104 | , jobsetPage : Result AjaxError JobsetPage 105 | , user : Maybe User 106 | , mdl : Material.Model 107 | , queueStats : QueueStats 108 | , searchString : String 109 | , backendURL : String 110 | , currentPage : Page 111 | } 112 | 113 | 114 | initialModel : Page -> Flags -> AppModel 115 | initialModel page flags = 116 | let 117 | jobsets = 118 | [ { id = "release-16.03" 119 | , name = "release-16.03" 120 | , description = "NixOS 16.03 release branch" 121 | , queued = 5 122 | , failed = 275 123 | , succeeded = 24315 124 | , lastEvaluation = "2016-05-21 13:57:13" 125 | , isShown = True 126 | } 127 | , { id = "trunk-combined" 128 | , name = "trunk-combined" 129 | , description = "Combined NixOS/Nixpkgs unstable" 130 | , queued = 1 131 | , failed = 406 132 | , succeeded = 24243 133 | , lastEvaluation = "2016-05-21 13:57:03" 134 | , isShown = True 135 | } 136 | ] 137 | in 138 | { alert = Nothing 139 | , user = Nothing 140 | , backendURL = flags.backendURL 141 | , mdl = Material.model 142 | , currentPage = page 143 | , searchString = "" 144 | , hydraConfig = 145 | -- TODO: downsize logo, serve it with webpack 146 | { logo = "http://nixos.org/logo/nixos-logo-only-hires.png" 147 | , hydraVersion = "0.1.1234.abcdef" 148 | , nixVersion = "1.12pre1234_abcdef" 149 | } 150 | , queueStats = 151 | QueueStats 124 32345 19 152 | -- Pages 153 | , jobsetPage = 154 | Ok 155 | { latestCheckTime = Date.fromString "2016-08-06 12:38:01" 156 | , latestEvaluationTime = Date.fromString "2016-08-06 17:45:55" 157 | , latestFinishedEvaluationTime = Date.fromString "2016-08-06 17:45:55" 158 | , name = "Hardcodedfoobar" 159 | , evaluations = 160 | [ { id = 123 161 | , inputChanges = "snabbBsrc → e1fdc74" 162 | , jobSummary = { succeeded = 145, failed = 62, inQueue = 23 } 163 | , evaluatedAt = Date.fromString "2016-08-05 13:43:40" 164 | } 165 | ] 166 | } 167 | , jobsets = Ok [] 168 | , projects = 169 | [ { id = "nixos" 170 | , name = "NixOS" 171 | , description = "the purely functional Linux distribution" 172 | , isShown = True 173 | , jobsets = jobsets 174 | } 175 | , { id = "nix" 176 | , name = "Nix" 177 | , description = "the purely functional package manager" 178 | , isShown = True 179 | , jobsets = 180 | [ { id = "master" 181 | , name = "master" 182 | , description = "Master branch" 183 | , queued = 0 184 | , failed = 33 185 | , succeeded = 1 186 | , isShown = True 187 | , lastEvaluation = "2016-05-21 13:57:13" 188 | } 189 | ] 190 | } 191 | , { id = "nixpkgs" 192 | , name = "Nixpkgs" 193 | , description = "Nix Packages collection" 194 | , isShown = True 195 | , jobsets = 196 | [ { id = "trunk" 197 | , name = "trunk" 198 | , description = "Trunk" 199 | , isShown = True 200 | , queued = 0 201 | , failed = 7798 202 | , succeeded = 24006 203 | , lastEvaluation = "2016-05-21 13:57:13" 204 | } 205 | , { id = "staging" 206 | , name = "staging" 207 | , description = "Staging" 208 | , isShown = True 209 | , queued = 0 210 | , failed = 31604 211 | , succeeded = 63 212 | , lastEvaluation = "2016-05-21 13:57:03" 213 | } 214 | ] 215 | } 216 | , { id = "nixops" 217 | , name = "NixOps" 218 | , description = "Deploying NixOS machines" 219 | , isShown = True 220 | , jobsets = [] 221 | } 222 | ] 223 | } 224 | -------------------------------------------------------------------------------- /frontend/src/Msg.elm: -------------------------------------------------------------------------------- 1 | module Msg exposing (..) 2 | 3 | import Material 4 | import Http 5 | import Navigation 6 | import Components.LiveSearch as LiveSearch 7 | import Urls exposing (Page) 8 | 9 | 10 | type LoginType 11 | = Hydra 12 | | Google 13 | 14 | 15 | type Msg 16 | = Mdl (Material.Msg Msg) 17 | | FetchSucceed String 18 | | FetchFail Http.Error 19 | | LoginUserClick LoginType 20 | | LogoutUserClick 21 | | PreferencesClick 22 | | LiveSearchMsg LiveSearch.Msg 23 | | NewPage Page 24 | | ClickCreateProject 25 | | UrlChange Navigation.Location 26 | -------------------------------------------------------------------------------- /frontend/src/Pages/Admin.elm: -------------------------------------------------------------------------------- 1 | module Pages.Admin exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (onClick) 6 | import Models exposing (..) 7 | import Msg exposing (Msg) 8 | import Page exposing (..) 9 | 10 | 11 | adminView : AppModel -> List (Html Msg) 12 | adminView jobset = 13 | [] 14 | -------------------------------------------------------------------------------- /frontend/src/Pages/Build.elm: -------------------------------------------------------------------------------- 1 | module Pages.Build exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (onClick) 6 | import Models exposing (..) 7 | import Msg exposing (Msg) 8 | import Page exposing (..) 9 | 10 | 11 | buildView : AppModel -> List (Html Msg) 12 | buildView jobset = 13 | [] 14 | -------------------------------------------------------------------------------- /frontend/src/Pages/Evaluation.elm: -------------------------------------------------------------------------------- 1 | module Pages.Evaluation exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (onClick) 6 | import Models exposing (..) 7 | import Msg exposing (Msg) 8 | import Page exposing (..) 9 | 10 | 11 | evaluationView : AppModel -> List (Html Msg) 12 | evaluationView jobset = 13 | [] 14 | -------------------------------------------------------------------------------- /frontend/src/Pages/Jobset.elm: -------------------------------------------------------------------------------- 1 | module Pages.Jobset exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Material.Menu as Menu 6 | import Material.List as List 7 | import Material.Options as Options 8 | import Material.Tabs as Tabs 9 | import Material.Table as Table 10 | import Models exposing (..) 11 | import Msg exposing (..) 12 | import Utils exposing (..) 13 | import Urls as Urls exposing (..) 14 | 15 | 16 | view : AppModel -> List (Html Msg) 17 | view model = 18 | case model.jobsetPage of 19 | Err _ -> 20 | [ p [] [ text "TODO" ] ] 21 | 22 | Ok jobset -> 23 | renderHeader model "Jobset" (Just jobset.name) Nothing 24 | ++ [ Tabs.render Mdl 25 | [ 4 ] 26 | model.mdl 27 | [ Tabs.ripple 28 | --, Tabs.onSelectTab SelectTab 29 | --, Tabs.activeTab model.tab 30 | ] 31 | [ Tabs.label 32 | [ Options.center ] 33 | [ Options.span [ Options.css "width" "4px" ] [] 34 | , text "Evaluations" 35 | ] 36 | , Tabs.label 37 | [ Options.center ] 38 | [ Options.span [ Options.css "width" "4px" ] [] 39 | , text "Jobs" 40 | ] 41 | , Tabs.label 42 | [ Options.center ] 43 | [ Options.span [ Options.css "width" "4px" ] [] 44 | , text "Channels" 45 | ] 46 | ] 47 | (if List.isEmpty [ 1 ] then 48 | render404 "No evaluations yet." 49 | else 50 | [ List.ul [] 51 | [ List.li [ List.withSubtitle ] 52 | [ List.content [] 53 | [ text "Lastest check" 54 | , List.subtitle [] [ text "2016-08-06 12:38:01" ] 55 | ] 56 | ] 57 | , List.li [ List.withSubtitle ] 58 | [ List.content [] 59 | [ text "Lastest evaluation" 60 | , List.subtitle [] 61 | [ a 62 | [ href "TODO" ] 63 | [ text "2016-08-06 17:45:55" ] 64 | ] 65 | ] 66 | ] 67 | , List.li [ List.withSubtitle ] 68 | [ List.content [] 69 | [ text "Lastest finished evaluation" 70 | , List.subtitle [] 71 | [ a 72 | [ href "TODO" ] 73 | [ text "2016-08-06 17:45:55" ] 74 | ] 75 | ] 76 | ] 77 | ] 78 | , Table.table [ Options.css "width" "100%" ] 79 | [ Table.thead [] 80 | [ Table.tr [] 81 | [ Table.th [] [ text "#" ] 82 | , Table.th [] [ text "Input chages" ] 83 | , Table.th [] [ text "Job status" ] 84 | , Table.th [] [ text "Time" ] 85 | ] 86 | ] 87 | , Table.tbody [] 88 | (jobset.evaluations 89 | |> List.map 90 | (\evaluation -> 91 | Table.tr [] 92 | [ Table.td [] 93 | [ a 94 | (onClickPage (Urls.Jobset "123" "foo")) 95 | [ text "123" ] 96 | ] 97 | , Table.td [] [ text "snabbBsrc → e1fdc74" ] 98 | , Table.td [] (statusLabels 145 62 23) 99 | , Table.td [] [ text "2016-08-05 13:43:40" ] 100 | ] 101 | ) 102 | ) 103 | ] 104 | ] 105 | ) 106 | ] 107 | -------------------------------------------------------------------------------- /frontend/src/Pages/Project.elm: -------------------------------------------------------------------------------- 1 | module Pages.Project exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Maybe 6 | import List 7 | import Material.Button as Button 8 | import Material.Options as Options 9 | import Material.Elevation as Elevation 10 | import Material.Menu as Menu 11 | import Material.Table as Table 12 | import Material.Textfield as Textfield 13 | import Material.Toggles as Toggles 14 | import Components.LiveSearch exposing (search) 15 | import Components.Help exposing (..) 16 | import Msg exposing (..) 17 | import Models exposing (Project, AppModel) 18 | import Urls exposing (..) 19 | import Utils exposing (..) 20 | 21 | 22 | view : AppModel -> Page -> List (Html Msg) 23 | view model page = 24 | case page of 25 | Home -> 26 | projectsView model model.projects 27 | 28 | Project name -> 29 | case List.head (List.filter (\p -> p.name == name) model.projects) of 30 | Just project -> 31 | [ renderProject model 0 project ] 32 | 33 | Nothing -> 34 | render404 ("Project " ++ name ++ " does not exist.") 35 | 36 | NewProject -> 37 | newProjectView model 38 | 39 | -- TODO: get rid of this 40 | _ -> 41 | [] 42 | 43 | 44 | projectsView : AppModel -> List Project -> List (Html Msg) 45 | projectsView model projects = 46 | let 47 | newprojects = 48 | List.indexedMap (renderProject model) (search projects) 49 | in 50 | renderHeader model "Projects" Nothing (Just NewProject) 51 | ++ if List.isEmpty newprojects then 52 | render404 "Zero projects. Maybe add one?" 53 | else 54 | newprojects 55 | 56 | 57 | newProjectView : AppModel -> List (Html Msg) 58 | newProjectView model = 59 | renderHeader model "Add a new project" Nothing Nothing 60 | ++ [ Html.form [] 61 | [ Textfield.render Mdl 62 | [ 5 ] 63 | model.mdl 64 | [ Textfield.label "Identifier (e.g. hydra)" 65 | , Textfield.floatingLabel 66 | , Textfield.text_ 67 | , Options.css "display" "block" 68 | ] 69 | , Textfield.render Mdl 70 | [ 6 ] 71 | model.mdl 72 | [ Textfield.label "Display name (e.g. Hydra)" 73 | , Textfield.floatingLabel 74 | , Textfield.text_ 75 | , Options.css "display" "block" 76 | ] 77 | , Textfield.render Mdl 78 | [ 7 ] 79 | model.mdl 80 | [ Textfield.label "Description (e.g. Builds Nix expressions and provides insight about the process)" 81 | , Textfield.floatingLabel 82 | , Textfield.text_ 83 | , Options.css "display" "block" 84 | ] 85 | , Textfield.render Mdl 86 | [ 8 ] 87 | model.mdl 88 | [ Textfield.label "URL (e.g. https://github.com/NixOS/hydra)" 89 | , Textfield.floatingLabel 90 | , Textfield.text_ 91 | , Options.css "display" "block" 92 | ] 93 | ] 94 | , Toggles.checkbox Mdl 95 | [ 9 ] 96 | model.mdl 97 | [ Toggles.ripple 98 | --, Toggles.onClick MyToggleMsg 99 | ] 100 | [ text "Is visible on the project list?" ] 101 | , Toggles.checkbox Mdl 102 | [ 10 ] 103 | model.mdl 104 | [ Toggles.ripple 105 | --, Toggles.onClick MyToggleMsg 106 | ] 107 | [ text "Is enabled?" ] 108 | , Textfield.render Mdl 109 | [ 11 ] 110 | model.mdl 111 | [ Textfield.label "Owner" 112 | , Textfield.floatingLabel 113 | , Textfield.text_ 114 | , Options.css "display" "block" 115 | , Textfield.value (Maybe.withDefault "" (Maybe.map (\u -> u.id) model.user)) 116 | ] 117 | , Button.render Mdl 118 | [ 12 ] 119 | model.mdl 120 | [ Button.raised 121 | , Button.colored 122 | --, Button.onClick MyClickMsg 123 | ] 124 | [ text "Create project" ] 125 | ] 126 | 127 | 128 | renderProject : AppModel -> Int -> Project -> Html Msg 129 | renderProject model i project = 130 | Options.div 131 | [ Elevation.e2 132 | , Options.css "margin" "30px" 133 | , Options.css "padding" "8px" 134 | ] 135 | [ h3 136 | [] 137 | [ a (onClickPage (Urls.Project project.name)) 138 | [ Options.span 139 | [ Options.css "margin" "16px" ] 140 | [ text (project.name) ] 141 | ] 142 | , small 143 | [ class "hidden-xs" ] 144 | [ text ("(" ++ project.description ++ ")") ] 145 | -- TODO: correct index 146 | , Menu.render Mdl 147 | [ i + 10 ] 148 | model.mdl 149 | [ Menu.ripple 150 | , Menu.bottomRight 151 | , Options.css "float" "right" 152 | ] 153 | [ Menu.item [] 154 | [ menuIcon "add" 155 | , text "Add a jobset" 156 | ] 157 | , Menu.item [] 158 | [ menuIcon "settings" 159 | , text "Configuration" 160 | ] 161 | , Menu.item [] 162 | [ menuIcon "delete" 163 | , text "Delete the project" 164 | ] 165 | ] 166 | ] 167 | , if List.isEmpty project.jobsets then 168 | Options.span 169 | [ Options.center 170 | , Options.css "margin" "30px" 171 | ] 172 | [ text "No Jobsets configured yet." ] 173 | else 174 | Table.table [ Options.css "width" "100%" ] 175 | [ Table.thead [] 176 | [ Table.tr [] 177 | [ Table.th [] [ text "Jobset", jobsetHelp model ] 178 | , Table.th [] [ text "Description" ] 179 | , Table.th [] [ text "Job status" ] 180 | , Table.th [] [ text "Last evaluation" ] 181 | ] 182 | ] 183 | , Table.tbody [] 184 | (search project.jobsets 185 | |> List.map 186 | (\jobset -> 187 | Table.tr [] 188 | [ Table.td [] 189 | [ a 190 | (onClickPage (Urls.Jobset project.name jobset.id)) 191 | [ text jobset.name ] 192 | ] 193 | , Table.td [] [ text jobset.description ] 194 | , Table.td [] (statusLabels jobset.succeeded jobset.failed jobset.queued) 195 | , Table.td [] [ text jobset.lastEvaluation ] 196 | ] 197 | ) 198 | ) 199 | ] 200 | ] 201 | -------------------------------------------------------------------------------- /frontend/src/Pages/Queue.elm: -------------------------------------------------------------------------------- 1 | module Pages.Queue exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (onClick) 6 | import Models exposing (..) 7 | import Msg exposing (Msg) 8 | import Page exposing (..) 9 | 10 | 11 | queueView : AppModel -> List (Html Msg) 12 | queueView jobset = 13 | [] 14 | -------------------------------------------------------------------------------- /frontend/src/Pages/Search.elm: -------------------------------------------------------------------------------- 1 | module Pages.Search exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (onClick) 6 | import Models exposing (..) 7 | import Msg exposing (Msg) 8 | import Page exposing (..) 9 | 10 | 11 | searchView : AppModel -> List (Html Msg) 12 | searchView jobset = 13 | [] 14 | -------------------------------------------------------------------------------- /frontend/src/Pages/User.elm: -------------------------------------------------------------------------------- 1 | module Pages.User exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (onClick) 6 | import Models exposing (..) 7 | import Msg exposing (Msg) 8 | import Page exposing (..) 9 | 10 | 11 | userView : AppModel -> List (Html Msg) 12 | userView jobset = 13 | [] 14 | -------------------------------------------------------------------------------- /frontend/src/Update.elm: -------------------------------------------------------------------------------- 1 | port module Update exposing (..) 2 | 3 | import Material 4 | import Navigation 5 | import Models exposing (..) 6 | import Msg exposing (..) 7 | import Components.LiveSearch as LiveSearch 8 | import Urls exposing (..) 9 | import UrlParser exposing (parsePath) 10 | 11 | 12 | update : Msg -> AppModel -> ( AppModel, Cmd Msg ) 13 | update msg model = 14 | case msg of 15 | Mdl msg_ -> 16 | Material.update msg_ model 17 | 18 | FetchSucceed init -> 19 | ( model, Cmd.none ) 20 | 21 | FetchFail msg -> 22 | ( model, Cmd.none ) 23 | 24 | LoginUserClick loginType -> 25 | let 26 | -- TODO: well, actually do the login proceedure 27 | user = 28 | { id = "domenkozar" 29 | , name = "Domen Kožar" 30 | , email = "domen@dev.si" 31 | , roles = [] 32 | , recieveEvaluationErrors = False 33 | } 34 | in 35 | case loginType of 36 | Hydra -> 37 | ( { model | user = Just user }, Cmd.none ) 38 | 39 | Google -> 40 | ( { model | user = Just user }, Cmd.none ) 41 | 42 | LogoutUserClick -> 43 | -- TODO: well, should we cleanup something? 44 | ( { model | user = Nothing }, Cmd.none ) 45 | 46 | PreferencesClick -> 47 | ( model, Cmd.none ) 48 | 49 | LiveSearchMsg searchmsg -> 50 | let 51 | ( newmodel, cmds ) = 52 | LiveSearch.update searchmsg model 53 | in 54 | ( newmodel, Cmd.map LiveSearchMsg cmds ) 55 | 56 | NewPage page -> 57 | ( model, Navigation.newUrl (pageToURL page) ) 58 | 59 | ClickCreateProject -> 60 | -- TODO: http 61 | ( model, Cmd.none ) 62 | 63 | UrlChange location -> 64 | let 65 | page = Maybe.withDefault Home (parsePath pageParser location) 66 | in 67 | ( { model | currentPage = page } 68 | , title (pageToTitle page) 69 | ) 70 | 71 | -- Ports 72 | 73 | 74 | port title : String -> Cmd msg 75 | -------------------------------------------------------------------------------- /frontend/src/Urls.elm: -------------------------------------------------------------------------------- 1 | module Urls exposing (..) 2 | 3 | import Debug 4 | import Navigation 5 | import String 6 | import UrlParser exposing (Parser, (), map, int, oneOf, s, string) 7 | 8 | 9 | {-| Main type representing current url/page 10 | -} 11 | type Page 12 | = Home 13 | | Project String 14 | | NewProject 15 | | Jobset String String 16 | 17 | 18 | pageParser : Parser (Page -> a) a 19 | pageParser = 20 | oneOf 21 | [ map Home (s "") 22 | , map Project (s "project" string) 23 | , map NewProject (s "create-project") 24 | , map Jobset (s "jobset" string string) 25 | ] 26 | 27 | 28 | pageToURL : Page -> String 29 | pageToURL page = 30 | case page of 31 | Home -> 32 | "/" 33 | 34 | Project name -> 35 | "/project/" ++ name 36 | 37 | NewProject -> 38 | "/create-project" 39 | 40 | Jobset project jobset -> 41 | "/jobset/" ++ project ++ "/" ++ jobset 42 | 43 | 44 | pageToTitle : Page -> String 45 | pageToTitle page = 46 | case page of 47 | Home -> 48 | "Projects" 49 | 50 | Project name -> 51 | "Project " ++ name 52 | 53 | NewProject -> 54 | "New Project" 55 | 56 | Jobset project jobset -> 57 | "Jobset " ++ jobset ++ " of project " ++ project 58 | -------------------------------------------------------------------------------- /frontend/src/Utils.elm: -------------------------------------------------------------------------------- 1 | module Utils exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Html.Events exposing (..) 6 | import Json.Decode as Json 7 | import Material.Elevation as Elevation 8 | import Material.Button as Button 9 | import Material.Color as Color 10 | import Material.Icon as Icon 11 | import Material.Options as Options 12 | import Msg exposing (..) 13 | import Urls exposing (..) 14 | import Models exposing (..) 15 | 16 | 17 | menuIcon : String -> Html Msg 18 | menuIcon name = 19 | Icon.view name [ Options.css "width" "40px" ] 20 | 21 | 22 | onPreventDefaultClick : msg -> Attribute msg 23 | onPreventDefaultClick message = 24 | onWithOptions "click" { defaultOptions | preventDefault = True } (Json.succeed message) 25 | 26 | 27 | onClickPage : Page -> List (Attribute Msg) 28 | onClickPage page = 29 | [ style [ ( "pointer", "cursor" ) ] 30 | , href (pageToURL page) 31 | , onPreventDefaultClick (NewPage page) 32 | ] 33 | 34 | 35 | optionalTag : Bool -> Html Msg -> Html Msg 36 | optionalTag doInclude html = 37 | if doInclude then 38 | html 39 | else 40 | text "" 41 | 42 | 43 | statusLabels : Int -> Int -> Int -> List (Html Msg) 44 | statusLabels succeeded failed queued = 45 | [ optionalTag (succeeded > 0) 46 | (badge 47 | (Color.color Color.Green Color.S500) 48 | [ Options.attribute <| title "Jobs succeeded" ] 49 | [ text (toString succeeded) ] 50 | ) 51 | , optionalTag (failed > 0) 52 | (badge 53 | (Color.color Color.Red Color.S500) 54 | [ Options.attribute <| title "Jobs failed" ] 55 | [ text (toString failed) ] 56 | ) 57 | , optionalTag (queued > 0) 58 | (badge 59 | (Color.color Color.Grey Color.S500) 60 | [ Options.attribute <| title "Jobs in queue" ] 61 | [ text (toString queued) ] 62 | ) 63 | ] 64 | 65 | 66 | badge : Color.Color -> List (Options.Property c Msg) -> List (Html Msg) -> Html Msg 67 | badge color properties content = 68 | Options.span 69 | ([ Options.css "border-radius" "9px" 70 | , Options.css "padding" "3px 5px" 71 | , Options.css "line-height" "14px" 72 | , Options.css "white-space" "nowrap" 73 | , Options.css "font-weight" "bold" 74 | , Options.css "font-size" "12px" 75 | , Options.css "margin" "0 3px" 76 | , Options.css "cursor" "help" 77 | , Options.css "color" 78 | (if color == Color.white then 79 | "#000" 80 | else 81 | "#FFF" 82 | ) 83 | , Color.background color 84 | ] 85 | ++ properties 86 | ) 87 | content 88 | 89 | 90 | whiteBadge : List (Options.Property c Msg) -> List (Html Msg) -> Html Msg 91 | whiteBadge properties content = 92 | badge Color.white properties content 93 | 94 | 95 | render404 : String -> List (Html Msg) 96 | render404 reason = 97 | [ Options.div 98 | [ Elevation.e2 99 | , Options.css "padding" "40px" 100 | , Options.center 101 | ] 102 | [ text reason ] 103 | ] 104 | 105 | 106 | renderHeader : AppModel -> String -> Maybe String -> Maybe Page -> List (Html Msg) 107 | renderHeader model name subname page = 108 | let 109 | subnameHtml = 110 | case subname of 111 | Nothing -> 112 | [] 113 | 114 | Just s -> 115 | [ small [ style [ ( "margin-left", "10px" ) ] ] 116 | [ text s ] 117 | ] 118 | 119 | pageHtml = 120 | case page of 121 | Nothing -> 122 | [] 123 | 124 | Just p -> 125 | [ Button.render Mdl 126 | [ 2 ] 127 | model.mdl 128 | [ Button.fab 129 | , Button.colored 130 | , Button.onClick (NewPage p) 131 | , Options.css "margin-left" "20px" 132 | ] 133 | [ Icon.i "add" ] 134 | ] 135 | in 136 | [ h1 137 | [ style [ ( "margin-bottom", "30px" ) ] ] 138 | ([ text name ] ++ subnameHtml ++ pageHtml) 139 | ] 140 | -------------------------------------------------------------------------------- /frontend/src/View.elm: -------------------------------------------------------------------------------- 1 | module View exposing (..) 2 | 3 | import Html exposing (..) 4 | import Html.Attributes exposing (..) 5 | import Maybe 6 | import List 7 | import Material.Scheme 8 | import Material.Color as Color 9 | import Material.Layout as Layout 10 | import Material.Options as Options 11 | import Material.Footer as Footer 12 | import Components.Navbar as Navbar 13 | import Pages.Project exposing (..) 14 | import Pages.Jobset as Jobset exposing (..) 15 | import Msg exposing (..) 16 | import Models exposing (..) 17 | import Utils exposing (..) 18 | import Urls exposing (..) 19 | 20 | 21 | view : AppModel -> Html Msg 22 | view model = 23 | Options.div 24 | [] 25 | [ Material.Scheme.topWithScheme Color.BlueGrey Color.LightBlue <| 26 | Layout.render Mdl 27 | model.mdl 28 | [ Layout.fixedHeader ] 29 | { header = Navbar.view model 30 | , drawer = [] 31 | , tabs = ( Navbar.tabs model, [ Color.background (Color.color Color.LightBlue Color.A700) ] ) 32 | , main = viewBody model 33 | } 34 | ] 35 | 36 | 37 | viewBody : AppModel -> List (Html Msg) 38 | viewBody model = 39 | let 40 | softwareLink name url version = 41 | p [] 42 | [ a [ href url ] 43 | [ text name ] 44 | , span [] 45 | [ text " @ " 46 | , text version 47 | ] 48 | ] 49 | in 50 | Options.div 51 | [ Options.css "margin" "30px" 52 | , Options.css "min-height" "100%" 53 | ] 54 | (pageToView model) 55 | :: [ Footer.mini 56 | [ Options.css "position" "absolute" 57 | , Options.css "bottom" "-70px" 58 | , Options.css "width" "100%" 59 | ] 60 | { left = 61 | Footer.left [] 62 | [ Footer.logo 63 | [] 64 | [] 65 | ] 66 | , right = 67 | Footer.right [] 68 | [ Footer.logo 69 | [] 70 | [ Footer.html <| softwareLink "Nix" "http://nixos.org/nix/" model.hydraConfig.nixVersion 71 | , Footer.html <| softwareLink "Hydra" "http://nixos.org/hydra/" model.hydraConfig.hydraVersion 72 | ] 73 | ] 74 | } 75 | ] 76 | 77 | 78 | pageToView : AppModel -> List (Html Msg) 79 | pageToView model = 80 | case model.currentPage of 81 | Home -> 82 | Pages.Project.view model model.currentPage 83 | 84 | Project name -> 85 | Pages.Project.view model model.currentPage 86 | 87 | NewProject -> 88 | Pages.Project.view model model.currentPage 89 | 90 | Jobset projectName jobsetName -> 91 | case List.head (List.filter (\p -> p.name == projectName) model.projects) of 92 | Just project -> 93 | case List.head (List.filter (\j -> j.name == jobsetName) project.jobsets) of 94 | Just jobset -> 95 | Jobset.view model 96 | 97 | Nothing -> 98 | render404 ("Jobset " ++ jobsetName ++ " does not exist.") 99 | 100 | Nothing -> 101 | render404 ("Project " ++ projectName ++ " does not exist.") 102 | -------------------------------------------------------------------------------- /frontend/src/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /frontend/src/index.js: -------------------------------------------------------------------------------- 1 | 'use strict'; 2 | 3 | // Require index.html so it gets copied to dist 4 | require('./index.html'); 5 | 6 | var app = require('./Main.elm').Main.fullscreen({ 7 | backendURL: process.env.BACKEND_URL 8 | }); 9 | 10 | app.ports.title.subscribe(function(title) { 11 | document.title = "Hercules - " + title; 12 | }); 13 | -------------------------------------------------------------------------------- /frontend/webpack.config.js: -------------------------------------------------------------------------------- 1 | var path = require("path"), 2 | webpack = require('webpack'); 3 | 4 | module.exports = { 5 | entry: { 6 | app: [ 7 | './src/index.js' 8 | ] 9 | }, 10 | 11 | output: { 12 | path: path.resolve(__dirname + '/dist'), 13 | filename: 'app.js', 14 | }, 15 | 16 | module: { 17 | loaders: [ 18 | { 19 | test: /\.html$/, 20 | include: /src/, 21 | loader: 'file?name=[name].[ext]', 22 | }, 23 | { 24 | test: /\.elm$/, 25 | include: /src/, 26 | loader: 'elm-hot!elm-webpack?warn=true', 27 | } 28 | ], 29 | noParse: /\.elm$/, 30 | }, 31 | 32 | plugins: [ 33 | new webpack.EnvironmentPlugin(["BACKEND_URL"]) 34 | ], 35 | 36 | devServer: { 37 | inline: true, 38 | stats: 'errors-only', 39 | historyApiFallback: true, 40 | headers: { 41 | "Access-Control-Allow-Origin": "*", 42 | "Access-Control-Allow-Methods": "GET, POST, PUT, DELETE, PATCH, OPTIONS", 43 | "Access-Control-Allow-Headers": "X-Requested-With, content-type, Authorization" 44 | } 45 | }, 46 | }; 47 | -------------------------------------------------------------------------------- /haskell-packages.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? (import ./../pkgs.nix) {} }: 2 | 3 | rec { 4 | haskellPackages = pkgs.haskell.packages.ghc802.override { 5 | overrides = 6 | self: super: { 7 | # https://github.com/folsen/opaleye-gen/issues/8 8 | opaleye-gen = haskellPackageGen { doFilter = false; } ( 9 | pkgs.fetchFromGitHub { 10 | owner = "folsen"; 11 | repo = "opaleye-gen"; 12 | rev = "14938df0081187539f23f8547fb1b7762e286ac3"; 13 | sha256 = "1xapgyhkn71m0arb06rv5b1cncz5gv9lybi3q4yavs8zh4jbkbn7"; 14 | } 15 | ); 16 | 17 | servant-auth-swagger = 18 | let 19 | src = pkgs.fetchFromGitHub { 20 | owner = "plow-technologies"; 21 | repo = "servant-auth"; 22 | rev = "fba71585cd39bd16e86580d5320f20e486d5b05a"; 23 | sha256 = "14ihr5cr7jrqwk9990m64jmw0h4gvrakffddlagm5bm85z0x6csr"; 24 | }; 25 | in pkgs.haskell.lib.doJailbreak (haskellPackageGen { doFilter = false; } "${src}/servant-auth-swagger"); 26 | 27 | # New versions for opaleye-gen 28 | product-profunctors = super.product-profunctors_0_8_0_3; 29 | }; 30 | }; 31 | 32 | # haskellPackageGen takes some options and a source location and generates a 33 | # derivation which builds the haskell package at that source location. 34 | haskellPackageGen = { doFilter ? true 35 | , doHaddock ? true 36 | , extraEnvPackages ? [] # Any extra packages to be made available in the developer shell only 37 | }: src: 38 | let filteredSrc = builtins.filterSource (path: type: 39 | type != "unknown" && 40 | (baseNameOf path == "dist" -> type != "directory") 41 | ) src; 42 | 43 | package = pkgs.runCommand "default.nix" {} '' 44 | ${pkgs.haskell.packages.ghc802.cabal2nix}/bin/cabal2nix \ 45 | ${if doFilter then filteredSrc else src} \ 46 | ${if doHaddock then "" else "--no-haddock"} \ 47 | > $out 48 | ''; 49 | 50 | drv = haskellPackages.callPackage package {}; 51 | 52 | envWithExtras = pkgs.lib.overrideDerivation drv.env (attrs: { 53 | buildInputs = attrs.buildInputs ++ extraEnvPackages; 54 | }); 55 | in drv // { env = envWithExtras; }; 56 | } 57 | -------------------------------------------------------------------------------- /pkgs.nix: -------------------------------------------------------------------------------- 1 | import (fetchTarball https://github.com/NixOS/nixpkgs/archive/57e768f58e7d2019ea19520226d5fb6e05e98c96.tar.gz) 2 | --------------------------------------------------------------------------------