packages feed

ms-azure-api (empty) → 0.1.0.0

raw patch · 8 files changed

+384/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, hoauth2, http-types, modern-uri, req, scientific, text, time, transformers, unliftio

Files

+ CHANGELOG.md view
@@ -0,0 +1,13 @@+# Changelog for `ms-azure-api`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0++First release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,32 @@+# ms-azure-api++Haskell client bindings to the [Microsoft Azure API]().+    +[![Hackage](https://img.shields.io/hackage/v/ms-azure-api?style=for-the-badge)](https://hackage.haskell.org/package/ms-azure-api)++![main](https://github.com/unfoldml/ms-graph-api/actions/workflows/haskell.yml/badge.svg?branch=main)+++## Introduction++This library provides the client interface (under the `MSAzureAPI` namespace).++Authentication can be implemented with the @ms-auth@ library.++## Status++This library is still in development, so expect missing functionality.+If there's anything you would like to see added, feel free to+[open an issue](https://github.com/unfoldml/ms-graph-api/issues/new).+In general, since the MS Azure API is quite large, features will be added to this library on a need basis.++## Evolution of the library++Some breaking changes might also be introduced as the library matures.++We adhere to a simplified version of the [Package Versioning Policy](https://pvp.haskell.org/): breaking changes are signaled by increasing the major version number (e.g. 0.x -> 1.x ).+++## Copyright++(c) 2023-, Marco Zocca, UnfoldML AB
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ms-azure-api.cabal view
@@ -0,0 +1,50 @@+name:                ms-azure-api+version:             0.1.0.0+synopsis:            Microsoft Azure API+description:         Bindings to the Microsoft Azure API+homepage:            https://github.com/unfoldml/ms-api+license:             BSD3+license-file:        LICENSE+author:              Marco Zocca+maintainer:          oss@unfoldml.com+copyright:           2023 Marco Zocca+category:            Web+build-type:          Simple+extra-source-files:  README.md+                     CHANGELOG.md+cabal-version:       >=1.10+tested-with:         GHC == 7.10.2++library+  default-language:    Haskell2010+  hs-source-dirs:      src+  exposed-modules:     MSAzureAPI.Internal.Common+                       MSAzureAPI.StorageServices+                       MSAzureAPI.StorageServices.FileService+  build-depends:       base >= 4.7 && < 5+                     , aeson+                     , bytestring+                     , containers+                     , hoauth2 == 2.6.0+                     , http-types+                     , modern-uri+                     , req+                     , scientific+                     , text+                     , time >= 1.8+                     , transformers >= 0.5+                     , unliftio+  ghc-options:         -Wall+                       -Wcompat+                       -Wno-unused-imports+  default-extensions:  OverloadedStrings+                       DeriveGeneric+                       DeriveFunctor+                       DerivingStrategies+                       LambdaCase+                       DataKinds+++source-repository head+  type:     git+  location: https://github.com/unfoldml/ms-azure-api
+ src/MSAzureAPI/Internal/Common.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE DataKinds #-}+{-# options_ghc -Wno-unused-imports #-}+-- | Common functions for the MS Azure API+--+module MSAzureAPI.Internal.Common (+  APIPlane(..)+  , get+  , getLbs+  , post+  -- ** Helpers+  , tryReq+  -- ** JSON+  , Collection+  , 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.Ord (comparing)+import Data.Char (toLower)++-- aeson+import qualified Data.Aeson as A (ToJSON(..), 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)+-- hoauth2+import Network.OAuth.OAuth2 (OAuth2Token(..))+import Network.OAuth.OAuth2.Internal (AccessToken(..), ExchangeToken(..), RefreshToken(..), OAuth2Error, IdToken(..))+-- modern-uri+-- import Text.URI (URI, mkURI)+-- req+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)+-- text+import Data.Text (Text, pack, unpack)+-- unliftio+import UnliftIO (MonadUnliftIO(..))+import UnliftIO.Exception (try)+++-- | @GET@ a 'LBS.ByteString' e.g. a file+getLbs :: APIPlane+       -> [Text] -- ^ URI path segments+       -> Option 'Https -> AccessToken -> Req LBS.ByteString+getLbs apiplane paths params tok = responseBody <$> req GET url NoReqBody lbsResponse opts+  where+    opts = auth <> params+    (url, auth) = msAzureReqConfig apiplane paths tok+++-- | Specialized version of 'try' to 'HttpException's+--+-- This can be used to catch exceptions of composite 'Req' statements, e.g. around a @do@ block+tryReq :: Req a -> Req (Either HttpException a)+tryReq = try++-- | API control planes+--+-- 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++-- | @POST@+post :: (A.FromJSON b, A.ToJSON a) =>+        APIPlane+     -> [Text] -- ^ URI path segments+     -> Option 'Https+     -> a -- ^ request body+     -> AccessToken -> Req b+post apiplane paths params bdy tok = responseBody <$> req POST url (ReqBodyJson bdy) jsonResponse opts+  where+    opts = auth <> params+    (url, auth) = msAzureReqConfig apiplane paths tok++-- | @GET@+get :: (A.FromJSON b) =>+       APIPlane+    -> [Text] -- ^ URI path segments+    -> Option 'Https -> AccessToken -> Req b+get apiplane paths params tok = responseBody <$> req GET url NoReqBody jsonResponse opts+  where+    opts = auth <> params+    (url, auth) = msAzureReqConfig apiplane paths tok++msAzureReqConfig :: APIPlane+                 -> [Text] -- ^ URI path segments+                 -> AccessToken+                 -> (Url 'Https, Option 'Https)+msAzureReqConfig apiplane uriRest (AccessToken ttok) = (url, os)+  where+    urlBase = case apiplane of+      APManagement -> "management.azure.com"+      APData ub -> ub+    url = (https urlBase) //: uriRest+    os = oAuth2Bearer $ BS8.pack (unpack ttok)++++(//:) :: Url scheme -> [Text] -> Url scheme+(//:) = foldl (/:)+++-- * aeson++-- | a collection of items with key @value@+data Collection a = Collection {+  cValue :: [a]+                               } deriving (Eq, Show, Generic)+instance A.FromJSON a => A.FromJSON (Collection a) where+  parseJSON = A.genericParseJSON (aesonOptions "c")++-- | drop the prefix and lowercase first character+--+-- e.g. @userDisplayName@ @->@ @displayName@+aesonOptions :: String -- ^ record prefix+             -> A.Options+aesonOptions pfx = A.defaultOptions { A.fieldLabelModifier = recordName pfx }++-- | drop the prefix and lowercase first character+recordName :: String -- ^ record name prefix+           -> String -- ^ JSON field name+           -> String+recordName pf str = case uncons $ dropPrefix pf str of+  Just (c, cs) -> toLower c : cs+  _ -> error "record name cannot be empty"++-- | Drops the given prefix from a list.+--   It returns the original sequence if the sequence doesn't start with the given prefix.+--+-- > dropPrefix "Mr. " "Mr. Men" == "Men"+-- > dropPrefix "Mr. " "Dr. Men" == "Dr. Men"+dropPrefix :: Eq a => [a] -> [a] -> [a]+dropPrefix a b = fromMaybe b $ stripPrefix a b
+ src/MSAzureAPI/StorageServices.hs view
@@ -0,0 +1,11 @@+module MSAzureAPI.StorageServices where++{- Permissions that an Azure AD entity (user or service principal) needs to perform file service operations:+++https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory#permissions-for-calling-data-operations+-}++++
+ src/MSAzureAPI/StorageServices/FileService.hs view
@@ -0,0 +1,107 @@+-- | StorageServices.FileService+--+-- authorize with AD : https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory+--+-- permissions for calling data operations : https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory#permissions-for-calling-data-operations+module MSAzureAPI.StorageServices.FileService (getFile) where++import Control.Monad.IO.Class (MonadIO(..))++-- 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)+-- time+import Data.Time (UTCTime, getCurrentTime)+import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale)+import Data.Time.LocalTime (getZonedTime)++import MSAzureAPI.Internal.Common (APIPlane(..), get, post, getLbs)++{- | Headers:++https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory#call-storage-operations-with-oauth-tokens++Requests that use an OAuth 2.0 token from Azure Active Directory (Azure AD): To authorize a request with Azure AD, pass the++x-ms-version++header on the request with a service version of 2017-11-09 or higher. For more information, see Call storage operations with OAuth tokens in Authorize with Azure Active Directory.++-}++xMsVerHeader :: Option 'Https+xMsVerHeader = header "x-ms-version" "2022-11-02"+++-- | x-ms-date header should be formatted as+--+-- %a, %d %b %Y %H:%M:%S GMT+--+-- e.g. Fri, 26 Jun 2015 23:39:12 GMT+xMsDateHeader :: MonadIO m => m (Option 'Https)+xMsDateHeader = do+  zt <- liftIO getZonedTime+  let+    zth = formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" zt+  pure $ header "x-ms-date" (BS8.pack zth)++-- getDateHeader :: MonadIO m => m String+-- getDateHeader = do+--   zt <- liftIO getZonedTime+--   pure $ formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" zt+++-- | Configure a StorageService request+-- msStorageReqConfig :: MonadIO m =>+--                       AccessToken -> Text -> [Text] -> m (Url 'Https, Option 'Https)+-- msStorageReqConfig atok uriBase uriRest = do+--   dateHeader <- xMsDateHeader+--   let+--     verHeader = xMsVerHeader+--     (url, os) = msAzureDataReqConfig atok uriBase uriRest+--   pure (url, os <> verHeader <> dateHeader)++msStorageReqHeaders :: MonadIO m => m (Option 'Https)+msStorageReqHeaders = do+  dh <- xMsDateHeader+  let+    vh = xMsVerHeader+  pure (dh <> vh)++-- | get file  https://learn.microsoft.com/en-us/rest/api/storageservices/get-file#request+--+-- @GET https:\/\/myaccount.file.core.windows.net\/myshare\/mydirectorypath\/myfile@+getFile :: Text -- ^ storage account+        -> Text -- ^ file share+        -> Text -- ^ filepath, including directories+        -> AccessToken+        -> Req LBS.ByteString+getFile acct fshare fpath atok = do+  os <- msStorageReqHeaders+  getLbs (APData domain) pth os atok+  where+    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 +--+-- GET https://myaccount.file.core.windows.net/myshare/mydirectorypath?restype=directory&comp=list+-- listDirectoryAndFiles++--+-- Path component 	Description+--+-- myaccount 	The name of your storage account.+-- myshare 	The name of your file share.+-- mydirectorypath 	Optional. The path to the directory.+-- myfile 	The name of the file.+++