{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Defines /Base64/ encoding
--
-- @since 0.1.0.0
module Data.TypedEncoding.Instances.Enc.Base64 where

import           Data.TypedEncoding
import           Data.TypedEncoding.Instances.Support
import           Data.TypedEncoding.Instances.Support.Unsafe

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL


import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.Lazy as BL64
import           Data.TypedEncoding.Instances.Restriction.Base64 ()



-- $setup
-- >>> :set -XOverloadedStrings -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances -XTypeApplications
-- >>> import Test.QuickCheck
-- >>> import Test.QuickCheck.Instances.ByteString()
-- >>> :{  
-- instance Arbitrary (UncheckedEnc () B.ByteString) where 
--      arbitrary = do
--          payload <- frequency [ (5, fmap (getPayload . encodeAll @'["enc-B64"] @(). toEncoding ()) $ arbitrary) 
--                             , (1, arbitrary)]
--          pure $ toUncheckedEnc ["enc-B64"] () payload
-- :}


-----------------
-- * Conversions
-----------------

-- |
-- @since 0.1.0.0 
acceptLenientS :: Enc ("enc-B64-len" ': ys) c B.ByteString -> Enc ("enc-B64" ': ys) c B.ByteString 
acceptLenientS :: Enc @[Symbol] ((':) @Symbol "enc-B64-len" ys) c ByteString
-> Enc @[Symbol] ((':) @Symbol "enc-B64" ys) c ByteString
acceptLenientS = (ByteString -> ByteString)
-> Enc @[Symbol] ((':) @Symbol "enc-B64-len" ys) c ByteString
-> Enc @[Symbol] ((':) @Symbol "enc-B64" ys) c ByteString
forall k1 k2 s1 s2 (e1 :: k1) c (e2 :: k2).
(s1 -> s2) -> Enc @k1 e1 c s1 -> Enc @k2 e2 c s2
withUnsafeCoerce (ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.decodeLenient)

-- |
-- @since 0.1.0.0 
acceptLenientL :: Enc ("enc-B64-len" ': ys) c BL.ByteString -> Enc ("enc-B64" ': ys) c BL.ByteString 
acceptLenientL :: Enc @[Symbol] ((':) @Symbol "enc-B64-len" ys) c ByteString
-> Enc @[Symbol] ((':) @Symbol "enc-B64" ys) c ByteString
acceptLenientL = (ByteString -> ByteString)
-> Enc @[Symbol] ((':) @Symbol "enc-B64-len" ys) c ByteString
-> Enc @[Symbol] ((':) @Symbol "enc-B64" ys) c ByteString
forall k1 k2 s1 s2 (e1 :: k1) c (e2 :: k2).
(s1 -> s2) -> Enc @k1 e1 c s1 -> Enc @k2 e2 c s2
withUnsafeCoerce (ByteString -> ByteString
BL64.encode (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL64.decodeLenient)

-- |
-- Validated "r-B64" is guaranteed to decode.
-- 
-- Use flattenAs in the other direction.
--  
-- This would not be safe for Text
asEncodingB :: Enc '["r-B64"] c B.ByteString ->  Enc '["enc-B64"] c B.ByteString 
asEncodingB :: Enc @[Symbol] ((':) @Symbol "r-B64" ('[] @Symbol)) c ByteString
-> Enc
     @[Symbol] ((':) @Symbol "enc-B64" ('[] @Symbol)) c ByteString
asEncodingB = (ByteString -> ByteString)
-> Enc @[Symbol] ((':) @Symbol "r-B64" ('[] @Symbol)) c ByteString
-> Enc
     @[Symbol] ((':) @Symbol "enc-B64" ('[] @Symbol)) c ByteString
forall k1 k2 s1 s2 (e1 :: k1) c (e2 :: k2).
(s1 -> s2) -> Enc @k1 e1 c s1 -> Enc @k2 e2 c s2
withUnsafeCoerce ByteString -> ByteString
forall a. a -> a
id

-- |
-- Validated "r-B64" is guaranteed to decode.  
-- This would not be safe for Text
asEncodingBL :: Enc '["r-B64"] c BL.ByteString ->  Enc '["enc-B64"] c BL.ByteString 
asEncodingBL :: Enc @[Symbol] ((':) @Symbol "r-B64" ('[] @Symbol)) c ByteString
-> Enc
     @[Symbol] ((':) @Symbol "enc-B64" ('[] @Symbol)) c ByteString
asEncodingBL = (ByteString -> ByteString)
-> Enc @[Symbol] ((':) @Symbol "r-B64" ('[] @Symbol)) c ByteString
-> Enc
     @[Symbol] ((':) @Symbol "enc-B64" ('[] @Symbol)) c ByteString
forall k1 k2 s1 s2 (e1 :: k1) c (e2 :: k2).
(s1 -> s2) -> Enc @k1 e1 c s1 -> Enc @k2 e2 c s2
withUnsafeCoerce ByteString -> ByteString
forall a. a -> a
id


-- @"enc-B64-nontext"@ is deprecated, use "r-B64"
--
-- @since 0.1.0.0 
instance FlattenAs "r-ASCII" "enc-B64-nontext" where

-- | allow to treat B64 encodings as ASCII forgetting about B64 encoding.
--
-- Converting to "r-B64" is also an option now.
--
-- >>> let tstB64 = encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString
-- >>> displ (flattenAs $ tstB64 :: Enc '["r-ASCII"] () B.ByteString)
-- "Enc '[r-ASCII] () (ByteString SGVsbG8gV29ybGQ=)"
--
--
-- @since 0.1.0.0 
instance FlattenAs "r-ASCII" "enc-B64" where

-- |
-- @since 0.5.1.0 
instance FlattenAs "r-B64" "enc-B64" where

-- |
-- This is not precise, actually /Base 64/ uses a subset of ASCII
-- and that would require a new definition @"r-B64"@.
--
-- This instance likely to be changed / corrected in the future if @"r-B64"@ is defined.
--
-- >>> let tstB64 = encodeAll . toEncoding () $ "Hello World" :: Enc '["enc-B64"] () B.ByteString
-- >>> displ (_encodesInto @"r-ASCII" $ tstB64)
-- "Enc '[r-ASCII,enc-B64] () (ByteString SGVsbG8gV29ybGQ=)"
--
-- >>> displ (_encodesInto @"r-UTF8" $ tstB64)
-- "Enc '[r-UTF8,enc-B64] () (ByteString SGVsbG8gV29ybGQ=)"
--
-- @since 0.3.0.0
instance EncodingSuperset "enc-B64" where
    type EncSuperset "enc-B64" = "r-B64"

-- |
-- >>> tstChar8Encodable @'["enc-B64-len", "enc-B64"]
-- "I am CHAR8 encodable"
instance EncodingSuperset "enc-B64-len" where
    type EncSuperset "enc-B64-len" = "r-B64"

-- * Encoders

-- |
-- @since 0.3.0.0 
instance Applicative f => Encode f "enc-B64" "enc-B64" c B.ByteString where
    encoding :: Encoding f "enc-B64" "enc-B64" c ByteString
encoding = Encoding f "enc-B64" "enc-B64" c ByteString
forall (f :: * -> *) c.
Applicative f =>
Encoding f "enc-B64" "enc-B64" c ByteString
encB64B

-- |
--
-- @since 0.3.0.0 
encB64B :: Applicative f => Encoding f "enc-B64" "enc-B64" c B.ByteString
encB64B :: Encoding f "enc-B64" "enc-B64" c ByteString
encB64B = (ByteString -> ByteString)
-> Encoding f "enc-B64" (AlgNm "enc-B64") c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
Applicative f =>
(str -> str) -> Encoding f nm (AlgNm nm) c str
_implEncodingP ByteString -> ByteString
B64.encode

-- |
-- @since 0.3.0.0 
instance Applicative f => Encode f "enc-B64" "enc-B64" c BL.ByteString where
    encoding :: Encoding f "enc-B64" "enc-B64" c ByteString
encoding = Encoding f "enc-B64" "enc-B64" c ByteString
forall (f :: * -> *) c.
Applicative f =>
Encoding f "enc-B64" "enc-B64" c ByteString
encB64BL

-- |
-- @since 0.3.0.0 
encB64BL :: Applicative f => Encoding f "enc-B64" "enc-B64" c BL.ByteString
encB64BL :: Encoding f "enc-B64" "enc-B64" c ByteString
encB64BL = (ByteString -> ByteString)
-> Encoding f "enc-B64" (AlgNm "enc-B64") c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
Applicative f =>
(str -> str) -> Encoding f nm (AlgNm nm) c str
_implEncodingP ByteString -> ByteString
BL64.encode



-- * Decoders

-- |
-- @since 0.3.0.0 
instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c B.ByteString where
    decoding :: Decoding f "enc-B64" "enc-B64" c ByteString
decoding = Decoding f "enc-B64" "enc-B64" c ByteString
forall (f :: * -> *) c.
(UnexpectedDecodeErr @* f, Applicative f) =>
Decoding f "enc-B64" "enc-B64" c ByteString
decB64B

-- | Effectful decoding for corruption detection.
-- This protocol is used, for example, in emails. 
-- It is a well known encoding and hackers will have no problem 
-- making undetectable changes, but error handling at this stage
-- could verify that email was corrupted.
--
-- prop> _propSafeDecoding @"enc-B64" @() @B.ByteString encB64B decB64B ()
-- 
-- prop> _propSafeValidatedDecoding @"enc-B64" @() @B.ByteString validation decB64B () . getUncheckedPayload @() @B.ByteString
--
-- @since 0.3.0.0
decB64B :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c B.ByteString
decB64B :: Decoding f "enc-B64" "enc-B64" c ByteString
decB64B = (ByteString -> f ByteString)
-> Decoding f "enc-B64" (AlgNm "enc-B64") c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
Functor f =>
(str -> f str) -> Decoding f nm (AlgNm nm) c str
_implDecodingF (forall (x :: Symbol) (f :: * -> *) err a.
(KnownSymbol x, UnexpectedDecodeErr @* f, Applicative f,
 Show err) =>
Either err a -> f a
forall (f :: * -> *) err a.
(KnownSymbol "enc-B64", UnexpectedDecodeErr @* f, Applicative f,
 Show err) =>
Either err a -> f a
asUnexpected @"enc-B64" (Either String ByteString -> f ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
B64.decode)

-- |
-- @since 0.3.0.0 
instance (UnexpectedDecodeErr f, Applicative f) => Decode f "enc-B64" "enc-B64" c BL.ByteString where
    decoding :: Decoding f "enc-B64" "enc-B64" c ByteString
decoding = Decoding f "enc-B64" "enc-B64" c ByteString
forall (f :: * -> *) c.
(UnexpectedDecodeErr @* f, Applicative f) =>
Decoding f "enc-B64" "enc-B64" c ByteString
decB64BL

-- |
-- prop> _propSafeDecoding @"enc-B64" @() @BL.ByteString encB64BL decB64BL
--
-- @since 0.3.0.0 
decB64BL :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "enc-B64" "enc-B64" c BL.ByteString
decB64BL :: Decoding f "enc-B64" "enc-B64" c ByteString
decB64BL = (ByteString -> f ByteString)
-> Decoding f "enc-B64" (AlgNm "enc-B64") c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
Functor f =>
(str -> f str) -> Decoding f nm (AlgNm nm) c str
_implDecodingF (forall (x :: Symbol) (f :: * -> *) err a.
(KnownSymbol x, UnexpectedDecodeErr @* f, Applicative f,
 Show err) =>
Either err a -> f a
forall (f :: * -> *) err a.
(KnownSymbol "enc-B64", UnexpectedDecodeErr @* f, Applicative f,
 Show err) =>
Either err a -> f a
asUnexpected @"enc-B64" (Either String ByteString -> f ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
BL64.decode)


-- * Validation

-- |
-- @since 0.3.0.0 
instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c B.ByteString where
    validation :: Validation f "enc-B64" "enc-B64" c ByteString
validation = Decoding
  (Either UnexpectedDecodeEx) "enc-B64" "enc-B64" c ByteString
-> Validation f "enc-B64" "enc-B64" c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
(KnownSymbol nm, RecreateErr @* f, Applicative f) =>
Decoding (Either UnexpectedDecodeEx) nm nm c str
-> Validation f nm nm c str
validFromDec Decoding
  (Either UnexpectedDecodeEx) "enc-B64" "enc-B64" c ByteString
forall (f :: * -> *) c.
(UnexpectedDecodeErr @* f, Applicative f) =>
Decoding f "enc-B64" "enc-B64" c ByteString
decB64B

-- |
-- @since 0.3.0.0 
instance (RecreateErr f, Applicative f) => Validate f "enc-B64" "enc-B64" c BL.ByteString where
    validation :: Validation f "enc-B64" "enc-B64" c ByteString
validation = Decoding
  (Either UnexpectedDecodeEx) "enc-B64" "enc-B64" c ByteString
-> Validation f "enc-B64" "enc-B64" c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
(KnownSymbol nm, RecreateErr @* f, Applicative f) =>
Decoding (Either UnexpectedDecodeEx) nm nm c str
-> Validation f nm nm c str
validFromDec Decoding
  (Either UnexpectedDecodeEx) "enc-B64" "enc-B64" c ByteString
forall (f :: * -> *) c.
(UnexpectedDecodeErr @* f, Applicative f) =>
Decoding f "enc-B64" "enc-B64" c ByteString
decB64BL


-- | Lenient decoding does not fail
-- 
-- @since 0.3.0.0 
instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c B.ByteString where
    validation :: Validation f "enc-B64-len" "enc-B64-len" c ByteString
validation = (forall (xs :: [Symbol]).
 Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
 -> f (Enc @[Symbol] xs c ByteString))
-> Validation f "enc-B64-len" (AlgNm "enc-B64-len") c ByteString
forall (f :: * -> *) (nm :: Symbol) conf str.
(forall (xs :: [Symbol]).
 Enc @[Symbol] ((':) @Symbol nm xs) conf str
 -> f (Enc @[Symbol] xs conf str))
-> Validation f nm (AlgNm nm) conf str
_mkValidation ((forall (xs :: [Symbol]).
  Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
  -> f (Enc @[Symbol] xs c ByteString))
 -> Validation f "enc-B64-len" (AlgNm "enc-B64-len") c ByteString)
-> (forall (xs :: [Symbol]).
    Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
    -> f (Enc @[Symbol] xs c ByteString))
-> Validation f "enc-B64-len" (AlgNm "enc-B64-len") c ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
-> f (Enc @[Symbol] xs c ByteString)
forall k1 k2 (f :: * -> *) str (enc1 :: k1) conf (enc2 :: k2).
Applicative f =>
(str -> str) -> Enc @k1 enc1 conf str -> f (Enc @k2 enc2 conf str)
implTranP ByteString -> ByteString
forall a. a -> a
id

-- | Lenient decoding does not fail
-- 
-- @since 0.3.0.0 
instance Applicative f => Validate f "enc-B64-len" "enc-B64-len" c BL.ByteString where
    validation :: Validation f "enc-B64-len" "enc-B64-len" c ByteString
validation = (forall (xs :: [Symbol]).
 Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
 -> f (Enc @[Symbol] xs c ByteString))
-> Validation f "enc-B64-len" (AlgNm "enc-B64-len") c ByteString
forall (f :: * -> *) (nm :: Symbol) conf str.
(forall (xs :: [Symbol]).
 Enc @[Symbol] ((':) @Symbol nm xs) conf str
 -> f (Enc @[Symbol] xs conf str))
-> Validation f nm (AlgNm nm) conf str
_mkValidation ((forall (xs :: [Symbol]).
  Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
  -> f (Enc @[Symbol] xs c ByteString))
 -> Validation f "enc-B64-len" (AlgNm "enc-B64-len") c ByteString)
-> (forall (xs :: [Symbol]).
    Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
    -> f (Enc @[Symbol] xs c ByteString))
-> Validation f "enc-B64-len" (AlgNm "enc-B64-len") c ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> Enc @[Symbol] ((':) @Symbol "enc-B64-len" xs) c ByteString
-> f (Enc @[Symbol] xs c ByteString)
forall k1 k2 (f :: * -> *) str (enc1 :: k1) conf (enc2 :: k2).
Applicative f =>
(str -> str) -> Enc @k1 enc1 conf str -> f (Enc @k2 enc2 conf str)
implTranP ByteString -> ByteString
forall a. a -> a
id