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

-- {-# LANGUAGE PartialTypeSignatures #-}

-- | Simple DIY encoding example that "signs" Text with its length.
--
-- Documentation includes discussion of error handling options. 
--
-- My current thinking: 
--
-- Stronger type level information about encoding provides type safety over decoding process.
-- Decoding cannot fail unless somehow underlying data has been corrupted.
--
-- Such integrity of data should be enforced at boundaries
-- (JSON instances, DB retrievals, etc).  This can be accomplished using provided support for /Validation/ or using 'Data.TypedEncoding.Common.Types.UncheckedEnc.UncheckedEnc'.
-- 
-- This still is user decision, the errors during decoding process are considered unexpected 'UnexpectedDecodeErr'.
-- In particular user can decide to use unsafe operations with the encoded type. See 'Examples.TypedEncoding.Unsafe'.

module Examples.TypedEncoding.Instances.DiySignEncoding where

import           Data.TypedEncoding
import qualified Data.TypedEncoding.Instances.Support as EnT

import qualified Data.Text as T
import           Data.Char
import           Data.Semigroup ((<>))
import           Text.Read (readMaybe)

-- $setup
-- >>> :set -XOverloadedStrings -XMultiParamTypeClasses -XDataKinds
-- >>> import Test.QuickCheck.Instances.Text()

-- | encoding function, typically should be module private 
encodeSign :: T.Text -> T.Text
encodeSign :: Text -> Text
encodeSign Text
t = (String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Text -> Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t


-- | dual purpose decoding and recovery function.
--
-- This typically should be module private.
--
-- >>> decodeSign "3:abc" 
-- Right "abc"
--
-- >>> decodeSign "4:abc" 
-- Left "Corrupted Signature"
decodeSign :: T.Text -> Either String T.Text
decodeSign :: Text -> Either String Text
decodeSign Text
t = 
    let (Text
sdit, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isDigit (Text -> (Text, Text)) -> Text -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text
t
        actsize :: Int
actsize = Text -> Int
T.length Text
rest Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        msize :: Maybe Int
msize = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text
sdit
        checkDelimit :: Bool
checkDelimit = Text -> Text -> Bool
T.isInfixOf Text
":" Text
rest
    in if Maybe Int
msize Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
actsize Bool -> Bool -> Bool
&& Bool
checkDelimit
       then Text -> Either String Text
forall a b. b -> Either a b
Right (Text -> Either String Text) -> Text -> Either String Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
rest
       else String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"Corrupted Signature"       


-- | Encoded hello world example.
--
-- >>> helloSigned
-- UnsafeMkEnc Proxy () "11:Hello World"
--
-- >>> fromEncoding . decodeAll $ helloSigned 
-- "Hello World"
helloSigned :: Enc '["my-sign"] () T.Text
helloSigned :: Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
helloSigned = Enc @[Symbol] ('[] @Symbol) () Text
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
forall (nms :: [Symbol]) c str.
EncodeAll Identity nms nms c str =>
Enc @[Symbol] ('[] @Symbol) c str -> Enc @[Symbol] nms c str
encodeAll (Enc @[Symbol] ('[] @Symbol) () Text
 -> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
-> (Text -> Enc @[Symbol] ('[] @Symbol) () Text)
-> Text
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Text -> Enc @[Symbol] ('[] @Symbol) () Text
forall conf str.
conf -> str -> Enc @[Symbol] ('[] @Symbol) conf str
toEncoding () (Text
 -> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
-> Text
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
forall a b. (a -> b) -> a -> b
$ Text
"Hello World"

-- | property checks that 'T.Text' values are expected to decode 
-- without error after encoding.
--
-- prop> \t -> propEncDec
propEncDec :: T.Text -> Bool
propEncDec :: Text -> Bool
propEncDec Text
t = 
    let enc :: Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
enc = Enc @[Symbol] ('[] @Symbol) () Text
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
forall (nms :: [Symbol]) c str.
EncodeAll Identity nms nms c str =>
Enc @[Symbol] ('[] @Symbol) c str -> Enc @[Symbol] nms c str
encodeAll (Enc @[Symbol] ('[] @Symbol) () Text
 -> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
-> (Text -> Enc @[Symbol] ('[] @Symbol) () Text)
-> Text
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Text -> Enc @[Symbol] ('[] @Symbol) () Text
forall conf str.
conf -> str -> Enc @[Symbol] ('[] @Symbol) conf str
toEncoding () (Text
 -> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
-> Text
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
forall a b. (a -> b) -> a -> b
$ Text
t :: Enc '["my-sign"] () T.Text
    in Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Enc @[Symbol] ('[] @Symbol) () Text -> Text
forall k conf str. Enc @[k] ('[] @k) conf str -> str
fromEncoding (Enc @[Symbol] ('[] @Symbol) () Text -> Text)
-> (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
    -> Enc @[Symbol] ('[] @Symbol) () Text)
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
-> Enc @[Symbol] ('[] @Symbol) () Text
forall (nms :: [Symbol]) c str.
DecodeAll Identity nms nms c str =>
Enc @[Symbol] nms c str -> Enc @[Symbol] ('[] @Symbol) c str
decodeAll (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
 -> Text)
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
-> Text
forall a b. (a -> b) -> a -> b
$ Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
enc)

hacker :: Either RecreateEx (Enc '["my-sign"] () T.Text)
hacker :: Either
  RecreateEx
  (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
hacker = 
    let payload :: Text
payload = Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
-> Text
forall k (enc :: k) conf str. Enc @k enc conf str -> str
getPayload (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
 -> Text)
-> Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
-> Text
forall a b. (a -> b) -> a -> b
$ Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text
helloSigned :: T.Text
        -- | payload is sent over network and get corrupted
        newpay :: Text
newpay = Text
payload Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" corruption" 
        -- | boundary check recovers the data
        newdata :: Either
  RecreateEx
  (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
newdata = Enc @[Symbol] ('[] @Symbol) () Text
-> Either
     RecreateEx
     (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
forall (nms :: [Symbol]) (f :: * -> *) c str.
(Monad f, ValidateAll f nms nms c str) =>
Enc @[Symbol] ('[] @Symbol) c str -> f (Enc @[Symbol] nms c str)
recreateFAll (Enc @[Symbol] ('[] @Symbol) () Text
 -> Either
      RecreateEx
      (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text))
-> (Text -> Enc @[Symbol] ('[] @Symbol) () Text)
-> Text
-> Either
     RecreateEx
     (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Text -> Enc @[Symbol] ('[] @Symbol) () Text
forall conf str.
conf -> str -> Enc @[Symbol] ('[] @Symbol) conf str
toEncoding () (Text
 -> Either
      RecreateEx
      (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text))
-> Text
-> Either
     RecreateEx
     (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
forall a b. (a -> b) -> a -> b
$ Text
newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text)
    in Either
  RecreateEx
  (Enc @[Symbol] ((':) @Symbol "my-sign" ('[] @Symbol)) () Text)
newdata    
-- ^ Hacker example
-- The data was transmitted over a network and got corrupted.
--
-- >>> let payload = getPayload $ helloSigned :: T.Text
-- >>> let newpay = payload <> " corruption" 
-- >>> recreateFAll . toEncoding () $ newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text)
-- Left (RecreateEx "my-sign" ("Corrupted Signature"))
--
-- >>> recreateFAll . toEncoding () $ payload :: Either RecreateEx (Enc '["my-sign"] () T.Text)
-- Right (UnsafeMkEnc Proxy () "11:Hello World")


-- | Because encoding function is pure we can create instance of 'Encode' 
-- that is polymorphic in effect @f@. 
--
-- This is done using 'EnT.implTranP' combinator.
instance Applicative f => Encode f "my-sign" "my-sign" c T.Text where
   encoding :: Encoding f "my-sign" "my-sign" c Text
encoding = (Text -> Text) -> Encoding f "my-sign" (AlgNm "my-sign") c Text
forall (nm :: Symbol) (f :: * -> *) c str.
Applicative f =>
(str -> str) -> Encoding f nm (AlgNm nm) c str
EnT._implEncodingP Text -> Text
encodeSign    

-- | Decoding allows effectful @f@ to allow for troubleshooting and unsafe payload changes.
--
-- Implementation simply uses 'EnT.implDecodingF' combinator on the 'asUnexpected' composed with decoding function.
--
-- 'UnexpectedDecodeErr' has Identity instance allowing for decoding that assumes errors are not possible.
--
-- For debugging purposes or when unsafe changes to "my-sign" @Error UnexpectedDecodeEx@ instance can be used.
instance (UnexpectedDecodeErr f, Applicative f) => Decode f "my-sign" "my-sign" c T.Text where
    decoding :: Decoding f "my-sign" "my-sign" c Text
decoding = Decoding f "my-sign" "my-sign" c Text
forall (f :: * -> *) c.
(UnexpectedDecodeErr @* f, Applicative f) =>
Decoding f "my-sign" "my-sign" c Text
decMySign 

decMySign :: (UnexpectedDecodeErr f, Applicative f) => Decoding f "my-sign" "my-sign" c T.Text
decMySign :: Decoding f "my-sign" "my-sign" c Text
decMySign = (Text -> f Text) -> Decoding f "my-sign" "my-sign" c Text
forall (nm :: Symbol) (f :: * -> *) c str.
Functor f =>
(str -> f str) -> Decoding f nm nm c str
EnT.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 "my-sign", UnexpectedDecodeErr @* f, Applicative f,
 Show err) =>
Either err a -> f a
asUnexpected @"my-sign" (Either String Text -> f Text)
-> (Text -> Either String Text) -> Text -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Text
decodeSign) 

-- | Recreation allows effectful @f@ to check for tampering with data.
--
-- Implementation simply uses 'EnT.validFromDec' combinator on the recovery function.
instance (RecreateErr f, Applicative f) => Validate f "my-sign" "my-sign" c T.Text where
    validation :: Validation f "my-sign" "my-sign" c Text
validation = Decoding (Either UnexpectedDecodeEx) "my-sign" "my-sign" c Text
-> Validation f "my-sign" "my-sign" c Text
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
EnT.validFromDec Decoding (Either UnexpectedDecodeEx) "my-sign" "my-sign" c Text
forall (f :: * -> *) c.
(UnexpectedDecodeErr @* f, Applicative f) =>
Decoding f "my-sign" "my-sign" c Text
decMySign