--
-- MinIO Haskell SDK, (C) 2017-2023 MinIO, Inc.
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
--

module Network.Minio.XmlGenerator
  ( mkCreateBucketConfig,
    mkCompleteMultipartUploadRequest,
    mkPutNotificationRequest,
    mkSelectRequest,
  )
where

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import Network.Minio.Data
import Network.Minio.XmlCommon
import Text.XML

-- | Create a bucketConfig request body XML
mkCreateBucketConfig :: Text -> Region -> ByteString
mkCreateBucketConfig :: Text -> Text -> ByteString
mkCreateBucketConfig Text
ns Text
location = ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def Document
bucketConfig
  where
    s3Element :: Text -> [Node] -> Element
s3Element Text
n = Name -> Map Name Text -> [Node] -> Element
Element (Text -> Text -> Name
s3Name Text
ns Text
n) forall a. Monoid a => a
mempty
    root :: Element
root =
      Text -> [Node] -> Element
s3Element
        Text
"CreateBucketConfiguration"
        [ Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
            Text -> [Node] -> Element
s3Element
              Text
"LocationConstraint"
              [Text -> Node
NodeContent Text
location]
        ]
    bucketConfig :: Document
bucketConfig = Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []

-- | Create a completeMultipartUpload request body XML
mkCompleteMultipartUploadRequest :: [PartTuple] -> ByteString
mkCompleteMultipartUploadRequest :: [PartTuple] -> ByteString
mkCompleteMultipartUploadRequest [PartTuple]
partInfo =
  ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def Document
cmur
  where
    root :: Element
root =
      Name -> Map Name Text -> [Node] -> Element
Element Name
"CompleteMultipartUpload" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => (a, Text) -> Element
mkPart) [PartTuple]
partInfo
    mkPart :: (a, Text) -> Element
mkPart (a
n, Text
etag) =
      Name -> Map Name Text -> [Node] -> Element
Element
        Name
"Part"
        forall a. Monoid a => a
mempty
        [ Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
            Name -> Map Name Text -> [Node] -> Element
Element
              Name
"PartNumber"
              forall a. Monoid a => a
mempty
              [Text -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show a
n],
          Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
            Name -> Map Name Text -> [Node] -> Element
Element
              Name
"ETag"
              forall a. Monoid a => a
mempty
              [Text -> Node
NodeContent Text
etag]
        ]
    cmur :: Document
cmur = Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []

-- Simplified XML representation without element attributes.
data XNode
  = XNode Text [XNode]
  | XLeaf Text Text
  deriving stock (XNode -> XNode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XNode -> XNode -> Bool
$c/= :: XNode -> XNode -> Bool
== :: XNode -> XNode -> Bool
$c== :: XNode -> XNode -> Bool
Eq, Int -> XNode -> ShowS
[XNode] -> ShowS
XNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XNode] -> ShowS
$cshowList :: [XNode] -> ShowS
show :: XNode -> String
$cshow :: XNode -> String
showsPrec :: Int -> XNode -> ShowS
$cshowsPrec :: Int -> XNode -> ShowS
Show)

toXML :: Text -> XNode -> ByteString
toXML :: Text -> XNode -> ByteString
toXML Text
ns XNode
node =
  ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$
    RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$
      Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) (XNode -> Element
xmlNode XNode
node) []
  where
    xmlNode :: XNode -> Element
    xmlNode :: XNode -> Element
xmlNode (XNode Text
name [XNode]
nodes) =
      Name -> Map Name Text -> [Node] -> Element
Element (Text -> Text -> Name
s3Name Text
ns Text
name) forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNode -> Element
xmlNode) [XNode]
nodes
    xmlNode (XLeaf Text
name Text
content) =
      Name -> Map Name Text -> [Node] -> Element
Element
        (Text -> Text -> Name
s3Name Text
ns Text
name)
        forall a. Monoid a => a
mempty
        [Text -> Node
NodeContent Text
content]

class ToXNode a where
  toXNode :: a -> XNode

instance ToXNode Event where
  toXNode :: Event -> XNode
toXNode = Text -> Text -> XNode
XLeaf Text
"Event" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText

