content: -- Copyright (C) 2013, 2014, 2017  Fraser Tweedale
  --
  -- Licensed under the Apache License, Version 2.0 (the "License");
  -- you may not use this file except in compliance with the License.
  -- You may obtain a copy of the License at
  --
  --      http://www.apache.org/licenses/LICENSE-2.0
  --
  -- Unless required by applicable law or agreed to in writing, software
  -- distributed under the License is distributed on an "AS IS" BASIS,
  -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  -- See the License for the specific language governing permissions and
  -- limitations under the License.
  
  {-# LANGUAGE NoMonomorphismRestriction #-}
  
  {-|
  
  Internal utility functions for encoding/decoding JOSE types.
  
  -}
  module Crypto.JOSE.Types.Internal
    (
      insertToObject
    , insertManyToObject
    , encodeB64
    , parseB64
    , encodeB64Url
    , parseB64Url
    , bsToInteger
    , integerToBS
    , intBytes
    , sizedIntegerToBS
    , base64url
    ) where
  
  import Data.Bifunctor (first)
  import Data.Tuple (swap)
  import Data.Word (Word8)
  
  import Control.Lens
  import Control.Lens.Cons.Extras
  import Crypto.Number.Basic (log2)
  import Data.Aeson.Types
  import qualified Data.Aeson.KeyMap as M
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Base64 as B64
  import qualified Data.ByteString.Base64.URL as B64U
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as E
  
  -- | Insert the given key and value into the given @Value@, which
  -- is expected to be an @Object@.  If the value is not an @Object@,
  -- this is a no-op.
  --
  insertToObject :: ToJSON v => Key -> v -> Value -> Value
  insertToObject k v (Object o) = Object $ M.insert k (toJSON v) o
  insertToObject _ _ v          = v
  
  -- | Insert several key/value pairs to the given @Value@, which
  -- is expected to be an @Object@.  If the value is not an @Object@,
  -- this is a no-op.
  --
  insertManyToObject :: [Pair] -> Value -> Value
  insertManyToObject kvs (Object o) = Object $ foldr (uncurry M.insert) o kvs
  insertManyToObject _ v            = v
  
  -- | Produce a parser of base64 encoded text from a bytestring parser.
  --
  parseB64 :: (B.ByteString -> Parser a) -> T.Text -> Parser a
  parseB64 f = either fail f . decodeB64
    where
      decodeB64 = B64.decode . E.encodeUtf8
  
  -- | Convert a bytestring to a base64 encoded JSON 'String'
  --
  encodeB64 :: B.ByteString -> Value
  encodeB64 = String . E.decodeUtf8 . B64.encode
  
  
  -- | Prism for encoding / decoding base64url.
  --
  -- To encode, @'review' base64url@.
  -- To decode, @'preview' base64url@.
  --
  -- Works with any combinations of strict/lazy @ByteString@.
  --
  base64url ::
    ( AsEmpty s1, AsEmpty s2
    , Cons s1 s1 Word8 Word8
    , Cons s2 s2 Word8 Word8
    ) => Prism' s1 s2
  base64url = reconsIso . b64u . reconsIso
    where
      b64u = prism B64U.encodeUnpadded (\s -> first (const s) (B64U.decodeUnpadded s))
      reconsIso = iso (view recons) (view recons)
  {-# INLINE base64url #-}
  
  
  -- | Produce a parser of base64url encoded text from a bytestring parser.
  --
  parseB64Url :: (B.ByteString -> Parser a) -> T.Text -> Parser a
  parseB64Url f = maybe (fail "Not valid base64url") f . preview base64url . E.encodeUtf8
  
  -- | Convert a bytestring to a base64url encoded JSON 'String'
  --
  encodeB64Url :: B.ByteString -> Value
  encodeB64Url = String . E.decodeUtf8 . review base64url
  
  -- | Convert an unsigned big endian octet sequence to the integer
  -- it represents.
  --
  bsToInteger :: B.ByteString -> Integer
  bsToInteger = B.foldl (\acc x -> acc * 256 + toInteger x) 0
  
  -- | Convert an integer to its unsigned big endian representation as
  -- an octet sequence.
  --
  integerToBS :: Integral a => a -> B.ByteString
  integerToBS = B.reverse . B.unfoldr (fmap swap . f)
    where
      f 0 = Nothing
      f x = Just (fromIntegral <$> quotRem x 256)
  
  sizedIntegerToBS :: Integral a => Int -> a -> B.ByteString
  sizedIntegerToBS w = zeroPad . integerToBS
    where zeroPad xs = B.replicate (w - B.length xs) 0 `B.append` xs
  
  intBytes :: Integer -> Int
  intBytes n = (log2 n `div` 8) + 1
  