-- | Command-line interface for decoding AWS CloudFront policy cookies.

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

import Network.AWS.CloudFront.SignedCookies.CLI.Internal (text)
import Network.AWS.CloudFront.SignedCookies.Encoding (base64Decode)
import Network.AWS.CloudFront.SignedCookies.Types (PolicyCookie (..), Text)

-- aeson
import qualified Data.Aeson as A

-- aeson-pretty
import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)

-- base
import Data.Coerce (coerce)

-- bytestring
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS

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

-- text
import qualified Data.Text.Lazy as LText
import Data.Text.Lazy.Builder as Text (toLazyText)
import qualified Data.Text.Lazy.IO as LText

-- | Entry point for the AWS CloudFront cookie decoding 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{PolicyCookie
opt_policyCookie :: Opts -> PolicyCookie
opt_policyCookie :: PolicyCookie
..} = do

  ByteString
bs :: BS.ByteString <-
    case Text -> Either String ByteString
base64Decode (Text -> Either String ByteString)
-> Text -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ PolicyCookie -> Text
coerce @PolicyCookie @Text PolicyCookie
opt_policyCookie of
      Left String
e  -> String -> IO ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Right ByteString
x -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

  Value
value <-
    case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' (ByteString -> ByteString
LBS.fromStrict ByteString
bs) of
      Left String
e  -> String -> IO Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Right Value
x -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
x

  let
    Text
result :: LText.Text =
      Builder -> Text
Text.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Builder
forall a. ToJSON a => a -> Builder
encodePrettyToTextBuilder @A.Value Value
value

  -- Print the JSON to stdout
  Text -> IO ()
LText.putStr Text
result

-- | Parse result for the command-line arguments for cookie decoding.

data Opts =
  Opts
    { Opts -> PolicyCookie
opt_policyCookie :: PolicyCookie
        -- ^ The value of a @CloudFront-Policy@ cookie.
    }

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

optsParser :: Opt.Parser Opts
optsParser :: Parser Opts
optsParser =
  PolicyCookie -> Opts
Opts
    (PolicyCookie -> Opts) -> Parser PolicyCookie -> Parser Opts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser PolicyCookie
forall a. Coercible Text a => String -> String -> Parser a
text String
"policy-cookie" String
"The value of a CloudFront-Policy cookie"

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
"Decode signed AWS CloudFront policy cookies"