encode.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Main where

import Control.Applicative
import Data.Aeson
import Data.Char
import GHC.Generics
import Numeric
import Snap.Core
import Snap.Http.Server
import qualified Data.ByteString.Base64 as B64 (encode, decodeLenient)
import qualified Data.ByteString.Char8 as Char8 (pack, unpack)
import qualified Data.ByteString.Internal as StrictBS (ByteString)
import qualified Data.ByteString.Lazy as LazyBS (toStrict)

main :: IO ()
main = quickHttpServe site

data Encodings = Encodings 
  { binary :: String
  , hex :: String
  , decimal :: [Int]
  , base64 :: String
  , ascii :: String
  }
  deriving (Show, Generic)
instance ToJSON Encodings

site :: Snap ()
site =
  ifTop (writeBS "Please visit /binary/, /hex/, /decimal/, /ascii/, or /base64/ followed by your value") <|>
  (route $
    map createRoute
      [ ("binary", id)
      , ("hex", hexToBinary)
      , ("decimal", decimalToBinary . read)
      , ("ascii", asciiToBinary)
      , ("base64", base64ToBinary)
      ]
  )

createRoute (inputEncoding, toBinary) =
  (inputEncoding <> "/:value", handler inputEncoding toBinary)

handler inputEncoding toBinary = do
  param <- getParam "value"
  case param of
    Nothing -> writeBS $ "Given " <> inputEncoding <> " input couldn't be parsed"
    Just binaryParam -> writeBS . binaryToEncodings . toBinary . Char8.unpack $ binaryParam 

binaryToEncodings :: String -> StrictBS.ByteString
binaryToEncodings binary =
  LazyBS.toStrict . encode $ 
    Encodings
      { hex = binaryToHex binary
      , decimal = map binaryToDecimal (words binary)
      , base64 = binaryToBase64 binary
      , ascii = binaryToAscii binary
      , binary = binary
      }

--hex
hexToBinary :: String -> String
hexToBinary = unwords . map (decimalToBinary . fst . head . readHex) . words

binaryToHex :: String -> String
binaryToHex = unwords . map (flip showHex "" . binaryToDecimal) . words

--decimal
decimalToBinary :: Int -> String
decimalToBinary x = showIntAtBase 2 intToDigit x ""

binaryToDecimal :: String -> Int
binaryToDecimal = fst . head . readInt 2 (`elem` ['0','1']) digitToInt

--ascii
asciiToBinary :: String -> String
asciiToBinary = unwords . map (decimalToBinary . fromEnum)

binaryToAscii :: String -> String
binaryToAscii = map toEnum . map binaryToDecimal . words

--base64
base64ToBinary :: String -> String
base64ToBinary = asciiToBinary . Char8.unpack . B64.decodeLenient . Char8.pack

binaryToBase64 :: String -> String
binaryToBase64 = Char8.unpack . B64.encode . Char8.pack . binaryToAscii