keycloak-hs (empty) → 0.0.0.0
raw patch · 8 files changed
+678/−0 lines, 8 filesdep +aesondep +aeson-better-errorsdep +aeson-casingsetup-changed
Dependencies added: aeson, aeson-better-errors, aeson-casing, base, base64-bytestring, bytestring, exceptions, hslogger, http-api-data, http-client, http-types, keycloak-hs, lens, mtl, string-conversions, text, word8, wreq
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +20/−0
- Setup.hs +2/−0
- keycloak-hs.cabal +61/−0
- src/Keycloak/Client.hs +270/−0
- src/Keycloak/Types.hs +290/−0
- test/Spec.hs +2/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for keycloak-hs++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Corentin Dupont (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,20 @@+keycloak-hs+===========++keycloak-hs is a library for connecting to Keycloak made in Haskell.+Keycloak allows to authenticate users and protect resources.++Warning: This package is experimental and still under development.++Install+=======++Installation follows the standard approach to installing Stack-based projects.++1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).+2. Run `stack install --fast` to install this package.++Tutorial+========++TBD
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ keycloak-hs.cabal view
@@ -0,0 +1,61 @@+cabal-version: 1.12+name: keycloak-hs+version: 0.0.0.0+description: Please see the README on GitHub at <https://github.com/cdupont/keycloak-hs#readme>+homepage: https://github.com/cdupont/keycloak-hs#readme+bug-reports: https://github.com/cdupont/keycloak-hs/issues+author: Corentin Dupont+maintainer: corentin.dupont@gmail.com+copyright: 2019 Corentin Dupont+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/cdupont/keycloak-hs++library+ exposed-modules:+ Keycloak.Client+ Keycloak.Types+ other-modules:+ Paths_keycloak_hs+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , http-client+ , lens+ , mtl+ , word8+ , bytestring+ , text+ , aeson+ , aeson-casing+ , aeson-better-errors+ , http-api-data+ , http-types+ , hslogger+ , string-conversions+ , wreq+ , base64-bytestring+ , exceptions+ default-language: Haskell2010+++test-suite keycloak-hs-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_keycloak_hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , keycloak-hs+ default-language: Haskell2010
+ src/Keycloak/Client.hs view
@@ -0,0 +1,270 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++module Keycloak.Client where++import Control.Lens hiding ((.=))+import Control.Monad.Reader as R+import qualified Control.Monad.Catch as C+import Control.Monad.Except (throwError, catchError, MonadError)+import Data.Aeson as JSON+import Data.Aeson.Types hiding ((.=))+import Data.Aeson.BetterErrors as AB+import Data.Text hiding (head, tail, map)+import Data.Text.Encoding+import Data.Maybe+import Data.ByteString.Base64 as B64+import Data.String.Conversions+import Data.Monoid hiding (First)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as BL+import Keycloak.Types+import Network.HTTP.Client as HC hiding (responseBody)+import Network.HTTP.Types.Status+import Network.HTTP.Types.Method +import Network.HTTP.Types (renderQuery)+import Network.Wreq as W hiding (statusCode)+import Network.Wreq.Types+import System.Log.Logger+import Debug.Trace+import System.IO.Unsafe+++-------------------+-- * Permissions --+-------------------++-- Checks is a scope is permitted on a resource. An HTTP Exception 403 will be thrown if not.+checkPermission :: ResourceId -> ScopeName -> Token -> Keycloak ()+checkPermission (ResourceId res) scope tok = do+ debug $ "Checking permissions: " ++ (show res) ++ " " ++ (show scope)+ client <- asks _clientId+ let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),+ "audience" := client,+ "permission" := res <> "#" <> scope]+ keycloakPost "protocol/openid-connect/token" dat tok+ return ()++isAuthorized :: ResourceId -> ScopeName -> Token -> Keycloak Bool+isAuthorized res scope tok = do+ r <- try $ checkPermission res scope tok+ case r of+ Right _ -> return True+ Left e | (statusCode <$> getErrorStatus e) == Just 403 -> return False+ Left e -> throwError e --rethrow the error++getAllPermissions :: [ScopeName] -> Token -> Keycloak [Permission]+getAllPermissions scopes tok = do+ debug "Get all permissions"+ client <- asks _clientId+ let dat = ["grant_type" := ("urn:ietf:params:oauth:grant-type:uma-ticket" :: Text),+ "audience" := client,+ "response_mode" := ("permissions" :: Text)]+ <> map (\s -> "permission" := ("#" <> s)) scopes+ body <- keycloakPost "protocol/openid-connect/token" dat tok+ case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)+++--------------+-- * Tokens --+--------------+ +getUserAuthToken :: Text -> Text -> Keycloak Token+getUserAuthToken username password = do + debug "Get user token"+ client <- asks _clientId+ secret <- asks _clientSecret+ let dat = ["client_id" := client, + "client_secret" := secret,+ "grant_type" := ("password" :: Text),+ "password" := password,+ "username" := username]+ body <- keycloakPost' "protocol/openid-connect/token" dat+ debug $ "Keycloak: " ++ (show body) + case eitherDecode body of+ Right ret -> do + debug $ "Keycloak success: " ++ (show ret) + return ret+ Left err2 -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++getClientAuthToken :: Keycloak Token+getClientAuthToken = do+ debug "Get client token"+ client <- asks _clientId+ secret <- asks _clientSecret+ let dat = ["client_id" := client, + "client_secret" := secret,+ "grant_type" := ("client_credentials" :: Text)]+ body <- keycloakPost' "protocol/openid-connect/token" dat+ case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return $ ret+ Left err2 -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++decodeToken :: Token -> Either String TokenDec+decodeToken (Token tok) = case (BS.split '.' tok) ^? element 1 of+ Nothing -> Left "Token is not formed correctly"+ Just part2 -> case AB.parse parseTokenDec (traceShowId $ convertString $ B64.decodeLenient $ traceShowId part2) of+ Right td -> Right td+ Left (e :: ParseError String) -> Left $ show e++getUsername :: Token -> Maybe Username+getUsername tok = do + case decodeToken tok of+ Right t -> Just $ preferredUsername t+ Left e -> do+ traceM $ "Error while decoding token: " ++ (show e)+ Nothing++----------------+-- * Resource --+----------------++createResource :: Resource -> Token -> Keycloak ResourceId+createResource r tok = do+ debug $ convertString $ "Creating resource: " <> (JSON.encode r)+ body <- keycloakPost "authz/protection/resource_set" (toJSON r) tok+ debug $ convertString $ "Created resource: " ++ convertString body+ case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return $ fromJust $ resId ret+ Left err2 -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++deleteResource :: ResourceId -> Token -> Keycloak ()+deleteResource (ResourceId rid) tok = do+ keycloakDelete ("authz/protection/resource_set/" <> rid) tok + return ()+++-------------+-- * Users --+-------------++getUsers :: Maybe Max -> Maybe First -> Token -> Keycloak [User]+getUsers max first tok = do+ let query = maybe [] (\l -> [("limit", Just $ convertString $ show l)]) max+ ++ maybe [] (\m -> [("max", Just $ convertString $ show m)]) first+ body <- keycloakAdminGet ("users" <> (convertString $ renderQuery True query)) tok + debug $ "Keycloak success: " ++ (show body) + case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)++getUser :: UserId -> Token -> Keycloak User+getUser (UserId id) tok = do+ body <- keycloakAdminGet ("users/" <> (convertString id)) tok + debug $ "Keycloak success: " ++ (show body) + case eitherDecode body of+ Right ret -> do+ debug $ "Keycloak success: " ++ (show ret) + return ret+ Left (err2 :: String) -> do+ debug $ "Keycloak parse error: " ++ (show err2) + throwError $ ParseError $ pack (show err2)+++-------------------------+-- * Keycloak requests --+-------------------------+-- Perform post to Keycloak.+keycloakPost :: (Postable dat, Show dat) => Path -> dat -> Token -> Keycloak BL.ByteString+keycloakPost path dat tok = do + (KCConfig baseUrl realm _ _) <- ask+ let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken tok)]+ let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path) + info $ "Issuing KEYCLOAK POST with url: " ++ (show url) + debug $ " data: " ++ (show dat) + debug $ " headers: " ++ (show $ opts ^. W.headers) + eRes <- C.try $ liftIO $ W.postWith opts url dat+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left err -> do+ warn $ "Keycloak HTTP error: " ++ (show err)+ throwError $ HTTPError err++keycloakPost' :: (Postable dat, Show dat) => Path -> dat -> Keycloak BL.ByteString+keycloakPost' path dat = do + (KCConfig baseUrl realm _ _) <- ask+ let opts = W.defaults+ let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path) + info $ "Issuing KEYCLOAK POST with url: " ++ (show url) + debug $ " data: " ++ (show dat) + debug $ " headers: " ++ (show $ opts ^. W.headers) + eRes <- C.try $ liftIO $ W.postWith opts url dat+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left err -> do+ warn $ "Keycloak HTTP error: " ++ (show err)+ throwError $ HTTPError err++-- Perform delete to Keycloak.+keycloakDelete :: Path -> Token -> Keycloak ()+keycloakDelete path tok = do + (KCConfig baseUrl realm _ _) <- ask+ let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken tok)]+ let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/" <> path) + info $ "Issuing KEYCLOAK DELETE with url: " ++ (show url) + debug $ " headers: " ++ (show $ opts ^. W.headers) + eRes <- C.try $ liftIO $ W.deleteWith opts url+ case eRes of + Right res -> return ()+ Left err -> do+ warn $ "Keycloak HTTP error: " ++ (show err)+ throwError $ HTTPError err++-- Perform get to Keycloak on admin API+keycloakAdminGet :: Path -> Token -> Keycloak BL.ByteString+keycloakAdminGet path tok = do + (KCConfig baseUrl realm _ _) <- ask+ let opts = W.defaults & W.header "Authorization" .~ ["Bearer " <> (unToken tok)]+ let url = (unpack $ baseUrl <> "/admin/realms/" <> realm <> "/" <> path) + info $ "Issuing KEYCLOAK GET with url: " ++ (show url) + debug $ " headers: " ++ (show $ opts ^. W.headers) + eRes <- C.try $ liftIO $ W.getWith opts url+ case eRes of + Right res -> do+ return $ fromJust $ res ^? responseBody+ Left err -> do+ warn $ "Keycloak HTTP error: " ++ (show err)+ throwError $ HTTPError err+++---------------+-- * Helpers --+---------------++debug, warn, info, err :: (MonadIO m) => String -> m ()+debug s = liftIO $ debugM "API" s+info s = liftIO $ infoM "API" s+warn s = liftIO $ warningM "API" s+err s = liftIO $ errorM "API" s++getErrorStatus :: KCError -> Maybe Status +getErrorStatus (HTTPError (HttpExceptionRequest _ (StatusCodeException r _))) = Just $ HC.responseStatus r+getErrorStatus _ = Nothing++try :: MonadError a m => m b -> m (Either a b)+try act = catchError (Right <$> act) (return . Left)+
+ src/Keycloak/Types.hs view
@@ -0,0 +1,290 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++module Keycloak.Types where++import Data.Aeson+import Data.Aeson.Types+import Data.Aeson.Casing+import Data.Text hiding (head, tail, map, toLower, drop)+import Data.Text.Encoding+import Data.Monoid+import Data.Maybe+import Data.Aeson.BetterErrors as AB+import qualified Data.ByteString as BS+import qualified Data.Word8 as W8 (isSpace, _colon, toLower)+import Data.Char+import Control.Monad.Except (ExceptT)+import Control.Monad.Reader as R+import Control.Lens hiding ((.=))+import GHC.Generics (Generic)+import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..))+import Network.HTTP.Client as HC hiding (responseBody)+++----------------------+-- * Keycloak Monad --+----------------------++type Keycloak a = ReaderT KCConfig (ExceptT KCError IO) a++data KCError = HTTPError HttpException -- ^ Keycloak returned an HTTP error.+ | ParseError Text -- ^ Failed when parsing the response+ | EmptyError -- ^ Empty error to serve as a zero element for Monoid.++data KCConfig = KCConfig {+ _baseUrl :: Text,+ _realm :: Text,+ _clientId :: Text,+ _clientSecret :: Text} deriving (Eq, Show)+-- _adminLogin :: Username,+-- _adminPassword :: Password,+-- _guestLogin :: Username,+-- _guestPassword :: Password}++defaultKCConfig :: KCConfig+defaultKCConfig = KCConfig {+ _baseUrl = "http://localhost:8080/auth",+ _realm = "waziup",+ _clientId = "api-server",+ _clientSecret = "4e9dcb80-efcd-484c-b3d7-1e95a0096ac0"}+-- _adminLogin = "cdupont",+-- _adminPassword = "password",+ -- _guestLogin = "guest",+ -- _guestPassword = "guest"}++type Path = Text+++-------------+-- * Token --+-------------++newtype Token = Token {unToken :: BS.ByteString} deriving (Eq, Show, Generic)++instance FromJSON Token where+ parseJSON (Object v) = do+ t <- v .: "access_token"+ return $ Token $ encodeUtf8 t ++instance FromHttpApiData Token where+ parseQueryParam = parseHeader . encodeUtf8+ parseHeader (extractBearerAuth -> Just tok) = Right $ Token tok+ parseHeader _ = Left "cannot extract auth Bearer"++extractBearerAuth :: BS.ByteString -> Maybe BS.ByteString+extractBearerAuth bs =+ let (x, y) = BS.break W8.isSpace bs+ in if BS.map W8.toLower x == "bearer"+ then Just $ BS.dropWhile W8.isSpace y+ else Nothing++instance ToHttpApiData Token where+ toQueryParam (Token token) = "Bearer " <> (decodeUtf8 token)+ +data TokenDec = TokenDec {+ jti :: Text,+ exp :: Int,+ nbf :: Int,+ iat :: Int,+ iss :: Text,+ aud :: Text,+ sub :: Text,+ typ :: Text,+ azp :: Text,+ authTime :: Int,+ sessionState :: Text,+ acr :: Text,+ allowedOrigins :: Value,+ realmAccess :: Value,+ ressourceAccess :: Value,+ scope :: Text,+ name :: Text,+ preferredUsername :: Text,+ givenName :: Text,+ familyName :: Text,+ email :: Text+ } deriving (Generic, Show)++parseTokenDec :: Parse e TokenDec+parseTokenDec = TokenDec <$>+ AB.key "jti" asText <*>+ AB.key "exp" asIntegral <*>+ AB.key "nbf" asIntegral <*>+ AB.key "iat" asIntegral <*>+ AB.key "iss" asText <*>+ AB.key "aud" asText <*>+ AB.key "sub" asText <*>+ AB.key "typ" asText <*>+ AB.key "azp" asText <*>+ AB.key "auth_time" asIntegral <*>+ AB.key "session_state" asText <*>+ AB.key "acr" asText <*>+ AB.key "allowed-origins" asValue <*>+ AB.key "realm_access" asValue <*>+ AB.key "resource_access" asValue <*>+ AB.key "scope" asText <*>+ AB.key "name" asText <*>+ AB.key "preferred_username" asText <*>+ AB.key "given_name" asText <*>+ AB.key "family_name" asText <*>+ AB.key "email" asText++------------------+-- * Permission --+------------------++type ScopeName = Text++newtype ScopeId = ScopeId {unScopeId :: Text} deriving (Show, Eq, Generic)++--JSON instances+instance ToJSON ScopeId where+ toJSON = genericToJSON (defaultOptions {unwrapUnaryRecords = True})++instance FromJSON ScopeId where+ parseJSON = genericParseJSON (defaultOptions {unwrapUnaryRecords = True})++data Scope = Scope {+ scopeId :: Maybe ScopeId,+ scopeName :: ScopeName+ } deriving (Generic, Show, Eq)++instance ToJSON Scope where+ toJSON = genericToJSON defaultOptions {fieldLabelModifier = unCapitalize . drop 5, omitNothingFields = True}++instance FromJSON Scope where+ parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = unCapitalize . drop 5}++data Permission = Permission + { rsname :: ResourceName,+ rsid :: ResourceId,+ scopes :: [ScopeName]+ } deriving (Generic, Show, Eq)++instance ToJSON Permission where+ toJSON = genericToJSON defaultOptions {omitNothingFields = True}++instance FromJSON Permission where+ parseJSON = genericParseJSON defaultOptions++type Username = Text+type Password = Text+++------------+-- * User --+------------++type First = Int+type Max = Int++-- Id of a user+newtype UserId = UserId {unUserId :: Text} deriving (Show, Eq, Generic)++--JSON instances+instance ToJSON UserId where+ toJSON = genericToJSON (defaultOptions {unwrapUnaryRecords = True})++instance FromJSON UserId where+ parseJSON = genericParseJSON (defaultOptions {unwrapUnaryRecords = True})++-- | User +data User = User+ { userId :: Maybe UserId -- ^ The unique user ID + , userUsername :: Username -- ^ Username+ , userFirstName :: Maybe Text -- ^ First name+ , userLastName :: Maybe Text -- ^ Last name+ , userEmail :: Maybe Text -- ^ Email + } deriving (Show, Eq, Generic)++unCapitalize :: String -> String+unCapitalize (c:cs) = toLower c : cs+unCapitalize [] = []++instance FromJSON User where+ parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = unCapitalize . drop 4}++instance ToJSON User where+ toJSON = genericToJSON defaultOptions {fieldLabelModifier = drop 4, omitNothingFields = True}++-------------+-- * Owner --+-------------++data Owner = Owner {+ ownId :: Maybe Text,+ ownName :: Username+ } deriving (Generic, Show)++instance FromJSON Owner where+ parseJSON = genericParseJSON $ aesonDrop 3 snakeCase ++instance ToJSON Owner where+ toJSON = genericToJSON $ (aesonDrop 3 snakeCase) {omitNothingFields = True}+++----------------+-- * Resource --+----------------++type ResourceName = Text++newtype ResourceId = ResourceId {unResId :: Text} deriving (Show, Eq, Generic)++-- JSON instances+instance ToJSON ResourceId where+ toJSON = genericToJSON (defaultOptions {unwrapUnaryRecords = True})++instance FromJSON ResourceId where+ parseJSON = genericParseJSON (defaultOptions {unwrapUnaryRecords = True})++data Resource = Resource {+ resId :: Maybe ResourceId,+ resName :: ResourceName,+ resType :: Maybe Text,+ resUris :: [Text],+ resScopes :: [Scope],+ resOwner :: Owner,+ resOwnerManagedAccess :: Bool,+ resAttributes :: [Attribute]+ } deriving (Generic, Show)++instance FromJSON Resource where+ parseJSON (Object v) = do+ rId <- v .:? "_id"+ rName <- v .: "name"+ rType <- v .:? "type"+ rUris <- v .: "uris"+ rScopes <- v .: "scopes"+ rOwn <- v .: "owner"+ rOMA <- v .: "ownerManagedAccess"+ rAtt <- v .:? "attributes"+ return $ Resource rId rName rType rUris rScopes rOwn rOMA (maybe [] fromJust rAtt)++instance ToJSON Resource where+ toJSON (Resource id name typ uris scopes own uma attrs) =+ object ["name" .= toJSON name,+ "uris" .= toJSON uris,+ "scopes" .= toJSON scopes,+ "owner" .= toJSON own,+ "ownerManagedAccess" .= toJSON uma,+ "attributes" .= object (map (\(Attribute name vals) -> name .= toJSON vals) attrs)]++data Attribute = Attribute {+ attName :: Text,+ attValues :: [Text]+ } deriving (Generic, Show)++instance FromJSON Attribute where+ parseJSON = genericParseJSON $ aesonDrop 3 camelCase ++instance ToJSON Attribute where+ toJSON (Attribute name vals) = object [name .= toJSON vals] ++++makeLenses ''KCConfig
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"