{-# 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 :: forall a.
ToJSON a =>
Text
-> Text
-> Text
-> Option 'Https
-> MessageBatch a
-> AccessToken
-> Req ()
sendMessageBatch Text
sn Text
qname Text
topic = forall b a.
(FromJSON b, ToJSON a) =>
Text -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
postSBMessage Text
sn [
  Text
qpt
  , Text
"messages"
  ]
  where
    qpt :: Text
qpt = Text
qname forall a. Semigroup a => a -> a -> a
<> Text
"|" forall a. Semigroup a => a -> a -> a
<> Text
topic

newtype MessageBatch a = MessageBatch [a] deriving (MessageBatch a -> MessageBatch a -> Bool
forall a. Eq a => MessageBatch a -> MessageBatch a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageBatch a -> MessageBatch a -> Bool
$c/= :: forall a. Eq a => MessageBatch a -> MessageBatch a -> Bool
== :: MessageBatch a -> MessageBatch a -> Bool
$c== :: forall a. Eq a => MessageBatch a -> MessageBatch a -> Bool
Eq, Int -> MessageBatch a -> ShowS
forall a. Show a => Int -> MessageBatch a -> ShowS
forall a. Show a => [MessageBatch a] -> ShowS
forall a. Show a => MessageBatch a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageBatch a] -> ShowS
$cshowList :: forall a. Show a => [MessageBatch a] -> ShowS
show :: MessageBatch a -> String
$cshow :: forall a. Show a => MessageBatch a -> String
showsPrec :: Int -> MessageBatch a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MessageBatch a -> ShowS
Show)
instance IsList (MessageBatch a) where
  type Item (MessageBatch a) = a
  fromList :: [Item (MessageBatch a)] -> MessageBatch a
fromList = forall a. [a] -> MessageBatch a
MessageBatch
  toList :: MessageBatch a -> [Item (MessageBatch a)]
toList (MessageBatch [a]
xs) = [a]
xs
instance A.ToJSON a => A.ToJSON (MessageBatch a) where
  toJSON :: MessageBatch a -> Value
toJSON (MessageBatch [a]
xs) = forall a. ToJSON a => a -> Value
A.toJSON forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> forall k a. k -> a -> Map k a
M.singleton (String
"Body" :: String) a
x) [a]
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 :: Text
-> Text -> Text -> Text -> TopicCreate -> AccessToken -> Req ()
createTopic Text
subid Text
rgname Text
nname Text
tname = forall b a.
(FromJSON b, ToJSON a) =>
APIPlane -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
put APIPlane
APManagement [
  Text
"subscriptions", Text
subid
  , Text
"resourceGroup", Text
rgname
  , Text
"providers", Text
"Microsoft.ServiceBus"
  , Text
"namespaces", Text
nname
  , Text
"topicName", Text
tname
  ] (Text
"api-version" Text -> Text -> Option 'Https
==: Text
"2021-11-01")

data TopicCreate = TopicCreate {
  TopicCreate -> TCProperties
tcProperties :: TCProperties
                               } deriving (TopicCreate -> TopicCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopicCreate -> TopicCreate -> Bool
$c/= :: TopicCreate -> TopicCreate -> Bool
== :: TopicCreate -> TopicCreate -> Bool
$c== :: TopicCreate -> TopicCreate -> Bool
Eq, Int -> TopicCreate -> ShowS
[TopicCreate] -> ShowS
TopicCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopicCreate] -> ShowS
$cshowList :: [TopicCreate] -> ShowS
show :: TopicCreate -> String
$cshow :: TopicCreate -> String
showsPrec :: Int -> TopicCreate -> ShowS
$cshowsPrec :: Int -> TopicCreate -> ShowS
Show, forall x. Rep TopicCreate x -> TopicCreate
forall x. TopicCreate -> Rep TopicCreate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopicCreate x -> TopicCreate
$cfrom :: forall x. TopicCreate -> Rep TopicCreate x
Generic)

instance A.ToJSON TopicCreate where
  toJSON :: TopicCreate -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"tc")
data TCProperties = TCProperties {
  TCProperties -> Bool
tcpEnableBatchedOperations :: Bool -- ^ enable batched operations on the backend
                                 } deriving (TCProperties -> TCProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TCProperties -> TCProperties -> Bool
$c/= :: TCProperties -> TCProperties -> Bool
== :: TCProperties -> TCProperties -> Bool
$c== :: TCProperties -> TCProperties -> Bool
Eq, Int -> TCProperties -> ShowS
[TCProperties] -> ShowS
TCProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TCProperties] -> ShowS
$cshowList :: [TCProperties] -> ShowS
show :: TCProperties -> String
$cshow :: TCProperties -> String
showsPrec :: Int -> TCProperties -> ShowS
$cshowsPrec :: Int -> TCProperties -> ShowS
Show, forall x. Rep TCProperties x -> TCProperties
forall x. TCProperties -> Rep TCProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TCProperties x -> TCProperties
$cfrom :: forall x. TCProperties -> Rep TCProperties x
Generic)
instance A.ToJSON TCProperties where
  toJSON :: TCProperties -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"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 :: Text