instance ToXNode Notification where
  toXNode :: Notification -> XNode
toXNode (Notification [NotificationConfig]
qc [NotificationConfig]
tc [NotificationConfig]
lc) =
    Text -> [XNode] -> XNode
XNode Text
"NotificationConfiguration" forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName Text
"QueueConfiguration" Text
"Queue") [NotificationConfig]
qc
        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName Text
"TopicConfiguration" Text
"Topic") [NotificationConfig]
tc
        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName Text
"CloudFunctionConfiguration" Text
"CloudFunction") [NotificationConfig]
lc

toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName Text
eltName Text
arnName (NotificationConfig Text
itemId Text
arn [Event]
events Filter
fRule) =
  Text -> [XNode] -> XNode
XNode Text
eltName forall a b. (a -> b) -> a -> b
$
    [Text -> Text -> XNode
XLeaf Text
"Id" Text
itemId, Text -> Text -> XNode
XLeaf Text
arnName Text
arn]
      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. ToXNode a => a -> XNode
toXNode [Event]
events
      forall a. [a] -> [a] -> [a]
++ [forall a. ToXNode a => a -> XNode
toXNode Filter
fRule]

instance ToXNode Filter where
  toXNode :: Filter -> XNode
toXNode (Filter (FilterKey (FilterRules [FilterRule]
rules))) =
    Text -> [XNode] -> XNode
XNode Text
"Filter" [Text -> [XNode] -> XNode
XNode Text
"S3Key" (forall a b. (a -> b) -> [a] -> [b]
map FilterRule -> XNode
getFRXNode [FilterRule]
rules)]

getFRXNode :: FilterRule -> XNode
getFRXNode :: FilterRule -> XNode
getFRXNode (FilterRule Text
n Text
v) =
  Text -> [XNode] -> XNode
XNode
    Text
"FilterRule"
    [ Text -> Text -> XNode
XLeaf Text
"Name" Text
n,
      Text -> Text -> XNode
XLeaf Text
"Value" Text
v
    ]

mkPutNotificationRequest :: Text -> Notification -> ByteString
mkPutNotificationRequest :: Text -> Notification -> ByteString
mkPutNotificationRequest Text
ns = Text -> XNode -> ByteString
toXML Text
ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToXNode a => a -> XNode
toXNode

mkSelectRequest :: SelectRequest -> ByteString
mkSelectRequest :: SelectRequest -> ByteString
mkSelectRequest SelectRequest
r = ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
renderLBS forall a. Default a => a
def Document
sr
  where
    sr :: Document
sr = Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] forall a. Maybe a
Nothing []) Element
root []
    root :: Element
root =
      Name -> Map Name Text -> [Node] -> Element
Element Name
"SelectRequest" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
        [ Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element
                Name
"Expression"
                forall a. Monoid a => a
mempty
                [Text -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ SelectRequest -> Text
srExpression SelectRequest
r]
            ),
          Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element
                Name
"ExpressionType"
                forall a. Monoid a => a
mempty
                [Text -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show forall a b. (a -> b) -> a -> b
$ SelectRequest -> ExpressionType
srExpressionType SelectRequest
r]
            ),
          Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element Name
"InputSerialization" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
                InputSerialization -> [Node]
inputSerializationNodes forall a b. (a -> b) -> a -> b
$
                  SelectRequest -> InputSerialization
srInputSerialization SelectRequest
r
            ),
          Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element Name
"OutputSerialization" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
                OutputSerialization -> [Node]
outputSerializationNodes forall a b. (a -> b) -> a -> b
$
                  SelectRequest -> OutputSerialization
srOutputSerialization SelectRequest
r
            )
        ]
          forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Bool -> [Node]
reqProgElem (SelectRequest -> Maybe Bool
srRequestProgressEnabled SelectRequest
r)
    reqProgElem :: Bool -> [Node]
