add a bunch of stuff

ms-azure-api/CHANGELOG.md

@@ -8,7 +8,16 @@ and this project adheres to the
 
 ## Unreleased
 
-## 0.2
+## 0.3.0.0
+
+MSAzureAPI.MachineLearning.Compute
+MSAzureAPI.MachineLearning.Jobs
+MSAzureAPI.MachineLearning.Usages
+
+* breaking changes:
+MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles now has an extra parameter to support paginated results
+
+## 0.2.0.0
 
 MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles
 

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

@@ -18,8 +18,10 @@ tested-with:         GHC == 9.2.8
 library
   default-language:    Haskell2010
   hs-source-dirs:      src
-  exposed-modules:     MSAzureAPI.MachineLearning.Compute
+  exposed-modules:     MSAzureAPI
+                       MSAzureAPI.MachineLearning.Compute
                        MSAzureAPI.MachineLearning.Jobs
+                       MSAzureAPI.MachineLearning.Usages
                        MSAzureAPI.StorageServices
                        MSAzureAPI.StorageServices.FileService
   other-modules:       MSAzureAPI.Internal.Common

ms-azure-api/src/MSAzureAPI.hs

@@ -1 +1,13 @@
-module MSAzureAPI where
+module MSAzureAPI (
+    -- ** HTTP request helpers
+  tryReq
+  -- ** Common types
+  , Collection
+  , collectionValue
+  , collectionNextLink
+  -- *** Location
+  , Location(..)
+  , showLocation
+                  ) where
+
+import MSAzureAPI.Internal.Common

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

@@ -13,8 +13,14 @@ module MSAzureAPI.Internal.Common (
   , (==:)
   -- ** Helpers
   , tryReq
-  -- ** JSON
+  -- ** Common types
   , Collection
+  , collectionValue
+  , collectionNextLink
+  -- *** Location
+  , Location(..)
+  , showLocation
+  -- ** JSON co\/dec
   , aesonOptions
   ) where
 
@@ -136,14 +142,38 @@ msAzureReqConfig apiplane uriRest (AccessToken ttok) = (url, os)
 (//:) = 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
 --

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

@@ -1,3 +1,6 @@
+-- |
+--
+-- auth: needs @user_impersonation@ scope
 module MSAzureAPI.MachineLearning.Compute where
 
 import Control.Applicative (Alternative(..))

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

@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)
 -- -- xmlbf-xeno
 -- import qualified Xmlbf.Xeno as XB (fromRawXml)
 -- xmlbf
-import qualified Xmlbf as XB (Parser, runParser, pElement, pText)
+-- import qualified Xmlbf as XB (Parser, runParser, pElement, pText)
 
 import qualified MSAzureAPI.Internal.Common as MSA (APIPlane(..), (==:), put, get, getBs, post, getLbs, aesonOptions)
 
@@ -53,9 +53,9 @@ createJob sid rgid wsid jid =
                     "resourceGroups", rgid,
                     "providers", "Microsoft.MachineLearningServices",
                     "workspaces", wsid,
-                    "jobs", jid] ("api-version" MSA.==: "2023-04-01")
+                    "jobs", jid] ("api-version" MSA.==: "2023-04-JobBase")
 
--- | JobBase type
+-- | 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

ms-azure-api/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 : <https://learn.microsoft.com/en-us/rest/api/azureml/2023-04-01/usages/list?tabs=HTTP>
+--
+-- @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")
+
+

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

@@ -8,10 +8,11 @@ module MSAzureAPI.StorageServices.FileService (
   getFile
   -- * Directories
   , listDirectoriesAndFiles
+  , DirItems(..)
   , DirItem(..)
   ) where
 
-import Control.Applicative (Alternative(..))
+import Control.Applicative (Alternative(..), optional)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Foldable (asum)
 import Data.Functor (void)
@@ -113,38 +114,59 @@ getFile acct fshare fpath atok = do
     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 @<NextMarker> 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
 
 -- | 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 +205,11 @@ properties = tag "Properties" $
 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