{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Network.AWS.Data.Sensitive
-- Copyright   : (c) 2013-2016 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
module Network.AWS.Data.Sensitive where

import           Control.DeepSeq
import           Data.Data                   (Data, Typeable)
import           Data.Hashable
import           Data.Monoid
import           Data.String
import           GHC.Generics                (Generic)
import           Network.AWS.Data.ByteString
import           Network.AWS.Data.JSON
import           Network.AWS.Data.Query
import           Network.AWS.Data.Text
import           Network.AWS.Data.XML
import           Network.AWS.Lens            (Iso', iso)

-- | /Note/: read . show /= isomorphic
newtype Sensitive a = Sensitive { desensitise :: a }
    deriving
        ( Eq
        , Ord
        , Read
        , IsString
        , Monoid
        , Data
        , Typeable
        , Generic
        , ToByteString
        , FromText
        , ToText
        , FromXML
        , ToXML
        , ToQuery
        , ToJSON
        , FromJSON
        )

instance Show (Sensitive a) where
    show = const "******"

instance Hashable a => Hashable (Sensitive a)
instance NFData   a => NFData   (Sensitive a)

_Sensitive :: Iso' (Sensitive a) a
_Sensitive = iso desensitise Sensitive