saving

ms-auth/ms-auth.cabal

@@ -20,6 +20,7 @@ library
   hs-source-dirs:      src
   exposed-modules:     MSAuth
                        Network.OAuth2.Provider.AzureAD
+
   other-modules:       Network.OAuth2.Provider.AzureAD.SharedKey
                        Network.OAuth.OAuth2
                        Network.OAuth.OAuth2.AuthorizationRequest

ms-auth/src/MSAuth.hs

@@ -25,6 +25,10 @@ module MSAuth (
   , withAADUser
   , Scotty
   , Action
+  -- * OAuth types
+  , OAuth2Token(..), AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error(..), IdToken(..)
   ) where
 
 import Network.OAuth2.Session
+
+import Network.OAuth.OAuth2.Internal (OAuth2Token(..), AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error(..), IdToken(..))

ms-auth/src/Network/OAuth2/Provider/AzureAD/SharedKey.hs

@@ -41,6 +41,7 @@ timeString = f <$> getCurrentTime
 
 xMsDate :: IO (String, String)
 xMsDate = ("x-ms-date", ) <$> timeString
+
 canonicalizeHeaders :: [(String, String)] -> [T.Text]
 canonicalizeHeaders = map canonicalizeHdr . sortOn fst
   where
@@ -50,7 +51,6 @@ data ToSignLite = ToSignLite {
   tslVerb :: T.Text -- ^ REST verb
   , tslContentType :: T.Text -- ^ MIME content type
   , tslCanHeaders :: [(String, String)]
-  -- , tslOwner :: T.Text -- ^ owner of the storage account
   , tslPath :: T.Text -- ^ resource path
   }
 
@@ -62,37 +62,19 @@ ctzMq410TV3wS7upTBcunJTDLEJwMAZuFPfr0mrrA08=
 -}
 
 
