module Aws.SimpleDb.Core where

import           Aws.Core
import qualified Blaze.ByteString.Builder       as Blaze
import qualified Blaze.ByteString.Builder.Char8 as Blaze8
import qualified Control.Exception              as C
import           Control.Monad
import           Control.Monad.Trans.Resource   (MonadThrow, throwM)
import qualified Data.ByteString                as B
import qualified Data.ByteString.Base64         as Base64
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Semigroup                 as Sem
import qualified Data.Text                      as T
import qualified Data.Text.Encoding             as T
import           Data.Typeable
import           Prelude
import qualified Network.HTTP.Conduit           as HTTP
import qualified Network.HTTP.Types             as HTTP
import           Text.XML.Cursor                (($|), ($/), ($//), (&|))
import qualified Text.XML.Cursor                as Cu

type ErrorCode = String

data SdbError
    = SdbError {
        SdbError -> Status
sdbStatusCode :: HTTP.Status
      , SdbError -> ErrorCode
sdbErrorCode :: ErrorCode
      , SdbError -> ErrorCode
sdbErrorMessage :: String
      }
    deriving (Int -> SdbError -> ShowS
[SdbError] -> ShowS
SdbError -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [SdbError] -> ShowS
$cshowList :: [SdbError] -> ShowS
show :: SdbError -> ErrorCode
$cshow :: SdbError -> ErrorCode
showsPrec :: Int -> SdbError -> ShowS
$cshowsPrec :: Int -> SdbError -> ShowS
Show, Typeable)

instance C.Exception SdbError

data SdbMetadata
    = SdbMetadata {
        SdbMetadata -> Maybe Text
requestId :: Maybe T.Text
      , SdbMetadata -> Maybe Text
boxUsage :: Maybe T.Text
      }
    deriving (Int -> SdbMetadata -> ShowS
[SdbMetadata] -> ShowS
SdbMetadata -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [SdbMetadata] -> ShowS
$cshowList :: [SdbMetadata] -> ShowS
show :: SdbMetadata -> ErrorCode
$cshow :: SdbMetadata -> ErrorCode
showsPrec :: Int -> SdbMetadata -> ShowS
$cshowsPrec :: Int -> SdbMetadata -> ShowS
Show, Typeable)

instance Loggable SdbMetadata where
    toLogText :: SdbMetadata -> Text
toLogText (SdbMetadata Maybe Text
rid Maybe Text
bu) = Text
"SimpleDB: request ID=" forall a. Monoid a => a -> a -> a
`mappend`
                                     forall a. a -> Maybe a -> a
fromMaybe Text
"<none>" Maybe Text
rid forall a. Monoid a => a -> a -> a
`mappend`
                                     Text
", box usage=" forall a. Monoid a => a -> a -> a
`mappend`
                                     forall a. a -> Maybe a -> a
fromMaybe Text
"<not available>" Maybe Text
bu

instance Sem.Semigroup SdbMetadata where
    SdbMetadata Maybe Text
r1 Maybe Text
b1 <> :: SdbMetadata -> SdbMetadata -> SdbMetadata
<> SdbMetadata Maybe Text
r2 Maybe Text
b2 = Maybe Text -> Maybe Text -> SdbMetadata
SdbMetadata (Maybe Text
r1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
r2) (Maybe Text
b1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
b2)

instance Monoid SdbMetadata where
    mempty :: SdbMetadata
mempty = Maybe Text -> Maybe Text -> SdbMetadata
SdbMetadata forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    mappend :: SdbMetadata -> SdbMetadata -> SdbMetadata
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

data SdbConfiguration qt
    = SdbConfiguration {
        forall qt. SdbConfiguration qt -> Protocol
sdbiProtocol :: Protocol
      , forall qt. SdbConfiguration qt -> Method
sdbiHttpMethod :: Method
      , forall qt. SdbConfiguration qt -> ByteString
sdbiHost :: B.ByteString
      , forall qt. SdbConfiguration qt -> Int
sdbiPort :: Int
      }
    deriving (Int -> SdbConfiguration qt -> ShowS
forall qt. Int -> SdbConfiguration qt -> ShowS
forall qt. [SdbConfiguration qt] -> ShowS
forall qt. SdbConfiguration qt -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [SdbConfiguration qt] -> ShowS
$cshowList :: forall qt. [SdbConfiguration qt] -> ShowS
show :: SdbConfiguration qt -> ErrorCode
$cshow :: forall qt. SdbConfiguration qt -> ErrorCode
showsPrec :: Int -> SdbConfiguration qt -> ShowS
$cshowsPrec :: forall qt. Int -> SdbConfiguration qt -> ShowS
Show)

instance DefaultServiceConfiguration (SdbConfiguration NormalQuery) where
  defServiceConfig :: SdbConfiguration NormalQuery
defServiceConfig = ByteString -> SdbConfiguration NormalQuery
sdbHttpsPost ByteString
sdbUsEast
  debugServiceConfig :: SdbConfiguration NormalQuery
debugServiceConfig = ByteString -> SdbConfiguration NormalQuery
sdbHttpPost ByteString
sdbUsEast

instance DefaultServiceConfiguration (SdbConfiguration UriOnlyQuery) where
  defServiceConfig :: SdbConfiguration UriOnlyQuery
defServiceConfig = forall qt. ByteString -> SdbConfiguration qt
sdbHttpsGet ByteString
sdbUsEast
  debugServiceConfig :: SdbConfiguration UriOnlyQuery
debugServiceConfig = forall qt. ByteString -> SdbConfiguration qt
sdbHttpGet ByteString
sdbUsEast

sdbUsEast :: B.ByteString
sdbUsEast :: ByteString
sdbUsEast = ByteString
"sdb.amazonaws.com"

sdbUsWest :: B.ByteString
sdbUsWest :: ByteString
sdbUsWest = ByteString
"sdb.us-west-1.amazonaws.com"

sdbEuWest :: B.ByteString
sdbEuWest :: ByteString
sdbEuWest = ByteString
"sdb.eu-west-1.amazonaws.com"

sdbApSoutheast :: B.ByteString
sdbApSoutheast :: ByteString
sdbApSoutheast = ByteString
"sdb.ap-southeast-1.amazonaws.com"

sdbApNortheast :: B.ByteString
sdbApNortheast :: ByteString
sdbApNortheast = ByteString
"sdb.ap-northeast-1.amazonaws.com"

sdbHttpGet :: B.ByteString -> SdbConfiguration qt
sdbHttpGet :: forall qt. ByteString -> SdbConfiguration qt
sdbHttpGet ByteString
endpoint = forall qt.
Protocol -> Method -> ByteString -> Int -> SdbConfiguration qt
SdbConfiguration Protocol
HTTP Method
Get ByteString
endpoint (Protocol -> Int
defaultPort Protocol
HTTP)

sdbHttpPost :: B.ByteString -> SdbConfiguration NormalQuery
sdbHttpPost :: ByteString -> SdbConfiguration NormalQuery
sdbHttpPost ByteString
endpoint = forall qt.
Protocol -> Method -> ByteString -> Int -> SdbConfiguration qt
SdbConfiguration Protocol
HTTP Method
PostQuery ByteString
endpoint (Protocol -> Int
defaultPort Protocol
HTTP)

sdbHttpsGet :: B.ByteString -> SdbConfiguration qt
sdbHttpsGet :: forall qt. ByteString -> SdbConfiguration qt
sdbHttpsGet ByteString
endpoint = forall qt.
Protocol -> Method -> ByteString -> Int -> SdbConfiguration qt
SdbConfiguration Protocol
HTTPS Method
Get ByteString
endpoint (Protocol -> Int
defaultPort Protocol
HTTPS)

sdbHttpsPost :: B.ByteString -> SdbConfiguration NormalQuery
sdbHttpsPost :: ByteString -> SdbConfiguration NormalQuery
sdbHttpsPost ByteString
endpoint = forall qt.
Protocol -> Method -> ByteString -> Int -> SdbConfiguration qt
SdbConfiguration Protocol
HTTPS Method
PostQuery ByteString
endpoint (Protocol -> Int
defaultPort Protocol
HTTPS)

sdbSignQuery :: [(B.ByteString, B.ByteString)] -> SdbConfiguration qt -> SignatureData -> SignedQuery
sdbSignQuery :: forall qt.
[(ByteString, ByteString)]
-> SdbConfiguration qt -> SignatureData -> SignedQuery
sdbSignQuery [(ByteString, ByteString)]
q SdbConfiguration qt
si SignatureData
sd
    = SignedQuery {
        sqMethod :: Method
sqMethod = Method
method
      , sqProtocol :: Protocol
sqProtocol = forall qt. SdbConfiguration qt -> Protocol
sdbiProtocol SdbConfiguration qt
si
      , sqHost :: ByteString
sqHost = ByteString
host
      , sqPort :: Int
sqPort = forall qt. SdbConfiguration qt -> Int
sdbiPort SdbConfiguration qt
si
      , sqPath :: ByteString
sqPath = ByteString
path
      , sqQuery :: Query
sqQuery = Query
sq
      , sqDate :: Maybe UTCTime
sqDate = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SignatureData -> UTCTime
signatureTime SignatureData
sd
      , sqAuthorization :: Maybe (IO ByteString)
sqAuthorization = forall a. Maybe a
Nothing
      , sqContentType :: Maybe ByteString
sqContentType = forall a. Maybe a
Nothing
      , sqContentMd5 :: Maybe (Digest MD5)
sqContentMd5 = forall a. Maybe a
Nothing
      , sqAmzHeaders :: RequestHeaders
sqAmzHeaders = []
      , sqOtherHeaders :: RequestHeaders
sqOtherHeaders = []
      , sqBody :: Maybe RequestBody
sqBody = forall a. Maybe a
Nothing
      , sqStringToSign :: ByteString
sqStringToSign = ByteString
stringToSign
      }
    where
      ah :: AuthorizationHash
ah = AuthorizationHash
HmacSHA256
      q' :: Query
q' = forall a. QueryLike a => a -> Query
HTTP.toQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)]
q forall a. [a] -> [a] -> [a]
++ (ByteString
"Version", ByteString
"2009-04-15") forall a. a -> [a] -> [a]
: [(ByteString, ByteString)]
queryAuth
      ti :: AbsoluteTimeInfo
