--------------------------------------------------------------------------------
-- Haskell client for Moss                                                    --
-- Copyright (c) 2018 Michael B. Gale (m.gale@warwick.ac.uk)                  --
--------------------------------------------------------------------------------

module Stanford.Moss (
    MossCfg(..),
    defaultMossCfg,

    Language(..),
    Moss,
    liftIO,

    withMoss,
    addBaseFile,
    addFile,
    addFilesForStudent,
    query
) where

--------------------------------------------------------------------------------

import Control.Exception
import Control.Monad
import Control.Monad.State

import Data.Monoid

import Network.Simple.TCP

import System.IO
import System.PosixCompat

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C

--------------------------------------------------------------------------------

-- | Represents configurations for a Moss connection.
data MossCfg = MossCfg {
    MossCfg -> HostName
mossServer     :: HostName,
    MossCfg -> HostName
mossPort       :: ServiceName,
    MossCfg -> ByteString
mossUser       :: BS.ByteString,
    MossCfg -> Maybe HostName
mossDir        :: Maybe FilePath,
    MossCfg -> Bool
mossX          :: Bool,
    MossCfg -> Int
mossMaxMatches :: Int,
    MossCfg -> Bool
mossShow       :: Bool,
    MossCfg -> Language
mossLanguage   :: Language
} deriving (MossCfg -> MossCfg -> Bool
(MossCfg -> MossCfg -> Bool)
-> (MossCfg -> MossCfg -> Bool) -> Eq MossCfg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MossCfg -> MossCfg -> Bool
$c/= :: MossCfg -> MossCfg -> Bool
== :: MossCfg -> MossCfg -> Bool
$c== :: MossCfg -> MossCfg -> Bool
Eq, Int -> MossCfg -> ShowS
[MossCfg] -> ShowS
MossCfg -> HostName
(Int -> MossCfg -> ShowS)
-> (MossCfg -> HostName) -> ([MossCfg] -> ShowS) -> Show MossCfg
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [MossCfg] -> ShowS
$cshowList :: [MossCfg] -> ShowS
show :: MossCfg -> HostName
$cshow :: MossCfg -> HostName
showsPrec :: Int -> MossCfg -> ShowS
$cshowsPrec :: Int -> MossCfg -> ShowS
Show)

-- | 'defaultMossCfg' is the default configuration for a Moss connection.
defaultMossCfg :: MossCfg
defaultMossCfg :: MossCfg
defaultMossCfg = MossCfg :: HostName
-> HostName
-> ByteString
-> Maybe HostName
-> Bool
-> Int
-> Bool
-> Language
-> MossCfg
MossCfg {
    mossServer :: HostName
mossServer     = HostName
"moss.stanford.edu",
    mossPort :: HostName
mossPort       = HostName
"7690",
    mossUser :: ByteString
mossUser       = ByteString
"",
    mossDir :: Maybe HostName
mossDir        = Maybe HostName
forall a. Maybe a
Nothing,
    mossX :: Bool
mossX          = Bool
False,
    mossMaxMatches :: Int
mossMaxMatches = Int
250,
    mossShow :: Bool
mossShow       = Bool
True,
    mossLanguage :: Language
mossLanguage   = Language
Haskell
}

--------------------------------------------------------------------------------

-- | Enumerates programming languages supported by Moss.
data Language
    = C
    | CPP
    | Java
    | CSharp
    | Python
    | VisualBasic
    | Javascript
    | FORTRAN
    | ML
    | Haskell
    | Lisp
    | Scheme
    | Pascal
    | Modula2
    | Ada
    | Perl
    | TCL
    | Matlab
    | VHDL
    | Verilog
    | Spice
    | MIPS
    | A8086
    | HCL2
    | ASCII
    | Prolog
    | PLSQL
    deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum Language
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Language -> Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFrom :: Language -> [Language]
fromEnum :: Language -> Int
$cfromEnum :: Language -> Int
toEnum :: Int -> Language
$ctoEnum :: Int -> Language
pred :: Language -> Language
$cpred :: Language -> Language
succ :: Language -> Language
$csucc :: Language -> Language
Enum)

