{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Gogol.Data.Base64
-- Copyright   : (c) 2013-2022 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Gogol.Data.Base64
  ( Base64 (..),
    _Base64,
  )
where

import Control.Lens (Iso', iso)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Base64.Types qualified as Base64
import Data.ByteString (ByteString)
import Data.ByteString.Base64 qualified as Base64
import Data.Hashable
import Data.Text.Encoding qualified as Text
import GHC.Generics (Generic)
import Gogol.Data.JSON (parseJSONText, toJSONText)
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))

-- | Raw bytes that will be transparently base64 encoded\/decoded
-- on tramission to\/from a remote API.
newtype Base64 = Base64 {Base64 -> ByteString
fromBase64 :: ByteString}
  deriving (Base64 -> Base64 -> Bool
(Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool) -> Eq Base64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64 -> Base64 -> Bool
== :: Base64 -> Base64 -> Bool
$c/= :: Base64 -> Base64 -> Bool
/= :: Base64 -> Base64 -> Bool
Eq, Int -> Base64 -> ShowS
[Base64] -> ShowS
Base64 -> String
(Int -> Base64 -> ShowS)
-> (Base64 -> String) -> ([Base64] -> ShowS) -> Show Base64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64 -> ShowS
showsPrec :: Int -> Base64 -> ShowS
$cshow :: Base64 -> String
show :: Base64 -> String
$cshowList :: [Base64] -> ShowS
showList :: [Base64] -> ShowS
Show, ReadPrec [Base64]
ReadPrec Base64
Int -> ReadS Base64
ReadS [Base64]
(Int -> ReadS Base64)
-> ReadS [Base64]
-> ReadPrec Base64
-> ReadPrec [Base64]
-> Read Base64
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Base64
readsPrec :: Int -> ReadS Base64
$creadList :: ReadS [Base64]
readList :: ReadS [Base64]
$creadPrec :: ReadPrec Base64
readPrec :: ReadPrec Base64
$creadListPrec :: ReadPrec [Base64]
readListPrec :: ReadPrec [Base64]
Read, Eq Base64
Eq Base64 =>
(Base64 -> Base64 -> Ordering)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Base64)
-> (Base64 -> Base64 -> Base64)
-> Ord Base64
Base64 -> Base64 -> Bool
Base64 -> Base64 -> Ordering
Base64 -> Base64 -> Base64
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Base64 -> Base64 -> Ordering
compare :: Base64 -> Base64 -> Ordering
$c< :: Base64 -> Base64 -> Bool
< :: Base64 -> Base64 -> Bool
$c<= :: Base64 -> Base64 -> Bool
<= :: Base64 -> Base64 -> Bool
$c> :: Base64 -> Base64 -> Bool
> :: Base64 -> Base64 -> Bool
$c>= :: Base64 -> Base64 -> Bool
>= :: Base64 -> Base64 -> Bool
$cmax :: Base64 -> Base64 -> Base64
max :: Base64 -> Base64 -> Base64
$cmin :: Base64 -> Base64 -> Base64
min :: Base64 -> Base64 -> Base64
Ord, (forall x. Base64 -> Rep Base64 x)
-> (forall x. Rep Base64 x -> Base64) -> Generic Base64
forall x. Rep Base64 x -> Base64
forall x. Base64 -> Rep Base64 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Base64 -> Rep Base64 x
from :: forall x. Base64 -> Rep Base64 x
$cto :: forall x. Rep Base64 x -> Base64
to :: forall x. Rep Base64 x -> Base64
Generic, Eq Base64
Eq Base64 =>
(Int -> Base64 -> Int) -> (Base64 -> Int) -> Hashable Base64
Int -> Base64 -> Int
Base64 -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Base64 -> Int
hashWithSalt :: Int -> Base64 -> Int
$chash :: Base64 -> Int
hash :: Base64 -> Int
Hashable)

_Base64 :: Iso' Base64 ByteString
_Base64 :: Iso' Base64 ByteString
_Base64 = (Base64 -> ByteString)
-> (ByteString -> Base64) -> Iso' Base64 ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Base64 -> ByteString
fromBase64 ByteString -> Base64
Base64

instance ToHttpApiData Base64 where
  toUrlPiece :: Base64 -> Text
toUrlPiece = Base64 'StdPadded Text -> Text
forall (k :: Alphabet) a. Base64 k a -> a
Base64.extractBase64 (Base64 'StdPadded Text -> Text)
-> (Base64 -> Base64 'StdPadded Text) -> Base64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded Text
Base64.encodeBase64 (ByteString -> Base64 'StdPadded Text)
-> (Base64 -> ByteString) -> Base64 -> Base64 'StdPadded Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
fromBase64
  toQueryParam :: Base64 -> Text
toQueryParam = Base64 'StdPadded Text -> Text
forall (k :: Alphabet) a. Base64 k a -> a
Base64.extractBase64 (Base64 'StdPadded Text -> Text)
-> (Base64 -> Base64 'StdPadded Text) -> Base64 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded Text
Base64.encodeBase64 (ByteString -> Base64 'StdPadded Text)
-> (Base64 -> ByteString) -> Base64 -> Base64 'StdPadded Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
fromBase64
  toHeader :: Base64 -> ByteString
toHeader = Base64 'StdPadded ByteString -> ByteString
forall (k :: Alphabet) a. Base64 k a -> a
Base64.extractBase64 (Base64 'StdPadded ByteString -> ByteString)
-> (Base64 -> Base64 'StdPadded ByteString) -> Base64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded ByteString
Base64.encodeBase64' (ByteString -> Base64 'StdPadded ByteString)
-> (Base64 -> ByteString) -> Base64 -> Base64 'StdPadded ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base64 -> ByteString
fromBase64

instance FromHttpApiData Base64 where
  parseUrlPiece :: Text -> Either Text Base64
parseUrlPiece = (ByteString -> Base64)
-> Either Text ByteString -> Either Text Base64
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Base64
Base64 (Either Text ByteString -> Either Text Base64)
-> (Text -> Either Text ByteString) -> Text -> Either Text Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
Base64.decodeBase64Untyped (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
  parseQueryParam :: Text -> Either Text Base64
parseQueryParam = (ByteString -> Base64)
-> Either Text ByteString -> Either Text Base64
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Base64
Base64 (Either Text ByteString -> Either Text Base64)
-> (Text -> Either Text ByteString) -> Text -> Either Text Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
Base64.decodeBase64Untyped (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8
  parseHeader :: ByteString -> Either Text Base64
parseHeader = (ByteString -> Base64)
-> Either Text ByteString -> Either Text Base64
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Base64
Base64 (Either Text ByteString -> Either Text Base64)
-> (ByteString -> Either Text ByteString)
-> ByteString
-> Either Text Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
Base64.decodeBase64Untyped

instance FromJSON Base64 where
  parseJSON :: Value -> Parser Base64
parseJSON = String -> Value -> Parser Base64
forall a. FromHttpApiData a => String -> Value -> Parser a
parseJSONText String
"Base64"

instance ToJSON Base64 where
  toJSON :: Base64 -> Value
toJSON = Base64 -> Value
forall a. ToHttpApiData a => a -> Value
toJSONText