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 08:45:48 +00:00
|
|
|
deriving (Show, Generic, Enum)
|
2019-04-17 05:51:15 +00:00
|
|
|
|
|
|
|
instance ToJSON AuthAlgorithm where
|
2019-04-17 08:45:48 +00:00
|
|
|
toEncoding = genericToEncoding defaultOptions
|
2019-04-17 05:51:15 +00:00
|
|
|
|
|
|
|
instance FromJSON AuthAlgorithm
|
|
|
|
|
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)
|
|
|
|
)
|