-- | PASETO
-- [Pre-Authentication Encoding (PAE)](https://github.com/paseto-standard/paseto-spec/blob/af79f25908227555404e7462ccdd8ce106049469/docs/01-Protocol-Versions/Common.md#authentication-padding).
module Crypto.Paseto.PreAuthenticationEncoding
  ( encode
  , DecodingError (..)
  , decode
  ) where

import Control.Monad ( replicateM )
import Data.Binary.Get
  ( ByteOffset, Get, getByteString, getWord64le, runGetOrFail )
import Data.Binary.Put ( putByteString, putWord64le, runPut )
import Data.Bits ( (.&.) )
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Foldable ( for_ )
import Data.Word ( Word64 )
import Prelude

-- | Encode a multipart message using
-- [Pre-Authentication Encoding (PAE)](https://github.com/paseto-standard/paseto-spec/blob/af79f25908227555404e7462ccdd8ce106049469/docs/01-Protocol-Versions/Common.md#authentication-padding)
-- as defined in the PASETO spec.
encode :: [ByteString] -> ByteString
encode :: [ByteString] -> ByteString
encode [ByteString]
pieces = ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (Put -> ByteString) -> Put -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  let numPieces :: Word64
      numPieces :: Word64
numPieces = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
pieces
  Word64 -> Put
putWord64le (Word64 -> Word64
clearMsb Word64
numPieces) -- Clear the MSB for interoperability
  [ByteString] -> (ByteString -> Put) -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteString]
pieces ((ByteString -> Put) -> Put) -> (ByteString -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \ByteString
piece -> do
    let pieceLen :: Word64
        pieceLen :: Word64
pieceLen = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
piece
    Word64 -> Put
putWord64le (Word64 -> Word64
clearMsb Word64
pieceLen) -- Clear the MSB for interoperability
    ByteString -> Put
putByteString ByteString
piece
  where
    -- Clear the most significant bit of a 'Word64'.
    clearMsb :: Word64 -> Word64
    clearMsb :: Word64 -> Word64
clearMsb Word64
w64 = Word64
w64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. (Word64
0x7FFFFFFFFFFFFFFF :: Word64)

-- | Error decoding a PAE-encoded message.
newtype DecodingError = DecodingError (LBS.ByteString, ByteOffset, String)
  deriving newtype (Int -> DecodingError -> ShowS
[DecodingError] -> ShowS
DecodingError -> String
(Int -> DecodingError -> ShowS)
-> (DecodingError -> String)
-> ([DecodingError] -> ShowS)
-> Show DecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodingError -> ShowS
showsPrec :: Int -> DecodingError -> ShowS
$cshow :: DecodingError -> String
show :: DecodingError -> String
$cshowList :: [DecodingError] -> ShowS
showList :: [DecodingError] -> ShowS
Show, DecodingError -> DecodingError -> Bool
(DecodingError -> DecodingError -> Bool)
-> (DecodingError -> DecodingError -> Bool) -> Eq DecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodingError -> DecodingError -> Bool
== :: DecodingError -> DecodingError -> Bool
$c/= :: DecodingError -> DecodingError -> Bool
/= :: DecodingError -> DecodingError -> Bool
Eq)

-- | Decode a multipart message which has been encoded using
-- [Pre-Authentication Encoding (PAE)](https://github.com/paseto-standard/paseto-spec/blob/af79f25908227555404e7462ccdd8ce106049469/docs/01-Protocol-Versions/Common.md#authentication-padding)
-- as defined in the PASETO spec.
decode :: ByteString -> Either DecodingError [ByteString]
decode :: ByteString -> Either DecodingError [ByteString]
decode ByteString
bs =
  case Get [ByteString]
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, [ByteString])
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get [ByteString]
getPieces (ByteString -> ByteString
LBS.fromStrict ByteString
bs) of
    Left (ByteString, ByteOffset, String)
err -> DecodingError -> Either DecodingError [ByteString]
forall a b. a -> Either a b
Left ((ByteString, ByteOffset, String) -> DecodingError
DecodingError (ByteString, ByteOffset, String)
err)
    Right (ByteString
_, ByteOffset
_, [ByteString]
pieces) -> [ByteString] -> Either DecodingError [ByteString]
forall a b. b -> Either a b
Right [ByteString]
pieces
  where
    getPieces :: Get [ByteString]
    getPieces :: Get [ByteString]
getPieces = do
      Word64
numPieces <- Get Word64
getWord64le
      Int -> Get ByteString -> Get [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
numPieces) (Get ByteString -> Get [ByteString])
-> Get ByteString -> Get [ByteString]
forall a b. (a -> b) -> a -> b
$ do
        Word64
pieceLen <- Get Word64
getWord64le
        Int -> Get ByteString
getByteString (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
pieceLen)