-> Text -> Text -> Text -> AccessToken -> Req QueueCreateResponse
createQueue Text
subid Text
rgname Text
nname Text
qname = forall b a.
(FromJSON b, ToJSON a) =>
APIPlane -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
put APIPlane
APManagement [
    Text
"subscriptions", Text
subid
  , Text
"resourceGroup", Text
rgname
  , Text
"providers", Text
"Microsoft.ServiceBus"
  , Text
"namespaces", Text
nname
  , Text
"queues", Text
qname
  ] (Text
"api-version" Text -> Text -> Option 'Https
==: Text
"2021-11-01") ()

data QueueCreateResponse = QueueCreateResponse {
  QueueCreateResponse -> Text
qcrId :: Text
  , QueueCreateResponse -> QCRProperties
qcrProperties :: QCRProperties
                                               } deriving (QueueCreateResponse -> QueueCreateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueueCreateResponse -> QueueCreateResponse -> Bool
$c/= :: QueueCreateResponse -> QueueCreateResponse -> Bool
== :: QueueCreateResponse -> QueueCreateResponse -> Bool
$c== :: QueueCreateResponse -> QueueCreateResponse -> Bool
Eq, Int -> QueueCreateResponse -> ShowS
[QueueCreateResponse] -> ShowS
QueueCreateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueueCreateResponse] -> ShowS
$cshowList :: [QueueCreateResponse] -> ShowS
show :: QueueCreateResponse -> String
$cshow :: QueueCreateResponse -> String
showsPrec :: Int -> QueueCreateResponse -> ShowS
$cshowsPrec :: Int -> QueueCreateResponse -> ShowS
Show, forall x. Rep QueueCreateResponse x -> QueueCreateResponse
forall x. QueueCreateResponse -> Rep QueueCreateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueueCreateResponse x -> QueueCreateResponse
$cfrom :: forall x. QueueCreateResponse -> Rep QueueCreateResponse x
Generic)
instance A.FromJSON QueueCreateResponse where
  parseJSON :: Value -> Parser QueueCreateResponse
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"qcr")

data QCRProperties = QCRProperties {
  QCRProperties -> Int
qcrpMaxMessageSizeInKilobytes :: Int
                                   } deriving (QCRProperties -> QCRProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QCRProperties -> QCRProperties -> Bool
$c/= :: QCRProperties -> QCRProperties -> Bool
== :: QCRProperties -> QCRProperties -> Bool
$c== :: QCRProperties -> QCRProperties -> Bool
Eq, Int -> QCRProperties -> ShowS
[QCRProperties] -> ShowS
QCRProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QCRProperties] -> ShowS
$cshowList :: [QCRProperties] -> ShowS
show :: QCRProperties -> String
$cshow :: QCRProperties -> String
showsPrec :: Int -> QCRProperties -> ShowS
$cshowsPrec :: Int -> QCRProperties -> ShowS
Show, forall x. Rep QCRProperties x -> QCRProperties
forall x. QCRProperties -> Rep QCRProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QCRProperties x -> QCRProperties
$cfrom :: forall x. QCRProperties -> Rep QCRProperties x
Generic)
instance A.FromJSON QCRProperties where
  parseJSON :: Value -> Parser QCRProperties
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"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 :: Text
-> Text
-> Text
-> NameSpaceCreate
-> AccessToken
-> Req NameSpaceCreateResponse
createNamespace Text
subid Text
rgname Text
nname = forall b a.
(FromJSON b, ToJSON a) =>
APIPlane -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
put APIPlane
APManagement [
  Text
"subscriptions", Text
subid
  , Text
"resourceGroup", Text
rgname
  , Text
"providers", Text
"Microsoft.ServiceBus"
  , Text
"namespaces", Text
nname
  ] (Text
"api-version" Text -> Text -> Option 'Https
==: Text
"2021-11-01")

-- | https://learn.microsoft.com/en-us/rest/api/servicebus/controlplane-stable/namespaces/create-or-update?tabs=HTTP#namespacecreate
data NameSpaceCreate = NameSpaceCreate {
  NameSpaceCreate -> Sku
sku :: Sku
  , NameSpaceCreate -> Location
location :: Location
                                       } deriving (NameSpaceCreate -> NameSpaceCreate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameSpaceCreate -> NameSpaceCreate -> Bool
$c/= :: NameSpaceCreate -> NameSpaceCreate -> Bool
== :: NameSpaceCreate -> NameSpaceCreate -> Bool
$c== :: NameSpaceCreate -> NameSpaceCreate -> Bool
Eq, Int -> NameSpaceCreate -> ShowS
[NameSpaceCreate] -> ShowS
NameSpaceCreate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSpaceCreate] -> ShowS
$cshowList :: [NameSpaceCreate] -> ShowS
show :: NameSpaceCreate -> String
$cshow :: NameSpaceCreate -> String
showsPrec :: Int -> NameSpaceCreate -> ShowS
$cshowsPrec :: Int -> NameSpaceCreate -> ShowS
Show, forall x. Rep NameSpaceCreate x -> NameSpaceCreate
forall x. NameSpaceCreate -> Rep NameSpaceCreate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameSpaceCreate x -> NameSpaceCreate
$cfrom :: forall x. NameSpaceCreate -> Rep NameSpaceCreate x
Generic)
instance A.ToJSON NameSpaceCreate

