{-# LANGUAGE GeneralizedNewtypeDeriving, LambdaCase, OverloadedStrings, ViewPatterns #-}
module BattlePlace.WebApi.Types.Util
( Base64ByteString(..)
, Base64Word64(..)
, StrWord64(..)
) where
import Control.Monad
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as J
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Encoding as BA
import qualified Data.ByteString as B
import Data.Either
import Data.Hashable
import qualified Data.Serialize as S
import Data.String
import qualified Data.Swagger as SW
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word
import Foreign.Storable
import Servant.API
base64ParseJsonStr :: S.Serialize a => T.Text -> J.Parser a
base64ParseJsonStr = \case
(BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8 -> Right (S.decode -> Right object)) -> return object
_ -> fail "wrong base64 object"
base64ToJsonStr :: S.Serialize a => a -> T.Text
base64ToJsonStr = T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded . S.encode
base64ParseUrlPiece :: S.Serialize a => T.Text -> Either T.Text a
base64ParseUrlPiece = either (Left . T.pack) (either (Left . T.pack) Right . S.decode) . BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8
newtype Base64ByteString = Base64ByteString B.ByteString deriving (Eq, Ord, Semigroup, Monoid, Hashable, BA.ByteArray, BA.ByteArrayAccess)
instance J.FromJSON Base64ByteString where
parseJSON = either fail return . BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8 <=< J.parseJSON
instance J.ToJSON Base64ByteString where
toJSON = J.toJSON . T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded
toEncoding = J.toEncoding . T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded
instance SW.ToSchema Base64ByteString where
declareNamedSchema _ = return $ SW.NamedSchema (Just "Base64ByteString") SW.byteSchema
newtype Base64Word64 = Base64Word64 Word64 deriving (Eq, Ord, Num, Storable, Hashable, S.Serialize, Read, Show)
instance J.FromJSON Base64Word64 where
parseJSON = base64ParseJsonStr <=< J.parseJSON
instance J.FromJSONKey Base64Word64 where
fromJSONKey = J.FromJSONKeyTextParser base64ParseJsonStr
instance J.ToJSON Base64Word64 where
toJSON = J.toJSON . base64ToJsonStr
toEncoding = J.toEncoding . base64ToJsonStr
instance J.ToJSONKey Base64Word64 where
toJSONKey = J.toJSONKeyText base64ToJsonStr
instance FromHttpApiData Base64Word64 where
parseUrlPiece = base64ParseUrlPiece
instance IsString Base64Word64 where
fromString = fromRight (error "wrong base64 word") . J.parseEither J.parseJSON . J.String . T.pack
instance SW.ToSchema Base64Word64 where
declareNamedSchema _ = return $ SW.NamedSchema (Just "Base64Word64") SW.byteSchema
newtype StrWord64 = StrWord64 Word64 deriving (Eq, Ord, Num, Storable, Hashable, S.Serialize, Read, Show)
instance J.FromJSON StrWord64 where
parseJSON = f . reads <=< J.parseJSON where
f = \case
[(n, "")] -> return $ StrWord64 n
_ -> fail "wrong number"
instance J.ToJSON StrWord64 where
toJSON (StrWord64 n) = J.toJSON $ show n
instance FromHttpApiData StrWord64 where
parseUrlPiece = f . reads <=< parseUrlPiece where
f = \case
[(n, "")] -> Right $ StrWord64 n
_ -> Left "wrong number"
instance SW.ToSchema StrWord64 where
declareNamedSchema _ = return $ SW.NamedSchema (Just "StrWord64") SW.byteSchema