{- Copyright 2017 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, FlexibleInstances, OverloadedStrings #-} module Val where import Memory import JSON import GHC.Generics (Generic) import Data.Aeson.Types import qualified Codec.Binary.Base64 as B64 import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.ByteString as B import qualified Data.Semigroup as Sem -- | Newtype of ByteString so we can have JSON instances without orphans. newtype Val = Val { val :: B.ByteString } deriving (Show, Generic, Eq, Sem.Semigroup, Monoid) instance DataSize Val where dataSize (Val b) = fromIntegral (B.length b) -- | JSON instances for Val, using base64 encoding when the value -- is not utf-8 encoded, and otherwise using a more efficient encoding. instance ToJSON Val where toJSON (Val b) = case T.decodeUtf8' b of Right v -> object [ "v" .= v ] Left _ -> object [ "b64" .= b64 b ] instance FromJSON Val where parseJSON (Object o) = do mv <- o .:? "v" case mv of Just v -> return $ Val $ T.encodeUtf8 v Nothing -> Val <$> (unb64 =<< o .: "b64") parseJSON invalid = typeMismatch "ByteString" invalid b64 :: B.ByteString -> T.Text b64 = T.decodeUtf8 . B64.encode unb64 :: Monad m => T.Text -> m B.ByteString unb64 t = either (\_ -> fail "bad base64 data") return ( B64.decode $ T.encodeUtf8 t)