Skip to content

Commit 867587a

Browse files
DanBurtonDanBurton
committed
Test suite builds again, and previous failure changed to expect exception commercialhaskell#102 
1 parent 5ad68c2 commit 867587a

3 files changed

Lines changed: 83 additions & 40 deletions

File tree

‎src/test/Network/HTTP/Download/VerifiedSpec.hs‎

Lines changed: 29 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
1+
{-# LANGUAGE RecordWildCards #-}
12
module Network.HTTP.Download.VerifiedSpec where
23

34
import Crypto.Hash
45
import Control.Exception
6+
import Control.Monad.Trans.Reader
57
import Data.Maybe
68
import Network.HTTP.Client.Conduit
79
import Network.HTTP.Download.Verified
@@ -11,6 +13,7 @@ import System.IO (writeFile)
1113
import System.IO.Temp
1214
import Test.Hspec
1315

16+
1417
-- TODO: share across test files
1518
withTempDir :: (Path Abs Dir -> IO a) -> IO a
1619
withTempDir f = withSystemTempDirectory "NHD_VerifiedSpec" $ \dirFp -> do
@@ -54,53 +57,66 @@ isWrongDigest :: VerifiedDownloadException -> Bool
5457
isWrongDigest WrongDigest{} = True
5558
isWrongDigest _ = False
5659

57-
spec :: Spec
58-
spec = do
59-
-- TODO: share manager across tests
60+
data T = T
61+
{ manager :: Manager
62+
}
63+
64+
runWith :: Manager -> ReaderT Manager m r -> m r
65+
runWith = flip runReaderT
6066

67+
setup :: IO T
68+
setup = do
69+
manager <- newManager
70+
return T{..}
71+
72+
teardown :: T -> IO ()
73+
teardown _ = return ()
74+
75+
spec :: Spec
76+
spec = beforeAll setup $ afterAll teardown $ do
6177
describe "verifiedDownload" $ do
62-
it "downloads the file correctly" $ withTempDir $ \dir -> do
78+
it "downloads the file correctly" $ \T{..} -> withTempDir $ \dir -> do
6379
examplePath <- getExamplePath dir
6480
let exampleFilePath = toFilePath examplePath
6581
doesFileExist exampleFilePath `shouldReturn` False
66-
let go = withManager $ verifiedDownload exampleReq examplePath
82+
let go = runWith manager $ verifiedDownload exampleReq examplePath
6783
go `shouldReturn` True
6884
doesFileExist exampleFilePath `shouldReturn` True
6985

70-
it "is idempotent, and doesn't redownload unnecessarily" $ withTempDir $ \dir -> do
86+
it "is idempotent, and doesn't redownload unnecessarily" $ \T{..} -> withTempDir $ \dir -> do
7187
examplePath <- getExamplePath dir
7288
let exampleFilePath = toFilePath examplePath
7389
doesFileExist exampleFilePath `shouldReturn` False
74-
let go = withManager $ verifiedDownload exampleReq examplePath
90+
let go = runWith manager $ verifiedDownload exampleReq examplePath
7591
go `shouldReturn` True
7692
doesFileExist exampleFilePath `shouldReturn` True
7793
go `shouldReturn` False
7894
doesFileExist exampleFilePath `shouldReturn` True
7995

80-
it "does redownload when the destination file is wrong" $ withTempDir $ \dir -> do
96+
it "does redownload when the destination file is wrong" $ \T{..} -> withTempDir $ \dir -> do
8197
examplePath <- getExamplePath dir
8298
let exampleFilePath = toFilePath examplePath
8399
writeFile exampleFilePath exampleWrongContent
84100
doesFileExist exampleFilePath `shouldReturn` True
85-
let go = withManager $ verifiedDownload exampleReq examplePath
101+
let go = runWith manager $ verifiedDownload exampleReq examplePath
86102
go `shouldReturn` True
87103
doesFileExist exampleFilePath `shouldReturn` True
88104

89-
it "rejects incorrect content length" $ withTempDir $ \dir -> do
105+
it "rejects incorrect content length" $ \T{..} -> withTempDir $ \dir -> do
90106
examplePath <- getExamplePath dir
91107
let exampleFilePath = toFilePath examplePath
92108
let wrongContentLengthReq = exampleReq
93109
{ vrDownloadBytes = exampleWrongContentLength
94110
}
95-
let go = withManager $ verifiedDownload wrongContentLengthReq examplePath
111+
let go = runWith manager $ verifiedDownload wrongContentLengthReq examplePath
96112
go `shouldThrow` isWrongContentLength
97113
doesFileExist exampleFilePath `shouldReturn` False
98114

99-
it "rejects incorrect digest" $ withTempDir $ \dir -> do
115+
it "rejects incorrect digest" $ \T{..} -> withTempDir $ \dir -> do
100116
examplePath <- getExamplePath dir
101117
let exampleFilePath = toFilePath examplePath
102118
let wrongDigestReq = exampleReq
103119
{ vrExpectedHexDigest = exampleWrongDigest }
104-
let go = withManager $ verifiedDownload wrongDigestReq examplePath
120+
let go = runWith manager $ verifiedDownload wrongDigestReq examplePath
105121
go `shouldThrow` isWrongDigest
106122
doesFileExist exampleFilePath `shouldReturn` False

‎src/test/Stack/ConfigSpec.hs‎

Lines changed: 53 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,14 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
{-# LANGUAGE TemplateHaskell #-}
13
module Stack.ConfigSpec where
24

35
import Control.Applicative
46
import Control.Monad
57
import Control.Monad.Logger
68
import Control.Exception
79
import Data.Maybe
10+
import Data.Monoid
11+
import Network.HTTP.Conduit (Manager)
812
import Path
913
--import System.FilePath
1014
import System.Directory
@@ -16,17 +20,37 @@ import Stack.Config
1620
import Stack.Types.Config
1721
import Stack.Types.StackT
1822

23+
sampleConfig :: String
24+
sampleConfig =
25+
"resolver: lts-2.10\n" ++
26+
"packages: ['.']\n"
27+
28+
stackDotYaml :: Path Rel File
29+
stackDotYaml = $(mkRelFile "stack.yaml")
30+
31+
data T = T
32+
{ manager :: Manager
33+
}
34+
35+
setup :: IO T
36+
setup = do
37+
manager <- newTLSManager
38+
return T{..}
39+
40+
teardown :: T -> IO ()
41+
teardown _ = return ()
42+
1943
spec :: Spec
20-
spec = do
21-
manager <- runIO $ newTLSManager
22-
stackDotYaml <- runIO $ parseRelFile "stack.yaml"
44+
spec = beforeAll setup $ afterAll teardown $ do
2345
let logLevel = LevelDebug
46+
-- TODO(danburton): not use inTempDir
2447
let inTempDir action = do
2548
currentDirectory <- getCurrentDirectory
2649
withSystemTempDirectory "Stack_ConfigSpec" $ \tempDir -> do
2750
let enterDir = setCurrentDirectory tempDir
2851
let exitDir = setCurrentDirectory currentDirectory
2952
bracket_ enterDir exitDir action
53+
-- TODO(danburton): a safer version of this?
3054
let withEnvVar name newValue action = do
3155
originalValue <- fromMaybe "" <$> lookupEnv name
3256
let setVar = setEnv name newValue
@@ -35,32 +59,34 @@ spec = do
3559

3660

3761
describe "loadConfig" $ do
38-
let loadConfig' = runStackLoggingT manager logLevel loadConfig
39-
40-
-- TODO: make sure parent dirs also don't have config file
41-
it "works even if no config file exists" $ inTempDir $ do
42-
_config <- loadConfig'
62+
let loadConfig' m = runStackLoggingT m logLevel (loadConfig mempty)
63+
let loadBuildConfigRest m = runStackLoggingT m logLevel
64+
-- TODO(danburton): make sure parent dirs also don't have config file
65+
it "works even if no config file exists" $ \T{..} -> example $ do
66+
_config <- loadConfig' manager
4367
return ()
4468

45-
-- TODO: should throw?
46-
it "works with a blank config file" $ inTempDir $ do
69+
it "works with a blank config file" $ \T{..} -> inTempDir $ do
4770
writeFile (toFilePath stackDotYaml) ""
48-
_config <- loadConfig'
49-
return ()
71+
-- TODO(danburton): more specific test for exception
72+
loadConfig' manager `shouldThrow` anyException
5073

51-
-- it "finds the config file in a parent directory" $ inTempDir $ do
52-
-- writeFile (toFilePath stackDotYaml) "packages: ['child']"
53-
-- parentDir <- getCurrentDirectory >>= parseAbsDir
54-
-- let childDir = "child"
55-
-- createDirectory childDir
56-
-- setCurrentDirectory childDir
57-
-- config <- loadConfig'
58-
-- configDir config `shouldBe` parentDir
74+
it "finds the config file in a parent directory" $ \T{..} -> inTempDir $ do
75+
writeFile (toFilePath stackDotYaml) sampleConfig
76+
parentDir <- getCurrentDirectory >>= parseAbsDir
77+
let childDir = "child"
78+
createDirectory childDir
79+
setCurrentDirectory childDir
80+
LoadConfig{..} <- loadConfig' manager
81+
BuildConfig{..} <- loadBuildConfigRest manager lcLoadBuildConfig
82+
bcRoot `shouldBe` parentDir
5983

60-
-- it "respects the STACK_YAML env variable" $ inTempDir $ do
61-
-- withSystemTempDirectory "config-is-here" $ \dirFilePath -> do
62-
-- dir <- parseAbsDir dirFilePath
63-
-- writeFile (toFilePath (dir </> stackDotYaml)) "packages: ['child']"
64-
-- withEnvVar "STACK_YAML" dirFilePath $ do
65-
-- config <- loadConfig'
66-
-- configDir config `shouldBe` dir
84+
it "respects the STACK_YAML env variable" $ \T{..} -> inTempDir $ do
85+
withSystemTempDirectory "config-is-here" $ \dirFilePath -> do
86+
dir <- parseAbsDir dirFilePath
87+
let stackYamlFp = toFilePath (dir </> stackDotYaml)
88+
writeFile stackYamlFp sampleConfig
89+
withEnvVar "STACK_YAML" stackYamlFp $ do
90+
LoadConfig{..} <- loadConfig' manager
91+
BuildConfig{..} <- loadBuildConfigRest manager lcLoadBuildConfig
92+
bcRoot `shouldBe` dir

‎stack.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -157,4 +157,5 @@ test-suite stack-test
157157
, monad-logger
158158
, http-conduit
159159
, cryptohash
160+
, transformers
160161
default-language: Haskell2010

0 commit comments

Comments
 (0)