diff --git a/ms-azure-api/ms-azure-api.cabal b/ms-azure-api/ms-azure-api.cabal index 0b527ab..3a6655f 100644 --- a/ms-azure-api/ms-azure-api.cabal +++ b/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 diff --git a/ms-azure-api/src/MSAzureAPI/Internal/Common.hs b/ms-azure-api/src/MSAzureAPI/Internal/Common.hs index b816291..2d031b4 100644 --- a/ms-azure-api/src/MSAzureAPI/Internal/Common.hs +++ b/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 diff --git a/ms-azure-api/src/MSAzureAPI/MachineLearning/Jobs.hs b/ms-azure-api/src/MSAzureAPI/MachineLearning/Jobs.hs new file mode 100644 index 0000000..3093e63 --- /dev/null +++ b/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: +-- +-- @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 diff --git a/ms-azure-api/src/MSAzureAPI/StorageServices.hs b/ms-azure-api/src/MSAzureAPI/StorageServices.hs index ef5dbbc..f83217d 100644 --- a/ms-azure-api/src/MSAzureAPI/StorageServices.hs +++ b/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: +-- +-- 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 --} - - - - diff --git a/ms-graph-api/src/MSGraphAPI/Internal/Common.hs b/ms-graph-api/src/MSGraphAPI/Internal/Common.hs index 5d2c464..07bfa11 100644 --- a/ms-graph-api/src/MSGraphAPI/Internal/Common.hs +++ b/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,16 +86,16 @@ 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 @@ -90,11 +103,11 @@ get paths params tok = responseBody <$> req GET url NoReqBody jsonResponse opts 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\/...@ --