{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Network.DO.Spaces.Actions.GetBucketLocation
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.DO.Spaces.Actions.GetBucketLocation
    ( GetBucketLocation(..)
    , GetBucketLocationResponse(..)
    ) where

import           Control.Monad.Reader    ( MonadReader(ask) )

import           Data.ByteString         ( ByteString )
import qualified Data.Text               as T

import           GHC.Generics            ( Generic )

import           Network.DO.Spaces.Types
import           Network.DO.Spaces.Utils
import qualified Network.HTTP.Types      as H

import qualified Text.XML.Cursor         as X
import           Text.XML.Cursor         ( ($.//), (&/), (&|) )

-- | Query the location (the 'Region') of a 'Bucket'
newtype GetBucketLocation = GetBucketLocation
    { GetBucketLocation -> Bucket
bucket :: Bucket
      -- ^ The name of the 'Bucket' whose location you'd like to retrieve
    }
    deriving stock ( Int -> GetBucketLocation -> ShowS
[GetBucketLocation] -> ShowS
GetBucketLocation -> String
(Int -> GetBucketLocation -> ShowS)
-> (GetBucketLocation -> String)
-> ([GetBucketLocation] -> ShowS)
-> Show GetBucketLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketLocation] -> ShowS
$cshowList :: [GetBucketLocation] -> ShowS
show :: GetBucketLocation -> String
$cshow :: GetBucketLocation -> String
showsPrec :: Int -> GetBucketLocation -> ShowS
$cshowsPrec :: Int -> GetBucketLocation -> ShowS
Show, (forall x. GetBucketLocation -> Rep GetBucketLocation x)
-> (forall x. Rep GetBucketLocation x -> GetBucketLocation)
-> Generic GetBucketLocation
forall x. Rep GetBucketLocation x -> GetBucketLocation
forall x. GetBucketLocation -> Rep GetBucketLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBucketLocation x -> GetBucketLocation
$cfrom :: forall x. GetBucketLocation -> Rep GetBucketLocation x
Generic )
    deriving newtype ( GetBucketLocation -> GetBucketLocation -> Bool
(GetBucketLocation -> GetBucketLocation -> Bool)
-> (GetBucketLocation -> GetBucketLocation -> Bool)
-> Eq GetBucketLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketLocation -> GetBucketLocation -> Bool
$c/= :: GetBucketLocation -> GetBucketLocation -> Bool
== :: GetBucketLocation -> GetBucketLocation -> Bool
$c== :: GetBucketLocation -> GetBucketLocation -> Bool
Eq )

newtype GetBucketLocationResponse = GetBucketLocationResponse
    { GetBucketLocationResponse -> Region
locationConstraint :: Region
      -- ^ The 'Region' of the queried 'Bucket'
    }
    deriving stock ( Int -> GetBucketLocationResponse -> ShowS
[GetBucketLocationResponse] -> ShowS
GetBucketLocationResponse -> String
(Int -> GetBucketLocationResponse -> ShowS)
-> (GetBucketLocationResponse -> String)
-> ([GetBucketLocationResponse] -> ShowS)
-> Show GetBucketLocationResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBucketLocationResponse] -> ShowS
$cshowList :: [GetBucketLocationResponse] -> ShowS
show :: GetBucketLocationResponse -> String
$cshow :: GetBucketLocationResponse -> String
showsPrec :: Int -> GetBucketLocationResponse -> ShowS
$cshowsPrec :: Int -> GetBucketLocationResponse -> ShowS
Show, (forall x.
 GetBucketLocationResponse -> Rep GetBucketLocationResponse x)
-> (forall x.
    Rep GetBucketLocationResponse x -> GetBucketLocationResponse)
-> Generic GetBucketLocationResponse
forall x.
Rep GetBucketLocationResponse x -> GetBucketLocationResponse
forall x.
GetBucketLocationResponse -> Rep GetBucketLocationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBucketLocationResponse x -> GetBucketLocationResponse
$cfrom :: forall x.
GetBucketLocationResponse -> Rep GetBucketLocationResponse x
Generic )
    deriving newtype ( GetBucketLocationResponse -> GetBucketLocationResponse -> Bool
(GetBucketLocationResponse -> GetBucketLocationResponse -> Bool)
-> (GetBucketLocationResponse -> GetBucketLocationResponse -> Bool)
-> Eq GetBucketLocationResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBucketLocationResponse -> GetBucketLocationResponse -> Bool
$c/= :: GetBucketLocationResponse -> GetBucketLocationResponse -> Bool
== :: GetBucketLocationResponse -> GetBucketLocationResponse -> Bool
$c== :: GetBucketLocationResponse -> GetBucketLocationResponse -> Bool
Eq )

instance MonadSpaces m => Action m GetBucketLocation where
    type ConsumedResponse GetBucketLocation = GetBucketLocationResponse

    buildRequest :: GetBucketLocation -> m SpacesRequestBuilder
buildRequest GetBucketLocation { Bucket
bucket :: Bucket
$sel:bucket:GetBucketLocation :: GetBucketLocation -> Bucket
.. } = do
        Spaces
spaces <- m Spaces
forall r (m :: * -> *). MonadReader r m => m r
ask
        SpacesRequestBuilder -> m SpacesRequestBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpacesRequestBuilder :: Spaces
-> Maybe RequestBody
-> Maybe Method
-> [Header]
-> Maybe Bucket
-> Maybe Object
-> Maybe Query
-> Maybe Query
-> Maybe Region
-> SpacesRequestBuilder
SpacesRequestBuilder
             { $sel:bucket:SpacesRequestBuilder :: Maybe Bucket
bucket         = Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just Bucket
bucket
             , $sel:method:SpacesRequestBuilder :: Maybe Method
method         = Maybe Method
forall a. Maybe a
Nothing
             , $sel:body:SpacesRequestBuilder :: Maybe RequestBody
body           = Maybe RequestBody
forall a. Maybe a
Nothing
             , $sel:object:SpacesRequestBuilder :: Maybe Object
object         = Maybe Object
forall a. Maybe a
Nothing
             , $sel:headers:SpacesRequestBuilder :: [Header]
headers        = [Header]
forall a. Monoid a => a
mempty
             , $sel:overrideRegion:SpacesRequestBuilder :: Maybe Region
overrideRegion = Maybe Region
forall a. Maybe a
Nothing
             , $sel:queryString:SpacesRequestBuilder :: Maybe Query
queryString    = Maybe Query
forall a. Maybe a
Nothing
             , $sel:subresources:SpacesRequestBuilder :: Maybe Query
subresources   = Query -> Maybe Query
forall a. a -> Maybe a
Just
                   (Query -> Maybe Query) -> Query -> Maybe Query
forall a b. (a -> b) -> a -> b
$ Query -> Query
forall a. QueryLike a => a -> Query
H.toQuery [ ( ByteString
"location" :: ByteString
                                 , Maybe ByteString
forall a. Maybe a
Nothing :: Maybe ByteString
                                 )
                               ]
             , Spaces
$sel:spaces:SpacesRequestBuilder :: Spaces
spaces :: Spaces
..
             }

    consumeResponse :: RawResponse m -> m (ConsumedResponse GetBucketLocation)
consumeResponse RawResponse m
raw = do
        Cursor
cursor <- RawResponse m -> m Cursor
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
RawResponse m -> m Cursor
xmlDocCursor RawResponse m
raw
        Region -> GetBucketLocationResponse
GetBucketLocationResponse
            (Region -> GetBucketLocationResponse)
-> m Region -> m GetBucketLocationResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ClientException -> [m Region] -> m Region
forall e (f :: * -> *) a.
(Exception e, MonadThrow f) =>
e -> [f a] -> f a
X.forceM (Text -> ClientException
xmlElemError Text
"LocationConstraint")
                 ([m Region] -> m Region) -> [m Region] -> m Region
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [m Region]) -> [m Region]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$.// Text -> Axis
X.laxElement Text
"LocationConstraint" Axis -> (Cursor -> [m Region]) -> Cursor -> [m Region]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
X.content
                 (Cursor -> [Text]) -> (Text -> m Region) -> Cursor -> [m Region]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| (Text -> m Region
forall (m :: * -> *) a.
(MonadThrow m, IsString a, Eq a) =>
a -> m Region
slugToRegion (Text -> m Region) -> (Text -> Text) -> Text -> m Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip))