ms-azure-api 0.3.1.0 → 0.4.0.0

raw patch · 5 files changed

+139/−29 lines, 5 filesdep +http-client-tlsPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client-tls

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• ms-azure-api.cabal +2/−1
• src/MSAzureAPI/Internal/Common.hs +21/−1
• src/MSAzureAPI/MachineLearning/Jobs.hs +104/−22
• src/MSAzureAPI/StorageServices/FileService.hs +7/−5

@@ -8,6 +8,11 @@  ## Unreleased +## 0.4++TLS support++ ## 0.3.1.0  MSAzureAPI.StorageServices.FileService : add listDirectoriesAndFilesC (stream all response pages from listDirectoriesAndFiles)

@@ -1,5 +1,5 @@ name:                ms-azure-api-version:             0.3.1.0+version:             0.4.0.0 synopsis:            Microsoft Azure API description:         Bindings to the Microsoft Azure API homepage:            https://github.com/unfoldml/ms-graph-api@@ -32,6 +32,7 @@                      , containers                      , exceptions >= 0.10.4                      , hoauth2 == 2.6.0+                     , http-client-tls >= 0.3.6.1                      , http-types                      , modern-uri                      , req

@@ -9,6 +9,9 @@   , getBs   , getLbs   , post+  -- * HTTP(S) connections+  , run+  , withTLS   -- ** URL parameters   , (==:)   -- ** Helpers@@ -40,13 +43,15 @@ import qualified Data.ByteString.Char8 as BS8 (pack, unpack) import qualified Data.ByteString.Lazy as LBS (ByteString) import qualified Data.ByteString.Lazy.Char8 as LBS8 (pack, unpack, putStrLn)+-- http-client-tls+import Network.HTTP.Client.TLS (newTlsManager) -- hoauth2 import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error, IdToken(..)) -- 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, HttpConfig(..), HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody) -- text import Data.Text (Text, pack, unpack) -- unliftio@@ -76,6 +81,21 @@   where     opts = auth <> params     (url, auth) = msAzureReqConfig apiplane paths tok++-- | Create a new TLS manager, which should be reused throughout the program+withTLS :: MonadIO m =>+           (HttpConfig -> m b) -- ^ user program+        -> m b+withTLS act = do+  mgr <- newTlsManager+  let+    hc = defaultHttpConfig { httpConfigAltManager = Just mgr }+  act hc++-- | Run a 'Req' computation+run :: MonadIO m =>+       HttpConfig -> Req a -> m (Either HttpException a)+run hc = runReq hc . tryReq   -- | Specialized version of 'try' to 'HttpException's

