-- |
--
-- auth: needs @user_impersonation@ scope
module MSAzureAPI.MachineLearning.Compute 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.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (Req, Url, Option, Scheme(..))
-- text
import Data.Text (Text, pack, unpack)
import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)
-- time
import Data.Time (UTCTime, getCurrentTime)
import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale)
import Data.Time.LocalTime (ZonedTime, getZonedTime)

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

-- | list computes in a workspace
--
-- docs : https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/compute/list?tabs=HTTP
--
-- @GET https:\/\/management.azure.com\/subscriptions\/{subscriptionId}\/resourceGroups\/{resourceGroupName}\/providers\/Microsoft.MachineLearningServices\/workspaces\/{workspaceName}\/computes?api-version=2023-04-01@
listComputes :: Text -- ^ subscription id
             -> Text -- ^ res group id
             -> Text -- ^ ML workspace id
             -> AccessToken -> Req (MSA.Collection Compute)
listComputes :: Text -> Text -> Text -> AccessToken -> Req (Collection Compute)
listComputes Text
sid Text
rgid Text
wsid = forall b.
FromJSON b =>
APIPlane -> [Text] -> Option 'Https -> AccessToken -> Req b
MSA.get APIPlane
MSA.APManagement [
  Text
"subscriptions", Text
sid,
    Text
"resourceGroups", Text
rgid,
    Text
"providers", Text
"Microsoft.MachineLearningServices",
    Text
"workspaces", Text
wsid,
    Text
"computes"
  ] (Text
"api-version" Text -> Text -> Option 'Https
MSA.==: Text
"2023-04-01")

data Compute = Compute {
  Compute -> Text
cmpId :: Text
  , Compute -> Text
cmpType :: Text
  , Compute -> Text
cmpName :: Text
  , Compute -> Text
cmpLocation :: Text
  , Compute -> ComputeProperties
cmpProperties :: ComputeProperties
                       } deriving (Int -> Compute -> ShowS
[Compute] -> ShowS
Compute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Compute] -> ShowS
$cshowList :: [Compute] -> ShowS
show :: Compute -> String
$cshow :: Compute -> String
showsPrec :: Int -> Compute -> ShowS
$cshowsPrec :: Int -> Compute -> ShowS
Show, forall x. Rep Compute x -> Compute
forall x. Compute -> Rep Compute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Compute x -> Compute
$cfrom :: forall x. Compute -> Rep Compute x
Generic)
instance A.FromJSON Compute where
  parseJSON :: Value -> Parser Compute
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSA.aesonOptions String
"cmp")
instance A.ToJSON Compute where
  toEncoding :: Compute -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding (String -> Options
MSA.aesonOptions String
"cmp")

data ComputeProperties = ComputeProperties {
  ComputeProperties -> ZonedTime
cmppCreatedOn :: ZonedTime
  , ComputeProperties -> ZonedTime
cmppModifiedOn :: ZonedTime
  , ComputeProperties -> Text
cmppResourceId :: Text
  , ComputeProperties -> ComputeType
cmppComputeType :: ComputeType
  , ComputeProperties -> ProvisioningState
cmppProvisioningState :: ProvisioningState
                                           } deriving (Int -> ComputeProperties -> ShowS
[ComputeProperties] -> ShowS
ComputeProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputeProperties] -> ShowS
$cshowList :: [ComputeProperties] -> ShowS
show :: ComputeProperties -> String
$cshow :: ComputeProperties -> String
showsPrec :: Int -> ComputeProperties -> ShowS
$cshowsPrec :: Int -> ComputeProperties -> ShowS
Show, forall x. Rep ComputeProperties x -> ComputeProperties
forall x. ComputeProperties -> Rep ComputeProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComputeProperties x -> ComputeProperties
$cfrom :: forall x. ComputeProperties -> Rep ComputeProperties x
Generic)
instance A.ToJSON ComputeProperties where
  toEncoding :: ComputeProperties -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding (String -> Options
MSA.aesonOptions String
"cmpp")
instance A.FromJSON ComputeProperties where
  parseJSON :: Value -> Parser ComputeProperties
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSA.aesonOptions String
"cmpp")

data ComputeType = AKS deriving (ComputeType -> ComputeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComputeType -> ComputeType -> Bool
$c/= :: ComputeType -> ComputeType -> Bool
== :: ComputeType -> ComputeType -> Bool
$c== :: ComputeType -> ComputeType -> Bool
Eq, Int -> ComputeType -> ShowS
[ComputeType] -> ShowS
ComputeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComputeType] -> ShowS
$cshowList :: [ComputeType] -> ShowS
show :: ComputeType -> String
$cshow :: ComputeType -> String
showsPrec :: Int -> ComputeType -> ShowS
$cshowsPrec :: Int -> ComputeType -> ShowS
Show, forall x. Rep ComputeType x -> ComputeType
forall x. ComputeType -> Rep ComputeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComputeType x -> ComputeType
$cfrom :: forall x. ComputeType -> Rep ComputeType x
Generic)
instance A.ToJSON ComputeType
instance A.FromJSON ComputeType

data ProvisioningState = Succeeded deriving (ProvisioningState -> ProvisioningState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProvisioningState -> ProvisioningState -> Bool
$c/= :: ProvisioningState -> ProvisioningState -> Bool
== :: ProvisioningState -> ProvisioningState -> Bool
$c== :: ProvisioningState -> ProvisioningState -> Bool
Eq, Int -> ProvisioningState -> ShowS
[ProvisioningState] -> ShowS
ProvisioningState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProvisioningState] -> ShowS
$cshowList :: [ProvisioningState] -> ShowS
show :: ProvisioningState -> String
$cshow :: ProvisioningState -> String
showsPrec :: Int -> ProvisioningState -> ShowS
$cshowsPrec :: Int -> ProvisioningState -> ShowS
Show, forall x. Rep ProvisioningState x -> ProvisioningState
forall x. ProvisioningState -> Rep ProvisioningState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProvisioningState x -> ProvisioningState
$cfrom :: forall x. ProvisioningState -> Rep ProvisioningState x
Generic)
instance A.ToJSON ProvisioningState
instance A.FromJSON ProvisioningState