adding AML Jobs

ms-azure-api/ms-azure-api.cabal

@@ -1,5 +1,5 @@
 name:                ms-azure-api
-version:             0.2.0.1
+version:             0.3.0.0
 synopsis:            Microsoft Azure API
 description:         Bindings to the Microsoft Azure API
 homepage:            https://github.com/unfoldml/ms-graph-api
@@ -13,14 +13,15 @@ build-type:          Simple
 extra-source-files:  README.md
                      CHANGELOG.md
 cabal-version:       >=1.10
-tested-with:         GHC == 7.10.2
+tested-with:         GHC == 9.2.8
 
 library
   default-language:    Haskell2010
   hs-source-dirs:      src
-  exposed-modules:     MSAzureAPI.Internal.Common
+  exposed-modules:     MSAzureAPI.MachineLearning.Jobs
                        MSAzureAPI.StorageServices
                        MSAzureAPI.StorageServices.FileService
+  other-modules:       MSAzureAPI.Internal.Common
   build-depends:       base >= 4.7 && < 5
                      , aeson
                      , bytestring

ms-azure-api/src/MSAzureAPI/Internal/Common.hs

@@ -4,6 +4,7 @@
 --
 module MSAzureAPI.Internal.Common (
   APIPlane(..)
+  , put
   , get
   , getBs
   , getLbs
@@ -83,11 +84,23 @@ tryReq = try
 data APIPlane = APManagement -- ^ Management plane (@management.azure.com@ endpoints)
               | APData Text -- ^ Data plane e.g. FileREST API
 
+
+-- | @PUT@
+put :: (A.FromJSON b, A.ToJSON a) =>
+       APIPlane
+    -> [Text] -- ^ URI path segments
+    -> Option 'Https -- ^ request parameters etc.
+    -> a -> AccessToken -> Req b
+put apiplane paths params bdy tok = responseBody <$> req POST url (ReqBodyJson bdy) jsonResponse opts
+  where
+    opts = auth <> params
+    (url, auth) = msAzureReqConfig apiplane paths tok
+
 -- | @POST@
 post :: (A.FromJSON b, A.ToJSON a) =>
         APIPlane
      -> [Text] -- ^ URI path segments
-     -> Option 'Https
+     -> Option 'Https -- ^ request parameters etc.
      -> a -- ^ request body
      -> AccessToken -> Req b
 post apiplane paths params bdy tok = responseBody <$> req POST url (ReqBodyJson bdy) jsonResponse opts

ms-azure-api/src/MSAzureAPI/MachineLearning/Jobs.hs

@@ -0,0 +1,49 @@
+module MSAzureAPI.MachineLearning.Jobs where
+
+import Control.Applicative (Alternative(..))
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.Foldable (asum)
+import Data.Functor (void)
+import Data.Maybe (listToMaybe)
+import qualified Text.ParserCombinators.ReadP as RP (ReadP, readP_to_S, choice, many, between, char, string, satisfy)
+
+-- 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)
+-- time
+import Data.Time (UTCTime, getCurrentTime)
+import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale)
+import Data.Time.LocalTime (getZonedTime)
+-- xeno
+import qualified Xeno.DOM.Robust as X (Node, Content(..), name, contents, children)
+-- xmlbf-xeno
+import qualified Xmlbf.Xeno as XB (fromRawXml)
+-- xmlbf
+import qualified Xmlbf as XB (Parser, runParser, pElement, pText)
+
+import MSAzureAPI.Internal.Common (APIPlane(..), (==:), put, get, getBs, post, getLbs)
+
+
+-- | create a job
+--
+-- docs: <https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/jobs/create-or-update?tabs=HTTP>
+--
+-- @PUT https:\/\/management.azure.com\/subscriptions\/{subscriptionId}\/resourceGroups\/{resourceGroupName}\/providers\/Microsoft.MachineLearningServices\/workspaces\/{workspaceName}\/jobs\/{id}?api-version=2023-04-01@
+
+createJob sid rgid wsid jid =
+  put APManagement ["subscriptions", sid,
+                    "resourceGroups", rgid,
+                    "providers", "Microsoft.MachineLearningServices",
+                    "workspaces", wsid,
+                    "jobs", jid] ("api-version" ==: "2023-04-01")
+
+data JobBase = JB

ms-azure-api/src/MSAzureAPI/StorageServices.hs

