-- | 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 (
  -- * Files
  getFile
  -- * Directories
  , listDirectoriesAndFiles
  -- , listDirectoriesAndFilesC
  , DirItems(..)
  , DirItem(..)
  ) where

import Control.Applicative (Alternative(..), optional)
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (asum)
import Data.Functor (void)
import Data.Maybe (listToMaybe, isJust)
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)
-- conduit
import qualified Data.Conduit as C (ConduitT, yield, runConduitRes)
import Data.Conduit ((.|))
-- hoauth2
-- import Network.OAuth.OAuth2 (OAuth2Token(..))
import Network.OAuth.OAuth2.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (HttpException, runReq, defaultHttpConfig, 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, getBs, post, getLbs, tryReq)





{- | 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 :: Option 'Https
xMsVerHeader = forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"x-ms-version" ByteString
"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 :: forall (m :: * -> *). MonadIO m => m (Option 'Https)
xMsDateHeader = do
  ZonedTime
zt <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
  let
    zth :: String
zth = forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a, %d %b %Y %H:%M:%S %Z" ZonedTime
zt
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"x-ms-date" (String -> ByteString
BS8.pack String
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 :: forall (m :: * -> *). MonadIO m => m (Option 'Https)
msStorageReqHeaders = do
  Option 'Https
dh <- forall (m :: * -> *). MonadIO m => m (Option 'Https)
xMsDateHeader
  let
    vh :: Option 'Https
vh = Option 'Https
xMsVerHeader
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Option 'Https
dh forall a. Semigroup a => a -> a -> a
<> Option 'Https
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 :: Text -> Text -> Text -> AccessToken -> Req ByteString
getFile Text
acct Text
fshare Text
fpath AccessToken
atok = do
  Option 'Https
os <- forall (m :: * -> *). MonadIO m => m (Option 'Https)
msStorageReqHeaders
  APIPlane
-> [Text] -> Option 'Https -> AccessToken -> Req ByteString
getLbs (Text -> APIPlane
APData Text
domain) [Text]
pth Option 'Https
os AccessToken
atok
  where
    domain :: Text
domain = Text
acct forall a. Semigroup a => a -> a -> a
<> Text
".file.core.windows.net"
    pth :: [Text]
pth = [Text
fshare, Text
fpath]

-- | list directories and files  https://learn.microsoft.com/en-us/rest/api/storageservices/list-directories-and-files#request
--
-- NB the the response list contains at most 5000 elements
--
-- @GET https:\/\/myaccount.file.core.windows.net\/myshare\/mydirectorypath?restype=directory&comp=list@
--
-- === Paginated results
--
-- NB : The Marker, ShareSnapshot, and MaxResults elements are present only if you specify them on the request URI.
--
-- If the @<NextMarker> element in the @XML body has a value, it means that the result list is not complete. In that case
listDirectoriesAndFiles :: Text -- ^ storage account
                        -> Text -- ^ file share
                        -> Text -- ^ directory path, including directories
                        -> Maybe Text -- ^ next page marker. Use 'Nothing' to retrieve first page of results
                        -> AccessToken
                        -> Req (Either String DirItems)
listDirectoriesAndFiles :: Text
-> Text
-> Text
-> Maybe Text
-> AccessToken
-> Req (Either String DirItems)
listDirectoriesAndFiles Text
acct Text
fshare Text
fpath Maybe Text
mm AccessToken
atok = do
  Option 'Https
os <- forall (m :: * -> *). MonadIO m => m (Option 'Https)
msStorageReqHeaders
  ByteString
bs <- APIPlane
-> [Text] -> Option 'Https -> AccessToken -> Req ByteString
getBs (Text -> APIPlane
APData Text
domain) [Text]
pth (Option 'Https
os forall a. Semigroup a => a -> a -> a
<> Text
"restype" Text -> Text -> Option 'Https
==: Text
"directory" forall a. Semigroup a => a -> a -> a
<> Text
"comp" Text -> Text -> Option 'Https
==: Text
"list" forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Option 'Https
mMarker Maybe Text
mm) AccessToken
atok
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b. Parser b -> ByteString -> Either String b
parseXML Parser DirItems
listDirectoriesP ByteString
bs
  where
    domain :: Text
domain = Text
acct forall a. Semigroup a => a -> a -> a
<> Text
".file.core.windows.net"
    pth :: [Text]
pth = [Text
fshare, Text
fpath]
    mMarker :: Maybe Text -> Option 'Https
mMarker = \case
      Just Text
m -> (Text
"marker" Text -> Text -> Option 'Https
==: Text
m)
      Maybe Text
_ -> forall a. Monoid a => a
mempty

-- -- | Repeated call of 'listDirectoriesAndFiles' supporting multi-page results
-- listDirectoriesAndFilesC :: MonadIO m =>
--                               Text -- ^ storage account
--                            -> Text -- ^ file share
--                            -> Text -- ^ directory path, including directories
--                            -> AccessToken -> C.ConduitT i [DirItem] m ()
-- listDirectoriesAndFilesC acct fshare fpath atok = go Nothing
--   where
--     go mm = do
--       eres <- runReq defaultHttpConfig $ tryReq $ listDirectoriesAndFiles acct fshare fpath mm atok
--       case eres of
--         Left _ -> undefined -- FIXME http exception
--         Right xe -> case xe of
--           Left _ -> undefined -- FIXME xml parsing error
--           Right (DirItems xs nMarker) -> do
--             C.yield xs
--             when (isJust nMarker) (go nMarker)

-- | Directory item, as returned by 'listDirectoriesAndFiles'
data DirItem = DIFile {DirItem -> Text
diId :: Text, DirItem -> Text
diName :: Text} -- ^ file
             | DIDirectory {diId :: Text, diName :: Text} -- ^ directory
             deriving (Int -> DirItem -> ShowS
[DirItem] -> ShowS
DirItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirItem] -> ShowS
$cshowList :: [DirItem] -> ShowS
show :: DirItem -> String
$cshow :: DirItem -> String
showsPrec :: Int -> DirItem -> ShowS
$cshowsPrec :: Int -> DirItem -> ShowS
Show)

-- | Items in the 'listDirectoriesAndFiles' response
data DirItems = DirItems {
  DirItems -> [DirItem]
disItems :: [DirItem]
  , DirItems -> Maybe Text
disResponseMarker :: Maybe Text -- ^ marker to request next page of results
                         }

-- | 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 DirItems
listDirectoriesP :: Parser DirItems
listDirectoriesP = do
  forall a. Text -> Parser a -> Parser a
tag Text
"EnumerationResults" forall a b. (a -> b) -> a -> b
$ do
    Parser ()
enumResultsIgnore
    [DirItem]
es <- Parser [DirItem]
entries
    Maybe Text
nm <- Parser (Maybe Text)
nextMarker
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DirItem] -> Maybe Text -> DirItems
DirItems [DirItem]
es Maybe Text
nm)

enumResultsIgnore :: XB.Parser ()
enumResultsIgnore :: Parser ()
enumResultsIgnore = [Text] -> Parser ()
ignoreList [Text
"Marker", Text
"Prefix", Text
"MaxResults", Text
"DirectoryId"] 

-- marker :: XB.Parser (Maybe Text)
-- marker = optional (TL.toStrict <$> tag "Marker" anystring)

entries :: XB.Parser [DirItem]
entries :: Parser [DirItem]
entries = forall a. Text -> Parser a -> Parser a
tag Text
"Entries" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser DirItem
file forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser DirItem
directory)

file :: XB.Parser DirItem
file :: Parser DirItem
file = forall a. Text -> Parser a -> Parser a
tag Text
"File" forall a b. (a -> b) -> a -> b
$ do
  Text
fid <- Parser Text
fileId
  Text
fname <- Parser Text
fileName
  Parser ()
properties
  Parser ()
entryFooter
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> DirItem
DIFile Text
fid Text
fname

directory :: XB.Parser DirItem
directory :: Parser DirItem
directory = forall a. Text -> Parser a -> Parser a
tag Text
"Directory" forall a b. (a -> b) -> a -> b
$ do
  Text
fid <- Parser Text
fileId
  Text
fname <- Parser Text
fileName
  Parser ()
properties
  Parser ()
entryFooter
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> DirItem
DIDirectory Text
fid Text
fname



entryFooter :: XB.Parser ()
entryFooter :: Parser ()
entryFooter = [Text] -> Parser ()
ignoreList [Text
"Attributes", Text
"PermissionKey"]

fileId :: XB.Parser Text
fileId :: Parser Text
fileId = Text -> Text
TL.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
tag Text
"FileId" Parser Text
anystring

fileName :: XB.Parser Text
fileName :: Parser Text
fileName = Text -> Text
TL.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
tag Text
"Name" Parser Text
anystring

properties :: XB.Parser ()
properties :: Parser ()
properties = forall a. Text -> Parser a -> Parser a
tag Text
"Properties" forall a b. (a -> b) -> a -> b
$
  [Text] -> Parser ()
ignoreList [Text
"Content-Length", Text
"CreationTime", Text
"LastAccessTime", Text
"LastWriteTime", Text
"ChangeTime", Text
"Last-Modified", Text
"Etag"]

ignoreList :: [Text] -> XB.Parser ()
ignoreList :: [Text] -> Parser ()
ignoreList [Text]
ns = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Text -> Parser a -> Parser a
`XB.pElement` Parser Text
XB.pText) [Text]
ns))

