ms-azure-api 0.4.0.0 → 0.5.0.0

raw patch · 4 files changed

+225/−4 lines, 4 filesdep +http-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• ms-azure-api.cabal +3/−1
• src/MSAzureAPI/Internal/Common.hs +49/−3
• src/MSAzureAPI/ServiceBus.hs +160/−0

@@ -8,6 +8,19 @@  ## Unreleased +## 0.5.0.0++ToJSON instance of Location renders the full name e.g. "West Europe"++MSAzureAPI.ServiceBus++add 'http-client' as an explicit dependency++* breaking changes++Fixed definition of 'put' to use the correct HTTP verb+Add constructor to 'APIPlane' to reflect service bus usage+ ## 0.4  TLS support

@@ -1,5 +1,5 @@ name:                ms-azure-api-version:             0.4.0.0+version:             0.5.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 @@                        MSAzureAPI.MachineLearning.Compute                        MSAzureAPI.MachineLearning.Jobs                        MSAzureAPI.MachineLearning.Usages+                       MSAzureAPI.ServiceBus                        MSAzureAPI.StorageServices                        MSAzureAPI.StorageServices.FileService   other-modules:       MSAzureAPI.Internal.Common@@ -32,6 +33,7 @@                      , containers                      , exceptions >= 0.10.4                      , hoauth2 == 2.6.0+                     , http-client                      , http-client-tls >= 0.3.6.1                      , http-types                      , modern-uri

@@ -4,11 +4,17 @@ -- module MSAzureAPI.Internal.Common (   APIPlane(..)+  -- ** PUT   , put+  -- ** GET   , get   , getBs   , getLbs+  -- ** POST   , post+  , postSBMessage+  -- ** DELETE+  , delete   -- * HTTP(S) connections   , run   , withTLS@@ -23,6 +29,7 @@   -- *** Location   , Location(..)   , showLocation+  , locationDisplayName   -- ** JSON co\/dec   , aesonOptions   ) where@@ -37,12 +44,14 @@ import Data.Char (toLower)  -- aeson-import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON, defaultOptions, Options(..), withObject, withText, (.:), (.:?), object, (.=), Key, Value, camelTo2)+import qualified Data.Aeson as A (ToJSON(..), encode, 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) import qualified Data.ByteString.Lazy.Char8 as LBS8 (pack, unpack, putStrLn)+-- http-client+import qualified Network.HTTP.Client as L (RequestBody(..)) -- http-client-tls import Network.HTTP.Client.TLS (newTlsManager) -- hoauth2@@ -51,7 +60,7 @@ -- modern-uri -- import Text.URI (URI, mkURI) -- req-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)+import Network.HTTP.Req (Req, runReq, HttpBody(..), HttpConfig(..), HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), PUT(..), DELETE(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody) -- text import Data.Text (Text, pack, unpack) -- unliftio@@ -109,6 +118,7 @@ -- https://learn.microsoft.com/en-us/azure/azure-resource-manager/management/control-plane-and-data-plane data APIPlane = APManagement -- ^ Management plane (@management.azure.com@ endpoints)               | APData Text -- ^ Data plane e.g. FileREST API+              | APServiceBus Text -- ^ Data plane for Service Bus. The parameter is the service name   -- | @PUT@@@ -117,11 +127,19 @@     -> [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+put apiplane paths params bdy tok = responseBody <$> req PUT url (ReqBodyJson bdy) jsonResponse opts   where     opts = auth <> params     (url, auth) = msAzureReqConfig apiplane paths tok +-- | @DELETE@+delete :: (A.FromJSON b, A.ToJSON a) =>+          APIPlane -> [Text] -> Option 'Https -> a -> AccessToken -> Req b+delete apiplane paths params bdy tok = responseBody <$> req DELETE url (ReqBodyJson bdy) jsonResponse opts+  where+    opts = auth <> params+    (url, auth) = msAzureReqConfig apiplane paths tok+ -- | @POST@ post :: (A.FromJSON b, A.ToJSON a) =>         APIPlane@@ -134,6 +152,23 @@     opts = auth <> params     (url, auth) = msAzureReqConfig apiplane paths tok +-- | Post a message or batch thereof to the Service Bus+--+-- see example : https://learn.microsoft.com/en-us/rest/api/servicebus/send-message-batch#example+postSBMessage :: (A.FromJSON b, A.ToJSON a) =>+                 Text+              -> [Text]+              -> Option 'Https -> a -> AccessToken -> Req b+postSBMessage servName paths params bdy tok = responseBody <$> req POST url (ReqBodyServiceBusMessage bdy) jsonResponse opts+  where+    opts = auth <> params+    (url, auth) = msAzureReqConfig (APServiceBus servName) paths tok++data ReqBodyServiceBusMessage a = ReqBodyServiceBusMessage a+instance A.ToJSON a => HttpBody (ReqBodyServiceBusMessage a) where+  getRequestBody (ReqBodyServiceBusMessage a) = L.RequestBodyLBS (A.encode a)+  getRequestContentType _ = Just "application/vnd.microsoft.servicebus.json"+ -- | @GET@ get :: (A.FromJSON b) =>        APIPlane@@ -153,6 +188,7 @@     urlBase = case apiplane of       APManagement -> "management.azure.com"       APData ub -> ub+      APServiceBus sn -> sn <> ".servicebus.windows.net"     url = (https urlBase) //: uriRest     os = oAuth2Bearer $ BS8.pack (unpack ttok) @@ -164,6 +200,7 @@  -- * common types +-- | Displays the short name, e.g. "westeu" showLocation :: Location -> Text showLocation = pack . show @@ -176,6 +213,15 @@   show = \case     LNorthEU -> "northeu"     LWestEU -> "westeu"+-- | Renders the full name via 'locationDisplayName'+instance A.ToJSON Location where+  toJSON = A.String . locationDisplayName++-- | Displays the full name, e.g. "West Europe"+locationDisplayName :: Location -> Text+locationDisplayName = \case+  LNorthEU -> "North Europe"+  LWestEU -> "West Europe"  -- | a collection of items with key @value@ --

