module MSAzureAPI.MachineLearning.Usages where

import Control.Applicative (Alternative(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (asum)
import Data.Functor (void)
-- import Data.Maybe (listToMaybe)
import GHC.Generics (Generic(..))

-- aeson
import qualified Data.Aeson as A (ToJSON(..), genericToEncoding, FromJSON(..), genericParseJSON, defaultOptions, Options(..), withObject, withText, (.:), (.:?), object, (.=), Key, Value, camelTo2)
-- bytestring
import qualified Data.ByteString as BS (ByteString)
import qualified Data.ByteString.Char8 as BS8 (pack, unpack)
import qualified Data.ByteString.Lazy as LBS (ByteString)
-- hoauth2
-- import Network.OAuth.OAuth2 (OAuth2Token(..))
import Network.OAuth.OAuth2.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (Req, Url, Option, Scheme(..), header, (=:))
-- text
import Data.Text (Text, pack, unpack)
import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)

import qualified MSAzureAPI.Internal.Common as MSA (APIPlane(..), (==:), put, get, getBs, post, getLbs, Collection, Location, showLocation, aesonOptions)

-- | Gets the current usage information as well as limits for AML resources for given subscription and location.
--
-- docs : <https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/usages/list?tabs=HTTP>
--
-- @GET https:\/\/management.azure.com\/subscriptions\/{subscriptionId}\/providers\/Microsoft.MachineLearningServices\/locations\/{location}\/usages?api-version=2023-04-01@
getUsages :: Text -- ^ subscription ID
          -> MSA.Location -- ^ location
          -> AccessToken -> Req (MSA.Collection Usage)
getUsages :: Text -> Location -> AccessToken -> Req (Collection Usage)
getUsages Text
sid Location
loc = forall b.
FromJSON b =>
APIPlane -> [Text] -> Option 'Https -> AccessToken -> Req b
MSA.get APIPlane
MSA.APManagement [
  Text
"subscriptions", Text
sid,
  Text
"providers", Text
"Microsoft.MachineLearningServices",
  Text
"locations", Location -> Text
MSA.showLocation Location
loc,
  Text
"usages"
  ] (Text
"api-version" Text -> Text -> Option 'Https
MSA.==: Text
"2023-04-01")

data Usage = Usage {
  Usage -> Int
uCurrentValue :: Int
  , Usage -> Int
uLimit :: Int
  , Usage -> Text
uType :: Text
  , Usage -> UsageName
uName :: UsageName
                   } deriving (Usage -> Usage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Usage -> Usage -> Bool
$c/= :: Usage -> Usage -> Bool
== :: Usage -> Usage -> Bool
$c== :: Usage -> Usage -> Bool
Eq, Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Usage] -> ShowS
$cshowList :: [Usage] -> ShowS
show :: Usage -> String
$cshow :: Usage -> String
showsPrec :: Int -> Usage -> ShowS
$cshowsPrec :: Int -> Usage -> ShowS
Show, Eq Usage
Usage -> Usage -> Bool
Usage -> Usage -> Ordering
Usage -> Usage -> Usage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Usage -> Usage -> Usage
$cmin :: Usage -> Usage -> Usage
max :: Usage -> Usage -> Usage
$cmax :: Usage -> Usage -> Usage
>= :: Usage -> Usage -> Bool
$c>= :: Usage -> Usage -> Bool
> :: Usage -> Usage -> Bool
$c> :: Usage -> Usage -> Bool
<= :: Usage -> Usage -> Bool
$c<= :: Usage -> Usage -> Bool
< :: Usage -> Usage -> Bool
$c< :: Usage -> Usage -> Bool
compare :: Usage -> Usage -> Ordering
$ccompare :: Usage -> Usage -> Ordering
Ord, forall x. Rep Usage x -> Usage
forall x. Usage -> Rep Usage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Usage x -> Usage
$cfrom :: forall x. Usage -> Rep Usage x
Generic)
instance A.FromJSON Usage where
  parseJSON :: Value -> Parser Usage
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSA.aesonOptions String
"u")

data UsageName = UsageName {
  UsageName -> Text
unLocalizedValue :: Text
  , UsageName -> Text
unValue :: Text
                           } deriving (UsageName -> UsageName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UsageName -> UsageName -> Bool
$c/= :: UsageName -> UsageName -> Bool
== :: UsageName -> UsageName -> Bool
$c== :: UsageName -> UsageName -> Bool
Eq, Int -> UsageName -> ShowS
[UsageName] -> ShowS
UsageName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UsageName] -> ShowS
$cshowList :: [UsageName] -> ShowS
show :: UsageName -> String
$cshow :: UsageName -> String
showsPrec :: Int -> UsageName -> ShowS
$cshowsPrec :: Int -> UsageName -> ShowS
Show, Eq UsageName
UsageName -> UsageName -> Bool
UsageName -> UsageName -> Ordering
UsageName -> UsageName -> UsageName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UsageName -> UsageName -> UsageName
$cmin :: UsageName -> UsageName -> UsageName
max :: UsageName -> UsageName -> UsageName
$cmax :: UsageName -> UsageName -> UsageName
>= :: UsageName -> UsageName -> Bool
$c>= :: UsageName -> UsageName -> Bool
> :: UsageName -> UsageName -> Bool
$c> :: UsageName -> UsageName -> Bool
<= :: UsageName -> UsageName -> Bool
$c<= :: UsageName -> UsageName -> Bool
< :: UsageName -> UsageName -> Bool
$c< :: UsageName -> UsageName -> Bool
compare :: UsageName -> UsageName -> Ordering
$ccompare :: UsageName -> UsageName -> Ordering
Ord, forall x. Rep UsageName x -> UsageName
forall x. UsageName -> Rep UsageName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UsageName x -> UsageName
$cfrom :: forall x. UsageName -> Rep UsageName x
Generic)
instance A.FromJSON UsageName where
  parseJSON :: Value -> Parser UsageName
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSA.aesonOptions String
"un")