{- * Hedgewars, a free turn based strategy game * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com> * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; version 2 of the License * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. \-}{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}module NetRoutines whereimport Network.Socketimport Control.Concurrent.Chanimport Data.Timeimport Control.Monadimport Data.Uniqueimport qualified Codec.Binary.Base64 as Base64import qualified Data.ByteString as BWimport qualified Data.ByteString.Char8 as Bimport qualified Control.Exception as Eimport System.Entropyimport Data.Either-----------------------------import CoreTypesimport UtilsacceptLoop :: Socket -> Chan CoreMessage -> IO ()acceptLoop servSock chan = E.bracket openHandle closeHandle (forever . f) where f ch = E.try (Network.Socket.accept servSock) >>= \v -> case v of Left (e :: E.IOException) -> return () Right (sock, sockAddr) -> do clientHost <- sockAddr2String sockAddr currentTime <- getCurrentTime sendChan' <- newChan uid <- newUnique salt <- liftM (B.pack . Base64.encode . BW.unpack) $ hGetEntropy ch 18 let newClient = (ClientInfo uid sendChan' sock clientHost currentTime "" "" salt False False 0 0 False False False False False False False False Nothing Nothing newEventsInfo newEventsInfo newEventsInfo 0 ) writeChan chan $ Accept newClient return ()