9a0e494 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Merge branch 'develop' into an-binary-caches

9a0e494Elliot Cameron7 years ago

.gitignore+1

compare with master

unifiedsplit

@@ -2,6 +2,7 @@

2**/.cabal-sandbox

3**/cabal.sandbox.config

4result

5+result-*

5*.o

6*.o

6*.hi

7*.hi

7TAGS

8TAGS

.hlint.yamlnew file+65

@@ -0,0 +1,65 @@

1+# HLint configuration file

2+# https://github.com/ndmitchell/hlint

3+##########################

5+# This file contains a template configuration file, which is typically

6+# placed as .hlint.yaml in the root of your project

9+# Specify additional command line arguments

10+#

11+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]

12+

13+

14+# Control which extensions/flags/modules/functions can be used

15+#

16+# - extensions:

17+# - default: false # all extension are banned by default

18+# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used

19+# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module

20+#

21+# - flags:

22+# - {name: -w, within: []} # -w is allowed nowhere

23+#

24+# - modules:

25+# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'

26+# - {name: Control.Arrow, within: []} # Certain modules are banned entirely

27+#

28+# - functions:

29+# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules

30+

31+

32+# Add custom hints for this project

33+#

34+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"

35+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}

36+

37+

38+# Turn on hints that are off by default

39+#

40+# Ban "module X(module X) where", to require a real export list

41+# - warn: {name: Use explicit module export list}

42+#

43+# Replace a $ b $ c with a . b $ c

44+# - group: {name: dollar, enabled: true}

45+#

46+# Generalise map to fmap, ++ to <>

47+# - group: {name: generalise, enabled: true}

48+

49+

50+# Ignore some builtin hints

51+- ignore: {name: Redundant do}

52+- ignore: {name: Redundant flip}

53+- ignore: {name: Use <$>}

54+- ignore: {name: Use camelCase}

55+- ignore: {name: Use if}

56+- ignore: {name: Use unless}

57+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules

58+

59+

60+# Define some custom infix operators

61+# - fixity: infixr 3 ~^#^~

62+

63+

64+# To generate a suitable file for HLint do:

65+# $ hlint --default > .hlint.yaml

ChangeLog.md+11

@@ -2,6 +2,17 @@

3This project's release branch is `master`. This log is written from the perspective of the release branch: when changes hit `master`, they are considered released, and the date should reflect that release.

5+## v0.4.0.0 - 2020-01-10