nextMarker :: XB.Parser (Maybe Text)
nextMarker :: Parser (Maybe Text)
nextMarker = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Text
TL.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> Parser a -> Parser a
tag Text
"NextMarker" Parser Text
anystring)

-- selfClosing :: Text -> XB.Parser ()
-- selfClosing t = tag t (pure ())


anystring :: XB.Parser TL.Text
anystring :: Parser Text
anystring = Parser Text
XB.pText
tag :: Text -> XB.Parser a -> XB.Parser a
tag :: forall a. Text -> Parser a -> Parser a
tag = forall a. Text -> Parser a -> Parser a
XB.pElement

parseXML :: XB.Parser b -> BS.ByteString -> Either String b
parseXML :: forall b. Parser b -> ByteString -> Either String b
parseXML Parser b
p ByteString
bs = ByteString -> Either String [Node]
XB.fromRawXml ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Parser a -> [Node] -> Either String a
XB.runParser Parser b
p



-- -- t0, t1, tdir, tfile, tentries :: String
-- t0, t1, t1', tfile :: BS.ByteString
-- t0 = "<Properties><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties>"

-- t1' = "<?xml version=\"1.0\" encoding=\"utf-8\"?> <EnumerationResults ServiceEndpoint=\"https://myaccount.file.core.windows.net/\" ShareName=\"myshare\" ShareSnapshot=\"date-time\" DirectoryPath=\"directory-path\"> <Marker>string-value</Marker> <Prefix>string-value</Prefix> <MaxResults>int-value</MaxResults> <DirectoryId>directory-id</DirectoryId> <Entries> <File> <FileId>file-id</FileId> <Name>file-name</Name> <Properties> <Content-Length>size-in-bytes</Content-Length> <CreationTime>datetime</CreationTime> <LastAccessTime>datetime</LastAccessTime> <LastWriteTime>datetime</LastWriteTime> <ChangeTime>datetime</ChangeTime> <Last-Modified>datetime</Last-Modified> <Etag>etag</Etag> </Properties> <Attributes>Archive|Hidden|Offline|ReadOnly</Attributes> <PermissionKey>4066528134148476695*1</PermissionKey> </File> <Directory> <FileId>file-id</FileId> <Name>directory-name</Name> <Properties> <CreationTime>datetime</CreationTime> <LastAccessTime>datetime</LastAccessTime> <LastWriteTime>datetime</LastWriteTime> <ChangeTime>datetime</ChangeTime> <Last-Modified>datetime</Last-Modified> <Etag>etag</Etag> </Properties> <Attributes>Archive|Hidden|Offline|ReadOnly</Attributes> <PermissionKey>4066528134148476695*1</PermissionKey> </Directory> </Entries> <NextMarker /> </EnumerationResults>"