ti = SignatureData -> AbsoluteTimeInfo
signatureTimeInfo SignatureData
sd
      cr :: Credentials
cr = SignatureData -> Credentials
signatureCredentials SignatureData
sd
      queryAuth :: [(ByteString, ByteString)]
queryAuth = [case AbsoluteTimeInfo
ti of
                     AbsoluteTimestamp UTCTime
time -> (ByteString
"Timestamp", UTCTime -> ByteString
fmtAmzTime UTCTime
time)
                     AbsoluteExpires   UTCTime
time -> (ByteString
"Expires", UTCTime -> ByteString
fmtAmzTime UTCTime
time)
                  , (ByteString
"AWSAccessKeyId", Credentials -> ByteString
accessKeyID Credentials
cr)
                  , (ByteString
"SignatureMethod", AuthorizationHash -> ByteString
amzHash AuthorizationHash
ah)
                  , (ByteString
"SignatureVersion", ByteString
"2")]
                  forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
tok -> [(ByteString
"SecurityToken", ByteString
tok)]) (Credentials -> Maybe ByteString
iamToken Credentials
cr)
      sq :: Query
sq = (ByteString
"Signature", forall a. a -> Maybe a
Just ByteString
sig) forall a. a -> [a] -> [a]
: Query
q'
      method :: Method
