diff --git a/haskell-kubernetes.cabal b/haskell-kubernetes.cabal --- a/haskell-kubernetes.cabal +++ b/haskell-kubernetes.cabal @@ -1,5 +1,5 @@ name: haskell-kubernetes -version: 0.3.2 +version: 0.4.0 synopsis: Haskell bindings to the Kubernetes API (via swagger-codegen) description: Please see README.md homepage: https://github.com/soundcloud/haskell-kubernetes @@ -150,15 +150,16 @@ , bytestring >= 0.10 && < 0.11 , containers >= 0.5 && < 0.6 , either >= 4.4 && < 4.5 + , http-api-data >= 0.2 && < 0.3 , http-types == 0.9.* , lens == 4.13.* , network-uri >= 2.6 && < 2.7 , QuickCheck >= 2.8 && < 2.9 , quickcheck-instances >= 0.3 && < 0.4 , scientific >= 0.3 && < 0.4 - , servant >= 0.4 && < 0.5 - , servant-client >= 0.4 && < 0.5 - , servant-server >= 0.4 && < 0.5 + , servant >= 0.7 && < 0.8 + , servant-client >= 0.7 && < 0.8 + , servant-server >= 0.7 && < 0.8 , split >= 0.2 && < 0.3 , text >= 1.2 && < 1.3 , unordered-containers >= 0.2 && < 0.3 @@ -173,22 +174,22 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , either >= 4.4 && < 4.5 - , haskell-kubernetes >= 0.3 && < 0.4 + , haskell-kubernetes >= 0.4 && < 0.5 , network-uri >= 2.6 && < 2.7 , QuickCheck >= 2.8 && < 2.9 - , servant >= 0.4 && < 0.5 - , servant-client >= 0.4 && < 0.5 + , servant >= 0.7 && < 0.8 + , servant-client >= 0.7 && < 0.8 , split >= 0.2 && < 0.3 , transformers >= 0.4 && < 0.5 default-language: Haskell2010 -executable server - hs-source-dirs: server - main-is: Main.hs - ghc-options: -threaded -fcontext-stack=1000 -rtsopts -with-rtsopts=-N - build-depends: base - , haskell-kubernetes >= 0.3 && < 0.4 - , servant-server >= 0.4 && < 0.5 - , servant-mock >= 0.4 && < 0.5 - , warp >= 3.2 && < 3.3 - default-language: Haskell2010 +--executable server + --hs-source-dirs: server + --main-is: Main.hs + --ghc-options: -threaded -fcontext-stack=1000 -rtsopts -with-rtsopts=-N + --build-depends: base + --, haskell-kubernetes >= 0.3 && < 0.4 + --, servant-server >= 0.4 && < 0.5 + --, servant-mock >= 0.4 && < 0.5 + --, warp >= 3.2 && < 3.3 + --default-language: Haskell2010 diff --git a/lib/Kubernetes/Api/ApivApi.hs b/lib/Kubernetes/Api/ApivApi.hs --- a/lib/Kubernetes/Api/ApivApi.hs +++ b/lib/Kubernetes/Api/ApivApi.hs @@ -250,7 +250,6 @@ import Data.Text (Text) import Servant.API import Servant.Client -import Network.URI (URIAuth (..), parseURI) import Kubernetes.Model.V1.ComponentStatusList import Kubernetes.Model.V1.ComponentStatus import Kubernetes.Model.V1.ConfigMapList @@ -356,7 +355,7 @@ :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> QueryParam "path" Text :> Put '[JSON] Text -- connectPutNamespacedPodProxy :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> QueryParam "path" Text :> Post '[JSON] Text -- connectPostNamespacedPodProxy :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> QueryParam "path" Text :> Delete '[JSON] Text -- connectDeleteNamespacedPodProxy - -- :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> QueryParam "path" Text :> Options '[JSON] Text -- connectOptionsNamespacedPodProxy + -- :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> QueryParam "path" Text :> Option '[JSON] Text -- connectOptionsNamespacedPodProxy :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> Capture "path" Text :> QueryParam "path" Text :> Get '[JSON] Text -- connectGetNamespacedPodProxy_0 -- :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> Capture "path" Text :> QueryParam "path" Text :> Head '[JSON] Text -- connectHeadNamespacedPodProxy_0 :<|> "api" :> "v1" :> "namespaces" :> Capture "namespace" Text :> "pods" :> Capture "name" Text :> "proxy" :> Capture "path" Text :> QueryParam "path" Text :> Put '[JSON] Text -- connectPutNamespacedPodProxy_0 @@ -520,25 +519,6 @@ proxyApivApi :: Proxy ApivApi proxyApivApi = Proxy - -serverPath :: String -serverPath = "https://127.0.0.1:8080/" - -parseHostPort :: String -> (String, Int) -parseHostPort path = (h,p) - where - authority = case parseURI path of - Just x -> uriAuthority x - _ -> Nothing - (h, p) = case authority of - Just y -> (uriRegName y, (getPort . uriPort) y) - _ -> ("localhost", 8080) - getPort p' = case (length p') of - 0 -> 80 - _ -> (read . drop 1) p' - -(host, port) = parseHostPort serverPath - getAPIResources :<|> listNamespacedComponentStatus :<|> readNamespacedComponentStatus @@ -766,4 +746,4 @@ :<|> watchSecretList :<|> watchServiceAccountList :<|> watchServiceList - = client proxyApivApi $ BaseUrl Http host port + = client proxyApivApi diff --git a/lib/Kubernetes/Utils.hs b/lib/Kubernetes/Utils.hs --- a/lib/Kubernetes/Utils.hs +++ b/lib/Kubernetes/Utils.hs @@ -19,8 +19,6 @@ import Control.Monad (mzero) import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson as A -import Data.List (intercalate) -import Data.List.Split (splitOn) import Data.Scientific (coefficient, scientific) import qualified Data.Text as T import Data.Text.Read (decimal) @@ -45,21 +43,16 @@ toJSON (IntegerOrText (Left i)) = A.Number (scientific i 0) toJSON (IntegerOrText (Right s)) = A.String s -instance FromText IntegerOrText where - fromText txt = case decimal txt of - Right (i, t) | T.null t -> Just (IntegerOrText (Left i)) - _ -> Just (IntegerOrText (Right txt)) +instance FromHttpApiData IntegerOrText where + parseUrlPiece txt = + case decimal txt of + Right (i, t) | T.null t -> Right (IntegerOrText (Left i)) + _ -> Right (IntegerOrText (Right txt)) -instance ToText IntegerOrText where - toText iot = case iot of +instance ToHttpApiData IntegerOrText where + toUrlPiece iot = case iot of IntegerOrText (Left i) -> T.pack (show i) IntegerOrText (Right t) -> t - -instance FromText [String] where - fromText = Just . splitOn "," . T.unpack - -instance ToText [String] where - toText = T.pack . intercalate "," lkp inputs l = case lookup l inputs of Nothing -> Left $ "label " ++ T.unpack l ++ " not found" diff --git a/server/Main.hs b/server/Main.hs deleted file mode 100644 --- a/server/Main.hs +++ /dev/null @@ -1,20 +0,0 @@ --- This source code is distributed under the terms of a MIT license, --- Copyright (c) 2016-present, SoundCloud Ltd. --- All rights reserved. --- --- This source code is distributed under the terms of a MIT license, --- found in the LICENSE file. - -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} - -module Main where - -import Kubernetes.Apis -import Servant -import Servant.Mock -import qualified Network.Wai.Handler.Warp as Warp - -main :: IO () -main = Warp.run 8080 $ serve api (mock api)