diff --git a/src/Network/Minio/Instances.hs b/src/Network/Minio/Instances.hs index 836b8dfdb..725ecbd27 100644 --- a/src/Network/Minio/Instances.hs +++ b/src/Network/Minio/Instances.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen +-- SPDX-FileCopyrightText: 2022-2024 Stephan Barth -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -15,6 +15,14 @@ import Network.Minio import qualified UnliftIO.Exception as UnliftIO import Control.Monad.Catch + -- fromJSON, withObject, withScientific + -- , (.!=), (.:?) +import Data.Aeson ( + FromJSON(..) + ) +--import Data.Aeson.Types + +import Data.ByteArray instance MonadThrow Minio where throwM = UnliftIO.throwIO @@ -26,3 +34,18 @@ instance MonadMask Minio where mask = UnliftIO.mask uninterruptibleMask = UnliftIO.uninterruptibleMask generalBracket acq rel inner = withUnliftIO $ \UnliftIO{..} -> generalBracket (unliftIO acq) ((unliftIO .) . rel) $ unliftIO . inner + +--deriving instance Generic ScrubbedBytes +--deriving instance FromJSON ScrubbedBytes + +instance FromJSON ScrubbedBytes where + parseJSON = error "instance FromJSON ScrubbedBytes used but not implemented; implementation was neccessary due to version bump but cannot defined directly as intended, as ScrubbedBytes wants to take care that data cannot remain in memory after free, but Aeson does not care on loading. Hence, not implemented right now." + -- do + -- pj <- parseJSON x + -- return $ + +--deriving newtype instance Generic AccessKey +--deriving newtype instance Generic SecretKey + +deriving newtype instance FromJSON AccessKey +deriving newtype instance FromJSON SecretKey diff --git a/src/Settings.hs b/src/Settings.hs index e3fcc6105..07f4584a6 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -252,8 +252,18 @@ data AppSettings = AppSettings , appLegalExternal :: Set LegalExternal - } deriving Show + } + -- removed deriving Show due to no Show instance for Minio.ConnectInfo in version minio-hs-1.7.0 any more (last version with Show instance was 1.6.0) + -- deriving Show +data VerpMode = VerpNone + | Verp { verpPrefix :: Text, verpSeparator :: Char } + deriving (Eq, Show, Read, Generic) + +data ARCConf w = ARCConf + { arccMaximumGhost :: Int + , arccMaximumWeight :: w + } deriving (Eq, Ord, Read, Show, Generic) data JobMode = JobsLocal { jobsAcceptOffload :: Bool } | JobsOffload @@ -268,6 +278,36 @@ data ApprootScope = ApprootUserGenerated | ApprootDefault deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving anyclass (Universe, Finite, Hashable) +data TokenBucketConf = TokenBucketConf + { tokenBucketDepth :: Word64 + , tokenBucketInvRate :: NominalDiffTime + , tokenBucketInitialValue :: Int64 + } deriving (Eq, Ord, Show, Generic) + +data PrewarmCacheConf = PrewarmCacheConf + { precMaximumWeight :: Int + , precStart, precEnd, precInhibit :: NominalDiffTime -- ^ Prewarming cache starts at @t - precStart@ and should be finished by @t - precEnd@; injecting from minio to database is inhibited from @t - precStart@ until @t - precStart + precInhibit@ + , precSteps :: Natural + , precMaxSpeedup :: Rational + } deriving (Eq, Ord, Read, Show, Generic) + +data SettingBotMitigation + = SettingBotMitigationOnlyLoggedInTableSorting + | SettingBotMitigationUnauthorizedFormHoneypots + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) + deriving anyclass (Universe, Finite) + +data LegalExternal = LegalExternal + { externalLanguage :: Lang + , externalImprint :: Text + , externalDataProtection :: Text + , externalTermsOfUse :: Text + , externalPayments :: Text + } + deriving (Eq, Ord, Read, Show, Generic) + + + newtype ServerSessionSettings = ServerSessionSettings { applyServerSessionSettings :: forall a. ServerSession.State a -> ServerSession.State a } @@ -370,6 +410,12 @@ instance FromJSON MemcachedConf where return MemcachedConf{ memcachedConnectInfo = Memcached.ConnectInfo{..}, .. } + +instance FromJSON HaskellNet.PortNumber where + parseJSON = withScientific "PortNumber" $ \sciNum -> case Scientific.toBoundedInteger sciNum of + Just int -> return $ fromIntegral (int :: Word16) + Nothing -> fail "Expected whole number of plausible size to denote port" + instance FromJSON WidgetMemcachedConf where parseJSON v = flip (withObject "WidgetMemcachedConf") v $ \o -> do widgetMemcachedConf <- parseJSON v @@ -391,44 +437,13 @@ data SmtpAuthConf = SmtpAuthConf , smtpAuthPassword :: HaskellNet.Password } deriving (Show) -data TokenBucketConf = TokenBucketConf - { tokenBucketDepth :: Word64 - , tokenBucketInvRate :: NominalDiffTime - , tokenBucketInitialValue :: Int64 - } deriving (Eq, Ord, Show, Generic) - -data VerpMode = VerpNone - | Verp { verpPrefix :: Text, verpSeparator :: Char } - deriving (Eq, Show, Read, Generic) - -data ARCConf w = ARCConf - { arccMaximumGhost :: Int - , arccMaximumWeight :: w - } deriving (Eq, Ord, Read, Show, Generic) - -data PrewarmCacheConf = PrewarmCacheConf - { precMaximumWeight :: Int - , precStart, precEnd, precInhibit :: NominalDiffTime -- ^ Prewarming cache starts at @t - precStart@ and should be finished by @t - precEnd@; injecting from minio to database is inhibited from @t - precStart@ until @t - precStart + precInhibit@ - , precSteps :: Natural - , precMaxSpeedup :: Rational - } deriving (Eq, Ord, Read, Show, Generic) - -data SettingBotMitigation - = SettingBotMitigationOnlyLoggedInTableSorting - | SettingBotMitigationUnauthorizedFormHoneypots - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) - deriving anyclass (Universe, Finite) - -data LegalExternal = LegalExternal - { externalLanguage :: Lang - , externalImprint :: Text - , externalDataProtection :: Text - , externalTermsOfUse :: Text - , externalPayments :: Text - } - deriving (Eq, Ord, Read, Show, Generic) makeLenses_ ''LegalExternal +deriveFromJSON + defaultOptions + { fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel + } + ''ResourcePoolConf nullaryPathPiece ''ApprootScope $ camelToPathPiece' 1 pathPieceJSON ''ApprootScope @@ -497,17 +512,6 @@ instance FromJSON LdapConf where ldapPool <- o .: "pool" return LdapConf{..} -deriveFromJSON - defaultOptions - { fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel - } - ''ResourcePoolConf - -instance FromJSON HaskellNet.PortNumber where - parseJSON = withScientific "PortNumber" $ \sciNum -> case Scientific.toBoundedInteger sciNum of - Just int -> return $ fromIntegral (int :: Word16) - Nothing -> fail "Expected whole number of plausible size to denote port" - deriveFromJSON defaultOptions { constructorTagModifier = unpack . intercalate "-" . Text.splitOn "_" . toLower . pack @@ -542,14 +546,12 @@ instance FromJSON LprConf where lprQueue <- o .: "queue" return LprConf{..} -instance FromJSON SmtpConf where - parseJSON = withObject "SmtpConf" $ \o -> do - smtpHost <- o .:? "host" .!= "" - smtpPort <- o .: "port" - smtpAuth <- assertM (not . null . smtpAuthUsername) <$> o .:? "auth" - smtpSsl <- o .: "ssl" - smtpPool <- o .: "pool" - return SmtpConf{..} +instance FromJSON SmtpAuthConf where + parseJSON = withObject "SmtpAuthConf" $ \o -> do + smtpAuthType <- o .: "type" + smtpAuthUsername <- o .:? "user" .!= "" + smtpAuthPassword <- o .:? "pass" .!= "" + return SmtpAuthConf{..} deriveFromJSON defaultOptions @@ -558,12 +560,14 @@ deriveFromJSON } ''SmtpSslMode -instance FromJSON SmtpAuthConf where - parseJSON = withObject "SmtpAuthConf" $ \o -> do - smtpAuthType <- o .: "type" - smtpAuthUsername <- o .:? "user" .!= "" - smtpAuthPassword <- o .:? "pass" .!= "" - return SmtpAuthConf{..} +instance FromJSON SmtpConf where + parseJSON = withObject "SmtpConf" $ \o -> do + smtpHost <- o .:? "host" .!= "" + smtpPort <- o .: "port" + smtpAuth <- assertM (not . null . smtpAuthUsername) <$> o .:? "auth" + smtpSsl <- o .: "ssl" + smtpPool <- o .: "pool" + return SmtpConf{..} instance FromJSON JwtEncoding where parseJSON v@(String _) = JwsEncoding <$> parseJSON v @@ -582,13 +586,18 @@ instance FromJSON Minio.ConnectInfo where parseJSON v = flip (withObject "ConnectInfo") v $ \o -> do connectHost <- o .:? "host" .!= "" connectPort <- o .: "port" - connectAccessKey <- o .:? "access-key" .!= "" - connectSecretKey <- o .:? "secret-key" .!= "" + cvAccessKey <- o .:? "access-key" .!= "" + cvSecretKey <- o .:? "secret-key" .!= "" + let cvSessionToken = Nothing + let cv = Minio.CredentialValue{..} + let connectCreds = error "Minio.connectCreds was not overwritten by Minio.setCreds before evaluation!" -- Minio.CredsStatic constructor is not exported connectIsSecure <- o .: "is-secure" connectRegion <- o .:? "region" .!= "" connectAutoDiscoverRegion <- o .:? "auto-discover-region" .!= True connectDisableTLSCertValidation <- o .:? "disable-cert-validation" .!= False - return Minio.ConnectInfo{..} + --return Minio.ConnectInfo{..} + let ret = Minio.ConnectInfo{..} + return $ Minio.setCreds cv ret instance FromJSON ServerSessionSettings where