master...c8ebdad · obelisk

git.iko.soy/obelisk

on c8ebdad help sign in

default.nix+35−34

since splitsnapshots

unifiedsplit

@@ -329,40 +329,39 @@ in rec {

329 });

330 in allConfig;

331 in (mkProject (projectDefinition args)).projectConfig);

332− mainProjectOut = projectOut { inherit system; };

332+ projectOutHost = projectOut { inherit system; };

333 serverOn = projectInst: version: serverExe

334 projectInst.ghc.backend

335− mainProjectOut.ghcjs.frontend

335+ projectOutHost.ghcjs.frontend

336 projectInst.passthru.staticFiles

337 projectInst.passthru.__closureCompilerOptimizationLevel

338 version;

339− linuxExe = serverOn (projectOut { system = "x86_64-linux"; });

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

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

341− in mainProjectOut // {

342− __unstable__.profiledObRun = let

340+ profiledObRun =

341+ let

343− profiled = projectOut { inherit system; enableLibraryProfiling = true; };

342+ profiled = projectOut { inherit system; enableLibraryProfiling = true; };

344− exeSource = builtins.toFile "ob-run.hs" ''

343+ exeSource = builtins.toFile "ob-run-profiled.hs" ''

345− {-# LANGUAGE NoImplicitPrelude #-}

344+ {-# LANGUAGE NoImplicitPrelude #-}

346− {-# LANGUAGE PackageImports #-}

345+ {-# LANGUAGE PackageImports #-}

347− module Main where

346+ module Main where

348−

347+

349− -- Explicitly import Prelude from base lest there be multiple modules called Prelude

348+ -- Explicitly import Prelude from base lest there be multiple modules called Prelude

350− import "base" Prelude (IO, (++), read)

349+ import "base" Prelude (IO, (++), read)

351−

350+

352− import "base" Control.Exception (finally)

351+ import "base" Control.Exception (finally)

353− import "reflex" Reflex.Profiled (writeProfilingData)

352+ import "reflex" Reflex.Profiled (writeProfilingData)

354− import "base" System.Environment (getArgs)

353+ import "base" System.Environment (getArgs)

355−

354+

356− import qualified "obelisk-run" Obelisk.Run

355+ import qualified "obelisk-run" Obelisk.Run

357− import qualified Frontend

356+ import qualified Frontend

358− import qualified Backend

357+ import qualified Backend

359−

358+

360− main :: IO ()

359+ main :: IO ()

361− main = do

360+ main = do

362− [portStr, assets, profFileName] <- getArgs

361+ [portStr, assets, profFileName] <- getArgs

363− Obelisk.Run.run (read portStr) (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend

362+ Obelisk.Run.run (read portStr) (Obelisk.Run.runServeAsset assets) Backend.backend Frontend.frontend

364− `finally` writeProfilingData (profFileName ++ ".rprof")

363+ `finally` writeProfilingData (profFileName ++ ".rprof")

365− '';

364+ '';

366 in nixpkgs.runCommand "ob-run" {

365 in nixpkgs.runCommand "ob-run" {

367 buildInputs = [ (profiled.ghc.ghcWithPackages (p: [p.backend p.frontend])) ];

366 buildInputs = [ (profiled.ghc.ghcWithPackages (p: [p.backend p.frontend])) ];

368 } ''

367 } ''

@@ -370,14 +369,16 @@ in rec {

370 mkdir -p $out/bin

369 mkdir -p $out/bin

371 ghc -x hs -prof -fno-prof-auto -threaded ob-run.hs -o $out/bin/ob-run

370 ghc -x hs -prof -fno-prof-auto -threaded ob-run.hs -o $out/bin/ob-run

372 '';

371 '';

373−

372+ in projectOutHost // lib.makeExtensible (self: {

374− linuxExeConfigurable = linuxExe;

373+ __unstable__.profiledObRun = profiledObRun;

375− linuxExe = linuxExe dummyVersion;

374+ exeConfigurable = { system, version }: serverOn (projectOut { inherit system; }) version;

376− exe = serverOn mainProjectOut dummyVersion;

375+ exe = self.exeConfigurable { inherit system; version = dummyVersion; };

376+ linuxExeConfigurable = version: self.exeConfigurable { system = "x86_64-linux"; inherit version; };

377+ linuxExe = self.linuxExeConfigurable dummyVersion;

377 server = args@{ hostName, adminEmail, routeHost, enableHttps, version, module ? serverModules.mkBaseEc2 }:

378 server = args@{ hostName, adminEmail, routeHost, enableHttps, version, module ? serverModules.mkBaseEc2 }:

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

379+ server (args // { exe = self.linuxExeConfigurable version; });

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

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

380− };

381+ });

381 haskellPackageSets = {

382 haskellPackageSets = {

382 inherit (reflex-platform) ghc ghcjs;

383 inherit (reflex-platform) ghc ghcjs;

383 };

384 };

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

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

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4− "branch": "develop",

4+ "branch": "eac@tweaks-from-wrinkl",

5 "private": false,

6− "rev": "c21ec7036c8351185cd2feef9ce577b6a61c4f22",

6+ "rev": "1cca141c7a87e98e8e36860c326408942851bf61",

7− "sha256": "0m4sdpz6qvngralpyprrbvsyi2zmfh2l3q5vhihwfp3842blvbfg"

7+ "sha256": "0mlxn6zy4983rr3ahslm5yvyz6gkqs9m6by9xl9vm0dhm2cb36gj"

lib/command/src/Obelisk/Command/Deploy.hs+16−13

@@ -17,6 +17,7 @@ import Data.Bits

17import qualified Data.ByteString.Lazy as BSL

18import Data.Default

19import qualified Data.Map as Map

20+import Data.Maybe (isJust)

20import qualified Data.Set as Set

21import qualified Data.Set as Set

21import Data.String.Here.Interpolated (i)

22import Data.String.Here.Interpolated (i)

22import qualified Data.Text as T

23import qualified Data.Text as T

@@ -125,14 +126,15 @@ deployPush deployPath getNixBuilders = do

125 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"

126 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"

126 routeHost <- getHostFromRoute enableHttps route

127 routeHost <- getHostFromRoute enableHttps route

127 let srcPath = deployPath </> "src"

128 let srcPath = deployPath </> "src"

128− thunkPtr <- readThunk srcPath >>= \case

129+ thunkPtr' <- readThunk srcPath >>= \case

129− Right (ThunkData_Packed _ ptr) -> return ptr

130+ Right (ThunkData_Packed _ ptr) -> return $ Just ptr

130 Right ThunkData_Checkout -> do

131 Right ThunkData_Checkout -> do

131 checkGitCleanStatus srcPath True >>= \case

132 checkGitCleanStatus srcPath True >>= \case

132− True -> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath

133+ True -> Just <$> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath

134+ False -> Nothing <$ putLog Warning "Skipping packing of src thunk; won't be able to automatically commit this deployment"

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

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

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

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

135− let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr

137+ let version' = show . _thunkRev_commit . _thunkPtr_rev <$> thunkPtr'

136 builders <- getNixBuilders

138 builders <- getNixBuilders

137 let moduleFile = deployPath </> "module.nix"

139 let moduleFile = deployPath </> "module.nix"

138 moduleFileExists <- liftIO $ doesFileExist moduleFile

140 moduleFileExists <- liftIO $ doesFileExist moduleFile

@@ -149,7 +151,7 @@ deployPush deployPath getNixBuilders = do

149 [ strArg "hostName" host

151 [ strArg "hostName" host

150 , strArg "adminEmail" adminEmail

152 , strArg "adminEmail" adminEmail

151 , strArg "routeHost" routeHost

153 , strArg "routeHost" routeHost

152− , strArg "version" version

154+ , strArg "version" $ maybe "Deployment was done with a dirty source tree" id version'

153 , boolArg "enableHttps" enableHttps

155 , boolArg "enableHttps" enableHttps

154 ] <> [rawArg "module" ("import " <> toNixPath moduleFile) | moduleFileExists ])

156 ] <> [rawArg "module" ("import " <> toNixPath moduleFile) | moduleFileExists ])

155 & nixCmdConfig_builders .~ builders

157 & nixCmdConfig_builders .~ builders

@@ -179,13 +181,14 @@ deployPush deployPath getNixBuilders = do

179 , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"

181 , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"

180 ]

182 ]