data NameSpaceCreateResponse = NameSpaceCreateResponse {
  NameSpaceCreateResponse -> Text
nscrId :: Text
  , NameSpaceCreateResponse -> NSCRProperties
nscrProperties :: NSCRProperties
                                                       } deriving (NameSpaceCreateResponse -> NameSpaceCreateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameSpaceCreateResponse -> NameSpaceCreateResponse -> Bool
$c/= :: NameSpaceCreateResponse -> NameSpaceCreateResponse -> Bool
== :: NameSpaceCreateResponse -> NameSpaceCreateResponse -> Bool
$c== :: NameSpaceCreateResponse -> NameSpaceCreateResponse -> Bool
Eq, Int -> NameSpaceCreateResponse -> ShowS
[NameSpaceCreateResponse] -> ShowS
NameSpaceCreateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameSpaceCreateResponse] -> ShowS
$cshowList :: [NameSpaceCreateResponse] -> ShowS
show :: NameSpaceCreateResponse -> String
$cshow :: NameSpaceCreateResponse -> String
showsPrec :: Int -> NameSpaceCreateResponse -> ShowS
$cshowsPrec :: Int -> NameSpaceCreateResponse -> ShowS
Show, forall x. Rep NameSpaceCreateResponse x -> NameSpaceCreateResponse
forall x. NameSpaceCreateResponse -> Rep NameSpaceCreateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameSpaceCreateResponse x -> NameSpaceCreateResponse
$cfrom :: forall x. NameSpaceCreateResponse -> Rep NameSpaceCreateResponse x
Generic)
instance A.FromJSON NameSpaceCreateResponse where
  parseJSON :: Value -> Parser NameSpaceCreateResponse
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"nscr")

data NSCRProperties = NSCRProperties {
  NSCRProperties -> UTCTime
nscrpCreatedAt :: UTCTime
  , NSCRProperties -> Text
nscrpServiceBusEndpoint :: Text
                                     } deriving (NSCRProperties -> NSCRProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NSCRProperties -> NSCRProperties -> Bool
$c/= :: NSCRProperties -> NSCRProperties -> Bool
== :: NSCRProperties -> NSCRProperties -> Bool
$c== :: NSCRProperties -> NSCRProperties -> Bool
Eq, Int -> NSCRProperties -> ShowS
[NSCRProperties] -> ShowS
NSCRProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NSCRProperties] -> ShowS
$cshowList :: [NSCRProperties] -> ShowS
show :: NSCRProperties -> String
$cshow :: NSCRProperties -> String
showsPrec :: Int -> NSCRProperties -> ShowS
$cshowsPrec :: Int -> NSCRProperties -> ShowS
Show, forall x. Rep NSCRProperties x -> NSCRProperties
forall x. NSCRProperties -> Rep NSCRProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NSCRProperties x -> NSCRProperties
$cfrom :: forall x. NSCRProperties -> Rep NSCRProperties x
Generic)
instance A.FromJSON NSCRProperties where
  parseJSON :: Value -> Parser NSCRProperties
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"nscrp")

data Sku = Sku {
  Sku -> SkuName
skuName :: SkuName
               } deriving (Sku -> Sku -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sku -> Sku -> Bool
$c/= :: Sku -> Sku -> Bool
== :: Sku -> Sku -> Bool
$c== :: Sku -> Sku -> Bool
Eq, Int -> Sku -> ShowS
[Sku] -> ShowS
Sku -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sku] -> ShowS
$cshowList :: [Sku] -> ShowS
show :: Sku -> String
$cshow :: Sku -> String
showsPrec :: Int -> Sku -> ShowS
$cshowsPrec :: Int -> Sku -> ShowS
Show)
-- | name and tier are rendered as the same thing
instance A.ToJSON Sku where
  toJSON :: Sku -> Value
toJSON (Sku SkuName
n) = [Pair] -> Value
A.object [
    Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= SkuName
n
    , Key
"tier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= SkuName
n
                              ]

data SkuName = Basic | Premium | Standard deriving (SkuName -> SkuName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SkuName -> SkuName -> Bool
$c/= :: SkuName -> SkuName -> Bool
== :: SkuName -> SkuName -> Bool
$c== :: SkuName -> SkuName -> Bool
Eq, Int -> SkuName -> ShowS
[SkuName] -> ShowS
SkuName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SkuName] -> ShowS
$cshowList :: [SkuName] -> ShowS
show :: SkuName -> String
$cshow :: SkuName -> String
showsPrec :: Int -> SkuName -> ShowS
$cshowsPrec :: Int -> SkuName -> ShowS
Show, forall x. Rep SkuName x -> SkuName
forall x. SkuName -> Rep SkuName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SkuName x -> SkuName
$cfrom :: forall x. SkuName -> Rep SkuName x
Generic)
instance A.ToJSON SkuName