aboutsummaryrefslogtreecommitdiff
path: root/server/test/Thermoprint/ServerSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/test/Thermoprint/ServerSpec.hs')
-rw-r--r--server/test/Thermoprint/ServerSpec.hs6
1 files changed, 3 insertions, 3 deletions
diff --git a/server/test/Thermoprint/ServerSpec.hs b/server/test/Thermoprint/ServerSpec.hs
index 334f785..d1dadba 100644
--- a/server/test/Thermoprint/ServerSpec.hs
+++ b/server/test/Thermoprint/ServerSpec.hs
@@ -85,13 +85,13 @@ setup startup = withSystemTempFile "thermoprint.sqlite" $ \fp h -> hClose h >> d
85 runSqlite = runStderrLoggingT . filterLogger (const (> LevelDebug)) . withSqlitePool (T.pack fp) 1 . runReaderT 85 runSqlite = runStderrLoggingT . filterLogger (const (> LevelDebug)) . withSqlitePool (T.pack fp) 1 . runReaderT
86 86
87 printers = [ ( pure $ S.PM tPM 87 printers = [ ( pure $ S.PM tPM
88 , S.QMConfig ((join . lift $ takeTMVar (manage tManager) <* signalTSem (ran tManager)) >> return 0) (Nat $ liftIO . runIdentityT) 88 , S.QMConfig ((join . lift $ takeTMVar (manage tManager) <* signalTSem (ran tManager)) >> return 0) (NT $ liftIO . runIdentityT)
89 ) 89 )
90 ] 90 ]
91 91
92 tPM :: MonadIO m => Printout -> m (Maybe PrintingError) 92 tPM :: MonadIO m => Printout -> m (Maybe PrintingError)
93 tPM printout = liftIO . atomically $ putTMVar (outputChan tPrinter) printout >> tryTakeTMVar (failSwitch tPrinter) 93 tPM printout = liftIO . atomically $ putTMVar (outputChan tPrinter) printout >> tryTakeTMVar (failSwitch tPrinter)
94 RunningServer <$> forkFinally (S.thermoprintServer False (Nat runSqlite) $ def' `S.withPrinters` printers) (putMVar term) <*> pure term <*> pure startSem <*> pure tPrinter <*> pure tManager 94 RunningServer <$> forkFinally (S.thermoprintServer False (NT runSqlite) $ def' `S.withPrinters` printers) (putMVar term) <*> pure term <*> pure startSem <*> pure tPrinter <*> pure tManager
95 where 95 where
96 def' :: MonadIO m => S.Config m 96 def' :: MonadIO m => S.Config m
97 def' = S.def { S.warpSettings = setBeforeMainLoop (signalQSem startup) $ defaultSettings } 97 def' = S.def { S.warpSettings = setBeforeMainLoop (signalQSem startup) $ defaultSettings }
@@ -158,7 +158,7 @@ spec = withSetup $ do
158 where 158 where
159 Client{..} = mkClient' $ BaseUrl Http "localhost" 3000 "" 159 Client{..} = mkClient' $ BaseUrl Http "localhost" 3000 ""
160 is404 :: ServantError -> Bool 160 is404 :: ServantError -> Bool
161 is404 e@(FailureResponse {}) = statusCode (responseStatus e) == 404 161 is404 (FailureResponse e) = statusCode (responseStatusCode e) == 404
162 is404 _ = False 162 is404 _ = False
163 163
164 164