method = forall qt. SdbConfiguration qt -> Method
sdbiHttpMethod SdbConfiguration qt
si
      host :: ByteString
host = forall qt. SdbConfiguration qt -> ByteString
sdbiHost SdbConfiguration qt
si
      path :: ByteString
path = ByteString
"/"
      sig :: ByteString
sig = Credentials -> AuthorizationHash -> ByteString -> ByteString
signature Credentials
cr AuthorizationHash
ah ByteString
stringToSign
      stringToSign :: ByteString
stringToSign = Builder -> ByteString
Blaze.toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
                     forall a. a -> [a] -> [a]
intersperse (Char -> Builder
Blaze8.fromChar Char
'\n')
                       [ByteString -> Builder
Blaze.copyByteString forall a b. (a -> b) -> a -> b
$ Method -> ByteString
httpMethod Method
method
                       , ByteString -> Builder
Blaze.copyByteString forall a b. (a -> b) -> a -> b
$ ByteString
host
                       , ByteString -> Builder
Blaze.copyByteString forall a b. (a -> b) -> a -> b
$ ByteString
path
                       , Bool -> Query -> Builder
HTTP.renderQueryBuilder Bool
False Query
q']

sdbResponseConsumer :: (Cu.Cursor -> Response SdbMetadata a)
                    -> IORef SdbMetadata
                    -> HTTPResponseConsumer a
sdbResponseConsumer :: forall a.
(Cursor -> Response SdbMetadata a)
-> IORef SdbMetadata -> HTTPResponseConsumer a
sdbResponseConsumer Cursor -> Response SdbMetadata a
inner IORef SdbMetadata
metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
resp
    = forall m a.
Monoid m =>
(Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
xmlCursorConsumer Cursor -> Response SdbMetadata a
parse IORef SdbMetadata
metadataRef Response (ConduitM () ByteString (ResourceT IO) ())
resp
    where parse :: Cursor -> Response SdbMetadata a
parse Cursor
cursor
              = do let requestId' :: Maybe Text
requestId' = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"RequestID"
                   let boxUsage' :: Maybe Text
boxUsage' = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
"BoxUsage"
                   forall m. m -> Response m ()
tellMetadata forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> SdbMetadata
SdbMetadata Maybe Text
requestId' Maybe Text
boxUsage'
                   case Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
Cu.laxElement Text
"Error" of
                     []      -> Cursor -> Response SdbMetadata a
inner Cursor
cursor
                     (Cursor
err:[Cursor]
_) -> Cursor -> Response SdbMetadata a
fromError Cursor
err
          fromError :: Cursor -> Response SdbMetadata a
fromError Cursor
cursor = do ErrorCode
errCode <- forall (m :: * -> *) a. MonadThrow m => ErrorCode -> [a] -> m a
force ErrorCode
"Missing Error Code" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [ErrorCode]
elCont Text
"Code"
                                ErrorCode
errMessage <- forall (m :: * -> *) a. MonadThrow m => ErrorCode -> [a] -> m a
force ErrorCode
"Missing Error Message" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [ErrorCode]
elCont Text
"Message"
                                forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Status -> ErrorCode -> ErrorCode -> SdbError
SdbError (forall body. Response body -> Status
HTTP.responseStatus Response (ConduitM () ByteString (ResourceT IO) ())
resp) ErrorCode
errCode ErrorCode
errMessage

class SdbFromResponse a where
    sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a

sdbCheckResponseType :: MonadThrow m => a -> T.Text -> Cu.Cursor -> m a
sdbCheckResponseType :: forall (m :: * -> *) a. MonadThrow m => a -> Text -> Cursor -> m a
sdbCheckResponseType a
a Text
n Cursor
c = do Cursor
_ <- forall (m :: * -> *) a. MonadThrow m => ErrorCode -> [a] -> m a
force (ErrorCode
"Expected response type " forall a. [a] -> [a] -> [a]
++ Text -> ErrorCode
T.unpack Text
n) (Text -> Axis
Cu.laxElement Text
n Cursor
c)
                                forall (m :: * -> *) a. Monad m => a -> m a
return a
a

decodeBase64 :: MonadThrow m => Cu.Cursor -> m T.Text
decodeBase64 :: forall (m :: * -> *). MonadThrow m => Cursor -> m Text
decodeBase64 Cursor
cursor =
  let encoded :: Text
encoded = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
Cu.content
      encoding :: Maybe Text
encoding = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> a) -> a
$| Text -> Cursor -> [Text]
Cu.laxAttribute Text
"encoding" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Text -> Text
T.toCaseFold
  in
    case Maybe Text
encoding of
      Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
encoded
      Just Text
"base64" -> case ByteString -> Either ErrorCode ByteString
Base64.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
encoded of
                         Left ErrorCode
msg -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ ErrorCode -> XmlException
XmlException (ErrorCode
"Invalid Base64 data: " forall a. [a] -> [a] -> [a]
++ ErrorCode
msg)
                         Right ByteString
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
x
      Just Text
actual -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ ErrorCode -> XmlException
XmlException (ErrorCode
"Unrecognized encoding " forall a. [a] -> [a] -> [a]
++ Text -> ErrorCode
T.unpack Text
actual)

data Attribute a
    = ForAttribute { forall a. Attribute a -> Text
attributeName :: T.Text, forall a. Attribute a -> a
attributeData :: a }
    deriving (Int -> Attribute a -> ShowS
forall a. Show a => Int -> Attribute a -> ShowS
forall a. Show a => [Attribute a] -> ShowS
forall a. Show a => Attribute a -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [Attribute a] -> ShowS
$cshowList :: forall a. Show a => [Attribute a] -> ShowS
show :: Attribute a -> ErrorCode
$cshow :: forall a. Show a => Attribute a -> ErrorCode
showsPrec :: Int -> Attribute a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Attribute a -> ShowS
Show)

readAttribute :: MonadThrow m => Cu.Cursor -> m (Attribute T.Text)
readAttribute :: forall (m :: * -> *). MonadThrow m => Cursor -> m (Attribute Text)
readAttribute Cursor
cursor = do
  Text
name <- forall (m :: * -> *) a. MonadThrow m => ErrorCode -> [m a] -> m a
forceM ErrorCode
"Missing Name" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Name" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| forall (m :: * -> *). MonadThrow m => Cursor -> m Text
decodeBase64
  Text
value <- forall (m :: * -> *) a. MonadThrow m => ErrorCode -> [m a] -> m a
forceM ErrorCode
"Missing Value" forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Value" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| forall (m :: * -> *). MonadThrow m => Cursor -> m Text
decodeBase64
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Text -> a -> Attribute a
ForAttribute Text
name Text
value

data SetAttribute
    = SetAttribute { SetAttribute -> Text
setAttribute :: T.Text, SetAttribute -> Bool
isReplaceAttribute :: Bool }
    deriving (Int -> SetAttribute -> ShowS
[SetAttribute] -> ShowS
SetAttribute -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [SetAttribute] -> ShowS
$cshowList :: [SetAttribute] -> ShowS
show :: SetAttribute -> ErrorCode
$cshow :: SetAttribute -> ErrorCode
showsPrec :: Int -> SetAttribute -> ShowS
$cshowsPrec :: Int -> SetAttribute -> ShowS
Show)

attributeQuery :: (a -> [(B.ByteString, B.ByteString)]) -> Attribute a -> [(B.ByteString, B.ByteString)]
attributeQuery :: forall a.
(a -> [(ByteString, ByteString)])
-> Attribute a -> [(ByteString, ByteString)]
attributeQuery  a -> [(ByteString, ByteString)]
f (ForAttribute Text
name a
x) =  (ByteString
"Name", Text -> ByteString
T.encodeUtf8 Text
name) forall a. a -> [a] -> [a]
: a -> [(ByteString, ByteString)]
f a
x

addAttribute :: T.Text -> T.Text -> Attribute SetAttribute
addAttribute :: Text -> Text -> Attribute SetAttribute
addAttribute Text
name Text
value = forall a. Text -> a -> Attribute a
ForAttribute Text
name (Text -> Bool -> SetAttribute
SetAttribute Text
value Bool
False)

replaceAttribute :: T.Text -> T.Text -> Attribute SetAttribute
replaceAttribute :: Text -> Text -> Attribute SetAttribute
replaceAttribute Text
name Text
value = forall a. Text -> a -> Attribute a
ForAttribute Text
name (Text -> Bool -> SetAttribute
SetAttribute Text
value Bool
True)

setAttributeQuery :: SetAttribute -> [(B.ByteString, B.ByteString)]
setAttributeQuery :: SetAttribute -> [(ByteString, ByteString)]
setAttributeQuery (SetAttribute Text
value Bool
replace)
    = (ByteString
"Value", Text -> ByteString
T.encodeUtf8 Text
value) forall a. a -> [a] -> [a]
: [(ByteString
"Replace", ByteString
awsTrue) | Bool
replace]

data DeleteAttribute
    = DeleteAttribute
    | ValuedDeleteAttribute { DeleteAttribute -> Text
deleteAttributeValue :: T.Text }
    deriving (Int -> DeleteAttribute -> ShowS
[DeleteAttribute] -> ShowS
DeleteAttribute -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [DeleteAttribute] -> ShowS
$cshowList :: [DeleteAttribute] -> ShowS
show :: DeleteAttribute -> ErrorCode
$cshow :: DeleteAttribute -> ErrorCode
showsPrec :: Int -> DeleteAttribute -> ShowS
$cshowsPrec :: Int -> DeleteAttribute -> ShowS
Show)

deleteAttributeQuery :: DeleteAttribute -> [(B.ByteString, B.ByteString)]
deleteAttributeQuery :: DeleteAttribute -> [(ByteString, ByteString)]
deleteAttributeQuery DeleteAttribute
DeleteAttribute = []
deleteAttributeQuery (ValuedDeleteAttribute Text
value) = [(ByteString
"Value", Text -> ByteString
T.encodeUtf8 Text
value)]

data ExpectedAttribute
    = ExpectedValue { ExpectedAttribute -> Text
expectedAttributeValue :: T.Text }
    | ExpectedExists { ExpectedAttribute -> Bool
expectedAttributeExists :: Bool }
    deriving (Int -> ExpectedAttribute -> ShowS
[ExpectedAttribute] -> ShowS
ExpectedAttribute -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedAttribute] -> ShowS
$cshowList :: [ExpectedAttribute] -> ShowS
show :: ExpectedAttribute -> ErrorCode
$cshow :: ExpectedAttribute -> ErrorCode
showsPrec :: Int -> ExpectedAttribute -> ShowS
$cshowsPrec :: Int -> ExpectedAttribute -> ShowS
Show)

