module Network.AWS.CloudFront.SignedCookies.Types

  (
  -- * Policy
    Policy (..), Resource (..)

  -- * Crypto
  , PemFilePath (..), KeyPairId (..)

  -- * Cookies
  , CookiesText, SetCookie, CookieDomain (..), CookiePath (..)
  , PolicyCookie (..), SignatureCookie (..)

  -- * Time
  , NominalDiffTime, POSIXTime, Lifespan (..), StartTime (..), EndTime (..)

  -- * IP address
  , IpAddress (..)

  -- * Strings
  , Text, ByteString

  -- * Crypto
  , PrivateKey

  ) where

-- bytestring
import Data.ByteString (ByteString)

-- cookie
import Web.Cookie (CookiesText, SetCookie)

-- cryptonite
import Crypto.PubKey.RSA (PrivateKey (..), PublicKey (..))

-- text
import Data.Text (Text)

-- time
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Clock.POSIX (POSIXTime)

{- |

Location in the filesystem where a .pem file containing an
RSA secret key can be found.

The filename downloaded from AWS looks like this:

* @"pk-APKAIATX@@N3RCIOVT5WRQ.pem"@

-}
newtype PemFilePath = PemFilePath Text
  deriving (PemFilePath -> PemFilePath -> Bool
(PemFilePath -> PemFilePath -> Bool)
-> (PemFilePath -> PemFilePath -> Bool) -> Eq PemFilePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PemFilePath -> PemFilePath -> Bool
$c/= :: PemFilePath -> PemFilePath -> Bool
== :: PemFilePath -> PemFilePath -> Bool
$c== :: PemFilePath -> PemFilePath -> Bool
Eq, Int -> PemFilePath -> ShowS
[PemFilePath] -> ShowS
PemFilePath -> String
(Int -> PemFilePath -> ShowS)
-> (PemFilePath -> String)
-> ([PemFilePath] -> ShowS)
-> Show PemFilePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PemFilePath] -> ShowS
$cshowList :: [PemFilePath] -> ShowS
show :: PemFilePath -> String
$cshow :: PemFilePath -> String
showsPrec :: Int -> PemFilePath -> ShowS
$cshowsPrec :: Int -> PemFilePath -> ShowS
Show)

{- |

CloudFront key pair ID for the key pair that you are using to
generate signature.

The key pair ID can be found in the name of key files that you
download, and looks like this:

* @APKAIATXN3@@RCIOVT5WRQ@

-}
newtype KeyPairId = KeyPairId Text
  deriving (KeyPairId -> KeyPairId -> Bool
(KeyPairId -> KeyPairId -> Bool)
-> (KeyPairId -> KeyPairId -> Bool) -> Eq KeyPairId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyPairId -> KeyPairId -> Bool
$c/= :: KeyPairId -> KeyPairId -> Bool
== :: KeyPairId -> KeyPairId -> Bool
$c== :: KeyPairId -> KeyPairId -> Bool
Eq, Int -> KeyPairId -> ShowS
[KeyPairId] -> ShowS
KeyPairId -> String
(Int -> KeyPairId -> ShowS)
-> (KeyPairId -> String)
-> ([KeyPairId] -> ShowS)
-> Show KeyPairId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyPairId] -> ShowS
$cshowList :: [KeyPairId] -> ShowS
show :: KeyPairId -> String
$cshow :: KeyPairId -> String
showsPrec :: Int -> KeyPairId -> ShowS
$cshowsPrec :: Int -> KeyPairId -> ShowS
Show)

{- |

Examples:

* @"d123example.cl@@oudfront.net"@
* @"cloudfrontalia@@s.example.com"@

-}
newtype CookieDomain = CookieDomain Text
  deriving (CookieDomain -> CookieDomain -> Bool
(CookieDomain -> CookieDomain -> Bool)
-> (CookieDomain -> CookieDomain -> Bool) -> Eq CookieDomain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieDomain -> CookieDomain -> Bool
$c/= :: CookieDomain -> CookieDomain -> Bool
== :: CookieDomain -> CookieDomain -> Bool
$c== :: CookieDomain -> CookieDomain -> Bool
Eq, Int -> CookieDomain -> ShowS
[CookieDomain] -> ShowS
CookieDomain -> String
(Int -> CookieDomain -> ShowS)
-> (CookieDomain -> String)
-> ([CookieDomain] -> ShowS)
-> Show CookieDomain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieDomain] -> ShowS
$cshowList :: [CookieDomain] -> ShowS
show :: CookieDomain -> String
$cshow :: CookieDomain -> String
showsPrec :: Int -> CookieDomain -> ShowS
$cshowsPrec :: Int -> CookieDomain -> ShowS
Show)

