module MSAzureAPI.StorageServices.FileService (
getFile
, listDirectoriesAndFiles
, 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)
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.Conduit as C (ConduitT, yield, runConduitRes)
import Data.Conduit ((.|))
import Network.OAuth.OAuth2.Internal (AccessToken(..))
import Network.HTTP.Req (HttpException, runReq, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:))
import Data.Text (Text, pack, unpack)
import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)
import Data.Time (UTCTime, getCurrentTime)
import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale)
import Data.Time.LocalTime (getZonedTime)
import qualified Xeno.DOM.Robust as X (Node, Content(..), name, contents, children)
import qualified Xmlbf.Xeno as XB (fromRawXml)
import qualified Xmlbf as XB (Parser, runParser, pElement, pText)
import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs, tryReq)
xMsVerHeader :: Option 'Https
= forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"x-ms-version" ByteString
"2022-11-02"
xMsDateHeader :: MonadIO m => m (Option 'Https)
= 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)
msStorageReqHeaders :: MonadIO m => m (Option 'Https)
= 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)
getFile :: Text
-> Text
-> Text
-> 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]
listDirectoriesAndFiles :: Text
-> Text
-> Text
-> Maybe Text
-> 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
data DirItem = DIFile {DirItem -> Text
diId :: Text, DirItem -> Text
diName :: Text}
| DIDirectory {diId :: Text, diName :: Text}
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)
data DirItems = DirItems {
DirItems -> [DirItem]
disItems :: [DirItem]
, DirItems -> Maybe Text
disResponseMarker :: Maybe Text
}
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"]
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 ()
= [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)
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