module
Utils.Katt.Utils
where
import Control.Error hiding (tryIO)
import qualified Control.Exception as E
import Control.Lens
import Control.Monad (liftM)
import Control.Monad.Trans (lift)
import qualified Control.Monad.State as S
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Monoid ((<>))
import qualified Network.Wreq as W
import qualified Network.Wreq.Session as WS
import System.Exit (exitFailure)
import System.IO (stderr)
type ConfigEnvInternal m = S.StateT ConfigState m
type ConfigEnv m = EitherT ErrorDesc (ConfigEnvInternal m)
type Submission = (KattisProblem, [FilePath])
type ErrorDesc = B.ByteString
type SubmissionId = Integer
type ProblemSession = Integer
type ProjectState = (KattisProblem)
data ConfigState =
ConfigState {
user :: B.ByteString,
apiKey :: B.ByteString,
host :: B.ByteString,
loginPage :: B.ByteString,
submitPage :: B.ByteString,
project :: Maybe ProjectState
}
deriving Show
type Session = (WS.Session, B.ByteString)
data KattisProblem
= ProblemId Integer
| ProblemName B.ByteString
deriving (Eq, Show)
data KattisLanguage
= LangCplusplus
| LangJava
| LangC
| LangHaskell
deriving (Eq, Show)
loginSuccess :: B.ByteString
loginSuccess = "Login successful"
inputTestExtension :: FilePath
inputTestExtension = ".in"
outputTestExtension :: FilePath
outputTestExtension = ".ans"
programName :: B.ByteString
programName = "katt"
configDir :: B.ByteString
configDir = "." <> programName
testFolder :: FilePath
testFolder = "tests"
problemAddress :: B.ByteString
problemAddress = "/problems/"
unWrapTrans :: (Monad m, S.MonadTrans t) => EitherT e m a -> EitherT e (t m) a
unWrapTrans = EitherT . lift . runEitherT
tryIO :: S.MonadIO m => IO a -> EitherT ErrorDesc m a
tryIO = EitherT . S.liftIO . liftM (fmapL (B.pack . show)) .
(E.try :: (IO a -> IO (Either E.SomeException a)))
tryIOMsg :: S.MonadIO m => B.ByteString -> IO a -> EitherT ErrorDesc m a
tryIOMsg msg = EitherT . S.liftIO . liftM (fmapL $ const msg) .
(E.try :: (IO a -> IO (Either E.SomeException a)))
terminateOnFailure :: S.MonadIO m => ErrorDesc -> EitherT ErrorDesc m a -> m a
terminateOnFailure msg state = do
res <- runEitherT state
S.liftIO $ case res of
Left errorMessage -> do
B.hPutStrLn stderr $ msg <> ", error: " <> errorMessage
exitFailure
Right success -> return success
defaultOpts :: W.Options
defaultOpts = W.defaults
& W.header "User-Agent" .~ [programName]
retrievePublicPage :: B.ByteString -> ConfigEnv IO B.ByteString
retrievePublicPage path = do
host' <- S.gets host
reply <- tryIO $W.getWith defaultOpts $ buildURL host' path
return . B.concat . BL.toChunks $ reply ^. W.responseBody
retrievePrivatePage :: Session -> B.ByteString -> EitherT ErrorDesc IO B.ByteString
retrievePrivatePage (sess, host') page = do
reply <- tryIO $WS.getWith defaultOpts sess (buildURL host' page)
return . B.concat . BL.toChunks $ reply ^. W.responseBody
buildURL :: B.ByteString -> B.ByteString -> String
buildURL host' path = B.unpack $host' <> "/" <> path
withAuth :: (WS.Session -> EitherT ErrorDesc IO a) -> ConfigEnv IO a
withAuth action = do
conf <- S.get
EitherT . S.liftIO .WS.withSession $\sess -> runEitherT $do
let formData = [("token" :: B.ByteString, apiKey conf),
("user", user conf),
("script", "true")]
url = buildURL (host conf) (loginPage conf)
reply <- tryIO $WS.postWith defaultOpts sess url formData
let response = B.concat . BL.toChunks $reply ^. W.responseBody
tryAssert ("Login failure. Server returned: '" <> response <> "'")
(response == loginSuccess)
action sess
retrieveProblemId :: KattisProblem -> IO Integer
retrieveProblemId (ProblemId id') = return id'
retrieveProblemId (ProblemName _) = undefined
retrieveProblemName :: KattisProblem -> IO B.ByteString
retrieveProblemName (ProblemId _) = undefined
retrieveProblemName (ProblemName name) = return name