{-# language CPP #-}

module System.Nix.Internal.Base
  ( BaseEncoding(Base16,NixBase32,Base64)
  , encodeWith
  , decodeWith
  )
where

import qualified Data.ByteString.Base16 as Base16
import qualified System.Nix.Base32      as Base32  -- Nix has own Base32 encoding
import qualified Data.ByteString.Base64 as Base64

-- | Constructors to indicate the base encodings
data BaseEncoding
  = NixBase32
  -- | ^ Nix has a special map of Base32 encoding
  -- Placed first, since it determines Haskell optimizations of pattern matches, & NixBase seems be the most widely used in Nix.
  | Base16
  | Base64


-- | Encode @ByteString@ with @Base@ encoding, produce @Text@.
encodeWith :: BaseEncoding -> ByteString -> Text
encodeWith :: BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
Base16 = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode
encodeWith BaseEncoding
NixBase32 = ByteString -> Text
Base32.encode
encodeWith BaseEncoding
Base64 = forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode

-- | Take the input & @Base@ encoding witness -> decode into @Text@.
decodeWith :: BaseEncoding -> Text -> Either String ByteString
#if MIN_VERSION_base16_bytestring(1,0,0)
decodeWith :: BaseEncoding -> Text -> Either String ByteString
decodeWith BaseEncoding
Base16 = ByteString -> Either String ByteString
Base16.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
#else
decodeWith Base16 = lDecode  -- this tacit sugar simply makes GHC pleased with number of args
 where
  lDecode t =
    case Base16.decode (encodeUtf8 t) of
      (x, "") -> pure $ x
      _       -> Left $ "Unable to decode base16 string" <> toString t
#endif
decodeWith BaseEncoding
NixBase32 = Text -> Either String ByteString
Base32.decode
decodeWith BaseEncoding
Base64 = ByteString -> Either String ByteString
Base64.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertUtf8 a b => a -> b
encodeUtf8