-- | Command-line interface for generating AWS CloudFront signed cookies.

module Network.AWS.CloudFront.SignedCookies.CLI.Sign
  ( main, mainOpts, Opts (..), optsParser, mainParserInfo
  ) where

import Network.AWS.CloudFront.SignedCookies (KeyPairId (..), Lifespan (..), PemFilePath (..), Resource (..), createSignedCookies, readPrivateKeyPemFile, renderCookiesText, simplePolicy)
import Network.AWS.CloudFront.SignedCookies.CLI.Internal (days, text)

-- optparse-applicative
import qualified Options.Applicative as Opt

-- text
import qualified Data.Text.IO as Text

-- | Entry point for the AWS CloudFront cookie-signing command-line interface.

main :: IO ()
main :: IO ()
main = do

  Opts
opts <- ParserInfo Opts -> IO Opts
forall a. ParserInfo a -> IO a
Opt.execParser (ParserInfo Opts -> IO Opts) -> ParserInfo Opts -> IO Opts
forall a b. (a -> b) -> a -> b
$ Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser (Opts -> Opts)
forall a. Parser (a -> a)
Opt.helper Parser (Opts -> Opts) -> Parser Opts -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Opts
optsParser) InfoMod Opts
forall a. InfoMod a
infoMod

  Opts -> IO ()
mainOpts Opts
opts

mainOpts :: Opts -> IO ()
mainOpts :: Opts -> IO ()
mainOpts Opts{Lifespan
Resource
KeyPairId
PemFilePath
opt_lifespan :: Opts -> Lifespan
opt_resource :: Opts -> Resource
opt_keyPairId :: Opts -> KeyPairId
opt_pemFilePath :: Opts -> PemFilePath
opt_lifespan :: Lifespan
opt_resource :: Resource
opt_keyPairId :: KeyPairId
opt_pemFilePath :: PemFilePath
..} = do

  -- Construct an IAM policy
  Policy
policy <- Resource -> Lifespan -> IO Policy
simplePolicy Resource
opt_resource Lifespan
opt_lifespan

  -- Parse the .pem file to get the private key
  PrivateKey
key <- PemFilePath -> IO PrivateKey
readPrivateKeyPemFile PemFilePath
opt_pemFilePath

  -- Construct signed cookies
  CookiesText
cookies <- KeyPairId -> PrivateKey -> Policy -> IO CookiesText
createSignedCookies KeyPairId
opt_keyPairId PrivateKey
key Policy
policy

  -- Print the cookies to stdout
  (Text -> IO ()
Text.putStr (Text -> IO ()) -> (CookiesText -> Text) -> CookiesText -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CookiesText -> Text
renderCookiesText) CookiesText
cookies

-- | Parse result for the command-line arguments for signed cookie generation.

data Opts =
  Opts
    { Opts -> PemFilePath
opt_pemFilePath :: PemFilePath
        -- ^ Location in the filesystem where a .pem file
        --   containing an RSA secret key can be found
    , Opts -> KeyPairId
opt_keyPairId   :: KeyPairId
        -- ^ CloudFront key pair ID for the key pair that
        --   you are using to generate signature
    , Opts -> Resource
opt_resource    :: Resource
        -- ^ URL that the policy will grant access to,
        --   optionally containing asterisks for wildcards
    , Opts -> Lifespan
opt_lifespan    :: Lifespan
        -- ^ Amount of time until the policy expires
    }

-- | Parser for all the command-line arguments for signed cookie generation.
--
-- See "Options.Applicative", 'Opt.info', and 'Opt.execParser'
-- to learn how to use a 'Opt.Parser'.

optsParser :: Opt.Parser Opts
optsParser :: Parser Opts
optsParser =
  PemFilePath -> KeyPairId -> Resource -> Lifespan -> Opts
Opts
    (PemFilePath -> KeyPairId -> Resource -> Lifespan -> Opts)
-> Parser PemFilePath
-> Parser (KeyPairId -> Resource -> Lifespan -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser PemFilePath
forall a. Coercible Text a => String -> String -> Parser a
text String
"pem-file"    String
"Location in the filesystem where a .pem file \
                           \containing an RSA secret key can be found"

    Parser (KeyPairId -> Resource -> Lifespan -> Opts)
-> Parser KeyPairId -> Parser (Resource -> Lifespan -> Opts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser KeyPairId
forall a. Coercible Text a => String -> String -> Parser a
text String
"key-pair-id" String
"CloudFront key pair ID for the key pair that \
                           \you are using to generate signature"

    Parser (Resource -> Lifespan -> Opts)
-> Parser Resource -> Parser (Lifespan -> Opts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser Resource
forall a. Coercible Text a => String -> String -> Parser a
text String
"resource"    String
"URL that the policy will grant access to, \
                           \optionally containing asterisks for wildcards"

    Parser (Lifespan -> Opts) -> Parser Lifespan -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser Lifespan
forall a.
Coercible NominalDiffTime a =>
String -> String -> Parser a
days String
"days"        String
"Integer number of days until the policy expires"

mainParserInfo :: Opt.ParserInfo (IO ())
mainParserInfo :: ParserInfo (IO ())
mainParserInfo =
  Opts -> IO ()
mainOpts (Opts -> IO ()) -> ParserInfo Opts -> ParserInfo (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser Opts
optsParser InfoMod Opts
forall a. InfoMod a
infoMod

infoMod :: Opt.InfoMod a
infoMod :: InfoMod a
infoMod =
  String -> InfoMod a
forall a. String -> InfoMod a
Opt.header String
"Generate signed cookies for AWS CloudFront"