Fix a bunch of warnings

This commit is contained in:
Tom McLaughlin
2024-06-17 15:40:09 -07:00
committed by thomasjm
parent 2b0ba85e61
commit 47d88d7061
7 changed files with 30 additions and 16 deletions

View File

@@ -199,7 +199,7 @@ test-suite spec
, tls >=1.4.1 , tls >=1.4.1
, typed-process >=0.2 , typed-process >=0.2
, uri-bytestring >=0.3 , uri-bytestring >=0.3
, yaml , yaml >=0.8.4
default-language: Haskell2010 default-language: Haskell2010
if impl(ghc >= 9.6) if impl(ghc >= 9.6)
build-depends: build-depends:

View File

@@ -26,7 +26,7 @@ tests:
- hspec - hspec
- hspec-attoparsec - hspec-attoparsec
- hspec-megaparsec - hspec-megaparsec
- yaml - yaml >= 0.8.4
- file-embed - file-embed
example: example:
main: App.hs main: App.hs

View File

@@ -72,8 +72,7 @@ data GCPGetTokenException = GCPCmdProducedInvalidJSON String
instance Exception GCPGetTokenException instance Exception GCPGetTokenException
getToken :: GCPAuth -> IO (Either GCPGetTokenException Text) getToken :: GCPAuth -> IO (Either GCPGetTokenException Text)
getToken auth@(GCPAuth{..}) = getCurrentToken auth getToken auth@(GCPAuth{}) = getCurrentToken auth >>= maybe (fetchToken auth) (return . Right)
>>= maybe (fetchToken auth) (return . Right)
getCurrentToken :: GCPAuth -> IO (Maybe Text) getCurrentToken :: GCPAuth -> IO (Maybe Text)
getCurrentToken (GCPAuth{..}) = do getCurrentToken (GCPAuth{..}) = do

View File

