mateamt/src/Types/Auth.hs

94 lines
2.1 KiB
Haskell
Raw Normal View History

2019-04-17 05:51:15 +00:00
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
2019-04-17 08:45:48 +00:00
{-# LANGUAGE TypeSynonymInstances #-}
2019-04-17 05:51:15 +00:00
module Types.Auth where
import GHC.Generics
import Data.Aeson
import Data.ByteString
2019-04-17 08:45:48 +00:00
import qualified Data.ByteString.Base16 as B16
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
2019-04-17 05:51:15 +00:00
data AuthInfo = AuthInfo
{ authSalt :: AuthSalt
, authAlgorithm :: AuthAlgorithm
}
deriving (Show, Generic)
instance ToJSON AuthInfo where
2019-04-17 08:45:48 +00:00
toEncoding = genericToEncoding defaultOptions
2019-04-17 05:51:15 +00:00
instance FromJSON AuthInfo
data AuthAlgorithm
= PBKDF2
2019-04-17 09:09:49 +00:00
deriving (Show, Read, Generic, Enum)
2019-04-17 05:51:15 +00:00
instance ToJSON AuthAlgorithm where
2019-04-17 09:09:49 +00:00
toJSON = toJSON . show
2019-04-17 05:51:15 +00:00
2019-04-17 09:09:49 +00:00
instance FromJSON AuthAlgorithm where
parseJSON j = read <$> parseJSON j
2019-04-17 05:51:15 +00:00
2019-04-17 08:45:48 +00:00
newtype AuthSalt = AuthSalt ByteString deriving (Show)
2019-04-17 05:51:15 +00:00
instance ToJSON AuthSalt where
2019-04-17 08:45:48 +00:00
toJSON (AuthSalt bs) = (String . decodeUtf8 . B16.encode) bs
instance FromJSON AuthSalt where
parseJSON = withText ""
(\t -> do
let enc = fst $ B16.decode $ encodeUtf8 t
return (AuthSalt enc)
)
newtype AuthHash = AuthHash ByteString deriving (Show)
2019-04-17 05:51:15 +00:00
2019-04-17 08:45:48 +00:00
instance ToJSON AuthHash where
toJSON (AuthHash bs) = (String . decodeUtf8 . B16.encode) bs
instance FromJSON AuthHash where
parseJSON = withText ""
(\t -> do
let enc = fst $ B16.decode $ encodeUtf8 t
return (AuthHash enc)
)
2019-04-17 05:51:15 +00:00
data AuthRequest = AuthRequest
{ requestUser :: Int
2019-04-17 08:45:48 +00:00
, requestHash :: AuthHash
2019-04-17 05:51:15 +00:00
}
deriving (Show, Generic)
instance ToJSON AuthRequest where
2019-04-17 08:45:48 +00:00
toEncoding = genericToEncoding defaultOptions
2019-04-17 05:51:15 +00:00
instance FromJSON AuthRequest
data AuthResult
= Granted
2019-04-17 08:45:48 +00:00
{ authToken :: AuthToken
2019-04-17 05:51:15 +00:00
}
| Denied
deriving (Show, Generic)
instance ToJSON AuthResult where
2019-04-17 08:45:48 +00:00
toEncoding = genericToEncoding defaultOptions
2019-04-17 05:51:15 +00:00
instance FromJSON AuthResult
2019-04-17 08:45:48 +00:00
newtype AuthToken = AuthToken ByteString deriving (Show)
instance ToJSON AuthToken where
toJSON (AuthToken bs) = (String . decodeUtf8 . B16.encode) bs
instance FromJSON AuthToken where
parseJSON = withText ""
(\t -> do
let enc = fst $ B16.decode $ encodeUtf8 t
return (AuthToken enc)
)