-- t1 = "<?xml version=\"1.0\" encoding=\"utf-8\"?><EnumerationResults ServiceEndpoint=\"https://myaccount.file.core.windows.net/\" ShareName=\"myshare\" ShareSnapshot=\"date-time\" DirectoryPath=\"directory-path\"><Marker>string-value</Marker><Prefix>string-value</Prefix><MaxResults>int-value</MaxResults><DirectoryId>directory-id</DirectoryId><Entries><File><FileId>file-id</FileId><Name>file-name</Name><Properties><Content-Length>size-in-bytes</Content-Length><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties><Attributes>Archive|Hidden|Offline|ReadOnly</Attributes><PermissionKey>4066528134148476695*1</PermissionKey></File><Directory><FileId>file-id</FileId><Name>directory-name</Name><Properties><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties><Attributes>Archive|Hidden|Offline|ReadOnly</Attributes><PermissionKey>4066528134148476695*1</PermissionKey></Directory></Entries><NextMarker /></EnumerationResults>"

-- -- tdir = "<Directory><FileId>file-id</FileId><Name>directory-name</Name><Properties><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties><Attributes>Archive|Hidden|Offline|ReadOnly</Attributes><PermissionKey>4066528134148476695*1</PermissionKey></Directory>"

-- tfile = "<File><FileId>file-id</FileId><Name>file-name</Name><Properties><Content-Length>size-in-bytes</Content-Length><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties><Attributes>Archive|Hidden|Offline|ReadOnly</Attributes><PermissionKey>4066528134148476695*1</PermissionKey></File>"

-- -- tentries = "<Entries><File><FileId>file-id</FileId><Name>file-name</Name><Properties><Content-Length>size-in-bytes</Content-Length><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties><Attributes>Archive|Hidden|Offline|ReadOnly</Attributes><PermissionKey>4066528134148476695*1</PermissionKey></File><Directory><FileId>file-id</FileId><Name>directory-name</Name><Properties><CreationTime>datetime</CreationTime><LastAccessTime>datetime</LastAccessTime><LastWriteTime>datetime</LastWriteTime><ChangeTime>datetime</ChangeTime><Last-Modified>datetime</Last-Modified><Etag>etag</Etag></Properties><Attributes>Archive|Hidden|Offline|ReadOnly</Attributes><PermissionKey>4066528134148476695*1</PermissionKey></Directory></Entries>"