instance Show Language where
    show :: Language -> HostName
show Language
C = HostName
"c"
    show Language
CPP = HostName
"cc"
    show Language
Java = HostName
"java"
    show Language
CSharp = HostName
"csharp"
    show Language
Python = HostName
"python"
    show Language
VisualBasic = HostName
"vb"
    show Language
Javascript = HostName
"javascript"
    show Language
FORTRAN = HostName
"fortran"
    show Language
ML = HostName
"ml"
    show Language
Haskell = HostName
"haskell"
    show Language
Lisp = HostName
"lisp"
    show Language
Scheme = HostName
"scheme"
    show Language
Pascal = HostName
"pascal"
    show Language
Modula2 = HostName
"modula2"
    show Language
Ada = HostName
"ada"
    show Language
Perl = HostName
"perl"
    show Language
TCL = HostName
"tcl"
    show Language
Matlab = HostName
"matlab"
    show Language
VHDL = HostName
"vhdl"
    show Language
Verilog = HostName
"verilog"
    show Language
Spice = HostName
"spice"
    show Language
MIPS = HostName
"mips"
    show Language
A8086 = HostName
"a8086"
    show Language
ASCII = HostName
"ascii"
    show Language
Prolog = HostName
"prolog"
    show Language
PLSQL = HostName
"plsql"

--------------------------------------------------------------------------------

-- | Represents the state of a Moss connection.
data MossSt = MossSt {
    MossSt -> Socket
mossSocket  :: Socket,
    MossSt -> Int
mossCounter :: Int,
    MossSt -> MossCfg
mossCfg     :: MossCfg
} deriving (MossSt -> MossSt -> Bool
(MossSt -> MossSt -> Bool)
-> (MossSt -> MossSt -> Bool) -> Eq MossSt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MossSt -> MossSt -> Bool
$c/= :: MossSt -> MossSt -> Bool
== :: MossSt -> MossSt -> Bool
$c== :: MossSt -> MossSt -> Bool
Eq, Int -> MossSt -> ShowS
[MossSt] -> ShowS
MossSt -> HostName
(Int -> MossSt -> ShowS)
-> (MossSt -> HostName) -> ([MossSt] -> ShowS) -> Show MossSt
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [MossSt] -> ShowS
$cshowList :: [MossSt] -> ShowS
show :: MossSt -> HostName
$cshow :: MossSt -> HostName
showsPrec :: Int -> MossSt -> ShowS
$cshowsPrec :: Int -> MossSt -> ShowS
Show)

-- | The type of computations which use a connection to Moss.
type Moss = StateT MossSt IO

-- | 'sendCmd' @socket bytestring@ sends @bytestring@ as a command over the
-- connection represented by @socket@.
sendCmd :: Socket -> BS.ByteString -> IO ()
sendCmd :: Socket -> ByteString -> IO ()
sendCmd Socket
s ByteString
xs = do
    HostName -> IO ()
putStr HostName
"Send: "
    HostName -> IO ()
putStrLn (ByteString -> HostName
forall a. Show a => a -> HostName
show ByteString
xs)
    Socket -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
