├── .envrc ├── .gitignore ├── CODE_OF_CONDUCT.md ├── LICENCE ├── Makefile ├── README.md ├── Setup.hs ├── app └── Main.hs ├── artiflakery.cabal ├── default.nix ├── flake.lock ├── flake.nix ├── hie.yaml ├── module.nix ├── package.nix ├── package.yaml ├── pdf-viewer.html ├── src ├── Auth.hs ├── AutoReload.hs ├── BuildFlake.hs ├── Config.hs ├── Logger.hs └── Server.hs ├── stack.yaml └── stack.yaml.lock /.envrc: -------------------------------------------------------------------------------- 1 | use flake 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ 3 | data 4 | auth.txt 5 | routes.txt 6 | result 7 | secret-key 8 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity 10 | and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the 26 | overall community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at 63 | julien@malka.sh. 64 | All complaints will be reviewed and investigated promptly and fairly. 65 | 66 | All community leaders are obligated to respect the privacy and security of the 67 | reporter of any incident. 68 | 69 | ## Enforcement Guidelines 70 | 71 | Community leaders will follow these Community Impact Guidelines in determining 72 | the consequences for any action they deem in violation of this Code of Conduct: 73 | 74 | ### 1. Correction 75 | 76 | **Community Impact**: Use of inappropriate language or other behavior deemed 77 | unprofessional or unwelcome in the community. 78 | 79 | **Consequence**: A private, written warning from community leaders, providing 80 | clarity around the nature of the violation and an explanation of why the 81 | behavior was inappropriate. A public apology may be requested. 82 | 83 | ### 2. Warning 84 | 85 | **Community Impact**: A violation through a single incident or series 86 | of actions. 87 | 88 | **Consequence**: A warning with consequences for continued behavior. No 89 | interaction with the people involved, including unsolicited interaction with 90 | those enforcing the Code of Conduct, for a specified period of time. This 91 | includes avoiding interactions in community spaces as well as external channels 92 | like social media. Violating these terms may lead to a temporary or 93 | permanent ban. 94 | 95 | ### 3. Temporary Ban 96 | 97 | **Community Impact**: A serious violation of community standards, including 98 | sustained inappropriate behavior. 99 | 100 | **Consequence**: A temporary ban from any sort of interaction or public 101 | communication with the community for a specified period of time. No public or 102 | private interaction with the people involved, including unsolicited interaction 103 | with those enforcing the Code of Conduct, is allowed during this period. 104 | Violating these terms may lead to a permanent ban. 105 | 106 | ### 4. Permanent Ban 107 | 108 | **Community Impact**: Demonstrating a pattern of violation of community 109 | standards, including sustained inappropriate behavior, harassment of an 110 | individual, or aggression toward or disparagement of classes of individuals. 111 | 112 | **Consequence**: A permanent ban from any sort of public interaction within 113 | the community. 114 | 115 | ## Attribution 116 | 117 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 118 | version 2.0, available at 119 | https://www.contributor-covenant.org/version/2/0/code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at 128 | https://www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /LICENCE: -------------------------------------------------------------------------------- 1 | EUROPEAN UNION PUBLIC LICENCE v. 1.2 2 | EUPL © the European Union 2007, 2016 3 | 4 | This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such use is covered by a right of the copyright holder of the Work). 5 | 6 | The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following notice immediately following the copyright notice for the Work: 7 | 8 | Licensed under the EUPL 9 | 10 | or has expressed by any other means his willingness to license under the EUPL. 11 | 12 | 1. Definitions 13 | In this Licence, the following terms have the following meaning: 14 | 15 | — ‘The Licence’: this Licence. 16 | 17 | — ‘The Original Work’: the work or software distributed or communicated by the Licensor under this Licence, available as Source Code and also as Executable Code as the case may be. 18 | 19 | — ‘Derivative Works’: the works or software that could be created by the Licensee, based upon the Original Work or modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in the country mentioned in Article 15. 20 | 21 | — ‘The Work’: the Original Work or its Derivative Works. 22 | 23 | — ‘The Source Code’: the human-readable form of the Work which is the most convenient for people to study and modify. 24 | 25 | — ‘The Executable Code’: any code which has generally been compiled and which is meant to be interpreted by a computer as a program. 26 | 27 | — ‘The Licensor’: the natural or legal person that distributes or communicates the Work under the Licence. 28 | 29 | — ‘Contributor(s)’: any natural or legal person who modifies the Work under the Licence, or otherwise contributes to the creation of a Derivative Work. 30 | 31 | — ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of the Work under the terms of the Licence. 32 | 33 | — ‘Distribution’ or ‘Communication’: any act of selling, giving, lending, renting, distributing, communicating, transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential functionalities at the disposal of any other natural or legal person. 34 | 35 | 2. Scope of the rights granted by the Licence 36 | The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for the duration of copyright vested in the Original Work: 37 | 38 | — use the Work in any circumstance and for all usage, 39 | 40 | — reproduce the Work, 41 | 42 | — modify the Work, and make Derivative Works based upon the Work, 43 | 44 | — communicate to the public, including the right to make available or display the Work or copies thereof to the public and perform publicly, as the case may be, the Work, 45 | 46 | — distribute the Work or copies thereof, 47 | 48 | — lend and rent the Work or copies thereof, 49 | 50 | — sublicense rights in the Work or copies thereof. 51 | 52 | Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the applicable law permits so. 53 | 54 | In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed by law in order to make effective the licence of the economic rights here above listed. 55 | 56 | The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the extent necessary to make use of the rights granted on the Work under this Licence. 57 | 58 | 3. Communication of the Source Code 59 | The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to distribute or communicate the Work. 60 | 61 | 4. Limitations on copyright 62 | Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations thereto. 63 | 64 | 5. Obligations of the Licensee 65 | The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those obligations are the following: 66 | 67 | Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work to carry prominent notices stating that the Work has been modified and the date of modification. 68 | Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless the Original Work is expressly distributed only under this version of the Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the Work or Derivative Work that alter or restrict the terms of the Licence. 69 | Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. 70 | Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available for as long as the Licensee continues to distribute or communicate the Work. 71 | Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the copyright notice. 72 | 6. Chain of Authorship 73 | The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. 74 | 75 | Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or licensed to him/her and that he/she has the power and authority to grant the Licence. 76 | 77 | Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contri­ butions to the Work, under the terms of this Licence. 78 | 79 | 7. Disclaimer of Warranty 80 | The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work and may therefore contain defects or ‘bugs’ inherent to this type of development. 81 | 82 | For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this Licence. 83 | 84 | This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. 85 | 86 | 8. Disclaimer of Liability 87 | Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. 88 | 89 | 9. Additional agreements 90 | While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by the fact You have accepted any warranty or additional liability. 91 | 92 | 10. Acceptance of the Licence 93 | The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms and conditions. 94 | 95 | Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution or Communication by You of the Work or copies thereof. 96 | 97 | 11. Information to the public 98 | In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, by offering to download the Work from a remote location) the distribution channel or media (for example, a website) must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence and the way it may be accessible, concluded, stored and reproduced by the Licensee. 99 | 100 | 12. Termination of the Licence 101 | The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms of the Licence. 102 | 103 | Such a termination will not terminate the licences of any person who has received the Work from the Licensee under the Licence, provided such persons remain in full compliance with the Licence. 104 | 105 | 13. Miscellaneous 106 | Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the Work. 107 | 108 | If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid and enforceable. 109 | 110 | The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. New versions of the Licence will be published with a unique version number. 111 | 112 | All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take advantage of the linguistic version of their choice. 113 | 114 | 14. Jurisdiction 115 | Without prejudice to specific agreement between parties, 116 | 117 | — any litigation resulting from the interpretation of this License, arising between the European Union institutions, bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, 118 | 119 | — any litigation arising between other parties and resulting from the interpretation of this License, will be subject to the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. 120 | 121 | 15. Applicable Law 122 | Without prejudice to specific agreement between parties, 123 | 124 | — this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, resides or has his registered office, 125 | 126 | — this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside a European Union Member State. 127 | 128 | Appendix 129 | ‘Compatible Licences’ according to Article 5 EUPL are: 130 | 131 | — GNU General Public License (GPL) v. 2, v. 3 132 | 133 | — GNU Affero General Public License (AGPL) v. 3 134 | 135 | — Open Software License (OSL) v. 2.1, v. 3.0 136 | 137 | — Eclipse Public License (EPL) v. 1.0 138 | 139 | — CeCILL v. 2.0, v. 2.1 140 | 141 | — Mozilla Public Licence (MPL) v. 2 142 | 143 | — GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 144 | 145 | — Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software 146 | 147 | — European Union Public Licence (EUPL) v. 1.1, v. 1.2 148 | 149 | — Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) 150 | 151 | The European Commission may update this Appendix to later versions of the above licences without producing a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the covered Source Code from exclusive appropriation. 152 | 153 | All other changes or additions to this Appendix require the production of a new EUPL version. 154 | 155 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | BIN_DIR=$(shell stack path --local-install-root)/bin 2 | 3 | build: 4 | stack build 5 | 6 | run: build 7 | exec $(BIN_DIR)/artiflakery-exe --routes routes.txt --auth auth.txt 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Artiflakery 2 | 3 | Artiflakery is a webserver for on the fly delivery of flake artifacts. 4 | 5 | It allows you to define pairs such as `(route1, flakeref1)` such that upon loading `route1`, the default package of `flakeref1` gets served. 6 | Each route can be public or limited to groups of authenticated users. 7 | 8 | ## 🔁 Auto reload 9 | 10 | Upon load of a route, Artiflakery serves the last built output for the associated flakeref and launch an asynchroneous rebuild of the artifact. If an flakeref produces a different artifact, all the open pages for the associated route get reloaded. 11 | 12 | 13 | # ⚙️ Configuration 14 | 15 | Artiflakery is configured through 2 configuration files: 16 | 17 | ## 🛤️ Routes 18 | 19 | Routes are defined in a textual file with lines of the format `route flakeref authgroup1 authgroup2 ... authgroupn`, for example: 20 | 21 | ``` 22 | /hello/world/ github:hello/world#test public 23 | /foo/bar/ github:foo/bar?dir=test admins friends 24 | /hello/test/ github:hello/test admins 25 | ``` 26 | 27 | ## 🔓 Authentification groups 28 | 29 | Authentification groups are defined in a textual file with lines of the format `groupname,username:bcrypt_hash`, where `username:bcrypt_hash` can be obtained by running `htpasswd -nB $user`. 30 | 31 | The special `public` group can be assigned to resources that should be accessed publicly. 32 | 33 | 34 | ## Running the program 35 | 36 | As a standalone, run `artiflakery --routes routes.txt --auth auth.txt` 37 | 38 | 39 | # NixOS module 40 | 41 | This repository exports a NixOS module for streamlined configuration and deployment of Artifactory. 42 | 43 | A typical configuration could look like this: 44 | 45 | ```nix 46 | services.artiflakery = { 47 | enable = true; 48 | authFile = "/server/artiflakery-auth.txt"; 49 | routes = { 50 | "/hello/world/" = { 51 | flakeref = "github:foo/bar?dir=test"; 52 | access = [ 53 | "admins" 54 | "friends" 55 | ]; 56 | }; 57 | "/foo/bar/" = { 58 | flakeref = "github:foo/bar?dir=test"; 59 | access = [ 60 | "public" 61 | ]; 62 | }; 63 | }; 64 | }; 65 | ``` 66 | 67 | 68 | 69 | 70 | 71 | 72 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DerivingStrategies #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | {-# LANGUAGE PartialTypeSignatures #-} 8 | {-# LANGUAGE RankNTypes #-} 9 | {-# LANGUAGE ScopedTypeVariables #-} 10 | {-# OPTIONS_GHC -Wno-type-defaults #-} 11 | {-# OPTIONS_GHC -Wno-unused-top-binds #-} 12 | 13 | module Main (main) where 14 | 15 | import Auth 16 | ( checkBasicAuth, 17 | getSecretKey, 18 | isAuthorized, 19 | makeSecureCookieHeader, 20 | parseAuthFile, 21 | signCookieValue, 22 | ) 23 | import AutoReload (addClient, connId, removeClient) 24 | import BuildFlake (buildFlakeWithLogging) 25 | import Colog.Message 26 | import Colog.Monad 27 | import Config (FlakeRef, Group, Route, RouteMap, UserDB, parseConfigFile) 28 | import Control.Concurrent.Async 29 | import Control.Exception (finally) 30 | import Control.Monad (forever, void, when) 31 | import Control.Monad.IO.Class 32 | import Data.List (maximumBy) 33 | import qualified Data.Map.Strict as Map 34 | import Data.Ord (comparing) 35 | import Data.Text (Text) 36 | import qualified Data.Text as T 37 | import Data.Text.Encoding (decodeUtf8, encodeUtf8) 38 | import Logger 39 | import Network.HTTP.Types 40 | import Network.Wai 41 | import Network.Wai.Application.Static (defaultFileServerSettings, ssAddTrailingSlash, staticApp) 42 | import Network.Wai.Handler.Warp (run) 43 | import Network.Wai.Handler.WebSockets (websocketsApp) 44 | import Network.WebSockets hiding (Message) 45 | import Options.Applicative 46 | import Server 47 | import System.Directory 48 | import System.FilePath (dropTrailingPathSeparator, takeDirectory) 49 | import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) 50 | 51 | findMatchingRoute :: Text -> RouteMap -> Maybe (Route, (FlakeRef, [Group])) 52 | findMatchingRoute path routeMap = 53 | let normalized = T.dropWhile (== '/') path <> "/" 54 | isMatch (r, _) = r `T.isPrefixOf` normalized 55 | matches = filter isMatch (Map.toList routeMap) 56 | in case filter isMatch (Map.toList routeMap) of 57 | [] -> Nothing 58 | _ -> Just $ maximumBy (comparing (T.length . fst)) matches 59 | 60 | app :: 61 | RouteMap -> 62 | UserDB -> 63 | LoggedApplication env m 64 | app routeMap authDB req respond = do 65 | secret <- liftIO $ getSecretKey 66 | let rawPath = decodeUtf8 $ rawPathInfo req 67 | normalizedPath = T.dropWhile (== '/') rawPath 68 | logDebug $ "Incoming request path: " <> normalizedPath 69 | case findMatchingRoute normalizedPath routeMap of 70 | Nothing -> do 71 | logWarning $ "No matching auth route. Serving static: " <> normalizedPath 72 | liftIO $ staticApp (defaultFileServerSettings "data") {ssAddTrailingSlash = True} req respond 73 | Just (matchedRoute, (_, allowedGroups)) -> do 74 | if normalizedPath /= matchedRoute && (normalizedPath <> "/") == matchedRoute 75 | then liftIO $ respond $ responseBuilder status301 [("Location", encodeUtf8 ("/" <> matchedRoute))] mempty 76 | else do 77 | (authorized, groups) <- isAuthorized allowedGroups req 78 | if authorized 79 | then serve normalizedPath routeMap authDB req respond 80 | else do 81 | result <- liftIO $ checkBasicAuth authDB allowedGroups req 82 | case result of 83 | Just group -> do 84 | let groupStr = signCookieValue secret (encodeUtf8 (T.intercalate "," (group : groups))) 85 | cookieHeader <- liftIO $ makeSecureCookieHeader (decodeUtf8 groupStr) 86 | serve matchedRoute routeMap authDB req $ \resp -> 87 | respond $ mapResponseHeaders ((cookieHeader :) . filter (\(h, _) -> h /= "Set-Cookie")) resp 88 | Nothing -> 89 | liftIO $ 90 | respond $ 91 | responseLBS 92 | status401 93 | [("WWW-Authenticate", "Basic realm=\"Access to " <> encodeUtf8 matchedRoute <> "\"")] 94 | "Unauthorized" 95 | 96 | webSocketHandler :: (WithLog env Message m, MonadIO m) => PendingConnection -> m () 97 | webSocketHandler pendingConn = do 98 | logInfo "New WebSocket connection accepted." 99 | conn <- liftIO $ acceptRequest pendingConn 100 | client <- liftIO $ addClient conn 101 | _ <- 102 | liftIO $ 103 | finally 104 | (forever $ void (receiveData conn :: IO Text)) 105 | (pure ()) 106 | logInfo $ "Closing connection: " <> T.pack (show (connId client)) 107 | liftIO $ removeClient (connId client) 108 | 109 | createDataSkeleton :: (WithLog env Message m, MonadIO m) => RouteMap -> m () 110 | createDataSkeleton routeMap = do 111 | logInfo "Creating data skeleton..." 112 | dataExists <- liftIO $ doesDirectoryExist "data" 113 | when dataExists $ liftIO $ removeDirectoryRecursive "data" 114 | let createR r = createDirectoryIfMissing True ("data/" ++ takeDirectory (dropTrailingPathSeparator (T.unpack r))) 115 | liftIO $ mapM_ createR (Map.keys routeMap) 116 | 117 | appWithLogging :: forall env m. RouteMap -> UserDB -> LoggedApplication env m 118 | appWithLogging routeMap authDB req respond = 119 | do 120 | case websocketsApp defaultConnectionOptions (usingLoggerT coloredLogAction . webSocketHandler) req of 121 | Just wsResp -> liftIO $ respond wsResp 122 | Nothing -> app routeMap authDB req respond 123 | 124 | data AppOptions = AppOptions 125 | { routesFile :: FilePath, 126 | authFile :: FilePath 127 | } 128 | 129 | parseOptions :: Parser AppOptions 130 | parseOptions = 131 | AppOptions 132 | <$> strOption 133 | ( long "routes" 134 | <> metavar "FILE" 135 | <> help "Routes configuration file" 136 | <> showDefault 137 | ) 138 | <*> strOption 139 | ( long "auth" 140 | <> metavar "FILE" 141 | <> help "Authentication database file" 142 | <> showDefault 143 | ) 144 | 145 | main :: IO () 146 | main = do 147 | hSetBuffering stdout LineBuffering 148 | options <- execParser opts 149 | routeMap <- parseConfigFile (routesFile options) 150 | authDB <- parseAuthFile (authFile options) 151 | 152 | usingLoggerT coloredLogAction $ createDataSkeleton routeMap 153 | 154 | _ <- async $ usingLoggerT coloredLogAction $ mapM_ (uncurry buildFlakeWithLogging) (Map.toList $ Map.map fst routeMap) 155 | 156 | let loggedApp = appWithLogging routeMap authDB 157 | let app' req respond = usingLoggerT coloredLogAction (loggedApp req respond) 158 | 159 | run 8090 app' 160 | where 161 | opts = 162 | info 163 | (parseOptions <**> helper) 164 | ( fullDesc 165 | <> progDesc "Run the web application with custom routes and auth files" 166 | <> header "Web App - A configurable web application" 167 | ) 168 | -------------------------------------------------------------------------------- /artiflakery.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.38.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: artiflakery 8 | version: 1.0.0 9 | description: A webserver for on the fly delivery of Nix flake artifacts 10 | homepage: https://github.com/JulienMalka/artiflakery#readme 11 | bug-reports: https://github.com/JulienMalka/artiflakery/issues 12 | author: Julien Malka 13 | maintainer: julien.malka@me.com 14 | copyright: 2025 Julien Malka 15 | license: EUPL-1.2 16 | build-type: Simple 17 | extra-source-files: 18 | README.md 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/JulienMalka/artiflakery 23 | 24 | library 25 | exposed-modules: 26 | Auth 27 | AutoReload 28 | BuildFlake 29 | Config 30 | Logger 31 | Server 32 | other-modules: 33 | Paths_artiflakery 34 | autogen-modules: 35 | Paths_artiflakery 36 | hs-source-dirs: 37 | src 38 | default-extensions: 39 | OverloadedStrings 40 | ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints 41 | build-depends: 42 | ansi-terminal 43 | , async 44 | , base >=4.7 && <5 45 | , base64-bytestring 46 | , bcrypt 47 | , bytestring 48 | , co-log 49 | , co-log-core 50 | , containers 51 | , cookie 52 | , crypton 53 | , directory 54 | , exceptions 55 | , file-embed 56 | , filepath 57 | , http-types 58 | , optparse-applicative 59 | , process 60 | , text 61 | , time 62 | , unix 63 | , wai >=3.2 64 | , wai-app-static 65 | , wai-websockets 66 | , warp 67 | , websockets 68 | default-language: Haskell2010 69 | 70 | executable artiflakery-exe 71 | main-is: Main.hs 72 | other-modules: 73 | Paths_artiflakery 74 | autogen-modules: 75 | Paths_artiflakery 76 | hs-source-dirs: 77 | app 78 | ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N 79 | build-depends: 80 | ansi-terminal 81 | , artiflakery 82 | , async 83 | , base >=4.7 && <5 84 | , base64-bytestring 85 | , bcrypt 86 | , bytestring 87 | , co-log 88 | , co-log-core 89 | , containers 90 | , cookie 91 | , crypton 92 | , directory 93 | , exceptions 94 | , file-embed 95 | , filepath 96 | , http-types 97 | , optparse-applicative 98 | , process 99 | , text 100 | , time 101 | , unix 102 | , wai >=3.2 103 | , wai-app-static 104 | , wai-websockets 105 | , warp 106 | , websockets 107 | default-language: Haskell2010 108 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | (import ( 2 | let 3 | lock = builtins.fromJSON (builtins.readFile ./flake.lock); 4 | in 5 | fetchTarball { 6 | url = 7 | lock.nodes.flake-compat.locked.url 8 | or "https://github.com/edolstra/flake-compat/archive/${lock.nodes.flake-compat.locked.rev}.tar.gz"; 9 | sha256 = lock.nodes.flake-compat.locked.narHash; 10 | } 11 | ) { src = ./.; }).defaultNix 12 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-compat": { 4 | "locked": { 5 | "lastModified": 1747046372, 6 | "narHash": "sha256-CIVLLkVgvHYbgI2UpXvIIBJ12HWgX+fjA8Xf8PUmqCY=", 7 | "owner": "edolstra", 8 | "repo": "flake-compat", 9 | "rev": "9100a0f413b0c601e0533d1d94ffd501ce2e7885", 10 | "type": "github" 11 | }, 12 | "original": { 13 | "owner": "edolstra", 14 | "repo": "flake-compat", 15 | "type": "github" 16 | } 17 | }, 18 | "flake-utils": { 19 | "inputs": { 20 | "systems": "systems" 21 | }, 22 | "locked": { 23 | "lastModified": 1731533236, 24 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 25 | "owner": "numtide", 26 | "repo": "flake-utils", 27 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "owner": "numtide", 32 | "repo": "flake-utils", 33 | "type": "github" 34 | } 35 | }, 36 | "nixpkgs": { 37 | "locked": { 38 | "lastModified": 1747327360, 39 | "narHash": "sha256-LSmTbiq/nqZR9B2t4MRnWG7cb0KVNU70dB7RT4+wYK4=", 40 | "owner": "nixos", 41 | "repo": "nixpkgs", 42 | "rev": "e06158e58f3adee28b139e9c2bcfcc41f8625b46", 43 | "type": "github" 44 | }, 45 | "original": { 46 | "owner": "nixos", 47 | "ref": "nixos-unstable", 48 | "repo": "nixpkgs", 49 | "type": "github" 50 | } 51 | }, 52 | "root": { 53 | "inputs": { 54 | "flake-compat": "flake-compat", 55 | "flake-utils": "flake-utils", 56 | "nixpkgs": "nixpkgs" 57 | } 58 | }, 59 | "systems": { 60 | "locked": { 61 | "lastModified": 1681028828, 62 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 63 | "owner": "nix-systems", 64 | "repo": "default", 65 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 66 | "type": "github" 67 | }, 68 | "original": { 69 | "owner": "nix-systems", 70 | "repo": "default", 71 | "type": "github" 72 | } 73 | } 74 | }, 75 | "root": "root", 76 | "version": 7 77 | } 78 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Artiflakery"; 3 | 4 | inputs.nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable"; 5 | inputs.flake-utils.url = "github:numtide/flake-utils"; 6 | inputs.flake-compat.url = "github:edolstra/flake-compat"; 7 | 8 | outputs = 9 | { 10 | nixpkgs, 11 | flake-utils, 12 | ... 13 | }: 14 | 15 | (flake-utils.lib.eachDefaultSystem ( 16 | system: 17 | let 18 | pkgs = nixpkgs.legacyPackages.${system}; 19 | artiflakery = pkgs.haskellPackages.callPackage ./package.nix { }; 20 | in 21 | { 22 | defaultPackage = artiflakery; 23 | checks = { 24 | inherit artiflakery; 25 | }; 26 | devShells.default = pkgs.mkShell { 27 | buildInputs = with pkgs; [ 28 | stack 29 | haskell.compiler.ghc96 30 | haskell-language-server 31 | ]; 32 | }; 33 | 34 | } 35 | )) // { 36 | nixosModules.default = import ./module.nix; 37 | }; 38 | } 39 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | stack: 3 | - path: "./src" 4 | component: "artiflakery:lib" 5 | 6 | - path: "./app/Main.hs" 7 | component: "artiflakery:exe:artiflakery-exe" 8 | 9 | - path: "./test" 10 | component: "artiflakery:test:artiflakery-test" 11 | -------------------------------------------------------------------------------- /module.nix: -------------------------------------------------------------------------------- 1 | { 2 | config, 3 | lib, 4 | pkgs, 5 | ... 6 | }: 7 | 8 | with lib; 9 | 10 | let 11 | cfg = config.services.artiflakery; 12 | 13 | routesFile = pkgs.writeText "artiflakery-routes.txt" ( 14 | concatStringsSep "\n" ( 15 | mapAttrsToList ( 16 | routePath: routeOpts: "${routePath} ${routeOpts.flakeref} ${concatStringsSep " " routeOpts.access}" 17 | ) cfg.routes 18 | ) 19 | + "\n" 20 | ); 21 | 22 | in 23 | { 24 | options.services.artiflakery = { 25 | enable = mkEnableOption "Artiflakery service"; 26 | 27 | package = mkOption { 28 | type = types.package; 29 | default = pkgs.artiflakery; 30 | description = "The artiflakery package to use."; 31 | }; 32 | 33 | authFile = mkOption { 34 | type = types.path; 35 | description = '' 36 | Path to the authentication file containing secrets. 37 | This file must be created manually by the user. 38 | ''; 39 | example = "/var/lib/artiflakery/auth.txt"; 40 | }; 41 | 42 | routes = mkOption { 43 | type = types.attrsOf ( 44 | types.submodule { 45 | options = { 46 | flakeref = mkOption { 47 | type = types.str; 48 | description = "Complete flake reference URL"; 49 | example = "git+ssh://git@github.com/foo/bar"; 50 | }; 51 | 52 | access = mkOption { 53 | type = types.listOf types.str; 54 | description = "Access levels for this route (can include multiple)"; 55 | example = [ 56 | "admins" 57 | "friends" 58 | ]; 59 | }; 60 | }; 61 | } 62 | ); 63 | default = { }; 64 | description = "Routes configuration"; 65 | example = literalExpression '' 66 | { 67 | "hello/world/" = { 68 | flakeref = "git+ssh://git@github.com/hello/world"; 69 | access = ["admins" "public"]; 70 | }; 71 | } 72 | ''; 73 | }; 74 | }; 75 | 76 | config = mkIf cfg.enable { 77 | users.users = { 78 | artiflakery = { 79 | isSystemUser = true; 80 | group = "artiflakery"; 81 | description = "ArtifLakery service user"; 82 | home = "/var/lib/artiflakery"; 83 | createHome = true; 84 | }; 85 | }; 86 | 87 | users.groups.artiflakery = { }; 88 | 89 | nix.settings.allowed-users = [ "artiflakery" ]; 90 | 91 | systemd.services.artiflakery = { 92 | description = "ArtifLakery Service"; 93 | wantedBy = [ "multi-user.target" ]; 94 | after = [ "network.target" ]; 95 | path = [ 96 | pkgs.lix 97 | pkgs.git 98 | pkgs.openssh 99 | ]; 100 | 101 | script = "${cfg.package}/bin/artiflakery-exe --auth ${cfg.authFile} --routes ${routesFile}"; 102 | 103 | serviceConfig = { 104 | User = "artiflakery"; 105 | Group = "artiflakery"; 106 | Restart = "on-failure"; 107 | RestartSec = "5s"; 108 | 109 | PrivateTmp = true; 110 | ProtectHostname = true; 111 | ProtectKernelTunables = true; 112 | ProtectKernelModules = true; 113 | ProtectControlGroups = true; 114 | NoNewPrivileges = true; 115 | WorkingDirectory = "/var/lib/artiflakery"; 116 | 117 | }; 118 | }; 119 | }; 120 | } 121 | -------------------------------------------------------------------------------- /package.nix: -------------------------------------------------------------------------------- 1 | { 2 | mkDerivation, 3 | ansi-terminal, 4 | async, 5 | base, 6 | base64-bytestring, 7 | bcrypt, 8 | bytestring, 9 | co-log, 10 | co-log-core, 11 | containers, 12 | cookie, 13 | crypton, 14 | directory, 15 | exceptions, 16 | file-embed, 17 | filepath, 18 | http-types, 19 | optparse-applicative, 20 | process, 21 | text, 22 | time, 23 | unix, 24 | wai, 25 | wai-app-static, 26 | wai-websockets, 27 | warp, 28 | websockets, 29 | }: 30 | mkDerivation { 31 | pname = "artiflakery"; 32 | version = "1.0.0"; 33 | src = ./.; 34 | isLibrary = true; 35 | isExecutable = true; 36 | libraryHaskellDepends = [ 37 | ansi-terminal 38 | async 39 | base 40 | base64-bytestring 41 | bcrypt 42 | bytestring 43 | co-log 44 | co-log-core 45 | containers 46 | cookie 47 | crypton 48 | directory 49 | exceptions 50 | file-embed 51 | filepath 52 | http-types 53 | optparse-applicative 54 | process 55 | text 56 | time 57 | unix 58 | wai 59 | wai-app-static 60 | wai-websockets 61 | warp 62 | websockets 63 | ]; 64 | executableHaskellDepends = [ 65 | ansi-terminal 66 | async 67 | base 68 | base64-bytestring 69 | bcrypt 70 | bytestring 71 | co-log 72 | co-log-core 73 | containers 74 | cookie 75 | crypton 76 | directory 77 | exceptions 78 | file-embed 79 | filepath 80 | http-types 81 | optparse-applicative 82 | process 83 | text 84 | time 85 | unix 86 | wai 87 | wai-app-static 88 | wai-websockets 89 | warp 90 | websockets 91 | ]; 92 | doCheck = false; 93 | homepage = "https://github.com/JulienMalka/artiflakery#readme"; 94 | license = "EUPL-1.2"; 95 | mainProgram = "artiflakery-exe"; 96 | } 97 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: artiflakery 2 | version: 1.0.0 3 | github: "JulienMalka/artiflakery" 4 | license: EUPL-1.2 5 | author: "Julien Malka" 6 | maintainer: "julien.malka@me.com" 7 | copyright: "2025 Julien Malka" 8 | 9 | extra-source-files: 10 | - README.md 11 | 12 | description: A webserver for on the fly delivery of Nix flake artifacts 13 | 14 | dependencies: 15 | - base >= 4.7 && < 5 16 | - wai >= 3.2 17 | - warp 18 | - http-types 19 | - async 20 | - containers 21 | - process 22 | - time 23 | - text 24 | - bytestring 25 | - wai-app-static 26 | - wai-websockets 27 | - websockets 28 | - directory 29 | - unix 30 | - filepath 31 | - ansi-terminal 32 | - crypton 33 | - base64-bytestring 34 | - cookie 35 | - co-log 36 | - co-log-core 37 | - exceptions 38 | - bcrypt 39 | - optparse-applicative 40 | - file-embed 41 | 42 | ghc-options: 43 | - -Wall 44 | - -Wcompat 45 | - -Widentities 46 | - -Wincomplete-record-updates 47 | - -Wincomplete-uni-patterns 48 | - -Wmissing-export-lists 49 | - -Wmissing-home-modules 50 | - -Wpartial-fields 51 | - -Wredundant-constraints 52 | 53 | library: 54 | source-dirs: src 55 | default-extensions: 56 | - OverloadedStrings 57 | 58 | executables: 59 | artiflakery-exe: 60 | main: Main.hs 61 | source-dirs: app 62 | ghc-options: 63 | - -threaded 64 | - -rtsopts 65 | - -with-rtsopts=-N 66 | dependencies: 67 | - artiflakery 68 | 69 | 70 | -------------------------------------------------------------------------------- /pdf-viewer.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | PDF Viewer 7 | 35 | 36 | 37 |
View PDF
38 |
39 | 40 |
41 | 42 | 43 | 48 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /src/Auth.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module Auth 4 | ( Group, 5 | UserId, 6 | UserDB, 7 | parseAuthFile, 8 | checkBasicAuth, 9 | isAuthorized, 10 | signCookieValue, 11 | verifyCookieValue, 12 | extractGroupsFromCookie, 13 | makeSecureCookieHeader, 14 | getSecretKey 15 | ) 16 | where 17 | 18 | import Colog.Message 19 | import Colog.Monad 20 | import Config (Group, PasswordHash, UserDB, UserId, parseAuthFile) 21 | import Crypto.Hash.Algorithms (SHA256) 22 | import Crypto.MAC.HMAC (HMAC, hmac, hmacGetDigest) 23 | import qualified Crypto.BCrypt as BCrypt 24 | import qualified Data.ByteString as BS 25 | import qualified Data.ByteString.Base64 as B64 26 | import Data.ByteString.Builder (toLazyByteString) 27 | import qualified Data.ByteString.Char8 as BS8 28 | import qualified Data.ByteString.Lazy as BL 29 | import qualified Data.Map.Strict as Map 30 | import Data.Text (Text) 31 | import qualified Data.Text as T 32 | import qualified Data.Text.Encoding as TE 33 | import Data.Time.Clock 34 | import Network.HTTP.Types (Header, hAuthorization) 35 | import Network.Wai (Request, requestHeaders) 36 | import Web.Cookie 37 | import System.Directory (doesFileExist) 38 | import Crypto.Random (getRandomBytes) 39 | import Control.Monad.IO.Class 40 | 41 | -- | Load or generate a secret key for signing cookies 42 | getSecretKey :: IO BS.ByteString 43 | getSecretKey = do 44 | let keyFile = "secret-key" 45 | exists <- doesFileExist keyFile 46 | if exists 47 | then BS.readFile keyFile 48 | else do 49 | key <- getRandomBytes 32 -- Secure 256-bit key 50 | BS.writeFile keyFile key 51 | return key 52 | 53 | -- | Check if a user is authorized based on group membership 54 | isAuthorized :: (WithLog env Message m, MonadIO m) => [Group] -> Request -> m (Bool, [Group]) 55 | isAuthorized allowed req = do 56 | userGroups <- extractGroupsFromCookie req 57 | let userGroups' = userGroups ++ [ "public" ] 58 | let status = any (`elem` userGroups') allowed 59 | return (status, userGroups') 60 | 61 | -- | Extract user groups from signed cookie 62 | extractGroupsFromCookie :: (WithLog env Message m, MonadIO m) => Request -> m [Group] 63 | extractGroupsFromCookie req = do 64 | secret <- liftIO getSecretKey 65 | let mCookieHeader = lookup "Cookie" (requestHeaders req) 66 | case mCookieHeader of 67 | Just raw -> 68 | let cookies = parseCookies raw 69 | mVal = lookup "authGroups" cookies >>= verifyCookieValue secret 70 | in case mVal of 71 | Just val -> do 72 | logDebug $ "COOKIE:" <> TE.decodeUtf8 val 73 | return $ T.splitOn "," (TE.decodeUtf8 val) 74 | Nothing -> return [] 75 | Nothing -> return [] 76 | 77 | -- | Attempt to authenticate a user with Basic Auth and return their group if authorized 78 | checkBasicAuth :: UserDB -> [Group] -> Request -> IO (Maybe Group) 79 | checkBasicAuth db allowed req = 80 | case lookup hAuthorization (requestHeaders req) of 81 | Just authHeader -> 82 | case decodeBasicAuth authHeader of 83 | Just (uid, pw) -> findValidGroupIO db allowed uid pw 84 | Nothing -> return Nothing 85 | Nothing -> return Nothing 86 | 87 | -- | Bcrypt password verification 88 | verifyPassword :: PasswordHash -> Text -> Bool 89 | verifyPassword hash pw = 90 | BCrypt.validatePassword (TE.encodeUtf8 hash) (TE.encodeUtf8 pw) 91 | 92 | -- | Monadic version of findValidGroup using bcrypt password checking 93 | findValidGroupIO :: UserDB -> [Group] -> UserId -> Text -> IO (Maybe Group) 94 | findValidGroupIO db allowed uid pw = go (filter (`elem` allowed) (Map.keys db)) 95 | where 96 | go [] = return Nothing 97 | go (g:gs) = 98 | case lookup uid (Map.findWithDefault [] g db) of 99 | Just hashedPw -> 100 | if verifyPassword hashedPw pw 101 | then return (Just g) 102 | else go gs 103 | Nothing -> go gs 104 | 105 | -- | Decode HTTP Basic Auth credentials 106 | decodeBasicAuth :: BS.ByteString -> Maybe (UserId, Text) 107 | decodeBasicAuth bs = 108 | let prefix = "Basic " 109 | in case BS8.stripPrefix prefix bs of 110 | Just b64 -> 111 | case B64.decode b64 of 112 | Right decoded -> 113 | let (user, rest) = BS8.break (== ':') decoded 114 | in if BS8.null rest 115 | then Nothing 116 | else Just (TE.decodeUtf8 user, TE.decodeUtf8 $ BS8.tail rest) 117 | Left _ -> Nothing 118 | Nothing -> Nothing 119 | 120 | -- | Sign a cookie value with HMAC 121 | signCookieValue :: BS.ByteString -> BS.ByteString -> BS.ByteString 122 | signCookieValue secret val = 123 | let sig = hmacGetDigest (hmac secret val :: HMAC SHA256) 124 | in BS8.concat [val, "|", B64.encode (BS8.pack $ show sig)] 125 | 126 | -- | Verify a signed cookie value 127 | verifyCookieValue :: BS.ByteString -> BS.ByteString -> Maybe BS.ByteString 128 | verifyCookieValue secret signed = 129 | let (val, sigPart) = BS8.breakSubstring "|" signed 130 | in case BS8.stripPrefix "|" sigPart of 131 | Just b64sig -> 132 | let expected = B64.encode . BS8.pack . show $ hmacGetDigest (hmac secret val :: HMAC SHA256) 133 | in if b64sig == expected 134 | then Just val 135 | else Nothing 136 | Nothing -> Nothing 137 | 138 | -- | One week cookie expiry 139 | weekInSeconds :: NominalDiffTime 140 | weekInSeconds = 7 * 24 * 60 * 60 141 | 142 | -- | Create a secure Set-Cookie header 143 | makeSecureCookieHeader :: Text -> IO Header 144 | makeSecureCookieHeader group = do 145 | now <- getCurrentTime 146 | let weekFromNow = Just $ addUTCTime weekInSeconds now 147 | cookie = 148 | defaultSetCookie 149 | { setCookieName = BS8.pack "authGroups", 150 | setCookieValue = TE.encodeUtf8 group, 151 | setCookiePath = Just "/", 152 | setCookieExpires = weekFromNow, 153 | setCookieHttpOnly = True, 154 | setCookieSecure = True, 155 | setCookieSameSite = Just sameSiteStrict 156 | } 157 | renderedCookie :: BS.ByteString 158 | renderedCookie = BL.toStrict $ toLazyByteString $ renderSetCookie cookie 159 | return ("Set-Cookie", renderedCookie) 160 | -------------------------------------------------------------------------------- /src/AutoReload.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module AutoReload 6 | ( notifyClientsFor, 7 | addClient, 8 | removeClient, 9 | ClientConnection, 10 | connId, 11 | wsConn, 12 | ) 13 | where 14 | 15 | import Colog.Message 16 | import Colog.Monad 17 | import Config (Route) 18 | import Control.Concurrent.MVar 19 | import Control.Exception (catch) 20 | import Control.Monad (forM_) 21 | import Control.Monad.IO.Class 22 | import Data.Text (Text) 23 | import qualified Data.Text as T 24 | import Network.WebSockets (Connection, ConnectionException, sendTextData) 25 | import System.IO.Unsafe (unsafePerformIO) 26 | 27 | data ClientConnection = ClientConnection 28 | { connId :: Int, 29 | wsConn :: Connection 30 | } 31 | 32 | connectionCounter :: MVar Int 33 | connectionCounter = unsafePerformIO $ newMVar 0 34 | 35 | activeConnections :: MVar [ClientConnection] 36 | activeConnections = unsafePerformIO $ newMVar [] 37 | 38 | getNextConnectionId :: IO Int 39 | getNextConnectionId = modifyMVar connectionCounter $ \i -> return (i + 1, i) 40 | 41 | addClient :: Connection -> IO ClientConnection 42 | addClient conn = do 43 | connId' <- getNextConnectionId 44 | let clientConn = ClientConnection connId' conn 45 | modifyMVar_ activeConnections $ \conns -> return (clientConn : conns) 46 | return clientConn 47 | 48 | removeClient :: Int -> IO () 49 | removeClient cid = modifyMVar_ activeConnections $ \conns -> 50 | return (filter (\c -> connId c /= cid) conns) 51 | 52 | notifyClientsFor :: (WithLog env Message m, MonadIO m) => Route -> Text -> m () 53 | notifyClientsFor route message = 54 | notifyClients (message <> ":" <> route) 55 | 56 | notifyClients :: (WithLog env Message m, MonadIO m) => Text -> m () 57 | notifyClients message = do 58 | clients <- liftIO $ readMVar activeConnections 59 | 60 | forM_ clients $ \client -> do 61 | liftIO $ 62 | catch 63 | (sendTextData (wsConn client) message) 64 | ( \(_ :: ConnectionException) -> do 65 | removeClient (connId client) 66 | ) 67 | 68 | logInfo $ "Notified " <> T.pack (show (length clients)) <> " clients: " <> message 69 | -------------------------------------------------------------------------------- /src/BuildFlake.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | 4 | module BuildFlake (buildFlakeWithLogging) where 5 | 6 | import AutoReload (notifyClientsFor) 7 | import Colog.Message 8 | import Colog.Monad 9 | import Config (FlakeRef, Route) 10 | import Control.Concurrent (forkIO) 11 | import Control.Concurrent.MVar 12 | import Control.Monad.Catch (bracket) 13 | import Control.Monad.IO.Class 14 | import Data.IORef 15 | import qualified Data.Map.Strict as Map 16 | import qualified Data.Text as T 17 | import Logger 18 | import System.Environment (getEnvironment) 19 | import System.FilePath (dropTrailingPathSeparator) 20 | import System.IO (BufferMode (LineBuffering), Handle, hGetLine, hIsEOF, hSetBuffering) 21 | import System.IO.Error (catchIOError) 22 | import System.IO.Unsafe (unsafePerformIO) 23 | import System.Posix.Files (readSymbolicLink) 24 | import System.Process 25 | import Text.Printf (printf) 26 | 27 | type RouteLocks = IORef (Map.Map Route (MVar ())) 28 | 29 | {-# NOINLINE routeLocks #-} 30 | routeLocks :: RouteLocks 31 | routeLocks = unsafePerformIO $ newIORef Map.empty 32 | 33 | streamStderr :: (WithLog env Message m, MonadIO m) => Handle -> MVar () -> m () 34 | streamStderr h done = do 35 | let loop = do 36 | eof <- liftIO $ hIsEOF h 37 | if eof 38 | then liftIO $ putMVar done () 39 | else do 40 | line <- liftIO $ hGetLine h 41 | logDebug $ T.pack line 42 | loop 43 | loop 44 | 45 | buildFlakeWithLogging :: (WithLog env Message m, MonadIO m) => Route -> FlakeRef -> m () 46 | buildFlakeWithLogging route flakeref = do 47 | locks <- liftIO $ readIORef routeLocks 48 | lock <- case Map.lookup route locks of 49 | Just l -> return l 50 | Nothing -> do 51 | newLock <- liftIO $ newMVar () 52 | liftIO $ atomicModifyIORef' routeLocks $ \m -> (Map.insert route newLock m, newLock) 53 | 54 | acquired <- liftIO $ tryTakeMVar lock 55 | let runBuildIO route' ref = usingLoggerT coloredLogAction (runBuild route' ref) 56 | case acquired of 57 | Nothing -> logInfo $ "Build already in progress for route: " <> route 58 | Just () -> do 59 | liftIO $ 60 | bracket 61 | (return ()) 62 | (\_ -> liftIO $ putMVar lock ()) 63 | (\_ -> runBuildIO route flakeref) 64 | 65 | runBuild :: (WithLog env Message m, MonadIO m) => Route -> FlakeRef -> m () 66 | runBuild route flakeref = do 67 | let output = "data/" <> route 68 | logInfo $ "Starting build for " <> flakeref 69 | currentEnv <- liftIO getEnvironment 70 | 71 | oldTarget <- 72 | liftIO $ 73 | catchIOError 74 | (readSymbolicLink $ dropTrailingPathSeparator (T.unpack output)) 75 | (\_ -> return "") 76 | 77 | let processConfig = 78 | (shell $ "nix build --refresh -o " <> T.unpack output <> " " <> T.unpack flakeref) 79 | { std_err = CreatePipe, 80 | env = Just currentEnv 81 | } 82 | 83 | result <- liftIO $ createProcess processConfig 84 | case result of 85 | (_, _, Just herr, ph) -> do 86 | liftIO $ hSetBuffering herr LineBuffering 87 | stderrDone <- liftIO newEmptyMVar 88 | 89 | _ <- liftIO $ forkIO $ usingLoggerT coloredLogAction (streamStderr herr stderrDone) 90 | 91 | exitCode <- liftIO $ waitForProcess ph 92 | _ <- liftIO $ takeMVar stderrDone 93 | 94 | newTarget <- 95 | liftIO $ 96 | catchIOError 97 | (readSymbolicLink $ dropTrailingPathSeparator (T.unpack output)) 98 | (\_ -> return "") 99 | 100 | logInfo $ 101 | T.pack $ 102 | printf 103 | "Completed building %s with exit code %s" 104 | (T.unpack flakeref) 105 | (show exitCode) 106 | 107 | if oldTarget /= newTarget && not (null newTarget) 108 | then do 109 | logInfo "Build produced new result, notifying clients" 110 | notifyClientsFor route "Build Complete!" 111 | else logInfo "No changes in build result, not notifying clients" 112 | _ -> logError "Failed to create process with expected stderr handle" 113 | -------------------------------------------------------------------------------- /src/Config.hs: -------------------------------------------------------------------------------- 1 | module Config 2 | ( 3 | parseConfigFile, 4 | Route, 5 | FlakeRef, 6 | RouteMap, 7 | Group, 8 | UserId, 9 | PasswordHash, 10 | UserDB, 11 | parseAuthFile 12 | ) 13 | where 14 | 15 | import qualified Data.Map.Strict as Map 16 | import Data.Map.Strict (Map) 17 | import Data.Maybe (mapMaybe) 18 | import Data.Text (Text) 19 | import qualified Data.Text as T 20 | import qualified Data.Text.IO as TIO 21 | 22 | type Route = Text 23 | type FlakeRef = Text 24 | type Group = Text 25 | type UserId = Text 26 | type PasswordHash = Text 27 | type UserDB = Map Group [(UserId, PasswordHash)] 28 | type RouteMap = Map Route (FlakeRef, [Group]) 29 | 30 | parseConfigFile :: FilePath -> IO RouteMap 31 | parseConfigFile path = do 32 | content <- TIO.readFile path 33 | let parsed = mapMaybe parseLine (T.lines content) 34 | routeMap = Map.fromList [ (route, (ref, groups)) | (route, ref, groups) <- parsed ] 35 | return routeMap 36 | where 37 | parseLine :: Text -> Maybe (Route, FlakeRef, [Group]) 38 | parseLine line = 39 | case T.words line of 40 | (route : ref : groups) -> Just (route, ref, groups) 41 | _ -> Nothing 42 | 43 | 44 | parseAuthFile :: FilePath -> IO UserDB 45 | parseAuthFile path = do 46 | content <- readFile path 47 | let entries = map (parseLine . T.strip . T.pack) (lines content) 48 | insertEntry m (g, u, h) = Map.insertWith (++) g [(u, h)] m 49 | return $ foldl insertEntry Map.empty (mapMaybe id entries) 50 | where 51 | parseLine :: Text -> Maybe (Group, UserId, PasswordHash) 52 | parseLine line = 53 | case T.splitOn "," line of 54 | [group, userHash] -> 55 | case T.splitOn ":" userHash of 56 | [user, hash] -> Just (group, user, hash) 57 | _ -> Nothing 58 | _ -> Nothing 59 | -------------------------------------------------------------------------------- /src/Logger.hs: -------------------------------------------------------------------------------- 1 | module Logger (coloredLogAction) where 2 | 3 | import Colog 4 | import qualified Data.Text as T 5 | import Data.Time (defaultTimeLocale, formatTime, getCurrentTime) 6 | import Data.Time.Clock (UTCTime) 7 | import System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleLayer (..), SGR (..), setSGRCode) 8 | 9 | padRight :: Int -> Char -> T.Text -> T.Text 10 | padRight width char text = 11 | let textLen = T.length text 12 | in if textLen >= width 13 | then text 14 | else text <> T.replicate (width - textLen) (T.singleton char) 15 | 16 | colorBySeverity :: Severity -> T.Text -> T.Text 17 | colorBySeverity sev txt = case sev of 18 | Debug -> colorize Green txt 19 | Info -> colorize Blue txt 20 | Warning -> colorize Yellow txt 21 | Error -> colorize Red txt 22 | where 23 | colorize :: Color -> T.Text -> T.Text 24 | colorize c txt' = 25 | T.pack (setSGRCode [SetColor Foreground Vivid c]) 26 | <> txt' 27 | <> T.pack (setSGRCode [Reset]) 28 | 29 | customMessageFormat :: Severity -> UTCTime -> T.Text -> T.Text 30 | customMessageFormat sev time msg = 31 | let formattedText = 32 | T.intercalate 33 | " | " 34 | [ padRight 8 ' ' (T.pack $ show sev), 35 | T.pack $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" time, 36 | msg 37 | ] 38 | in colorBySeverity sev formattedText 39 | 40 | coloredLogAction :: LogAction IO Message 41 | coloredLogAction = 42 | filterBySeverity Debug msgSeverity $ 43 | cmapM 44 | ( \msg -> do 45 | time <- getCurrentTime 46 | pure $ customMessageFormat (msgSeverity msg) time (msgText msg) 47 | ) 48 | logTextStdout 49 | -------------------------------------------------------------------------------- /src/Server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeApplications #-} 5 | 6 | module Server 7 | ( serve, 8 | serveFlakeWithCookie, 9 | serveStaticWithCookie, 10 | serveFlakePath, 11 | LoggedApplication, 12 | ) 13 | where 14 | 15 | import BuildFlake (buildFlakeWithLogging) 16 | import Colog.Message 17 | import Colog.Monad 18 | import Config 19 | import Control.Concurrent.Async 20 | import Control.Monad.IO.Class 21 | import qualified Data.ByteString as BS 22 | import qualified Data.ByteString.Lazy as BL 23 | import Data.FileEmbed (embedFile) 24 | import qualified Data.Map.Strict as Map 25 | import Data.Text (Text) 26 | import qualified Data.Text as T 27 | import Data.Text.Encoding (encodeUtf8) 28 | import qualified Data.Text.Encoding as TE 29 | import qualified Data.Text.IO as TIO 30 | import Logger 31 | import Network.HTTP.Types 32 | import Network.Wai 33 | import Network.Wai.Application.Static (defaultFileServerSettings, ssAddTrailingSlash, staticApp) 34 | import System.Directory 35 | import System.FilePath (()) 36 | 37 | type LoggedApplication env m = 38 | (WithLog env Message m, MonadIO m) => 39 | Network.Wai.Request -> 40 | (Network.Wai.Response -> IO ResponseReceived) -> 41 | m ResponseReceived 42 | 43 | pdfViewerHtml :: BS.ByteString 44 | pdfViewerHtml = $(embedFile "pdf-viewer.html") 45 | 46 | websocketScriptFor :: Route -> Text 47 | websocketScriptFor route = 48 | T.unlines 49 | [ "" 57 | ] 58 | 59 | notFound :: (Network.Wai.Response -> IO ResponseReceived) -> IO ResponseReceived 60 | notFound respond = 61 | respond $ responseLBS status404 [("Content-Type", "text/plain")] "404 - Not Found" 62 | 63 | serveFlakePath :: Route -> FlakeRef -> [Group] -> UserDB -> LoggedApplication env m 64 | serveFlakePath route ref _allowedGroups _authDB _req respond = do 65 | logInfo $ "Serving route (authorized): " <> route 66 | 67 | let dataDir = "data" 68 | routeDir = dataDir T.unpack route 69 | htmlFile = routeDir T.unpack "index.html" 70 | pdfFile = routeDir T.unpack "main.pdf" 71 | 72 | _ <- 73 | liftIO $ 74 | async $ 75 | usingLoggerT coloredLogAction $ 76 | buildFlakeWithLogging route ref 77 | 78 | pdfExists <- liftIO $ doesFileExist pdfFile 79 | htmlExists <- liftIO $ doesFileExist htmlFile 80 | 81 | if htmlExists || pdfExists 82 | then do 83 | finalOutput <- 84 | if pdfExists 85 | then pure $ TE.decodeUtf8 pdfViewerHtml `T.append` websocketScriptFor route 86 | else do 87 | content <- liftIO $ TIO.readFile htmlFile 88 | pure $ content `T.append` websocketScriptFor route 89 | 90 | liftIO $ respond $ responseLBS status200 [("Content-Type", "text/html")] (BL.fromStrict $ encodeUtf8 finalOutput) 91 | else liftIO $ notFound respond 92 | 93 | serve :: Text -> RouteMap -> UserDB -> LoggedApplication env m 94 | serve normalizedPath routeMap authDB req respond = do 95 | logInfo $ "Serving " <> normalizedPath 96 | if Map.member normalizedPath routeMap 97 | then uncurry (serveFlakePath normalizedPath) (routeMap Map.! (normalizedPath <> "/")) authDB req respond 98 | else liftIO $ staticApp (defaultFileServerSettings "data") {ssAddTrailingSlash = True} req respond 99 | 100 | serveFlakeWithCookie :: Text -> Header -> RouteMap -> UserDB -> LoggedApplication env m 101 | serveFlakeWithCookie normalizedPath cookieHeader routeMap authDB req respond = do 102 | let (ref, allowedGroups) = routeMap Map.! (normalizedPath <> "/") 103 | serveFlakePath normalizedPath ref allowedGroups authDB req $ \resp -> 104 | respond $ mapResponseHeaders ((cookieHeader :) . filter (\(h, _) -> h /= "Set-Cookie")) resp 105 | 106 | serveStaticWithCookie :: Header -> LoggedApplication env m 107 | serveStaticWithCookie cookieHeader req respond = do 108 | liftIO $ staticApp (defaultFileServerSettings "data") {ssAddTrailingSlash = True} req $ \r -> 109 | respond $ mapResponseHeaders ((cookieHeader :) . filter (\(h, _) -> h /= "Set-Cookie")) r 110 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # A 'specific' Stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # snapshot: lts-22.28 12 | # snapshot: nightly-2024-07-05 13 | # snapshot: ghc-9.6.6 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # snapshot: ./custom-snapshot.yaml 19 | # snapshot: https://example.com/snapshots/2024-01-01.yaml 20 | snapshot: 21 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/17.yaml 22 | 23 | # User packages to be built. 24 | # Various formats can be used as shown in the example below. 25 | # 26 | # packages: 27 | # - some-directory 28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 29 | # subdirs: 30 | # - auto-update 31 | # - wai 32 | # 33 | # 34 | 35 | compiler: ghc-9.6 # Specify your exact GHC version here 36 | 37 | nix: 38 | enable: true 39 | packages: [zlib] 40 | 41 | packages: 42 | - . 43 | # Dependency packages to be pulled from upstream that are not in the snapshot. 44 | # These entries can reference officially published versions as well as 45 | # forks / in-progress versions pinned to a git hash. For example: 46 | # 47 | # extra-deps: 48 | # - acme-missiles-0.3 49 | # - git: https://github.com/commercialhaskell/stack.git 50 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 51 | # 52 | # extra-deps: [] 53 | 54 | # Override default flag values for project packages and extra-deps 55 | # flags: {} 56 | 57 | # Extra package databases containing global packages 58 | # extra-package-dbs: [] 59 | 60 | # Control whether we use the GHC we find on the path 61 | # 62 | # Require a specific version of Stack, using version ranges 63 | # require-stack-version: -any # Default 64 | # require-stack-version: ">=3.1" 65 | # 66 | # Override the architecture used by Stack, especially useful on Windows 67 | # arch: i386 68 | # arch: x86_64 69 | # 70 | # Extra directories used by Stack for building 71 | # extra-include-dirs: [/path/to/dir] 72 | # extra-lib-dirs: [/path/to/dir] 73 | # 74 | # Allow a newer minor version of GHC than the snapshot specifies 75 | # compiler-check: newer-minor 76 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | sha256: 2763632e4c4094ce12f5ae12b22f524cdc6453b6b19007ff164a37fd9d2ea829 10 | size: 683819 11 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/17.yaml 12 | original: 13 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/17.yaml 14 | --------------------------------------------------------------------------------