{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
module DBus.Socket
(
Socket
, send
, receive
, SocketError
, socketError
, socketErrorMessage
, socketErrorFatal
, socketErrorAddress
, SocketOptions
, socketAuthenticator
, socketTransportOptions
, defaultSocketOptions
, open
, openWith
, close
, SocketListener
, listen
, listenWith
, accept
, closeListener
, socketListenerAddress
, Authenticator
, authenticator
, authenticatorWithUnixFds
, authenticatorClient
, authenticatorServer
) where
import Prelude hiding (getLine)
import Control.Concurrent
import Control.Exception
import Control.Monad (mplus)
import qualified Data.ByteString
import qualified Data.ByteString.Char8 as Char8
import Data.Char (ord)
import Data.IORef
import Data.List (isPrefixOf)
import Data.Typeable (Typeable)
import qualified System.Posix.User
import Text.Printf (printf)
import DBus
import DBus.Transport
import DBus.Internal.Wire (unmarshalMessageM)
data SocketError = SocketError
{ SocketError -> [Char]
socketErrorMessage :: String
, SocketError -> Bool
socketErrorFatal :: Bool
, SocketError -> Maybe Address
socketErrorAddress :: Maybe Address
}
deriving (SocketError -> SocketError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SocketError -> SocketError -> Bool
$c/= :: SocketError -> SocketError -> Bool
== :: SocketError -> SocketError -> Bool
$c== :: SocketError -> SocketError -> Bool
Eq, Int -> SocketError -> ShowS
[SocketError] -> ShowS
SocketError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SocketError] -> ShowS
$cshowList :: [SocketError] -> ShowS
show :: SocketError -> [Char]
$cshow :: SocketError -> [Char]
showsPrec :: Int -> SocketError -> ShowS
$cshowsPrec :: Int -> SocketError -> ShowS
Show, Typeable)
instance Exception SocketError
socketError :: String -> SocketError
socketError :: [Char] -> SocketError
socketError [Char]
msg = [Char] -> Bool -> Maybe Address -> SocketError
SocketError [Char]
msg Bool
True forall a. Maybe a
Nothing
data SomeTransport = forall t. (Transport t) => SomeTransport t
instance Transport SomeTransport where
data TransportOptions SomeTransport = SomeTransportOptions
transportDefaultOptions :: TransportOptions SomeTransport
transportDefaultOptions = TransportOptions SomeTransport
SomeTransportOptions
transportPut :: SomeTransport -> ByteString -> IO ()
transportPut (SomeTransport t
t) = forall t. Transport t => t -> ByteString -> IO ()
transportPut t
t
transportPutWithFds :: SomeTransport -> ByteString -> [Fd] -> IO ()
transportPutWithFds (SomeTransport t
t) = forall t. Transport t => t -> ByteString -> [Fd] -> IO ()
transportPutWithFds t
t
transportGet :: SomeTransport -> Int -> IO ByteString
transportGet (SomeTransport t
t) = forall t. Transport t => t -> Int -> IO ByteString
transportGet t
t
transportGetWithFds :: SomeTransport -> Int -> IO (ByteString, [Fd])
transportGetWithFds (SomeTransport t
t) = forall t. Transport t => t -> Int -> IO (ByteString, [Fd])
transportGetWithFds t
t
transportClose :: SomeTransport -> IO ()
transportClose (SomeTransport t
t) = forall t. Transport t => t -> IO ()
transportClose t
t
data Socket = Socket
{ Socket -> SomeTransport
socketTransport :: SomeTransport
, Socket -> Maybe Address
socketAddress :: Maybe Address
, Socket -> IORef Serial
socketSerial :: IORef Serial
, Socket -> MVar ()
socketReadLock :: MVar ()
, Socket -> MVar ()
socketWriteLock :: MVar ()
}
data Authenticator t = Authenticator
{
forall t. Authenticator t -> t -> IO Bool
authenticatorClient :: t -> IO Bool
, forall t. Authenticator t -> t -> UUID -> IO Bool
authenticatorServer :: t -> UUID -> IO Bool
}
data SocketOptions t = SocketOptions
{
forall t. SocketOptions t -> Authenticator t
socketAuthenticator :: Authenticator t
, forall t. SocketOptions t -> TransportOptions t
socketTransportOptions :: TransportOptions t
}
defaultSocketOptions :: SocketOptions SocketTransport
defaultSocketOptions :: SocketOptions SocketTransport
defaultSocketOptions = SocketOptions
{ socketTransportOptions :: TransportOptions SocketTransport
socketTransportOptions = forall t. Transport t => TransportOptions t
transportDefaultOptions
, socketAuthenticator :: Authenticator SocketTransport
socketAuthenticator = UnixFdSupport -> Authenticator SocketTransport
authExternal UnixFdSupport
UnixFdsNotSupported
}
open :: Address -> IO Socket
open :: Address -> IO Socket
open = forall t.
TransportOpen t =>
SocketOptions t -> Address -> IO Socket
openWith SocketOptions SocketTransport
defaultSocketOptions
openWith :: TransportOpen t => SocketOptions t -> Address -> IO Socket
openWith :: forall t.
TransportOpen t =>
SocketOptions t -> Address -> IO Socket
openWith SocketOptions t
opts Address
addr = forall a. Maybe Address -> IO a -> IO a
toSocketError (forall a. a -> Maybe a
Just Address
addr) forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(forall t. TransportOpen t => TransportOptions t -> Address -> IO t
transportOpen (forall t. SocketOptions t -> TransportOptions t
socketTransportOptions SocketOptions t
opts) Address
addr)
forall t. Transport t => t -> IO ()
transportClose
(\t
t -> do
Bool
authed <- forall t. Authenticator t -> t -> IO Bool
authenticatorClient (forall t. SocketOptions t -> Authenticator t
socketAuthenticator SocketOptions t
opts) t
t
if Bool -> Bool
not Bool
authed
then forall e a. Exception e => e -> IO a
throwIO ([Char] -> SocketError
socketError [Char]
"Authentication failed")
{ socketErrorAddress :: Maybe Address
socketErrorAddress = forall a. a -> Maybe a
Just Address
addr
}
else do
IORef Serial
serial <- forall a. a -> IO (IORef a)
newIORef Serial
firstSerial
MVar ()
readLock <- forall a. a -> IO (MVar a)
newMVar ()
MVar ()
writeLock <- forall a. a -> IO (MVar a)
newMVar ()
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTransport
-> Maybe Address -> IORef Serial -> MVar () -> MVar () -> Socket
Socket (forall t. Transport t => t -> SomeTransport
SomeTransport t
t) (forall a. a -> Maybe a
Just Address
addr) IORef Serial
serial MVar ()
readLock MVar ()
writeLock))
data SocketListener = forall t. (TransportListen t) => SocketListener (TransportListener t) (Authenticator t)
listen :: Address -> IO SocketListener
listen :: Address -> IO SocketListener
listen = forall t.
TransportListen t =>
SocketOptions t -> Address -> IO SocketListener
listenWith SocketOptions SocketTransport
defaultSocketOptions
listenWith :: TransportListen t => SocketOptions t -> Address -> IO SocketListener
listenWith :: forall t.
TransportListen t =>
SocketOptions t -> Address -> IO SocketListener
listenWith SocketOptions t
opts Address
addr = forall a. Maybe Address -> IO a -> IO a
toSocketError (forall a. a -> Maybe a
Just Address
addr) forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(forall t.
TransportListen t =>
TransportOptions t -> Address -> IO (TransportListener t)
transportListen (forall t. SocketOptions t -> TransportOptions t
socketTransportOptions SocketOptions t
opts) Address
addr)
forall t. TransportListen t => TransportListener t -> IO ()
transportListenerClose
(\TransportListener t
l -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall t.
TransportListen t =>
TransportListener t -> Authenticator t -> SocketListener
SocketListener TransportListener t
l (forall t. SocketOptions t -> Authenticator t
socketAuthenticator SocketOptions t
opts)))
accept :: SocketListener -> IO Socket
accept :: SocketListener -> IO Socket
accept (SocketListener TransportListener t
l Authenticator t
auth) = forall a. Maybe Address -> IO a -> IO a
toSocketError forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(forall t. TransportListen t => TransportListener t -> IO t
transportAccept TransportListener t
l)
forall t. Transport t => t -> IO ()
transportClose
(\t
t -> do
let uuid :: UUID
uuid = forall t. TransportListen t => TransportListener t -> UUID
transportListenerUUID TransportListener t
l
Bool
authed <- forall t. Authenticator t -> t -> UUID -> IO Bool
authenticatorServer Authenticator t
auth t
t UUID
uuid
if Bool -> Bool
not Bool
authed
then forall e a. Exception e => e -> IO a
throwIO ([Char] -> SocketError
socketError [Char]
"Authentication failed")
else do
IORef Serial
serial <- forall a. a -> IO (IORef a)
newIORef Serial
firstSerial
MVar ()
readLock <- forall a. a -> IO (MVar a)
newMVar ()
MVar ()
writeLock <- forall a. a -> IO (MVar a)
newMVar ()
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeTransport
-> Maybe Address -> IORef Serial -> MVar () -> MVar () -> Socket
Socket (forall t. Transport t => t -> SomeTransport
SomeTransport t
t) forall a. Maybe a
Nothing IORef Serial
serial MVar ()
readLock MVar ()
writeLock))
close :: Socket -> IO ()
close :: Socket -> IO ()
close = forall t. Transport t => t -> IO ()
transportClose forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> SomeTransport
socketTransport
closeListener :: SocketListener -> IO ()
closeListener :: SocketListener -> IO ()
closeListener (SocketListener TransportListener t
l Authenticator t
_) = forall t. TransportListen t => TransportListener t -> IO ()
transportListenerClose TransportListener t
l
socketListenerAddress :: SocketListener -> Address
socketListenerAddress :: SocketListener -> Address
socketListenerAddress (SocketListener TransportListener t
l Authenticator t
_) = forall t. TransportListen t => TransportListener t -> Address
transportListenerAddress TransportListener t
l
send :: Message msg => Socket -> msg -> (Serial -> IO a) -> IO a
send :: forall msg a.
Message msg =>
Socket -> msg -> (Serial -> IO a) -> IO a
send Socket
sock msg
msg Serial -> IO a
io = forall a. Maybe Address -> IO a -> IO a
toSocketError (Socket -> Maybe Address
socketAddress Socket
sock) forall a b. (a -> b) -> a -> b
$ do
Serial
serial <- Socket -> IO Serial
nextSocketSerial Socket
sock
case forall msg.
Message msg =>
Endianness
-> Serial -> msg -> Either MarshalError (ByteString, [Fd])
marshalWithFds Endianness
LittleEndian Serial
serial msg
msg of
Right (ByteString
bytes, [Fd]
fds) -> do
let t :: SomeTransport
t = Socket -> SomeTransport
socketTransport Socket
sock
a
a <- Serial -> IO a
io Serial
serial
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Socket -> MVar ()
socketWriteLock Socket
sock) (\()
_ -> forall t. Transport t => t -> ByteString -> [Fd] -> IO ()
transportPutWithFds SomeTransport
t ByteString
bytes [Fd]
fds)
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
Left MarshalError
err -> forall e a. Exception e => e -> IO a
throwIO ([Char] -> SocketError
socketError ([Char]
"Message cannot be sent: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show MarshalError
err))
{ socketErrorFatal :: Bool
socketErrorFatal = Bool
False
}
nextSocketSerial :: Socket -> IO Serial
nextSocketSerial :: Socket -> IO Serial
nextSocketSerial Socket
sock = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (Socket -> IORef Serial
socketSerial Socket
sock) (\Serial
x -> (Serial -> Serial
nextSerial Serial
x, Serial
x))
receive :: Socket -> IO ReceivedMessage
receive :: Socket -> IO ReceivedMessage
receive Socket
sock = forall a. Maybe Address -> IO a -> IO a
toSocketError (Socket -> Maybe Address
socketAddress Socket
sock) forall a b. (a -> b) -> a -> b
$ do
let t :: SomeTransport
t = Socket -> SomeTransport
socketTransport Socket
sock
let get :: Int -> IO (ByteString, [Fd])
get Int
n = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
Data.ByteString.empty, [])
else forall t. Transport t => t -> Int -> IO (ByteString, [Fd])
transportGetWithFds SomeTransport
t Int
n
Either UnmarshalError ReceivedMessage
received <- forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Socket -> MVar ()
socketReadLock Socket
sock) (\()
_ -> forall (m :: * -> *).
Monad m =>
(Int -> m (ByteString, [Fd]))
-> m (Either UnmarshalError ReceivedMessage)
unmarshalMessageM Int -> IO (ByteString, [Fd])
get)
case Either UnmarshalError ReceivedMessage
received of
Left UnmarshalError
err -> forall e a. Exception e => e -> IO a
throwIO ([Char] -> SocketError
socketError ([Char]
"Error reading message from socket: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show UnmarshalError
err))
Right ReceivedMessage
msg -> forall (m :: * -> *) a. Monad m => a -> m a
return ReceivedMessage
msg
toSocketError :: Maybe Address -> IO a -> IO a
toSocketError :: forall a. Maybe Address -> IO a -> IO a
toSocketError Maybe Address
addr IO a
io = forall a. IO a -> [Handler a] -> IO a
catches IO a
io [Handler a]
handlers where
handlers :: [Handler a]
handlers =
[ forall a e. Exception e => (e -> IO a) -> Handler a
Handler TransportError -> IO a
catchTransportError
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler SocketError -> IO a
updateSocketError
, forall a e. Exception e => (e -> IO a) -> Handler a
Handler IOException -> IO a
catchIOException
]
catchTransportError :: TransportError -> IO a
catchTransportError TransportError
err = forall e a. Exception e => e -> IO a
throwIO ([Char] -> SocketError
socketError (TransportError -> [Char]
transportErrorMessage TransportError
err))
{ socketErrorAddress :: Maybe Address
socketErrorAddress = Maybe Address
addr
}
updateSocketError :: SocketError -> IO a
updateSocketError SocketError
err = forall e a. Exception e => e -> IO a
throwIO SocketError
err
{ socketErrorAddress :: Maybe Address
socketErrorAddress = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (SocketError -> Maybe Address
socketErrorAddress SocketError
err) Maybe Address
addr
}
catchIOException :: IOException -> IO a
catchIOException IOException
exc = forall e a. Exception e => e -> IO a
throwIO ([Char] -> SocketError
socketError (forall a. Show a => a -> [Char]
show (IOException
exc :: IOException)))
{ socketErrorAddress :: Maybe Address
socketErrorAddress = Maybe Address
addr
}
authenticator :: Authenticator t
authenticator :: forall t. Authenticator t
authenticator = forall t.
(t -> IO Bool) -> (t -> UUID -> IO Bool) -> Authenticator t
Authenticator (\t
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (\t
_ UUID
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
data UnixFdSupport = UnixFdsSupported | UnixFdsNotSupported
authenticatorWithUnixFds :: Authenticator SocketTransport
authenticatorWithUnixFds :: Authenticator SocketTransport
authenticatorWithUnixFds = UnixFdSupport -> Authenticator SocketTransport
authExternal UnixFdSupport
UnixFdsSupported
authExternal :: UnixFdSupport -> Authenticator SocketTransport
authExternal :: UnixFdSupport -> Authenticator SocketTransport
authExternal UnixFdSupport
unixFdSupport = forall t. Authenticator t
authenticator
{ authenticatorClient :: SocketTransport -> IO Bool
authenticatorClient = UnixFdSupport -> SocketTransport -> IO Bool
clientAuthExternal UnixFdSupport
unixFdSupport
, authenticatorServer :: SocketTransport -> UUID -> IO Bool
authenticatorServer = UnixFdSupport -> SocketTransport -> UUID -> IO Bool
serverAuthExternal UnixFdSupport
unixFdSupport
}
clientAuthExternal :: UnixFdSupport -> SocketTransport -> IO Bool
clientAuthExternal :: UnixFdSupport -> SocketTransport -> IO Bool
clientAuthExternal UnixFdSupport
unixFdSupport SocketTransport
t = do
forall t. Transport t => t -> ByteString -> IO ()
transportPut SocketTransport
t ([Word8] -> ByteString
Data.ByteString.pack [Word8
0])
UserID
uid <- IO UserID
System.Posix.User.getRealUserID
let token :: [Char]
token = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall r. PrintfType r => [Char] -> r
printf [Char]
"%02X" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (forall a. Show a => a -> [Char]
show UserID
uid)
forall t. Transport t => t -> [Char] -> IO ()
transportPutLine SocketTransport
t ([Char]
"AUTH EXTERNAL " forall a. [a] -> [a] -> [a]
++ [Char]
token)
[Char]
resp <- forall t. Transport t => t -> IO [Char]
transportGetLine SocketTransport
t
case [Char] -> [Char] -> Maybe [Char]
splitPrefix [Char]
"OK " [Char]
resp of
Just [Char]
_ -> do
Bool
ok <- do
case UnixFdSupport
unixFdSupport of
UnixFdSupport
UnixFdsSupported -> do
forall t. Transport t => t -> [Char] -> IO ()
transportPutLine SocketTransport
t [Char]
"NEGOTIATE_UNIX_FD"
[Char]
respFd <- forall t. Transport t => t -> IO [Char]
transportGetLine SocketTransport
t
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
respFd forall a. Eq a => a -> a -> Bool
== [Char]
"AGREE_UNIX_FD")
UnixFdSupport
UnixFdsNotSupported -> do
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
if Bool
ok then do
forall t. Transport t => t -> [Char] -> IO ()
transportPutLine SocketTransport
t [Char]
"BEGIN"
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
serverAuthExternal :: UnixFdSupport -> SocketTransport -> UUID -> IO Bool
serverAuthExternal :: UnixFdSupport -> SocketTransport -> UUID -> IO Bool
serverAuthExternal UnixFdSupport
unixFdSupport SocketTransport
t UUID
uuid = do
let negotiateFdsAndBegin :: IO ()
negotiateFdsAndBegin = do
[Char]
line <- forall t. Transport t => t -> IO [Char]
transportGetLine SocketTransport
t
case [Char]
line of
[Char]
"NEGOTIATE_UNIX_FD" -> do
let msg :: [Char]
msg = case UnixFdSupport
unixFdSupport of
UnixFdSupport
UnixFdsSupported ->
[Char]
"AGREE_UNIX_FD"
UnixFdSupport
UnixFdsNotSupported ->
[Char]
"ERROR Unix File Descriptor support is not configured."
forall t. Transport t => t -> [Char] -> IO ()
transportPutLine SocketTransport
t [Char]
msg
IO ()
negotiateFdsAndBegin
[Char]
"BEGIN" ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Char]
_ ->
IO ()
negotiateFdsAndBegin
let checkToken :: [Char] -> IO Bool
checkToken [Char]
token = do
(Maybe CUInt
_, Maybe CUInt
uid, Maybe CUInt
_) <- SocketTransport -> IO (Maybe CUInt, Maybe CUInt, Maybe CUInt)
socketTransportCredentials SocketTransport
t
let wantToken :: [Char]
wantToken = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall r. PrintfType r => [Char] -> r
printf [Char]
"%02X" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"XXX" forall a. Show a => a -> [Char]
show Maybe CUInt
uid)
if [Char]
token forall a. Eq a => a -> a -> Bool
== [Char]
wantToken
then do
forall t. Transport t => t -> [Char] -> IO ()
transportPutLine SocketTransport
t ([Char]
"OK " forall a. [a] -> [a] -> [a]
++ UUID -> [Char]
formatUUID UUID
uuid)
IO ()
negotiateFdsAndBegin
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
ByteString
c <- forall t. Transport t => t -> Int -> IO ByteString
transportGet SocketTransport
t Int
1
if ByteString
c forall a. Eq a => a -> a -> Bool
/= [Char] -> ByteString
Char8.pack [Char]
"\x00"
then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
[Char]
line <- forall t. Transport t => t -> IO [Char]
transportGetLine SocketTransport
t
case [Char] -> [Char] -> Maybe [Char]
splitPrefix [Char]
"AUTH EXTERNAL " [Char]
line of
Just [Char]
token -> [Char] -> IO Bool
checkToken [Char]
token
Maybe [Char]
Nothing -> if [Char]
line forall a. Eq a => a -> a -> Bool
== [Char]
"AUTH EXTERNAL"
then do
[Char]
dataLine <- forall t. Transport t => t -> IO [Char]
transportGetLine SocketTransport
t
case [Char] -> [Char] -> Maybe [Char]
splitPrefix [Char]
"DATA " [Char]
dataLine of
Just [Char]
token -> [Char] -> IO Bool
checkToken [Char]
token
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
transportPutLine :: Transport t => t -> String -> IO ()
transportPutLine :: forall t. Transport t => t -> [Char] -> IO ()
transportPutLine t
t [Char]
line = forall t. Transport t => t -> ByteString -> IO ()
transportPut t
t ([Char] -> ByteString
Char8.pack ([Char]
line forall a. [a] -> [a] -> [a]
++ [Char]
"\r\n"))
transportGetLine :: Transport t => t -> IO String
transportGetLine :: forall t. Transport t => t -> IO [Char]
transportGetLine t
t = do
let getchr :: IO Char
getchr = ByteString -> Char
Char8.head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall t. Transport t => t -> Int -> IO ByteString
transportGet t
t Int
1
[Char]
raw <- forall (m :: * -> *) a. (Monad m, Eq a) => [a] -> m a -> m [a]
readUntil [Char]
"\r\n" IO Char
getchr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Int -> [a] -> [a]
dropEnd Int
2 [Char]
raw)
dropEnd :: Int -> [a] -> [a]
dropEnd :: forall a. Int -> [a] -> [a]
dropEnd Int
n [a]
xs = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
- Int
n) [a]
xs
splitPrefix :: String -> String -> Maybe String
splitPrefix :: [Char] -> [Char] -> Maybe [Char]
splitPrefix [Char]
prefix [Char]
str = if forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
prefix [Char]
str
then forall a. a -> Maybe a
Just (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
prefix) [Char]
str)
else forall a. Maybe a
Nothing
readUntil :: (Monad m, Eq a) => [a] -> m a -> m [a]
readUntil :: forall (m :: * -> *) a. (Monad m, Eq a) => [a] -> m a -> m [a]
readUntil [a]
guard m a
getx = [a] -> m [a]
readUntil' [] where
guard' :: [a]
guard' = forall a. [a] -> [a]
reverse [a]
guard
step :: [a] -> m [a]
step [a]
xs | forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
guard' [a]
xs = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [a]
xs)
| Bool
otherwise = [a] -> m [a]
readUntil' [a]
xs
readUntil' :: [a] -> m [a]
readUntil' [a]
xs = do
a
x <- m a
getx
[a] -> m [a]
step (a
xforall a. a -> [a] -> [a]
:[a]
xs)