module Network.AWS.CloudFront.SignedCookies.Encoding
  ( base64Encode
  , base64Decode
  ) where

import Network.AWS.CloudFront.SignedCookies.Types (ByteString, Text)

-- base64-bytestring
import qualified Data.ByteString.Base64 as Base64

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

{- |

The base 64 encoding scheme used for AWS CloudFront signed cookies.
We use this to encode both the policy and the signature.

Excerpts from [Setting Signed Cookies Using a Custom Policy](https://docs.aws.amazon.com/AmazonCloudFront/latest/DeveloperGuide/private-content-setting-signed-cookie-custom-policy.html):

1. Base64-encode the string using MIME base64 encoding. For more information, see
   [Section 6.8, Base64 Content-Transfer-Encoding](https://tools.ietf.org/html/rfc2045#section-6.8)
   in RFC 2045, MIME (Multipurpose Internet Mail Extensions) Part One:
   Format of Internet Message Bodies.

2. Replace characters that are invalid in a URL query string with
   characters that are valid. The following table lists invalid and
   valid characters.

    > Replace these          With these
    > invalid characters     valid characters
    > ------------------     ----------------
    > +                      - (hyphen)
    > =                      _ (underscore)
    > /                      ~ (tilde)

-}

base64Encode :: ByteString -> Text
base64Encode :: ByteString -> Text
base64Encode =
  (Char -> Char) -> Text -> Text
Text.map Char -> Char
charEncode (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode
  where
    charEncode :: Char -> Char
charEncode =
      \case
        Char
'+' -> Char
'-'
        Char
'=' -> Char
'_'
        Char
'/' -> Char
'~'
        Char
x   -> Char
x

{- |

The inverse of 'base64Encode'. Produces a 'Left' value with
an error message if decoding fails.

-}

base64Decode :: Text -> Either String ByteString
base64Decode :: Text -> Either String ByteString
base64Decode =
  ByteString -> Either String ByteString
Base64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
Text.map Char -> Char
charDecode
  where
    charDecode :: Char -> Char
charDecode =
      \case
        Char
'-' -> Char
'+'
        Char
'_' -> Char
'='
        Char
'~' -> Char
'/'
        Char
x   -> Char
x