expectedValue :: T.Text -> T.Text -> Attribute ExpectedAttribute
expectedValue :: Text -> Text -> Attribute ExpectedAttribute
expectedValue Text
name Text
value = forall a. Text -> a -> Attribute a
ForAttribute Text
name (Text -> ExpectedAttribute
ExpectedValue Text
value)

expectedExists :: T.Text -> Bool -> Attribute ExpectedAttribute
expectedExists :: Text -> Bool -> Attribute ExpectedAttribute
expectedExists Text
name Bool
exists = forall a. Text -> a -> Attribute a
ForAttribute Text
name (Bool -> ExpectedAttribute
ExpectedExists Bool
exists)

expectedAttributeQuery :: ExpectedAttribute -> [(B.ByteString, B.ByteString)]
expectedAttributeQuery :: ExpectedAttribute -> [(ByteString, ByteString)]
expectedAttributeQuery (ExpectedValue Text
value) = [(ByteString
"Value", Text -> ByteString
T.encodeUtf8 Text
value)]
expectedAttributeQuery (ExpectedExists Bool
exists) = [(ByteString
"Exists", Bool -> ByteString
awsBool Bool
exists)]

data Item a
    = Item { forall a. Item a -> Text
itemName :: T.Text, forall a. Item a -> a
itemData :: a }
    deriving (Int -> Item a -> ShowS
forall a. Show a => Int -> Item a -> ShowS
forall a. Show a => [Item a] -> ShowS
forall a. Show a => Item a -> ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> ErrorCode) -> ([a] -> ShowS) -> Show a
showList :: [Item a] -> ShowS
$cshowList :: forall a. Show a => [Item a] -> ShowS
show :: Item a -> ErrorCode
$cshow :: forall a. Show a => Item a -> ErrorCode
showsPrec :: Int -> Item a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Item a -> ShowS
Show)

