{-# LANGUAGE DataKinds #-}
--{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
--{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PartialTypeSignatures #-}
--{-# LANGUAGE TypeApplications #-}

-- | 'r-B64' is restricted to values that are valid Base64 encodings of some data.
-- For example, @Enc '["r-B64"] () T.Text@ can contain encoded binary image.
--
-- "enc-B64" can be converted to "r-B64" using @flattenAs@ defined in
-- 'Data.TypedEncoding.Instances.Enc.Base64'.     
-- However, there is no, and there should be no conversion general conversion from "r-B64" back to "enc-B64":
-- @Enc '["r-B64"] () T.Text@ is not B64 encoded text, it is B64 encoded something.
--
-- @since 0.5.1.0
module Data.TypedEncoding.Instances.Restriction.Base64 where

import           Data.TypedEncoding.Instances.Support


import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text.Encoding as TE 
import qualified Data.Text.Lazy.Encoding as TEL 
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Base64.Lazy as BL64
import qualified Data.ByteString.Char8 as B8
import qualified Data.TypedEncoding.Instances.Restriction.ASCII as RAscii

-- $setup
-- >>> :set -XScopedTypeVariables -XKindSignatures -XMultiParamTypeClasses -XDataKinds -XPolyKinds -XPartialTypeSignatures -XFlexibleInstances -XTypeApplications



instance Encode (Either EncodeEx) "r-B64" "r-B64" c B.ByteString where
    encoding :: Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encoding = Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encRB64B
  
instance Encode (Either EncodeEx) "r-B64" "r-B64" c BL.ByteString where
    encoding :: Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encoding = Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encRB64BL
  

instance Encode (Either EncodeEx) "r-B64" "r-B64" c T.Text where
    encoding :: Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encoding = Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encRB64T
  
instance Encode (Either EncodeEx) "r-B64" "r-B64" c TL.Text where
    encoding :: Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encoding = Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encRB64TL

instance Encode (Either EncodeEx) "r-B64" "r-B64" c String where
    encoding :: Encoding (Either EncodeEx) "r-B64" "r-B64" c String
encoding = Encoding (Either EncodeEx) "r-B64" "r-B64" c String
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c String
encRB64S

-- using lazy decoding to detect errors seems to be the fastest option that is not super hard to code


encRB64B :: Encoding (Either EncodeEx) "r-B64" "r-B64" c B.ByteString
encRB64B :: Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encRB64B = (ByteString -> Either String ByteString)
-> Encoding (Either EncodeEx) "r-B64" (AlgNm "r-B64") c ByteString
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx ((ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a err b. (a -> Either err b) -> a -> Either err a
implVerifyR (ByteString -> Either String ByteString
B64.decode)) 

encRB64BL :: Encoding (Either EncodeEx) "r-B64" "r-B64" c BL.ByteString
encRB64BL :: Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encRB64BL = (ByteString -> Either String ByteString)
-> Encoding (Either EncodeEx) "r-B64" (AlgNm "r-B64") c ByteString
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx ((ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a err b. (a -> Either err b) -> a -> Either err a
implVerifyR (ByteString -> Either String ByteString
BL64.decode)) 

-- | Converts text to bytestring using UTF8 decoding and then verify encoding in ByteString
-- This is safe without verifying ASCII, any non-ASCII text will still convert to ByteString
-- but will fail B64.decode (TODO tests would be nice)
encRB64T :: Encoding (Either EncodeEx) "r-B64" "r-B64" c T.Text
encRB64T :: Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encRB64T = (Text -> Either String Text)
-> Encoding (Either EncodeEx) "r-B64" (AlgNm "r-B64") c Text
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx ((Text -> Either String ByteString) -> Text -> Either String Text
forall a err b. (a -> Either err b) -> a -> Either err a
implVerifyR (ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8)) 

encRB64TL :: Encoding (Either EncodeEx) "r-B64" "r-B64" c TL.Text
encRB64TL :: Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encRB64TL = (Text -> Either String Text)
-> Encoding (Either EncodeEx) "r-B64" (AlgNm "r-B64") c Text
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx ((Text -> Either String ByteString) -> Text -> Either String Text
forall a err b. (a -> Either err b) -> a -> Either err a
implVerifyR (ByteString -> Either String ByteString
BL64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TEL.encodeUtf8)) 

encRB64S :: Encoding (Either EncodeEx) "r-B64" "r-B64" c String
encRB64S :: Encoding (Either EncodeEx) "r-B64" "r-B64" c String
encRB64S = (String -> Either String String)
-> Encoding (Either EncodeEx) "r-B64" (AlgNm "r-B64") c String
forall (nm :: Symbol) err c str.
(KnownSymbol nm, Show err) =>
(str -> Either err str)
-> Encoding (Either EncodeEx) nm (AlgNm nm) c str
_implEncodingEx ((String -> Either String (Either String ByteString))
-> String -> Either String String
forall a err b. (a -> Either err b) -> a -> Either err a
implVerifyR ((String -> Either String ByteString)
-> Either String String -> Either String (Either String ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> (String -> ByteString) -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B8.pack) (Either String String -> Either String (Either String ByteString))
-> (String -> Either String String)
-> String
-> Either String (Either String ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonAsciiChar -> Either String String)
-> (String -> Either String String)
-> Either NonAsciiChar String
-> Either String String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String)
-> (NonAsciiChar -> String) -> NonAsciiChar -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonAsciiChar -> String
forall a. Show a => a -> String
show) String -> Either String String
forall a b. b -> Either a b
Right (Either NonAsciiChar String -> Either String String)
-> (String -> Either NonAsciiChar String)
-> String
-> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either NonAsciiChar String
forall str. Char8Find str => str -> Either NonAsciiChar str
RAscii.encImpl)) 

-- -- * Decoding

instance (Applicative f) => Decode f "r-B64" "r-B64" c str where
    decoding :: Decoding f "r-B64" "r-B64" c str
decoding = Decoding f "r-B64" "r-B64" c str
forall (r :: Symbol) (f :: * -> *) c str.
(Restriction r, Applicative f) =>
Decoding f r r c str
decAnyR

instance (RecreateErr f, Applicative f) =>  Validate f "r-B64" "r-B64" c B.ByteString  where
    validation :: Validation f "r-B64" "r-B64" c ByteString
validation = Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
-> Validation f "r-B64" "r-B64" c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
(Restriction nm, KnownSymbol nm, RecreateErr @* f,
 Applicative f) =>
Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str
validR Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encRB64B

instance (RecreateErr f, Applicative f) =>  Validate f "r-B64" "r-B64" c BL.ByteString  where
    validation :: Validation f "r-B64" "r-B64" c ByteString
validation = Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
-> Validation f "r-B64" "r-B64" c ByteString
forall (nm :: Symbol) (f :: * -> *) c str.
(Restriction nm, KnownSymbol nm, RecreateErr @* f,
 Applicative f) =>
Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str
validR Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c ByteString
encRB64BL

instance (RecreateErr f, Applicative f) =>  Validate f "r-B64" "r-B64" c T.Text  where
    validation :: Validation f "r-B64" "r-B64" c Text
validation = Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
-> Validation f "r-B64" "r-B64" c Text
forall (nm :: Symbol) (f :: * -> *) c str.
(Restriction nm, KnownSymbol nm, RecreateErr @* f,
 Applicative f) =>
Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str
validR Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encRB64T

instance (RecreateErr f, Applicative f) =>  Validate f "r-B64" "r-B64" c TL.Text  where
    validation :: Validation f "r-B64" "r-B64" c Text
validation = Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
-> Validation f "r-B64" "r-B64" c Text
forall (nm :: Symbol) (f :: * -> *) c str.
(Restriction nm, KnownSymbol nm, RecreateErr @* f,
 Applicative f) =>
Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str
validR Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c Text
encRB64TL

instance (RecreateErr f, Applicative f) =>  Validate f "r-B64" "r-B64" c String  where
    validation :: Validation f "r-B64" "r-B64" c String
validation = Encoding (Either EncodeEx) "r-B64" "r-B64" c String
-> Validation f "r-B64" "r-B64" c String
forall (nm :: Symbol) (f :: * -> *) c str.
(Restriction nm, KnownSymbol nm, RecreateErr @* f,
 Applicative f) =>
Encoding (Either EncodeEx) nm nm c str -> Validation f nm nm c str
validR Encoding (Either EncodeEx) "r-B64" "r-B64" c String
forall c. Encoding (Either EncodeEx) "r-B64" "r-B64" c String
encRB64S