@@ -1,4 +1,11 @@-module MSAzureAPI.MachineLearning.Jobs where+module MSAzureAPI.MachineLearning.Jobs (+  createJob+  , listJobs+  , JobBaseResource(..)+  , JobBase(..)+  , Status(..)+  , SystemData(..)+                                       ) where  import Control.Applicative (Alternative(..)) import Control.Monad.IO.Class (MonadIO(..))@@ -21,8 +28,8 @@ -- text import Data.Text (Text, pack, unpack) import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)--- -- time--- import Data.Time (UTCTime, getCurrentTime)+-- time+import Data.Time (UTCTime, getCurrentTime) -- import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale) -- import Data.Time.LocalTime (getZonedTime) -- -- xeno@@ -32,36 +39,111 @@ -- xmlbf -- import qualified Xmlbf as XB (Parser, runParser, pElement, pText) -import qualified MSAzureAPI.Internal.Common as MSA (APIPlane(..), (==:), put, get, getBs, post, getLbs, aesonOptions)+import qualified MSAzureAPI.Internal.Common as MSA (APIPlane(..), Collection, (==:), put, get, getBs, post, getLbs, aesonOptions) +-- | List jobs+--+-- @ GET https:\/\/management.azure.com\/subscriptions\/{subscriptionId}\/resourceGroups\/{resourceGroupName}\/providers\/Microsoft.MachineLearningServices\/workspaces\/{workspaceName}\/jobs?api-version=2023-04-01&$skip={$skip}&jobType={jobType}&tag={tag}&listViewType={listViewType}@+listJobs ::+  Text -- ^ subscription id+  -> Text -- ^ res group id+  -> Text -- ^ ML workspace id+  -> AccessToken -> Req (MSA.Collection JobBaseResource)+listJobs sid rgid wsid = MSA.get MSA.APManagement [+    "subscriptions", sid,+    "resourceGroups", rgid,+    "providers", "Microsoft.MachineLearningServices",+    "workspaces", wsid,+    "jobs"+    ] ("api-version" MSA.==: "2023-04-01")  --- | create a job+-- | 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 :: (A.FromJSON b) =>-             Text -- ^ subscription id-          -> Text -- ^ res group id-          -> Text -- ^ ML workspace id-          -> Text -- ^ job id-          -> JobBase-          -> AccessToken -> Req b+createJob ::+  Text -- ^ subscription id+  -> Text -- ^ res group id+  -> Text -- ^ ML workspace id+  -> Text -- ^ job id+  -> JobBase+  -> AccessToken -> Req JobBaseResource createJob sid rgid wsid jid =-  MSA.put MSA.APManagement ["subscriptions", sid,-                    "resourceGroups", rgid,-                    "providers", "Microsoft.MachineLearningServices",-                    "workspaces", wsid,-                    "jobs", jid] ("api-version" MSA.==: "2023-04-JobBase")+  MSA.put MSA.APManagement [+  "subscriptions", sid,+    "resourceGroups", rgid,+    "providers", "Microsoft.MachineLearningServices",+    "workspaces", wsid,+    "jobs", jid] ("api-version" MSA.==: "2023-04-01") --- | 01 type+-- | https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/jobs/create-or-update?tabs=HTTP#jobbaseresource+data JobBaseResource = JobBaseResource {+  jbrId :: Text+  , jbrName :: Text+  , jbrSystemData :: SystemData+  , jbrProperties :: JobBase+                                       } deriving (Eq, Show, Generic)+instance A.FromJSON JobBaseResource where+  parseJSON = A.genericParseJSON (MSA.aesonOptions "jbr")++data SystemData = SystemData {+  sdCreatedAt :: UTCTime+  , sdCreatedBy :: Text+  , srLastModifiedAt :: UTCTime+  , srLastModifiedBy :: Text+                             } deriving (Eq, Show, Generic)+instance A.FromJSON SystemData where+  parseJSON = A.genericParseJSON (MSA.aesonOptions "sd")++-- | JobBase -- -- https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/jobs/create-or-update?tabs=HTTP-data JobBase = JBAutoMLJob -- ^ https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/jobs/list?tabs=HTTP#automljob-             | JBCommandJob-             | JBPipelineJob-             | JBSweepJob+-- data JobBase = JBAutoMLJob {+--   jbStatus :: Status+--   , jbComponentId :: Text+--   , jb+--                            } -- ^ https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/jobs/list?tabs=HTTP#automljob+--              | JBCommandJob {+--   jbStatus :: Status+--                            }+--              | JBPipelineJob {+--   jbStatus :: Status+--                            }+--              | JBSweepJob {+--   jbStatus :: Status+--                            }+data JobBase = JobBase {+    jbStatus :: Status+  , jbComponentId :: Text+  , jbComputeId :: Text+  , jbDescription :: Text+  , jbDisplayName :: Text+  -- , jbInputs :: A.Value -- AutoMLJob doesn't have inputs+  , jbOutputs :: A.Value+  , jbProperties :: A.Value+                       }              deriving (Eq, Show, Generic)+instance A.FromJSON JobBase where+  parseJSON = A.genericParseJSON (MSA.aesonOptions "jb") instance A.ToJSON JobBase where   toEncoding = A.genericToEncoding (MSA.aesonOptions "jb")++data Status = CancelRequested+            | Canceled+            | Completed+            | Failed+            | Finalizing+            | NotResponding+            | NotStarted+            | Paused+            | Preparing+            | Provisioning+            | Queued+            | Running+            | Starting+            | Unknown+            deriving (Eq, Show, Generic)+instance A.FromJSON Status+instance A.ToJSON Status

@@ -37,7 +37,7 @@ -- import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req-import Network.HTTP.Req (HttpException, runReq, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:))+import Network.HTTP.Req (HttpException, runReq, HttpConfig, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:)) -- text import Data.Text (Text, pack, unpack) import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)@@ -52,7 +52,7 @@ -- xmlbf import qualified Xmlbf as XB (Parser, runParser, pElement, pText) -import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs, tryReq)+import MSAzureAPI.Internal.Common (run, APIPlane(..), (==:), get, getBs, post, getLbs, tryReq)   @@ -159,11 +159,13 @@                             Text -- ^ storage account                          -> Text -- ^ file share                          -> Text -- ^ directory path, including directories-                         -> AccessToken -> C.ConduitT i [DirItem] m ()-listDirectoriesAndFilesC acct fshare fpath atok = go Nothing+                         -> HttpConfig+                         -> AccessToken+                         -> C.ConduitT i [DirItem] m ()+listDirectoriesAndFilesC acct fshare fpath hc atok = go Nothing   where     go mm = do-      eres <- runReq defaultHttpConfig $ tryReq $ listDirectoriesAndFiles acct fshare fpath mm atok+      eres <- run hc $ listDirectoriesAndFiles acct fshare fpath mm atok       case eres of         Left e -> throwM $ FSHttpE e         Right xe -> case xe of