reqProgElem Bool
enabled =
      [ Element -> Node
NodeElement
          ( Name -> Map Name Text -> [Node] -> Element
Element
              Name
"RequestProgress"
              forall a. Monoid a => a
mempty
              [ Element -> Node
NodeElement
                  ( Name -> Map Name Text -> [Node] -> Element
Element
                      Name
"Enabled"
                      forall a. Monoid a => a
mempty
                      [ Text -> Node
NodeContent
                          (if Bool
enabled then Text
"TRUE" else Text
"FALSE")
                      ]
                  )
              ]
          )
      ]
    inputSerializationNodes :: InputSerialization -> [Node]
inputSerializationNodes InputSerialization
is =
      Maybe CompressionType -> [Node]
comprTypeNode (InputSerialization -> Maybe CompressionType
isCompressionType InputSerialization
is)
        forall a. [a] -> [a] -> [a]
++ [Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$ InputFormatInfo -> Element
formatNode (InputSerialization -> InputFormatInfo
isFormatInfo InputSerialization
is)]
    comprTypeNode :: Maybe CompressionType -> [Node]
comprTypeNode (Just CompressionType
c) =
      [ Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
          Name -> Map Name Text -> [Node] -> Element
Element
            Name
"CompressionType"
            forall a. Monoid a => a
mempty
            [ Text -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ case CompressionType
c of
                CompressionType
CompressionTypeNone -> Text
"NONE"
                CompressionType
CompressionTypeGzip -> Text
"GZIP"
                CompressionType
CompressionTypeBzip2 -> Text
"BZIP2"
            ]
      ]
    comprTypeNode Maybe CompressionType
Nothing = []
    kvElement :: (Text, Text) -> Element
kvElement (Text
k, Text
v) = Name -> Map Name Text -> [Node] -> Element
Element (Text -> Maybe Text -> Maybe Text -> Name
Name Text
k forall a. Maybe a
Nothing forall a. Maybe a
Nothing) forall a. Monoid a => a
mempty [Text -> Node
NodeContent Text
v]
    formatNode :: InputFormatInfo -> Element
formatNode (InputFormatCSV CSVInputProp
c) =
      Name -> Map Name Text -> [Node] -> Element
Element
        Name
"CSV"
        forall a. Monoid a => a
mempty
        (forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Element
kvElement) (CSVInputProp -> [(Text, Text)]
csvPropsList CSVInputProp
c))
    formatNode (InputFormatJSON JSONInputProp
p) =
      Name -> Map Name Text -> [Node] -> Element
Element
        Name
"JSON"
        forall a. Monoid a => a
mempty
        [ Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element
                Name
"Type"
                forall a. Monoid a => a
mempty
                [ Text -> Node
NodeContent forall a b. (a -> b) -> a -> b
$ case JSONInputProp -> JSONType
jsonipType JSONInputProp
p of
                    JSONType
JSONTypeDocument -> Text
"DOCUMENT"
                    JSONType
JSONTypeLines -> Text
"LINES"
                ]
            )
        ]
    formatNode InputFormatInfo
InputFormatParquet = Name -> Map Name Text -> [Node] -> Element
Element Name
"Parquet" forall a. Monoid a => a
mempty []
    outputSerializationNodes :: OutputSerialization -> [Node]
outputSerializationNodes (OutputSerializationJSON JSONOutputProp
j) =
      [ Element -> Node
NodeElement
          ( Name -> Map Name Text -> [Node] -> Element
Element Name
"JSON" forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
              Maybe Text -> [Node]
rdElem forall a b. (a -> b) -> a -> b
$
                JSONOutputProp -> Maybe Text
jsonopRecordDelimiter JSONOutputProp
j
          )
      ]
    outputSerializationNodes (OutputSerializationCSV CSVInputProp
c) =
      [ Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
          Name -> Map Name Text -> [Node] -> Element
Element
            Name
"CSV"
            forall a. Monoid a => a
mempty
            (forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Element
kvElement) (CSVInputProp -> [(Text, Text)]
csvPropsList CSVInputProp
c))
      ]
    rdElem :: Maybe Text -> [Node]
rdElem Maybe Text
Nothing = []
    rdElem (Just Text
t) =
      [ Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$
          Name -> Map Name Text -> [Node] -> Element
Element
            Name
"RecordDelimiter"
            forall a. Monoid a => a
mempty
            [Text -> Node
NodeContent Text
t]
      ]