diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,12 @@ ## Unreleased +## 0.2 + +MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles + +Add XML support via `xeno` and `xmlbf` to parse `listDirectoriesAndFiles` response bodies + ## 0.1.0.0 First release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ This library provides the client interface (under the `MSAzureAPI` namespace). -Authentication can be implemented with the @ms-auth@ library. +Authentication can be implemented with the `ms-auth` library. ## Status diff --git a/ms-azure-api.cabal b/ms-azure-api.cabal --- a/ms-azure-api.cabal +++ b/ms-azure-api.cabal @@ -1,8 +1,8 @@ name: ms-azure-api -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Microsoft Azure API description: Bindings to the Microsoft Azure API -homepage: https://github.com/unfoldml/ms-api +homepage: https://github.com/unfoldml/ms-graph-api license: BSD3 license-file: LICENSE author: Marco Zocca @@ -34,6 +34,9 @@ , time >= 1.8 , transformers >= 0.5 , unliftio + , xeno + , xmlbf + , xmlbf-xeno ghc-options: -Wall -Wcompat -Wno-unused-imports @@ -47,4 +50,4 @@ source-repository head type: git - location: https://github.com/unfoldml/ms-azure-api + location: https://github.com/unfoldml/ms-graph-api diff --git a/src/MSAzureAPI/Internal/Common.hs b/src/MSAzureAPI/Internal/Common.hs --- a/src/MSAzureAPI/Internal/Common.hs +++ b/src/MSAzureAPI/Internal/Common.hs @@ -5,8 +5,11 @@ module MSAzureAPI.Internal.Common ( APIPlane(..) , get + , getBs , getLbs , post + -- ** URL parameters + , (==:) -- ** Helpers , tryReq -- ** JSON @@ -43,12 +46,26 @@ import UnliftIO (MonadUnliftIO(..)) import UnliftIO.Exception (try) +-- | URL parameters +(==:) :: Text -- ^ key + -> Text -- ^ value + -> Option 'Https +(==:) = (=:) -- | @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 + +-- | @GET@ a 'BS.ByteString' e.g. a file +getBs :: APIPlane + -> [Text] -- ^ URI path segments + -> Option 'Https -> AccessToken -> Req BS.ByteString +getBs apiplane paths params tok = responseBody <$> req GET url NoReqBody bsResponse opts where opts = auth <> params (url, auth) = msAzureReqConfig apiplane paths tok diff --git a/src/MSAzureAPI/StorageServices/FileService.hs b/src/MSAzureAPI/StorageServices/FileService.hs --- a/src/MSAzureAPI/StorageServices/FileService.hs +++ b/src/MSAzureAPI/StorageServices/FileService.hs @@ -3,27 +3,50 @@ -- 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 +module MSAzureAPI.StorageServices.FileService ( + -- * Files + getFile + -- * Directories + , listDirectoriesAndFiles + , DirItem(..) + ) where +import Control.Applicative (Alternative(..)) import Control.Monad.IO.Class (MonadIO(..)) +import Data.Foldable (asum) +import Data.Functor (void) +import Data.Maybe (listToMaybe) +import qualified Text.ParserCombinators.ReadP as RP (ReadP, readP_to_S, choice, many, between, char, string, satisfy) -- 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) -- hoauth2 -- import Network.OAuth.OAuth2 (OAuth2Token(..)) import Network.OAuth.OAuth2.Internal (AccessToken(..)) -- req -import Network.HTTP.Req (Req, Url, Option, Scheme(..), header) +import Network.HTTP.Req (Req, Url, Option, Scheme(..), header, (=:)) -- 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 (getZonedTime) +-- xeno +import qualified Xeno.DOM.Robust as X (Node, Content(..), name, contents, children) +-- xmlbf-xeno +import qualified Xmlbf.Xeno as XB (fromRawXml) +-- xmlbf +import qualified Xmlbf as XB (Parser, runParser, pElement, pText) -import MSAzureAPI.Internal.Common (APIPlane(..), get, post, getLbs) +import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs) + + + + {- | Headers: https://learn.microsoft.com/en-us/rest/api/storageservices/authorize-with-azure-active-directory#call-storage-operations-with-oauth-tokens @@ -92,16 +115,98 @@ -- | 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 +-- @GET https:\/\/myaccount.file.core.windows.net\/myshare\/mydirectorypath?restype=directory&comp=list@ +listDirectoriesAndFiles :: Text -- ^ storage account + -> Text -- ^ file share + -> Text -- ^ directory path, including directories + -> AccessToken + -> Req (Either String [DirItem]) +listDirectoriesAndFiles acct fshare fpath atok = do + os <- msStorageReqHeaders + bs <- getBs (APData domain) pth (os <> "restype" ==: "directory" <> "comp" ==: "list") atok + pure $ parseXML listDirectoriesP bs + where + domain = acct <> ".file.core.windows.net" + pth = [fshare, fpath] --- --- 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. +-- | Directory item, as returned by 'listDirectoriesAndFiles' +data DirItem = DIFile {diId :: Text, diName :: Text} + | DIDirectory {diId :: Text, diName :: Text} + deriving (Show) +-- | XML parser for the response body format shown here: https://learn.microsoft.com/en-us/rest/api/storageservices/list-directories-and-files#response-body +listDirectoriesP :: XB.Parser [DirItem] +listDirectoriesP = do + tag "EnumerationResults" $ do + enumResultsIgnore + es <- entries + selfClosing "NextMarker" + pure es +enumResultsIgnore :: XB.Parser () +enumResultsIgnore = ignoreList ["Marker", "Prefix", "MaxResults", "DirectoryId"] +entries :: XB.Parser [DirItem] +entries = tag "Entries" $ many (file <|> directory) + +file :: XB.Parser DirItem +file = tag "File" $ do + fid <- fileId + fname <- fileName + properties + entryFooter + pure $ DIFile fid fname + +directory :: XB.Parser DirItem +directory = tag "Directory" $ do + fid <- fileId + fname <- fileName + properties + entryFooter + pure $ DIDirectory fid fname + + + +entryFooter :: XB.Parser () +entryFooter = ignoreList ["Attributes", "PermissionKey"] + +fileId :: XB.Parser Text +fileId = TL.toStrict <$> tag "FileId" anystring + +fileName :: XB.Parser Text +fileName = TL.toStrict <$> tag "Name" anystring + +properties :: XB.Parser () +properties = tag "Properties" $ + ignoreList ["Content-Length", "CreationTime", "LastAccessTime", "LastWriteTime", "ChangeTime", "Last-Modified", "Etag"] + +ignoreList :: [Text] -> XB.Parser () +ignoreList ns = void $ many (asum (map (`XB.pElement` XB.pText) ns)) + +selfClosing :: Text -> XB.Parser () +selfClosing t = tag t (pure ()) + + +anystring :: XB.Parser TL.Text +anystring = XB.pText +tag :: Text -> XB.Parser a -> XB.Parser a +tag = XB.pElement + +parseXML :: XB.Parser b -> BS.ByteString -> Either String b +parseXML p bs = XB.fromRawXml bs >>= XB.runParser p + + + +-- -- t0, t1, tdir, tfile, tentries :: String +-- t0, t1, t1', tfile :: BS.ByteString +-- t0 = "datetimedatetimedatetimedatetimedatetimeetag" + +-- t1' = " string-value string-value int-value directory-id file-id file-name size-in-bytes datetime datetime datetime datetime datetime etag Archive|Hidden|Offline|ReadOnly 4066528134148476695*1 file-id directory-name datetime datetime datetime datetime datetime etag Archive|Hidden|Offline|ReadOnly 4066528134148476695*1 " + +-- t1 = "string-valuestring-valueint-valuedirectory-idfile-idfile-namesize-in-bytesdatetimedatetimedatetimedatetimedatetimeetagArchive|Hidden|Offline|ReadOnly4066528134148476695*1file-iddirectory-namedatetimedatetimedatetimedatetimedatetimeetagArchive|Hidden|Offline|ReadOnly4066528134148476695*1" + +-- -- tdir = "file-iddirectory-namedatetimedatetimedatetimedatetimedatetimeetagArchive|Hidden|Offline|ReadOnly4066528134148476695*1" + +-- tfile = "file-idfile-namesize-in-bytesdatetimedatetimedatetimedatetimedatetimeetagArchive|Hidden|Offline|ReadOnly4066528134148476695*1" + +-- -- tentries = "file-idfile-namesize-in-bytesdatetimedatetimedatetimedatetimedatetimeetagArchive|Hidden|Offline|ReadOnly4066528134148476695*1file-iddirectory-namedatetimedatetimedatetimedatetimedatetimeetagArchive|Hidden|Offline|ReadOnly4066528134148476695*1"