-- | Usually @"/"@
newtype CookiePath = CookiePath Text
  deriving (CookiePath -> CookiePath -> Bool
(CookiePath -> CookiePath -> Bool)
-> (CookiePath -> CookiePath -> Bool) -> Eq CookiePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookiePath -> CookiePath -> Bool
$c/= :: CookiePath -> CookiePath -> Bool
== :: CookiePath -> CookiePath -> Bool
$c== :: CookiePath -> CookiePath -> Bool
Eq, Int -> CookiePath -> ShowS
[CookiePath] -> ShowS
CookiePath -> String
(Int -> CookiePath -> ShowS)
-> (CookiePath -> String)
-> ([CookiePath] -> ShowS)
-> Show CookiePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookiePath] -> ShowS
$cshowList :: [CookiePath] -> ShowS
show :: CookiePath -> String
$cshow :: CookiePath -> String
showsPrec :: Int -> CookiePath -> ShowS
$cshowsPrec :: Int -> CookiePath -> ShowS
Show)

-- | The value of a @CloudFront-Policy@ cookie.
newtype PolicyCookie = PolicyCookie Text
  deriving (PolicyCookie -> PolicyCookie -> Bool
(PolicyCookie -> PolicyCookie -> Bool)
-> (PolicyCookie -> PolicyCookie -> Bool) -> Eq PolicyCookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyCookie -> PolicyCookie -> Bool
$c/= :: PolicyCookie -> PolicyCookie -> Bool
== :: PolicyCookie -> PolicyCookie -> Bool
$c== :: PolicyCookie -> PolicyCookie -> Bool
Eq, Int -> PolicyCookie -> ShowS
[PolicyCookie] -> ShowS
PolicyCookie -> String
(Int -> PolicyCookie -> ShowS)
-> (PolicyCookie -> String)
-> ([PolicyCookie] -> ShowS)
-> Show PolicyCookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyCookie] -> ShowS
$cshowList :: [PolicyCookie] -> ShowS
show :: PolicyCookie -> String
$cshow :: PolicyCookie -> String
showsPrec :: Int -> PolicyCookie -> ShowS
$cshowsPrec :: Int -> PolicyCookie -> ShowS
Show)

-- | The value of a @CloudFront-Signature@ cookie.
newtype SignatureCookie = SignatureCookie Text
  deriving (SignatureCookie -> SignatureCookie -> Bool
(SignatureCookie -> SignatureCookie -> Bool)
-> (SignatureCookie -> SignatureCookie -> Bool)
-> Eq SignatureCookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureCookie -> SignatureCookie -> Bool
$c/= :: SignatureCookie -> SignatureCookie -> Bool
== :: SignatureCookie -> SignatureCookie -> Bool
$c== :: SignatureCookie -> SignatureCookie -> Bool
Eq, Int -> SignatureCookie -> ShowS
[SignatureCookie] -> ShowS
SignatureCookie -> String
(Int -> SignatureCookie -> ShowS)
-> (SignatureCookie -> String)
-> ([SignatureCookie] -> ShowS)
-> Show SignatureCookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureCookie] -> ShowS
$cshowList :: [SignatureCookie] -> ShowS
show :: SignatureCookie -> String
$cshow :: SignatureCookie -> String
showsPrec :: Int -> SignatureCookie -> ShowS
$cshowsPrec :: Int -> SignatureCookie -> ShowS
Show)

{- |

URL that a policy will grant access to, optionally containing
asterisks for wildcards.

Examples:

* @"https:\/@@\/d123example.cloudfront.net/index.html"@
* @"https:\/@@\/d123example.cloudfront.net/*.jpeg"@

-}
newtype Resource = Resource Text
  deriving (Resource -> Resource -> Bool
(Resource -> Resource -> Bool)
-> (Resource -> Resource -> Bool) -> Eq Resource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resource -> Resource -> Bool
$c/= :: Resource -> Resource -> Bool
== :: Resource -> Resource -> Bool
$c== :: Resource -> Resource -> Bool
Eq, Int -> Resource -> ShowS
[Resource] -> ShowS
Resource -> String
(Int -> Resource -> ShowS)
-> (Resource -> String) -> ([Resource] -> ShowS) -> Show Resource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resource] -> ShowS
$cshowList :: [Resource] -> ShowS
show :: Resource -> String
$cshow :: Resource -> String
showsPrec :: Int -> Resource -> ShowS
$cshowsPrec :: Int -> Resource -> ShowS
Show)

-- | How long from now the credentials expire
newtype Lifespan = Lifespan NominalDiffTime
  deriving (Lifespan -> Lifespan -> Bool
(Lifespan -> Lifespan -> Bool)
-> (Lifespan -> Lifespan -> Bool) -> Eq Lifespan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lifespan -> Lifespan -> Bool
$c/= :: Lifespan -> Lifespan -> Bool
== :: Lifespan -> Lifespan -> Bool
$c== :: Lifespan -> Lifespan -> Bool
Eq, Int -> Lifespan -> ShowS
[Lifespan] -> ShowS
Lifespan -> String
(Int -> Lifespan -> ShowS)
-> (Lifespan -> String) -> ([Lifespan] -> ShowS) -> Show Lifespan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lifespan] -> ShowS
$cshowList :: [Lifespan] -> ShowS
show :: Lifespan -> String
$cshow :: Lifespan -> String
showsPrec :: Int -> Lifespan -> ShowS
$cshowsPrec :: Int -> Lifespan -> ShowS
Show)

