Adding custom LocationConstraint type

This allows more fine-grained (correct) control of de/serialisation for BucketLocationConstraint values. Fixes #249.
brendanhay · Nov 18, 2015 · b5b778b · b5b778b
1 parent 2d0d4bc
commit b5b778b
Show file tree

Hide file tree

Showing 2 changed files with 50 additions and 6 deletions.
diff --git a/amazonka-s3/src/Network/AWS/S3/Internal.hs b/amazonka-s3/src/Network/AWS/S3/Internal.hs
@@ -3,7 +3,9 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE MultiWayIf                 #-}
+{-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 
 -- |
@@ -15,12 +17,18 @@
 -- Portability : non-portable (GHC extensions)
 --
 module Network.AWS.S3.Internal
-    ( Region          (..)
-    , BucketName      (..)
-    , ETag            (..)
-    , ObjectVersionId (..)
+    ( Region             (..)
+    , BucketName         (..)
+    , ETag               (..)
+    , ObjectVersionId    (..)
+
+    -- * Bucket Location
+    , LocationConstraint (..)
+    , _LocationConstraint
+
+    -- * Object Key
     , Delimiter
-    , ObjectKey       (..)
+    , ObjectKey          (..)
     , _ObjectKey
     , keyPrefix
     , keyName
@@ -93,6 +101,42 @@ newtype ObjectVersionId = ObjectVersionId Text
         , ToLog
         )
 
+newtype LocationConstraint = LocationConstraint { location :: Region }
+    deriving
+        ( Eq
+        , Ord
+        , Read
+        , Show
+        , Data
+        , Typeable
+        , Generic
+        , ToText
+        , ToByteString
+        , ToLog
+        )
+
+_LocationConstraint :: Iso' LocationConstraint Region
+_LocationConstraint = iso location LocationConstraint
+
+instance FromText LocationConstraint where
+    parser = LocationConstraint <$> (parser <|> go)
+      where
+        go = takeLowerText >>= \case
+            ""   -> pure NorthVirginia
+            "eu" -> pure Ireland
+            e    -> fromTextError $
+                "Failure parsing LocationConstraint from " <> e
+
+instance FromXML LocationConstraint where
+    parseXML = \case
+        [] -> pure (LocationConstraint NorthVirginia)
+        ns -> parseXMLText "LocationConstraint" ns
+
+instance ToXML LocationConstraint where
+    toXML = \case
+        LocationConstraint NorthVirginia -> XNull
+        LocationConstraint r             -> toXMLText r
+
 newtype ObjectKey = ObjectKey Text
     deriving
         ( Eq

diff --git a/gen/config/s3.json b/gen/config/s3.json
@@ -48,7 +48,7 @@
         },
         "BucketLocationConstraint": {
             "replacedBy": {
-                "name": "Region",
+                "name": "LocationConstraint",
                 "deriving": []
             }
         },