clckwrks 0.25.5 → 0.26.0

raw patch · 5 files changed

+85/−9 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Clckwrks/Acid.hs +38/−3
• Clckwrks/Admin/EditSettings.hs +37/−3
• Clckwrks/Monad.hs +1/−0
• Clckwrks/Server.hs +7/−1
• clckwrks.cabal +2/−2

@@ -16,6 +16,7 @@ import Data.Acid.Local             (openLocalStateFrom, createCheckpointAndClose) #if MIN_VERSION_acid_state (0,16,0) import Data.Acid.Remote            (acidServerSockAddr, skipAuthenticationCheck)+import Data.Int                    (Int64) import Network.Socket              (SockAddr(SockAddrUnix)) #else import Data.Acid.Remote            (acidServer, skipAuthenticationCheck)@@ -60,9 +61,30 @@     type MigrateFrom CoreState_1 = CoreState_v0     migrate (CoreState_v0 ua rr) = CoreState_1 Nothing ua rr Nothing + -- | 'CoreState' holds some values that are required by the core -- itself, or which are useful enough to be shared with numerous -- plugins/themes.+data CoreState_2 = CoreState_2+    { _coreSiteName_2       :: Maybe Text+    , _coreUACCT_2          :: Maybe UACCT  -- ^ Google Account UAACT+    , _coreRootRedirect_2   :: Maybe Text+    , _coreLoginRedirect_2  :: Maybe Text+    , _coreFromAddress_2    :: Maybe SimpleAddress+    , _coreReplyToAddress_2 :: Maybe SimpleAddress+    , _coreSendmailPath_2   :: Maybe FilePath+    , _coreEnableOpenId_2   :: Bool -- ^ allow OpenId authentication+    }+    deriving (Eq, Data, Typeable, Show)+$(deriveSafeCopy 2 'extension ''CoreState_2)++instance Migrate CoreState_2 where+    type MigrateFrom CoreState_2 = CoreState_1+    migrate (CoreState_1 sn ua rr lr) = CoreState_2 sn ua rr lr Nothing Nothing Nothing True++-- | 'CoreState' holds some values that are required by the core+-- itself, or which are useful enough to be shared with numerous+-- plugins/themes. data CoreState = CoreState     { _coreSiteName       :: Maybe Text     , _coreUACCT          :: Maybe UACCT  -- ^ Google Account UAACT@@ -72,14 +94,16 @@     , _coreReplyToAddress :: Maybe SimpleAddress     , _coreSendmailPath   :: Maybe FilePath     , _coreEnableOpenId   :: Bool -- ^ allow OpenId authentication+    , _coreBodyPolicy     :: (FilePath, Int64, Int64, Int64) -- ^ (temp directory for uploads, maxDisk, maxRAM, maxHeader)     }     deriving (Eq, Data, Typeable, Show)-$(deriveSafeCopy 2 'extension ''CoreState)+$(deriveSafeCopy 3 'extension ''CoreState)  makeLenses ''CoreState+ instance Migrate CoreState where-    type MigrateFrom CoreState = CoreState_1-    migrate (CoreState_1 sn ua rr lr) = CoreState sn ua rr lr Nothing Nothing Nothing True+    type MigrateFrom CoreState = CoreState_2+    migrate (CoreState_2 sn ua rr lr fa rta smp eo) = CoreState sn ua rr lr fa rta smp eo ("/tmp/", (10 * 10^6), (1 * 10^6), (1 * 10^6))  initialCoreState :: CoreState initialCoreState = CoreState@@ -91,6 +115,7 @@     , _coreReplyToAddress = Nothing     , _coreSendmailPath   = Nothing     , _coreEnableOpenId   = True+    , _coreBodyPolicy     = ("/tmp/", (10 * 10^6), (1 * 10^6), (1 * 10^6))     }  -- | get the site name@@ -117,6 +142,14 @@ setRootRedirect :: Maybe Text -> Update CoreState () setRootRedirect path = coreRootRedirect .= path +-- | get the 'BodyPolicy' data for requests which can have bodies+getBodyPolicy :: Query CoreState (FilePath, Int64, Int64, Int64)+getBodyPolicy = view coreBodyPolicy++-- | set the 'BodyPolicy' data for requests which can have bodies+setBodyPolicy :: (FilePath, Int64, Int64, Int64) -> Update CoreState ()+setBodyPolicy bp = coreBodyPolicy .= bp+ -- | get the path that we should redirect to after login getLoginRedirect :: Query CoreState (Maybe Text) getLoginRedirect = view coreLoginRedirect@@ -172,6 +205,8 @@   , 'setRootRedirect   , 'getLoginRedirect   , 'setLoginRedirect+  , 'getBodyPolicy+  , 'setBodyPolicy   , 'getSiteName   , 'setSiteName   , 'getFromAddress

