diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,9 +8,22 @@ ## Unreleased -## 0.2 +MSAzureAPI.StorageServices.FileService : add listDirectoriesAndFilesC (stream all response pages from listDirectoriesAndFiles) -MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles +## 0.3.0.0 + +add 'conduit' as a dependency + +MSAzureAPI.MachineLearning.Compute +MSAzureAPI.MachineLearning.Jobs +MSAzureAPI.MachineLearning.Usages + +* breaking changes: +MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles now has an extra parameter to support paginated results, as well as a more informative return type. + +## 0.2.0.0 + +MSAzureAPI.StorageServices.FileService : add listDirectoriesAndFiles Add XML support via `xeno` and `xmlbf` to parse `listDirectoriesAndFiles` response bodies diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # ms-azure-api -Haskell client bindings to the [Microsoft Azure API](). +Haskell client bindings to the [Microsoft Azure API](https://learn.microsoft.com/en-us/rest/api/azure/). [![Hackage](https://img.shields.io/hackage/v/ms-azure-api?style=for-the-badge)](https://hackage.haskell.org/package/ms-azure-api) @@ -9,7 +9,7 @@ ## Introduction -This library provides the client interface (under the `MSAzureAPI` namespace). +This library provides the client interface to the MS Azure API (under the `MSAzureAPI` namespace). Authentication can be implemented with the `ms-auth` library. @@ -24,8 +24,9 @@ Some breaking changes might also be introduced as the library matures. -We adhere to a simplified version of the [Package Versioning Policy](https://pvp.haskell.org/): breaking changes are signaled by increasing the major version number (e.g. 0.x -> 1.x ). +We adhere to the [Package Versioning Policy](https://pvp.haskell.org/): major breaking changes or API refactors are signaled by increasing the first major version number (i.e. 0.0.0.0 -> 1.0.0.0 ) whereas less significant ones are indicated by increasing the second one (0.0.0.0 -> 0.1.0.0). +Significant changes in the SDK will be documented in the respective CHANGELOG. ## Copyright diff --git a/ms-azure-api.cabal b/ms-azure-api.cabal --- a/ms-azure-api.cabal +++ b/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,17 +13,22 @@ 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 + MSAzureAPI.MachineLearning.Compute + MSAzureAPI.MachineLearning.Jobs + MSAzureAPI.MachineLearning.Usages MSAzureAPI.StorageServices MSAzureAPI.StorageServices.FileService + other-modules: MSAzureAPI.Internal.Common build-depends: base >= 4.7 && < 5 , aeson , bytestring + , conduit , containers , hoauth2 == 2.6.0 , http-types diff --git a/src/MSAzureAPI.hs b/src/MSAzureAPI.hs new file mode 100644 --- /dev/null +++ b/src/MSAzureAPI.hs @@ -0,0 +1,13 @@ +module MSAzureAPI ( + -- ** HTTP request helpers + tryReq + -- ** Common types + , Collection + , collectionValue + , collectionNextLink + -- *** Location + , Location(..) + , showLocation + ) where + +import MSAzureAPI.Internal.Common diff --git a/src/MSAzureAPI/Internal/Common.hs b/src/MSAzureAPI/Internal/Common.hs --- a/src/MSAzureAPI/Internal/Common.hs +++ b/src/MSAzureAPI/Internal/Common.hs @@ -4,6 +4,7 @@ -- module MSAzureAPI.Internal.Common ( APIPlane(..) + , put , get , getBs , getLbs @@ -12,8 +13,14 @@ , (==:) -- ** Helpers , tryReq - -- ** JSON + -- ** Common types , Collection + , collectionValue + , collectionNextLink + -- *** Location + , Location(..) + , showLocation + -- ** JSON co\/dec , aesonOptions ) where @@ -83,11 +90,23 @@ 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 @@ -123,14 +142,38 @@ (//:) = foldl (/:) --- * aeson +-- * common types +showLocation :: Location -> Text +showLocation = pack . show + +-- | Azure regions +data Location = + LNorthEU -- ^ "North Europe" + | LWestEU -- ^ "West Europe" + deriving (Eq) +instance Show Location where + show = \case + LNorthEU -> "northeu" + LWestEU -> "westeu" + -- | a collection of items with key @value@ +-- +-- NB : results are paginated, and subsequent chunks can be accessed by following the @nextLink@ field data Collection a = Collection { cValue :: [a] + , cNextLink :: Maybe Text -- ^ The URI to fetch the next page of results } deriving (Eq, Show, Generic) instance A.FromJSON a => A.FromJSON (Collection a) where parseJSON = A.genericParseJSON (aesonOptions "c") +-- | Get the collection items +collectionValue :: Collection a -> [a] +collectionValue = cValue +-- | Get the next link for a 'Collection' of paginated results +collectionNextLink :: Collection a -> Maybe Text +collectionNextLink = cNextLink + +-- * aeson -- | drop the prefix and lowercase first character -- diff --git a/src/MSAzureAPI/MachineLearning/Compute.hs b/src/MSAzureAPI/MachineLearning/Compute.hs new file mode 100644 --- /dev/null +++ b/src/MSAzureAPI/MachineLearning/Compute.hs @@ -0,0 +1,80 @@ +-- | +-- +-- 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 sid rgid wsid = MSA.get MSA.APManagement [ + "subscriptions", sid, + "resourceGroups", rgid, + "providers", "Microsoft.MachineLearningServices", + "workspaces", wsid, + "computes" + ] ("api-version" MSA.==: "2023-04-01") + +data Compute = Compute { + cmpId :: Text + , cmpType :: Text + , cmpName :: Text + , cmpLocation :: Text + , cmpProperties :: ComputeProperties + } deriving (Show, Generic) +instance A.FromJSON Compute where + parseJSON = A.genericParseJSON (MSA.aesonOptions "cmp") +instance A.ToJSON Compute where + toEncoding = A.genericToEncoding (MSA.aesonOptions "cmp") + +data ComputeProperties = ComputeProperties { + cmppCreatedOn :: ZonedTime + , cmppModifiedOn :: ZonedTime + , cmppResourceId :: Text + , cmppComputeType :: ComputeType + , cmppProvisioningState :: ProvisioningState + } deriving (Show, Generic) +instance A.ToJSON ComputeProperties where + toEncoding = A.genericToEncoding (MSA.aesonOptions "cmpp") +instance A.FromJSON ComputeProperties where + parseJSON = A.genericParseJSON (MSA.aesonOptions "cmpp") + +data ComputeType = AKS deriving (Eq, Show, Generic) +instance A.ToJSON ComputeType +instance A.FromJSON ComputeType + +data ProvisioningState = Succeeded deriving (Eq, Show, Generic) +instance A.ToJSON ProvisioningState +instance A.FromJSON ProvisioningState diff --git a/src/MSAzureAPI/MachineLearning/Jobs.hs b/src/MSAzureAPI/MachineLearning/Jobs.hs new file mode 100644 --- /dev/null +++ b/src/MSAzureAPI/MachineLearning/Jobs.hs @@ -0,0 +1,67 @@ +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 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) +-- -- 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 qualified MSAzureAPI.Internal.Common as MSA (APIPlane(..), (==:), put, get, getBs, post, getLbs, aesonOptions) + + + +-- | 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 :: (A.FromJSON b) => + Text -- ^ subscription id + -> Text -- ^ res group id + -> Text -- ^ ML workspace id + -> Text -- ^ job id + -> JobBase + -> AccessToken -> Req b +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") + +-- | 01 type +-- +-- 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 + deriving (Eq, Show, Generic) +instance A.ToJSON JobBase where + toEncoding = A.genericToEncoding (MSA.aesonOptions "jb") diff --git a/src/MSAzureAPI/MachineLearning/Usages.hs b/src/MSAzureAPI/MachineLearning/Usages.hs new file mode 100644 --- /dev/null +++ b/src/MSAzureAPI/MachineLearning/Usages.hs @@ -0,0 +1,58 @@ +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 : +-- +-- @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 sid loc = MSA.get MSA.APManagement [ + "subscriptions", sid, + "providers", "Microsoft.MachineLearningServices", + "locations", MSA.showLocation loc, + "usages" + ] ("api-version" MSA.==: "2023-04-01") + +data Usage = Usage { + uCurrentValue :: Int + , uLimit :: Int + , uType :: Text + , uName :: UsageName + } deriving (Eq, Show, Ord, Generic) +instance A.FromJSON Usage where + parseJSON = A.genericParseJSON (MSA.aesonOptions "u") + +data UsageName = UsageName { + unLocalizedValue :: Text + , unValue :: Text + } deriving (Eq, Show, Ord, Generic) +instance A.FromJSON UsageName where + parseJSON = A.genericParseJSON (MSA.aesonOptions "un") + + diff --git a/src/MSAzureAPI/StorageServices.hs b/src/MSAzureAPI/StorageServices.hs --- a/src/MSAzureAPI/StorageServices.hs +++ b/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/src/MSAzureAPI/StorageServices/FileService.hs b/src/MSAzureAPI/StorageServices/FileService.hs --- a/src/MSAzureAPI/StorageServices/FileService.hs +++ b/src/MSAzureAPI/StorageServices/FileService.hs @@ -8,25 +8,31 @@ getFile -- * Directories , listDirectoriesAndFiles + -- , listDirectoriesAndFilesC + , DirItems(..) , DirItem(..) ) where -import Control.Applicative (Alternative(..)) +import Control.Applicative (Alternative(..), optional) +import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import Data.Foldable (asum) import Data.Functor (void) -import Data.Maybe (listToMaybe) +import Data.Maybe (listToMaybe, isJust) 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) +-- conduit +import qualified Data.Conduit as C (ConduitT, yield, runConduitRes) +import Data.Conduit ((.|)) -- hoauth2 -- import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req -import Network.HTTP.Req (Req, Url, Option, Scheme(..), header, (=:)) +import Network.HTTP.Req (HttpException, runReq, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:)) -- text import Data.Text (Text, pack, unpack) import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict) @@ -41,7 +47,7 @@ -- xmlbf import qualified Xmlbf as XB (Parser, runParser, pElement, pText) -import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs) +import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs, tryReq) @@ -113,39 +119,78 @@ domain = acct <> ".file.core.windows.net" pth = [fshare, fpath] --- | list directories and files https://learn.microsoft.com/en-us/rest/api/storageservices/list-directories-and-files#request +-- | list directories and files https://learn.microsoft.com/en-us/rest/api/storageservices/list-directories-and-files#request -- +-- NB the the response list contains at most 5000 elements +-- -- @GET https:\/\/myaccount.file.core.windows.net\/myshare\/mydirectorypath?restype=directory&comp=list@ +-- +-- === Paginated results +-- +-- NB : The Marker, ShareSnapshot, and MaxResults elements are present only if you specify them on the request URI. +-- +-- If the @ element in the @XML body has a value, it means that the result list is not complete. In that case listDirectoriesAndFiles :: Text -- ^ storage account -> Text -- ^ file share -> Text -- ^ directory path, including directories + -> Maybe Text -- ^ next page marker. Use 'Nothing' to retrieve first page of results -> AccessToken - -> Req (Either String [DirItem]) -listDirectoriesAndFiles acct fshare fpath atok = do + -> Req (Either String DirItems) +listDirectoriesAndFiles acct fshare fpath mm atok = do os <- msStorageReqHeaders - bs <- getBs (APData domain) pth (os <> "restype" ==: "directory" <> "comp" ==: "list") atok + bs <- getBs (APData domain) pth (os <> "restype" ==: "directory" <> "comp" ==: "list" <> mMarker mm) atok pure $ parseXML listDirectoriesP bs where domain = acct <> ".file.core.windows.net" pth = [fshare, fpath] + mMarker = \case + Just m -> ("marker" ==: m) + _ -> mempty +-- -- | Repeated call of 'listDirectoriesAndFiles' supporting multi-page results +-- listDirectoriesAndFilesC :: MonadIO m => +-- Text -- ^ storage account +-- -> Text -- ^ file share +-- -> Text -- ^ directory path, including directories +-- -> AccessToken -> C.ConduitT i [DirItem] m () +-- listDirectoriesAndFilesC acct fshare fpath atok = go Nothing +-- where +-- go mm = do +-- eres <- runReq defaultHttpConfig $ tryReq $ listDirectoriesAndFiles acct fshare fpath mm atok +-- case eres of +-- Left _ -> undefined -- FIXME http exception +-- Right xe -> case xe of +-- Left _ -> undefined -- FIXME xml parsing error +-- Right (DirItems xs nMarker) -> do +-- C.yield xs +-- when (isJust nMarker) (go nMarker) + -- | Directory item, as returned by 'listDirectoriesAndFiles' -data DirItem = DIFile {diId :: Text, diName :: Text} - | DIDirectory {diId :: Text, diName :: Text} +data DirItem = DIFile {diId :: Text, diName :: Text} -- ^ file + | DIDirectory {diId :: Text, diName :: Text} -- ^ directory deriving (Show) +-- | Items in the 'listDirectoriesAndFiles' response +data DirItems = DirItems { + disItems :: [DirItem] + , disResponseMarker :: Maybe Text -- ^ marker to request next page of results + } + -- | XML parser for the response body format shown here: https://learn.microsoft.com/en-us/rest/api/storageservices/list-directories-and-files#response-body -listDirectoriesP :: XB.Parser [DirItem] +listDirectoriesP :: XB.Parser DirItems listDirectoriesP = do tag "EnumerationResults" $ do enumResultsIgnore es <- entries - selfClosing "NextMarker" - pure es + nm <- nextMarker + pure (DirItems es nm) enumResultsIgnore :: XB.Parser () -enumResultsIgnore = ignoreList ["Marker", "Prefix", "MaxResults", "DirectoryId"] +enumResultsIgnore = ignoreList ["Marker", "Prefix", "MaxResults", "DirectoryId"] +-- marker :: XB.Parser (Maybe Text) +-- marker = optional (TL.toStrict <$> tag "Marker" anystring) + entries :: XB.Parser [DirItem] entries = tag "Entries" $ many (file <|> directory) @@ -183,8 +228,11 @@ ignoreList :: [Text] -> XB.Parser () ignoreList ns = void $ many (asum (map (`XB.pElement` XB.pText) ns)) -selfClosing :: Text -> XB.Parser () -selfClosing t = tag t (pure ()) +nextMarker :: XB.Parser (Maybe Text) +nextMarker = optional (TL.toStrict <$> tag "NextMarker" anystring) + +-- selfClosing :: Text -> XB.Parser () +-- selfClosing t = tag t (pure ()) anystring :: XB.Parser TL.Text