Replace raw HTTP dispatch with typed Servant API
This commit is contained in:
parent
06d1383456
commit
435d4fea4c
1 changed files with 1625 additions and 445 deletions
572
src/Nuthatch/Api.hs
Normal file
572
src/Nuthatch/Api.hs
Normal file
|
|
@ -0,0 +1,572 @@
|
|||
module Nuthatch.Api
|
||||
( Api
|
||||
, HealthEndpoint
|
||||
, ReadyEndpoint
|
||||
, LoginPageEndpoint
|
||||
, BrowserScriptEndpoint
|
||||
, LoginEndpoint
|
||||
, LoginSuccess
|
||||
, LogoutEndpoint
|
||||
, LogoutSuccess
|
||||
, BrowseEndpoint
|
||||
, DownloadEndpoint
|
||||
, DownloadSuccess
|
||||
, UploadEndpoint
|
||||
, DeleteEndpoint
|
||||
, DeletePrefixEndpoint
|
||||
, api
|
||||
, HTML
|
||||
, JavaScript
|
||||
, HtmlPage (..)
|
||||
, BrowserScript (..)
|
||||
, SessionContext (..)
|
||||
, SessionAuth
|
||||
, BrowsePrefix (..)
|
||||
, PaginationToken (..)
|
||||
, SearchQuery (..)
|
||||
, DeclaredSize (..)
|
||||
, DevUsername (..)
|
||||
, LoginRequest (..)
|
||||
, LoginResponse (..)
|
||||
, LoginView (..)
|
||||
, HealthResponse (..)
|
||||
, ReadyResponse (..)
|
||||
, BrowseResponse (..)
|
||||
, BrowseView (..)
|
||||
, DeleteRequest (..)
|
||||
, DeletePrefixRequest (..)
|
||||
, DeletePrefixResponse (..)
|
||||
, UploadResponse (..)
|
||||
, DeleteResponse (..)
|
||||
, Throws
|
||||
, BoundaryError (..)
|
||||
, AuthenticationError (..)
|
||||
, ReadyError (..)
|
||||
, LoginError (..)
|
||||
, LogoutError (..)
|
||||
, BrowseError (..)
|
||||
, DownloadError (..)
|
||||
, UploadError (..)
|
||||
, DeleteError (..)
|
||||
, DeletePrefixError (..)
|
||||
, validatePaginationToken
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
( FromJSON (..)
|
||||
, ToJSON (..)
|
||||
, Value
|
||||
, object
|
||||
, withObject
|
||||
, (.:)
|
||||
, (.=)
|
||||
)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Char (isControl)
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Network.HTTP.Media ((//), (/:))
|
||||
import Nuthatch.Types
|
||||
import Servant.API
|
||||
import Servant.Server (HasServer (..))
|
||||
import Servant.Server.Experimental.Auth (AuthServerData)
|
||||
import Web.FormUrlEncoded (FromForm (..), lookupUnique)
|
||||
|
||||
data HTML
|
||||
data JavaScript
|
||||
|
||||
instance Accept HTML where
|
||||
contentType _ = "text" // "html" /: ("charset", "utf-8")
|
||||
|
||||
instance Accept JavaScript where
|
||||
contentType _ = "text" // "javascript" /: ("charset", "utf-8")
|
||||
|
||||
newtype HtmlPage = HtmlPage { unHtmlPage :: Text }
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance MimeRender HTML HtmlPage where
|
||||
mimeRender _ = BL.fromStrict . TE.encodeUtf8 . unHtmlPage
|
||||
|
||||
newtype BrowserScript = BrowserScript { unBrowserScript :: Text }
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance MimeRender JavaScript BrowserScript where
|
||||
mimeRender _ = BL.fromStrict . TE.encodeUtf8 . unBrowserScript
|
||||
|
||||
data SessionContext = SessionContext
|
||||
{ sessionUser :: SessionUser
|
||||
, sessionCsrf :: Maybe CsrfToken
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
data SessionAuth
|
||||
|
||||
type instance AuthServerData (AuthProtect SessionAuth) = SessionContext
|
||||
|
||||
newtype BrowsePrefix = BrowsePrefix { unBrowsePrefix :: Maybe RelativePath }
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
newtype PaginationToken = PaginationToken { unPaginationToken :: Text }
|
||||
deriving stock (Eq, Show)
|
||||
deriving newtype (ToJSON, FromJSON)
|
||||
|
||||
newtype SearchQuery = SearchQuery { unSearchQuery :: Text }
|
||||
deriving stock (Eq, Show)
|
||||
deriving newtype (ToJSON, FromJSON)
|
||||
|
||||
newtype DeclaredSize = DeclaredSize { unDeclaredSize :: Integer }
|
||||
deriving stock (Eq, Ord, Show)
|
||||
deriving newtype (ToJSON, FromJSON)
|
||||
|
||||
newtype DevUsername = DevUsername { unDevUsername :: Text }
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
data LoginRequest = LoginRequest
|
||||
{ loginUsername :: DevUsername
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance FromJSON LoginRequest where
|
||||
parseJSON = withObject "LoginRequest" $ \o -> do
|
||||
raw <- o .: "username"
|
||||
LoginRequest <$> either (fail . T.unpack) pure (validateDevUsername raw)
|
||||
|
||||
instance FromForm LoginRequest where
|
||||
fromForm form = do
|
||||
raw <- lookupUnique "username" form
|
||||
LoginRequest <$> validateDevUsername raw
|
||||
|
||||
data LoginResponse = LoginResponse
|
||||
{ loginUserId :: UserId
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON LoginResponse where
|
||||
toJSON response = object ["user_id" .= loginUserId response]
|
||||
|
||||
data LoginView = LoginView
|
||||
{ loginViewHtml :: HtmlPage
|
||||
, loginViewJson :: LoginResponse
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance MimeRender HTML LoginView where
|
||||
mimeRender proxy = mimeRender proxy . loginViewHtml
|
||||
|
||||
instance ToJSON LoginView where
|
||||
toJSON = toJSON . loginViewJson
|
||||
|
||||
newtype HealthResponse = HealthResponse { healthOk :: Bool }
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON HealthResponse where
|
||||
toJSON response = object ["ok" .= healthOk response]
|
||||
|
||||
newtype ReadyResponse = ReadyResponse { ready :: Bool }
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON ReadyResponse where
|
||||
toJSON response = object ["ready" .= ready response]
|
||||
|
||||
data BrowseResponse = BrowseResponse
|
||||
{ browseEntries :: [ListEntry]
|
||||
, browseContinuation :: Maybe PaginationToken
|
||||
, browsePartial :: Bool
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON BrowseResponse where
|
||||
toJSON response = object
|
||||
[ "entries" .= browseEntries response
|
||||
, "continuation" .= browseContinuation response
|
||||
, "partial" .= browsePartial response
|
||||
]
|
||||
|
||||
data BrowseView = BrowseView
|
||||
{ browseViewHtml :: HtmlPage
|
||||
, browseViewJson :: BrowseResponse
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance MimeRender HTML BrowseView where
|
||||
mimeRender proxy = mimeRender proxy . browseViewHtml
|
||||
|
||||
instance ToJSON BrowseView where
|
||||
toJSON = toJSON . browseViewJson
|
||||
|
||||
data DeleteRequest = DeleteRequest
|
||||
{ deleteRoot :: Root
|
||||
, deletePath :: RelativePath
|
||||
, deleteOperationId :: OperationId
|
||||
, deleteCsrf :: CsrfToken
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance FromJSON DeleteRequest where
|
||||
parseJSON = withObject "DeleteRequest" $ \o ->
|
||||
DeleteRequest
|
||||
<$> o .: "root"
|
||||
<*> o .: "path"
|
||||
<*> o .: "operation_id"
|
||||
<*> o .: "csrf"
|
||||
|
||||
data DeletePrefixRequest = DeletePrefixRequest
|
||||
{ deletePrefixRoot :: Root
|
||||
, deletePrefixPath :: RelativePath
|
||||
, deletePrefixCsrf :: CsrfToken
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance FromJSON DeletePrefixRequest where
|
||||
parseJSON = withObject "DeletePrefixRequest" $ \o ->
|
||||
DeletePrefixRequest
|
||||
<$> o .: "root"
|
||||
<*> o .: "path"
|
||||
<*> o .: "csrf"
|
||||
|
||||
newtype DeletePrefixResponse = DeletePrefixResponse
|
||||
{ deletedObjectCount :: Int
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON DeletePrefixResponse where
|
||||
toJSON response = object ["deleted" .= deletedObjectCount response]
|
||||
|
||||
data UploadResponse = UploadResponse
|
||||
{ uploadResponseOperationId :: OperationId
|
||||
, uploadResponseResult :: MutationResult
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON UploadResponse where
|
||||
toJSON response = object
|
||||
[ "operation_id" .= uploadResponseOperationId response
|
||||
, "result" .= mutationResultText (uploadResponseResult response)
|
||||
]
|
||||
|
||||
data DeleteResponse = DeleteResponse
|
||||
{ deleteResponseOperationId :: OperationId
|
||||
, deleteResponseResult :: MutationResult
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON DeleteResponse where
|
||||
toJSON response = object
|
||||
[ "operation_id" .= deleteResponseOperationId response
|
||||
, "result" .= mutationResultText (deleteResponseResult response)
|
||||
]
|
||||
|
||||
data Throws error
|
||||
|
||||
instance HasServer endpoint context =>
|
||||
HasServer (Throws error :> endpoint) context where
|
||||
type ServerT (Throws error :> endpoint) m = ServerT endpoint m
|
||||
route _ = route (Proxy :: Proxy endpoint)
|
||||
hoistServerWithContext _ context transform server =
|
||||
hoistServerWithContext
|
||||
(Proxy :: Proxy endpoint)
|
||||
context
|
||||
transform
|
||||
server
|
||||
|
||||
instance HasLink endpoint => HasLink (Throws error :> endpoint) where
|
||||
type MkLink (Throws error :> endpoint) result = MkLink endpoint result
|
||||
toLink convert _ = toLink convert (Proxy :: Proxy endpoint)
|
||||
|
||||
data BoundaryError = InvalidUtf8
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON BoundaryError where
|
||||
toJSON InvalidUtf8 =
|
||||
errorValue "invalid_utf8" "request paths and query values must be valid UTF-8" Nothing
|
||||
|
||||
data AuthenticationError
|
||||
= AuthenticationRequired
|
||||
| MalformedAuthentication
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON AuthenticationError where
|
||||
toJSON AuthenticationRequired =
|
||||
errorValue "authentication_required" "login required" Nothing
|
||||
toJSON MalformedAuthentication =
|
||||
errorValue "malformed_authentication" "authentication data is malformed" Nothing
|
||||
|
||||
data ReadyError = ReadyDependencyUnavailable
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON ReadyError where
|
||||
toJSON ReadyDependencyUnavailable =
|
||||
errorValue "dependency_unavailable" "PostgreSQL is unavailable" Nothing
|
||||
|
||||
data LoginError
|
||||
= InvalidUsername
|
||||
| SessionCreationFailed Text
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON LoginError where
|
||||
toJSON InvalidUsername =
|
||||
errorValue "invalid_username" "username must be one token" Nothing
|
||||
toJSON (SessionCreationFailed message) =
|
||||
errorValue "session_error" message Nothing
|
||||
|
||||
data LogoutError = LogoutCsrfRejected
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON LogoutError where
|
||||
toJSON LogoutCsrfRejected =
|
||||
errorValue "csrf_validation_failed" "CSRF validation failed" Nothing
|
||||
|
||||
newtype BrowseError = BrowseObjectStoreFailed Text
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON BrowseError where
|
||||
toJSON (BrowseObjectStoreFailed message) =
|
||||
errorValue "object_store_error" message Nothing
|
||||
|
||||
data DownloadError
|
||||
= DownloadObjectStoreFailed Text
|
||||
| DownloadNotFound
|
||||
| DownloadThrottleUnavailable
|
||||
| DownloadBandwidthExceeded
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON DownloadError where
|
||||
toJSON (DownloadObjectStoreFailed message) =
|
||||
errorValue "object_store_error" message Nothing
|
||||
toJSON DownloadNotFound =
|
||||
errorValue "not_found" "object not found" Nothing
|
||||
toJSON DownloadThrottleUnavailable =
|
||||
errorValue "throttle_unavailable" "bandwidth throttle unavailable" Nothing
|
||||
toJSON DownloadBandwidthExceeded =
|
||||
errorValue "bandwidth_exceeded" "bandwidth limit exceeded" Nothing
|
||||
|
||||
data UploadError
|
||||
= UploadCsrfRejected
|
||||
| UploadInvalidBodyStream Text
|
||||
| UploadSizeMismatch
|
||||
| UploadTooLarge
|
||||
| UploadContentIdentityMismatch
|
||||
| UploadThrottleUnavailable
|
||||
| UploadBandwidthExceeded
|
||||
| UploadMutationRejected Text
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON UploadError where
|
||||
toJSON UploadCsrfRejected =
|
||||
errorValue "csrf_validation_failed" "CSRF validation failed" Nothing
|
||||
toJSON (UploadInvalidBodyStream message) =
|
||||
errorValue "invalid_body_stream" message Nothing
|
||||
toJSON UploadSizeMismatch =
|
||||
errorValue "size_mismatch" "request body does not match declared size" Nothing
|
||||
toJSON UploadTooLarge =
|
||||
errorValue "object_too_large" "object too large" Nothing
|
||||
toJSON UploadContentIdentityMismatch =
|
||||
errorValue "content_identity_mismatch" "request body digest does not match" Nothing
|
||||
toJSON UploadThrottleUnavailable =
|
||||
errorValue "throttle_unavailable" "bandwidth throttle unavailable" Nothing
|
||||
toJSON UploadBandwidthExceeded =
|
||||
errorValue "bandwidth_exceeded" "bandwidth limit exceeded" Nothing
|
||||
toJSON (UploadMutationRejected message) =
|
||||
errorValue "mutation_rejected" message Nothing
|
||||
|
||||
data DeleteError
|
||||
= DeleteCsrfRejected
|
||||
| DeleteMutationRejected Text
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON DeleteError where
|
||||
toJSON DeleteCsrfRejected =
|
||||
errorValue "csrf_validation_failed" "CSRF validation failed" Nothing
|
||||
toJSON (DeleteMutationRejected message) =
|
||||
errorValue "mutation_rejected" message Nothing
|
||||
|
||||
data DeletePrefixError
|
||||
= DeletePrefixCsrfRejected
|
||||
| DeletePrefixMutationRejected Text
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance ToJSON DeletePrefixError where
|
||||
toJSON DeletePrefixCsrfRejected =
|
||||
errorValue "csrf_validation_failed" "CSRF validation failed" Nothing
|
||||
toJSON (DeletePrefixMutationRejected message) =
|
||||
errorValue "prefix_mutation_rejected" message Nothing
|
||||
|
||||
errorValue :: Text -> Text -> Maybe Value -> Value
|
||||
errorValue code message details = object
|
||||
[ "error" .= code
|
||||
, "message" .= message
|
||||
, "details" .= details
|
||||
]
|
||||
|
||||
type HealthEndpoint =
|
||||
"healthz" :> Get '[JSON] HealthResponse
|
||||
|
||||
type ReadyEndpoint =
|
||||
"readyz" :> Throws ReadyError :> Get '[JSON] ReadyResponse
|
||||
|
||||
type LoginPageEndpoint =
|
||||
"login" :> Get '[HTML] HtmlPage
|
||||
|
||||
type BrowserScriptEndpoint =
|
||||
"nuthatch.js" :> Get '[JavaScript] BrowserScript
|
||||
|
||||
type LoginSuccess =
|
||||
Headers
|
||||
'[ Header "Set-Cookie" Text
|
||||
, Header "Set-Cookie" Text
|
||||
, Header "X-CSRF-Token" CsrfToken
|
||||
]
|
||||
LoginView
|
||||
|
||||
type LoginEndpoint =
|
||||
"login"
|
||||
:> Throws LoginError
|
||||
:> ReqBody '[JSON, FormUrlEncoded] LoginRequest
|
||||
:> Post '[HTML, JSON] LoginSuccess
|
||||
|
||||
type LogoutSuccess =
|
||||
Headers
|
||||
'[ Header "Set-Cookie" Text
|
||||
, Header "Set-Cookie" Text
|
||||
]
|
||||
NoContent
|
||||
|
||||
type LogoutEndpoint =
|
||||
"logout"
|
||||
:> AuthProtect SessionAuth
|
||||
:> Throws AuthenticationError
|
||||
:> Throws LogoutError
|
||||
:> Header' '[Required, Strict] "X-CSRF-Token" CsrfToken
|
||||
:> Post '[JSON] LogoutSuccess
|
||||
|
||||
type BrowseEndpoint =
|
||||
AuthProtect SessionAuth
|
||||
:> Throws AuthenticationError
|
||||
:> Throws BrowseError
|
||||
:> QueryParam "root" Root
|
||||
:> QueryParam "prefix" BrowsePrefix
|
||||
:> QueryParam "q" SearchQuery
|
||||
:> QueryParam "continuation" PaginationToken
|
||||
:> Get '[HTML, JSON] BrowseView
|
||||
|
||||
type DownloadSuccess =
|
||||
Headers
|
||||
'[ Header "Content-Disposition" Text
|
||||
, Header "X-Content-Type-Options" Text
|
||||
]
|
||||
(SourceIO BS.ByteString)
|
||||
|
||||
type DownloadEndpoint =
|
||||
"download"
|
||||
:> AuthProtect SessionAuth
|
||||
:> Throws AuthenticationError
|
||||
:> Throws DownloadError
|
||||
:> QueryParam' '[Required, Strict] "root" Root
|
||||
:> QueryParam' '[Required, Strict] "path" RelativePath
|
||||
:> StreamGet NoFraming OctetStream DownloadSuccess
|
||||
|
||||
type UploadEndpoint =
|
||||
"upload"
|
||||
:> AuthProtect SessionAuth
|
||||
:> Throws AuthenticationError
|
||||
:> Throws UploadError
|
||||
:> QueryParam' '[Required, Strict] "root" Root
|
||||
:> QueryParam' '[Required, Strict] "path" RelativePath
|
||||
:> QueryParam' '[Required, Strict] "operation_id" OperationId
|
||||
:> Header' '[Required, Strict] "X-Declared-Size" DeclaredSize
|
||||
:> Header' '[Required, Strict] "X-Content-SHA256" ContentSha256
|
||||
:> Header' '[Required, Strict] "X-CSRF-Token" CsrfToken
|
||||
:> StreamBody NoFraming OctetStream (SourceIO BS.ByteString)
|
||||
:> Post '[JSON] UploadResponse
|
||||
|
||||
type DeleteEndpoint =
|
||||
"delete"
|
||||
:> AuthProtect SessionAuth
|
||||
:> Throws AuthenticationError
|
||||
:> Throws DeleteError
|
||||
:> ReqBody '[JSON] DeleteRequest
|
||||
:> Post '[JSON] DeleteResponse
|
||||
|
||||
type DeletePrefixEndpoint =
|
||||
"delete-prefix"
|
||||
:> AuthProtect SessionAuth
|
||||
:> Throws AuthenticationError
|
||||
:> Throws DeletePrefixError
|
||||
:> ReqBody '[JSON] DeletePrefixRequest
|
||||
:> Post '[JSON] DeletePrefixResponse
|
||||
|
||||
type Api =
|
||||
HealthEndpoint
|
||||
:<|> ReadyEndpoint
|
||||
:<|> LoginPageEndpoint
|
||||
:<|> BrowserScriptEndpoint
|
||||
:<|> LoginEndpoint
|
||||
:<|> LogoutEndpoint
|
||||
:<|> BrowseEndpoint
|
||||
:<|> DownloadEndpoint
|
||||
:<|> UploadEndpoint
|
||||
:<|> DeleteEndpoint
|
||||
:<|> DeletePrefixEndpoint
|
||||
|
||||
api :: Proxy Api
|
||||
api = Proxy
|
||||
|
||||
instance ToHttpApiData BrowsePrefix where
|
||||
toUrlPiece (BrowsePrefix Nothing) = ""
|
||||
toUrlPiece (BrowsePrefix (Just path)) = unRelativePath path
|
||||
|
||||
instance FromHttpApiData BrowsePrefix where
|
||||
parseUrlPiece "" = Right (BrowsePrefix Nothing)
|
||||
parseUrlPiece raw = BrowsePrefix . Just <$> validateRelativePath raw
|
||||
|
||||
instance ToHttpApiData PaginationToken where
|
||||
toUrlPiece = unPaginationToken
|
||||
|
||||
instance FromHttpApiData PaginationToken where
|
||||
parseUrlPiece = validatePaginationToken
|
||||
|
||||
instance ToHttpApiData SearchQuery where
|
||||
toUrlPiece = unSearchQuery
|
||||
|
||||
instance FromHttpApiData SearchQuery where
|
||||
parseUrlPiece raw
|
||||
| T.null raw = Left "search query must not be empty"
|
||||
| T.length raw > 512 = Left "search query is too long"
|
||||
| T.any isControl raw = Left "search query contains a control character"
|
||||
| otherwise = Right (SearchQuery raw)
|
||||
|
||||
instance ToHttpApiData DeclaredSize where
|
||||
toUrlPiece = T.pack . show . unDeclaredSize
|
||||
|
||||
instance FromHttpApiData DeclaredSize where
|
||||
parseUrlPiece raw =
|
||||
case reads (T.unpack raw) of
|
||||
[(size, "")] | size > 0 -> Right (DeclaredSize size)
|
||||
_ -> Left "declared size must be a positive integer"
|
||||
|
||||
validatePaginationToken :: Text -> Either Text PaginationToken
|
||||
validatePaginationToken raw
|
||||
| T.null raw = Left "pagination token must not be empty"
|
||||
| T.length raw > 2048 = Left "pagination token is too long"
|
||||
| T.any isControl raw = Left "pagination token contains a control character"
|
||||
| otherwise = Right (PaginationToken raw)
|
||||
|
||||
validateDevUsername :: Text -> Either Text DevUsername
|
||||
validateDevUsername raw
|
||||
| T.null raw = Left "username must not be empty"
|
||||
| T.length raw > 128 = Left "username is too long"
|
||||
| T.any invalidCharacter raw = Left "username must be one printable token"
|
||||
| otherwise = Right (DevUsername raw)
|
||||
where
|
||||
invalidCharacter character =
|
||||
isControl character || character `elem` (" \t\r\n" :: String)
|
||||
|
||||
mutationResultText :: MutationResult -> Text
|
||||
mutationResultText MutationPending = "pending"
|
||||
mutationResultText MutationSucceeded = "succeeded"
|
||||
mutationResultText MutationFailed = "failed"
|
||||
mutationResultText MutationRejected = "rejected"
|
||||
mutationResultText MutationConflict = "conflict"
|
||||
Loading…
Reference in a new issue