7+* Bump reflex-platform which, notably, bumps nixpkgs to 19.09. ([#585](https://github.com/obsidiansystems/obelisk/pull/585))

8+* Add new thunk loader for Git repositories that supports `file://` Git remotes and supports private repositories via `builtins.fetchGit` for private repositories (when the `git.json` file specifies `"private": true`). ([#594](https://github.com/obsidiansystems/obelisk/pull/594))

9+* Add a new thunk loader for GitHub repositories that uses `builtins.fetchTarball` for public repositories to increase loader performance and uses `fetchFromGitHub` for private repositories (when the `github.json` file specifies `"private": true`). Note that `fetchFromGitHub` requires some Nix configuration for the Nix builder to access the repository. If `ob thunk pack` fails in this case, use `-v` to see Nix's helpful message. ([#594](https://github.com/obsidiansystems/obelisk/pull/594))

10+* Add `--public`/`--private` options to `ob thunk pack` to specify if a repository should be treated as a public or private. ([#594](https://github.com/obsidiansystems/obelisk/pull/594))

11+* Improve error messaging when a dependency doesn't have the expected `.cabal` or `package.yaml` file. ([#597](https://github.com/obsidiansystems/obelisk/pull/597))

12+* Improve the skeleton in small ways. ([#593](https://github.com/obsidiansystems/obelisk/pull/593), [#589](https://github.com/obsidiansystems/obelisk/pull/589))

13+* Fix `ob` commands to again support running from any subdirectory of an obelisk project ([#591](https://github.com/obsidiansystems/obelisk/pull/591))

14+* Add `reflex-platform-func` argument to Obelisk's `default.nix`. It defaults to it's prior behavior of using the reflex-platform in in `dep`. ([#612](https://github.com/obsidiansystems/obelisk/pull/612))

15+

5## v0.3.0.0 - 2019-12-20

16## v0.3.0.0 - 2019-12-20

7* Generalised `pathSegmentEncoder`, added `pathFieldEncoder`.

18* Generalised `pathSegmentEncoder`, added `pathFieldEncoder`.

README.md+1−1

@@ -153,7 +153,7 @@ For further information see [the Haskell section](https://nixos.org/nixpkgs/manu

153

154### Running over https

155

156−To run your app locally over https, update the protocol in `config/common/route` to `https`, and then use `ob run` as normal.

156+To run your app locally over https, update the protocol in `config/common/route` to `https`, and then use `ob run` as normal.

157

158Since Obelisk generates a self-signed certificate for running https, the browser will issue a warning about using an invalid certificate. On Chrome, you can go to `chrome://flags/#allow-insecure-localhost` to enable invalid certificates for localhost.

159

acme.nixdeleted−397

@@ -1,397 +0,0 @@

1−### COPIED FROM

2−### https://github.com/NixOS/nixpkgs/blob/1d36ad6d16dbf1d3937f899a087a4360332eb141/nixos/modules/security/acme.nix

3−###

4−### to support new plugins in simp_le for ACMEv2 support.

5−### Changed lines are marked with a comment: ### CHANGED

6−

7−{ config, lib, pkgs, ... }:

8−

9−with lib;

10−

11−let

12−

13− cfg = config.security.acme;

14−

15− certOpts = { name, ... }: {

16− options = {

17− webroot = mkOption {

18− type = types.str;

19− example = "/var/lib/acme/acme-challenges";

20− description = ''

21− Where the webroot of the HTTP vhost is located.

22− <filename>.well-known/acme-challenge/</filename> directory

23− will be created below the webroot if it doesn't exist.

24− <literal>http://example.org/.well-known/acme-challenge/</literal> must also

25− be available (notice unencrypted HTTP).

26− '';

27− };

28−

29− domain = mkOption {

30− type = types.str;

31− default = name;

32− description = "Domain to fetch certificate for (defaults to the entry name)";

33− };

34−

35− email = mkOption {

36− type = types.nullOr types.str;

37− default = null;

38− description = "Contact email address for the CA to be able to reach you.";

39− };

40−

41− user = mkOption {

42− type = types.str;

43− default = "root";

44− description = "User running the ACME client.";

45− };

46−

47− group = mkOption {

48− type = types.str;

49− default = "root";

50− description = "Group running the ACME client.";

51− };

52−

53− allowKeysForGroup = mkOption {

54− type = types.bool;

55− default = false;

56− description = ''

57− Give read permissions to the specified group

58− (<option>security.acme.cert.<name>.group</option>) to read SSL private certificates.

59− '';

60− };

61−

62− postRun = mkOption {

63− type = types.lines;

64− default = "";

65− example = "systemctl reload nginx.service";

66− description = ''

67− Commands to run after new certificates go live. Typically

68− the web server and other servers using certificates need to

69− be reloaded.

70−

71− Executed in the same directory with the new certificate.

72− '';

73− };

74−

75− plugins = mkOption {

76− type = types.listOf (types.enum [

77− "cert.der" "cert.pem" "chain.pem" "external.sh"

78− "fullchain.pem" "full.pem" "key.der" "key.pem" "account_key.json" "account_reg.json" ### CHANGED

79− ]);

80− default = [ "fullchain.pem" "full.pem" "key.pem" "account_key.json" "account_reg.json" ]; ### CHANGED

81− description = ''

82− Plugins to enable. With default settings simp_le will

83− store public certificate bundle in <filename>fullchain.pem</filename>,

84− private key in <filename>key.pem</filename> and those two previous

85− files combined in <filename>full.pem</filename> in its state directory.

86− '';

87− };

88−

89− activationDelay = mkOption {

90− type = types.nullOr types.str;

91− default = null;

92− description = ''

93− Systemd time span expression to delay copying new certificates to main

94− state directory. See <citerefentry><refentrytitle>systemd.time</refentrytitle>

95− <manvolnum>7</manvolnum></citerefentry>.

96− '';

97− };

98−

99− preDelay = mkOption {

100− type = types.lines;

101− default = "";

102− description = ''

103− Commands to run after certificates are re-issued but before they are

104− activated. Typically the new certificate is published to DNS.

105−

106− Executed in the same directory with the new certificate.

107− '';

108− };

109−

110− extraDomains = mkOption {

111− type = types.attrsOf (types.nullOr types.str);

112− default = {};

113− example = literalExample ''

114− {

115− "example.org" = "/srv/http/nginx";

116− "mydomain.org" = null;

117− }

118− '';

119− description = ''

120− A list of extra domain names, which are included in the one certificate to be issued, with their

121− own server roots if needed.

122− '';

123− };

124− };

125− };

126−

127−in

128−

129−{

130−

131− ###### interface

132−

133− options = {

134− security.acme = {

135− directory = mkOption {

136− default = "/var/lib/acme";

137− type = types.str;

138− description = ''

139− Directory where certs and other state will be stored by default.

140− '';

141− };

142−

143− validMin = mkOption {

144− type = types.int;

145− default = 30 * 24 * 3600;

146− description = "Minimum remaining validity before renewal in seconds.";

147− };

148−

149− renewInterval = mkOption {

150− type = types.str;

151− default = "weekly";

152− description = ''

153− Systemd calendar expression when to check for renewal. See

154− <citerefentry><refentrytitle>systemd.time</refentrytitle>

155− <manvolnum>7</manvolnum></citerefentry>.

156− '';

157− };

158−

159− preliminarySelfsigned = mkOption {

160− type = types.bool;

161− default = true;

162− description = ''

163− Whether a preliminary self-signed certificate should be generated before

164− doing ACME requests. This can be useful when certificates are required in

165− a webserver, but ACME needs the webserver to make its requests.

166−

167− With preliminary self-signed certificate the webserver can be started and

168− can later reload the correct ACME certificates.

169− '';

170− };

171−

172− production = mkOption {

173− type = types.bool;

174− default = true;

175− description = ''

176− If set to true, use Let's Encrypt's production environment

177− instead of the staging environment. The main benefit of the

178− staging environment is to get much higher rate limits.

179−

180− See

181− <literal>https://letsencrypt.org/docs/staging-environment</literal>

182− for more detail.

183− '';

184− };

185−

186− certs = mkOption {

187− default = { };

188− type = with types; attrsOf (submodule certOpts);

189− description = ''

190− Attribute set of certificates to get signed and renewed.

191− '';

192− example = literalExample ''

193− {

194− "example.com" = {

195− webroot = "/var/www/challenges/";

196− email = "foo@example.com";

197− extraDomains = { "www.example.com" = null; "foo.example.com" = "/var/www/foo/"; };

198− };

199− "bar.example.com" = {

200− webroot = "/var/www/challenges/";

201− email = "bar@example.com";

202− };

203− }

204− '';

205− };

206− };

207− };

208−

209− ###### implementation

210− config = mkMerge [

211− (mkIf (cfg.certs != { }) {

212−

213− systemd.services = let

214− services = concatLists servicesLists;

215− servicesLists = mapAttrsToList certToServices cfg.certs;

216− certToServices = cert: data:

217− let

218− cpath = lpath + optionalString (data.activationDelay != null) ".staging";

219− lpath = "${cfg.directory}/${cert}";

220− rights = if data.allowKeysForGroup then "750" else "700";

221− cmdline = [ "-v" "-d" data.domain "--default_root" data.webroot "--valid_min" cfg.validMin ]

222− ++ optionals (data.email != null) [ "--email" data.email ]

223− ++ concatMap (p: [ "-f" p ]) data.plugins

224− ++ concatLists (mapAttrsToList (name: root: [ "-d" (if root == null then name else "${name}:${root}")]) data.extraDomains)

225− ++ optionals (!cfg.production) ["--server" "https://acme-staging.api.letsencrypt.org/directory"];

226− acmeService = {

227− description = "Renew ACME Certificate for ${cert}";

228− after = [ "network.target" "network-online.target" ];

229− wants = [ "network-online.target" ];

230− serviceConfig = {

231− Type = "oneshot";

232− SuccessExitStatus = [ "0" "1" ];

233− PermissionsStartOnly = true;

234− User = data.user;

235− Group = data.group;

236− PrivateTmp = true;

237− };

238− path = with pkgs; [ simp_le systemd ];

239− preStart = ''

240− mkdir -p '${cfg.directory}'

241− chown 'root:root' '${cfg.directory}'

242− chmod 755 '${cfg.directory}'

243− if [ ! -d '${cpath}' ]; then

244− mkdir '${cpath}'

245− fi

246− chmod ${rights} '${cpath}'

247− chown -R '${data.user}:${data.group}' '${cpath}'

248− mkdir -p '${data.webroot}/.well-known/acme-challenge'

249− chown -R '${data.user}:${data.group}' '${data.webroot}/.well-known/acme-challenge'

250− '';

251− script = ''

252− cd '${cpath}'

253− set +e

254− simp_le ${escapeShellArgs cmdline}

255− EXITCODE=$?

256− set -e

257− echo "$EXITCODE" > /tmp/lastExitCode

258− exit "$EXITCODE"

259− '';

260− postStop = ''

261− cd '${cpath}'

262−

263− if [ -e /tmp/lastExitCode ] && [ "$(cat /tmp/lastExitCode)" = "0" ]; then

264− ${if data.activationDelay != null then ''

265−

266− ${data.preDelay}

267−

268− if [ -d '${lpath}' ]; then

269− systemd-run --no-block --on-active='${data.activationDelay}' --unit acme-setlive-${cert}.service

270− else

271− systemctl --wait start acme-setlive-${cert}.service

272− fi

273− '' else data.postRun}

274−

275− # noop ensuring that the "if" block is non-empty even if

276− # activationDelay == null and postRun == ""

277− true

278− fi

279− '';

280−

281− before = [ "acme-certificates.target" ];

282− wantedBy = [ "acme-certificates.target" ];

283− };

284− delayService = {

285− description = "Set certificate for ${cert} live";

286− path = with pkgs; [ rsync ];

287− serviceConfig = {

288− Type = "oneshot";

289− };

290− script = ''

291− rsync -a --delete-after '${cpath}/' '${lpath}'

292− '';

293− postStop = data.postRun;

294− };

295− selfsignedService = {

296− description = "Create preliminary self-signed certificate for ${cert}";

297− path = [ pkgs.openssl ];

298− preStart = ''

299− if [ ! -d '${cpath}' ]

300− then

301− mkdir -p '${cpath}'

302− chmod ${rights} '${cpath}'

303− chown '${data.user}:${data.group}' '${cpath}'

304− fi

305− '';

306− script =

307− ''

308− workdir="$(mktemp -d)"

309−

310− # Create CA

311− openssl genrsa -des3 -passout pass:xxxx -out $workdir/ca.pass.key 2048

312− openssl rsa -passin pass:xxxx -in $workdir/ca.pass.key -out $workdir/ca.key

313− openssl req -new -key $workdir/ca.key -out $workdir/ca.csr \

314− -subj "/C=UK/ST=Warwickshire/L=Leamington/O=OrgName/OU=Security Department/CN=example.com"

315− openssl x509 -req -days 1 -in $workdir/ca.csr -signkey $workdir/ca.key -out $workdir/ca.crt

316−

317− # Create key

318− openssl genrsa -des3 -passout pass:xxxx -out $workdir/server.pass.key 2048

319− openssl rsa -passin pass:xxxx -in $workdir/server.pass.key -out $workdir/server.key

320− openssl req -new -key $workdir/server.key -out $workdir/server.csr \

321− -subj "/C=UK/ST=Warwickshire/L=Leamington/O=OrgName/OU=IT Department/CN=example.com"

322− openssl x509 -req -days 1 -in $workdir/server.csr -CA $workdir/ca.crt \

323− -CAkey $workdir/ca.key -CAserial $workdir/ca.srl -CAcreateserial \

324− -out $workdir/server.crt

325−

326− # Copy key to destination

327− cp $workdir/server.key ${cpath}/key.pem

328−

329− # Create fullchain.pem (same format as "simp_le ... -f fullchain.pem" creates)

330− cat $workdir/{server.crt,ca.crt} > "${cpath}/fullchain.pem"

331−

332− # Create full.pem for e.g. lighttpd

333− cat $workdir/{server.key,server.crt,ca.crt} > "${cpath}/full.pem"

334−

335− # Give key acme permissions

336− chown '${data.user}:${data.group}' "${cpath}/"{key,fullchain,full}.pem

337− chmod ${rights} "${cpath}/"{key,fullchain,full}.pem

338− '';

339− serviceConfig = {

340− Type = "oneshot";

341− PermissionsStartOnly = true;

342− PrivateTmp = true;

343− User = data.user;

344− Group = data.group;

345− };

346− unitConfig = {

347− # Do not create self-signed key when key already exists

348− ConditionPathExists = "!${cpath}/key.pem";

349− };

350− before = [

351− "acme-selfsigned-certificates.target"

352− ];

353− wantedBy = [

354− "acme-selfsigned-certificates.target"

355− ];

356− };

357− in (

358− [ { name = "acme-${cert}"; value = acmeService; } ]

359− ++ optional cfg.preliminarySelfsigned { name = "acme-selfsigned-${cert}"; value = selfsignedService; }

360− ++ optional (data.activationDelay != null) { name = "acme-setlive-${cert}"; value = delayService; }

361− );

362− servicesAttr = listToAttrs services;

363− injectServiceDep = {

364− after = [ "acme-selfsigned-certificates.target" ];

365− wants = [ "acme-selfsigned-certificates.target" "acme-certificates.target" ];

366− };

367− in

368− servicesAttr //

369− (if config.services.nginx.enable then { nginx = injectServiceDep; } else {}) //

370− (if config.services.lighttpd.enable then { lighttpd = injectServiceDep; } else {});

371−

372− systemd.timers = flip mapAttrs' cfg.certs (cert: data: nameValuePair

373− ("acme-${cert}")

374− ({

375− description = "Renew ACME Certificate for ${cert}";

376− wantedBy = [ "timers.target" ];

377− timerConfig = {

378− OnCalendar = cfg.renewInterval;

379− Unit = "acme-${cert}.service";

380− Persistent = "yes";

381− AccuracySec = "5m";

382− RandomizedDelaySec = "1h";

383− };

384− })

385− );

386−

387− systemd.targets."acme-selfsigned-certificates" = mkIf cfg.preliminarySelfsigned {};

388− systemd.targets."acme-certificates" = {};

389− })

390−

391− ];

392−

393− meta = {

394− maintainers = with lib.maintainers; [ abbradar fpletz globin ];

395− #doc = ./acme.xml; ### CHANGED

396− };

397−}

all-builds.nixnew file+117

@@ -0,0 +1,117 @@

1+{ self-args ? {

2+ config.android_sdk.accept_license = true;

3+ iosSdkVersion = "10.2";

4+ }

5+, local-self ? import ./. self-args

6+, supportedSystems ? [

7+ "x86_64-linux"

8+ "x86_64-darwin"

9+ ]

10+}:

11+

12+let

13+ inherit (local-self.nixpkgs) lib runCommand nix;

14+ cacheBuildSystems = supportedSystems;

15+

16+ obeliskPackagesCommon = [

17+ "obelisk-frontend"

18+ "obelisk-route"

19+ "obelisk-executable-config-lookup"

20+ ];

21+

22+ obeliskPackagesBackend = obeliskPackagesCommon ++ [

23+ "obelisk-asset-manifest"

24+ "obelisk-asset-serve-snap"

25+ "obelisk-backend"

26+ "obelisk-cliapp"

27+ "obelisk-command"

28+ "obelisk-executable-config-inject"

29+ "obelisk-frontend"

30+ "obelisk-run"

31+ "obelisk-route"

32+ "obelisk-selftest"

33+ "obelisk-snap-extras"

34+ ];

35+

36+ pnameToAttrs = pkgsSet: pnames:

37+ lib.listToAttrs (map

38+ (name: { inherit name; value = pkgsSet.${name}; })

39+ pnames);

40+

41+ concatDepends = let

42+ extractDeps = x: (x.override {

43+ mkDerivation = drv: {

44+ out = builtins.concatLists [

45+ (drv.buildDepends or [])

46+ (drv.libraryHaskellDepends or [])

47+ (drv.executableHaskellDepends or [])

48+ ];

49+ };

50+ }).out;

51+ in pkgAttrs: builtins.concatLists (map extractDeps (builtins.attrValues pkgAttrs));

52+

53+ perPlatform = lib.genAttrs cacheBuildSystems (system: let

54+ reflex-platform = import ./dep/reflex-platform { inherit system; };

55+ perProfiling = profiling: let

56+ obelisk = import ./. (self-args // { inherit system profiling; });

57+ ghc = pnameToAttrs

58+ obelisk.haskellPackageSets.ghc

59+ obeliskPackagesBackend;

60+ ghcjs = pnameToAttrs

61+ obelisk.haskellPackageSets.ghcjs

62+ obeliskPackagesCommon;

63+ cachePackages = builtins.concatLists [

64+ (builtins.attrValues ghc)

65+ (lib.optionals (!profiling) (builtins.attrValues ghcjs))

66+ (concatDepends ghc)

67+ (lib.optionals (!profiling) (concatDepends ghcjs))

68+ (lib.optional reflex-platform.androidSupport androidSkeleton)

69+ (lib.optional reflex-platform.iosSupport iosSkeleton)

70+ (lib.optionals (!profiling) [

71+ command

72+ serverSkeletonExe

73+ serverSkeletonShell

74+ ])

75+ ];

76+ command = obelisk.command;

77+ skeleton = import ./skeleton { inherit obelisk; };

78+ serverSkeletonExe = skeleton.exe;

79+ # TODO fix nixpkgs so it doesn't try to run the result of haskell shells as setup hooks.

80+ serverSkeletonShell = local-self.nixpkgs.runCommand "shell-safe-for-dep" {} ''

81+ touch "$out"

82+ echo "return" >> "$out"

83+ cat "${skeleton.shells.ghc}" >> "$out"

84+ '';

85+ androidSkeleton = (import ./skeleton { inherit obelisk; }).android.frontend;

86+ iosSkeleton = (import ./skeleton { inherit obelisk; }).ios.frontend;

87+ nameSuffix = if profiling then "profiled" else "unprofiled";

88+ in {

89+ inherit

90+ ghc

91+ ;

92+ cache = reflex-platform.pinBuildInputs "obelisk-${system}-${nameSuffix}" cachePackages;

93+ } // lib.optionalAttrs (!profiling) {

94+ inherit

95+ command

96+ ghcjs

97+ serverSkeletonExe

98+ serverSkeletonShell

99+ ;

100+ } // lib.optionalAttrs reflex-platform.androidSupport {

101+ inherit androidSkeleton;

102+ } // lib.optionalAttrs reflex-platform.iosSupport {

103+ inherit iosSkeleton;

104+ };

105+ profiled = perProfiling true;

106+ unprofiled = perProfiling false;

107+ cachePackages = map (p: p.cache) [ profiled unprofiled ];

108+ in {

109+ inherit profiled unprofiled;

110+ cache = reflex-platform.pinBuildInputs "obelisk-${system}" cachePackages;

111+ });

112+

113+ metaCache = local-self.reflex-platform.pinBuildInputs

114+ "obelisk-everywhere"

115+ (map (a: a.cache) (builtins.attrValues perPlatform));

116+

117+in perPlatform // { inherit metaCache; }

all-tests.nixnew file+107

@@ -0,0 +1,107 @@

1+{

2+ supportedSystems ? [ builtins.currentSystem ]

3+}:

4+let

5+ nginxRoot = "/run/nginx";

6+ obelisk = import ./default.nix {};

7+ # Get NixOS a pre-release 20.03 that contains the python based tests and recursive nix

8+ pkgs = import (builtins.fetchTarball https://github.com/nixos/nixpkgs/archive/3de5266.tar.gz) {};

9+ sshKeys = import (pkgs.path + /nixos/tests/ssh-keys.nix) pkgs;

10+ make-test = import (pkgs.path + /nixos/tests/make-test-python.nix);

11+ obelisk-everywhere = (import ./all-builds.nix { inherit supportedSystems; }).x86_64-linux.cache;

12+ snakeOilPrivateKey = sshKeys.snakeOilPrivateKey.text;

13+ snakeOilPublicKey = sshKeys.snakeOilPublicKey;

14+in

15+ make-test ({...}: {

16+ name = "obelisk";

17+ nodes = {

18+ githost = {

19+ networking.firewall.allowedTCPPorts = [ 22 80 ];

20+ services.openssh = {

21+ enable = true;

22+ };

23+ environment.systemPackages = [

24+ pkgs.git

25+ ];

26+ users.users.root.openssh.authorizedKeys.keys = [

27+ snakeOilPublicKey

28+ ];

29+ };

30+

31+ client = {

32+ imports = [

33+ (pkgs.path + /nixos/modules/installer/cd-dvd/channel.nix)

34+ ];

35+ nix.useSandbox = false;

36+ nix.binaryCaches = [];

37+ environment.systemPackages = [

38+ obelisk.command

39+ obelisk.shell

40+ obelisk-everywhere

41+ pkgs.git

42+ ];

43+ };

44+ };

45+

46+ testScript =

47+ let

48+ privateKeyFile = pkgs.writeText "id_rsa" ''${snakeOilPrivateKey}'';

49+ sshConfigFile = pkgs.writeText "ssh_config" ''

50+ Host *

51+ StrictHostKeyChecking no

52+ UserKnownHostsFile=/dev/null

53+ ConnectionAttempts=1

54+ ConnectTimeout=1

55+ IdentityFile=~/.ssh/id_rsa

56+ User=root

57+ '';

58+ in ''

59+ start_all()

60+ githost.wait_for_open_port("22")

61+

62+ with subtest("test obelisk is installed"):

63+ client.succeed("ob --help")

64+

65+ with subtest("test the client can access the server via ssh"):

66+ client.succeed("mkdir -p ~/.ssh/")

67+ client.succeed(

68+ "cp ${privateKeyFile} ~/.ssh/id_rsa"

69+ )

70+ client.succeed("chmod 600 ~/.ssh/id_rsa")

71+ client.wait_until_succeeds(

72+ "ssh -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no -i ~/.ssh/id_rsa githost true"

73+ )

74+ client.succeed(

75+ "cp ${sshConfigFile} ~/.ssh/config"

76+ )

77+ client.wait_until_succeeds("ssh githost true")

78+

79+ with subtest("test a remote bare repo can be started"):

80+ githost.succeed("mkdir -p ~/myorg/myapp.git")

81+ githost.succeed("cd ~/myorg/myapp.git && git init --bare")

82+

83+ with subtest("test a git project can be configured with a remote using ssh"):

84+ client.succeed("mkdir -p ~/code/myapp")

85+ client.succeed("cd ~/code/myapp && git init")

86+ client.succeed("cd ~/code/myapp && touch README")

87+ client.succeed("cd ~/code/myapp && git add .")

88+ client.succeed('git config --global user.email "you@example.com"')

89+ client.succeed('git config --global user.name "Your Name"')

90+ client.succeed('cd ~/code/myapp && git commit -m "Initial"')

91+ client.succeed(

92+ "cd ~/code/myapp && git remote add origin root@githost:/root/myorg/myapp.git"

93+ )

94+

95+ with subtest("test pushing code to the remote"):

96+ client.succeed("cd ~/code/myapp && git push -u origin master")

97+ client.succeed("cd ~/code/myapp && git status")

98+

99+ with subtest("test obelisk can pack"):

100+ client.succeed("ob thunk pack ~/code/myapp")

101+ client.succeed("grep -qF 'git' ~/code/myapp/default.nix")

102+ client.succeed("grep -qF 'myorg' ~/code/myapp/git.json")

103+

104+ with subtest("test obelisk can detect private repos"):

105+ client.succeed("""grep -qF '"private": false' ~/code/myapp/git.json""")

106+ '';

107+ }) {}

default.nix+25−29

@@ -2,6 +2,7 @@

2, profiling ? false

3, iosSdkVersion ? "10.2"

4, config ? {}

5+, reflex-platform-func ? import ./dep/reflex-platform

5}:

6}:

6let

7let

7 cleanSource = builtins.filterSource (name: _: let baseName = builtins.baseNameOf name; in !(

8 cleanSource = builtins.filterSource (name: _: let baseName = builtins.baseNameOf name; in !(

@@ -16,7 +17,7 @@ let

16 openssh

17 openssh

17 ];

18 ];

19− getReflexPlatform = sys: import ./dep/reflex-platform {

20+ getReflexPlatform = sys: reflex-platform-func {

20 inherit iosSdkVersion config;

21 inherit iosSdkVersion config;

21 system = sys;

22 system = sys;

22 enableLibraryProfiling = profiling;

23 enableLibraryProfiling = profiling;

@@ -34,10 +35,7 @@ let

34 pkgs = self.callPackage ({ pkgs }: pkgs) {};

35 pkgs = self.callPackage ({ pkgs }: pkgs) {};

35 haskellLib = pkgs.haskell.lib;

36 haskellLib = pkgs.haskell.lib;

36 in {

37 in {

37− hnix = haskellLib.overrideCabal (self.callHackage "hnix" "0.6.1" { these = self.these_0_8; }) (_: {

38+ hnix = haskellLib.dontCheck (haskellLib.doJailbreak (self.callCabal2nix "hnix" (hackGet dep/hnix) {}));

38− jailbreak = true;

39− doCheck = false;

40− });

41 hnix-store-core = self.callHackage "hnix-store-core" "0.1.0.0" {};

39 hnix-store-core = self.callHackage "hnix-store-core" "0.1.0.0" {};

43 ghcid = self.callCabal2nix "ghcid" (hackGet ./dep/ghcid) {};

41 ghcid = self.callCabal2nix "ghcid" (hackGet ./dep/ghcid) {};

@@ -50,6 +48,8 @@ let

50 pkgs = self.callPackage ({ pkgs }: pkgs) {};

48 pkgs = self.callPackage ({ pkgs }: pkgs) {};

51 onLinux = pkg: f: if pkgs.stdenv.isLinux then f pkg else pkg;

49 onLinux = pkg: f: if pkgs.stdenv.isLinux then f pkg else pkg;

52 in {

50 in {

51+ shelly = self.callHackage "shelly" "1.9.0" {};

52+

53 obelisk-executable-config-inject = pkgs.obeliskExecutableConfig.platforms.web.inject self;

55 obelisk-asset-manifest = self.callCabal2nix "obelisk-asset-manifest" (cleanSource ./lib/asset/manifest) {};

@@ -67,7 +67,12 @@ let

67 haskellLib.overrideCabal pkg (drv: { librarySystemDepends = [ pkgs.iproute ]; })

68 );

69 obelisk-route = self.callCabal2nix "obelisk-route" (cleanSource ./lib/route) {};

70− obelisk-selftest = self.callCabal2nix "obelisk-selftest" (cleanSource ./lib/selftest) {};

70+ obelisk-selftest = haskellLib.overrideCabal (self.callCabal2nix "obelisk-selftest" (cleanSource ./lib/selftest) {}) {

71+ librarySystemDepends = [

72+ pkgs.cabal-install

73+ pkgs.coreutils

74+ ];

75+ };

71 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};

76 obelisk-snap-extras = self.callCabal2nix "obelisk-snap-extras" (cleanSource ./lib/snap-extras) {};

72 tabulation = self.callCabal2nix "tabulation" (cleanSource ./lib/tabulation) {};

77 tabulation = self.callCabal2nix "tabulation" (cleanSource ./lib/tabulation) {};

73 })

78 })

@@ -116,7 +121,7 @@ in rec {

116 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.

121 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.

117 path = reflex-platform.filterGit ./.;

122 path = reflex-platform.filterGit ./.;

118 obelisk = ghcObelisk;

123 obelisk = ghcObelisk;

119− obeliskEnvs = ghcObeliskEnvs;

124+ obeliskEnvs = pkgs.lib.filterAttrs (k: _: pkgs.lib.strings.hasPrefix "obelisk-" k) ghcObeliskEnvs;

120 command = ghcObelisk.obelisk-command;

125 command = ghcObelisk.obelisk-command;

121 shell = pinBuildInputs "obelisk-shell" ([command] ++ commandRuntimeDeps pkgs);

126 shell = pinBuildInputs "obelisk-shell" ([command] ++ commandRuntimeDeps pkgs);

122

127

@@ -125,10 +130,10 @@ in rec {

125 set -euo pipefail

130 set -euo pipefail

126

131

127 PATH="${command}/bin:$PATH"

132 PATH="${command}/bin:$PATH"

128− export OBELISK_IMPL="${hackGet ./.}"

133+ export OBELISK_IMPL="$(mktemp -d)"

134+ git clone file://${pathGit} $OBELISK_IMPL

129 "${ghcObelisk.obelisk-selftest}/bin/obelisk-selftest" +RTS -N -RTS "$@"

135 "${ghcObelisk.obelisk-selftest}/bin/obelisk-selftest" +RTS -N -RTS "$@"

130 '';

136 '';

131− #TODO: Why can't I build ./skeleton directly as a derivation? `nix-build -E ./.` doesn't work

132 skeleton = pkgs.runCommand "skeleton" {

137 skeleton = pkgs.runCommand "skeleton" {

133 dir = builtins.filterSource (path: type: builtins.trace path (baseNameOf path != ".obelisk")) ./skeleton;

138 dir = builtins.filterSource (path: type: builtins.trace path (baseNameOf path != ".obelisk")) ./skeleton;

134 } ''

139 } ''

@@ -150,6 +155,7 @@ in rec {

150 compressedJs = frontend: optimizationLevel: pkgs.runCommand "compressedJs" {} ''

155 compressedJs = frontend: optimizationLevel: pkgs.runCommand "compressedJs" {} ''

151 mkdir $out

156 mkdir $out

152 cd $out

157 cd $out

158+ # TODO profiling + static shouldn't break and need an ad-hoc workaround like that

153 ln -s "${haskellLib.justStaticExecutables frontend}/bin/frontend.jsexe/all.js" all.unminified.js

159 ln -s "${haskellLib.justStaticExecutables frontend}/bin/frontend.jsexe/all.js" all.unminified.js

154 ${if optimizationLevel == null then ''

160 ${if optimizationLevel == null then ''

155 ln -s all.unminified.js all.js

161 ln -s all.unminified.js all.js

@@ -232,7 +238,7 @@ in rec {

232 pkgs.runCommand "serverExe" {} ''

238 pkgs.runCommand "serverExe" {} ''

233 mkdir $out

239 mkdir $out

234 set -eux

240 set -eux

235− ln -s "${haskellLib.justStaticExecutables backend}"/bin/* $out/

241+ ln -s "${if profiling then backend else haskellLib.justStaticExecutables backend}"/bin/* $out/

236 ln -s "${mkAssets assets}" $out/static.assets

242 ln -s "${mkAssets assets}" $out/static.assets

237 ln -s ${mkAssets (compressedJs frontend optimizationLevel)} $out/frontend.jsexe.assets

243 ln -s ${mkAssets (compressedJs frontend optimizationLevel)} $out/frontend.jsexe.assets

238 echo ${version} > $out/version

244 echo ${version} > $out/version

@@ -247,17 +253,6 @@ in rec {

247 imports = [

253 imports = [

248 (serverModules.mkBaseEc2 args)

254 (serverModules.mkBaseEc2 args)

249 (serverModules.mkObeliskApp args)

255 (serverModules.mkObeliskApp args)

250− ./acme.nix

251− ];

252− disabledModules = [

253− (pkgs.path + /nixos/modules/security/acme.nix)

254− ];

255− nixpkgs.overlays = [

256− (self: super: let

257− nixos1909 = import (hackGet ./dep/nixpkgs-19.09) {};

258− in {

259− inherit (nixos1909) simp_le;

260− })

261 ];

256 ];

262 };

257 };

263 };

258 };

@@ -341,18 +336,19 @@ in rec {

341 passthru = { inherit android ios packages overrides tools shellToolOverrides withHoogle staticFiles staticFilesImpure __closureCompilerOptimizationLevel processedStatic __iosWithConfig __androidWithConfig; };

336 passthru = { inherit android ios packages overrides tools shellToolOverrides withHoogle staticFiles staticFilesImpure __closureCompilerOptimizationLevel processedStatic __iosWithConfig __androidWithConfig; };

342 };

337 };

343 in mkProject (projectDefinition args));

338 in mkProject (projectDefinition args));

339+ mainProjectOut = projectOut system;

344− serverOn = sys: version: serverExe

340+ serverOn = projectInst: version: serverExe

345− (projectOut sys).ghc.backend

341+ projectInst.ghc.backend

346− (projectOut system).ghcjs.frontend

342+ mainProjectOut.ghcjs.frontend

347− (projectOut sys).passthru.staticFiles

343+ projectInst.passthru.staticFiles

348− (projectOut sys).passthru.__closureCompilerOptimizationLevel

344+ projectInst.passthru.__closureCompilerOptimizationLevel

349 version;

345 version;

350− linuxExe = serverOn "x86_64-linux";

346+ linuxExe = serverOn (projectOut "x86_64-linux");

351 dummyVersion = "Version number is only available for deployments";

347 dummyVersion = "Version number is only available for deployments";

352− in projectOut system // {

348+ in mainProjectOut // {

353 linuxExeConfigurable = linuxExe;

349 linuxExeConfigurable = linuxExe;

354 linuxExe = linuxExe dummyVersion;

350 linuxExe = linuxExe dummyVersion;

355− exe = serverOn system dummyVersion;

351+ exe = serverOn mainProjectOut dummyVersion;

356 server = args@{ hostName, adminEmail, routeHost, enableHttps, version }:

352 server = args@{ hostName, adminEmail, routeHost, enableHttps, version }:

357 server (args // { exe = linuxExe version; });

353 server (args // { exe = linuxExe version; });

358 obelisk = import (base + "/.obelisk/impl") {};

354 obelisk = import (base + "/.obelisk/impl") {};

dep/nixpkgs-19.09/default.nix → dep/hnix/default.nixrenamed

The content is the same.

dep/hnix/github.jsonnew file+7

@@ -0,0 +1,7 @@

1+{

2+ "owner": "haskell-nix",

3+ "repo": "hnix",

4+ "branch": "master",

5+ "rev": "6c9c7c310c54372b3db0fdf5a0137b395cde1bdb",

6+ "sha256": "1i5903b7lxqn2s3jarb14h6wdq8bxiik1hp0xy43w5w1hgvvq0g5"

7+}

dep/nixpkgs-19.09/github.jsondeleted−7

@@ -1,7 +0,0 @@

1−{

2− "owner": "nixos",

3− "repo": "nixpkgs-channels",

4− "branch": "nixos-19.09",

5− "rev": "ca9f709fd0b8535261234e6eb5d2020aaf1a2c61",

6− "sha256": "0z1qgmzx9dwbvwxf16f9m30y8lqy4zv4phl0mcyv7grfhj3s1abw"

7−}

dep/reflex-platform/github.json+2−2

@@ -2,6 +2,6 @@

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4 "branch": "develop",

5− "rev": "aa8a9d1ac3d41ad51fbe04e575d4350da65cf3db",

5+ "rev": "90351bdb2c99d416ea95fd5b8b474e8f9fab2942",

6− "sha256": "0hffy5rcfy6ay06ww3cxykqzp024jfcdg6w1yrmnf0h80sjfgdcm"

6+ "sha256": "0bbzz4ckdx0ilhhpd3drfbsc0zdb2rnhw2m3nls9villbs3lz3lh"

jobsets.nixdeleted−71

@@ -1,71 +0,0 @@

1−{ prs }:

2−

3−let

4− self = import ./. {};

5− pkgs = self.nixpkgs;

6− mkFetchGithub = value: {

7− inherit value;

8− type = "git";

9− emailresponsible = false;

10− };

11−in

12−with pkgs.lib;

13−let

14− defaults = jobs: {

15− inherit (jobs) description;

16− enabled = 1;

17− hidden = false;

18− keepnr = 10;

19− schedulingshares = 100;

20− checkinterval = 120;

21− enableemail = false;

22− emailoverride = "";

23− nixexprinput = "obelisk";

24− nixexprpath = "release.nix";

25− inputs = jobs.inputs // {

26− nixpkgs = {

27− type = "git";

28− value = "https://github.com/NixOS/nixpkgs-channels nixos-unstable";

29− emailresponsible = false;

30− };

31− };

32− self-args = {

33− type = "nix";

34− value = "{ config.android_sdk.accept_license = true; }";

35− emailresponsible = false;

36− };

37− };

38− branchJobset = branch: defaults {

39− description = "obelisk-${branch}";

40− inputs = {

41− obelisk = {

42− value = "https://github.com/obsidiansystems/obelisk ${branch}";

43− type = "git";

44− emailresponsible = false;

45− };

46− };

47− };

48− makePr = num: info: {

49− name = "obelisk-pr-${num}";

50− value = defaults {

51− description = "#${num}: ${info.title}";

52− inputs = {

53− obelisk = {

54− #NOTE: This should really use "pull/${num}/merge"; however, GitHub's

55− #status checks only operate on PR heads. This creates a race

56− #condition, which can currently only be solved by requiring PRs to be

57− #up to date before they're merged. See

58− #https://github.com/isaacs/github/issues/1002

59− value = "https://github.com/obsidiansystems/obelisk pull/${num}/head";

60− type = "git";

61− emailresponsible = false;

62− };

63− };

64− };

65− };

66− processedPrs = mapAttrs' makePr (builtins.fromJSON (builtins.readFile prs));

67− jobsetsAttrs = processedPrs //

68− genAttrs ["master"] branchJobset;

69−in {

70− jobsets = pkgs.writeText "spec.json" (builtins.toJSON jobsetsAttrs);

71−}

lib/asset/README.md+10−10

@@ -1,7 +1,7 @@

1## obelisk-asset

3−The 'assets.nix' file contains nix expressions that are a mutually

3+The 'assets.nix' file contains nix expressions that are a mutually

4−recursive set of attributes used to create static asset directories

4+recursive set of attributes used to create static asset directories

5with hashable file encodings. This file should be incorporated within

6your project's 'default.nix' file. (See ./example/default.nix , line 2)

7```

@@ -10,20 +10,20 @@ your project's 'default.nix' file. (See ./example/default.nix , line 2)

10```

12The 'mkAssets' and 'mkAssetsWith' functions within 'assets.nix' only

13−need to be passed an encoding('zopfliEncodings', 'gzipEncodings',

13+need to be passed an encoding('zopfliEncodings', 'gzipEncodings',

14'noEncodings') and a static directory of your choice as arguments.

16−In this example, 'mkAssets' is used on a directory that has a .png

16+In this example, 'mkAssets' is used on a directory that has a .png

17file inside of it. (See ./example/default.nix, line 11)

18```

19−myAssets = assets.mkAssets ./static;

19+myAssets = assets.mkAssets ./static;

20```

22−Once you have successfully incorporated 'assets.nix' into your

22+Once you have successfully incorporated 'assets.nix' into your

23−project's nix file(s), use nix-build to generate a symlink of

23+project's nix file(s), use nix-build to generate a symlink of

24−your 'mkAssets' expression. The following command from

24+your 'mkAssets' expression. The following command from

25−example/run-example (line 3) will generate an immutable symlink

25+example/run-example (line 3) will generate an immutable symlink

26−that holds hashed static assets.

26+that holds hashed static assets.

27```bash

28nix-build -o static.assets -A myAssets

29```

lib/cliapp/obelisk-cliapp.cabal+1

@@ -10,6 +10,7 @@ library

10 ansi-terminal

11 , base

12 , bytestring

13+ , containers

13 , exceptions

14 , exceptions

14 , io-streams

15 , io-streams

15 , lens

16 , lens

lib/cliapp/src/Obelisk/CliApp.hs+13−6

@@ -33,16 +33,23 @@ module Obelisk.CliApp

33 , Severity (..)

35 -- .Process

36− , ProcessFailure (..)

37 , AsProcessFailure (..)

36 , AsProcessFailure (..)

38− , readProcessAndLogStderr

37+ , ProcessFailure (..)

39− , readProcessAndLogOutput

38+ , ProcessSpec (..)

40− , readCreateProcessWithExitCode

39+ , callCommand

40+ , callProcess

41 , callProcessAndLogOutput

42 , createProcess_

43− , callProcess

43+ , overCreateProcess

44− , callCommand

44+ , proc

45+ , readCreateProcessWithExitCode

46+ , readProcessAndLogOutput

47+ , readProcessAndLogStderr

45 , reconstructCommand

48 , reconstructCommand

49+ , setCwd

50+ , setDelegateCtlc

51+ , setEnvOverride

52+ , shell

46 ) where

53 ) where

48import Control.Monad.Log (Severity (..))

55import Control.Monad.Log (Severity (..))

lib/cliapp/src/Obelisk/CliApp/Demo.hs−1

@@ -8,7 +8,6 @@ import Control.Monad.Fail

8import Control.Monad.IO.Class

9import Data.Semigroup ((<>))

10import qualified Data.Text as T

11−import System.Process (proc)

13import Control.Monad.Catch (MonadMask)

12import Control.Monad.Catch (MonadMask)

lib/cliapp/src/Obelisk/CliApp/Process.hs+81−34

@@ -9,17 +9,24 @@

9-- | An extension of `System.Process` that integrates with logging (`Obelisk.CLI.Logging`)

10-- and is thus spinner friendly.

11module Obelisk.CliApp.Process

12+ ( AsProcessFailure (..)

12− ( ProcessFailure (..)

13+ , ProcessFailure (..)

13− , AsProcessFailure (..)

14+ , ProcessSpec (..)

14− , readProcessAndLogStderr

15+ , callCommand

15− , readProcessAndLogOutput

16+ , callProcess

16− , readCreateProcessWithExitCode

17 , callProcessAndLogOutput

18 , createProcess

19 , createProcess_

20− , callProcess

20+ , overCreateProcess

21− , callCommand

21+ , proc

22+ , readCreateProcessWithExitCode

23+ , readProcessAndLogOutput

24+ , readProcessAndLogStderr

22 , reconstructCommand

25 , reconstructCommand

26+ , setCwd

27+ , setDelegateCtlc

28+ , setEnvOverride

29+ , shell

23 ) where

30 ) where

25import Control.Monad ((<=<), join, void)

32import Control.Monad ((<=<), join, void)

@@ -30,24 +37,50 @@ import Control.Lens (Prism', review)

30import qualified Data.ByteString as BS

37import qualified Data.ByteString as BS

31import qualified Data.ByteString.Char8 as BSC

38import qualified Data.ByteString.Char8 as BSC

32import Data.Function (fix)

39import Data.Function (fix)

40+import Data.Map (Map)

41+import qualified Data.Map as Map

33import Data.Monoid ((<>))

42import Data.Monoid ((<>))

34import Data.Text (Text)

43import Data.Text (Text)

35import qualified Data.Text as T

44import qualified Data.Text as T

36import qualified Data.Text.Encoding as T

45import qualified Data.Text.Encoding as T

37import Data.Text.Encoding.Error (lenientDecode)

46import Data.Text.Encoding.Error (lenientDecode)

47+import System.Environment (getEnvironment)

38import System.Exit (ExitCode (..))

48import System.Exit (ExitCode (..))

39import System.IO (Handle)

49import System.IO (Handle)

40import System.IO.Streams (InputStream, handleToInputStream)

50import System.IO.Streams (InputStream, handleToInputStream)

41import qualified System.IO.Streams as Streams

51import qualified System.IO.Streams as Streams

42import System.IO.Streams.Concurrent (concurrentMerge)

52import System.IO.Streams.Concurrent (concurrentMerge)

43−import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), cmdspec, std_err, std_out,

53+import System.Process (CreateProcess, ProcessHandle, StdStream (CreatePipe), std_err, std_out, waitForProcess)

44− waitForProcess)

45import qualified System.Process as Process

54import qualified System.Process as Process

47import Control.Monad.Log (Severity (..))

56import Control.Monad.Log (Severity (..))

48import Obelisk.CliApp.Logging (putLog, putLogRaw)

57import Obelisk.CliApp.Logging (putLog, putLogRaw)

49import Obelisk.CliApp.Types (CliLog, CliThrow)

58import Obelisk.CliApp.Types (CliLog, CliThrow)

60+data ProcessSpec = ProcessSpec

61+ { _processSpec_createProcess :: !CreateProcess

62+ , _processSpec_overrideEnv :: !(Maybe (Map String String -> Map String String))

63+ }

64+

65+proc :: FilePath -> [String] -> ProcessSpec

66+proc cmd args = ProcessSpec (Process.proc cmd args) Nothing

67+

68+shell :: String -> ProcessSpec

69+shell cmd = ProcessSpec (Process.shell cmd) Nothing

70+

71+setEnvOverride :: (Map String String -> Map String String) -> ProcessSpec -> ProcessSpec

72+setEnvOverride f p = p { _processSpec_overrideEnv = Just f }

73+

74+overCreateProcess :: (CreateProcess -> CreateProcess) -> ProcessSpec -> ProcessSpec

75+overCreateProcess f (ProcessSpec p x) = ProcessSpec (f p) x

76+

77+setDelegateCtlc :: Bool -> ProcessSpec -> ProcessSpec

78+setDelegateCtlc b = overCreateProcess (\p -> p { Process.delegate_ctlc = b })

79+

80+setCwd :: Maybe FilePath -> ProcessSpec -> ProcessSpec

81+setCwd fp = overCreateProcess (\p -> p { Process.cwd = fp })

82+

83+

51-- TODO put back in `Obelisk.CliApp.Process` and use prisms for extensible exceptions

84-- TODO put back in `Obelisk.CliApp.Process` and use prisms for extensible exceptions

52data ProcessFailure = ProcessFailure Process.CmdSpec Int -- exit code

85data ProcessFailure = ProcessFailure Process.CmdSpec Int -- exit code

53 deriving Show

86 deriving Show

@@ -62,7 +95,7 @@ instance AsProcessFailure ProcessFailure where

63readProcessAndLogStderr

96readProcessAndLogStderr

64 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

97 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

65− => Severity -> CreateProcess -> m Text

98+ => Severity -> ProcessSpec -> m Text

66readProcessAndLogStderr sev process = do

99readProcessAndLogStderr sev process = do

67 (out, _err) <- withProcess process $ \_out err -> do

100 (out, _err) <- withProcess process $ \_out err -> do

68 streamToLog =<< liftIO (streamHandle sev err)

101 streamToLog =<< liftIO (streamHandle sev err)

@@ -70,9 +103,10 @@ readProcessAndLogStderr sev process = do

103

71readCreateProcessWithExitCode

104readCreateProcessWithExitCode

72 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

105 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e)

73− => CreateProcess -> m (ExitCode, String, String)

106+ => ProcessSpec -> m (ExitCode, String, String)

74−readCreateProcessWithExitCode process = do

107+readCreateProcessWithExitCode procSpec = do

108+ process <- mkCreateProcess procSpec

75− putLog Debug $ "Creating process: " <> reconstructCommand (cmdspec process)

109+ putLog Debug $ "Creating process: " <> reconstructProcSpec procSpec

76 liftIO $ Process.readCreateProcessWithExitCode process ""

110 liftIO $ Process.readCreateProcessWithExitCode process ""

111

78-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

112-- | Like `System.Process.readProcess` but logs the combined output (stdout and stderr)

@@ -84,10 +118,10 @@ readCreateProcessWithExitCode process = do

84-- `callProcessAndLogOutput (Debug, Debug)`.

118-- `callProcessAndLogOutput (Debug, Debug)`.

85readProcessAndLogOutput

119readProcessAndLogOutput

86 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

120 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

87− => (Severity, Severity) -> CreateProcess -> m Text

121+ => (Severity, Severity) -> ProcessSpec -> m Text

88readProcessAndLogOutput (sev_out, sev_err) process = do

122readProcessAndLogOutput (sev_out, sev_err) process = do

89− (_, Just out, Just err, p) <- createProcess $ process

123+ (_, Just out, Just err, p) <- createProcess $ overCreateProcess

90− { std_out = CreatePipe , std_err = CreatePipe }

124+ (\p -> p { std_out = CreatePipe , std_err = CreatePipe }) process

125

92 -- TODO interleave stdout and stderr in log correctly

126 -- TODO interleave stdout and stderr in log correctly

93 streamToLog =<< liftIO (streamHandle sev_err err)

127 streamToLog =<< liftIO (streamHandle sev_err err)

@@ -96,9 +130,9 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

130

97 liftIO (waitForProcess p) >>= \case

131 liftIO (waitForProcess p) >>= \case

98 ExitSuccess -> pure outText

132 ExitSuccess -> pure outText

99− ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (cmdspec process) code

133+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

100

134

101−-- | Like `System.Process.callProcess` but logs the combined output (stdout and stderr)

135+-- | Like 'System.Process.callProcess' but logs the combined output (stdout and stderr)

102-- with the corresponding severity.

136-- with the corresponding severity.

103--

137--

104-- Usually this function is called as `callProcessAndLogOutput (Debug, Error)`. However

138-- Usually this function is called as `callProcessAndLogOutput (Debug, Error)`. However

@@ -106,9 +140,8 @@ readProcessAndLogOutput (sev_out, sev_err) process = do

106-- which case it is advisable to call it with a non-Error severity for stderr, like

140-- which case it is advisable to call it with a non-Error severity for stderr, like

107-- `callProcessAndLogOutput (Debug, Debug)`.

141-- `callProcessAndLogOutput (Debug, Debug)`.

108callProcessAndLogOutput

142callProcessAndLogOutput

109−

110 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

143 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

111− => (Severity, Severity) -> CreateProcess -> m ()

144+ => (Severity, Severity) -> ProcessSpec -> m ()

112callProcessAndLogOutput (sev_out, sev_err) process =

145callProcessAndLogOutput (sev_out, sev_err) process =

113 void $ withProcess process $ \out err -> do

146 void $ withProcess process $ \out err -> do

114 stream <- liftIO $ join $ combineStream

147 stream <- liftIO $ join $ combineStream

@@ -118,21 +151,31 @@ callProcessAndLogOutput (sev_out, sev_err) process =

118 where

151 where

119 combineStream s1 s2 = concurrentMerge [s1, s2]

152 combineStream s1 s2 = concurrentMerge [s1, s2]

120

153

121−-- | Like `System.Process.createProcess` but also logs (debug) the process being run

154+-- | Like 'System.Process.createProcess' but also logs (debug) the process being run

122createProcess

155createProcess

123 :: (MonadIO m, CliLog m)

156 :: (MonadIO m, CliLog m)

124− => CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

157+ => ProcessSpec -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

125−createProcess p = do

158+createProcess procSpec = do

159+ p <- mkCreateProcess procSpec

126− putLog Debug $ "Creating process: " <> reconstructCommand (cmdspec p)

160+ putLog Debug $ "Creating process: " <> reconstructProcSpec procSpec

127 liftIO $ Process.createProcess p

161 liftIO $ Process.createProcess p

128

162

129-- | Like `System.Process.createProcess_` but also logs (debug) the process being run

163-- | Like `System.Process.createProcess_` but also logs (debug) the process being run

130createProcess_

164createProcess_

131 :: (MonadIO m, CliLog m)

165 :: (MonadIO m, CliLog m)

132− => String -> CreateProcess -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

166+ => String -> ProcessSpec -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

133−createProcess_ name p = do

167+createProcess_ name procSpec = do

168+ p <- mkCreateProcess procSpec

134− putLog Debug $ "Creating process " <> T.pack name <> ": " <> reconstructCommand (cmdspec p)

169+ putLog Debug $ "Creating process " <> T.pack name <> ": " <> reconstructProcSpec procSpec

135− liftIO $ Process.createProcess p

170+ liftIO $ Process.createProcess_ name p

171+

172+mkCreateProcess :: MonadIO m => ProcessSpec -> m Process.CreateProcess

173+mkCreateProcess (ProcessSpec p override') = do

174+ case override' of

175+ Nothing -> pure p

176+ Just override -> do

177+ procEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (Process.env p)

178+ pure $ p { Process.env = Just $ Map.toAscList (override procEnv) }

136

179

137-- | Like `System.Process.callProcess` but also logs (debug) the process being run

180-- | Like `System.Process.callProcess` but also logs (debug) the process being run

138callProcess

181callProcess

@@ -152,17 +195,17 @@ callCommand cmd = do

152

195

153withProcess

196withProcess

154 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

197 :: (MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e, MonadFail m)

155− => CreateProcess -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

198+ => ProcessSpec -> (Handle -> Handle -> m ()) -> m (Handle, Handle)

156withProcess process f = do -- TODO: Use bracket.

199withProcess process f = do -- TODO: Use bracket.

157 -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.

200 -- FIXME: Using `withCreateProcess` here leads to something operating illegally on closed handles.

158− (_, Just out, Just err, p) <- createProcess $ process

201+ (_, Just out, Just err, p) <- createProcess $ overCreateProcess

159− { std_out = CreatePipe , std_err = CreatePipe }

202+ (\x -> x { std_out = CreatePipe , std_err = CreatePipe }) process

160

203

161 f out err -- Pass the handles to the passed function

204 f out err -- Pass the handles to the passed function

162

205

163 liftIO (waitForProcess p) >>= \case

206 liftIO (waitForProcess p) >>= \case

164 ExitSuccess -> return (out, err)

207 ExitSuccess -> return (out, err)

165− ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (cmdspec process) code

208+ ExitFailure code -> throwError $ review asProcessFailure $ ProcessFailure (Process.cmdspec $ _processSpec_createProcess process) code

166

209

167-- Create an input stream from the file handle, associating each item with the given severity.

210-- Create an input stream from the file handle, associating each item with the given severity.

168streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

211streamHandle :: Severity -> Handle -> IO (InputStream (Severity, BSC.ByteString))

@@ -179,8 +222,12 @@ streamToLog stream = fix $ \loop -> do

179

222

180-- | Pretty print a 'CmdSpec'

223-- | Pretty print a 'CmdSpec'

181reconstructCommand :: Process.CmdSpec -> Text

224reconstructCommand :: Process.CmdSpec -> Text

225+reconstructCommand p = case p of

182−reconstructCommand (Process.ShellCommand str) = T.pack str

226+ Process.ShellCommand str -> T.pack str

183−reconstructCommand (Process.RawCommand c as) = processToShellString c as

227+ Process.RawCommand c as -> processToShellString c as

184 where

228 where

185 processToShellString cmd args = T.unwords $ map quoteAndEscape (cmd : args)

229 processToShellString cmd args = T.unwords $ map quoteAndEscape (cmd : args)

186 quoteAndEscape x = "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

230 quoteAndEscape x = "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

231+

232+reconstructProcSpec :: ProcessSpec -> Text

233+reconstructProcSpec = reconstructCommand . Process.cmdspec . _processSpec_createProcess

lib/command/obelisk-command.cabal+1−1

@@ -1,5 +1,5 @@

1name: obelisk-command

2−version: 0.3

2+version: 0.4

3cabal-version: >= 1.8

4build-type: Simple

lib/command/src/Obelisk/Command.hs+28−13

@@ -13,6 +13,7 @@ import qualified Data.Binary as Binary

13import Data.Bool (bool)

14import qualified Data.ByteString.Base16 as Base16

15import qualified Data.ByteString.Lazy as LBS

16+import Data.Foldable (for_)

16import Data.List

17import Data.List

17import Data.Maybe (catMaybes)

18import Data.Maybe (catMaybes)

18import qualified Data.Text as T

19import qualified Data.Text as T

@@ -220,20 +221,35 @@ thunkDirectoryParser = fmap (dropTrailingPathSeparator . normalise) . strArgumen

220 , help "Path to directory containing thunk data"

221 , help "Path to directory containing thunk data"

221 ]

222 ]

222

223

224+thunkConfig :: Parser ThunkConfig

225+thunkConfig = ThunkConfig

226+ <$>

227+ ( flag' (Just True) (long "private" <> help "Mark thunks as pointing to a private repository")

228+ <|> flag' (Just False) (long "public" <> help "Mark thunks as pointing to a public repository")

229+ <|> pure Nothing

230+ )

231+

232+thunkUpdateConfig :: Parser ThunkUpdateConfig

233+thunkUpdateConfig = ThunkUpdateConfig

234+ <$> optional (strOption (long "branch" <> metavar "BRANCH" <> help "Use the given branch when looking for the latest revision"))

235+ <*> thunkConfig

236+

237+thunkPackConfig :: Parser ThunkPackConfig

238+thunkPackConfig = ThunkPackConfig

239+ <$> switch (long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care.")

240+ <*> thunkConfig

241+

223data ThunkCommand

242data ThunkCommand

224− = ThunkCommand_Update [FilePath] (Maybe String)

243+ = ThunkCommand_Update [FilePath] ThunkUpdateConfig

225 | ThunkCommand_Unpack [FilePath]

244 | ThunkCommand_Unpack [FilePath]

226− | ThunkCommand_Pack [FilePath] Bool

245+ | ThunkCommand_Pack [FilePath] ThunkPackConfig

227 deriving Show

246 deriving Show

228

247

229−forceFlag :: Parser Bool

230−forceFlag = switch $ long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care."

231−

232thunkCommand :: Parser ThunkCommand

248thunkCommand :: Parser ThunkCommand

233thunkCommand = hsubparser $ mconcat

249thunkCommand = hsubparser $ mconcat

234− [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> optional (strOption (long "branch" <> metavar "BRANCH"))) $ progDesc "Update thunk to latest revision available"

250+ [ command "update" $ info (ThunkCommand_Update <$> some thunkDirectoryParser <*> thunkUpdateConfig) $ progDesc "Update thunk to latest revision available"

235 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"

251 , command "unpack" $ info (ThunkCommand_Unpack <$> some thunkDirectoryParser) $ progDesc "Unpack thunk into git checkout of revision it points to"

236− , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> forceFlag) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

252+ , command "pack" $ info (ThunkCommand_Pack <$> some thunkDirectoryParser <*> thunkPackConfig) $ progDesc "Pack git checkout into thunk that points at the current branch's upstream"

237 ]

253 ]

238

254

239data ShellOpts

255data ShellOpts

@@ -374,17 +390,16 @@ ob = \case

374 DeployCommand_Update -> deployUpdate "."

390 DeployCommand_Update -> deployUpdate "."

375 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs

391 DeployCommand_Test (platform, extraArgs) -> deployMobile platform extraArgs

376 ObCommand_Run -> inNixShell' $ static run

392 ObCommand_Run -> inNixShell' $ static run

377− -- inNixShell ($(mkClosure 'ghcidAction) ())

378 ObCommand_Thunk tc -> case tc of

393 ObCommand_Thunk tc -> case tc of

379− ThunkCommand_Update thunks mBranch -> mapM_ ((flip updateThunkToLatest) mBranch) thunks

394+ ThunkCommand_Update thunks config -> for_ thunks (updateThunkToLatest config)

380− ThunkCommand_Unpack thunks -> mapM_ unpackThunk thunks

395+ ThunkCommand_Unpack thunks -> for_ thunks unpackThunk

381− ThunkCommand_Pack thunks force -> forM_ thunks (packThunk force)

396+ ThunkCommand_Pack thunks config -> for_ thunks (packThunk config)

382 ObCommand_Repl -> runRepl

397 ObCommand_Repl -> runRepl

383 ObCommand_Watch -> inNixShell' $ static runWatch

398 ObCommand_Watch -> inNixShell' $ static runWatch

384 ObCommand_Shell so -> withProjectRoot "." $ \root ->

399 ObCommand_Shell so -> withProjectRoot "." $ \root ->

385 projectShell root False (_shellOpts_shell so) (_shellOpts_command so)

400 projectShell root False (_shellOpts_shell so) (_shellOpts_command so)

386− ObCommand_Doc shell pkgs -> withProjectRoot "." $ \root ->

401+ ObCommand_Doc shell' pkgs -> withProjectRoot "." $ \root ->

387− projectShell root False shell (Just $ haddockCommand pkgs)

402+ projectShell root False shell' (Just $ haddockCommand pkgs)

388 ObCommand_Internal icmd -> case icmd of

403 ObCommand_Internal icmd -> case icmd of

389 ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case

404 ObInternal_RunStaticIO k -> liftIO (unsafeLookupStaticPtr @(ObeliskT IO ()) k) >>= \case

390 Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)

405 Nothing -> failWith $ "ObInternal_RunStaticIO: no such StaticKey: " <> T.pack (show k)

lib/command/src/Obelisk/Command/Deploy.hs+12−12

@@ -25,22 +25,23 @@ import Nix.Pretty

25import Nix.String (principledMakeNixStringWithoutContext)

26import Nix.Value

27import System.Directory

28−import System.Environment (getEnvironment)

29import System.FilePath

28import System.FilePath

30import System.IO

29import System.IO

31import System.Posix.Files

30import System.Posix.Files

32−import System.Process (delegate_ctlc, env, proc, cwd)

33import Text.URI (URI)

31import Text.URI (URI)

34import qualified Text.URI as URI

32import qualified Text.URI as URI

35import Text.URI.Lens

33import Text.URI.Lens

37import Obelisk.App (MonadObelisk)

35import Obelisk.App (MonadObelisk)

36+import Obelisk.CliApp (

38−import Obelisk.CliApp (Severity (..), callProcessAndLogOutput, failWith, putLog, withSpinner)

37+ Severity (..), callProcessAndLogOutput, failWith, proc, putLog,

38+ setCwd, setDelegateCtlc, setEnvOverride, withSpinner)

39import Obelisk.Command.Nix

40import Obelisk.Command.Project

41import Obelisk.Command.Thunk

42import Obelisk.Command.Utils

44+

44deployInit

45deployInit

45 :: MonadObelisk m

46 :: MonadObelisk m

46 => ThunkPtr

47 => ThunkPtr

@@ -57,7 +58,7 @@ deployInit thunkPtr deployDir sshKeyPath hostnames route adminEmail enableHttps

57 False -> failWith $ T.pack $ "ob deploy init: file does not exist: " <> sshKeyPath

58 False -> failWith $ T.pack $ "ob deploy init: file does not exist: " <> sshKeyPath

58 True -> pure $ deployDir </> "ssh_key"

59 True -> pure $ deployDir </> "ssh_key"

59 callProcessAndLogOutput (Notice, Error) $

60 callProcessAndLogOutput (Notice, Error) $

60− proc "cp" [sshKeyPath, localKey]

61+ proc cp [sshKeyPath, localKey]

61 liftIO $ setFileMode localKey $ ownerReadMode .|. ownerWriteMode

62 liftIO $ setFileMode localKey $ ownerReadMode .|. ownerWriteMode

62 return localKey

63 return localKey

63 withSpinner "Validating configuration" $ do

64 withSpinner "Validating configuration" $ do

@@ -82,7 +83,7 @@ deployInit thunkPtr deployDir sshKeyPath hostnames route adminEmail enableHttps

82 writeDeployConfig deployDir "backend_hosts" $ unlines hostnames

83 writeDeployConfig deployDir "backend_hosts" $ unlines hostnames

83 writeDeployConfig deployDir "enable_https" $ show enableHttps

84 writeDeployConfig deployDir "enable_https" $ show enableHttps

84 writeDeployConfig deployDir "admin_email" adminEmail

85 writeDeployConfig deployDir "admin_email" adminEmail

85− writeDeployConfig deployDir ("config" </> "common" </> "route") $ route

86+ writeDeployConfig deployDir ("config" </> "common" </> "route") route

86 withSpinner "Creating source thunk (./src)" $ liftIO $ do

87 withSpinner "Creating source thunk (./src)" $ liftIO $ do

87 createThunk (deployDir </> "src") thunkPtr

88 createThunk (deployDir </> "src") thunkPtr

88 setupObeliskImpl deployDir

89 setupObeliskImpl deployDir

@@ -107,7 +108,7 @@ deployPush deployPath getNixBuilders = do

107 Right (ThunkData_Packed ptr) -> return ptr

108 Right (ThunkData_Packed ptr) -> return ptr

108 Right (ThunkData_Checkout _) -> do

109 Right (ThunkData_Checkout _) -> do

109 checkGitCleanStatus srcPath True >>= \case

110 checkGitCleanStatus srcPath True >>= \case

110− True -> packThunk False srcPath

111+ True -> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath

111 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."

112 False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."

112 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)

113 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)

113 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr

114 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr

@@ -157,7 +158,7 @@ deployPush deployPath getNixBuilders = do

157 ]

158 ]

158 isClean <- checkGitCleanStatus deployPath True

159 isClean <- checkGitCleanStatus deployPath True

159 when (not isClean) $ do

160 when (not isClean) $ do

160− withSpinner "Commiting changes to Git" $ do

161+ withSpinner "Committing changes to Git" $ do

161 callProcessAndLogOutput (Debug, Error) $ proc "git"

162 callProcessAndLogOutput (Debug, Error) $ proc "git"

162 ["-C", deployPath, "add", "."]

163 ["-C", deployPath, "add", "."]

163 callProcessAndLogOutput (Debug, Error) $ proc "git"

164 callProcessAndLogOutput (Debug, Error) $ proc "git"

@@ -165,12 +166,11 @@ deployPush deployPath getNixBuilders = do

165 putLog Notice $ "Deployed => " <> T.pack route

166 putLog Notice $ "Deployed => " <> T.pack route

166 where

167 where

167 callProcess' envMap cmd args = do

168 callProcess' envMap cmd args = do

168− processEnv <- Map.toList . (envMap <>) . Map.fromList <$> liftIO getEnvironment

169+ let p = setEnvOverride (envMap <>) $ setDelegateCtlc True $ proc cmd args

169− let p = (proc cmd args) { delegate_ctlc = True, env = Just processEnv }

170 callProcessAndLogOutput (Notice, Notice) p

171

172deployUpdate :: MonadObelisk m => FilePath -> m ()

173−deployUpdate deployPath = updateThunkToLatest (deployPath </> "src") Nothing

173+deployUpdate deployPath = updateThunkToLatest (ThunkUpdateConfig Nothing (ThunkConfig Nothing)) (deployPath </> "src")

174

175keytoolToAndroidConfig :: KeytoolConfig -> HM.HashMap Text (NValue t Identity m)

176keytoolToAndroidConfig conf =

@@ -219,7 +219,7 @@ deployMobile platform mobileArgs = withProjectRoot "." $ \root -> do

219 , _keytoolConfig_storepass = keyStorePassword

220 , _keytoolConfig_keypass = keyStorePassword

221 }

222− createKeystore root $ keyToolConf

222+ createKeystore root keyToolConf

223 liftIO $ BSL.writeFile keytoolConfPath $ encode keyToolConf

224 checkKeytoolConfExist <- liftIO $ doesFileExist keytoolConfPath

225 unless checkKeytoolConfExist $ failWith "Missing android KeytoolConfig"

@@ -275,7 +275,7 @@ instance ToJSON KeytoolConfig

275createKeystore :: MonadObelisk m => FilePath -> KeytoolConfig -> m ()

276createKeystore root config = do

277 let expr = "with (import " <> toImplDir root <> ").reflex-platform.nixpkgs; pkgs.mkShell { buildInputs = [ pkgs.jdk ]; }"

278− callProcessAndLogOutput (Notice,Notice) $ (proc "nix-shell" ["default.nix", "-E" , expr, "--run" , keytoolCmd]) { cwd = Just root }

278+ callProcessAndLogOutput (Notice,Notice) $ setCwd (Just root) $ proc "nix-shell" ["default.nix", "-E" , expr, "--run" , keytoolCmd]

279 where

280 keytoolCmd = processToShellString "keytool"

281 [ "-genkeypair", "-noprompt"

lib/command/src/Obelisk/Command/Nix.hs+1−2

@@ -37,7 +37,6 @@ import Data.List (intercalate)

37import Data.Maybe

38import Data.Monoid ((<>))

39import qualified Data.Text as T

40−import System.Process (proc)

42import Obelisk.App (MonadObelisk)

41import Obelisk.App (MonadObelisk)

43import Obelisk.CliApp

42import Obelisk.CliApp

@@ -160,7 +159,7 @@ instance Default NixCmd where

160

159

161nixCmd :: MonadObelisk m => NixCmd -> m FilePath

160nixCmd :: MonadObelisk m => NixCmd -> m FilePath

162nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built " <> desc) $ do

161nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built " <> desc) $ do

163− output <- readProcessAndLogStderr Debug $ proc (T.unpack cmd) $ options

162+ output <- readProcessAndLogStderr Debug $ proc (T.unpack cmd) options

164 -- Remove final newline that Nix appends

163 -- Remove final newline that Nix appends

165 Just (outPath, '\n') <- pure $ T.unsnoc output

164 Just (outPath, '\n') <- pure $ T.unsnoc output

166 pure $ T.unpack outPath

165 pure $ T.unpack outPath

lib/command/src/Obelisk/Command/Project.hs+5−10

@@ -30,7 +30,7 @@ import System.IO.Temp

30import System.IO.Unsafe (unsafePerformIO)

31import System.Posix (FileStatus, FileMode, CMode (..), UserID, deviceID, fileID, fileMode, fileOwner, getFileStatus, getRealUserID)

32import System.Posix.Files

33−import System.Process (CreateProcess, cwd, proc, waitForProcess, delegate_ctlc)

33+import System.Process (waitForProcess)

34import System.Which (staticWhich)

36import GitHub.Data.GitData (Branch)

@@ -53,6 +53,7 @@ obeliskSourceWithBranch branch = ThunkSource_GitHub $ GitHubSource

53 { _gitHubSource_owner = "obsidiansystems"

54 , _gitHubSource_repo = "obelisk"

55 , _gitHubSource_branch = Just branch

56+ , _gitHubSource_private = False

56 }

57 }

58data InitSource

59data InitSource

@@ -168,7 +169,7 @@ findProjectRoot :: MonadObelisk m => FilePath -> m (Maybe FilePath)

168findProjectRoot target = do

169findProjectRoot target = do

169 myUid <- liftIO getRealUserID

170 myUid <- liftIO getRealUserID

170 targetStat <- liftIO $ getFileStatus target

171 targetStat <- liftIO $ getFileStatus target

171− umask <- liftIO $ getUmask

172+ umask <- liftIO getUmask

172 (result, _) <- liftIO $ runStateT (walkToProjectRoot target targetStat umask myUid) []

173 (result, _) <- liftIO $ runStateT (walkToProjectRoot target targetStat umask myUid) []

173 return result

174 return result

174

175

@@ -245,9 +246,9 @@ inImpureProjectShell shellName command = withProjectRoot "." $ \root ->

245projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

246projectShell :: MonadObelisk m => FilePath -> Bool -> String -> Maybe String -> m ()

246projectShell root isPure shellName command = do

247projectShell root isPure shellName command = do

247 let nixPath = $(staticWhich "nix")

248 let nixPath = $(staticWhich "nix")

248− nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ proc nixPath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]

249+ nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $ proc nixPath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]

249 nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"

250 nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"

250− (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setCtlc $ setCwd (Just root) $ proc "nix-shell" $

251+ (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setDelegateCtlc True $ setCwd (Just root) $ proc "nix-shell" $

251 [ "default.nix"] <>

252 [ "default.nix"] <>

252 ["--pure" | isPure] <>

253 ["--pure" | isPure] <>

253 [ "-A"

254 [ "-A"

@@ -262,9 +263,3 @@ projectShell root isPure shellName command = do

262 c

263 c

263 ]

264 ]

264 void $ liftIO $ waitForProcess ph

265 void $ liftIO $ waitForProcess ph

265−

266−setCtlc :: CreateProcess -> CreateProcess

267−setCtlc cfg = cfg { delegate_ctlc = True }

268−

269−setCwd :: Maybe FilePath -> CreateProcess -> CreateProcess

270−setCwd fp cfg = cfg { cwd = fp }

lib/command/src/Obelisk/Command/Run.hs+72−66

@@ -4,13 +4,17 @@

4{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE TemplateHaskell #-}

7+{-# LANGUAGE TupleSections #-}

7module Obelisk.Command.Run where

8module Obelisk.Command.Run where

10+import Control.Applicative (liftA2)

9−import Control.Exception (bracket)

11+import Control.Exception (Exception, bracket)

10import Control.Monad

12import Control.Monad

13+import Control.Monad.Except (runExceptT, throwError)

11import Control.Monad.IO.Class (liftIO)

14import Control.Monad.IO.Class (liftIO)

12import Control.Monad.Reader (MonadIO)

15import Control.Monad.Reader (MonadIO)

13import Data.Either

16import Data.Either

17+import Data.Foldable (for_)

14import qualified Data.List as L

18import qualified Data.List as L

15import qualified Data.List.NonEmpty as NE

19import qualified Data.List.NonEmpty as NE

16import Data.Maybe

20import Data.Maybe

@@ -24,23 +28,18 @@ import Distribution.Types.CondTree

24import Distribution.Types.GenericPackageDescription

28import Distribution.Types.GenericPackageDescription

25import Distribution.Types.Library

29import Distribution.Types.Library

26import Distribution.Utils.Generic

30import Distribution.Utils.Generic

27−import Hpack.Config

31+import qualified Hpack.Config as Hpack

28−import Hpack.Render

32+import qualified Hpack.Render as Hpack

29−import Hpack.Yaml

33+import qualified Hpack.Yaml as Hpack

30import Language.Haskell.Extension

34import Language.Haskell.Extension

31import Network.Socket hiding (Debug)

35import Network.Socket hiding (Debug)

32import System.Directory

36import System.Directory

33import System.FilePath

37import System.FilePath

34−import System.Process (proc)

35import System.IO.Temp (withSystemTempDirectory)

38import System.IO.Temp (withSystemTempDirectory)

36import System.Which (staticWhich)

39import System.Which (staticWhich)

37−import Data.ByteString (ByteString)

39import Obelisk.App (MonadObelisk, ObeliskT)

41import Obelisk.App (MonadObelisk, ObeliskT)

40−import Obelisk.CliApp

41− ( CliT (..), HasCliConfig, Severity (..)

42− , callCommand, failWith, getCliConfig, putLog

42+import Obelisk.CliApp (Severity (..) , callCommand, failWith, putLog, proc, readProcessAndLogStderr)

43− , readProcessAndLogStderr, runCli)

44import Obelisk.Command.Project (inProjectShell, withProjectRoot)

43import Obelisk.Command.Project (inProjectShell, withProjectRoot)

46data CabalPackageInfo = CabalPackageInfo

45data CabalPackageInfo = CabalPackageInfo

@@ -106,6 +105,27 @@ runWatch = do

106 pkgs <- getLocalPkgs

105 pkgs <- getLocalPkgs

107 withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath Nothing

106 withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath Nothing

108

107

108+data GuessPackageFileError = GuessPackageFileError_Ambiguous [FilePath] | GuessPackageFileError_NotFound

109+ deriving (Eq, Ord, Show)

110+instance Exception GuessPackageFileError

111+

112+-- | Given a directory, try to guess what the appropriate @.cabal@ or @package.yaml@ file is for the package.

113+guessCabalPackageFile

114+ :: MonadIO m

115+ => FilePath -- ^ Directory to search for cabal package

116+ -> m (Either GuessPackageFileError (Either FilePath FilePath))

117+ -- ^ 'Right' 'Left' for hpack package, 'Right' 'Right' for cabal package; 'FilePath' is relative to given directory.

118+guessCabalPackageFile dir = do

119+ candidates <- liftIO $

120+ filterM (doesFileExist . (dir </>))

121+ =<< filter (liftA2 (||) (== Hpack.packageConfig) (".cabal" `L.isSuffixOf`))

122+ <$> listDirectory dir

123+ pure $ case L.partition (== Hpack.packageConfig) candidates of

124+ ([hpack], _) -> Right $ Left hpack

125+ ([], [cabal]) -> Right $ Right cabal

126+ ([], []) -> Left GuessPackageFileError_NotFound

127+ (hpacks, cabals) -> Left $ GuessPackageFileError_Ambiguous $ hpacks <> cabals

128+

109-- | Relative paths to local packages of an obelisk project

129-- | Relative paths to local packages of an obelisk project

110-- TODO a way to query this

130-- TODO a way to query this

111getLocalPkgs :: Applicative f => f [FilePath]

131getLocalPkgs :: Applicative f => f [FilePath]

@@ -115,67 +135,53 @@ parseCabalPackage

115 :: (MonadObelisk m)

135 :: (MonadObelisk m)

116 => FilePath -- ^ package directory

136 => FilePath -- ^ package directory

117 -> m (Maybe CabalPackageInfo)

137 -> m (Maybe CabalPackageInfo)

118−parseCabalPackage dir = do

138+parseCabalPackage dir = either ((Nothing <$) . putLog Error) (pure . Just) <=< runExceptT $ do

119− let cabalFp = dir </> (takeBaseName dir <> ".cabal")

139+ (cabalContents, packageFile) <- guessCabalPackageFile dir >>= \case

120− hpackFp = dir </> "package.yaml"

140+ Left GuessPackageFileError_NotFound -> throwError $ "No .cabal or package.yaml file found in " <> T.pack dir

121− hasCabal <- liftIO $ doesFileExist cabalFp

141+ Left (GuessPackageFileError_Ambiguous _) -> throwError $ "Unable to determine which .cabal file to use in " <> T.pack dir

122− hasHpack <- liftIO $ doesFileExist hpackFp

142+ Right (Right cabalFileName) -> let file = dir </> cabalFileName in (, file) <$> liftIO (readUTF8File file)

123−

143+ Right (Left hpackFileName) -> do

124− mCabalContents <- if hasCabal

144+ let

125− then Just <$> liftIO (readUTF8File cabalFp)

145+ file = dir </> hpackFileName

126− else if hasHpack

127− then do

128− let decodeOptions = DecodeOptions (ProgramName "ob") hpackFp Nothing decodeYaml

146+ decodeOptions = Hpack.DecodeOptions (Hpack.ProgramName "ob") file Nothing Hpack.decodeYaml

129− liftIO (readPackageConfig decodeOptions) >>= \case

147+ liftIO (Hpack.readPackageConfig decodeOptions) >>= \case

130− Left err -> do

131− putLog Error $ T.pack $ "Failed to parse " <> hpackFp <> ": " <> err

148+ Left err -> throwError $ T.pack $ "Failed to parse " <> file <> ": " <> err

132− return Nothing

133− Right (DecodeResult hpackPackage _ _ _) -> do

149+ Right (Hpack.DecodeResult hpackPackage _ _ _) -> pure (Hpack.renderPackage [] hpackPackage, file)

134− return $ Just $ renderPackage [] hpackPackage

135− else return Nothing

136−

137− fmap join $ forM mCabalContents $ \cabalContents -> do

138− let (warnings, result) = runParseResult $ parseGenericPackageDescription $

139− toUTF8BS $ cabalContents

140− mapM_ (putLog Warning) $ fmap (T.pack . show) warnings

141− case result of

142− Right gpkg -> do

143− return $ do

144− (_, lib) <- simplifyCondTree (const $ pure True) <$> condLibrary gpkg

145− pure $ CabalPackageInfo

146− { _cabalPackageInfo_packageRoot = takeDirectory cabalFp

147− , _cabalPackageInfo_sourceDirs =

148− fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib

149− , _cabalPackageInfo_defaultExtensions =

150− defaultExtensions $ libBuildInfo lib

151− , _cabalPackageInfo_defaultLanguage =

152− defaultLanguage $ libBuildInfo lib

153− , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib

154− }

155− Left (_, errors) -> do

156− putLog Error $ T.pack $ "Failed to parse " <> cabalFp <> ":"

157− mapM_ (putLog Error) $ fmap (T.pack . show) errors

158− return Nothing

159

150

160−withUTF8FileContentsM :: (MonadIO m, HasCliConfig e m) => FilePath -> (ByteString -> CliT e IO a) -> m a

151+ let (warnings, result) = runParseResult $ parseGenericPackageDescription $

161−withUTF8FileContentsM fp f = do

152+ toUTF8BS cabalContents

162− c <- getCliConfig

153+ for_ warnings $ putLog Warning . T.pack . show

163− liftIO $ withUTF8FileContents fp $ runCli c . f . toUTF8BS

154+ case condLibrary <$> result of

155+ Right (Just condLib) -> do

156+ let (_, lib) = simplifyCondTree (const $ pure True) condLib

157+ pure $ CabalPackageInfo

158+ { _cabalPackageInfo_packageRoot = dir

159+ , _cabalPackageInfo_sourceDirs =

160+ fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib

161+ , _cabalPackageInfo_defaultExtensions =

162+ defaultExtensions $ libBuildInfo lib

163+ , _cabalPackageInfo_defaultLanguage =

164+ defaultLanguage $ libBuildInfo lib

165+ , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib

166+ }

167+ Right Nothing -> throwError "Haskell package has no library component"

168+ Left (_, errors) ->

169+ throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)

164

170

165-- | Create ghci configuration to load the given packages

171-- | Create ghci configuration to load the given packages

166withGhciScript

172withGhciScript

167 :: MonadObelisk m

173 :: MonadObelisk m

168 => [FilePath] -- ^ List of packages to load into ghci

174 => [FilePath] -- ^ List of packages to load into ghci

169− -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporory .ghci

175+ -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci

170 -> m ()

176 -> m ()

171−withGhciScript pkgs f = do

177+withGhciScript dirs f = do

172− (pkgDirErrs, packageInfos) <- fmap partitionEithers $ forM pkgs $ \pkg -> do

178+ (pkgDirErrs, packageInfos) <- fmap partitionEithers $ forM dirs $ \dir -> do

173− flip fmap (parseCabalPackage pkg) $ \case

179+ flip fmap (parseCabalPackage dir) $ \case

174− Nothing -> Left pkg

180+ Nothing -> Left dir

175 Just packageInfo -> Right packageInfo

181 Just packageInfo -> Right packageInfo

176

182

177 when (null packageInfos) $

183 when (null packageInfos) $

178− failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " pkgs

184+ failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " dirs

179 unless (null pkgDirErrs) $

185 unless (null pkgDirErrs) $

180 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs

186 putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs

181

187

@@ -185,16 +191,16 @@ withGhciScript pkgs f = do

185 language = NE.toList $ fromMaybe (Haskell98 NE.:| []) $ NE.nonEmpty languageFromPkgs

191 language = NE.toList $ fromMaybe (Haskell98 NE.:| []) $ NE.nonEmpty languageFromPkgs

186 extensionsLine = if extensions == mempty

192 extensionsLine = if extensions == mempty

187 then ""

193 then ""

188− else ":set " <> intercalate " " ((("-X" <>) . prettyShow) <$> extensions)

194+ else ":set " <> unwords (("-X" <>) . prettyShow <$> extensions)

189 ghcOptions = concat $ mapMaybe (\case (GHC, xs) -> Just xs; _ -> Nothing) $

195 ghcOptions = concat $ mapMaybe (\case (GHC, xs) -> Just xs; _ -> Nothing) $

190 packageInfos >>= _cabalPackageInfo_compilerOptions

196 packageInfos >>= _cabalPackageInfo_compilerOptions

191− dotGhci = unlines $

197+ dotGhci = unlines

192 [ ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)

198 [ ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)

193 , case ghcOptions of

199 , case ghcOptions of

194 [] -> ""

200 [] -> ""

195− xs -> ":set " <> intercalate " " xs

201+ xs -> ":set " <> unwords xs

196 , extensionsLine

202 , extensionsLine

197− , ":set " <> intercalate " " (("-X" <>) . prettyShow <$> language)

203+ , ":set " <> unwords (("-X" <>) . prettyShow <$> language)

198 , ":load Backend Frontend"

204 , ":load Backend Frontend"

199 , "import Obelisk.Run"

205 , "import Obelisk.Run"

200 , "import qualified Frontend"

206 , "import qualified Frontend"

@@ -254,4 +260,4 @@ getFreePort = liftIO $ withSocketsDo $ do

254 open addr = do

260 open addr = do

255 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

261 sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

256 bind sock (addrAddress addr)

262 bind sock (addrAddress addr)

257− return sock

263+ return sock

lib/command/src/Obelisk/Command/Thunk.hs+180−102

@@ -8,25 +8,30 @@

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TypeApplications #-}

10module Obelisk.Command.Thunk

11+ ( GitHubSource (..)

12+ , GitUri (..)

13+ , ReadThunkError (..)

14+ , ThunkConfig (..)

15+ , ThunkData (..)

16+ , ThunkPackConfig (..)

11− ( ThunkPtr (..)

17+ , ThunkPtr (..)

12 , ThunkRev (..)

18 , ThunkRev (..)

13 , ThunkSource (..)

19 , ThunkSource (..)

14− , ThunkData (..)

20+ , ThunkUpdateConfig (..)

15− , ReadThunkError (..)

16− , GitHubSource (..)

17− , getThunkGitBranch

18− , getLatestRev

19− , updateThunkToLatest

20 , createThunk

21 , createThunk

21 , createThunkWithLatest

22 , createThunkWithLatest

23+ , getLatestRev

24+ , getThunkGitBranch

25+ , getThunkPtr

26+ , gitUriToText

22 , nixBuildAttrWithCache

27 , nixBuildAttrWithCache

23 , nixBuildThunkAttrWithCache

28 , nixBuildThunkAttrWithCache

24− , unpackThunk

25 , packThunk

29 , packThunk

30+ , parseGitUri

26 , readThunk

31 , readThunk

32+ , unpackThunk

27 , updateThunk

33 , updateThunk

28− , getThunkPtr

34+ , updateThunkToLatest

29− , parseGitUri

30 , uriThunkPtr

35 , uriThunkPtr

31 ) where

36 ) where

@@ -68,8 +73,7 @@ import System.FilePath

68import System.IO.Error

73import System.IO.Error

69import System.IO.Temp

74import System.IO.Temp

70import System.Posix (getSymbolicLinkStatus, modificationTime)

75import System.Posix (getSymbolicLinkStatus, modificationTime)

71−import System.Process (proc)

76+import qualified Text.URI as URI

72−import Text.URI

74import Obelisk.App (MonadObelisk)

78import Obelisk.App (MonadObelisk)

75import Obelisk.CliApp

79import Obelisk.CliApp

@@ -111,37 +115,63 @@ data GitHubSource = GitHubSource

111 { _gitHubSource_owner :: Name Owner

115 { _gitHubSource_owner :: Name Owner

112 , _gitHubSource_repo :: Name Repo

116 , _gitHubSource_repo :: Name Repo

113 , _gitHubSource_branch :: Maybe (Name Branch)

117 , _gitHubSource_branch :: Maybe (Name Branch)

118+ , _gitHubSource_private :: Bool

114 }

119 }

115 deriving (Show, Eq, Ord)

120 deriving (Show, Eq, Ord)

116

121

122+newtype GitUri = GitUri URI.URI deriving (Eq, Ord, Show)

123+

124+gitUriToText :: GitUri -> Text

125+gitUriToText (GitUri uri)

126+ | (T.toLower . URI.unRText <$> URI.uriScheme uri) == Just "file"

127+ , Just (_, path) <- URI.uriPath uri

128+ = "/" <> T.intercalate "/" (map URI.unRText $ NonEmpty.toList path)

129+ | otherwise = URI.render uri

130+

117data GitSource = GitSource

131data GitSource = GitSource

118− { _gitSource_url :: URI

132+ { _gitSource_url :: GitUri

119 , _gitSource_branch :: Maybe (Name Branch)

133 , _gitSource_branch :: Maybe (Name Branch)

120 , _gitSource_fetchSubmodules :: Bool

134 , _gitSource_fetchSubmodules :: Bool

135+ , _gitSource_private :: Bool

121 }

136 }

122 deriving (Show, Eq, Ord)

137 deriving (Show, Eq, Ord)

123

138

139+newtype ThunkConfig = ThunkConfig

140+ { _thunkConfig_private :: Maybe Bool

141+ } deriving Show

142+

143+data ThunkUpdateConfig = ThunkUpdateConfig

144+ { _thunkUpdateConfig_branch :: Maybe String

145+ , _thunkUpdateConfig_config :: ThunkConfig

146+ } deriving Show

147+

148+data ThunkPackConfig = ThunkPackConfig

149+ { _thunkPackConfig_force :: Bool

150+ , _thunkPackConfig_config :: ThunkConfig

151+ } deriving Show

152+

124-- | Convert a GitHub source to a regular Git source. Assumes no submodules.

153-- | Convert a GitHub source to a regular Git source. Assumes no submodules.

125forgetGithub :: Bool -> GitHubSource -> GitSource

154forgetGithub :: Bool -> GitHubSource -> GitSource

126forgetGithub useSsh s = GitSource

155forgetGithub useSsh s = GitSource

127− { _gitSource_url = URI

156+ { _gitSource_url = GitUri $ URI.URI

128− { uriScheme = Just $ fromRight' $ mkScheme $ if useSsh then "ssh" else "https"

157+ { URI.uriScheme = Just $ fromRight' $ URI.mkScheme $ if useSsh then "ssh" else "https"

129− , uriAuthority = Right $ Authority

158+ , URI.uriAuthority = Right $ URI.Authority

130− { authUserInfo = UserInfo (fromRight' $ mkUsername "git") Nothing

159+ { URI.authUserInfo = URI.UserInfo (fromRight' $ URI.mkUsername "git") Nothing

131 <$ guard useSsh

160 <$ guard useSsh

132− , authHost = fromRight' $ mkHost "github.com"

161+ , URI.authHost = fromRight' $ URI.mkHost "github.com"

133− , authPort = Nothing

162+ , URI.authPort = Nothing

134 }

163 }

135− , uriPath = Just ( False

164+ , URI.uriPath = Just ( False

136− , fromRight' . mkPathPiece <$>

165+ , fromRight' . URI.mkPathPiece <$>

137 untagName (_gitHubSource_owner s)

166 untagName (_gitHubSource_owner s)

138 :| [ untagName (_gitHubSource_repo s) <> ".git" ]

167 :| [ untagName (_gitHubSource_repo s) <> ".git" ]

139 )

168 )

140− , uriQuery = []

169+ , URI.uriQuery = []

141− , uriFragment = Nothing

170+ , URI.uriFragment = Nothing

142 }

171 }

143 , _gitSource_branch = _gitHubSource_branch s

172 , _gitSource_branch = _gitHubSource_branch s

144 , _gitSource_fetchSubmodules = False

173 , _gitSource_fetchSubmodules = False

174+ , _gitSource_private = _gitHubSource_private s

145 }

175 }

146

176

147getThunkGitBranch :: ThunkPtr -> Maybe Text

177getThunkGitBranch :: ThunkPtr -> Maybe Text

@@ -155,20 +185,20 @@ commitNameToRef (N c) = Ref.fromHex $ encodeUtf8 c

155-- TODO: Use spinner here.

185-- TODO: Use spinner here.

156getNixSha256ForUriUnpacked

186getNixSha256ForUriUnpacked

157 :: MonadObelisk m

187 :: MonadObelisk m

158− => URI

188+ => GitUri

159 -> m NixSha256

189 -> m NixSha256

160getNixSha256ForUriUnpacked uri =

190getNixSha256ForUriUnpacked uri =

161− withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> render uri) $ do

191+ withExitFailMessage ("nix-prefetch-url: Failed to determine sha256 hash of URL " <> gitUriToText uri) $ do

162 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

192 [hash] <- fmap T.lines $ readProcessAndLogOutput (Debug, Debug) $

163− proc "nix-prefetch-url" ["--unpack" , "--type" , "sha256" , T.unpack $ render uri]

193+ proc "nix-prefetch-url" ["--unpack", "--type", "sha256", T.unpack $ gitUriToText uri]

164 pure hash

194 pure hash

165

195

166−nixPrefetchGit :: MonadObelisk m => URI -> Text -> Bool -> m NixSha256

196+nixPrefetchGit :: MonadObelisk m => GitUri -> Text -> Bool -> m NixSha256

167nixPrefetchGit uri rev fetchSubmodules =

197nixPrefetchGit uri rev fetchSubmodules =

168− withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> render uri <> " at " <> rev) $ do

198+ withExitFailMessage ("nix-prefetch-git: Failed to determine sha256 hash of Git repo " <> gitUriToText uri <> " at " <> rev) $ do

169 out <- readProcessAndLogStderr Debug $

199 out <- readProcessAndLogStderr Debug $

170 proc "nix-prefetch-git" $ filter (/="")

200 proc "nix-prefetch-git" $ filter (/="")

171− [ "--url", T.unpack $ render uri

201+ [ "--url", T.unpack $ gitUriToText uri

172 , "--rev", T.unpack rev

202 , "--rev", T.unpack rev

173 , if fetchSubmodules then "--fetch-submodules" else ""

203 , if fetchSubmodules then "--fetch-submodules" else ""

174 , "--quiet"

204 , "--quiet"

@@ -286,10 +316,12 @@ parseGitHubSource v = do

286 owner <- v Aeson..: "owner"

316 owner <- v Aeson..: "owner"

287 repo <- v Aeson..: "repo"

317 repo <- v Aeson..: "repo"

288 branch <- v Aeson..:! "branch"

318 branch <- v Aeson..:! "branch"

319+ private <- v Aeson..:? "private"

289 pure $ GitHubSource

320 pure $ GitHubSource

290 { _gitHubSource_owner = owner

321 { _gitHubSource_owner = owner

291 , _gitHubSource_repo = repo

322 , _gitHubSource_repo = repo

292 , _gitHubSource_branch = branch

323 , _gitHubSource_branch = branch

324+ , _gitHubSource_private = fromMaybe False private

293 }

325 }

294

326

295parseGitSource :: Aeson.Object -> Aeson.Parser GitSource

327parseGitSource :: Aeson.Object -> Aeson.Parser GitSource

@@ -297,10 +329,12 @@ parseGitSource v = do

297 Just url <- parseGitUri <$> v Aeson..: "url"

329 Just url <- parseGitUri <$> v Aeson..: "url"

298 branch <- v Aeson..:! "branch"

330 branch <- v Aeson..:! "branch"

299 fetchSubmodules <- v Aeson..:! "fetchSubmodules"

331 fetchSubmodules <- v Aeson..:! "fetchSubmodules"

332+ private <- v Aeson..:? "private"

300 pure $ GitSource

333 pure $ GitSource

301 { _gitSource_url = url

334 { _gitSource_url = url

302 , _gitSource_branch = branch

335 , _gitSource_branch = branch

303 , _gitSource_fetchSubmodules = fromMaybe False fetchSubmodules

336 , _gitSource_fetchSubmodules = fromMaybe False fetchSubmodules

337+ , _gitSource_private = fromMaybe False private

304 }

338 }

305

339

306overwriteThunk :: MonadObelisk m => FilePath -> ThunkPtr -> m ()

340overwriteThunk :: MonadObelisk m => FilePath -> ThunkPtr -> m ()

@@ -327,13 +361,15 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

327 , ("branch" .=) <$> _gitHubSource_branch s

361 , ("branch" .=) <$> _gitHubSource_branch s

328 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)

362 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)

329 , Just $ "sha256" .= _thunkRev_nixSha256 rev

363 , Just $ "sha256" .= _thunkRev_nixSha256 rev

364+ , Just $ "private" .= _gitHubSource_private s

330 ]

365 ]

331 ThunkSource_Git s -> encodePretty' plainGitCfg $ Aeson.object $ catMaybes

366 ThunkSource_Git s -> encodePretty' plainGitCfg $ Aeson.object $ catMaybes

332− [ Just $ "url" .= render (_gitSource_url s)

367+ [ Just $ "url" .= gitUriToText (_gitSource_url s)

333 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)

368 , Just $ "rev" .= Ref.toHexString (_thunkRev_commit rev)

334 , ("branch" .=) <$> _gitSource_branch s

369 , ("branch" .=) <$> _gitSource_branch s

335 , Just $ "sha256" .= _thunkRev_nixSha256 rev

370 , Just $ "sha256" .= _thunkRev_nixSha256 rev

336 , Just $ "fetchSubmodules" .= _gitSource_fetchSubmodules s

371 , Just $ "fetchSubmodules" .= _gitSource_fetchSubmodules s

372+ , Just $ "private" .= _gitSource_private s

337 ]

373 ]

338 where

374 where

339 githubCfg = defConfig

375 githubCfg = defConfig

@@ -354,6 +390,7 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of

354 [ "url"

390 [ "url"

355 , "rev"

391 , "rev"

356 , "sha256"

392 , "sha256"

393+ , "private"

357 , "fetchSubmodules"

394 , "fetchSubmodules"

358 ] <> compare

395 ] <> compare

359 , confTrailingNewline = True

396 , confTrailingNewline = True

@@ -377,8 +414,8 @@ createThunkWithLatest target s = do

377 , _thunkPtr_rev = rev

414 , _thunkPtr_rev = rev

378 }

415 }

379

416

380−updateThunkToLatest :: MonadObelisk m => FilePath -> Maybe String -> m ()

417+updateThunkToLatest :: MonadObelisk m => ThunkUpdateConfig -> FilePath -> m ()

381−updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do

418+updateThunkToLatest (ThunkUpdateConfig mBranch thunkConfig) target = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do

382 checkThunkDirectory "ob thunk update directory cannot be '.'" target

419 checkThunkDirectory "ob thunk update directory cannot be '.'" target

383 -- check to see if thunk should be updated to a specific branch or just update it's current branch

420 -- check to see if thunk should be updated to a specific branch or just update it's current branch

384 case mBranch of

421 case mBranch of

@@ -390,7 +427,7 @@ updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack t

390 ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"

427 ThunkData_Checkout _ -> failWith "cannot update an unpacked thunk"

391 let src = _thunkPtr_source ptr

428 let src = _thunkPtr_source ptr

392 rev <- getLatestRev src

429 rev <- getLatestRev src

393− overwriteThunk overwrite $ ThunkPtr

430+ overwriteThunk overwrite $ modifyThunkPtrByConfig thunkConfig $ ThunkPtr

394 { _thunkPtr_source = src

431 { _thunkPtr_source = src

395 , _thunkPtr_rev = rev

432 , _thunkPtr_rev = rev

396 }

433 }

@@ -398,24 +435,25 @@ updateThunkToLatest target mBranch = withSpinner' ("Updating thunk " <> T.pack t

398 Left err -> failWith $ T.pack $ "thunk update: " <> show err

435 Left err -> failWith $ T.pack $ "thunk update: " <> show err

399 Right c -> case c of

436 Right c -> case c of

400 ThunkData_Packed t -> case _thunkPtr_source t of

437 ThunkData_Packed t -> case _thunkPtr_source t of

401− ThunkSource_Git tsg -> setThunk target tsg branch

438+ ThunkSource_Git tsg -> setThunk thunkConfig target tsg branch

402 ThunkSource_GitHub tsgh -> do

439 ThunkSource_GitHub tsgh -> do

403 let tsg = forgetGithub False tsgh

440 let tsg = forgetGithub False tsgh

404− setThunk target tsg branch

441+ setThunk thunkConfig target tsg branch

405− ThunkData_Checkout _ -> failWith $ T.pack $ "thunk located at " <> (show target) <> " is unpacked. Use ob thunk pack on the desired directory and then try ob thunk update again."

442+ ThunkData_Checkout _ -> failWith $ T.pack $ "thunk located at " <> show target <> " is unpacked. Use ob thunk pack on the desired directory and then try ob thunk update again."

406

443

407−setThunk :: MonadObelisk m => FilePath -> GitSource -> String -> m ()

444+setThunk :: MonadObelisk m => ThunkConfig -> FilePath -> GitSource -> String -> m ()

408−setThunk target gs branch = do

445+setThunk thunkConfig target gs branch = do

409 newThunkPtr <- uriThunkPtr (_gitSource_url gs) (Just $ T.pack branch) Nothing

446 newThunkPtr <- uriThunkPtr (_gitSource_url gs) (Just $ T.pack branch) Nothing

410 overwriteThunk target newThunkPtr

447 overwriteThunk target newThunkPtr

411− updateThunkToLatest target Nothing

448+ updateThunkToLatest (ThunkUpdateConfig Nothing thunkConfig) target

412

449

413-- | All recognized github standalone loaders, ordered from newest to oldest.

450-- | All recognized github standalone loaders, ordered from newest to oldest.

414-- This tool will only ever produce the newest one when it writes a thunk.

451-- This tool will only ever produce the newest one when it writes a thunk.

415gitHubStandaloneLoaders :: NonEmpty Text

452gitHubStandaloneLoaders :: NonEmpty Text

416gitHubStandaloneLoaders =

453gitHubStandaloneLoaders =

417− gitHubStandaloneLoaderV2 :|

454+ gitHubStandaloneLoaderV4 :|

418 [ gitHubStandaloneLoaderV3

455 [ gitHubStandaloneLoaderV3

456+ , gitHubStandaloneLoaderV2

419 , gitHubStandaloneLoaderV1

457 , gitHubStandaloneLoaderV1

420 ]

458 ]

421

459

@@ -455,10 +493,23 @@ gitHubStandaloneLoaderV3 = T.unlines

455 , "in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))"

493 , "in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))"

456 ]

494 ]

457

495

496+gitHubStandaloneLoaderV4 :: Text

497+gitHubStandaloneLoaderV4 = T.unlines

498+ [ "# DO NOT HAND-EDIT THIS FILE"

499+ , "let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:"

500+ , " if !fetchSubmodules && !private then builtins.fetchTarball {"

501+ , " url = \"https://github.com/${owner}/${repo}/archive/${rev}.tar.gz\"; inherit sha256;"

502+ , " } else (import <nixpkgs> {}).fetchFromGitHub {"

503+ , " inherit owner repo rev sha256 fetchSubmodules private;"

504+ , " };"

505+ , "in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))"

506+ ]

507+

458plainGitStandaloneLoaders :: NonEmpty Text

508plainGitStandaloneLoaders :: NonEmpty Text

459plainGitStandaloneLoaders =

509plainGitStandaloneLoaders =

460− plainGitStandaloneLoaderV1 :|

510+ plainGitStandaloneLoaderV3 :|

511+ [ plainGitStandaloneLoaderV1

461− [ plainGitStandaloneLoaderV2

512+ , plainGitStandaloneLoaderV2

462 ]

513 ]

463

514

464plainGitStandaloneLoaderV1 :: Text

515plainGitStandaloneLoaderV1 :: Text

@@ -479,6 +530,22 @@ plainGitStandaloneLoaderV2 = T.unlines

479 , "in import (fetchGit (builtins.fromJSON (builtins.readFile ./git.json)))"

530 , "in import (fetchGit (builtins.fromJSON (builtins.readFile ./git.json)))"

480 ]

531 ]

481

532

533+plainGitStandaloneLoaderV3 :: Text

534+plainGitStandaloneLoaderV3 = T.unlines

535+ [ "# DO NOT HAND-EDIT THIS FILE"

536+ , "let fetch = {url, rev, ref ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:"

537+ , " let realUrl = let firstChar = builtins.substring 0 1 url; in"

538+ , " if firstChar == \"/\" then /. + url"

539+ , " else if firstChar == \".\" then ./. + url"

540+ , " else url;"

541+ , " in if !fetchSubmodules && private then builtins.fetchGit {"

542+ , " url = realUrl; inherit rev;"

543+ , " } else (import <nixpkgs> {}).fetchgit {"

544+ , " url = realUrl; inherit rev sha256;"

545+ , " };"

546+ , "in import (fetch (builtins.fromJSON (builtins.readFile ./git.json)))"

547+ ]

548+

482thunkFileNames :: [FilePath]

549thunkFileNames :: [FilePath]

483thunkFileNames = ["default.nix", "github.json", "git.json"]

550thunkFileNames = ["default.nix", "github.json", "git.json"]

484

551

@@ -520,7 +587,7 @@ nixBuildThunkAttrWithCache thunkDir attr = do

520 Just c -> return c

587 Just c -> return c

521 Nothing -> do

588 Nothing -> do

522 putLog Warning $ T.pack $ mconcat [thunkDir, ": ", attr, " not cached, building ..."]

589 putLog Warning $ T.pack $ mconcat [thunkDir, ": ", attr, " not cached, building ..."]

523− _ <- nixCmd $ NixCmd_Build$ def

590+ _ <- nixCmd $ NixCmd_Build $ def

524 Lens.& nixBuildConfig_outLink Lens..~ OutLink_IndirectRoot cachePath

591 Lens.& nixBuildConfig_outLink Lens..~ OutLink_IndirectRoot cachePath

525 Lens.& nixCmdConfig_target Lens..~ Target

592 Lens.& nixCmdConfig_target Lens..~ Target

526 { _target_path = Just thunkDir

593 { _target_path = Just thunkDir

@@ -568,13 +635,13 @@ updateThunk p f = withSystemTempDirectory "obelisk-thunkptr-" $ \tmpDir -> do

568 Right (ThunkData_Packed _) -> do

635 Right (ThunkData_Packed _) -> do

569 let tmpThunk = tmpDir </> "thunk"

636 let tmpThunk = tmpDir </> "thunk"

570 callProcessAndLogOutput (Notice, Error) $

637 callProcessAndLogOutput (Notice, Error) $

571− proc "cp" ["-r", "-T", thunkDir, tmpThunk]

638+ proc cp ["-r", "-T", thunkDir, tmpThunk]

572 return tmpThunk

639 return tmpThunk

573− Right _ -> failWith $ "Thunk is not packed"

640+ Right _ -> failWith "Thunk is not packed"

574 updateThunkFromTmp p' = do

641 updateThunkFromTmp p' = do

575− _ <- packThunk' True False p'

642+ _ <- packThunk' True (ThunkPackConfig False (ThunkConfig Nothing)) p'

576 callProcessAndLogOutput (Notice, Error) $

643 callProcessAndLogOutput (Notice, Error) $

577− proc "cp" ["-r", "-T", p', p]

644+ proc cp ["-r", "-T", p', p]

578

645

579finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

646finalMsg :: Bool -> (a -> Text) -> Maybe (a -> Text)

580finalMsg noTrail s = if noTrail then Nothing else Just s

647finalMsg noTrail s = if noTrail then Nothing else Just s

@@ -606,7 +673,7 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with

606 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo

673 let git = callProcessAndLogOutput (Notice, Notice) . gitProc tmpRepo

607 git $ [ "clone" ]

674 git $ [ "clone" ]

608 ++ ("--recursive" <$ guard (_gitSource_fetchSubmodules s))

675 ++ ("--recursive" <$ guard (_gitSource_fetchSubmodules s))

609− ++ [ T.unpack $ render $ _gitSource_url s ]

676+ ++ [ T.unpack $ gitUriToText $ _gitSource_url s ]

610 ++ do branch <- maybeToList $ _gitSource_branch s

677 ++ do branch <- maybeToList $ _gitSource_branch s

611 [ "--branch", T.unpack $ untagName branch ]

678 [ "--branch", T.unpack $ untagName branch ]

612 git ["reset", "--hard", Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr]

679 git ["reset", "--hard", Ref.toHexString $ _thunkRev_commit $ _thunkPtr_rev tptr]

@@ -615,31 +682,39 @@ unpackThunk' noTrail thunkDir = checkThunkDirectory "Can't pack/unpack from with

615

682

616 liftIO $ createDirectory obGitDir

683 liftIO $ createDirectory obGitDir

617 callProcessAndLogOutput (Notice, Error) $

684 callProcessAndLogOutput (Notice, Error) $

618− proc "cp" ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]

685+ proc cp ["-r", "-T", thunkDir </> ".", obGitDir </> "orig-thunk"]

619 callProcessAndLogOutput (Notice, Error) $

686 callProcessAndLogOutput (Notice, Error) $

620 proc "rm" ["-r", thunkDir]

687 proc "rm" ["-r", thunkDir]

621 callProcessAndLogOutput (Notice, Error) $

688 callProcessAndLogOutput (Notice, Error) $

622 proc "mv" ["-T", tmpRepo, thunkDir]

689 proc "mv" ["-T", tmpRepo, thunkDir]

623

690

624--TODO: add a rollback mode to pack to the original thunk

691--TODO: add a rollback mode to pack to the original thunk

625−packThunk :: MonadObelisk m => Bool -> FilePath -> m ThunkPtr

692+packThunk :: MonadObelisk m => ThunkPackConfig -> FilePath -> m ThunkPtr

626packThunk = packThunk' False

693packThunk = packThunk' False

627

694

628−packThunk' :: MonadObelisk m => Bool -> Bool -> FilePath -> m ThunkPtr

695+packThunk' :: MonadObelisk m => Bool -> ThunkPackConfig -> FilePath -> m ThunkPtr

629−packThunk' noTrail force thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case

696+packThunk' noTrail (ThunkPackConfig force thunkConfig) thunkDir = checkThunkDirectory "Can't pack/unpack from within the thunk directory" thunkDir >> readThunk thunkDir >>= \case

630 Left err -> failWith $ T.pack $ "thunk pack: " <> show err

697 Left err -> failWith $ T.pack $ "thunk pack: " <> show err

631 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"

698 Right (ThunkData_Packed _) -> failWith "pack: thunk is already packed"

632 Right (ThunkData_Checkout _) -> do

699 Right (ThunkData_Checkout _) -> do

633 withSpinner' ("Packing thunk " <> T.pack thunkDir)

700 withSpinner' ("Packing thunk " <> T.pack thunkDir)

634 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

701 (finalMsg noTrail $ const $ "Packed thunk " <> T.pack thunkDir) $ do

635− thunkPtr <- getThunkPtr (not force) thunkDir

702+ thunkPtr <- modifyThunkPtrByConfig thunkConfig <$> getThunkPtr (not force) thunkDir

636 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]

703 callProcessAndLogOutput (Debug, Error) $ proc "rm" ["-rf", thunkDir]

637 liftIO $ createThunk thunkDir thunkPtr

704 liftIO $ createThunk thunkDir thunkPtr

638 pure thunkPtr

705 pure thunkPtr

639

706

707+modifyThunkPtrByConfig :: ThunkConfig -> ThunkPtr -> ThunkPtr

708+modifyThunkPtrByConfig (ThunkConfig markPrivate') ptr = case markPrivate' of

709+ Nothing -> ptr

710+ Just markPrivate -> ptr { _thunkPtr_source = case _thunkPtr_source ptr of

711+ ThunkSource_Git s -> ThunkSource_Git $ s { _gitSource_private = markPrivate }

712+ ThunkSource_GitHub s -> ThunkSource_GitHub $ s { _gitHubSource_private = markPrivate }

713+ }

714+

640getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr

715getThunkPtr :: forall m. MonadObelisk m => Bool -> FilePath -> m ThunkPtr

641getThunkPtr checkClean thunkDir = do

716getThunkPtr checkClean thunkDir = do

642− when checkClean $ ensureCleanGitRepo thunkDir True $

717+ when checkClean $ ensureCleanGitRepo thunkDir True

643 "thunk pack: thunk checkout contains unsaved modifications"

718 "thunk pack: thunk checkout contains unsaved modifications"

644

719

645 -- Check whether there are any stashes

720 -- Check whether there are any stashes

@@ -661,7 +736,7 @@ getThunkPtr checkClean thunkDir = do

661 <$> T.lines

736 <$> T.lines

662 <$> readGitProcess thunkDir ["rev-parse", "HEAD"]

737 <$> readGitProcess thunkDir ["rev-parse", "HEAD"]

663 case b of

738 case b of

664− (Just "HEAD") -> failWith $ T.unlines $

739+ (Just "HEAD") -> failWith $ T.unlines

665 [ "thunk pack: You are in 'detached HEAD' state."

740 [ "thunk pack: You are in 'detached HEAD' state."

666 , "If you want to pack at the current ref \

741 , "If you want to pack at the current ref \

667 \then please create a new branch with 'git checkout -b <new-branch-name>' and push this upstream."

742 \then please create a new branch with 'git checkout -b <new-branch-name>' and push this upstream."

@@ -733,7 +808,7 @@ getThunkPtr checkClean thunkDir = do

733 [ "thunk pack: Certain branches in the thunk have commits not yet pushed upstream:"

808 [ "thunk pack: Certain branches in the thunk have commits not yet pushed upstream:"

734 , ""

809 , ""

735 ] ++

810 ] ++

736− (flip map (Map.toList nonGood) $ \(branch, (upstream, (ahead, behind))) -> mconcat

811+ flip map (Map.toList nonGood) (\(branch, (upstream, (ahead, behind))) -> mconcat

737 [" ", branch, " ahead: ", T.pack (show ahead), " behind: ", T.pack (show behind), " remote branch ", upstream]) ++

812 [" ", branch, " ahead: ", T.pack (show ahead), " behind: ", T.pack (show behind), " remote branch ", upstream]) ++

738 [ ""

813 [ ""

739 , "Please push these upstream and try again. (Or just fetch, if they are somehow \

814 , "Please push these upstream and try again. (Or just fetch, if they are somehow \

@@ -741,7 +816,7 @@ getThunkPtr checkClean thunkDir = do

741 ]

816 ]

742

817

743 -- We assume it's safe to pack the thunk at this point

818 -- We assume it's safe to pack the thunk at this point

744− putLog Informational $ "All changes safe in git remotes. OK to pack thunk."

819+ putLog Informational "All changes safe in git remotes. OK to pack thunk."

745

820

746 let remote = maybe "origin" snd $ flip Map.lookup headUpstream =<< mCurrentBranch

821 let remote = maybe "origin" snd $ flip Map.lookup headUpstream =<< mCurrentBranch

747

822

@@ -773,7 +848,7 @@ getLatestRev os = do

773-- performance. If that doesn't work (e.g. authentication issue), we fall back

848-- performance. If that doesn't work (e.g. authentication issue), we fall back

774-- on just doing things the normal way for git repos in general, and save it as

849-- on just doing things the normal way for git repos in general, and save it as

775-- a regular git thunk.

850-- a regular git thunk.

776−uriThunkPtr :: MonadObelisk m => URI -> Maybe Text -> Maybe Text -> m ThunkPtr

851+uriThunkPtr :: MonadObelisk m => GitUri -> Maybe Text -> Maybe Text -> m ThunkPtr

777uriThunkPtr uri mbranch mcommit = do

852uriThunkPtr uri mbranch mcommit = do

778 commit <- case mcommit of

853 commit <- case mcommit of

779 Nothing -> gitGetCommitBranch uri mbranch >>= return . snd

854 Nothing -> gitGetCommitBranch uri mbranch >>= return . snd

@@ -784,7 +859,7 @@ uriThunkPtr uri mbranch mcommit = do

784 case rev of

859 case rev of

785 Right r -> pure (ThunkSource_GitHub s, r)

860 Right r -> pure (ThunkSource_GitHub s, r)

786 Left e -> do

861 Left e -> do

787− putLog Warning $ "\

862+ putLog Warning "\

788\Failed to fetch archive from GitHub. This is probably a private repo. \

863\Failed to fetch archive from GitHub. This is probably a private repo. \

789\Falling back on normal fetchgit. Original failure:"

864\Falling back on normal fetchgit. Original failure:"

790 errorToWarning e

865 errorToWarning e

@@ -801,33 +876,33 @@ uriThunkPtr uri mbranch mcommit = do

801-- If the thunk is a GitHub thunk and fails, we do *not* fall back like with

876-- If the thunk is a GitHub thunk and fails, we do *not* fall back like with

802-- `uriThunkPtr`. Unlike a plain URL, a thunk src explicitly states which method

877-- `uriThunkPtr`. Unlike a plain URL, a thunk src explicitly states which method

803-- should be employed, and so we respect that.

878-- should be employed, and so we respect that.

804−uriToThunkSource :: URI -> Maybe Text -> ThunkSource

879+uriToThunkSource :: GitUri -> Maybe Text -> ThunkSource

805−uriToThunkSource u

880+uriToThunkSource (GitUri u)

806− | Right uriAuth <- uriAuthority u

881+ | Right uriAuth <- URI.uriAuthority u

807− , Just scheme <- unRText <$> uriScheme u

882+ , Just scheme <- URI.unRText <$> URI.uriScheme u

808 , case scheme of

883 , case scheme of

809− "ssh" -> uriAuth == Authority

884+ "ssh" -> uriAuth == URI.Authority

810− { authUserInfo = Just $ UserInfo (fromRight' $ mkUsername "git") Nothing

885+ { URI.authUserInfo = Just $ URI.UserInfo (fromRight' $ URI.mkUsername "git") Nothing

811− , authHost = fromRight' $ mkHost "github.com"

886+ , URI.authHost = fromRight' $ URI.mkHost "github.com"

812− , authPort = Nothing

887+ , URI.authPort = Nothing

813 }

888 }

814 s -> s `L.elem` [ "git", "https", "http" ] -- "http:" just redirects to "https:"

889 s -> s `L.elem` [ "git", "https", "http" ] -- "http:" just redirects to "https:"

815− && unRText (authHost uriAuth) == "github.com"

890+ && URI.unRText (URI.authHost uriAuth) == "github.com"

816− , Just (_, owner :| [repoish]) <- uriPath u

891+ , Just (_, owner :| [repoish]) <- URI.uriPath u

817 = \mbranch -> ThunkSource_GitHub $ GitHubSource

892 = \mbranch -> ThunkSource_GitHub $ GitHubSource

818− { _gitHubSource_owner = N $ unRText owner

893+ { _gitHubSource_owner = N $ URI.unRText owner

819 , _gitHubSource_repo = N $ let

894 , _gitHubSource_repo = N $ let

820− repoish' = unRText repoish

895+ repoish' = URI.unRText repoish

821− in case T.stripSuffix ".git" repoish' of

896+ in fromMaybe repoish' $ T.stripSuffix ".git" repoish'

822− Just repo -> repo

823− Nothing -> repoish'

824 , _gitHubSource_branch = N <$> mbranch

897 , _gitHubSource_branch = N <$> mbranch

898+ , _gitHubSource_private = False -- TODO: Can we try something to infer this?

825 }

899 }

826

900

827 | otherwise = \mbranch -> ThunkSource_Git $ GitSource

901 | otherwise = \mbranch -> ThunkSource_Git $ GitSource

828− { _gitSource_url = u

902+ { _gitSource_url = GitUri u

829 , _gitSource_branch = N <$> mbranch

903 , _gitSource_branch = N <$> mbranch

830 , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?

904 , _gitSource_fetchSubmodules = False -- TODO: How do we determine if this should be true?

905+ , _gitSource_private = False -- TODO: Can we try something to infer this?

831 }

906 }

832

907

833-- Funny signature indicates no effects depend on the optional branch name.

908-- Funny signature indicates no effects depend on the optional branch name.

@@ -840,19 +915,19 @@ githubThunkRev

840githubThunkRev s commit = do

915githubThunkRev s commit = do

841 owner <- forcePP $ _gitHubSource_owner s

916 owner <- forcePP $ _gitHubSource_owner s

842 repo <- forcePP $ _gitHubSource_repo s

917 repo <- forcePP $ _gitHubSource_repo s

843− revTarball <- mkPathPiece $ commit <> ".tar.gz"

918+ revTarball <- URI.mkPathPiece $ commit <> ".tar.gz"

844− let archiveUri = URI

919+ let archiveUri = GitUri $ URI.URI

845− { uriScheme = Just $ fromRight' $ mkScheme "https"

920+ { URI.uriScheme = Just $ fromRight' $ URI.mkScheme "https"

846− , uriAuthority = Right $ Authority

921+ , URI.uriAuthority = Right $ URI.Authority

847− { authUserInfo = Nothing

922+ { URI.authUserInfo = Nothing

848− , authHost = fromRight' $ mkHost "github.com"

923+ , URI.authHost = fromRight' $ URI.mkHost "github.com"

849− , authPort = Nothing

924+ , URI.authPort = Nothing

850 }

925 }

851− , uriPath = Just ( False

926+ , URI.uriPath = Just ( False

852− , owner :| [ repo, fromRight' $ mkPathPiece "archive", revTarball ]

927+ , owner :| [ repo, fromRight' $ URI.mkPathPiece "archive", revTarball ]

853 )

928 )

854− , uriQuery = []

929+ , URI.uriQuery = []

855− , uriFragment = Nothing

930+ , URI.uriFragment = Nothing

856 }

931 }

857 hash <- getNixSha256ForUriUnpacked archiveUri

932 hash <- getNixSha256ForUriUnpacked archiveUri

858 putLog Debug $ "Nix sha256 is " <> hash

933 putLog Debug $ "Nix sha256 is " <> hash

@@ -861,8 +936,8 @@ githubThunkRev s commit = do

861 , _thunkRev_nixSha256 = hash

936 , _thunkRev_nixSha256 = hash

862 }

937 }

863 where

938 where

864− forcePP :: Name entity -> m (RText 'PathPiece)

939+ forcePP :: Name entity -> m (URI.RText 'URI.PathPiece)

865− forcePP = mkPathPiece . untagName

940+ forcePP = URI.mkPathPiece . untagName

866

941

867gitThunkRev

942gitThunkRev

868 :: MonadObelisk m

943 :: MonadObelisk m

@@ -871,11 +946,11 @@ gitThunkRev

871 -> m ThunkRev

946 -> m ThunkRev

872gitThunkRev s commit = do

947gitThunkRev s commit = do

873 let u = _gitSource_url s

948 let u = _gitSource_url s

874− protocols = ["https", "ssh", "git"]

949+ protocols = ["file", "https", "ssh", "git"]

875− Just scheme <- pure $ unRText <$> uriScheme u

950+ scheme = maybe "file" URI.unRText $ URI.uriScheme $ (\(GitUri x) -> x) u

876 unless (T.toLower scheme `elem` protocols) $

951 unless (T.toLower scheme `elem` protocols) $

877 failWith $ "obelisk currently only supports "

952 failWith $ "obelisk currently only supports "

878− <> T.intercalate ", " protocols <> " protocols for non-GitHub remotes"

953+ <> T.intercalate ", " protocols <> " protocols for plain Git remotes"

879 hash <- nixPrefetchGit u commit $ _gitSource_fetchSubmodules s

954 hash <- nixPrefetchGit u commit $ _gitSource_fetchSubmodules s

880 putLog Informational $ "Nix sha256 is " <> hash

955 putLog Informational $ "Nix sha256 is " <> hash

881 pure $ ThunkRev

956 pure $ ThunkRev

@@ -889,10 +964,10 @@ gitThunkRev s commit = do

889-- If the branch name is passed in, it is returned exactly as-is. If it is not

964-- If the branch name is passed in, it is returned exactly as-is. If it is not

890-- passed it, the default branch of the repo is used instead.

965-- passed it, the default branch of the repo is used instead.

891gitGetCommitBranch

966gitGetCommitBranch

892− :: MonadObelisk m => URI -> Maybe Text -> m (Text, CommitId)

967+ :: MonadObelisk m => GitUri -> Maybe Text -> m (Text, CommitId)

893gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do

968gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote " <> uriMsg) $ do

894 (_, bothMaps) <- gitLsRemote

969 (_, bothMaps) <- gitLsRemote

895− (T.unpack $ render uri)

970+ (T.unpack $ gitUriToText uri)

896 (GitRef_Branch <$> mbranch)

971 (GitRef_Branch <$> mbranch)

897 Nothing

972 Nothing

898 branch <- case mbranch of

973 branch <- case mbranch of

@@ -908,18 +983,21 @@ gitGetCommitBranch uri mbranch = withExitFailMessage ("Failure for git remote "

908 pure (branch, commit)

983 pure (branch, commit)

909 where

984 where

910 rethrowE = either failWith pure

985 rethrowE = either failWith pure

911− uriMsg = render uri

986+ uriMsg = gitUriToText uri

987+

988+parseGitUri :: Text -> Maybe GitUri

989+parseGitUri x = GitUri <$> (parseFileURI x <|> parseAbsoluteURI x <|> parseSshShorthand x)

912

990

913−parseGitUri :: Text -> Maybe URI

991+parseFileURI :: Text -> Maybe URI.URI

914−parseGitUri x = parseAbsoluteURI x <|> parseSshShorthand x

992+parseFileURI uri = if "/" `T.isPrefixOf` uri then parseAbsoluteURI ("file://" <> uri) else Nothing

915

993

916−parseAbsoluteURI :: Text -> Maybe URI

994+parseAbsoluteURI :: Text -> Maybe URI.URI

917parseAbsoluteURI uri = do

995parseAbsoluteURI uri = do

918− parsedUri <- mkURI uri

996+ parsedUri <- URI.mkURI uri

919− guard $ isPathAbsolute parsedUri

997+ guard $ URI.isPathAbsolute parsedUri

920− pure $ parsedUri

998+ pure parsedUri

921

999

922−parseSshShorthand :: Text -> Maybe URI

1000+parseSshShorthand :: Text -> Maybe URI.URI

923parseSshShorthand uri = do

1001parseSshShorthand uri = do

924 -- This is what git does to check that the remote

1002 -- This is what git does to check that the remote

925 -- is not a local file path when parsing shorthand.

1003 -- is not a local file path when parsing shorthand.

@@ -932,4 +1010,4 @@ parseSshShorthand uri = do

932 -- This check is used to disambiguate a filepath containing a colon from shorthand

1010 -- This check is used to disambiguate a filepath containing a colon from shorthand

933 guard $ isNothing (T.findIndex (=='/') authAndHostname)

1011 guard $ isNothing (T.findIndex (=='/') authAndHostname)

934 && not (T.null colonAndPath)

1012 && not (T.null colonAndPath)

935− mkURI properUri

1013+ URI.mkURI properUri

lib/command/src/Obelisk/Command/Utils.hs+27−13

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

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE OverloadedStrings #-}

6{-# LANGUAGE PatternGuards #-}

7+{-# LANGUAGE TemplateHaskell #-}

7module Obelisk.Command.Utils where

8module Obelisk.Command.Utils where

9import Control.Applicative hiding (many)

10import Control.Applicative hiding (many)

@@ -23,7 +24,7 @@ import Data.Void (Void)

23import System.Directory (canonicalizePath)

24import System.Directory (canonicalizePath)

24import System.Environment (getExecutablePath)

25import System.Environment (getExecutablePath)

25import System.Exit (ExitCode)

26import System.Exit (ExitCode)

26−import qualified System.Process as P

27+import System.Which (staticWhich)

27import Text.Megaparsec as MP

28import Text.Megaparsec as MP

28import Text.Megaparsec.Char as MP

29import Text.Megaparsec.Char as MP

@@ -33,6 +34,9 @@ import Obelisk.CliApp

33getObeliskExe :: IO FilePath

34getObeliskExe :: IO FilePath

34getObeliskExe = getExecutablePath >>= canonicalizePath

35getObeliskExe = getExecutablePath >>= canonicalizePath

37+cp :: FilePath

38+cp = $(staticWhich "cp")

39+

36-- Check whether the working directory is clean

40-- Check whether the working directory is clean

37checkGitCleanStatus :: MonadObelisk m => FilePath -> Bool -> m Bool

41checkGitCleanStatus :: MonadObelisk m => FilePath -> Bool -> m Bool

38checkGitCleanStatus repo withIgnored = do

42checkGitCleanStatus repo withIgnored = do

@@ -61,20 +65,30 @@ initGit repo = do

61 git ["add", "."]

65 git ["add", "."]

62 git ["commit", "-m", "Initial commit."]

66 git ["commit", "-m", "Initial commit."]

64−gitProcNoRepo :: [String] -> P.CreateProcess

68+gitProcNoRepo :: [String] -> ProcessSpec

65−gitProcNoRepo = P.proc "git"

69+gitProcNoRepo args = setEnvOverride (M.singleton "GIT_TERMINAL_PROMPT" "0" <>) $ proc "git" args

67−gitProc :: FilePath -> [String] -> P.CreateProcess

71+gitProc :: FilePath -> [String] -> ProcessSpec

68gitProc repo = gitProcNoRepo . runGitInDir

72gitProc repo = gitProcNoRepo . runGitInDir

69 where

73 where

70 runGitInDir args' = case filter (not . null) args' of

74 runGitInDir args' = case filter (not . null) args' of

71 args@("clone":_) -> args <> [repo]

75 args@("clone":_) -> args <> [repo]

72 args -> ["-C", repo] <> args

76 args -> ["-C", repo] <> args

78+isolateGitProc :: ProcessSpec -> ProcessSpec

79+isolateGitProc = setEnvOverride (overrides <>)

80+ where

81+ overrides = M.fromList

82+ [ ("HOME", "/dev/null")

83+ , ("GIT_CONFIG_NOSYSTEM", "1")

84+ , ("GIT_TERMINAL_PROMPT", "0")

85+ , ("GIT_SSH_COMMAND", "ssh -o PreferredAuthentications=password -o PubkeyAuthentication=no -o GSSAPIAuthentication=no")

86+ ]

87+

74−-- | Recursively copy a directory using `cp -a`

88+-- | Recursively copy a directory using `cp -a` -- TODO: Should use -rT instead of -a

75−copyDir :: FilePath -> FilePath -> P.CreateProcess

89+copyDir :: FilePath -> FilePath -> ProcessSpec

76copyDir src dest =

90copyDir src dest =

77− (P.proc "cp" ["-a", ".", dest]) { P.cwd = Just src }

91+ setCwd (Just src) $ proc cp ["-a", ".", dest] -- TODO: This will break if dest is relative since we change cwd

79readGitProcess :: MonadObelisk m => FilePath -> [String] -> m Text

93readGitProcess :: MonadObelisk m => FilePath -> [String] -> m Text

80readGitProcess repo = readProcessAndLogOutput (Debug, Notice) . gitProc repo

94readGitProcess repo = readProcessAndLogOutput (Debug, Notice) . gitProc repo

@@ -87,15 +101,15 @@ processToShellString cmd args = unwords $ map quoteAndEscape (cmd : args)

87 where quoteAndEscape x = T.unpack $ "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

101 where quoteAndEscape x = T.unpack $ "'" <> T.replace "'" "'\''" (T.pack x) <> "'"

102

89-- | A simpler wrapper for CliApp's most used process function with sensible defaults.

103-- | A simpler wrapper for CliApp's most used process function with sensible defaults.

90−runProc :: MonadObelisk m => P.CreateProcess -> m ()

104+runProc :: MonadObelisk m => ProcessSpec -> m ()

91runProc = callProcessAndLogOutput (Notice, Error)

105runProc = callProcessAndLogOutput (Notice, Error)

106

93-- | Like runProc, but all output goes to Debug logging level

107-- | Like runProc, but all output goes to Debug logging level

94−runProcSilently :: MonadObelisk m => P.CreateProcess -> m ()

108+runProcSilently :: MonadObelisk m => ProcessSpec -> m ()

95runProcSilently = callProcessAndLogOutput (Debug, Debug)

109runProcSilently = callProcessAndLogOutput (Debug, Debug)

110

97-- | A simpler wrapper for CliApp's readProcessAndLogStderr with sensible defaults.

111-- | A simpler wrapper for CliApp's readProcessAndLogStderr with sensible defaults.

98−readProc :: MonadObelisk m => P.CreateProcess -> m Text

112+readProc :: MonadObelisk m => ProcessSpec -> m Text

99readProc = readProcessAndLogOutput (Debug, Error)

113readProc = readProcessAndLogOutput (Debug, Error)

100

114

101tshow :: Show a => a -> Text

115tshow :: Show a => a -> Text

@@ -129,13 +143,13 @@ gitLsRemote repository mRef mBranch = do

129 (exitCode, out, _err) <- case mBranch of

143 (exitCode, out, _err) <- case mBranch of

130 Nothing -> readCreateProcessWithExitCode $ gitProcNoRepo $

144 Nothing -> readCreateProcessWithExitCode $ gitProcNoRepo $

131 ["ls-remote", "--exit-code", "--symref", repository]

145 ["ls-remote", "--exit-code", "--symref", repository]

132− ++ (maybeToList $ T.unpack . showGitRef <$> mRef)

146+ ++ maybeToList (T.unpack . showGitRef <$> mRef)

133− Just branchName -> readCreateProcessWithExitCode $ gitProcNoRepo $

147+ Just branchName -> readCreateProcessWithExitCode $ gitProcNoRepo

134 ["ls-remote", "--exit-code", repository, branchName]

148 ["ls-remote", "--exit-code", repository, branchName]

135 let t = T.pack out

149 let t = T.pack out

136 maps <- case MP.runParser parseLsRemote "" t of

150 maps <- case MP.runParser parseLsRemote "" t of

137 Left err -> failWith $ T.pack $ MP.errorBundlePretty err

151 Left err -> failWith $ T.pack $ MP.errorBundlePretty err

138− Right table -> pure $ bimap M.fromList M.fromList $ partitionEithers $ table

152+ Right table -> pure $ bimap M.fromList M.fromList $ partitionEithers table

139 putLog Debug $ "git ls-remote maps: " <> T.pack (show maps)

153 putLog Debug $ "git ls-remote maps: " <> T.pack (show maps)

140 pure (exitCode, maps)

154 pure (exitCode, maps)

141

155

lib/command/src/Obelisk/Command/VmBuilder.hs−1

@@ -18,7 +18,6 @@ import System.Directory (createDirectoryIfMissing)

18import System.Exit (ExitCode(..))

19import System.FilePath ((<.>), (</>))

20import qualified System.Info

21−import System.Process (proc)

23import Obelisk.App (MonadObelisk, getObeliskUserStateDir)

22import Obelisk.App (MonadObelisk, getObeliskUserStateDir)

24import Obelisk.CliApp

23import Obelisk.CliApp

lib/executable-config/lookup/obelisk-executable-config-lookup.cabal+1−1

@@ -27,7 +27,7 @@ library

27 build-depends: directory

29 build-depends:

30− base,

30+ base,

31 base64-bytestring,

32 bytestring,

33 containers,

lib/route/src/Obelisk/Route.hs+1−1

@@ -881,7 +881,7 @@ instance (GCompare br, GCompare fr) => GCompare (FullRoute br fr) where

881 gcompare (FullRoute_Frontend x) (FullRoute_Frontend y) = gcompare x y

882

883instance (UniverseSome br, UniverseSome fr) => UniverseSome (FullRoute br fr) where

884− universeSome = [Some (FullRoute_Backend x) | Some x <- universeSome]

884+ universeSome = [Some (FullRoute_Backend x) | Some x <- universeSome]

885 ++ [Some (FullRoute_Frontend x) | Some x <- universeSome]

886

887-- | Build the typical top level application route encoder from a route for handling 404's,

lib/run/src/Obelisk/Run.hs+1−1

@@ -129,7 +129,7 @@ runWidget conf configs frontend validFullEncoder = do

129 putStrLn $ "Frontend running on " <> T.unpack (URI.render uri)

130 settings = setBeforeMainLoop beforeMainLoop (setPort port (setTimeout 3600 defaultSettings))

131 -- Providing TLS here will also incidentally provide it to proxied requests to the backend.

132− prepareRunner = case (uri ^? uriScheme . _Just . unRText) of

132+ prepareRunner = case uri ^? uriScheme . _Just . unRText of

133 Just "https" -> do

134 -- Generate a private key and self-signed certificate for TLS

135 privateKey <- RSA.generateRSAKey' 2048 3

lib/selftest/obelisk-selftest.cabal+4−2

@@ -11,16 +11,18 @@ library

11 base

12 , containers

13 , directory

14+ , filepath

14 , hspec

15 , hspec

15 , http-client

16 , http-client

16 , http-types

17 , http-types

17 , HUnit

18 , HUnit

19+ , network

18 , obelisk-cliapp

20 , obelisk-cliapp

19 , obelisk-executable-config-lookup

21 , obelisk-executable-config-lookup

20 , obelisk-run

22 , obelisk-run

23+ , which

21 , process

24 , process

22− , network

23− , shelly

25+ , shelly >= 1.9.0

24 , temporary

26 , temporary

25 , text

27 , text

26 exposed-modules:

28 exposed-modules:

lib/selftest/src/Obelisk/SelfTest.hs+101−45

@@ -3,6 +3,8 @@

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE PatternGuards #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6+{-# LANGUAGE ViewPatterns #-}

7+{-# LANGUAGE TemplateHaskell #-}

6module Obelisk.SelfTest where

8module Obelisk.SelfTest where

8import Control.Exception (bracket, throw)

10import Control.Exception (bracket, throw)

@@ -10,7 +12,7 @@ import Control.Monad

10import Control.Monad.IO.Class

12import Control.Monad.IO.Class

11import Data.Bool (bool)

13import Data.Bool (bool)

12import Data.Function (fix)

14import Data.Function (fix)

13−import Data.Semigroup (Semigroup, (<>))

15+import Data.Semigroup ((<>))

14import qualified Data.Set as Set

16import qualified Data.Set as Set

15import Data.String

17import Data.String

16import Data.Text (Text)

18import Data.Text (Text)

@@ -20,11 +22,13 @@ import qualified Data.Text.IO as T

20import qualified Network.HTTP.Client as HTTP

22import qualified Network.HTTP.Client as HTTP

21import qualified Network.HTTP.Types as HTTP

23import qualified Network.HTTP.Types as HTTP

22import qualified Network.Socket as Socket

24import qualified Network.Socket as Socket

23−import Shelly

25+import Shelly hiding (cp)

24import System.Directory (withCurrentDirectory, getDirectoryContents)

26import System.Directory (withCurrentDirectory, getDirectoryContents)

25import System.Environment

27import System.Environment

26import System.Exit (ExitCode (..))

28import System.Exit (ExitCode (..))

27−import System.Info

29+import System.FilePath (replaceBaseName, takeBaseName)

30+import System.Which (staticWhich)

31+import qualified System.Info

28import System.IO (Handle, hClose)

32import System.IO (Handle, hClose)

29import System.IO.Temp

33import System.IO.Temp

30import System.Process (readProcessWithExitCode, CreateProcess(cwd), readCreateProcessWithExitCode, proc)

34import System.Process (readProcessWithExitCode, CreateProcess(cwd), readCreateProcessWithExitCode, proc)

@@ -42,16 +46,21 @@ data ObRunState

42 | ObRunState_BackendStarted

46 | ObRunState_BackendStarted

43 deriving (Eq, Show)

47 deriving (Eq, Show)

45−doubleQuotes :: (IsString a, Semigroup a) => a -> a

49+cp :: FilePath

46−doubleQuotes s = "\"" <> s <> "\""

50+cp = $(staticWhich "cp")

51+

52+cabalPath :: FilePath

53+cabalPath = $(staticWhich "cabal")

54+

55+gitUserConfig :: [Text]

56+gitUserConfig = ["-c", "user.name=Obelisk Selftest", "-c", "user.email=noreply@example.com"]

48commit :: Text -> Sh ()

58commit :: Text -> Sh ()

49−commit msg = void $ run "git"

59+commit msg = void $ run "git" $ gitUserConfig <> [ "commit"

50− [ "commit"

51 , "--no-gpg-sign"

60 , "--no-gpg-sign"

52 , "--allow-empty"

61 , "--allow-empty"

53 , "-m"

62 , "-m"

54− , doubleQuotes msg

63+ , msg

55 ]

64 ]

57-- TODO replace Void and stop using loosely typed synchronous exceptions

66-- TODO replace Void and stop using loosely typed synchronous exceptions

@@ -67,6 +76,7 @@ tshow = T.pack . show

67shellyOb :: MonadIO m => (Sh a -> Sh a) -> Sh a -> m a

76shellyOb :: MonadIO m => (Sh a -> Sh a) -> Sh a -> m a

68shellyOb f obTest = shelly $ f obTest

77shellyOb f obTest = shelly $ f obTest

79+

70main :: IO ()

80main :: IO ()

71main = do

81main = do

72 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`

82 -- Note: you can pass hspec arguments as well, eg: `-m <pattern>`

@@ -75,25 +85,55 @@ main = do

75 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"

85 putStrLn "Tests may take longer to run if there are unbuilt derivations: use -v for verbose output"

76 let verbosity = bool silently verbosely isVerbose

86 let verbosity = bool silently verbosely isVerbose

77 nixBuild args = run "nix-build" ("--no-out-link" : args)

87 nixBuild args = run "nix-build" ("--no-out-link" : args)

78− obeliskImpl <- fromString <$> getEnv "OBELISK_IMPL"

88+ obeliskImplRaw <- fromString <$> getEnv "OBELISK_IMPL"

89+ let

90+ withObeliskImpl f =

91+ withSystemTempDirectory "obelisk-impl-copy" $ \(fromString -> obeliskImpl) -> do

92+ void . shellyOb verbosity $ chdir obeliskImpl $ do

93+ user <- T.strip <$> run "whoami" []

94+ run_ cp ["-rT", toTextIgnore obeliskImplRaw, toTextIgnore obeliskImpl]

95+ run_ "chown" ["-R", user, toTextIgnore obeliskImpl]

96+ run_ "chmod" ["-R", "g-rw,o-rw", toTextIgnore obeliskImpl]

97+ f obeliskImpl

98+

99+ withInitCache f obeliskImpl =

100+ withSystemTempDirectory "init Cache λ" $ \initCache -> do

101+ -- Setup the ob init cache

102+ void . shellyOb verbosity $ chdir initCache $ do

103+ run_ "ob" ["init", "--symlink", toTextIgnore obeliskImpl]

104+ run_ "git" ["init"]

105+

106+ f initCache

107+

108+ withObeliskImplAndInitCache f =

109+ withObeliskImpl $ \impl -> withInitCache (f impl) impl

110+

79 httpManager <- HTTP.newManager HTTP.defaultManagerSettings

111 httpManager <- HTTP.newManager HTTP.defaultManagerSettings

80− [p0, p1, p2, p3] <- liftIO $ getFreePorts 4

112+

81− withSystemTempDirectory "initCache" $ \initCache -> do

113+ withObeliskImplAndInitCache $ \obeliskImpl initCache ->

82− -- Setup the ob init cache

83− void . shellyOb verbosity $ chdir (fromString initCache) $ do

84− run_ "ob" ["init"]

85− run_ "git" ["init"]

86 hspec $ parallel $ do

114 hspec $ parallel $ do

87 let shelly_ = void . shellyOb verbosity

115 let shelly_ = void . shellyOb verbosity

116

89− inTmp :: (Shelly.FilePath -> Sh a) -> IO ()

117+ defaultTmpDirName = "test λ"

90− inTmp f = withTmp (chdir <*> f)

118

92− withTmp f = shelly_ . withSystemTempDirectory "test" $ f . fromString

119+ inTmp' :: FilePath -> (FilePath -> Sh a) -> IO ()

120+ inTmp' dirname f = withTmp' dirname (chdir <*> f)

121+ inTmp = inTmp' defaultTmpDirName

122

123+ withTmp' dirname f = shelly_ . withSystemTempDirectory dirname $ f . fromString

124+ withTmp = withTmp' defaultTmpDirName

125+

94− inTmpObInit f = inTmp $ \dir -> do

126+ inTmpObInit' dirname f = inTmp' dirname $ \dir -> do

95− run_ "cp" ["-a", fromString $ initCache <> "/.", toTextIgnore dir]

127+ run_ cp ["-rT", fromString initCache, toTextIgnore dir]

96 f dir

128 f dir

129+ inTmpObInit = inTmpObInit' defaultTmpDirName

130+

131+ -- To be used in tests that change the obelisk impl directory

132+ inTmpObInitWithImplCopy f = inTmpObInit $ \dir ->

133+ withObeliskImpl $ \(fromString -> implCopy) -> do

134+ run_ "rm" [thunk]

135+ run_ "ln" ["-s", implCopy, thunk]

136+ f dir

137

98 assertRevEQ a b = liftIO . assertEqual "" "" =<< diff a b

138 assertRevEQ a b = liftIO . assertEqual "" "" =<< diff a b

99 assertRevNE a b = liftIO . assertBool "" . (/= "") =<< diff a b

139 assertRevNE a b = liftIO . assertBool "" . (/= "") =<< diff a b

@@ -115,9 +155,9 @@ main = do

115 describe "ob init" $ parallel $ do

155 describe "ob init" $ parallel $ do

116 it "works with default impl" $ inTmp $ \_ -> run "ob" ["init"]

156 it "works with default impl" $ inTmp $ \_ -> run "ob" ["init"]

117 it "works with master branch impl" $ inTmp $ \_ -> run "ob" ["init", "--branch", "master"]

157 it "works with master branch impl" $ inTmp $ \_ -> run "ob" ["init", "--branch", "master"]

118− it "works with symlink" $ inTmp $ \_ -> run "ob" ["init", "--symlink", obeliskImpl]

158+ it "works with symlink" $ inTmp $ \_ -> run "ob" ["init", "--symlink", toTextIgnore obeliskImpl]

119− it "doesn't silently overwrite existing files" $ withSystemTempDirectory "ob-init" $ \dir -> do

159+ it "doesn't silently overwrite existing files" $ withSystemTempDirectory "ob-init λ" $ \dir -> do

120− let p force = (proc "ob" $ "--no-handoff" : "init" : ["--force"|force]) { cwd = Just dir }

160+ let p force = (System.Process.proc "ob" $ "--no-handoff" : "init" : ["--force"|force]) { cwd = Just dir }

121 (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p False) ""

161 (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p False) ""

122 (ExitFailure _, _, _) <- readCreateProcessWithExitCode (p False) ""

162 (ExitFailure _, _, _) <- readCreateProcessWithExitCode (p False) ""

123 (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p True) ""

163 (ExitSuccess, _, _) <- readCreateProcessWithExitCode (p True) ""

@@ -134,25 +174,28 @@ main = do

134

174

135 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"

175 -- These tests fail with "Could not find module 'Obelisk.Generated.Static'"

136 -- when not run by 'nix-build --attr selftest'

176 -- when not run by 'nix-build --attr selftest'

137− describe "ob run" $ parallel $ do

177+ describe "ob run" $ {- NOT parallel $ -} do

138− it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir p0 p1 Nothing httpManager

178+ it "works in root directory" $ inTmpObInit $ \_ -> testObRunInDir Nothing httpManager

139− it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir p2 p3 (Just "frontend") httpManager

179+ it "works in sub directory" $ inTmpObInit $ \_ -> testObRunInDir (Just "frontend") httpManager

180+ it "works with differently named cabal files" $ inTmpObInit $ \_ -> do

181+ changeCabalPackageName "backend/backend.cabal" "new-backend"

182+ testObRunInDir Nothing httpManager

140

183

141 describe "obelisk project" $ parallel $ do

184 describe "obelisk project" $ parallel $ do

142− it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , obeliskImpl]

185+ it "can build obelisk command" $ inTmpObInit $ \_ -> nixBuild ["-A", "command" , toTextIgnore obeliskImpl]

143− it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", obeliskImpl]

186+ it "can build obelisk skeleton" $ inTmpObInit $ \_ -> nixBuild ["-A", "skeleton", toTextIgnore obeliskImpl]

144− it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", obeliskImpl]

187+ it "can build obelisk shell" $ inTmpObInit $ \_ -> nixBuild ["-A", "shell", toTextIgnore obeliskImpl]

145− it "can build everything" $ inTmpObInit $ \_ -> nixBuild [obeliskImpl]

188+ it "can build everything" $ inTmpObInit $ \_ -> nixBuild [toTextIgnore obeliskImpl]

146

189

147 describe "blank initialized project" $ parallel $ do

190 describe "blank initialized project" $ parallel $ do

148

191

149 it "can build ghc.backend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghc.backend"]

192 it "can build ghc.backend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghc.backend"]

150 it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghcjs.frontend"]

193 it "can build ghcjs.frontend" $ inTmpObInit $ \_ -> nixBuild ["-A", "ghcjs.frontend"]

151

194

152− if os == "darwin"

195+ if System.Info.os == "darwin"

153 then it "can build ios" $ inTmpObInit $ \_ -> nixBuild ["-A", "ios.frontend"]

196 then it "can build ios" $ inTmpObInit $ \_ -> nixBuild ["-A", "ios.frontend"]

154 else it "can build android after accepting license" $ inTmpObInit $ \dir -> do

197 else it "can build android after accepting license" $ inTmpObInit $ \dir -> do

155− let defaultNixPath = dir </> ("default.nix" :: Shelly.FilePath)

198+ let defaultNixPath = dir </> ("default.nix" :: FilePath)

156 writefile defaultNixPath

199 writefile defaultNixPath

157 =<< T.replace

200 =<< T.replace

158 "# config.android_sdk.accept_license = false;"

201 "# config.android_sdk.accept_license = false;"

@@ -162,19 +205,24 @@ main = do

162

205

163 forM_ ["ghc", "ghcjs"] $ \compiler -> do

206 forM_ ["ghc", "ghcjs"] $ \compiler -> do

164 let

207 let

165− shell = "shells." <> compiler

208+ shellName = "shells." <> compiler

166− inShell cmd' = run "nix-shell" ["default.nix", "-A", fromString shell, "--run", cmd']

209+ inShell cmd' = run_ "nix-shell" ["default.nix", "-A", fromString shellName, "--run", cmd']

167− it ("can enter " <> shell) $ inTmpObInit $ \_ -> inShell "exit"

210+ it ("can enter " <> shellName) $ inTmpObInit $ \_ -> inShell "exit"

168− it ("can build in " <> shell) $ inTmpObInit $ \_ -> inShell $ "cabal new-build --" <> fromString compiler <> " all"

211+ -- NOTE: We override the temporary directory name because cabal has a bug preventing new-build from working

169−

212+ -- in a path that has unicode characters.

213+ it ("can build in " <> shellName) $ inTmpObInit' "test" $ \_ -> inShell $

214+ T.pack cabalPath <> " --version; " <> T.pack cabalPath <> " new-build --" <> T.pack compiler <> " all"

215+

170− it "has idempotent thunk update" $ inTmpObInit $ \_ -> do

216+ it "has idempotent thunk update" $ inTmpObInitWithImplCopy $ \_ -> do

217+ _ <- pack

171 u <- update

218 u <- update

172 uu <- update

219 uu <- update

173 assertRevEQ u uu

220 assertRevEQ u uu

174

221

175 describe "ob thunk pack/unpack" $ parallel $ do

222 describe "ob thunk pack/unpack" $ parallel $ do

176− it "has thunk pack and unpack inverses" $ inTmpObInit $ \_ -> do

223+ it "has thunk pack and unpack inverses" $ inTmpObInitWithImplCopy $ \_ -> do

177

224

225+ _ <- pack

178 e <- commitAll

226 e <- commitAll

179 eu <- unpack

227 eu <- unpack

180 eup <- pack

228 eup <- pack

@@ -212,7 +260,6 @@ main = do

212 testThunkPack $ fromText repo

260 testThunkPack $ fromText repo

213

261

214 it "aborts thunk pack when there are uncommitted files" $ inTmpObInit $ \dir -> do

262 it "aborts thunk pack when there are uncommitted files" $ inTmpObInit $ \dir -> do

215− void unpack

216 testThunkPack (dir </> thunk)

263 testThunkPack (dir </> thunk)

217

264

218 describe "ob thunk update --branch" $ parallel $ do

265 describe "ob thunk update --branch" $ parallel $ do

@@ -233,11 +280,12 @@ main = do

233

280

234

281

235-- | Run `ob run` in the given directory (maximum of one level deep)

282-- | Run `ob run` in the given directory (maximum of one level deep)

236−testObRunInDir :: Socket.PortNumber -> Socket.PortNumber -> Maybe Shelly.FilePath -> HTTP.Manager -> Sh ()

283+testObRunInDir :: Maybe FilePath -> HTTP.Manager -> Sh ()

237−testObRunInDir p0 p1 mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do

284+testObRunInDir mdir httpManager = handle_sh (\case ExitSuccess -> pure (); e -> throw e) $ do

285+ [p0, p1] <- liftIO $ getFreePorts 2

238 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison

286 let uri p = "http://localhost:" <> T.pack (show p) <> "/" -- trailing slash required for comparison

239 writefile "config/common/route" $ uri p0

287 writefile "config/common/route" $ uri p0

240− maybe id chdir mdir $ runHandle "ob" ["run"] $ \stdout -> do

288+ maybe id chdir mdir $ runHandle "ob" ["run", "-v"] $ \stdout -> do

241 firstUri <- handleObRunStdout httpManager stdout

289 firstUri <- handleObRunStdout httpManager stdout

242 let newUri = uri p1

290 let newUri = uri p1

243 when (firstUri == newUri) $ errorExit $

291 when (firstUri == newUri) $ errorExit $

@@ -248,7 +296,7 @@ testObRunInDir p0 p1 mdir httpManager = handle_sh (\case ExitSuccess -> pure ();

248 then errorExit $ "Reloading failed: expected " <> newUri <> " but got " <> runningUri

296 then errorExit $ "Reloading failed: expected " <> newUri <> " but got " <> runningUri

249 else exit 0

297 else exit 0

250

298

251−testThunkPack :: Shelly.FilePath -> Sh ()

299+testThunkPack :: FilePath -> Sh ()

252testThunkPack path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $ \file handle -> do

300testThunkPack path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $ \file handle -> do

253 let pack' = readProcessWithExitCode "ob" ["thunk", "pack", T.unpack $ toTextIgnore path'] ""

301 let pack' = readProcessWithExitCode "ob" ["thunk", "pack", T.unpack $ toTextIgnore path'] ""

254 ensureThunkPackFails q = liftIO $ pack' >>= \case

302 ensureThunkPackFails q = liftIO $ pack' >>= \case

@@ -269,7 +317,7 @@ testThunkPack path' = withTempFile (T.unpack $ toTextIgnore path') "test-file" $

269 liftIO $ T.hPutStrLn handle "test file" >> hClose handle

317 liftIO $ T.hPutStrLn handle "test file" >> hClose handle

270 ensureThunkPackFails "modified"

318 ensureThunkPackFails "modified"

271 -- Existing stashes

319 -- Existing stashes

272− void $ git ["stash"]

320+ void $ git $ gitUserConfig <> [ "stash" ]

273 ensureThunkPackFails "has stashes"

321 ensureThunkPackFails "has stashes"

274

322

275-- | Blocks until a non-empty line is available

323-- | Blocks until a non-empty line is available

@@ -314,6 +362,14 @@ obRunCheck httpManager _stdout frontendUri = do

314 req frontendUri >>= \r -> when (HTTP.responseStatus r /= HTTP.ok200) $ errorExit $

362 req frontendUri >>= \r -> when (HTTP.responseStatus r /= HTTP.ok200) $ errorExit $

315 "Request to frontend server failed: " <> T.pack (show r)

363 "Request to frontend server failed: " <> T.pack (show r)

316

364

365+-- | Rename a cabal file and do a really dumb, brittle search/replace in its content to update the name.

366+changeCabalPackageName :: FilePath -> Text -> Sh ()

367+changeCabalPackageName cabalFile newName = do

368+ contents <- readfile cabalFile

369+ writefile (replaceBaseName cabalFile (T.unpack newName)) $

370+ T.replace (" " <> T.pack (takeBaseName cabalFile)) (" " <> newName) contents -- WARNING: Super brittle

371+ rm cabalFile

372+

317getFreePorts :: Int -> IO [Socket.PortNumber]

373getFreePorts :: Int -> IO [Socket.PortNumber]

318getFreePorts 0 = pure []

374getFreePorts 0 = pure []

319getFreePorts n = Socket.withSocketsDo $ do

375getFreePorts n = Socket.withSocketsDo $ do

lib/tabulation/src/Data/Tabulation.hs+1−1

@@ -8,7 +8,7 @@ import Control.Lens

8-- | This is a class for record types whose fields can be enumerated by an associated GADT. It's closely related to the concept of a representable functor, except without the functor part, and the fields are not all the same type.

9class HasFields a where

10 type Field a :: * -> *

11−

11+

12 fieldLens :: Field a x -> Lens' a x

13 tabulateFieldsA :: Applicative f => (forall x. Field a x -> f x) -> f a

release.nix+8−95

@@ -1,97 +1,10 @@

1−{ self-args ? {

1+{

2− config.android_sdk.accept_license = true;

2+ supportedSystems ? [ "x86_64-linux" "x86_64-darwin" ]

3− iosSdkVersion = "10.2";

4− }

5−, local-self ? import ./. self-args

6}:

3}:

4+rec {

5+ recurseForDerivations = true;

6+ build = import ./all-builds.nix { inherit supportedSystems; };

7+ test = import ./all-tests.nix { inherit supportedSystems; };

8−let

9+ inherit (build) metaCache;

9− inherit (local-self.nixpkgs) lib runCommand nix;

10+}

10−

11− cacheBuildSystems = [ "x86_64-linux" "x86_64-darwin" ];

12−

13− obeliskPackagesCommon = [

14− "obelisk-frontend"

15− "obelisk-route"

16− "obelisk-executable-config-lookup"

17− ];

18−

19− obeliskPackagesBackend = obeliskPackagesCommon ++ [

20− "obelisk-asset-manifest"

21− "obelisk-asset-serve-snap"

22− "obelisk-backend"

23− "obelisk-cliapp"

24− "obelisk-command"

25− "obelisk-executable-config-inject"

26− "obelisk-frontend"

27− "obelisk-run"

28− "obelisk-route"

29− "obelisk-selftest"

30− "obelisk-snap-extras"

31− ];

32−

33− pnameToAttrs = pkgsSet: pnames:

34− lib.listToAttrs (map

35− (name: { inherit name; value = pkgsSet.${name}; })

36− pnames);

37−

38− concatDepends = let

39− extractDeps = x: (x.override {

40− mkDerivation = drv: {

41− out = builtins.concatLists [

42− (drv.buildDepends or [])

43− (drv.libraryHaskellDepends or [])

44− (drv.executableHaskellDepends or [])

45− ];

46− };

47− }).out;

48− in pkgAttrs: builtins.concatLists (map extractDeps (builtins.attrValues pkgAttrs));

49−

50− perPlatform = lib.genAttrs cacheBuildSystems (system: let

51− obelisk = import ./. (self-args // { inherit system; });

52− reflex-platform = obelisk.reflex-platform;

53− ghc = pnameToAttrs

54− obelisk.haskellPackageSets.ghc

55− obeliskPackagesBackend;

56− ghcjs = pnameToAttrs

57− obelisk.haskellPackageSets.ghcjs

58− obeliskPackagesCommon;

59− cachePackages = builtins.concatLists [

60− (builtins.attrValues ghc)

61− (builtins.attrValues ghcjs)

62− (concatDepends ghc)

63− (concatDepends ghcjs)

64− (lib.optional reflex-platform.androidSupport androidSkeleton)

65− (lib.optional reflex-platform.iosSupport iosSkeleton)

66− [ command serverSkeletonExe serverSkeletonShell ]

67− ];

68− command = obelisk.command;

69− skeleton = import ./skeleton { inherit obelisk; };

70− serverSkeletonExe = skeleton.exe;

71− # TODO fix nixpkgs so it doesn't try to run the result of haskell shells as setup hooks.

72− serverSkeletonShell = local-self.nixpkgs.runCommand "shell-safe-for-dep" {} ''

73− touch "$out"

74− echo "return" >> "$out"

75− cat "${skeleton.shells.ghc}" >> "$out"

76− '';

77− androidSkeleton = (import ./skeleton { inherit obelisk; }).android.frontend;

78− iosSkeleton = (import ./skeleton { inherit obelisk; }).ios.frontend;

79− in {

80− inherit

81− command

82− ghc ghcjs

83− serverSkeletonExe

84− serverSkeletonShell

85− ;

86− cache = reflex-platform.pinBuildInputs "obelisk-${system}" cachePackages;

87− } // lib.optionalAttrs reflex-platform.androidSupport {

88− inherit androidSkeleton;

89− } // lib.optionalAttrs reflex-platform.iosSupport {

90− inherit iosSkeleton;

91− });

92−

93− metaCache = local-self.reflex-platform.pinBuildInputs

94− "obelisk-everywhere"

95− (map (a: a.cache) (builtins.attrValues perPlatform));

96−

97−in perPlatform // { inherit metaCache; }

skeleton/.gitignore+1

@@ -1,5 +1,6 @@

1dist-newstyle

2result

3+result-*

3result-android

4result-android

4result-ios

5result-ios

5result-exe

6result-exe

skeleton/common/common.cabal−3

@@ -9,9 +9,6 @@ library

9 , obelisk-route

10 , mtl

11 , text

12− default-extensions:

13− TypeFamilies

14− PolyKinds

15 exposed-modules:

12 exposed-modules:

16 Common.Api

13 Common.Api

17 Common.Route

14 Common.Route

skeleton/common/src/Common/Route.hs+1

@@ -8,6 +8,7 @@

8{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE RankNTypes #-}

10{-# LANGUAGE TemplateHaskell #-}

11+{-# LANGUAGE TypeFamilies #-}

11module Common.Route where

12module Common.Route where

13{- -- You will probably want these imports for composing Encoders.

14{- -- You will probably want these imports for composing Encoders.

skeleton/frontend/frontend.cabal+1

@@ -9,6 +9,7 @@ library

9 , common

10 , obelisk-frontend

11 , obelisk-route

12+ , jsaddle

12 , reflex-dom

13 , reflex-dom

13 , obelisk-executable-config-lookup

14 , obelisk-executable-config-lookup

14 , obelisk-generated-static

15 , obelisk-generated-static

skeleton/frontend/src/Frontend.hs+21−3

@@ -1,25 +1,43 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE TypeApplications #-}

4module Frontend where

5module Frontend where

7+import Control.Monad

6import qualified Data.Text as T

8import qualified Data.Text as T

7import qualified Data.Text.Encoding as T

9import qualified Data.Text.Encoding as T

10+import Language.Javascript.JSaddle (eval, liftJSM)

11+

8import Obelisk.Frontend

12import Obelisk.Frontend

9import Obelisk.Configs

13import Obelisk.Configs

10import Obelisk.Route

14import Obelisk.Route

15+import Obelisk.Generated.Static

16+

11import Reflex.Dom.Core

17import Reflex.Dom.Core

13import Common.Api

19import Common.Api

14import Common.Route

20import Common.Route

15−import Obelisk.Generated.Static

22+

23+-- This runs in a monad that can be run on the client or the server.

24+-- To run code in a pure client or pure server context, use one of the

25+-- `prerender` functions.

17frontend :: Frontend (R FrontendRoute)

26frontend :: Frontend (R FrontendRoute)

18frontend = Frontend

27frontend = Frontend

28+ { _frontend_head = do

19− { _frontend_head = el "title" $ text "Obelisk Minimal Example"

29+ el "title" $ text "Obelisk Minimal Example"

30+ elAttr "link" ("href" =: static @"main.css" <> "type" =: "text/css" <> "rel" =: "stylesheet") blank

20 , _frontend_body = do

31 , _frontend_body = do

21− text "Welcome to Obelisk!"

32+ el "h1" $ text "Welcome to Obelisk!"

22 el "p" $ text $ T.pack commonStuff

33 el "p" $ text $ T.pack commonStuff

34+

35+ -- `prerender` and `prerender_` let you choose a widget to run on the server

36+ -- during prerendering and a different widget to run on the client with

37+ -- JavaScript. The following will generate a `blank` widget on the server and

38+ -- print "Hello, World!" on the client.

39+ prerender_ blank $ liftJSM $ void $ eval ("console.log('Hello, World!')" :: T.Text)

40+

23 elAttr "img" ("src" =: static @"obelisk.jpg") blank

41 elAttr "img" ("src" =: static @"obelisk.jpg") blank

24 el "div" $ do

42 el "div" $ do

25 exampleConfig <- getConfig "common/example"

43 exampleConfig <- getConfig "common/example"

skeleton/static/main.cssnew file+3

@@ -0,0 +1,3 @@

1+p {

2+ color: red;

3+}