--
-- MinIO Haskell SDK, (C) 2017 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 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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
renderLBS RenderSettings
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) Map Name Text
forall a. Monoid a => a
mempty
    root :: Element
root =
      Text -> [Node] -> Element
s3Element
        Text
"CreateBucketConfiguration"
        [ Element -> Node
NodeElement (Element -> Node) -> Element -> Node
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 [] Maybe Doctype
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def Document
cmur
  where
    root :: Element
root =
      Name -> Map Name Text -> [Node] -> Element
Element Name
"CompleteMultipartUpload" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
        (PartTuple -> Node) -> [PartTuple] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node) -> (PartTuple -> Element) -> PartTuple -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartTuple -> Element
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"
        Map Name Text
forall a. Monoid a => a
mempty
        [ Element -> Node
NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$
            Name -> Map Name Text -> [Node] -> Element
Element
              Name
"PartNumber"
              Map Name Text
forall a. Monoid a => a
mempty
              [Text -> Node
NodeContent (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall b a. (Show a, IsString b) => a -> b
show a
n],
          Element -> Node
NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$
            Name -> Map Name Text -> [Node] -> Element
Element
              Name
"ETag"
              Map Name Text
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 [] Maybe Doctype
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
(XNode -> XNode -> Bool) -> (XNode -> XNode -> Bool) -> Eq XNode
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
(Int -> XNode -> ShowS)
-> (XNode -> String) -> ([XNode] -> ShowS) -> Show XNode
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
    RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def (Document -> ByteString) -> Document -> ByteString
forall a b. (a -> b) -> a -> b
$
      Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
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) Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
        (XNode -> Node) -> [XNode] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node) -> (XNode -> Element) -> XNode -> Node
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)
        Map Name Text
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" (Text -> XNode) -> (Event -> Text) -> Event -> XNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Text
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" ([XNode] -> XNode) -> [XNode] -> XNode
forall a b. (a -> b) -> a -> b
$
      (NotificationConfig -> XNode) -> [NotificationConfig] -> [XNode]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName Text
"QueueConfiguration" Text
"Queue") [NotificationConfig]
qc
        [XNode] -> [XNode] -> [XNode]
forall a. [a] -> [a] -> [a]
++ (NotificationConfig -> XNode) -> [NotificationConfig] -> [XNode]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> NotificationConfig -> XNode
toXNodesWithArnName Text
"TopicConfiguration" Text
"Topic") [NotificationConfig]
tc
        [XNode] -> [XNode] -> [XNode]
forall a. [a] -> [a] -> [a]
++ (NotificationConfig -> XNode) -> [NotificationConfig] -> [XNode]
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 ([XNode] -> XNode) -> [XNode] -> XNode
forall a b. (a -> b) -> a -> b
$
    [Text -> Text -> XNode
XLeaf Text
"Id" Text
itemId, Text -> Text -> XNode
XLeaf Text
arnName Text
arn]
      [XNode] -> [XNode] -> [XNode]
forall a. [a] -> [a] -> [a]
++ (Event -> XNode) -> [Event] -> [XNode]
forall a b. (a -> b) -> [a] -> [b]
map Event -> XNode
forall a. ToXNode a => a -> XNode
toXNode [Event]
events
      [XNode] -> [XNode] -> [XNode]