@@ -7,11 +7,10 @@ import Data.ByteString (ByteString)
import Data.Default.Class (def) import Data.Default.Class (def)
import Data.Either (rights) import Data.Either (rights)
import Data.Either.Combinators (mapLeft) import Data.Either.Combinators (mapLeft)
import Data.Function ((&))
import Data.PEM (pemContent, pemParseBS) import Data.PEM (pemContent, pemParseBS)
import Data.X509 (SignedCertificate, decodeSignedCertificate) import Data.X509 (SignedCertificate, decodeSignedCertificate)
import Data.X509.CertificateStore (CertificateStore, makeCertificateStore) import Data.X509.CertificateStore (CertificateStore, makeCertificateStore)
import Lens.Micro import Lens.Micro ((&), (.~), Lens', lens, set)
import Network.TLS (Credential, credentialLoadX509FromMemory, defaultParamsClient) import Network.TLS (Credential, credentialLoadX509FromMemory, defaultParamsClient)
import System.X509 (getSystemCertificateStore) import System.X509 (getSystemCertificateStore)

View File

@@ -20,13 +20,12 @@ This is a mostly straightforward translation into Haskell, with 'FromJSON' and '
module Kubernetes.Client.KubeConfig where module Kubernetes.Client.KubeConfig where
import Data.Aeson (FromJSON (..), Options, ToJSON (..), import Data.Aeson (FromJSON (..), Options, ToJSON (..),
Value (..), camelTo2, defaultOptions, camelTo2, defaultOptions,
fieldLabelModifier, genericParseJSON, fieldLabelModifier, genericParseJSON,
genericToJSON, object, omitNothingFields, genericToJSON, object, omitNothingFields,
withObject, (.:), (.=)) withObject, (.:), (.=))
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Proxy import Data.Proxy
import Data.Semigroup ((<>))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Typeable import Data.Typeable
@@ -37,6 +36,11 @@ import GHC.TypeLits
import qualified Data.Aeson.Key as A import qualified Data.Aeson.Key as A
#endif #endif
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
camelToWithOverrides :: Char -> Map.Map String String -> Options camelToWithOverrides :: Char -> Map.Map String String -> Options
camelToWithOverrides c overrides = defaultOptions camelToWithOverrides c overrides = defaultOptions
{ fieldLabelModifier = modifier { fieldLabelModifier = modifier

View File

@@ -1,5 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Kubernetes.Client.Watch module Kubernetes.Client.Watch
( WatchEvent ( WatchEvent
, eventType , eventType
@@ -11,14 +13,22 @@ import Control.Monad
import Control.Monad.Trans (lift) import Control.Monad.Trans (lift)
import Data.Aeson import Data.Aeson
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Streaming.Char8 as Q
import qualified Data.Text as T import qualified Data.Text as T
import Kubernetes.OpenAPI.Core
import Kubernetes.OpenAPI.Client import Kubernetes.OpenAPI.Client
import Kubernetes.OpenAPI.Core
import Kubernetes.OpenAPI.MimeTypes import Kubernetes.OpenAPI.MimeTypes
import Kubernetes.OpenAPI.Model (Watch(..)) import Kubernetes.OpenAPI.Model (Watch(..))
import Network.HTTP.Client import Network.HTTP.Client
#if MIN_VERSION_streaming_bytestring(0,1,7)
import qualified Streaming.ByteString.Char8 as Q
type ByteStream = Q.ByteStream
#else
import qualified Data.ByteString.Streaming.Char8 as Q
type ByteStream = Q.ByteString
#endif
data WatchEvent a = WatchEvent data WatchEvent a = WatchEvent
{ _eventType :: T.Text { _eventType :: T.Text
, _eventObject :: a , _eventObject :: a
@@ -68,7 +78,7 @@ dispatchWatch ::
Manager Manager
-> KubernetesClientConfig -> KubernetesClientConfig
-> KubernetesRequest req contentType resp accept -> KubernetesRequest req contentType resp accept
-> (Q.ByteString IO () -> IO a) -> (ByteStream IO () -> IO a)
-> IO a -> IO a
dispatchWatch manager config request apply = do dispatchWatch manager config request apply = do
let watchRequest = applyOptionalParam request (Watch True) let watchRequest = applyOptionalParam request (Watch True)
@@ -78,14 +88,14 @@ dispatchWatch manager config request apply = do
withHTTP :: withHTTP ::
Request Request
-> Manager -> Manager
-> (Response (Q.ByteString IO ()) -> IO a) -> (Response (ByteStream IO ()) -> IO a)
-> IO a -> IO a
withHTTP request manager f = withResponse request manager f' withHTTP request manager f = withResponse request manager f'
where where
f' resp = do f' resp = do
let p = (from . brRead . responseBody) resp let p = (from . brRead . responseBody) resp
f (resp {responseBody = p}) f (resp {responseBody = p})
from :: IO B.ByteString -> Q.ByteString IO () from :: IO B.ByteString -> ByteStream IO ()
from io = go from io = go
where where
go = do go = do

View File

@@ -4,8 +4,8 @@ module Kubernetes.Client.KubeConfigSpec where
import Data.Aeson (decode, encode, parseJSON, import Data.Aeson (decode, encode, parseJSON,
toJSON) toJSON)
import Data.Maybe (fromJust) import Data.Either (fromRight)
import Data.Yaml (decodeFile) import Data.Yaml (decodeFileEither)
import Kubernetes.Client.KubeConfig (AuthInfo (..), Cluster (..), import Kubernetes.Client.KubeConfig (AuthInfo (..), Cluster (..),
Config, Context (..), Config, Context (..),
getAuthInfo, getCluster, getAuthInfo, getCluster,
@@ -15,11 +15,13 @@ import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do
let getConfig :: IO Config let getConfig :: IO Config
getConfig = fromJust <$> decodeFile "test/testdata/kubeconfig.yaml" getConfig = fromRight (error "Couldn't decode config") <$> decodeFileEither "test/testdata/kubeconfig.yaml"
describe "FromJSON and ToJSON instances" $ do describe "FromJSON and ToJSON instances" $ do
it "roundtrips successfully" $ do it "roundtrips successfully" $ do
config <- getConfig config <- getConfig
decode (encode (toJSON config)) `shouldBe` Just config decode (encode (toJSON config)) `shouldBe` Just config
describe "getContext" $ do describe "getContext" $ do
it "returns the correct context" $ do it "returns the correct context" $ do
config <- getConfig config <- getConfig