-- | The time at which credentials begin to take effect
data StartTime = StartImmediately | StartTime POSIXTime
  deriving (StartTime -> StartTime -> Bool
(StartTime -> StartTime -> Bool)
-> (StartTime -> StartTime -> Bool) -> Eq StartTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTime -> StartTime -> Bool
$c/= :: StartTime -> StartTime -> Bool
== :: StartTime -> StartTime -> Bool
$c== :: StartTime -> StartTime -> Bool
Eq, Int -> StartTime -> ShowS
[StartTime] -> ShowS
StartTime -> String
(Int -> StartTime -> ShowS)
-> (StartTime -> String)
-> ([StartTime] -> ShowS)
-> Show StartTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTime] -> ShowS
$cshowList :: [StartTime] -> ShowS
show :: StartTime -> String
$cshow :: StartTime -> String
showsPrec :: Int -> StartTime -> ShowS
$cshowsPrec :: Int -> StartTime -> ShowS
Show)

-- | The time at which credentials expire
newtype EndTime = EndTime POSIXTime
  deriving (EndTime -> EndTime -> Bool
(EndTime -> EndTime -> Bool)
-> (EndTime -> EndTime -> Bool) -> Eq EndTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndTime -> EndTime -> Bool
$c/= :: EndTime -> EndTime -> Bool
== :: EndTime -> EndTime -> Bool
$c== :: EndTime -> EndTime -> Bool
Eq, Int -> EndTime -> ShowS
[EndTime] -> ShowS
EndTime -> String
(Int -> EndTime -> ShowS)
-> (EndTime -> String) -> ([EndTime] -> ShowS) -> Show EndTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndTime] -> ShowS
$cshowList :: [EndTime] -> ShowS
show :: EndTime -> String
$cshow :: EndTime -> String
showsPrec :: Int -> EndTime -> ShowS
$cshowsPrec :: Int -> EndTime -> ShowS
Show)

-- | The IP address or address range of clients allowed to make requests
data IpAddress = AnyIp | IpAddress Text
  deriving (IpAddress -> IpAddress -> Bool
(IpAddress -> IpAddress -> Bool)
-> (IpAddress -> IpAddress -> Bool) -> Eq IpAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpAddress -> IpAddress -> Bool
$c/= :: IpAddress -> IpAddress -> Bool
== :: IpAddress -> IpAddress -> Bool
$c== :: IpAddress -> IpAddress -> Bool
Eq, Int -> IpAddress -> ShowS
[IpAddress] -> ShowS
IpAddress -> String
(Int -> IpAddress -> ShowS)
-> (IpAddress -> String)
-> ([IpAddress] -> ShowS)
-> Show IpAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpAddress] -> ShowS
$cshowList :: [IpAddress] -> ShowS
show :: IpAddress -> String
$cshow :: IpAddress -> String
showsPrec :: Int -> IpAddress -> ShowS
$cshowsPrec :: Int -> IpAddress -> ShowS
Show)

{- |

A policy specifies what resource is being granted, for what time period,
and to what IP addresses.

For AWS's documentation on what going into a CloudFront policy statement, see [Values That You Specify in the Policy Statement for a Custom Policy for Signed Cookies](https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/private-content-setting-signed-cookie-custom-policy.html#private-content-custom-policy-statement-cookies-values).

-}
data Policy =
  Policy
    { Policy -> Resource
policyResource  :: Resource
        -- ^ URL that the policy will grant access to,
        --   optionally containing asterisks for wildcards
    , Policy -> StartTime
policyStart     :: StartTime
        -- ^ The time at which credentials begin to take effect
    , Policy -> EndTime
policyEnd       :: EndTime
        -- ^ The time at which credentials expire
    , Policy -> IpAddress
policyIpAddress :: IpAddress
        -- ^ The IP address or address range of clients allowed to make requests
    }
    deriving (Policy -> Policy -> Bool
(Policy -> Policy -> Bool)
-> (Policy -> Policy -> Bool) -> Eq Policy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Policy -> Policy -> Bool
$c/= :: Policy -> Policy -> Bool
== :: Policy -> Policy -> Bool
$c== :: Policy -> Policy -> Bool
Eq, Int -> Policy -> ShowS
[Policy] -> ShowS
Policy -> String
(Int -> Policy -> ShowS)
-> (Policy -> String) -> ([Policy] -> ShowS) -> Show Policy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Policy] -> ShowS
$cshowList :: [Policy] -> ShowS
show :: Policy -> String
$cshow :: Policy -> String
showsPrec :: Int -> Policy -> ShowS
$cshowsPrec :: Int -> Policy -> ShowS
Show)