@@ -0,0 +1,160 @@+{-# LANGUAGE TypeFamilies #-}+module MSAzureAPI.ServiceBus where++import GHC.Exts (IsList(..))+import GHC.Generics (Generic(..))++-- aeson+import qualified Data.Aeson as A (ToJSON(..), genericToJSON, object, (.=), ToJSONKey(..), FromJSON(..), genericParseJSON)+-- containers+import qualified Data.Map as M (Map, singleton, fromList)+-- hoauth2+import Network.OAuth.OAuth2.Internal (AccessToken(..))++-- req+import Network.HTTP.Req (HttpException, runReq, HttpConfig, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:))+-- text+import Data.Text (Text, pack, unpack)+-- time+import Data.Time (UTCTime, getCurrentTime)+import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale)+import Data.Time.LocalTime (getZonedTime)++import MSAzureAPI.Internal.Common (run, APIPlane(..), Location(..), locationDisplayName, (==:), get, getBs, post, postSBMessage, getLbs, put, tryReq, aesonOptions)++-- | Send a message batch to the service bus+--+-- https://learn.microsoft.com/en-us/rest/api/servicebus/send-message-batch#request+sendMessageBatch :: (A.ToJSON a) =>+                    Text -- ^ namespace+                 -> Text -- ^ queue name+                 -> Text -- ^ topic+                 -> Option 'Https+                 -> MessageBatch a+                 -> AccessToken -> Req ()+sendMessageBatch sn qname topic = postSBMessage sn [+  qpt+  , "messages"+  ]+  where+    qpt = qname <> "|" <> topic++newtype MessageBatch a = MessageBatch [a] deriving (Eq, Show)+instance IsList (MessageBatch a) where+  type Item (MessageBatch a) = a+  fromList = MessageBatch+  toList (MessageBatch xs) = xs+instance A.ToJSON a => A.ToJSON (MessageBatch a) where+  toJSON (MessageBatch xs) = A.toJSON $ map (\x -> M.singleton ("Body" :: String) x) xs++-- | Create a service bus topic+--+-- https://learn.microsoft.com/en-us/rest/api/servicebus/controlplane-stable/topics/create-or-update?tabs=HTTP+createTopic ::+  Text -- ^ subscription id+  -> Text -- ^ RG name+  -> Text -- ^ namespace name+  -> Text -- ^ topic name+  -> TopicCreate+  -> AccessToken -> Req ()+createTopic subid rgname nname tname = put APManagement [+  "subscriptions", subid+  , "resourceGroup", rgname+  , "providers", "Microsoft.ServiceBus"+  , "namespaces", nname+  , "topicName", tname+  ] ("api-version" ==: "2021-11-01")++data TopicCreate = TopicCreate {+  tcProperties :: TCProperties+                               } deriving (Eq, Show, Generic)++instance A.ToJSON TopicCreate where+  toJSON = A.genericToJSON (aesonOptions "tc")+data TCProperties = TCProperties {+  tcpEnableBatchedOperations :: Bool -- ^ enable batched operations on the backend+                                 } deriving (Eq, Show, Generic)+instance A.ToJSON TCProperties where+  toJSON = A.genericToJSON (aesonOptions "tcp")++-- | Create a service bus queue using default options+--+-- https://learn.microsoft.com/en-us/rest/api/servicebus/controlplane-stable/queues/create-or-update?tabs=HTTP+createQueue ::+  Text -- ^ subscription id+  -> Text -- ^ RG name+  -> Text -- ^ namespace name+  -> Text -- ^ queue name+  -> AccessToken+  -> Req QueueCreateResponse+createQueue subid rgname nname qname = put APManagement [+    "subscriptions", subid+  , "resourceGroup", rgname+  , "providers", "Microsoft.ServiceBus"+  , "namespaces", nname+  , "queues", qname+  ] ("api-version" ==: "2021-11-01") ()++data QueueCreateResponse = QueueCreateResponse {+  qcrId :: Text+  , qcrProperties :: QCRProperties+                                               } deriving (Eq, Show, Generic)+instance A.FromJSON QueueCreateResponse where+  parseJSON = A.genericParseJSON (aesonOptions "qcr")++data QCRProperties = QCRProperties {+  qcrpMaxMessageSizeInKilobytes :: Int+                                   } deriving (Eq, Show, Generic)+instance A.FromJSON QCRProperties where+  parseJSON = A.genericParseJSON (aesonOptions "qcrp")++-- | Create a service bus namespace+--+-- https://learn.microsoft.com/en-us/rest/api/servicebus/controlplane-stable/namespaces/create-or-update?tabs=HTTP#namespacecreate+createNamespace ::+  Text -- ^ subscription id+  -> Text -- ^ RG name+  -> Text -- ^ namespace name+  -> NameSpaceCreate+  -> AccessToken+  -> Req NameSpaceCreateResponse+createNamespace subid rgname nname = put APManagement [+  "subscriptions", subid+  , "resourceGroup", rgname+  , "providers", "Microsoft.ServiceBus"+  , "namespaces", nname+  ] ("api-version" ==: "2021-11-01")++-- | https://learn.microsoft.com/en-us/rest/api/servicebus/controlplane-stable/namespaces/create-or-update?tabs=HTTP#namespacecreate+data NameSpaceCreate = NameSpaceCreate {+  sku :: Sku+  , location :: Location+                                       } deriving (Eq, Show, Generic)+instance A.ToJSON NameSpaceCreate++data NameSpaceCreateResponse = NameSpaceCreateResponse {+  nscrId :: Text+  , nscrProperties :: NSCRProperties+                                                       } deriving (Eq, Show, Generic)+instance A.FromJSON NameSpaceCreateResponse where+  parseJSON = A.genericParseJSON (aesonOptions "nscr")++data NSCRProperties = NSCRProperties {+  nscrpCreatedAt :: UTCTime+  , nscrpServiceBusEndpoint :: Text+                                     } deriving (Eq, Show, Generic)+instance A.FromJSON NSCRProperties where+  parseJSON = A.genericParseJSON (aesonOptions "nscrp")++data Sku = Sku {+  skuName :: SkuName+               } deriving (Eq, Show)+-- | name and tier are rendered as the same thing+instance A.ToJSON Sku where+  toJSON (Sku n) = A.object [+    "name" A..= n+    , "tier" A..= n+                              ]++data SkuName = Basic | Premium | Standard deriving (Eq, Show, Generic)+instance A.ToJSON SkuName