181 ]

183 ]

184+ when (isJust version') $ do

182− isClean <- checkGitCleanStatus deployPath True

185+ isClean <- checkGitCleanStatus deployPath True

183− when (not isClean) $ do

186+ when (not isClean) $ do

184− withSpinner "Committing changes to Git" $ do

187+ withSpinner "Committing changes to Git" $ do

185− callProcessAndLogOutput (Debug, Error) $ proc "git"

188+ callProcessAndLogOutput (Debug, Error) $ proc "git"

186− ["-C", deployPath, "add", "."]

189+ ["-C", deployPath, "add", "."]

187− callProcessAndLogOutput (Debug, Error) $ proc "git"

190+ callProcessAndLogOutput (Debug, Error) $ proc "git"

188− ["-C", deployPath, "commit", "-m", "New deployment"]

191+ ["-C", deployPath, "commit", "-m", "New deployment"]

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

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

190 where

193 where

191 callProcess' envMap cmd args = do

194 callProcess' envMap cmd args = do

lib/command/src/Obelisk/Command/Thunk.hs+34−42

@@ -26,9 +26,8 @@ import qualified Data.ByteString.Lazy as LBS

26import Data.Containers.ListUtils (nubOrd)

27import Data.Default

28import Data.Either.Combinators (fromRight', rightToMaybe)

29−import Data.Foldable (toList)

29+import Data.Foldable (for_, toList)

30import Data.Function ((&))

31−import Data.Functor ((<&>))

32import Data.Git.Ref (Ref)

31import Data.Git.Ref (Ref)

33import qualified Data.Git.Ref as Ref

32import qualified Data.Git.Ref as Ref

34import qualified Data.List as L

33import qualified Data.List as L

@@ -238,35 +237,38 @@ matchThunkSpecToDir

238 -> Set FilePath -- ^ Set of file paths relative to the given directory

237 -> Set FilePath -- ^ Set of file paths relative to the given directory

239 -> m ThunkData

238 -> m ThunkData

240matchThunkSpecToDir thunkSpec dir dirFiles = do

239matchThunkSpecToDir thunkSpec dir dirFiles = do

240+ isCheckout <- fmap or $ flip Map.traverseWithKey (_thunkSpec_files thunkSpec) $ \expectedPath -> \case

241+ ThunkFileSpec_CheckoutIndicator -> liftIO (doesDirectoryExist (dir </> expectedPath))

242+ _ -> pure False

243+ case isCheckout of

244+ True -> pure ThunkData_Checkout

245+ False -> do

241− case nonEmpty (toList $ dirFiles `Set.difference` expectedPaths) of

246+ for_ (nonEmpty (toList $ dirFiles `Set.difference` expectedPaths)) $ \fs ->

242− Just fs -> throwError $ ReadThunkError_UnrecognizedPaths $ (dir </>) <$> fs

247+ throwError $ ReadThunkError_UnrecognizedPaths $ (dir </>) <$> fs

243− Nothing -> pure ()

244− case nonEmpty (toList $ requiredPaths `Set.difference` dirFiles) of

248+ for_ (nonEmpty (toList $ requiredPaths `Set.difference` dirFiles)) $ \fs ->

245− Just fs -> throwError $ ReadThunkError_MissingPaths $ (dir </>) <$> fs

249+ throwError $ ReadThunkError_MissingPaths $ (dir </>) <$> fs

246− Nothing -> pure ()

247− datas <- fmap toList $ flip Map.traverseMaybeWithKey (_thunkSpec_files thunkSpec) $ \expectedPath -> \case

250+ datas <- fmap toList $ flip Map.traverseMaybeWithKey (_thunkSpec_files thunkSpec) $ \expectedPath -> \case

248− ThunkFileSpec_AttrCache -> Nothing <$ dirMayExist expectedPath

251+ ThunkFileSpec_AttrCache -> Nothing <$ dirMayExist expectedPath

249− ThunkFileSpec_CheckoutIndicator -> liftIO (doesDirectoryExist (dir </> expectedPath)) <&> \case

252+ ThunkFileSpec_CheckoutIndicator -> pure Nothing -- Handled above

250− False -> Nothing

251− True -> Just ThunkData_Checkout

252− ThunkFileSpec_FileMatches expectedContents -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

253+ ThunkFileSpec_FileMatches expectedContents -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

253− actualContents <- liftIO (T.readFile $ dir </> expectedPath)

254+ actualContents <- liftIO (T.readFile $ dir </> expectedPath)

254− case T.strip expectedContents == T.strip actualContents of

255+ case T.strip expectedContents == T.strip actualContents of

255− True -> pure Nothing

256+ True -> pure Nothing

256− False -> throwError $ ReadThunkError_FileDoesNotMatch (dir </> expectedPath) expectedContents

257+ False -> throwError $ ReadThunkError_FileDoesNotMatch (dir </> expectedPath) expectedContents

257− ThunkFileSpec_Ptr parser -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

258+ ThunkFileSpec_Ptr parser -> handle (\(e :: IOError) -> throwError $ ReadThunkError_FileError e) $ do

258− let path = dir </> expectedPath

259+ let path = dir </> expectedPath

259− liftIO (doesFileExist path) >>= \case

260+ liftIO (doesFileExist path) >>= \case

260− False -> pure Nothing

261+ False -> pure Nothing

261− True -> do

262+ True -> do

262− actualContents <- liftIO $ LBS.readFile path

263+ actualContents <- liftIO $ LBS.readFile path

263− case parser actualContents of

264+ case parser actualContents of

264− Right v -> pure $ Just (ThunkData_Packed thunkSpec v)

265+ Right v -> pure $ Just (thunkSpec, v)

265− Left e -> throwError $ ReadThunkError_UnparseablePtr (dir </> expectedPath) e

266+ Left e -> throwError $ ReadThunkError_UnparseablePtr (dir </> expectedPath) e

266−

267+

267− case nonEmpty datas of

268+ uncurry ThunkData_Packed <$> case nonEmpty datas of

268− Nothing -> throwError ReadThunkError_UnrecognizedThunk

269+ Nothing -> throwError ReadThunkError_UnrecognizedThunk

269− Just xs -> fold1WithM xs $ \a b -> either throwError pure (mergeThunkData a b)

270+ Just xs -> fold1WithM xs $ \a@(_, ptrA) (_, ptrB) ->

271+ if ptrA == ptrB then pure a else throwError $ ReadThunkError_AmbiguousPackedState ptrA ptrB

270 where

272 where

271 rootPathsOnly = Set.fromList . mapMaybe takeRootDir . Map.keys

273 rootPathsOnly = Set.fromList . mapMaybe takeRootDir . Map.keys

272 takeRootDir = fmap NonEmpty.head . nonEmpty . splitPath

274 takeRootDir = fmap NonEmpty.head . nonEmpty . splitPath

@@ -282,15 +284,6 @@ matchThunkSpecToDir thunkSpec dir dirFiles = do

282 True -> throwError $ ReadThunkError_UnrecognizedPaths $ expectedPath :| []

284 True -> throwError $ ReadThunkError_UnrecognizedPaths $ expectedPath :| []

283 False -> pure ()

285 False -> pure ()

284

286

285− -- Combine 'ThunkData' from different files, preferring "Checkout" over "Packed"

286− mergeThunkData ThunkData_Checkout ThunkData_Checkout = Right ThunkData_Checkout

287− mergeThunkData ThunkData_Checkout ThunkData_Packed{} = Left bothPackedAndUnpacked

288− mergeThunkData ThunkData_Packed{} ThunkData_Checkout = Left bothPackedAndUnpacked

289− mergeThunkData a@(ThunkData_Packed _ ptrA) (ThunkData_Packed _ ptrB) =

290− if ptrA == ptrB then Right a else Left $ ReadThunkError_AmbiguousPackedState ptrA ptrB

291−

292− bothPackedAndUnpacked = ReadThunkError_UnrecognizedState "Both packed data and checkout present"

293−

294 fold1WithM (x :| xs) f = foldM f x xs

287 fold1WithM (x :| xs) f = foldM f x xs

295

288

296readThunkWith

289readThunkWith

@@ -305,8 +298,7 @@ readThunkWith specTypes dir = do

305 Left e -> putLog Debug [i|Thunk specification ${_thunkSpec_name spec} did not match ${dir}: ${e}|] *> loop rest

298 Left e -> putLog Debug [i|Thunk specification ${_thunkSpec_name spec} did not match ${dir}: ${e}|] *> loop rest

306 x@(Right _) -> x <$ putLog Debug [i|Thunk specification ${_thunkSpec_name spec} matched ${dir}|]

299 x@(Right _) -> x <$ putLog Debug [i|Thunk specification ${_thunkSpec_name spec} matched ${dir}|]

307

300

308−-- | Read a thunk and validate that it is exactly a packed thunk.

301+-- | Read a packed or unpacked thunk based on predefined thunk specifications.

309−-- If additional data is present, fail.

310readThunk :: (MonadObelisk m) => FilePath -> m (Either ReadThunkError ThunkData)

302readThunk :: (MonadObelisk m) => FilePath -> m (Either ReadThunkError ThunkData)

311readThunk = readThunkWith thunkSpecTypes

303readThunk = readThunkWith thunkSpecTypes

312

304

lib/executable-config/default.nix+3−2

@@ -5,13 +5,14 @@

5{ lib

6, runCommand

7, obeliskCleanSource

8+, staticDirName ? ""

8}:

9}:

10let

11let

11 injectConfig = config: assets: runCommand "inject-config" {} (''

12 injectConfig = config: assets: runCommand "inject-config" {} (''

12 set -x

13 set -x

13− mkdir -p $out

14+ mkdir -p "$out"/'${staticDirName}'

14− cp --no-preserve=mode -Lr "${assets}" $out/static

15+ cp --no-preserve=mode -Lr "${assets}"/. "$out"/'${staticDirName}'/

15 chmod +w "$out"

16 chmod +w "$out"

16 '' + lib.optionalString (!(builtins.isNull config)) ''

17 '' + lib.optionalString (!(builtins.isNull config)) ''

17 if ! mkdir $out/config; then

18 if ! mkdir $out/config; then