diff --git a/load/Load.hs b/load/Load.hs index 843127132..fd1c47886 100644 --- a/load/Load.hs +++ b/load/Load.hs @@ -96,7 +96,7 @@ sampleIntegral = sampleN scaleIntegral instance PathPiece DiffTime where toPathPiece = (toPathPiece :: Pico -> Text) . MkFixed . diffTimeToPicoseconds fromPathPiece t = fromPathPiece t <&> \(MkFixed ps :: Pico) -> picosecondsToDiffTime ps - + data LoadSimulation = LoadSheetDownload @@ -214,13 +214,13 @@ runSimulation sim = do delays <- replicateM (fromIntegral p) $ do d <- view $ _2 . _simDelay sampleNDiffTime d - + forConcurrently_ ([1..p] `zip` sort delays) $ \(n, d') -> do begin <- liftIO getCurrentTime dur <- view $ _2 . _simDuration tDuration <- sampleNDiffTime dur - + let MkFixed us = realToFrac d' :: Micro threadDelay $ fromInteger us start <- liftIO getCurrentTime @@ -268,7 +268,7 @@ runSimulation' LoadSheetSubmission = do -- Just formData <- return . getFormData FIDsubmission $ resp ^. responseBody -- Just addButtonData <- return . flip (runFormScraper FIDsubmission) (resp ^. responseBody) $ do -- let btnSel = "button" Scalpel.@: [Scalpel.hasClass "btn-mass-input-add"] - + -- name <- Scalpel.attr "name" btnSel -- value <- Scalpel.attr "value" btnSel -- guard $ value == "add__0__0" @@ -305,7 +305,7 @@ runSimulation' LoadSheetSubmission = do procEnd <- join $ asks runtime print ("proc", procEnd - procStart) - + resp3 <- liftIO . httpRetry $ Session.post session (uriToString id formURI mempty) subData void . evaluate $! resp3 where @@ -328,11 +328,11 @@ runSimulation' LoadSheetSubmission = do -> m () logRetry shouldRetry err status = liftIO . putStrLn . pack $ Retry.defaultLogMsg shouldRetry err status - + -- runSimulation' other = terror $ "Not implemented: " <> tshow other runFormScraper :: FormIdentifier -> Scalpel.Scraper Lazy.ByteString a -> Lazy.ByteString -> Maybe a -runFormScraper fid innerS = fmap join . flip Scalpel.scrapeStringLike $ +runFormScraper fid innerS = fmap join . flip Scalpel.scrapeStringLike $ fmap listToMaybe . Scalpel.chroots "form" $ do fid' <- Scalpel.attr "value" $ "input" Scalpel.@: ["name" Scalpel.@= "form-identifier"] guard $ fid' == encodeUtf8 (fromStrict $ toPathPiece fid) @@ -341,11 +341,11 @@ runFormScraper fid innerS = fmap join . flip Scalpel.scrapeStringLike $ getFormData :: FormIdentifier -> Lazy.ByteString -> Maybe [FormParam] getFormData = flip runFormScraper $ - Scalpel.chroots ("input") $ do + Scalpel.chroots "input" $ do name <- Scalpel.attr "name" Scalpel.anySelector value <- Scalpel.attr "value" Scalpel.anySelector <|> pure "" return $ toStrict name := value - + newLoadSession :: ReaderT SimulationContext IO Session newLoadSession = do @@ -354,7 +354,7 @@ newLoadSession = do let withToken = case loadToken of Nothing -> id Just (Jwt bs) -> (:) (hAuthorization, "Bearer " <> bs) . filter ((/= hAuthorization) . fst) - + liftIO . Session.newSessionControl (Just mempty) $ tlsManagerSettings { managerModifyRequest = \req -> return $ req { requestHeaders = withToken $ requestHeaders req } diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index adbc5df67..bab28d39b 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -192,7 +192,6 @@ import Network.Mail.Mime.Instances as Import import Yesod.Core.Instances as Import () import Data.Aeson.Types.Instances as Import () import Database.Esqueleto.Instances as Import () -import Database.Esqueleto.PostgreSQL.JSON as Import (JSONB(..), unJSONB) import Numeric.Natural.Instances as Import () import Text.Blaze.Instances as Import () import Jose.Jwt.Instances as Import () @@ -272,8 +271,3 @@ import Control.Monad.Trans.RWS (RWST) type MForm m = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m type WeekDay = DayOfWeek - --- TODO: maybe move elsewhere -deriving newtype instance NFData a => NFData (JSONB a) -deriving newtype instance Semigroup a => Semigroup (JSONB a) -deriving newtype instance Monoid a => Monoid (JSONB a) diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs index df9bc1a79..d98422be7 100644 --- a/src/Model/Types/Common.hs +++ b/src/Model/Types/Common.hs @@ -1,7 +1,9 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later +{-# OPTIONS_GHC -fno-warn-orphans #-} + {-| Module: Model.Types.Common Description: Common types used by most @Model.Types.*@-Modules @@ -10,12 +12,13 @@ Types used by multiple other @Model.Types.*@-Modules -} module Model.Types.Common ( module Model.Types.Common + , module JSON ) where import Import.NoModel import qualified Yesod.Auth.Util.PasswordStore as PWStore - +import Database.Esqueleto.PostgreSQL.JSON as JSON (JSONB(..), JSONAccessor(..), unJSONB) type Count = Sum Integer type Points = Centi @@ -68,3 +71,7 @@ type SessionFileReference = Digest SHA3_256 type QualificationName = CI Text type QualificationShorthand = CI Text + +deriving newtype instance NFData a => NFData (JSONB a) +deriving newtype instance Semigroup a => Semigroup (JSONB a) +deriving newtype instance Monoid a => Monoid (JSONB a) diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs index 43c24a761..6a3457783 100644 --- a/src/Model/Types/DateTime.hs +++ b/src/Model/Types/DateTime.hs @@ -29,6 +29,7 @@ import Data.Time.Calendar.WeekDate -- import qualified Text.ParserCombinators.Parsec.Number as ParseNum (nat) import Database.Persist.Sql +import Database.Esqueleto.PostgreSQL.JSON (JSONB(..)) import Web.HttpApiData