on master help sign in
Merge pull request #11 from obsidiansystems/improve-readthunk-check
d917826Ryan Trinkle
command/obelisk-command.cabal+1
@@ -10,6 +10,7 @@ library
10 , aeson-pretty
10 , aeson-pretty
11 , base
11 , base
12 , bytestring
12 , bytestring
13+ , containers
13 , directory
14 , directory
14 , filepath
15 , filepath
15 , github
16 , github
command/src/Obelisk/Command/Thunk.hs+40−31
@@ -24,6 +24,7 @@ import Data.List.NonEmpty (NonEmpty (..))
24import qualified Data.List.NonEmpty as NonEmpty
24import qualified Data.List.NonEmpty as NonEmpty
25import Data.Maybe
25import Data.Maybe
26import Data.Monoid
26import Data.Monoid
27+import qualified Data.Set as Set
27import Data.Text (Text)
28import Data.Text (Text)
28import qualified Data.Text as T
29import qualified Data.Text as T
29import qualified Data.Text.IO as T
30import qualified Data.Text.IO as T
@@ -112,39 +113,47 @@ getLatestRev = \case
112-- present, fail.
113-- present, fail.
113readThunk :: FilePath -> IO (Maybe ThunkPtr)
114readThunk :: FilePath -> IO (Maybe ThunkPtr)
114readThunk thunkDir = do
115readThunk thunkDir = do
115− let githubJson = thunkDir </> "github.json"
116− doesFileExist githubJson >>= \case
117− False -> return Nothing
118− True -> do
119− -- Ensure that we recognize the thunk loader
120− loader <- T.readFile $ thunkDir </> "default.nix"
116+ let thunkLoader = thunkDir </> "default.nix"
121− guard $ loader `elem` gitHubStandaloneLoaders
117+ githubJson = thunkDir </> "github.json"
118+ attrCache = thunkDir </> ".attr-cache"
119+ expectedContents = Set.fromList $
120+ [ githubJson
121+ , thunkLoader
122+ , attrCache
123+ ]
122
124
123− -- Ensure that there aren't any other files in the thunk
125+ -- Ensure that there aren't any other files in the thunk
126+ -- NB: System.Directory.listDirectory returns the contents without the directory path
124− files <- listDirectory thunkDir
127+ files <- Set.fromList . fmap (thunkDir </>) <$> listDirectory thunkDir
125− guard $ length files == 3
128+ let unexpectedContents = files `Set.difference` expectedContents
129+ missingContents = expectedContents `Set.difference` files
130+ guard $ Set.null unexpectedContents && Set.null missingContents
126
131
132+ -- Ensure that we recognize the thunk loader
133+ loader <- T.readFile thunkLoader
134+ guard $ loader `elem` gitHubStandaloneLoaders
135+
127− txt <- LBS.readFile githubJson
136+ txt <- LBS.readFile githubJson
128− let p v = do
137+ let p v = do
129− owner <- v Aeson..: "owner"
138+ owner <- v Aeson..: "owner"
130− repo <- v Aeson..: "repo"
139+ repo <- v Aeson..: "repo"
131− rev <- v Aeson..: "rev"
140+ rev <- v Aeson..: "rev"
132− sha256 <- v Aeson..: "sha256"
141+ sha256 <- v Aeson..: "sha256"
133− branch <- v Aeson..:! "branch"
142+ branch <- v Aeson..:! "branch"
134− mPrivate <- v Aeson..:! "private"
143+ mPrivate <- v Aeson..:! "private"
135− return $ ThunkPtr
144+ return $ ThunkPtr
136− { _thunkPtr_rev = ThunkRev
145+ { _thunkPtr_rev = ThunkRev
137− { _thunkRev_commit = Ref.fromHexString rev
146+ { _thunkRev_commit = Ref.fromHexString rev
138− , _thunkRev_nixSha256 = sha256
147+ , _thunkRev_nixSha256 = sha256
139− }
148+ }
140− , _thunkPtr_source = ThunkSource_GitHub $ GitHubSource
149+ , _thunkPtr_source = ThunkSource_GitHub $ GitHubSource
141− { _gitHubSource_owner = owner
150+ { _gitHubSource_owner = owner
142− , _gitHubSource_repo = repo
151+ , _gitHubSource_repo = repo
143− , _gitHubSource_branch = branch
152+ , _gitHubSource_branch = branch
144− , _gitHubSource_private = fromMaybe False mPrivate
153+ , _gitHubSource_private = fromMaybe False mPrivate
145− }
154+ }
146− }
155+ }
147− return $ parseMaybe p =<< decode txt
156+ return $ parseMaybe p =<< decode txt
148
157
149overwriteThunk :: FilePath -> ThunkPtr -> IO ()
158overwriteThunk :: FilePath -> ThunkPtr -> IO ()
150overwriteThunk target thunk = do
159overwriteThunk target thunk = do