--- toSign :: ToSignLite -> String -> String -> IO (T.Text, Option scheme)
--- toSign (ToSignLite v cty hs pth) acct share = do
---   xms@(_, datev) <- xMsDate
---   let
---     hs' = xms : hs
---     dateHeader = header (BS.pack "x-ms-date") (BS.pack datev)
---     -- res = canonicalizedResource o pth
---     res = "/" <> T.pack acct <> "/" <> T.pack share <> "/" <> pth
---     appendNewline x = x <> "\n"
---     str = mconcat (map appendNewline ([ v, "", cty, ""] <> canonicalizeHeaders hs') <> [res])
---   print str
---   pure (str, dateHeader)
-
-
-
-
 signed :: ToSignLite
        -> String -- ^ storage account name
        -> String -- ^ file share
        -> BS.ByteString -- ^ shared key (from Azure portal)
        -> IO (T.Text, Option scheme)
 signed (ToSignLite v cty hs pth) acct share key = do
-  -- (t, dateHeader) <- toSign (ToSignLite v ty hs pth) acct share
-  xms@(_, datev) <- xMsDate
+  xdate@(_, datev) <- xMsDate
   let
-    hs' = xms : hs
+    hs' = canonicalizeHeaders (xdate : hs) -- ^ https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-shared-key#constructing-the-canonicalized-headers-string
     dateHeader = header (BS.pack "x-ms-date") (BS.pack datev)
-    -- res = canonicalizedResource o pth
     res = "/" <> T.pack acct <> "/" <> T.pack share <> "/" <> pth
     appendNewline x = x <> "\n"
-    t = mconcat (map appendNewline ([ v, "", cty, ""] <> canonicalizeHeaders hs') <> [res])
+    t = mconcat (map appendNewline ([ v, "", cty, ""] <> hs') <> [res])
   case B64.decodeBase64 key of
     Left e -> error $ T.unpack e
     Right dkey -> do
@@ -105,7 +87,6 @@ signed (ToSignLite v cty hs pth) acct share key = do
 getTest0 :: String -> IO BsResponse
 getTest0 k = do
   let
-    -- tsl = ToSignLite "GET" "text/plain; charset=UTF-8" [("x-ms-version", "2014-02-14")] "aior/README.md"
     tsl = ToSignLite "GET" "" [("x-ms-version", "2014-02-14")] "aior/README.md"
     acct = "weuflowsightsa"
     share = "irisity-april4-2023-delivery"

ms-azure-api/CHANGELOG.md

@@ -8,15 +8,20 @@ and this project adheres to the
 
 ## Unreleased
 
+get rid of `hoauth` dependency in favor of `ms-auth`.
+
+.CostManagement
+.MachineLearning.OnlineEndpoints
+
 ## 0.6.0.0
 
-MSAzureAPI.BotService
+.BotService
 
 ## 0.5.0.0
 
 ToJSON instance of Location renders the full name e.g. "West Europe"
 
-MSAzureAPI.ServiceBus
+.ServiceBus
 
 add 'http-client' as an explicit dependency
 
@@ -31,22 +36,22 @@ TLS support
 
 ## 0.3.1.0
 
-MSAzureAPI.StorageServices.FileService : add listDirectoriesAndFilesC (stream all response pages from listDirectoriesAndFiles)
+.StorageServices.FileService : add listDirectoriesAndFilesC (stream all response pages from listDirectoriesAndFiles)
 
 ## 0.3.0.0
 
 add 'conduit' as a dependency
 
-MSAzureAPI.MachineLearning.Compute
-MSAzureAPI.MachineLearning.Jobs
-MSAzureAPI.MachineLearning.Usages
+.MachineLearning.Compute
+.MachineLearning.Jobs
+.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.
+.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
+.StorageServices.FileService : add listDirectoriesAndFiles
 
 Add XML support via `xeno` and `xmlbf` to parse `listDirectoriesAndFiles` response bodies
 

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

@@ -1,5 +1,5 @@
 name:                ms-azure-api
-version:             0.6.0.1
+version:             0.7.0.0
 synopsis:            Microsoft Azure API
 description:         Bindings to the Microsoft Azure API
 homepage:            https://github.com/unfoldml/ms-graph-api
@@ -22,6 +22,7 @@ library
                        MSAzureAPI.BotService
                        MSAzureAPI.MachineLearning.Compute
                        MSAzureAPI.MachineLearning.Jobs
+                       MSAzureAPI.MachineLearning.OnlineEndpoints
                        MSAzureAPI.MachineLearning.Usages
                        MSAzureAPI.ServiceBus
                        MSAzureAPI.StorageServices
@@ -33,11 +34,12 @@ library
                      , conduit
                      , containers
                      , exceptions >= 0.10.4
-                     , hoauth2 == 2.6.0
+                     -- , hoauth2 == 2.6.0
                      , http-client
                      , http-client-tls >= 0.3.6.1
                      , http-types
                      , modern-uri
+                     , ms-auth >= 0.5
                      , req
                      , scientific
                      , text

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

@@ -24,8 +24,8 @@ import GHC.Generics (Generic(..))
 
 -- aeson
 import qualified Data.Aeson as A (ToJSON(..), genericToJSON, object, (.=), encode, ToJSONKey(..), FromJSON(..), genericParseJSON, withObject, withText, Value(..))
--- hoauth2
-import Network.OAuth.OAuth2.Internal (AccessToken(..))
+-- ms-auth
+import MSAuth (AccessToken(..))
 
 -- req
 import Network.HTTP.Req (HttpException, runReq, HttpConfig, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:))

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

@@ -0,0 +1,63 @@
+-- |
+--
+-- auth: needs @user_impersonation@ scope
+module MSAzureAPI.CostManagement 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)
+-- ms-auth
+import MSAuth (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.Calendar (Day)
+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)
+
+
+{- generate cost details report https://learn.microsoft.com/en-us/rest/api/cost-management/generate-cost-details-report/create-operation?tabs=HTTP
+-}
+
+-- POST https://management.azure.com/{scope}/providers/Microsoft.CostManagement/generateCostDetailsReport?api-version=2023-08-01
+
+generateCostDetailsReport :: (A.FromJSON b) =>
+                             Text -> CDROptions -> AccessToken -> Req b
+generateCostDetailsReport rid = MSA.post MSA.APManagement [
+  rid
+  , "providers", "Microsoft.CostManagement"
+  , "generateCostDetailsReport"
+  ] ("api-version" MSA.==: "2023-08-01")
+
+data CDROptions = CDROptions {
+  cdrTimePeriod :: CDRTimePeriod
+                       } deriving (Show, Generic)
+instance A.FromJSON CDROptions where
+  parseJSON = A.genericParseJSON (MSA.aesonOptions "cdr")
+instance A.ToJSON CDROptions where
+  toEncoding = A.genericToEncoding (MSA.aesonOptions "cdr")
+
+data CDRTimePeriod = CDRTimePeriod {
+  cdrtpStart :: Day
+  , cdrtpEnd :: Day
+                       } deriving (Show, Generic)
+instance A.FromJSON CDRTimePeriod where
+  parseJSON = A.genericParseJSON (MSA.aesonOptions "cdrtp")
+instance A.ToJSON CDRTimePeriod where
+  toEncoding = A.genericToEncoding (MSA.aesonOptions "cdrtp")

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

@@ -59,11 +59,10 @@ import Network.HTTP.Client (Manager)
 import qualified Network.HTTP.Client as L (RequestBody(..))
 -- 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)
+-- ms-auth
+import MSAuth (OAuth2Token(..), AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error, IdToken(..))
 -- req
 import Network.HTTP.Req (Req, runReq, HttpBody(..), HttpConfig(..), HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), PUT(..), DELETE(..), Url, Scheme(..), urlQ, useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody)
 -- text

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

@@ -16,8 +16,8 @@ import qualified Data.Aeson as A (ToJSON(..), genericToEncoding, FromJSON(..), g
 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(..))
+-- ms-auth
+import MSAuth (AccessToken(..))
 -- req
 import Network.HTTP.Req (Req, Url, Option, Scheme(..))
 -- text
@@ -52,24 +52,40 @@ data Compute = Compute {
   , cmpType :: Text
   , cmpName :: Text
   , cmpLocation :: Text
-  , cmpProperties :: ComputeProperties
+  , cmpProperties :: ComputeInstance
                        } 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
+-- | ComputeInstance https://learn.microsoft.com/en-us/rest/api/azureml/2023-10-01/compute/get?tabs=HTTP#computeinstance
+data ComputeInstance = ComputeInstance {
+  cmpiCreatedOn :: ZonedTime
+  , cmpiModifiedOn :: ZonedTime
+  , cmpiResourceId :: Text
+  , cmpiComputeType :: ComputeType
+  , cmpiProperties :: ComputeInstanceProperties
+  , cmpiProvisioningState :: 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")
+instance A.ToJSON ComputeInstance where
+  toEncoding = A.genericToEncoding (MSA.aesonOptions "cmpi")
+instance A.FromJSON ComputeInstance where
+  parseJSON = A.genericParseJSON (MSA.aesonOptions "cmpi")
+
+data ComputeInstanceProperties = ComputeInstanceProperties {
+  cmpipState :: Text
+                                                           } deriving (Show, Generic)
+instance A.ToJSON ComputeInstanceProperties where
+  toEncoding = A.genericToEncoding (MSA.aesonOptions "cmpip")
+instance A.FromJSON ComputeInstanceProperties where
+  parseJSON = A.genericParseJSON (MSA.aesonOptions "cmpip")
+
+-- data ComputeInstanceState = ComputeInstanceState {
+--   cmpis
+--                                                  } deriving (Show, Generic)
+-- instance A.FromJSON ComputeInstanceState where
+--   parseJSON = A.genericParseJSON (MSA.aesonOptions "cmpis")
 
 data ComputeType = AKS deriving (Eq, Show, Generic)
 instance A.ToJSON ComputeType

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

@@ -20,9 +20,8 @@ import qualified Data.Aeson as A (ToJSON(..), genericToEncoding, FromJSON(..), g
 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(..))
+-- ms-auth
+import MSAuth (AccessToken(..))
 -- req
 import Network.HTTP.Req (Req, Url, Option, Scheme(..), header, (=:))
 -- text

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

@@ -0,0 +1,70 @@
+-- |
+--
+-- auth: needs @user_impersonation@ scope
+module MSAzureAPI.MachineLearning.OnlineEndpoints 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)
+-- ms-auth
+import MSAuth (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 online endpoints
+--
+-- docs : https://learn.microsoft.com/en-us/rest/api/azureml/2023-10-01/online-endpoints/list?tabs=HTTP
+--
+-- @GET https:\/\/management.azure.com\/subscriptions\/{subscriptionId}\/resourceGroups\/{resourceGroupName}\/providers\/Microsoft.MachineLearningServices\/workspaces\/{workspaceName}\/onlineEndpoints?api-version=2023-10-01@
+listOnlineEndpoints :: Text -- ^ subscription id
+             -> Text -- ^ res group id
+             -> Text -- ^ ML workspace id
+             -> AccessToken -> Req (MSA.Collection OnlineEndpoint)
+listOnlineEndpoints sid rgid wsid = MSA.get MSA.APManagement [
+  "subscriptions", sid,
+    "resourceGroups", rgid,
+    "providers", "Microsoft.MachineLearningServices",
+    "workspaces", wsid,
+    "onlineEndpoints"
+  ] ("api-version" MSA.==: "2023-10-01")
+
+data OnlineEndpoint = OnlineEndpoint {
+  oeId :: Text
+  , oeType :: Text
+  , oeName :: Text
+  , oeLocation :: Text
+  , oeProperties :: OnlineEndpointProperties
+                       } deriving (Show, Generic)
+instance A.FromJSON OnlineEndpoint where
+  parseJSON = A.genericParseJSON (MSA.aesonOptions "oe")
+instance A.ToJSON OnlineEndpoint where
+  toEncoding = A.genericToEncoding (MSA.aesonOptions "oe")
+
+
+data OnlineEndpointProperties = OnlineEndpointProperties {
+  oepProperties :: A.Value
+  , oepScoringUri :: Text
+                       } deriving (Show, Generic)
+instance A.FromJSON OnlineEndpointProperties where
+  parseJSON = A.genericParseJSON (MSA.aesonOptions "oep")
+instance A.ToJSON OnlineEndpointProperties where
+  toEncoding = A.genericToEncoding (MSA.aesonOptions "oep")