{-# 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 'RecreateF' typeclass. -- -- 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.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 t = (T.pack . show . T.length $ t) <> ":" <> 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 t = let (sdit, rest) = T.span isDigit $ t actsize = T.length rest - 1 msize = readMaybe . T.unpack $ sdit checkDelimit = T.isInfixOf ":" rest in if msize == Just actsize && checkDelimit then Right $ T.drop 1 rest else Left $ "Corrupted Signature" -- | Encoded hello world example. -- -- >>> helloSigned -- MkEnc Proxy () "11:Hello World" -- -- >>> fromEncoding . decodeAll $ helloSigned -- "Hello World" helloSigned :: Enc '["my-sign"] () T.Text helloSigned = encodeAll . toEncoding () $ "Hello World" -- | property checks that 'T.Text' values are expected to decode -- without error after encoding. -- -- prop> \t -> propEncDec propEncDec :: T.Text -> Bool propEncDec t = let enc = encodeAll . toEncoding () $ t :: Enc '["my-sign"] () T.Text in t == (fromEncoding . decodeAll $ enc) hacker :: Either RecreateEx (Enc '["my-sign"] () T.Text) hacker = let payload = getPayload $ helloSigned :: T.Text -- | payload is sent over network and get corrupted newpay = payload <> " corruption" -- | boundary check recovers the data newdata = recreateFAll . toEncoding () $ newpay :: Either RecreateEx (Enc '["my-sign"] () T.Text) in 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 (MkEnc Proxy () "11:Hello World") -- | Because encoding function is pure we can create instance of EncodeF -- that is polymorphic in effect @f@. This is done using 'EnT.implTranP' combinator. instance Applicative f => EncodeF f (Enc xs c T.Text) (Enc ("my-sign" ': xs) c T.Text) where encodeF = EnT.implEncodeP encodeSign -- | Decoding allows effectful @f@ to allow for troubleshooting and unsafe payload changes. -- -- Implementation simply uses 'EnT.implDecodeF' 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) => DecodeF f (Enc ("my-sign" ': xs) c T.Text) (Enc xs c T.Text) where decodeF = EnT.implDecodeF (asUnexpected @"my-sign" . decodeSign) -- | Recreation allows effectful @f@ to check for tampering with data. -- Implementation simply uses 'EnT.implCheckPrevF' combinator on the recovery function. instance (RecreateErr f, Applicative f) => RecreateF f (Enc xs c T.Text) (Enc ("my-sign" ': xs) c T.Text) where checkPrevF = EnT.implCheckPrevF (asRecreateErr @"my-sign" . decodeSign)