module Network.AWS.CloudFront.SignedCookies.Policy
(
Policy (..)
, simplePolicy
, Resource (..)
, StartTime (..)
, EndTime (..)
, Lifespan (..)
, IpAddress (..)
, policyJSON
, jsonTextPolicy
, jsonValPolicy
) where
import Network.AWS.CloudFront.SignedCookies.Types (ByteString, EndTime (..), IpAddress (..), Lifespan (..), POSIXTime, Policy (..), Resource (..), StartTime (..), Text)
import Data.Aeson (toJSON, (.=))
import qualified Data.Aeson as A (Value, eitherDecode', encode, object)
import qualified Data.Aeson.Types as A (Pair)
import Control.Monad ((>=>))
import qualified Data.ByteString.Lazy as LBS
import Control.Lens ((^?))
import Data.Aeson.Lens (AsNumber (..), AsValue (..), key, nth)
import qualified Data.Text.Encoding as Text
import Data.Time.Clock.POSIX (getPOSIXTime)
policyJSON :: Policy -> ByteString
policyJSON :: Policy -> ByteString
policyJSON =
ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Policy -> ByteString) -> Policy -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode (Value -> ByteString) -> (Policy -> Value) -> Policy -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Policy -> Value
policyValue
policyValue :: Policy -> A.Value
policyValue :: Policy -> Value
policyValue Policy
policy = [Pair] -> Value
A.object [ Key
"Statement" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
statement ]
where
statement :: Value
statement = forall a. ToJSON a => a -> Value
toJSON @[A.Value]
[ [Pair] -> Value
A.object
[ Key
"Resource" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Policy -> Value
resourceValue Policy
policy
, Key
"Condition" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Policy -> Value
conditionValue Policy
policy
]
]
resourceValue :: Policy -> A.Value
resourceValue :: Policy -> Value
resourceValue (Policy (Resource Text
x) StartTime
_ EndTime
_ IpAddress
_) = forall a. ToJSON a => a -> Value
toJSON @Text Text
x
conditionValue :: Policy -> A.Value
conditionValue :: Policy -> Value
conditionValue (Policy Resource
_ StartTime
start EndTime
end IpAddress
ip) =
[Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
startCondition [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
endCondition [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
ipCondition
where
[Pair]
startCondition :: [A.Pair] =
case StartTime
start of
StartTime
StartImmediately -> []
StartTime POSIXTime
x -> [Key
"DateGreaterThan" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= POSIXTime -> Value
posixTimeValue POSIXTime
x]
[Pair]
endCondition :: [A.Pair] =
case EndTime
end of
EndTime POSIXTime
x -> [Key
"DateLessThan" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= POSIXTime -> Value
posixTimeValue POSIXTime
x]
[Pair]
ipCondition :: [A.Pair] =
case IpAddress
ip of
IpAddress
AnyIp -> []
IpAddress Text
x -> [Key
"IpAddress" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
sourceIpValue Text
x]
posixTimeValue :: POSIXTime -> A.Value
posixTimeValue :: POSIXTime -> Value
posixTimeValue POSIXTime
x = [Pair] -> Value
A.object [Key
"AWS:EpochTime" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= forall a. ToJSON a => a -> Value
toJSON @Integer (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
x) ]
sourceIpValue :: Text -> A.Value
sourceIpValue :: Text -> Value
sourceIpValue Text
x = [Pair] -> Value
A.object [Key
"AWS:SourceIp" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= forall a. ToJSON a => a -> Value
toJSON @Text Text
x]
jsonTextPolicy :: Text -> Either String Policy
jsonTextPolicy :: Text -> Either String Policy
jsonTextPolicy =
(ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' (ByteString -> Either String Value)
-> (Text -> ByteString) -> Text -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) (Text -> Either String Value)
-> (Value -> Either String Policy) -> Text -> Either String Policy
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
Value -> Either String Policy
jsonValPolicy
jsonValPolicy :: A.Value -> Either String Policy
jsonValPolicy :: Value -> Either String Policy
jsonValPolicy Value
val =
Resource -> StartTime -> EndTime -> IpAddress -> Policy
Policy
(Resource -> StartTime -> EndTime -> IpAddress -> Policy)
-> Either String Resource
-> Either String (StartTime -> EndTime -> IpAddress -> Policy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Either String Resource
jsonResource Value
val
Either String (StartTime -> EndTime -> IpAddress -> Policy)
-> Either String StartTime
-> Either String (EndTime -> IpAddress -> Policy)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either String StartTime
jsonStart Value
val
Either String (EndTime -> IpAddress -> Policy)
-> Either String EndTime -> Either String (IpAddress -> Policy)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either String EndTime
jsonEnd Value
val
Either String (IpAddress -> Policy)
-> Either String IpAddress -> Either String Policy
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Either String IpAddress
jsonIpAddress Value
val
jsonResource :: A.Value -> Either String Resource
jsonResource :: Value -> Either String Resource
jsonResource Value
val =
Either String Resource
-> (Resource -> Either String Resource)
-> Maybe Resource
-> Either String Resource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Resource
forall a b. a -> Either a b
Left String
"Missing \"Resource\"") Resource -> Either String Resource
forall a b. b -> Either a b
Right (Maybe Resource -> Either String Resource)
-> Maybe Resource -> Either String Resource
forall a b. (a -> b) -> a -> b
$
(Text -> Resource) -> Maybe Text -> Maybe Resource
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Resource
Resource
(Value
val Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Statement"
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversal' Value Value
forall t. AsValue t => Int -> Traversal' t Value
nth Int
0
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Resource"
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
jsonStart :: A.Value -> Either String StartTime
jsonStart :: Value -> Either String StartTime
jsonStart Value
val =
StartTime -> Either String StartTime
forall a b. b -> Either a b
Right (StartTime -> Either String StartTime)
-> StartTime -> Either String StartTime
forall a b. (a -> b) -> a -> b
$
StartTime -> (Integer -> StartTime) -> Maybe Integer -> StartTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StartTime
StartImmediately (POSIXTime -> StartTime
StartTime (POSIXTime -> StartTime)
-> (Integer -> POSIXTime) -> Integer -> StartTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger)
(Value
val Value -> Getting (First Integer) Value Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Statement"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversal' Value Value
forall t. AsValue t => Int -> Traversal' t Value
nth Int
0
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Condition"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"DateGreaterThan"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"AWS:EpochTime"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
Prism' Value Integer
_Integer)
jsonEnd :: A.Value -> Either String EndTime
jsonEnd :: Value -> Either String EndTime
jsonEnd Value
val =
Either String EndTime
-> (EndTime -> Either String EndTime)
-> Maybe EndTime
-> Either String EndTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String EndTime
forall a b. a -> Either a b
Left String
"Missing \"DateLessThan\"") EndTime -> Either String EndTime
forall a b. b -> Either a b
Right (Maybe EndTime -> Either String EndTime)
-> Maybe EndTime -> Either String EndTime
forall a b. (a -> b) -> a -> b
$
(Integer -> EndTime) -> Maybe Integer -> Maybe EndTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime -> EndTime
EndTime (POSIXTime -> EndTime)
-> (Integer -> POSIXTime) -> Integer -> EndTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger)
(Value
val Value -> Getting (First Integer) Value Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Statement"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversal' Value Value
forall t. AsValue t => Int -> Traversal' t Value
nth Int
0
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Condition"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"DateLessThan"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"AWS:EpochTime"
((Value -> Const (First Integer) Value)
-> Value -> Const (First Integer) Value)
-> Getting (First Integer) Value Integer
-> Getting (First Integer) Value Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Integer) Value Integer
forall t. AsNumber t => Prism' t Integer
Prism' Value Integer
_Integer)
jsonIpAddress :: A.Value -> Either String IpAddress
jsonIpAddress :: Value -> Either String IpAddress
jsonIpAddress Value
val =
IpAddress -> Either String IpAddress
forall a b. b -> Either a b
Right (IpAddress -> Either String IpAddress)
-> IpAddress -> Either String IpAddress
forall a b. (a -> b) -> a -> b
$
IpAddress -> (Text -> IpAddress) -> Maybe Text -> IpAddress
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IpAddress
AnyIp Text -> IpAddress
IpAddress
(Value
val Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Statement"
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Traversal' Value Value
forall t. AsValue t => Int -> Traversal' t Value
nth Int
0
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"Condition"
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"IpAddress"
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"AWS:SourceIp"
((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String)
simplePolicy
:: Resource
-> Lifespan
-> IO Policy
simplePolicy :: Resource -> Lifespan -> IO Policy
simplePolicy Resource
res Lifespan
life = do
POSIXTime
now :: POSIXTime <- IO POSIXTime
getPOSIXTime
let end :: EndTime
end = case Lifespan
life of Lifespan POSIXTime
x -> POSIXTime -> EndTime
EndTime (POSIXTime
now POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ POSIXTime
x)
Policy -> IO Policy
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Policy
{ policyResource :: Resource
policyResource = Resource
res
, policyEnd :: EndTime
policyEnd = EndTime
end
, policyStart :: StartTime
policyStart = StartTime
StartImmediately
, policyIpAddress :: IpAddress
policyIpAddress = IpAddress
AnyIp
}