send Socket
s (ByteString
xs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")

-- | 'withMoss' @cfg m@ runs a computation @m@ using a Moss connection whose
-- configuration is reprsented by @cfg@.
withMoss :: MossCfg -> Moss a -> IO a
withMoss :: MossCfg -> Moss a -> IO a
withMoss (cfg :: MossCfg
cfg@MossCfg {Bool
Int
HostName
Maybe HostName
ByteString
Language
mossLanguage :: Language
mossShow :: Bool
mossMaxMatches :: Int
mossX :: Bool
mossDir :: Maybe HostName
mossUser :: ByteString
mossPort :: HostName
mossServer :: HostName
mossLanguage :: MossCfg -> Language
mossShow :: MossCfg -> Bool
mossMaxMatches :: MossCfg -> Int
mossX :: MossCfg -> Bool
mossDir :: MossCfg -> Maybe HostName
mossUser :: MossCfg -> ByteString
mossPort :: MossCfg -> HostName
mossServer :: MossCfg -> HostName
..}) Moss a
m =
    HostName -> HostName -> ((Socket, SockAddr) -> IO a) -> IO a
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
HostName -> HostName -> ((Socket, SockAddr) -> m r) -> m r
connect HostName
mossServer HostName
mossPort (((Socket, SockAddr) -> IO a) -> IO a)
-> ((Socket, SockAddr) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Socket
s, SockAddr
addr) -> do
        Socket -> ByteString -> IO ()
sendCmd Socket
s (ByteString
"moss " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
mossUser)
        Socket -> ByteString -> IO ()
sendCmd Socket
s (ByteString
"X " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (Int -> HostName
forall a. Show a => a -> HostName
show (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
mossX)))
        Socket -> ByteString -> IO ()
sendCmd Socket
s (ByteString
"maxmatches " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (Int -> HostName
forall a. Show a => a -> HostName
show Int
mossMaxMatches))
        Socket -> ByteString -> IO ()
sendCmd Socket
s (ByteString
"language " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (Language -> HostName
forall a. Show a => a -> HostName
show Language
mossLanguage))

        Maybe ByteString
ls <- Socket -> Int -> IO (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
recv Socket
s Int
1024

        case Maybe ByteString
ls of
            Maybe ByteString
Nothing -> HostName -> IO a
forall a. HasCallStack => HostName -> a
error HostName
"No data received."
            Just ByteString
"no" -> do
                Socket -> ByteString -> IO ()
sendCmd Socket
s ByteString
"end"
                HostName -> IO a
forall a. HasCallStack => HostName -> a
error HostName
"Language not supported"
            Just ByteString
_ -> do
                HostName -> IO ()
putStrLn HostName
"Language supported."
                a
r <- Moss a -> MossSt -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Moss a
m (Socket -> Int -> MossCfg -> MossSt
MossSt Socket
s Int
1 MossCfg
cfg)
                Socket -> ByteString -> IO ()
sendCmd Socket
s ByteString
"end"
                a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | 'uploadFile' @index name path@ uploads a file located at @path@ to Moss
-- and assigns it to the collection of files at @index@ (e.g. representing
-- a student) with the name given by @name@.
uploadFile :: Int -> String -> FilePath -> Moss ()
uploadFile :: Int -> HostName -> HostName -> Moss ()
uploadFile Int
i HostName
dn HostName
fp = do
    Socket
s <- (MossSt -> Socket) -> StateT MossSt IO Socket
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MossSt -> Socket
mossSocket
    MossCfg{Bool
Int
HostName
Maybe HostName
ByteString
Language
mossLanguage :: Language
mossShow :: Bool
mossMaxMatches :: Int
mossX :: Bool
mossDir :: Maybe HostName
mossUser :: ByteString
mossPort :: HostName
mossServer :: HostName
mossLanguage :: MossCfg -> Language
mossShow :: MossCfg -> Bool
mossMaxMatches :: MossCfg -> Int
mossX :: MossCfg -> Bool
mossDir :: MossCfg -> Maybe HostName
mossUser :: MossCfg -> ByteString
mossPort :: MossCfg -> HostName
mossServer :: MossCfg -> HostName
..} <- (MossSt -> MossCfg) -> StateT MossSt IO MossCfg
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MossSt -> MossCfg
mossCfg

    IO () -> Moss ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Moss ()) -> IO () -> Moss ()
forall a b. (a -> b) -> a -> b
$ do
        FileOffset
size <- FileStatus -> FileOffset
fileSize (FileStatus -> FileOffset) -> IO FileStatus -> IO FileOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO FileStatus
getFileStatus HostName
fp
        Socket -> ByteString -> IO ()
sendCmd Socket
s ( ByteString
"file "
             ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (Int -> HostName
forall a. Show a => a -> HostName
show Int
i) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
             ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (Language -> HostName
forall a. Show a => a -> HostName
show Language
mossLanguage) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
             ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack (FileOffset -> HostName
forall a. Show a => a -> HostName
show FileOffset
size) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" "
             ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> HostName -> ByteString
C.pack HostName
dn)

        ByteString
xs <- HostName -> IO ByteString
BS.readFile HostName
fp
        Socket -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
send Socket
s ByteString
xs

-- | 'addBaseFile' @file@ adds @file@ as part of the skeleton code.
addBaseFile :: String -> FilePath -> Moss ()
addBaseFile :: HostName -> HostName -> Moss ()
addBaseFile = Int -> HostName -> HostName -> Moss ()
uploadFile Int
0

-- | 'addFile' @name file@ adds @file@ as a submission to Moss with @name@.
addFile :: String -> FilePath -> Moss ()
addFile :: HostName -> HostName -> Moss ()
addFile HostName
desc HostName
fp = do
    MossSt
st <- StateT MossSt IO MossSt
forall s (m :: * -> *). MonadState s m => m s
get
    Int -> HostName -> HostName -> Moss ()
uploadFile (MossSt -> Int
mossCounter MossSt
st) HostName
desc HostName
fp
    MossSt -> Moss ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (MossSt -> Moss ()) -> MossSt -> Moss ()
forall a b. (a -> b) -> a -> b
$ MossSt
st { mossCounter :: Int
mossCounter = MossSt -> Int
mossCounter MossSt
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

-- | 'addFilesForStudent' @filesWithNames@ uploads multiple files for
-- the same student. I.e. in the Moss submission they will share the same ID.
addFilesForStudent :: [(String, FilePath)] -> Moss ()
addFilesForStudent :: [(HostName, HostName)] -> Moss ()
addFilesForStudent [(HostName, HostName)]
fs = do
    MossSt
st <- StateT MossSt IO MossSt
forall s (m :: * -> *). MonadState s m => m s
get
    [(HostName, HostName)]
-> ((HostName, HostName) -> Moss ()) -> Moss ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(HostName, HostName)]
fs (((HostName, HostName) -> Moss ()) -> Moss ())
-> ((HostName, HostName) -> Moss ()) -> Moss ()
forall a b. (a -> b) -> a -> b
$ \(HostName
dn,HostName
fn) ->
        Int -> HostName -> HostName -> Moss ()
uploadFile (MossSt -> Int
mossCounter MossSt
st) HostName
dn HostName
fn
    MossSt -> Moss ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (MossSt -> Moss ()) -> MossSt -> Moss ()
forall a b. (a -> b) -> a -> b
$ MossSt
st { mossCounter :: Int
mossCounter = MossSt -> Int
mossCounter MossSt
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

-- | 'query' @comment@ runs the plagiarism check on all submitted files. The
-- URL of the report is returned if Moss was able to perform the checks
-- successfully.
query :: BS.ByteString -> Moss (Maybe BS.ByteString)
query :: ByteString -> Moss (Maybe ByteString)
query ByteString
cmt = do
    Socket
s <- (MossSt -> Socket) -> StateT MossSt IO Socket
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MossSt -> Socket
mossSocket
    IO (Maybe ByteString) -> Moss (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> Moss (Maybe ByteString))
-> IO (Maybe ByteString) -> Moss (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
        HostName -> IO ()
putStrLn HostName
"Querying, this may take several minutes..."
        Socket -> ByteString -> IO ()
sendCmd Socket
s (ByteString
"query 0 " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
cmt)
        Socket -> Int -> IO (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
recv Socket
s Int
1024

--------------------------------------------------------------------------------