readItem :: MonadThrow m => Cu.Cursor -> m (Item [Attribute T.Text])
readItem :: forall (m :: * -> *).
MonadThrow m =>
Cursor -> m (Item [Attribute Text])
readItem Cursor
cursor = do
  Text
name <- forall (m :: * -> *) a. MonadThrow m => ErrorCode -> [a] -> m a
force ErrorCode
"Missing Name" forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Name" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| forall (m :: * -> *). MonadThrow m => Cursor -> m Text
decodeBase64
  [Attribute Text]
attributes <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Axis
Cu.laxElement Text
"Attribute" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| forall (m :: * -> *). MonadThrow m => Cursor -> m (Attribute Text)
readAttribute
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Text -> a -> Item a
Item Text
name [Attribute Text]
attributes

itemQuery :: (a -> [(B.ByteString, B.ByteString)]) -> Item a -> [(B.ByteString, B.ByteString)]
itemQuery :: forall a.
(a -> [(ByteString, ByteString)])
-> Item a -> [(ByteString, ByteString)]
itemQuery a -> [(ByteString, ByteString)]
f (Item Text
name a
x) = (ByteString
"ItemName", Text -> ByteString
T.encodeUtf8 Text
name) forall a. a -> [a] -> [a]
: a -> [(ByteString, ByteString)]
f a
x