@@ -2,7 +2,7 @@ {-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.Admin.EditSettings where -import Clckwrks+import Clckwrks                  hiding (transform) import Clckwrks.Acid             (GetUACCT(..), SetUACCT(..), coreSiteName, coreUACCT, coreRootRedirect, coreLoginRedirect) import Clckwrks.Admin.Template   (template) import Control.Lens              ((&), (.~))@@ -14,6 +14,7 @@ import HSP.Google.Analytics      (UACCT(..)) import HSP.XMLGenerator import HSP.XML                   (fromStringLit)+import Numeric                   (readDec) import Text.Reform import Text.Reform.Happstack import Text.Reform.HSP.Text@@ -52,9 +53,41 @@        <*> (divControlGroup $              (labelText "after login redirect to"               `setAttrs` [("class":="control-label") :: Attr Text Text]) ++>              (divControls (inputText (fromMaybe mempty _coreLoginRedirect)) `transformEither` toMaybe))-         <*+       <*> bodyPolicyForm+       <*         (divControlGroup $ divControls $ inputSubmit "Update" `setAttrs` [("class" := "btn") :: Attr Text Text])     where+      bodyPolicyForm =+        let (tmpPath, mDisk, mRam, mHeader) = _coreBodyPolicy in+        (,,,) <$> (divControlGroup $+                   (labelText "temporary directory for uploads" `setAttrs` [("class":="control-label") :: Attr Text Text]) ++>+                   (divControls (inputText (T.pack tmpPath)) `transformEitherM` toFilePath))+              <*> (divControlGroup $+                   (labelText "maximum size for file uploads" `setAttrs` [("class":="control-label") :: Attr Text Text]) ++>+                   (divControls (inputText (T.pack $ show $ mDisk)) `transform` (decimalText InvalidDecimal)))+              <*> (divControlGroup $+                   (labelText "maximum size for non-file values" `setAttrs` [("class":="control-label") :: Attr Text Text]) ++>+                   (divControls (inputText (T.pack $ show $ mRam)) `transform` (decimalText InvalidDecimal)))+              <*> (divControlGroup $+                   (labelText "maximum size for overhead of headers in multipart/form-data" `setAttrs` [("class":="control-label") :: Attr Text Text]) ++>+                   (divControls (inputText (T.pack $ show $ mHeader)) `transform` (decimalText InvalidDecimal)))+++      -- | read an unsigned number in decimal notation+      decimalText :: (Monad m, Eq i, Num i) =>+                 (Text -> error) -- ^ create an error message ('String' is the value that did not parse)+              -> Proof m error Decimal Text i+      decimalText mkError = Proof Decimal (return . toDecimal)+        where+          toDecimal txt =+            case readDec (T.unpack txt) of+              [(d,[])] -> (Right d)+              _        -> (Left $ mkError txt)++      -- | FIXME: should perhaps check that the path exists and is writable?+      toFilePath :: (MonadIO m) => Text -> m (Either ClckFormError FilePath)+      toFilePath t = pure $ Right (T.unpack t)+       divHorizontal   = mapView (\xml -> [<div class="form-horizontal"><% xml %></div>])       divControlGroup = mapView (\xml -> [<div class="control-group"><% xml %></div>])       divControls     = mapView (\xml -> [<div class="controls"><% xml %></div>])@@ -72,11 +105,12 @@              then Right $ Nothing              else Right $ Just txt -      modifyCoreState sn ua rr lr =+      modifyCoreState sn ua rr lr bp =         c & coreSiteName      .~ sn           & coreUACCT         .~ ua           & coreRootRedirect  .~ rr           & coreLoginRedirect .~ lr+          & coreBodyPolicy    .~ bp  {- editUACCTForm :: Maybe UACCT -> ClckForm ClckURL (Maybe UACCT)

@@ -307,6 +307,7 @@ data ClckFormError     = ClckCFE (CommonFormError [Input])     | EmptyUsername+    | InvalidDecimal T.Text       deriving (Show)  instance FormError ClckFormError where

@@ -24,7 +24,10 @@ import qualified Data.Text          as Text import qualified Data.UUID.Types    as UUID import Happstack.Server.FileServe.BuildingBlocks (guessContentTypeM, isSafePath, serveFile)+import Happstack.Server.Internal.Types (canHaveBody)+import Happstack.Server.Monads      (askRq) import Happstack.Server.SimpleHTTPS (TLSConf(..), nullTLSConf, simpleHTTPS)+import Happstack.Server.Types       (Request(rqMethod)) import System.FilePath              ((</>), makeRelative, splitDirectories) import Web.Routes.Happstack         (implSite) import Web.Plugins.Core             (Plugins, withPlugins, getPluginRouteFn, getPostHooks, serve)@@ -84,7 +87,10 @@       handlers :: ClckwrksConfig -> ClckState -> ServerPart Response       handlers cc clckState =        do forceCanonicalHost-          decodeBody (defaultBodyPolicy "/tmp/" (10 * 10^6)  (1 * 10^6)  (1 * 10^6))+          req <- askRq+          when (canHaveBody (rqMethod req)) $+            do (p, mDisk, mRam, mHeader) <- query' (acidCore $ acidState clckState) GetBodyPolicy+               decodeBody (defaultBodyPolicy p mDisk mRam mHeader)           requestInit clckState           msum $             [ jsHandlers cc

@@ -1,5 +1,5 @@ Name:                clckwrks-Version:             0.25.5+Version:             0.26.0 Synopsis:            A secure, reliable content management system (CMS) and blogging platform Description:         clckwrks (pronounced, clockworks) aims to compete                      directly with popular PHP-based blogging and CMS@@ -21,7 +21,7 @@ Category:            Clckwrks Build-type:          Simple Cabal-version:       1.18-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.6.3, GHC == 8.8.1+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.6.3, GHC == 8.8.3, GHC == 8.10.1 Data-Files:            static/admin.css