Versionbump: Reordered Settings.hs for Template haskell; stub instances.

src/Network/Minio/Instances.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
+-- SPDX-FileCopyrightText: 2022-2024 Stephan Barth <stephan.barth@ Gregor Kleen <gregor.kleen@ifi.lmu.de>
 --
 -- 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

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
+instance FromJSON SmtpAuthConf where
-  parseJSON = withObject "SmtpConf" $ \o -> do
+  parseJSON = withObject "SmtpAuthConf" $ \o -> do
-    smtpHost <- o .:? "host" .!= ""
+    smtpAuthType <- o .: "type"
-    smtpPort <- o .: "port"
+    smtpAuthUsername <- o .:? "user" .!= ""
-    smtpAuth <- assertM (not . null . smtpAuthUsername) <$> o .:? "auth"
+    smtpAuthPassword <- o .:? "pass" .!= ""
-    smtpSsl <- o .: "ssl"
+    return SmtpAuthConf{..}
-    smtpPool <- o .: "pool"
-    return SmtpConf{..}
 
 deriveFromJSON
   defaultOptions
@@ -558,12 +560,14 @@ deriveFromJSON
     }
   ''SmtpSslMode
 
-instance FromJSON SmtpAuthConf where
+instance FromJSON SmtpConf where
-  parseJSON = withObject "SmtpAuthConf" $ \o -> do
+  parseJSON = withObject "SmtpConf" $ \o -> do
-    smtpAuthType <- o .: "type"
+    smtpHost <- o .:? "host" .!= ""
-    smtpAuthUsername <- o .:? "user" .!= ""
+    smtpPort <- o .: "port"
-    smtpAuthPassword <- o .:? "pass" .!= ""
+    smtpAuth <- assertM (not . null . smtpAuthUsername) <$> o .:? "auth"
-    return SmtpAuthConf{..}
+    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" .!= ""
+    cvAccessKey <- o .:? "access-key" .!= ""
-    connectSecretKey <- o .:? "secret-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