{-# LANGUAGE DataKinds #-}
{-# options_ghc -Wno-unused-imports #-}
module MSAzureAPI.Internal.Common (
APIPlane(..)
, put
, get
, getBs
, getLbs
, post
, (==:)
, tryReq
, Collection
, collectionValue
, collectionNextLink
, Location(..)
, showLocation
, aesonOptions
) where
import Control.Monad.IO.Class (MonadIO(..))
import Data.Proxy (Proxy)
import GHC.Generics (Generic(..))
import Data.List (sort, sortBy, stripPrefix, uncons)
import Data.Maybe (listToMaybe, fromMaybe)
import Data.Char (toLower)
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON, defaultOptions, Options(..), withObject, withText, (.:), (.:?), object, (.=), Key, Value, camelTo2)
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)
import Network.OAuth.OAuth2 (OAuth2Token(..))
import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error, IdToken(..))
import Network.HTTP.Req (Req, runReq, HttpException(..), defaultHttpConfig, req, Option, (=:), GET(..), POST(..), Url, Scheme(..), useHttpsURI, https, (/:), ReqBodyJson(..), NoReqBody(..), oAuth2Bearer, HttpResponse(..), jsonResponse, JsonResponse, lbsResponse, LbsResponse, bsResponse, BsResponse, responseBody)
import Data.Text (Text, pack, unpack)
import UnliftIO (MonadUnliftIO(..))
import UnliftIO.Exception (try)
(==:) :: Text
-> Text
-> Option 'Https
==: :: Text -> Text -> Option 'Https
(==:) = forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
(=:)
getLbs :: APIPlane
-> [Text]
-> Option 'Https -> AccessToken -> Req LBS.ByteString
getLbs :: APIPlane
-> [Text] -> Option 'Https -> AccessToken -> Req ByteString
getLbs APIPlane
apiplane [Text]
paths Option 'Https
params AccessToken
tok = forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
url NoReqBody
NoReqBody Proxy LbsResponse
lbsResponse Option 'Https
opts
where
opts :: Option 'Https
opts = Option 'Https
auth forall a. Semigroup a => a -> a -> a
<> Option 'Https
params
(Url 'Https
url, Option 'Https
auth) = APIPlane -> [Text] -> AccessToken -> (Url 'Https, Option 'Https)
msAzureReqConfig APIPlane
apiplane [Text]
paths AccessToken
tok
getBs :: APIPlane
-> [Text]
-> Option 'Https -> AccessToken -> Req BS.ByteString
getBs :: APIPlane
-> [Text] -> Option 'Https -> AccessToken -> Req ByteString
getBs APIPlane
apiplane [Text]
paths Option 'Https
params AccessToken
tok = forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
url NoReqBody
NoReqBody Proxy BsResponse
bsResponse Option 'Https
opts
where
opts :: Option 'Https
opts = Option 'Https
auth forall a. Semigroup a => a -> a -> a
<> Option 'Https
params
(Url 'Https
url, Option 'Https
auth) = APIPlane -> [Text] -> AccessToken -> (Url 'Https, Option 'Https)
msAzureReqConfig APIPlane
apiplane [Text]
paths AccessToken
tok
tryReq :: Req a -> Req (Either HttpException a)
tryReq :: forall a. Req a -> Req (Either HttpException a)
tryReq = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
data APIPlane = APManagement
| APData Text
put :: (A.FromJSON b, A.ToJSON a) =>
APIPlane
-> [Text]
-> Option 'Https
-> a -> AccessToken -> Req b
put :: forall b a.
(FromJSON b, ToJSON a) =>
APIPlane -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
put APIPlane
apiplane [Text]
paths Option 'Https
params a
bdy AccessToken
tok = forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req POST
POST Url 'Https
url (forall a. a -> ReqBodyJson a
ReqBodyJson a
bdy) forall a. Proxy (JsonResponse a)
jsonResponse Option 'Https
opts
where
opts :: Option 'Https
opts = Option 'Https
auth forall a. Semigroup a => a -> a -> a
<> Option 'Https
params
(Url 'Https
url, Option 'Https
auth) = APIPlane -> [Text] -> AccessToken -> (Url 'Https, Option 'Https)
msAzureReqConfig APIPlane
apiplane [Text]
paths AccessToken
tok
post :: (A.FromJSON b, A.ToJSON a) =>
APIPlane
-> [Text]
-> Option 'Https
-> a
-> AccessToken -> Req b
post :: forall b a.
(FromJSON b, ToJSON a) =>
APIPlane -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
post APIPlane
apiplane [Text]
paths Option 'Https
params a
bdy AccessToken
tok = forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req POST
POST Url 'Https
url (forall a. a -> ReqBodyJson a
ReqBodyJson a
bdy) forall a. Proxy (JsonResponse a)
jsonResponse Option 'Https
opts
where
opts :: Option 'Https
opts = Option 'Https
auth forall a. Semigroup a => a -> a -> a
<> Option 'Https
params
(Url 'Https
url, Option 'Https
auth) = APIPlane -> [Text] -> AccessToken -> (Url 'Https, Option 'Https)
msAzureReqConfig APIPlane
apiplane [Text]
paths AccessToken
tok
get :: (A.FromJSON b) =>
APIPlane
-> [Text]
-> Option 'Https -> AccessToken -> Req b
get :: forall b.
FromJSON b =>
APIPlane -> [Text] -> Option 'Https -> AccessToken -> Req b
get APIPlane
apiplane [Text]
paths Option 'Https
params AccessToken
tok = forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
HttpResponse response,
HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
url NoReqBody
NoReqBody forall a. Proxy (JsonResponse a)
jsonResponse Option 'Https
opts
where
opts :: Option 'Https
opts = Option 'Https
auth forall a. Semigroup a => a -> a -> a
<> Option 'Https
params
(Url 'Https
url, Option 'Https
auth) = APIPlane -> [Text] -> AccessToken -> (Url 'Https, Option 'Https)
msAzureReqConfig APIPlane
apiplane [Text]
paths AccessToken
tok
msAzureReqConfig :: APIPlane
-> [Text]
-> AccessToken
-> (Url 'Https, Option 'Https)
msAzureReqConfig :: APIPlane -> [Text] -> AccessToken -> (Url 'Https, Option 'Https)
msAzureReqConfig APIPlane
apiplane [Text]
uriRest (AccessToken Text
ttok) = (Url 'Https
url, Option 'Https
os)
where
urlBase :: Text
urlBase = case APIPlane
apiplane of
APIPlane
APManagement -> Text
"management.azure.com"
APData Text
ub -> Text
ub
url :: Url 'Https
url = (Text -> Url 'Https
https Text
urlBase) forall (scheme :: Scheme). Url scheme -> [Text] -> Url scheme
//: [Text]
uriRest
os :: Option 'Https
os = ByteString -> Option 'Https
oAuth2Bearer forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS8.pack (Text -> String
unpack Text
ttok)
(//:) :: Url scheme -> [Text] -> Url scheme
//: :: forall (scheme :: Scheme). Url scheme -> [Text] -> Url scheme
(//:) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
(/:)
showLocation :: Location -> Text
showLocation :: Location -> Text
showLocation = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
data Location =
LNorthEU
| LWestEU
deriving (Location -> Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq)
instance Show Location where
show :: Location -> String
show = \case
Location
LNorthEU -> String
"northeu"
Location
LWestEU -> String
"westeu"
data Collection a = Collection {
forall a. Collection a -> [a]
cValue :: [a]
, forall a. Collection a -> Maybe Text
cNextLink :: Maybe Text
} deriving (Collection a -> Collection a -> Bool
forall a. Eq a => Collection a -> Collection a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Collection a -> Collection a -> Bool
$c/= :: forall a. Eq a => Collection a -> Collection a -> Bool
== :: Collection a -> Collection a -> Bool
$c== :: forall a. Eq a => Collection a -> Collection a -> Bool
Eq, Int -> Collection a -> ShowS
forall a. Show a => Int -> Collection a -> ShowS
forall a. Show a => [Collection a] -> ShowS
forall a. Show a => Collection a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Collection a] -> ShowS
$cshowList :: forall a. Show a => [Collection a] -> ShowS
show :: Collection a -> String
$cshow :: forall a. Show a => Collection a -> String
showsPrec :: Int -> Collection a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Collection a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Collection a) x -> Collection a
forall a x. Collection a -> Rep (Collection a) x
$cto :: forall a x. Rep (Collection a) x -> Collection a
$cfrom :: forall a x. Collection a -> Rep (Collection a) x
Generic)
instance A.FromJSON a => A.FromJSON (Collection a) where
parseJSON :: Value -> Parser (Collection a)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"c")
collectionValue :: Collection a -> [a]
collectionValue :: forall a. Collection a -> [a]
collectionValue = forall a. Collection a -> [a]
cValue
collectionNextLink :: Collection a -> Maybe Text
collectionNextLink :: forall a. Collection a -> Maybe Text
collectionNextLink = forall a. Collection a -> Maybe Text
cNextLink
aesonOptions :: String
-> A.Options
aesonOptions :: String -> Options
aesonOptions String
pfx = Options
A.defaultOptions { fieldLabelModifier :: ShowS
A.fieldLabelModifier = String -> ShowS
recordName String
pfx }
recordName :: String
-> String
-> String
recordName :: String -> ShowS
recordName String
pf String
str = case forall a. [a] -> Maybe (a, [a])
uncons forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [a]
dropPrefix String
pf String
str of
Just (Char
c, String
cs) -> Char -> Char
toLower Char
c forall a. a -> [a] -> [a]
: String
cs
Maybe (Char, String)
_ -> forall a. HasCallStack => String -> a
error String
"record name cannot be empty"
dropPrefix :: Eq a => [a] -> [a] -> [a]
dropPrefix :: forall a. Eq a => [a] -> [a] -> [a]
dropPrefix [a]
a [a]
b = forall a. a -> Maybe a -> a
fromMaybe [a]
b forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
a [a]
b