@@ -1,11 +1,7 @@
+-- | Storage Services API: https://learn.microsoft.com/en-us/rest/api/storageservices/
+--
+--
+-- Permissions that an Azure AD entity (user or service principal) needs to perform file service operations:
+--
+-- <https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory#permissions-for-calling-data-operations>
 module MSAzureAPI.StorageServices where
-
-{- Permissions that an Azure AD entity (user or service principal) needs to perform file service operations:
-
-
-https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory#permissions-for-calling-data-operations
--}
-
-
-
-

ms-graph-api/src/MSGraphAPI/Internal/Common.hs

@@ -4,15 +4,17 @@
 --
 -- https://learn.microsoft.com/en-us/graph/api/overview?view=graph-rest-1.0&preserve-view=true
 module MSGraphAPI.Internal.Common (
+  -- * PUT
+  put
   -- * GET
-  get
+  , get
   , getLbs
-  -- ** catch HTTP exceptions
-  , getE
+  -- -- ** catch HTTP exceptions
+  -- , getE
   -- * POST
   , post
-    -- ** catch HTTP exceptions
-  , postE
+  --   -- ** catch HTTP exceptions
+  -- , postE
   -- * running requests
   , runReq
   , tryReq
@@ -43,7 +45,7 @@ import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), Refres
 -- modern-uri
 import Text.URI (URI, mkURI)
 -- req
-import Network.HTTP.Req (Req, runReq, HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody)
+import Network.HTTP.Req (Req, runReq, HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), PUT(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody)
 -- text
 import Data.Text (Text, pack, unpack)
 -- unliftio
@@ -59,12 +61,23 @@ tryReq :: Req a -> Req (Either HttpException a)
 tryReq = try
 
 
--- -- GET, POST 
+
+
+
+-- * REST verbs
+
+put :: (A.FromJSON b, A.ToJSON a) =>
+       [Text]
+    -> Option 'Https -> a -> AccessToken -> Req b
+put paths params bdy tok = responseBody <$> req PUT url (ReqBodyJson bdy) jsonResponse opts
+  where
+    opts = auth <> params
+    (url, auth) = msGraphReqConfig tok paths
 
 -- | @POST https:\/\/graph.microsoft.com\/v1.0\/...@
 post :: (A.ToJSON a, A.FromJSON b) =>
         [Text] -- ^ URI path segments
-     -> Option 'Https
+     -> Option 'Https -- ^ request parameters etc.
      -> a -- ^ request body
      -> AccessToken
      -> Req b
@@ -73,28 +86,28 @@ post paths params bdy tok = responseBody <$> req POST url (ReqBodyJson bdy) json
     opts = auth <> params
     (url, auth) = msGraphReqConfig tok paths
 
--- | Like 'post' but catches 'HttpException's to allow pattern matching
-postE :: (A.ToJSON a, A.FromJSON b) =>
-         [Text] -- ^ URI path segments
-      -> Option 'Https -> a -> AccessToken -> Req (Either HttpException b)
-postE paths params bdy tok = tryReq (post paths params bdy tok)
+-- -- | Like 'post' but catches 'HttpException's to allow pattern matching
+-- postE :: (A.ToJSON a, A.FromJSON b) =>
+--          [Text] -- ^ URI path segments
+--       -> Option 'Https -> a -> AccessToken -> Req (Either HttpException b)
+-- postE paths params bdy tok = tryReq (post paths params bdy tok)
 
 -- | @GET https:\/\/graph.microsoft.com\/v1.0\/...@
 get :: A.FromJSON a =>
        [Text] -- ^ URI path segments
-    -> Option 'Https
+    -> Option 'Https -- ^ request parameters etc.
     -> AccessToken
     -> Req a
 get paths params tok = responseBody <$> req GET url NoReqBody jsonResponse opts
   where
     opts = auth <> params
     (url, auth) = msGraphReqConfig tok paths
 
--- | Like 'get' but catches 'HttpException's to allow pattern matching
-getE :: (A.FromJSON a) =>
-        [Text] -- ^ URI path segments
-     -> Option 'Https -> AccessToken -> Req (Either HttpException a)
-getE paths params tok = tryReq (get paths params tok)
+-- -- | Like 'get' but catches 'HttpException's to allow pattern matching
+-- getE :: (A.FromJSON a) =>
+--         [Text] -- ^ URI path segments
+--      -> Option 'Https -> AccessToken -> Req (Either HttpException a)
+-- getE paths params tok = tryReq (get paths params tok)
 
 -- | @GET https:\/\/graph.microsoft.com\/v1.0\/...@
 --