forall a. [a] -> [a] -> [a]
++ [Filter -> XNode
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" ((FilterRule -> XNode) -> [FilterRule] -> [XNode]
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 (XNode -> ByteString)
-> (Notification -> XNode) -> Notification -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Notification -> XNode
forall a. ToXNode a => a -> XNode
toXNode

mkSelectRequest :: SelectRequest -> ByteString
mkSelectRequest :: SelectRequest -> ByteString
mkSelectRequest SelectRequest
r = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
renderLBS RenderSettings
forall a. Default a => a
def Document
sr
  where
    sr :: Document
sr = Prologue -> Element -> [Miscellaneous] -> Document
Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
root []
    root :: Element
root =
      Name -> Map Name Text -> [Node] -> Element
Element Name
"SelectRequest" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
        [ Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element
                Name
"Expression"
                Map Name Text
forall a. Monoid a => a
mempty
                [Text -> Node
NodeContent (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ SelectRequest -> Text
srExpression SelectRequest
r]
            ),
          Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element
                Name
"ExpressionType"
                Map Name Text
forall a. Monoid a => a
mempty
                [Text -> Node
NodeContent (Text -> Node) -> Text -> Node
forall a b. (a -> b) -> a -> b
$ ExpressionType -> Text
forall b a. (Show a, IsString b) => a -> b
show (ExpressionType -> Text) -> ExpressionType -> Text
forall a b. (a -> b) -> a -> b
$ SelectRequest -> ExpressionType
srExpressionType SelectRequest
r]
            ),
          Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element Name
"InputSerialization" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
                InputSerialization -> [Node]
inputSerializationNodes (InputSerialization -> [Node]) -> InputSerialization -> [Node]
forall a b. (a -> b) -> a -> b
$
                  SelectRequest -> InputSerialization
srInputSerialization SelectRequest
r
            ),
          Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element Name
"OutputSerialization" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
                OutputSerialization -> [Node]
outputSerializationNodes (OutputSerialization -> [Node]) -> OutputSerialization -> [Node]
forall a b. (a -> b) -> a -> b
$
                  SelectRequest -> OutputSerialization
srOutputSerialization SelectRequest
r
            )
        ]
          [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Node] -> (Bool -> [Node]) -> Maybe Bool -> [Node]
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"
              Map Name Text
forall a. Monoid a => a
mempty
              [ Element -> Node
NodeElement
                  ( Name -> Map Name Text -> [Node] -> Element
Element
                      Name
"Enabled"
                      Map Name Text
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)
        [Node] -> [Node] -> [Node]
forall a. [a] -> [a] -> [a]
++ [Element -> Node
NodeElement (Element -> Node) -> Element -> Node
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 (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$
          Name -> Map Name Text -> [Node] -> Element
Element
            Name
"CompressionType"
            Map Name Text
forall a. Monoid a => a
mempty
            [ Text -> Node
NodeContent (Text -> Node) -> Text -> Node
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 Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Map Name Text
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"
        Map Name Text
forall a. Monoid a => a
mempty
        (((Text, Text) -> Node) -> [(Text, Text)] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node)
-> ((Text, Text) -> Element) -> (Text, Text) -> Node
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"
        Map Name Text
forall a. Monoid a => a
mempty
        [ Element -> Node
NodeElement
            ( Name -> Map Name Text -> [Node] -> Element
Element
                Name
"Type"
                Map Name Text
forall a. Monoid a => a
mempty
                [ Text -> Node
NodeContent (Text -> Node) -> Text -> Node
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" Map Name Text
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" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
              Maybe Text -> [Node]
rdElem (Maybe Text -> [Node]) -> Maybe Text -> [Node]
forall a b. (a -> b) -> a -> b
$
                JSONOutputProp -> Maybe Text
jsonopRecordDelimiter JSONOutputProp
j
          )
      ]
    outputSerializationNodes (OutputSerializationCSV CSVInputProp
c) =
      [ Element -> Node
NodeElement (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$
          Name -> Map Name Text -> [Node] -> Element
Element
            Name
"CSV"
            Map Name Text
forall a. Monoid a => a
mempty
            (((Text, Text) -> Node) -> [(Text, Text)] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node)
-> ((Text, Text) -> Element) -> (Text, Text) -> Node
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 (Element -> Node) -> Element -> Node
forall a b. (a -> b) -> a -> b
$
          Name -> Map Name Text -> [Node] -> Element
Element
            Name
"RecordDelimiter"
            Map Name Text
forall a. Monoid a => a
mempty
            [Text -> Node
NodeContent Text
t]
      ]